Here are the procedures you will need.
I have modified them so they are not dependent on the larger program.
The code here is a complete working example with the exception of the include file which you can
Code: Select all
EnableExplicit
XIncludeFile "NearestColorModule.pbi" ; http://www.purebasic.fr/english/viewtopic.php?f=12&t=61475
UsePNGImageDecoder()
UseJPEGImageDecoder()
Declare POPULARITY_PALETTE(ImgRef.i,limit.i)
Declare SCAN_FOR_PALETTE(image.i)
Declare SHOW_PALETTE(Array palette.l(1))
Declare COUNT_COLORS(image.i)
Declare ASSEMBLE_TO_PALETTE(Array palette.l(1), ImgRef.i, dither.i)
#WinMain = 0
#WinPalette = 1
Structure PopType ; used in POPULARITY_PALETTE()
clr.l ; color
pop.i ; popularity
EndStructure
Global Dim WK_Pal.l(0) ;POPULARITY_PALETTE() fills this array
Define.i w,h,Qimage
Define.i limit = 32 ; the maximum number of colors in the result
Define.i dither = #True
Define.i ImgRef = LoadImage(#PB_Any,"TestImage.png") ;<-- edit path and filename as required
If ImgRef : w = ImageWidth(ImgRef) : h = ImageHeight(ImgRef)
If OpenWindow(#WinMain,0,0,w,h,"Example",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
If POPULARITY_PALETTE(ImgRef, limit) ;generate the palette
Qimage = ASSEMBLE_TO_PALETTE(WK_Pal(), ImgRef, dither) ;build the final image
If IsImage(Qimage)
ImageGadget(#PB_Any,0,0,w,h,ImageID(Qimage)) ;display the result
SCAN_FOR_PALETTE(Qimage) ; show the palette in a separate window
EndIf
EndIf
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
EndIf
End
; ****************************************************************************************
Procedure POPULARITY_PALETTE(ImgRef.i,limit.i)
; Create a color palette with a modified popularity approach.
; ImgRef = the source image.
; Limit = the maximum number of colors in result.
; Limit count can be specified from 2 to 256. (256 is arbitrary limit)
; Required support procedures are:
; 'COUNT_COLORS', and 'ASSEMBLE_TO_PALETTE'.
; Finished palette is placed in the global array WK_Pal().
; This algorithm was created by BasicallyPure.
Static.i kb = $FF0000, kg = $00FF00, kr = $0000FF
Protected.i ImgWork, count, Xmin,Ymin,Xmax, Ymax, i, x, y, lum, d, br, da, mb, md
Macro BMSK(mask) ; simple bitmask color reduction method
StartDrawing(ImageOutput(ImgWork))
For y = Ymin To yMax
For x = Xmin To xMax
Plot(x, y, Point(x,y) & mask | $0F0F0F)
Next x
Next y
StopDrawing()
EndMacro
If IsImage(ImgRef)
ImgWork = CopyImage(ImgRef,#PB_Any)
If ImgWork
count = COUNT_COLORS(ImgWork)
If count <= limit : limit = count : EndIf
Else
ProcedureReturn 0
EndIf
Else
ProcedureReturn 0
EndIf
; 1) preprocess colors using BitMask method, color count will
; be greatly reduced.
Xmax = ImageWidth(ImgWork) - 1
Ymax = ImageHeight(ImgWork) - 1
If limit < 48
BMSK($C0C0C0) ; _64 possible
count = COUNT_COLORS(ImgWork)
Else
count = 0
EndIf
If count < (limit + 10) ; need more colors to work with
If IsImage(ImgWork) : FreeImage(ImgWork) : EndIf
ImgWork = CopyImage(ImgRef,#PB_Any)
BMSK($E0E0E0) ; _512 possible
count = COUNT_COLORS(ImgWork)
If count < (limit + 10) ; need still more colors
If IsImage(ImgWork) : FreeImage(ImgWork) : EndIf
ImgWork = CopyImage(ImgRef,#PB_Any)
BMSK($F0F0F0) ; _4096 possible
EndIf
EndIf
; 2) gather popularity data
NewMap Pmap.i()
StartDrawing(ImageOutput(ImgWork))
For y = Ymin To Ymax
For x = Xmin To Xmax
Pmap(Str(Point(x,y))) + 1
Next
Next
StopDrawing()
If MapSize(Pmap()) < limit : limit = MapSize(Pmap()) : EndIf
; 3) subdivide colors into 4 brightness lists
NewList bright.PopType()
NewList MedBri.PopType()
NewList MedDrk.PopType()
NewList dark.PopType()
ForEach Pmap()
d = Val(MapKey(Pmap()))
lum = (d & kr)<<1 + (d & kg) >> 6 + (d & kb) >> 16
If lum > 1338
AddElement(bright()) : bright()\clr = d : bright()\pop = Pmap()
ElseIf lum > 892
AddElement(MedBri()) : MedBri()\clr = d : MedBri()\pop = Pmap()
ElseIf lum > 446
AddElement(MedDrk()) : MedDrk()\clr = d : MedDrk()\pop = Pmap()
Else
AddElement(dark()) : dark()\clr = d : dark()\pop = Pmap()
EndIf
Next
; 4) sort each brightness lists by popularity
SortStructuredList(bright(),#PB_Sort_Descending,OffsetOf(PopType\pop),#PB_Integer)
SortStructuredList(MedBri(),#PB_Sort_Descending,OffsetOf(PopType\pop),#PB_Integer)
SortStructuredList(MedDrk(),#PB_Sort_Descending,OffsetOf(PopType\pop),#PB_Integer)
SortStructuredList(dark() ,#PB_Sort_Descending,OffsetOf(PopType\pop),#PB_Integer)
; 5) create the final palette
FirstElement(bright()) : br = ListSize(bright())
FirstElement(MedBri()) : mb = ListSize(MedBri())
FirstElement(MedDrk()) : md = ListSize(MedDrk())
FirstElement(dark()) : da = ListSize(dark())
limit - 1
ReDim WK_Pal(limit)
i = 0 : d = %00
Repeat ; pick from each list in turn the most popular color
If d = %00 And br > 0
WK_Pal(i) = bright()\clr
NextElement(bright())
i + 1 : br - 1
ElseIf d = %01 And da > 0
WK_Pal(i) = dark()\clr
NextElement(dark())
i + 1 : da - 1
ElseIf d = %10 And mb > 0
WK_Pal(i) = MedBri()\clr
NextElement(MedBri())
i + 1 : mb - 1
ElseIf d = %11 And md > 0
WK_Pal(i) = MedDrk()\clr
NextElement(MedDrk())
i + 1 : md - 1
EndIf
d = (d + %01) & %11
Until i > limit
If IsImage(ImgWork) : FreeImage(ImgWork) : EndIf
ProcedureReturn 1
EndProcedure
Procedure COUNT_COLORS(image.i)
; returns the number of unique colors in an image (24 bit)
Protected.i x, y, max_x, max_y, c, count, m
Dim m.a($1FFFFF)
StartDrawing(ImageOutput(image))
max_x = ImageWidth(image) - 1
max_y = ImageHeight(image) - 1
For y = 0 To max_y
For x = 0 To max_x
c = Point(x, y) & $FFFFFF
If m(c >> 3) & 1 << (c & 7) = 0
m(c >> 3) | 1 << (c & 7)
count + 1
EndIf
Next
Next
StopDrawing()
ProcedureReturn count
EndProcedure
Procedure ASSEMBLE_TO_PALETTE(Array palette.l(1), ImgRef.i, dither.i)
; assign each pixel of an image to the defined palette using NearestColor module
; ImgRef = the source image
; dither: 0 = no dither, 1 = dither
; A new image is created, the return value is the new image number.
NearestColor::CatchPalette(@palette(), ArraySize(palette())+1)
ProcedureReturn NearestColor::DitheredImage(ImgRef, dither*128)
EndProcedure
Procedure SCAN_FOR_PALETTE(image.i)
; obtain the palette of all colors used in an image
; stops if number of colors exceeds 288
Static NewMap Pmap.i(1024)
Static Dim Palette.l(0)
Protected c,i,x,y,Xmax,Ymax
Xmax = ImageWidth(image)-1
Ymax = ImageHeight(image)-1
StartDrawing(ImageOutput(image))
For y = 0 To Ymax
For x = 0 To Xmax
c = Point(x,y)
If MapSize(Pmap()) > 288
Break 2
EndIf
Pmap(Str(c)) = c
Next
Next
StopDrawing()
ReDim palette(MapSize(Pmap())-1)
i = 0
ForEach Pmap()
palette(i) = Pmap()
i + 1
Next
ClearMap(Pmap())
SHOW_PALETTE(Palette())
EndProcedure
Procedure SHOW_PALETTE(Array palette.l(1))
; draw the palette window
Static flags = #PB_Window_SystemMenu | #PB_Window_Tool | #PB_Window_ScreenCentered
Static imgGad, imgPalette
Protected c, i, x, y, columns, Xmax, Ymax, blockSize
Protected Imax = ArraySize(palette())
If IsWindow(#WinPalette) = 0
OpenWindow(#WinPalette,0,0,110,220,"",flags,WindowID(#WinMain))
imgGad = ImageGadget(#PB_Any,0,0,1,1,0)
EndIf
If Imax > 287 ; (12_columns * 24_rows) - 1
Imax = 287
SetWindowTitle(#WinPalette,"over!")
Else
SetWindowTitle(#WinPalette,Str(Imax+1)+" Palette")
EndIf
columns = Round(Sqr((Imax+1)/2),#PB_Round_Up)
blockSize = 112 / columns
Xmax = columns * blockSize
Ymax = Xmax * 2
If IsImage(imgPalette) = 0
imgPalette = CreateImage(#PB_Any,Xmax,Ymax,24,0)
Else
ResizeImage(imgPalette,Xmax,Ymax)
EndIf
StartDrawing(ImageOutput(imgPalette))
Xmax - 1 : Ymax - 1
For y = 0 To Ymax
For x = 0 To Xmax
c = (x ! y)
c = (c << 16) | (c << 8) | c
Plot(x, y, c | $C0C0C0)
Next
Next
X = 0 : Y = 0
For I = 0 To Imax
Box(X, Y, blockSize, blockSize, palette(I))
X + blockSize
If X > Xmax : X = 0 : Y + blockSize : EndIf
Next
StopDrawing()
SetGadgetState(imgGad,ImageID(imgPalette))
EndProcedure