Code archives/Graphics/Seamless Tiles

This code has been declared by its author to be Public Domain code.

Download source code

Seamless Tiles by impixi
(Posted 20 years ago)
Create a seamless tile pixmap from a source pixmap
Rem
	Seamless Texture Tiling Example
	
	ORIGINAL AUTHOR (Article and C Code):
		Paul Bourke
		January 2000
	http://local.wasp.uwa.edu.au/~pbourke/texture/tiling/
			
	REQUIREMENTS:
		BlitzMax 1.22
		Windows XP (Linux and MacOS untested)
		
	PURPOSE:
		Create a seamless 'tile' pixmap from a source pixmap
		
EndRem

SuperStrict

AppTitle = "Seamless Texture Tiling Example"

Graphics 1024, 768
SetBlend SOLIDBLEND

Local tex:TPixmap = LoadPixmap("tex.png")	'<--- Provide your own texture for this example. <---

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

Local tile:TPixmap = createSeamlessTile(tex, MASK_RADIAL)

Local img:TImage = LoadImage(tile)

SetClsColor 255, 255, 255

While Not KeyHit(KEY_ESCAPE)

	Cls

	SetViewport 0, 0, GraphicsWidth(), GraphicsHeight()

	DrawText "Source:", 2, 2
	DrawPixmap tex, 2, 22
	
	DrawText "Result:", 2, tex.height + 42
	DrawPixmap tile, 2, tex.height + 62

	DrawText "Tiled Result:", tex.width + 20, 2
	SetViewport tex.width + 20, 22, GraphicsWidth() - tex.width - 22, GraphicsHeight() - 26
	TileImage img
			
	Flip 1

Wend

End


'*************** 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

Comments

Booticus
(Posted 20 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:

http://www.injuryupdate.com.au/issues/grass_types.php

but other than that its a killer bit of code, thanks!

impixi
(Posted 20 years ago)
EDIT: Removed dead links.

Plantagenet
(Posted 20 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 20 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.


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 19 years ago)
Here's the latest version of Ultra Simple Seamless Tiler 1.01, to be compiled against maxgui.mod revision 29:

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


Code Archives Forum