March 01, 2021, 09:59:02 PM

Author Topic: [bmx] Seamless Tiles by impixi [ 1+ years ago ]  (Read 843 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bmx] Seamless Tiles by impixi [ 1+ years ago ]
« on: June 29, 2017, 12:28:42 AM »
Title : Seamless Tiles
Author : impixi
Posted : 1+ years ago

Description : Create a seamless tile pixmap from a source pixmap

Code :
Code: BlitzMax
  1. Rem
  2.         Seamless Texture Tiling Example
  3.        
  4.         ORIGINAL AUTHOR (Article and C Code):
  5.                 Paul Bourke
  6.                 January 2000
  7.         http://local.wasp.uwa.edu.au/~pbourke/texture/tiling/
  8.                        
  9.         REQUIREMENTS:
  10.                 BlitzMax 1.22
  11.                 Windows XP (Linux and MacOS untested)
  12.                
  13.         PURPOSE:
  14.                 Create a seamless 'tile' pixmap from a source pixmap
  15.                
  16. EndRem
  17.  
  18. SuperStrict
  19.  
  20. AppTitle = "Seamless Texture Tiling Example"
  21.  
  22. Graphics 1024, 768
  23. SetBlend SOLIDBLEND
  24.  
  25. Local tex:TPixmap = LoadPixmap("tex.png")       '<--- Provide your own texture for this example. <---
  26.  
  27. If (tex.format <> PF_RGBA8888) Then tex = ConvertPixmap(tex, PF_RGBA8888)
  28.  
  29. Local tile:TPixmap = createSeamlessTile(tex, MASK_RADIAL)
  30.  
  31. Local img:TImage = LoadImage(tile)
  32.  
  33. SetClsColor 255, 255, 255
  34.  
  35. While Not KeyHit(KEY_ESCAPE)
  36.  
  37.         Cls
  38.  
  39.         SetViewport 0, 0, GraphicsWidth(), GraphicsHeight()
  40.  
  41.         DrawText "Source:", 2, 2
  42.         DrawPixmap tex, 2, 22
  43.        
  44.         DrawText "Result:", 2, tex.height + 42
  45.         DrawPixmap tile, 2, tex.height + 62
  46.  
  47.         DrawText "Tiled Result:", tex.width + 20, 2
  48.         SetViewport tex.width + 20, 22, GraphicsWidth() - tex.width - 22, GraphicsHeight() - 26
  49.         TileImage img
  50.                        
  51.         Flip 1
  52.  
  53. Wend
  54.  
  55. End
  56.  
  57.  
  58. '*************** SEAMLESS TILE FUNCTION AND RELATED CONSTANTS *************************************
  59.  
  60.  
  61. Const MASK_LINEAR:Int = 0
  62. Const MASK_RADIAL:Int = 1
  63.  
  64. Function createSeamlessTile:TPixmap(src:TPixmap, masktype:Int = MASK_LINEAR)
  65.  
  66.         'src: Source pixmap texture. Format should be PF_RGBA8888.
  67.         'masktype: Mask type. MASK_LINEAR or MASK_RADIAL. Some textures tile better using a different mask.
  68.         'Returns a new 'tileable' pixmap.
  69.  
  70.         Local outp:TPixmap = CreatePixmap(src.width, src.height, src.format)
  71.         Local diag:TPixmap = CreatePixmap(src.width, src.height, src.format)
  72.  
  73.         Local temp:TPixmap = PixmapWindow(src, 0, 0, src.width / 2, src.height / 2)
  74.  
  75.         For Local x:Int = 0 To temp.width - 1
  76.                 For Local z:Int = 0 To temp.height - 1
  77.                         WritePixel diag, (src.width / 2) + x, (src.height / 2) + z, ReadPixel(temp, x, z)
  78.                 Next
  79.         Next
  80.        
  81.         temp = PixmapWindow(src, src.width / 2, src.height / 2, src.width / 2, src.height / 2)
  82.        
  83.         For Local x:Int = 0 To temp.width - 1
  84.                 For Local z:Int = 0 To temp.height - 1
  85.                         WritePixel diag, x, z, ReadPixel(temp, x, z)
  86.                 Next
  87.         Next
  88.  
  89.         temp = PixmapWindow(src, src.width / 2, 0, src.width / 2, src.height / 2)
  90.        
  91.         For Local x:Int = 0 To temp.width - 1
  92.                 For Local z:Int = 0 To temp.height - 1
  93.                         WritePixel diag, x, (src.height / 2) + z, ReadPixel(temp, x, z)
  94.                 Next
  95.         Next
  96.  
  97.         temp = PixmapWindow(src, 0, src.height / 2, src.width / 2, src.height / 2)
  98.        
  99.         For Local x:Int = 0 To temp.width - 1
  100.                 For Local z:Int = 0 To temp.height - 1
  101.                         WritePixel diag, (src.width / 2) + x, z, ReadPixel(temp, x, z)
  102.                 Next
  103.         Next
  104.  
  105.         Local masksize:Int
  106.         If (src.width > src.height) Then masksize = src.width Else masksize = src.height
  107.                
  108.         Local mask:TPixmap = CreatePixmap(masksize, masksize, PF_RGB888)
  109.  
  110.         For Local x:Int = 0 To masksize / 2
  111.                 For Local z:Int = 0 To masksize / 2
  112.  
  113.                         Local d:Float = 0.0
  114.                        
  115.                         If masktype = MASK_RADIAL
  116.                                 d = Sqr((x - (masksize / 2)) * (x - (masksize / 2)) + (z - (masksize / 2)) * (z - (masksize / 2))) / (masksize / 2)
  117.                         Else
  118.                                 If masktype = MASK_LINEAR
  119.                                         d = Max(Float((masksize / 2) - x), Float((masksize / 2) - z)) / Float(masksize / 2)
  120.                                 EndIf
  121.                         EndIf
  122.                        
  123.                         d = 255 - (255 * d)
  124.                        
  125.                         If d < 1 Then d = 1
  126.                         If d > 255 Then d = 255
  127.                        
  128.                         WritePixel mask, x, z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
  129.                         WritePixel mask, x, (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
  130.                         WritePixel mask, (masksize - 1 - x), z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
  131.                         WritePixel mask, (masksize - 1 - x), (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
  132.  
  133.                 Next
  134.         Next
  135.  
  136.         mask = ResizePixmap(mask, src.width, src.height)
  137.  
  138.         For Local z:Int = 0 To src.height - 1
  139.                 For Local x:Int = 0 To src.width - 1
  140.                
  141.                         Local a1:Float = Float(Byte(ReadPixel(mask, x, z) Shr 16))
  142.                         Local a2:Float = Float(Byte(ReadPixel(mask, ((x + src.width / 2) Mod src.width), ((z + src.height / 2) Mod src.height)) Shr 16))
  143.                        
  144.                         Local px1:Int = ReadPixel(src, x, z)
  145.                         Local px1a:Byte = px1 Shr 24
  146.                         Local px1b:Byte = px1 Shr 16
  147.                         Local px1g:Byte = px1 Shr 8
  148.                         Local px1r:Byte = px1
  149.                        
  150.                         Local px2:Int = ReadPixel(diag, x, z)
  151.                         Local px2a:Byte = px2 Shr 24
  152.                         Local px2b:Byte = px2 Shr 16
  153.                         Local px2g:Byte = px2 Shr 8
  154.                         Local px2r:Byte = px2
  155.                        
  156.                         Local pxRa:Byte = px1a
  157.                         Local pxRb:Byte = (a1 * (px1b / (a1 + a2))) + (a2 * (px2b / (a1 + a2)))
  158.                         Local pxRg:Byte = (a1 * (px1g / (a1 + a2))) + (a2 * (px2g / (a1 + a2)))
  159.                         Local pxRr:Byte = (a1 * (px1r / (a1 + a2))) + (a2 * (px2r / (a1 + a2)))
  160.                         Local pxR:Int = Int(pxRa Shl 24 | pxRb Shl 16 | pxRg Shl 8 | pxRr)
  161.                                                
  162.                         WritePixel outp, x, z, pxR
  163.        
  164.                 Next
  165.         Next
  166.  
  167.         Return outp
  168.  
  169. EndFunction


Comments :


Booticus(Posted 1+ years ago)

 Thats damned handy! I did notice on a few test runs that a horizontal black line appears on some images that I used. Just picked some random grass images from here:<a href="http://www.injuryupdate.com.au/issues/grass_types.php" target="_blank">http://www.injuryupdate.com.au/issues/grass_types.php[/url]but other than that its a killer bit of code, thanks!


impixi(Posted 1+ years ago)

 EDIT: Removed dead links.


Plantagenet(Posted 1+ years ago)

 Tested With about half a dozen of my own images of varying sizes and sources and had no problems.  Good work, and a useful utility.


impixi(Posted 1+ years ago)

 As requested in another thread, here's the source for Ultra Simple Seamless Tiler V1.00. You will need to change the framework and possibly tweak the code if compiling for other platforms. The MaxGUI module is required.
Code: [Select]

SuperStrict

Framework BRL.Win32MaxGUI
Import BRL.EventQueue
Import BRL.PNGLoader
Import BRL.JPGLoader
Import BRL.TGALoader
Import BRL.BMPLoader

Global MainWindow:TMainWindow = New TMainWindow

AddHook EmitEventHook, StopHook

While True

WaitEvent

Select EventID()

Case EVENT_WINDOWCLOSE
Select EventSource()

Case MainWindow.Window
End

Case MainWindow.BatchWindow
EnableGadget MainWindow.Window
SetTextAreaText MainWindow.BatchTxtA1, ""
HideGadget MainWindow.BatchWindow
ActivateWindow MainWindow.Window

EndSelect

Case EVENT_APPTERMINATE
If EventSource() = MainWindow.Window Then End

Case EVENT_WINDOWSIZE
If EventSource() = MainWindow.Window
MainWindow.placeGadgets()
EndIf

Case EVENT_MOUSEMOVE

Select EventSource()
Case MainWindow.Panel_S
SetStatusText MainWindow.Window, "Left click to display tiled result."
Case MainWindow.Panel_RL
SetStatusText MainWindow.Window, "Left click to display tiled result."
Case MainWindow.Panel_RR
SetStatusText MainWindow.Window, "Left click to display tiled result."
EndSelect

Case EVENT_MOUSELEAVE

Select EventSource()
Case MainWindow.Panel_S
SetStatusText MainWindow.Window, ""
Case MainWindow.Panel_RL
SetStatusText MainWindow.Window, ""
Case MainWindow.Panel_RR
SetStatusText MainWindow.Window, ""
EndSelect

Case EVENT_MOUSEDOWN

If EventData() = 1

Select EventSource()

Case MainWindow.Panel_S
MainWindow.tileTile(0)
Case MainWindow.Panel_RL
MainWindow.tileTile(1)
Case MainWindow.Panel_RR
MainWindow.tileTile(2)

EndSelect

EndIf

Case EVENT_MENUACTION

Select EventData()

Case MainWindow.MENU_EXIT
End

Case MainWindow.MENU_ABOUT
Notify "Ultra Simple Seamless Tiler V1.0~n~nNovember 2006~n~nFREEWARE~n~nUse at your own risk.~nNO support or warranty provided."

Case MainWindow.MENU_OPEN
MainWindow.changeSource()

Case MainWindow.MENU_SAVE_LINEAR
MainWindow.saveLinear()

Case MainWindow.MENU_SAVE_RADIAL
MainWindow.saveRadial()

Case MainWindow.MENU_PROCESS_BATCH
DisableGadget MainWindow.Window
ShowGadget MainWindow.BatchWindow
ActivateWindow MainWindow.BatchWindow

End Select

Case EVENT_GADGETACTION

Select EventSource()

Case MainWindow.BatchBtnClose
EnableGadget MainWindow.Window
SetTextAreaText MainWindow.BatchTxtA1, ""
HideGadget MainWindow.BatchWindow
ActivateWindow MainWindow.Window

Case MainWindow.BatchBtn1
SetGadgetText(MainWindow.BatchTxt1, RequestDir ("Select a Folder: ",CurrentDir()))

Case MainWindow.BatchBtnGo
MainWindow.processBatch()

EndSelect

EndSelect

Wend

Function StopHook:Object(iId:Int, tData:Object, tContext:Object)
 
Local Event:TEvent = TEvent(tData)

  If Event.source = MainWindow.BatchBtnStop And Event.ID = EVENT_GADGETACTION
MainWindow.DoStopBatch = True
      Return Null
  EndIf

  Return tData

EndFunction


'***************************************************************************


Type TMainWindow

Field Window:TGadget

Field Panel_S:TGadget
Field Panel_RL:TGadget
Field Panel_RR:TGadget
Field Panel_T:TGadget

Const BORDER:Int = 5

Field Pm_S:TPixmap
Field Pm_RL:TPixmap
Field Pm_RR:TPixmap

Const MENU_OPEN:Int = 101
Const MENU_SAVE_LINEAR:Int = 102
Const MENU_SAVE_RADIAL:Int = 103
Const MENU_EXIT:Int = 104
Const MENU_PROCESS_BATCH:Int = 201
Const MENU_ABOUT:Int = 301

Field BatchWindow:TGadget
Field BatchLbl1:TGadget
Field BatchLbl2:TGadget
Field BatchLbl3:TGadget
Field BatchLbl4:TGadget
Field BatchTxt1:TGadget
Field BatchBtn1:TGadget
Field BatchBtn2:TGadget
Field BatchBtn3:TGadget
Field BatchTxtA1:TGadget
Field BatchBtnGo:TGadget
Field BatchBtnClose:TGadget
Field BatchBtnStop:TGadget

Field DoStopBatch:Int

Method New()

Local dt:TGadget = Desktop()

Local fontb:TGUIFont = LoadGuiFont("Arial", 10, True, False, False)

Window = CreateWindow("Ultra Simple Seamless Tiler V1.0", ((dt.width / 2) - 400), ((dt.height / 2) - 300), 800, 600, Null ,WINDOW_TITLEBAR | WINDOW_RESIZABLE | WINDOW_STATUS | WINDOW_MENU)

Local filemenu:TGadget = CreateMenu("&File", 0, WindowMenu(Window))
CreateMenu "&Open...", MENU_OPEN, filemenu, KEY_O, MODIFIER_COMMAND
CreateMenu "", 0, filemenu
CreateMenu "Save &Linear...", MENU_SAVE_LINEAR, filemenu,KEY_L, MODIFIER_COMMAND
CreateMenu "Save &Radial...", MENU_SAVE_RADIAL, filemenu,KEY_R, MODIFIER_COMMAND
CreateMenu "", 0, filemenu
CreateMenu "E&xit", MENU_EXIT, filemenu, KEY_F4, MODIFIER_COMMAND

Local batchmenu:TGadget = CreateMenu("&Batch", 0, WindowMenu(Window))
CreateMenu "&Process Batch...", MENU_PROCESS_BATCH, batchmenu, KEY_P, MODIFIER_COMMAND

Local helpmenu:TGadget = CreateMenu("&Help", 0, WindowMenu(Window))
CreateMenu "&About...", MENU_ABOUT, helpmenu, KEY_F1

UpdateWindowMenu Window

Panel_S = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Source:")
Panel_RL = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Linear:")
Panel_RR = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Radial:")
Panel_T:TGadget = CreatePanel(0, 0, 0, 0, Window, PANEL_GROUP, "Tiled Result:")

SetGadgetFont Panel_S, fontb
SetGadgetFont Panel_RL, fontb
SetGadgetFont Panel_RR, fontb
SetGadgetFont Panel_T, fontb

placeGadgets()

BatchWindow = CreateWindow("Process Batch", GadgetX(Window) + 100, GadgetY(Window) + 100, 500, 400, Window, WINDOW_TITLEBAR)
HideGadget BatchWindow

Local browse_wid:Int = 20

BatchLbl1 = CreateLabel("Source folder: ", BORDER, BORDER, 80, 25, BatchWindow)

BatchTxt1 = CreateTextField(BatchLbl1.width + BORDER * 2, BORDER, ClientWidth(BatchWindow) - BatchLbl1.width - BORDER - browse_wid - (BORDER * 3), 25, BatchWindow)
BatchBtn1 = CreateButton("...", GadgetX(BatchTxt1) + BatchTxt1.width + BORDER, BORDER, browse_wid, 20, BatchWindow)
BatchBtn2 = CreateButton("Linear Mask", BORDER, GadgetY(BatchLbl1) + BatchLbl1.height + BORDER + BORDER, 120, 20, BatchWindow, BUTTON_CHECKBOX)
BatchBtn3 = CreateButton("Radial Mask", BORDER, GadgetY(BatchBtn2) + BatchBtn1.height + BORDER, 120, 20, BatchWindow, BUTTON_CHECKBOX)
BatchLbl2 = CreateLabel("", GadgetX(BatchBtn2) + BatchBtn2.width + BORDER, GadgetY(BatchLbl1) + BatchLbl1.height + BORDER + BORDER, 80, 25, BatchWindow)
BatchLbl3 = CreateLabel("", GadgetX(BatchBtn3) + BatchBtn3.width + BORDER, GadgetY(BatchLbl2) + BatchLbl2.height + BORDER, 80, 25, BatchWindow)
BatchLbl4 = CreateLabel("Log:", BORDER, GadgetY(BatchLbl3) + BatchBtn3.height + BORDER + BORDER, 50, 20, BatchWindow)
BatchTxtA1 = CreateTextArea(BORDER, GadgetY(BatchLbl4) + BatchLbl4.height + BORDER + BORDER, ClientWidth(BatchWindow) - (BORDER * 2), 200, BatchWindow, TEXTAREA_READONLY)
BatchBtnGo = CreateButton("Go", BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER, 20, BatchWindow)
BatchBtnClose = CreateButton("Close", GadgetX(BatchBtnGo) + BatchBtnGo.width + BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER - BORDER, 20, BatchWindow)
BatchBtnStop = CreateButton("Stop", GadgetX(BatchBtnGo) + BatchBtnGo.width + BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER - BORDER, 20, BatchWindow)
HideGadget BatchBtnStop

EndMethod

Method placeGadgets()

Local panelsize:Int = (ClientHeight(Window) / 3) - BORDER

SetGadgetShape Panel_S, BORDER, BORDER, panelsize, panelsize
SetGadgetShape Panel_RL, BORDER, (Panel_S.height + BORDER) + 2, panelsize, panelsize
SetGadgetShape Panel_RR, BORDER, (Panel_RL.height + Panel_RL.height + BORDER) + 2, panelsize, panelsize

SetGadgetShape Panel_T, (Panel_S.width + (BORDER * 2)), BORDER, (ClientWidth(Window) - GadgetWidth(PANEL_S) - (3 * BORDER)), (ClientHeight(Window) - (2 * BORDER))

SetPanelColor Panel_S, 0, 0, 0
SetPanelColor Panel_RL, 0, 255, 0
SetPanelColor Panel_RR, 0, 0, 255

EndMethod

Method changeSource()

Local filter:String = "Image Files:png,jpg,tga,bmp; All Files:*"
Local filename:String = RequestFile("Load image file:", filter)
If filename <> ""
SetPointer POINTER_WAIT
SetStatusText Window, "Processing. Please wait..."
Local loadresult:Int = calcTiles(filename)
If Not loadresult Then Notify "Error: Could not load file."
SetStatusText Window, ""
SetPointer POINTER_DEFAULT
EndIf

EndMethod

Method calcTiles:Int(url:String = "")

Local newpm_s:TPixmap = LoadPixmap(url)

If Not newpm_s Then Return False Else Pm_S = newpm_s

If (Pm_S.format <> PF_RGBA8888) Then Pm_S = ConvertPixmap(Pm_S, PF_RGBA8888)

Pm_RL = createSeamlessTile(Pm_S, MASK_LINEAR)
Pm_RR = createSeamlessTile(Pm_S, MASK_RADIAL)

SetPanelPixmap Panel_S, Pm_S, PANELPIXMAP_FIT
SetPanelPixmap Panel_RL, Pm_RL, PANELPIXMAP_FIT
SetPanelPixmap Panel_RR, Pm_RR, PANELPIXMAP_FIT

tileTile(0)

'** Force a redraw
HideGadget Panel_S
ShowGadget Panel_S
HideGadget Panel_RL
ShowGadget Panel_RL
HideGadget Panel_RR
ShowGadget Panel_RR
'*****************

Return True

EndMethod

Method saveLinear()

Local filter:String = "Image Files:png; All Files:*"
Local filename:String = RequestFile("Save PNG image file:", filter, True)
If ((filename) And (pm_RL <> Null)) Then SavePixmapPNG(Pm_RL, filename, 9)

EndMethod

Method saveRadial()

Local filter:String = "Image Files:png; All Files:*"
Local filename:String = RequestFile("Save PNG image file:", filter, True)
If ((filename) And (pm_RR <> Null)) Then SavePixmapPNG(Pm_RR, filename, 9)

EndMethod

Method tileTile(ct:Int = 0)

Select ct

Case 0
SetGadgetText Panel_T, "Tiled Source:"
SetPanelColor Panel_T, 0, 0, 0
SetPanelPixmap Panel_T, Pm_S, PANELPIXMAP_TILE

Case 1
SetGadgetText Panel_T, "Tiled Linear:"
SetPanelColor Panel_T, 0, 255, 0
SetPanelPixmap Panel_T, Pm_RL, PANELPIXMAP_TILE

Case 2
SetGadgetText Panel_T, "Tiled Radial:"
SetPanelColor Panel_T, 0, 0, 255
SetPanelPixmap Panel_T, Pm_RR, PANELPIXMAP_TILE

EndSelect

'** Force a redraw
HideGadget Panel_T
ShowGadget Panel_T
'*****************

EndMethod

Method processBatch()

DoStopBatch = False

SetGadgetText BatchTxtA1, ""
DisableGadget BatchBtnGo
HideGadget BatchBtnClose
ShowGadget BatchBtnStop

Local srcurl:String = GadgetText(BatchTxt1)
Local files:String[] = LoadDir(srcurl)

If files.length <= 0
Notify "The specified source folder is invalid or empty."
EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose
Return
EndIf

If Not (ButtonState(BatchBtn2) Or ButtonState(BatchBtn3))
Notify "No mask selected."
EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose
Return
EndIf

Local linear:String = "linear"
Local lin:Int = False
Local radial:String = "radial"
Local rad:Int = False
Local logtext:String = ""

ChangeDir srcurl

If ButtonState(BatchBtn2)
lin = CreateDir(linear)
If lin
logtext :+ srcurl + "" + linear + " folder ready.~n"
Else
logtext :+ "ERROR: " + srcurl + "" + linear + " folder could NOT be prepared.~n"
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext

If ButtonState(BatchBtn3)
rad = CreateDir(radial)
If rad
logtext :+ srcurl + "" + radial + " folder ready.~n"
Else
logtext :+ "ERROR: " + srcurl + "" + radial + " folder could NOT be prepared.~n"
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext

For Local t:String = EachIn files

PollSystem

If DoStopBatch
logtext :+ "~n Processing HALTED by user."
SetGadgetText BatchTxtA1, logtext
Exit
EndIf

If (FileType(t) = FILETYPE_FILE)

logtext :+ "Processing " + t + "..."
SetGadgetText BatchTxtA1, logtext
PollSystem

Local srcpm:TPixmap = LoadPixmap(t)

If Not srcpm

logtext :+ " Unsupported image format.~n"

Else

Local pm:TPixmap
If (srcpm.format <> PF_RGBA8888) Then srcpm = ConvertPixmap(srcpm, PF_RGBA8888)

If (lin)
Local newname:String = linear + "" + StripExt(t) + ".png"
If FileType(newname) = 0 'Create the file only if it does not already exist
pm = createSeamlessTile(srcpm, MASK_LINEAR)
SavePixmapPNG(pm, newname, 9)
logtext :+ " Linear tile created."
Else
logtext :+ " Linear tile already exists."
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext
PollSystem

If DoStopBatch
logtext :+ "~n~n*** Processing HALTED by user. ***"
SetGadgetText BatchTxtA1, logtext
Exit
EndIf

If (rad)
Local newname:String = radial + "" + StripExt(t) + ".png"
If FileType(newname) = 0 'Create the file only if it does not already exist
pm = createSeamlessTile(srcpm, MASK_RADIAL)
SavePixmapPNG(pm, newname, 9)
logtext :+ " Radial tile created."
Else
logtext :+ " Radial tile already exists."
EndIf
EndIf

logtext :+ "~n"

EndIf

SetGadgetText BatchTxtA1, logtext

EndIf
Next

If Not DoStopBatch
logtext :+ "~n*** Processing COMPLETED. ***"
SetGadgetText BatchTxtA1, logtext
EndIf

EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose

EndMethod

EndType


'*************** SEAMLESS TILE FUNCTION AND RELATED CONSTANTS *************************************


Const MASK_LINEAR:Int = 0
Const MASK_RADIAL:Int = 1

Function createSeamlessTile:TPixmap(src:TPixmap, masktype:Int = MASK_LINEAR)

'src: Source pixmap texture. Format should be PF_RGBA8888.
'masktype: Mask type. MASK_LINEAR or MASK_RADIAL. Some textures tile better using a different mask.
'Returns a new 'tileable' pixmap.

Local outp:TPixmap = CreatePixmap(src.width, src.height, src.format)
Local diag:TPixmap = CreatePixmap(src.width, src.height, src.format)

Local temp:TPixmap = PixmapWindow(src, 0, 0, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, (src.width / 2) + x, (src.height / 2) + z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, src.width / 2, src.height / 2, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, x, z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, src.width / 2, 0, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, x, (src.height / 2) + z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, 0, src.height / 2, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, (src.width / 2) + x, z, ReadPixel(temp, x, z)
Next
Next

Local masksize:Int
If (src.width > src.height) Then masksize = src.width Else masksize = src.height

Local mask:TPixmap = CreatePixmap(masksize, masksize, PF_RGB888)

For Local x:Int = 0 To masksize / 2
For Local z:Int = 0 To masksize / 2

Local d:Float = 0.0

If masktype = MASK_RADIAL
d = Sqr((x - (masksize / 2)) * (x - (masksize / 2)) + (z - (masksize / 2)) * (z - (masksize / 2))) / (masksize / 2)
Else
If masktype = MASK_LINEAR
d = Max(Float((masksize / 2) - x), Float((masksize / 2) - z)) / Float(masksize / 2)
EndIf
EndIf

d = 255 - (255 * d)

If d < 1 Then d = 1
If d > 255 Then d = 255

WritePixel mask, x, z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, x, (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, (masksize - 1 - x), z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, (masksize - 1 - x), (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))

Next
Next

mask = ResizePixmap(mask, src.width, src.height)

For Local z:Int = 0 To src.height - 1
For Local x:Int = 0 To src.width - 1

Local a1:Float = Float(Byte(ReadPixel(mask, x, z) Shr 16))
Local a2:Float = Float(Byte(ReadPixel(mask, ((x + src.width / 2) Mod src.width), ((z + src.height / 2) Mod src.height)) Shr 16))

Local px1:Int = ReadPixel(src, x, z)
Local px1a:Byte = px1 Shr 24
Local px1b:Byte = px1 Shr 16
Local px1g:Byte = px1 Shr 8
Local px1r:Byte = px1

Local px2:Int = ReadPixel(diag, x, z)
Local px2a:Byte = px2 Shr 24
Local px2b:Byte = px2 Shr 16
Local px2g:Byte = px2 Shr 8
Local px2r:Byte = px2

Local pxRa:Byte = px1a
Local pxRb:Byte = (a1 * (px1b / (a1 + a2))) + (a2 * (px2b / (a1 + a2)))
Local pxRg:Byte = (a1 * (px1g / (a1 + a2))) + (a2 * (px2g / (a1 + a2)))
Local pxRr:Byte = (a1 * (px1r / (a1 + a2))) + (a2 * (px2r / (a1 + a2)))
Local pxR:Int = Int(pxRa Shl 24 | pxRb Shl 16 | pxRg Shl 8 | pxRr)

WritePixel outp, x, z, pxR

Next
Next

Return outp

EndFunction
EDIT: Added code line "Import BRL.EventQueue".


impixi(Posted 1+ years ago)

 Here's the latest version of Ultra Simple Seamless Tiler 1.01, to be compiled against maxgui.mod revision 29:
Code: [Select]
SuperStrict

Framework MaxGui.Drivers

Import BRL.EventQueue
Import BRL.PNGLoader
Import BRL.JPGLoader
Import BRL.TGALoader
Import BRL.BMPLoader

Global MainWindow:TMainWindow = New TMainWindow

AddHook EmitEventHook, StopHook

While True

WaitEvent

Select EventID()

Case EVENT_WINDOWCLOSE
Select EventSource()

Case MainWindow.Window
End

Case MainWindow.BatchWindow
EnableGadget MainWindow.Window
SetTextAreaText MainWindow.BatchTxtA1, ""
HideGadget MainWindow.BatchWindow
ActivateWindow MainWindow.Window

EndSelect

Case EVENT_APPTERMINATE
If EventSource() = MainWindow.Window Then End

Case EVENT_WINDOWSIZE
If EventSource() = MainWindow.Window
MainWindow.placeGadgets()
EndIf

Case EVENT_MOUSEMOVE

Select EventSource()
Case MainWindow.Panel_S
SetStatusText MainWindow.Window, "Left click to display tiled result."
Case MainWindow.Panel_RL
SetStatusText MainWindow.Window, "Left click to display tiled result."
Case MainWindow.Panel_RR
SetStatusText MainWindow.Window, "Left click to display tiled result."
EndSelect

Case EVENT_MOUSELEAVE

Select EventSource()
Case MainWindow.Panel_S
SetStatusText MainWindow.Window, ""
Case MainWindow.Panel_RL
SetStatusText MainWindow.Window, ""
Case MainWindow.Panel_RR
SetStatusText MainWindow.Window, ""
EndSelect

Case EVENT_MOUSEDOWN

If EventData() = 1

Select EventSource()

Case MainWindow.Panel_S
MainWindow.tileTile(0)
Case MainWindow.Panel_RL
MainWindow.tileTile(1)
Case MainWindow.Panel_RR
MainWindow.tileTile(2)

EndSelect

EndIf

Case EVENT_MENUACTION

Select EventData()

Case MainWindow.MENU_EXIT
End

Case MainWindow.MENU_ABOUT
Notify "Ultra Simple Seamless Tiler V1.01~n~nFebruary 2008~n~nFREEWARE~n~nUse at your own risk.~nNO support or warranty provided."

Case MainWindow.MENU_OPEN
MainWindow.changeSource()

Case MainWindow.MENU_SAVE_LINEAR
MainWindow.saveLinear()

Case MainWindow.MENU_SAVE_RADIAL
MainWindow.saveRadial()

Case MainWindow.MENU_PROCESS_BATCH
DisableGadget MainWindow.Window
ShowGadget MainWindow.BatchWindow
ActivateWindow MainWindow.BatchWindow

End Select

Case EVENT_GADGETACTION

Select EventSource()

Case MainWindow.BatchBtnClose
EnableGadget MainWindow.Window
SetTextAreaText MainWindow.BatchTxtA1, ""
HideGadget MainWindow.BatchWindow
ActivateWindow MainWindow.Window

Case MainWindow.BatchBtn1
SetGadgetText(MainWindow.BatchTxt1, RequestDir ("Select a Folder: ",CurrentDir()))

Case MainWindow.BatchBtnGo
MainWindow.processBatch()

EndSelect

EndSelect

Wend

Function StopHook:Object(iId:Int, tData:Object, tContext:Object)
 
Local Event:TEvent = TEvent(tData)

  If Event.source = MainWindow.BatchBtnStop And Event.ID = EVENT_GADGETACTION
MainWindow.DoStopBatch = True
      Return Null
  EndIf

  Return tData

EndFunction


'***************************************************************************


Type TMainWindow

Field Window:TGadget

Field Panel_S:TGadget
Field Panel_RL:TGadget
Field Panel_RR:TGadget
Field Panel_T:TGadget

Const BORDER:Int = 5

Field Pm_S:TPixmap
Field Pm_RL:TPixmap
Field Pm_RR:TPixmap

Const MENU_OPEN:Int = 101
Const MENU_SAVE_LINEAR:Int = 102
Const MENU_SAVE_RADIAL:Int = 103
Const MENU_EXIT:Int = 104
Const MENU_PROCESS_BATCH:Int = 201
Const MENU_ABOUT:Int = 301

Field BatchWindow:TGadget
Field BatchLbl1:TGadget
Field BatchLbl2:TGadget
Field BatchLbl3:TGadget
Field BatchLbl4:TGadget
Field BatchTxt1:TGadget
Field BatchBtn1:TGadget
Field BatchBtn2:TGadget
Field BatchBtn3:TGadget
Field BatchTxtA1:TGadget
Field BatchBtnGo:TGadget
Field BatchBtnClose:TGadget
Field BatchBtnStop:TGadget

Field DoStopBatch:Int

Method New()

Local dt:TGadget = Desktop()

Local fontb:TGUIFont = LoadGuiFont("Arial", 10, True, False, False)

Window = CreateWindow("Ultra Simple Seamless Tiler V1.01", ((dt.width / 2) - 400), ((dt.height / 2) - 300), 800, 600, Null ,WINDOW_TITLEBAR | WINDOW_RESIZABLE | WINDOW_STATUS | WINDOW_MENU)

Local filemenu:TGadget = CreateMenu("&File", 0, WindowMenu(Window))
CreateMenu "&Open...", MENU_OPEN, filemenu, KEY_O, MODIFIER_COMMAND
CreateMenu "", 0, filemenu
CreateMenu "Save &Linear...", MENU_SAVE_LINEAR, filemenu,KEY_L, MODIFIER_COMMAND
CreateMenu "Save &Radial...", MENU_SAVE_RADIAL, filemenu,KEY_R, MODIFIER_COMMAND
CreateMenu "", 0, filemenu
CreateMenu "E&xit", MENU_EXIT, filemenu, KEY_F4, MODIFIER_COMMAND

Local batchmenu:TGadget = CreateMenu("&Batch", 0, WindowMenu(Window))
CreateMenu "&Process Batch...", MENU_PROCESS_BATCH, batchmenu, KEY_P, MODIFIER_COMMAND

Local helpmenu:TGadget = CreateMenu("&Help", 0, WindowMenu(Window))
CreateMenu "&About...", MENU_ABOUT, helpmenu, KEY_F1

UpdateWindowMenu Window

Panel_S = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Source:")
Panel_RL = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Linear:")
Panel_RR = CreatePanel(0, 0, 0, 0, Window, PANEL_ACTIVE | PANEL_GROUP, "Radial:")
Panel_T:TGadget = CreatePanel(0, 0, 0, 0, Window, PANEL_GROUP, "Tiled Result:")

SetGadgetFont Panel_S, fontb
SetGadgetFont Panel_RL, fontb
SetGadgetFont Panel_RR, fontb
SetGadgetFont Panel_T, fontb

placeGadgets()

BatchWindow = CreateWindow("Process Batch", GadgetX(Window) + 100, GadgetY(Window) + 100, 500, 400, Window, WINDOW_TITLEBAR)
HideGadget BatchWindow

Local browse_wid:Int = 20

BatchLbl1 = CreateLabel("Source folder: ", BORDER, BORDER, 80, 25, BatchWindow)

BatchTxt1 = CreateTextField(BatchLbl1.width + BORDER * 2, BORDER, ClientWidth(BatchWindow) - BatchLbl1.width - BORDER - browse_wid - (BORDER * 3), 25, BatchWindow)
BatchBtn1 = CreateButton("...", GadgetX(BatchTxt1) + BatchTxt1.width + BORDER, BORDER, browse_wid, 20, BatchWindow)
BatchBtn2 = CreateButton("Linear Mask", BORDER, GadgetY(BatchLbl1) + BatchLbl1.height + BORDER + BORDER, 120, 20, BatchWindow, BUTTON_CHECKBOX)
BatchBtn3 = CreateButton("Radial Mask", BORDER, GadgetY(BatchBtn2) + BatchBtn1.height + BORDER, 120, 20, BatchWindow, BUTTON_CHECKBOX)
BatchLbl2 = CreateLabel("", GadgetX(BatchBtn2) + BatchBtn2.width + BORDER, GadgetY(BatchLbl1) + BatchLbl1.height + BORDER + BORDER, 80, 25, BatchWindow)
BatchLbl3 = CreateLabel("", GadgetX(BatchBtn3) + BatchBtn3.width + BORDER, GadgetY(BatchLbl2) + BatchLbl2.height + BORDER, 80, 25, BatchWindow)
BatchLbl4 = CreateLabel("Log:", BORDER, GadgetY(BatchLbl3) + BatchBtn3.height + BORDER + BORDER, 50, 20, BatchWindow)
BatchTxtA1 = CreateTextArea(BORDER, GadgetY(BatchLbl4) + BatchLbl4.height + BORDER + BORDER, ClientWidth(BatchWindow) - (BORDER * 2), 200, BatchWindow, TEXTAREA_READONLY)
BatchBtnGo = CreateButton("Go", BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER, 20, BatchWindow)
BatchBtnClose = CreateButton("Close", GadgetX(BatchBtnGo) + BatchBtnGo.width + BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER - BORDER, 20, BatchWindow)
BatchBtnStop = CreateButton("Stop", GadgetX(BatchBtnGo) + BatchBtnGo.width + BORDER, GadgetY(BatchTxtA1) + BatchTxtA1.height + BORDER + BORDER, ClientWidth(BatchWindow) / 2 - BORDER - BORDER, 20, BatchWindow)
HideGadget BatchBtnStop

EndMethod

Method placeGadgets()

Local panelsize:Int = (ClientHeight(Window) / 3) - BORDER

SetGadgetShape Panel_S, BORDER, BORDER, panelsize, panelsize
SetGadgetShape Panel_RL, BORDER, (Panel_S.height + BORDER) + 2, panelsize, panelsize
SetGadgetShape Panel_RR, BORDER, (Panel_RL.height + Panel_RL.height + BORDER) + 2, panelsize, panelsize

SetGadgetShape Panel_T, (Panel_S.width + (BORDER * 2)), BORDER, (ClientWidth(Window) - GadgetWidth(PANEL_S) - (3 * BORDER)), (ClientHeight(Window) - (2 * BORDER))

EndMethod

Method changeSource()

Local filter:String = "Image Files:png,jpg,tga,bmp; All Files:*"
Local filename:String = RequestFile("Load image file:", filter)
If filename <> ""
SetPointer POINTER_WAIT
SetStatusText Window, "Processing. Please wait..."
Local loadresult:Int = calcTiles(filename)
If Not loadresult Then Notify "Error: Could not load file."
SetStatusText Window, ""
SetPointer POINTER_DEFAULT
EndIf

EndMethod

Method calcTiles:Int(url:String = "")

Local newpm_s:TPixmap = LoadPixmap(url)

If Not newpm_s Then Return False Else Pm_S = newpm_s

If (Pm_S.format <> PF_RGBA8888) Then Pm_S = ConvertPixmap(Pm_S, PF_RGBA8888)

Pm_RL = createSeamlessTile(Pm_S, MASK_LINEAR)
Pm_RR = createSeamlessTile(Pm_S, MASK_RADIAL)

SetPanelPixmap Panel_S, Pm_S, PANELPIXMAP_FIT
SetPanelPixmap Panel_RL, Pm_RL, PANELPIXMAP_FIT
SetPanelPixmap Panel_RR, Pm_RR, PANELPIXMAP_FIT

tileTile(0)

'** Force a redraw
HideGadget Panel_S
ShowGadget Panel_S
HideGadget Panel_RL
ShowGadget Panel_RL
HideGadget Panel_RR
ShowGadget Panel_RR
'*****************

Return True

EndMethod

Method saveLinear()

Local filter:String = "PNG Files:png; All Files:*"
Local filename:String = RequestFile("Save PNG image file:", filter, True)
If ((filename) And (pm_RL <> Null)) Then SavePixmapPNG(Pm_RL, filename, 9)

EndMethod

Method saveRadial()

Local filter:String = "PNG Files:png; All Files:*"
Local filename:String = RequestFile("Save PNG image file:", filter, True)
If ((filename) And (pm_RR <> Null)) Then SavePixmapPNG(Pm_RR, filename, 9)

EndMethod

Method tileTile(ct:Int = 0)

Select ct

Case 0
SetGadgetText Panel_T, "Tiled Source:"
SetPanelPixmap Panel_T, Pm_S, PANELPIXMAP_TILE

Case 1
SetGadgetText Panel_T, "Tiled Linear:"
SetPanelPixmap Panel_T, Pm_RL, PANELPIXMAP_TILE

Case 2
SetGadgetText Panel_T, "Tiled Radial:"
SetPanelPixmap Panel_T, Pm_RR, PANELPIXMAP_TILE

EndSelect

'** Force a redraw
HideGadget Panel_T
ShowGadget Panel_T
'*****************

EndMethod

Method processBatch()

DoStopBatch = False

SetGadgetText BatchTxtA1, ""
DisableGadget BatchBtnGo
HideGadget BatchBtnClose
ShowGadget BatchBtnStop

Local srcurl:String = GadgetText(BatchTxt1)
Local files:String[] = LoadDir(srcurl)

If files.length <= 0
Notify "The specified source folder is invalid or empty."
EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose
Return
EndIf

If Not (ButtonState(BatchBtn2) Or ButtonState(BatchBtn3))
Notify "No mask selected."
EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose
Return
EndIf

Local linear:String = "linear"
Local lin:Int = False
Local radial:String = "radial"
Local rad:Int = False
Local logtext:String = ""

ChangeDir srcurl

If ButtonState(BatchBtn2)
lin = CreateDir(linear)
If lin
logtext :+ srcurl + "" + linear + " folder ready.~n"
Else
logtext :+ "ERROR: " + srcurl + "" + linear + " folder could NOT be prepared.~n"
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext

If ButtonState(BatchBtn3)
rad = CreateDir(radial)
If rad
logtext :+ srcurl + "" + radial + " folder ready.~n"
Else
logtext :+ "ERROR: " + srcurl + "" + radial + " folder could NOT be prepared.~n"
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext

For Local t:String = EachIn files

PollSystem

If DoStopBatch
logtext :+ "~n Processing HALTED by user."
SetGadgetText BatchTxtA1, logtext
Exit
EndIf

If (FileType(t) = FILETYPE_FILE)

logtext :+ "Processing " + t + "..."
SetGadgetText BatchTxtA1, logtext
PollSystem

Local srcpm:TPixmap = LoadPixmap(t)

If Not srcpm

logtext :+ " Unsupported image format.~n"

Else

Local pm:TPixmap
If (srcpm.format <> PF_RGBA8888) Then srcpm = ConvertPixmap(srcpm, PF_RGBA8888)

If (lin)
Local newname:String = linear + "" + StripExt(t) + ".png"
If FileType(newname) = 0 'Create the file only if it does not already exist
pm = createSeamlessTile(srcpm, MASK_LINEAR)
SavePixmapPNG(pm, newname, 9)
logtext :+ " Linear tile created."
Else
logtext :+ " Linear tile already exists."
EndIf
EndIf

SetGadgetText BatchTxtA1, logtext
PollSystem

If DoStopBatch
logtext :+ "~n~n*** Processing HALTED by user. ***"
SetGadgetText BatchTxtA1, logtext
Exit
EndIf

If (rad)
Local newname:String = radial + "" + StripExt(t) + ".png"
If FileType(newname) = 0 'Create the file only if it does not already exist
pm = createSeamlessTile(srcpm, MASK_RADIAL)
SavePixmapPNG(pm, newname, 9)
logtext :+ " Radial tile created."
Else
logtext :+ " Radial tile already exists."
EndIf
EndIf

logtext :+ "~n"

EndIf

SetGadgetText BatchTxtA1, logtext

EndIf
Next

If Not DoStopBatch
logtext :+ "~n*** Processing COMPLETED. ***"
SetGadgetText BatchTxtA1, logtext
EndIf

EnableGadget BatchBtnGo
HideGadget BatchBtnStop
ShowGadget BatchBtnClose

EndMethod

EndType


'*************** SEAMLESS TILE FUNCTION AND RELATED CONSTANTS *************************************


Const MASK_LINEAR:Int = 0
Const MASK_RADIAL:Int = 1

Function createSeamlessTile:TPixmap(src:TPixmap, masktype:Int = MASK_LINEAR)

'src: Source pixmap texture. Format should be PF_RGBA8888.
'masktype: Mask type. MASK_LINEAR or MASK_RADIAL. Some textures tile better using a different mask.
'Returns a new 'tileable' pixmap.

Local outp:TPixmap = CreatePixmap(src.width, src.height, src.format)
Local diag:TPixmap = CreatePixmap(src.width, src.height, src.format)

Local temp:TPixmap = PixmapWindow(src, 0, 0, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, (src.width / 2) + x, (src.height / 2) + z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, src.width / 2, src.height / 2, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, x, z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, src.width / 2, 0, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, x, (src.height / 2) + z, ReadPixel(temp, x, z)
Next
Next

temp = PixmapWindow(src, 0, src.height / 2, src.width / 2, src.height / 2)

For Local x:Int = 0 To temp.width - 1
For Local z:Int = 0 To temp.height - 1
WritePixel diag, (src.width / 2) + x, z, ReadPixel(temp, x, z)
Next
Next

Local masksize:Int
If (src.width > src.height) Then masksize = src.width Else masksize = src.height

Local mask:TPixmap = CreatePixmap(masksize, masksize, PF_RGB888)

For Local x:Int = 0 To masksize / 2
For Local z:Int = 0 To masksize / 2

Local d:Float = 0.0

If masktype = MASK_RADIAL
d = Sqr((x - (masksize / 2)) * (x - (masksize / 2)) + (z - (masksize / 2)) * (z - (masksize / 2))) / (masksize / 2)
Else
If masktype = MASK_LINEAR
d = Max(Float((masksize / 2) - x), Float((masksize / 2) - z)) / Float(masksize / 2)
EndIf
EndIf

d = 255 - (255 * d)

If d < 1 Then d = 1
If d > 255 Then d = 255

WritePixel mask, x, z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, x, (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, (masksize - 1 - x), z, Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))
WritePixel mask, (masksize - 1 - x), (masksize - 1 - z), Int(Byte(d) Shl 16 | Byte(d) Shl 8 | Byte(d))

Next
Next

mask = ResizePixmap(mask, src.width, src.height)

For Local z:Int = 0 To src.height - 1
For Local x:Int = 0 To src.width - 1

Local a1:Float = Float(Byte(ReadPixel(mask, x, z) Shr 16))
Local a2:Float = Float(Byte(ReadPixel(mask, ((x + src.width / 2) Mod src.width), ((z + src.height / 2) Mod src.height)) Shr 16))

Local px1:Int = ReadPixel(src, x, z)
Local px1a:Byte = px1 Shr 24
Local px1b:Byte = px1 Shr 16
Local px1g:Byte = px1 Shr 8
Local px1r:Byte = px1

Local px2:Int = ReadPixel(diag, x, z)
Local px2a:Byte = px2 Shr 24
Local px2b:Byte = px2 Shr 16
Local px2g:Byte = px2 Shr 8
Local px2r:Byte = px2

Local pxRa:Byte = px1a
Local pxRb:Byte = (a1 * (px1b / (a1 + a2))) + (a2 * (px2b / (a1 + a2)))
Local pxRg:Byte = (a1 * (px1g / (a1 + a2))) + (a2 * (px2g / (a1 + a2)))
Local pxRr:Byte = (a1 * (px1r / (a1 + a2))) + (a2 * (px2r / (a1 + a2)))
Local pxR:Int = Int(pxRa Shl 24 | pxRb Shl 16 | pxRg Shl 8 | pxRr)

WritePixel outp, x, z, pxR

Next
Next

Return outp

EndFunction


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal