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.
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".