Simple Palette Swapper - BlizMax-NG MaxGUI

[_PJ_]

In a separate project, I had required the functionality to swap pixel colours of some 2D sprite images. To get this working I made a small test program - so I figured that maybe, in case this was helpful to anyone else, I could polish up the test program, give it a UI and share it:

Thanks to @Sledge and @Midimaster for their help in https://www.syntaxboom.com/forum/index.php?topic=155.msg1309

Code Select Expand

Import MaxGUI.drivers
Const APP:String="Palette Swapper"

Global HWND:TGadget
Global OPENBUTTON:TGadget
Global SAVEBUTTON:TGadget
Global PREVIEW_WND:TGadget
Global PREVIEW_PNL:TGadget
Global PALETTEITEMLIST:TList

Global SaveMenu:TGadget
Global ImportMenu:TGadget
Global ExportMenu:TGadget

Initialise
Runtime

Function Runtime()
	Repeat
		WaitEvent
		
		Select EventID()
			Case EVENT_GADGETACTION
				Select EventSource()
					Case OPENBUTTON
						OpenEvent
					Case SAVEBUTTON
						If (TPalette.Current<>Null)
							SaveEvent
						End If
					Default
						SwapPixelButtonAction(TGadget(EventSource()))
						SetPanelPixmap(PREVIEW_PNL,TPalette.Current.Pix,PANELPIXMAP_STRETCH)	
						RedrawGadget(PREVIEW_PNL)
						RedrawGadget(PREVIEW_WND)
					End Select

			Case EVENT_MENUACTION
				Select (EventData())
					Case 1
						OpenEvent
					Case 2
						SaveEvent
					Case 3
						ImportEvent
					Case 4
						ExportEvent						
				End Select	

			Case EVENT_WINDOWCLOSE
			Exit
		End Select
	Forever
	End
End Function

Function Initialise()
	AppTitle = APP

	HWND:TGadget=CreateWindow(APP,0,0,1024,768,Null,WINDOW_TITLEBAR|WINDOW_CENTER|WINDOW_MENU)
	OPENBUTTON:TGadget=CreateButton("Open",0,ClientHeight(HWND)-24,64,24,HWND)
	SAVEBUTTON:TGadget=CreateButton("Save",ClientWidth(HWND)-64,ClientHeight(HWND)-24,64,24,HWND)
	
	Local File:TGadget=CreateMenu("File",0,WindowMenu(HWND))
	CreateMenu("Open",1,File)
	SaveMenu:TGadget=CreateMenu("Save",2,File)
	
	ImportMenu:TGadget=CreateMenu("Import",3,File)
	ExportMenu:TGadget=CreateMenu("Export",4,File)

	DisableMenu SaveMenu
	DisableGadget SAVEBUTTON
	DisableMenu ImportMenu
	DisableMenu ExportMenu

	UpdateWindowMenu(HWND)
	RedrawGadget(HWND)
End Function

Function ExportEvent()
	Local URL:String=RequestFile("Export SwapData","SwapData File:swd;",True,CurrentDir())
	If (URL="") Then Return
	
	Local File:TStream=WriteFile(URL)
	
	If (File=Null) 
		Return
	Else
		For Local Iter:TRecord=EachIn TPALETTE.Current.SWAPRECORD
			File.WriteInt(Iter.FromPixel)
			File.WriteInt(Iter.ToPixel)
		Next
		CloseFile File
		
		If FileType(URL) Then Notify("Export Succeeded")
			
	End If
End Function

Function ImportEvent()
	Local URL:String=RequestFile("Select SwapData","SwapData File:swd")
	
	If ((FileExists(URL)) And (URL<>""))
		Local File:TStream=ReadFile(URL)
		
		If (File=Null)
			Notify("Import Failed")
			Return
		End If	
					
		If (TPalette.Current<>Null)
			If (TPALETTE.Current.SWAPRECORD<>Null)
				For Local Iter:TRecord=EachIn TPALETTE.Current.SWAPRECORD
					If (Iter<>Null)
						Iter.FromPixel=Null
						Iter.ToPixel=Null
						Iter=Null
					End If
					ClearList(TPALETTE.Current.SWAPRECORD)
				Next
			Else
				TPalette.Current.SWAPRECORD=New TList
			End If
		Else
			Return
		End If
	
		EnableGadget(SAVEBUTTON)
		
		DisableMenu(ExportMenu)
		DisableMenu(ImportMenu)
		EnableMenu(SaveMenu)
		
		While Not Eof(File)
			Local FP:Int=File.ReadInt()
			Local TP:Int=File.ReadInt()
			
			'Add to SwapRecord list			
			Local Rec:TRecord=New TRecord
			Rec.FromPixel = FP
			Rec.ToPixel = TP			
		
			TPALETTE.Current.SWAPRECORD.Addlast(Rec)
						
			'Update pixels in image		
			For Local Y:Int= 0 Until TPALETTE.Current.Pix.height
				For Local X:Int= 0 Until TPALETTE.Current.Pix.width
					Local Pixel:Int=TPALETTE.Current.Pix.ReadPixel(X,Y)
					
					If (Pixel=FP) Then TPALETTE.Current.Pix.WritePixel(X,Y,TP)
					
				Next
			Next

			
		Wend
		If (FileSize(URL)>0) Then EnableMenu(ExportMenu)
						
		'Recreate Palette
		TPalette.ReCreatePalette()
		
		SetPanelPixmap(PREVIEW_PNL,TPALETTE.Current.Pix,PANELPIXMAP_STRETCH)
								
		RedrawGadget(PREVIEW_PNL)
		RedrawGadget(PREVIEW_WND)
	End If
End Function

Function OpenEvent()
	Local URL:String=RequestFile("Select Image","Image Files:png,jpg,bmp")
	If (FileExists(URL))
		ClearWindow()	
					
		If (PALETTEITEMLIST=Null) Then PALETTEITEMLIST=New TList
		
		Local P:TPalette=TPalette.GeneratePaletteFromImage(URL)
					
		If (P<>Null)
		
			P.DisplayPalette
				
			If (PREVIEW_WND=Null)						
				PREVIEW_WND=CreateWindow("Preview",0,0,P.Pix.width,P.Pix.height+32,HWND,WINDOW_TOOL|WINDOW_TITLEBAR|WINDOW_CENTER)
				PREVIEW_PNL=CreatePanel(0,0,P.Pix.width,P.Pix.height,PREVIEW_WND)
			Else
				SetPanelPixmap(PREVIEW_PNL,Null,PANELPIXMAP_STRETCH)
			End If
							
			SetGadgetShape(PREVIEW_WND,GadgetX(PREVIEW_WND),GadgetY(PREVIEW_WND),P.Pix.width,P.Pix.height+32)	
			SetGadgetShape(PREVIEW_PNL,GadgetX(PREVIEW_PNL),GadgetY(PREVIEW_PNL),P.Pix.width,P.Pix.height)
							
			SetGadgetLayout(PREVIEW_PNL,EDGE_ALIGNED,EDGE_RELATIVE,EDGE_ALIGNED,EDGE_RELATIVE)
							
			SetPanelPixmap(PREVIEW_PNL,P.Pix,PANELPIXMAP_STRETCH)
								
			RedrawGadget(PREVIEW_PNL)
			RedrawGadget(PREVIEW_WND)
						
			DisableMenu SaveMenu
			DisableMenu ExportMenu		
			EnableMenu ImportMenu			
			DisableGadget SAVEBUTTON
								
		End If
	End If
End Function

Function UpdateAllPixelsOfSpecificColour(Pixel:TPixelObject,NewColour:Int)
	For Local Coord:TCoords=EachIn Pixel.CoordinateList
		TPalette.Current.Pix.WritePixel(Coord.X,Coord.Y,NewColour)
	Next
End Function

Function SaveEvent()
	Local URL:String=RequestFile("Save PNG Spritesheet","Portable Network Graphic:png;",True,TPalette.Current.URL)
	If (URL="") Then Return
	
	SavePixmapPNG(TPalette.Current.Pix,URL,9)
	
	If (FileExists(URL))
		TPalette.Current.URL=URL
		
		DisableMenu SaveMenu
		DisableGadget SAVEBUTTON
	End If
	
End Function

Function SwapPixelButtonAction( Gadget:TGadget )
	Local Ex:TPixelObject=TPixelObject(GadgetExtra(Gadget))
	Local ActualPixelColour:Int=Ex.Pixel
		
		
	Local pA:Int=(ActualPixelColour Shr 24) & 255
	Local pR:Int=(ActualPixelColour Shr 16) & 255
	Local pG:Int=(ActualPixelColour Shr 8) & 255
	Local pB:Int=(ActualPixelColour Shr 0) & 255
					
	If (RequestColor(pR,pG,pB))				
		pR=RequestedRed() & 255
		pG=RequestedGreen() & 255
		pB=RequestedBlue() & 255
				
		'Update Palette display buttons
		SetGadgetColor(Gadget,pR,pG,pB)
		RedrawGadget Gadget
			
		Local UpdatedColour:Int=pA Shl 24|pR Shl 16|pG Shl 8|pB Shl 0
					
		UpdateAllPixelsOfSpecificColour(Ex,UpdatedColour)
		
		'Update actual palette data reference in memory
		Ex.Pixel=UpdatedColour
						
		'SetPanelPixmap(PREVIEW_PNL,TPalette.Current.Pix,PANELPIXMAP_STRETCH)	
		'RedrawGadget(PREVIEW_PNL)
		'RedrawGadget(PREVIEW_WND)
	
		EnableMenu SaveMenu
		DisableMenu ImportMenu
		EnableGadget ExportMenu
		EnableGadget SAVEBUTTON
		
		If (TPalette.Current.SWAPRECORD=Null) Then TPalette.Current.SWAPRECORD=New TList
						
		Local Rec:TRecord = New TRecord
		Rec.FromPixel=ActualPixelColour
		Rec.ToPixel=UpdatedColour
		TPalette.Current.SWAPRECORD.AddLast(Rec)
					
	End If
End Function

Function ClearWindow()
	If (PALETTEITEMLIST<>Null)
		For Local Iter:TGadget=EachIn PALETTEITEMLIST
			If (Iter<>Null)
				ListRemove(PALETTEITEMLIST,Iter)
				FreeGadget(Iter)
			End If		
		Next
	End If
End Function

Type TPalette
	Const SWATCHSIZE:Int=32
	Global Current:TPalette
	
	Field SWAPRECORD:TList
	
	Field Pix:TPixmap
	Field PixelList:TList
	Field URL:String
	
	Function ReCreatePalette()
		If (Current<>Null)				
			For Local PO:TPixelObject=EachIn Current.PixelList
				If (PO.CoordinateList<>Null)
					For Local C:TCoords=EachIn PO.CoordinateList
						C.X=Null
						C.Y=Null
						C=Null
					Next
					ClearList(PO.CoordinateList)
				End If
				PO=Null
			Next
			ClearList(Current.PixelList)	
		End If
		
		ClearWindow()
									
		For Local Y:Int= 0 Until Current.Pix.height
			For Local X:Int= 0 Until Current.Pix.width
				Local Pixel:Int=Current.Pix.ReadPixel(X,Y)
				
				Local pA:Int=(Pixel Shr 24) & 255
				If (PA>0) Then Current.AddPixel(Pixel,X,Y)'Ignore transparent
			Next
		Next
		
		Current.DisplayPalette()
	End Function
	
	Function GeneratePaletteFromImage:TPalette(ImageURL:String)
		Local Pixmap:TPixmap=LoadPixmap(ImageURL)
		If (Pixmap=Null) Then Return Null
		
		If (TPalette.Current<>Null)
			If (TPALETTE.Current.SWAPRECORD<>Null)
				For Local Iter:TRecord=EachIn TPALETTE.Current.SWAPRECORD
					If (Iter<>Null)
						Iter.FromPixel=Null
						Iter.ToPixel=Null
						Iter=Null
					End If
					ClearList(TPALETTE.Current.SWAPRECORD)
				Next
			End If
				
			For Local PO:TPixelObject=EachIn Current.PixelList
				If (PO.CoordinateList<>Null)
					For Local C:TCoords=EachIn PO.CoordinateList
						C.X=Null
						C.Y=Null
						C=Null
					Next
				End If
				PO=Null
			Next
			
			TPalette.Current.Pix=Null
			TPalette.Current.URL=""
			TPalette.Current=Null
		End If
		
		Local P:TPalette=New TPalette
		
		P.PixelList=New TList
		P.URL=ImageURL
		P.Pix=Pixmap		
				
		For Local Y:Int= 0 Until P.Pix.height
			For Local X:Int= 0 Until P.Pix.width
				Local Pixel:Int=P.Pix.ReadPixel(X,Y)
				
				Local pA:Int=(Pixel Shr 24) & 255
				If (PA>0) Then P.AddPixel(Pixel,X,Y)'Ignore transparent
			Next
		Next
		TPalette.Current=P
		Return P
	End Function
	
	Method AddPixel(RGBa:Int,X:Int,Y:Int)
		Local Found:Byte=False
		Local ThisPO:TPixelObject
		
		For Local PO:TPixelObject = EachIn Self.PixelList
			If (PO.Pixel=RGBa)
				Found=True
				ThisPO=PO
				Exit
			End If
		Next
		
		If (Not(Found))
			ThisPO:TPixelObject=New TPixelObject
			ThisPO.Pixel=RGBa
			ThisPO.CoordinateList=New TList
			Self.PixelList.Addlast(ThisPO)
		End If
		
		Local Coord:TCoords=New TCoords
		Coord.X=X
		Coord.Y=Y	
		ThisPO.CoordinateList.AddLast(Coord)
	End Method
	
	Method DisplayPalette()
		Local W:Int=HWND.width / SWATCHSIZE
		Local H:Int=HWND.height / SWATCHSIZE
			
		Local Count:Int=Self.PixelList.Count()
		
		For Local Iter:Int=1 To Count	
			Local X:Int=Iter Mod W
			Local Y:Int=Int(Floor(Iter / H))
			
			Local PO:TPixelObject=TPixelObject(Self.PixelList.ValueAtIndex(Iter-1))
			
			Local pA:Int=(PO.Pixel Shr 24) & 255
			Local pR:Int=(PO.Pixel Shr 16) & 255
			Local pG:Int=(PO.Pixel Shr 8) & 255
			Local pB:Int=(PO.Pixel Shr 0) & 255
					
			Local Button:TGadget=CreateButton("",X*SWATCHSIZE,Y*SWATCHSIZE,SWATCHSIZE-1,SWATCHSIZE-1,HWND)
			
			SetGadgetColor(Button, pR, pG, pB)
			SetGadgetExtra(Button,PO)
			
			PALETTEITEMLIST.AddLast(Button)		
					
		Next
	End Method	
End Type

Type TRecord
	Field FromPixel:Int
	Field ToPixel:Int
End Type

Type TPixelObject
	Field Pixel:Int
	Field CoordinateList:TList
End Type

Type TCoords
	Field X:Int
	Field Y:Int
End Type

[Midimaster]

Are you interested in optimizing/shortening your code? There are far to many expressions in your type related code lines.

I could give you some advise. Shortening may improve performance of your algo!

[_PJ_]

Hi Midimaster,
Thanks very much for the kind offer, but I think it's fine.
It's such a 'simple' program that I don't think there's any problem with the speed. It is also noice for me to have it clear and each function is explicit to allow for it to be modifiable.

For example, I have just now added better functionality for Import/Export of "palette swap data" so you can apply the same swap to multiple files

_

I am always open to general advice, though so if there's any "good practice"  tips, I am extremely grateful!

[Steve Elliott]

@ Midimaster why not post it anyway for education purposes?