Color Quantizing Image Editor

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Color Quantizing Image Editor

Post by SeregaZ »

any alternative url for download? mediafire is not open. and what it is? exe file, or sourse, or dll?

i have table with 512 constant colors. but output image can use only 15 from this 512. this project can do something like this?
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 536
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Color Quantizing Image Editor

Post by BasicallyPure »

SeregaZ, are you still having trouble with the download?
It seems to work for me.
The downloads for the latest version are all exe files.

From your description it sounds like what you need is wilbert's nearest color module.

edit: I see you have already found wilbert's module. :)
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Color Quantizing Image Editor

Post by SeregaZ »

it is bloody goverment's KGB do this. it block mediafire. but tru friGate CDN i am download right now fine. will see what it is.

nearest color fine, i am use that. but task a little dificult.

whole image into 512 from table, get 15 different colors from result, whole image into this 15. i am get first 15 - it is a little wrong. what if more intensive colors lay after first 15 unic colors? so i need some color sort procedure. any simple explanation how to do this sorting?

for example image have 23 unique colors after 512 repainting. i need make some sort and mix for make 15 from this 23. but mix can happen only into any of 512 colors, that is allow. not any color.

so for me it is a little dificult.
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 536
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Color Quantizing Image Editor

Post by BasicallyPure »

SeregaZ,
I have modified my 'Popularity_Palette()' example shown elsewhere in this topic so it may work for you.
This is a complete working example, just provide the path and file name of the image with 23 unique colors (your example).
It should work with any image that has 512 colors or less.
You can choose how many colors you want in the result, I have set the variable 'limit' to 15 but you can change it to anything <= 512.
The resulting palette will only consist of colors from the original image.
You will need a copy of wilbert's 'nearest color module' as an include file.

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() procedure
   clr.l ; color
   pop.i ; popularity
EndStructure

; ><><><><><><><><><><><><><>><><><> ATTENTION! <><><><><>><><><><><><><><><><><><><><>><><><><><>
Global Dim WK_Pal.l(0)  ; <--- this array will contain the final palette                        <>
Define.i limit = 15     ; <--- maximum number of colors in the result                           <>
Define.i dither = #True ; <--- dither yes or no                                                 <>
Define.i ImgRef = LoadImage(#PB_Any,"chicken_35.png") ;<--- edit path and filename as required  <>
; ><><><><><><><><><><><><><>><><><><><><><><><><><><><><>><><><><><><><><><><><><><><>><><><><><>

Define.i w,h,Qimage
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 512. (512 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
      
   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
   
   Xmax = ImageWidth(ImgWork) - 1
   Ymax = ImageHeight(ImgWork) - 1
   
   ; 1) if color count is > 512 color count will be reduced.
   ;    and palette colors may be altered.
   If count > 512
      ; simple bitmask color reduction method
      StartDrawing(ImageOutput(ImgWork))
         For y = Ymin To yMax
            For x = Xmin To xMax
               Plot(x, y, Point(x,y) & $E0E0E0 | $0F0F0F)
            Next x
         Next y
      StopDrawing()
   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 512
   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()) > 512
                  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,129,255,"",flags,WindowID(#WinMain))
      imgGad = ImageGadget(#PB_Any,0,0,1,1,0)
   EndIf
   
   If Imax > 511 ; (16_columns * 32_rows) - 1
      Imax = 511
      SetWindowTitle(#WinPalette,"over!")
   Else
      SetWindowTitle(#WinPalette,Str(Imax+1)+" Palette")
   EndIf
   
   columns = Round(Sqr((Imax+1)/2),#PB_Round_Up)
   blockSize = 126 / 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
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Post Reply