Based on code from Froggerpogger, I've written these procedures. Each of them takes in an RGB colour, translates it to HSL format then returns the H,S or L value. So, Luminosity() is as simple to use as Green().
To try and speed up the procedures, I've implemented a "memory bank". When an RGB is translated to HSL, it is added to an array structure so that it doesn't need to be translated again. This is sensible because you may call Saturation() and Hue() in succession for the same colour, so translating it twice would be ridiculous. A maximum of 100 colours can be stored in this array - then it begins re-translating and re-using slots. There may be a better way to do this, but I've never used Lists or Maps so can't tell.
So, ignoring the structures for now, the system works like this:
Code: Select all
Procedure.i TranslateRGBtoHSL(rgb.i)
// translation code
// ...
// ...
// save into memory bank code
// ...
// ...
; return bank slot number
ProcedureReturn slot
EndProcedure
Macro CheckTranslateRGBtoHSL(c)
slot = 0
// check for colour in the memory bank
//...
If Not slot ; colour isn't in the memory bank, so needs translating
slot = TranslateRGBtoHSL(c)
EndIf
EndMacro
Procedure.d Hue(c.i) ; saturation and luminosity work exactly the same
CheckTranslateRGBtoHSL(c)
ProcedureReturn hm\slot[slot]\hue
EndProcedureAdditionally, these functions are pretty useless without a way to convert back to RGB. (Then we can play in the HSL colourspace and still use PB's drawing functions.)
So using code by Froggerpogger I've made the procedure HSL(hue.i,sat.i,lum.i) which returns an RGB value. Again, combining H,S,L values into a usable RGB integer is as simple as combining R,G,B values with the RGB() function.
Now here's the complete code, including a demo program wherein 4 squares are drawn. Blue, yellow, green and red. A custom filter callback is used whereby yellow pixels are desaturated 75%.
Incidentally, the first 3 procedures in the code are standard proc's that I use in almost every program. RI() is especially useful for seeing how an image gets processed by the code you're working on - press Escape, Space or Return to close the image window once it appears.
Code: Select all
Procedure.d Beat(a.d,b.d)
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.d Defeat(a.d,b.d)
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure RI(img.i,title.s)
If Not IsImage(img)
MessageRequester("RI error","img is not an image!",0)
ProcedureReturn
EndIf
iw = ImageWidth(img)
ih = ImageHeight(img)
If Not title
title = "Report Image"
EndIf
win = OpenWindow(#PB_Any,0,0,iw,ih,title,#PB_Window_BorderLess|#PB_Window_ScreenCentered)
imgad = ImageGadget(#PB_Any,0,0,iw,ih,ImageID(img))
escapekey = 1
spacekey = 2
returnkey = 3
AddKeyboardShortcut(win,#PB_Shortcut_Escape,escapekey)
AddKeyboardShortcut(win,#PB_Shortcut_Space,spacekey)
AddKeyboardShortcut(win,#PB_Shortcut_Return,returnkey)
Repeat
we = WindowEvent()
If we
If we=#PB_Event_Menu
Break
EndIf
Else
Delay(10)
EndIf
ForEver
CloseWindow(win)
If free
FreeImage(img)
EndIf
EndProcedure
;-
;- INTO HSL STUFF
Structure hsl_slot
rgb.i
hue.d
sat.d
lum.d
EndStructure
#MaxHSLRems = 100
Structure HSL_MemBank
slot.hsl_slot[#MaxHSLRems+1]
useslot.i
highestused.i
EndStructure
Global hm.HSL_MemBank
Procedure.d Max3D(d1.d,d2.d,d3.d)
bd.d = d1
bd = Beat(bd,d2)
bd = Beat(bd,d3)
ProcedureReturn bd
EndProcedure
Procedure.d Min3D(d1.d,d2.d,d3.d)
bd.d = d1
bd = Defeat(bd,d2)
bd = Defeat(bd,d3)
ProcedureReturn bd
EndProcedure
Procedure.i TranslateRGBtoHSL(c.i)
PrintN("Translate begin @ "+Str(ElapsedMilliseconds()))
hm\useslot+1
If hm\useslot>#MaxHSLRems
hm\useslot=1
EndIf
hm\highestused = Beat(hm\useslot,hm\highestused)
m = hm\useslot
hm\slot[m]\rgb = c
hm\slot[m]\hue = 0
hm\slot[m]\sat = 0
hm\slot[m]\lum = 0
Select c
Case #Black
ProcedureReturn m
Case #Gray
hm\slot[m]\lum = 128
ProcedureReturn m
Case #White
hm\slot[m]\lum = 255
ProcedureReturn m
EndSelect
r.d = Red(c)
g.d = Green(c)
b.d = Blue(c)
max.d = Max3D(r,g,b)
min.d = Min3D(r,g,b)
delta.d = max - min
hue.d
sat.d
lum.d
; get lightness
lum = (max + min) / 2.0
; get saturation
If lum <= 0.5
sat = delta/(max+min)
Else
sat = delta/(2-max-min)
EndIf
; get hue
If r = max
hue = (g-b)/delta
ElseIf g = max
hue = 2.0 + (b-r)/delta
ElseIf b = max
hue = 4.0 + (r-g)/delta
EndIf
hue * 60.0
If hue<0.0
hue + 360.0
EndIf
hm\slot[m]\hue = hue
hm\slot[m]\sat = sat
hm\slot[m]\lum = lum
PrintN("Translate finished @ "+Str(ElapsedMilliseconds()))
ProcedureReturn m
EndProcedure
Macro CheckTranslateRGBtoHSL(c)
slot = 0
If hm\highestused>0 ; no point doing this search if no slots have been filled yet (no colours translated)
For a = 1 To hm\highestused
If hm\slot[a]\rgb = c
;printn "using old"
slot = a
Break
EndIf
Next a
EndIf
If Not slot
slot = TranslateRGBtoHSL(c)
PrintN("Stored in slot #"+Str(slot))
EndIf
EndMacro
Procedure.d Hue(c.i)
CheckTranslateRGBtoHSL(c)
ProcedureReturn hm\slot[slot]\hue
EndProcedure
Procedure.d Saturation(c.i)
CheckTranslateRGBtoHSL(c)
ProcedureReturn hm\slot[slot]\sat
EndProcedure
Procedure.d Luminosity(c.i)
CheckTranslateRGBtoHSL(c)
ProcedureReturn hm\slot[slot]\lum
EndProcedure
;-
;- INTO RGB STUFF
Procedure.f HSL2RGBHelper(q1.f, q2.f, h.f)
If h >= 360.0
h - 360.0
ElseIf h < 0.0
h + 360.0
EndIf
If h < 60.0
ProcedureReturn q1+(q2-q1)*h/60.0
ElseIf h < 180.0
ProcedureReturn q2
ElseIf h < 240.0
ProcedureReturn q1+(q2-q1)*(240.0-h)/60.0
Else
ProcedureReturn q1
EndIf
EndProcedure
Procedure.i HSL(hue.d,sat.d,lum.d) ; returns an RGB value usable in PB drawing operations
Protected f.f, p1.d, p2.d, t.f
Protected i.l
If lum<=0.5
p2 = lum*(1.0+sat)
Else
p2 = lum+sat-lum*sat
EndIf
p1 = 2.0*lum-p2
If sat=0.0
; it's a gray-tone
r = lum
g = lum
b = lum
Else
r = HSL2RGBHelper(p1, p2, hue+120.0)
g = HSL2RGBHelper(p1, p2, hue)
b = HSL2RGBHelper(p1, p2, hue-120.0)
EndIf
ProcedureReturn RGB(r,g,b)
EndProcedure
;-
;- THE CALLBACK
Procedure.i QuarterYellowSaturation(x.i,y.i,tc.i,bc.i)
bh.d = Hue(bc)
nrgb = bc
If bh=60 ; hue value for yellow is 60
bs.d = Saturation(bc)
bl.d = Luminosity(bc)
abs.d = bs/4
nrgb = HSL(bh,abs,bl)
EndIf
ProcedureReturn nrgb
EndProcedure
;-
;- PROGRAM START
OpenConsole()
iw.d = 900
ih.d = 900
h.d = iw/2
img = CreateImage(#PB_Any,iw,ih)
StartDrawing(ImageOutput(img))
Box(0,0,h,h,#Green)
Box(0,h,h,h,#Blue)
Box(h,0,h,h,#Yellow) ; this will be augmented by the custom filter
Box(h,h,h,h,#Red)
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@QuarterYellowSaturation())
start = ElapsedMilliseconds()
Box(0,0,iw,ih)
stop = ElapsedMilliseconds()
StopDrawing()
RI(img,Str(stop-start)+" ms")
Only bummer is that if the debugger is on, runtime takes a pounding from 79ms to 1953ms. So I've changed Debug calls to PrintN calls and done without the debugger.
Now, I'm personally quite happy with this code, but can anyone think of ways to improve it or speed it up? 79ms does seem lengthy for a very simple operation.
Otherwise, just enjoy the Hue(), Saturation(), Luminosity() and HSL() procedures!
All the best,
Seymour.
