Microsoft Small Basic

Program Listing: CPW085

List Program

' Hue Changer
' Version 0.1
' Copyright © 2016 Nonki Takahashi. All right reserved.
'
' Reference
' [1] James D. Foley, Andries Van Dam "Fundamentals of Interactive Computer Graphics" 1982
'
UNDEFINED = "N/A"
GraphicsWindow.Width = 600
GraphicsWindow.Height = 400
folder = "http://www.nonkit.com/smallbasic.files/"
GraphicsWindow.DrawImage(folder + "coupy100.png", 0, 0)
For panel = 1 To 24
If 1 < panel Then
row = Math.Floor((panel - 1) / 6) + 1
col = Math.Remainder(panel - 1, 6) + 1
y0 = (row - 1) * 100
x0 = (col - 1) * 100
For y = 0 To 99
For x = 0 To 99
sColor = GraphicsWindow.GetPixel(x, y)
Color_RGBtoHSL()
rHue = Math.Remainder(rHue + (360 / 24) * panel, 360)
Color_HSLtoRGB()
GraphicsWindow.SetPixel(x0 + x, y0 + y, sColor)
EndFor
EndFor
EndIf
EndFor
Sub Color_ColorToRGB
' Color | Convert Color to RGB
' param sColor - "#rrggbb"
' return iR, iG, iB - [0, 255]
sR = Text.GetSubText(sColor, 2, 2)
sG = Text.GetSubText(sColor, 4, 2)
sB = Text.GetSubText(sColor, 6, 2)
sHex = sR
Math_Hex2Dec()
iR = iDec
sHex = sG
Math_Hex2Dec()
iG = iDec
sHex = sB
Math_Hex2Dec()
iB = iDec
EndSub
Sub Color_HSLtoRGB
' Color | Convert HSL to RGB
' param rHue - [0, 360) or UNDEFINED
' param rLightness - [0, 1]
' param rSaturation - [0, 1]
' return iR, iG, iB - RGB color
' return sColor - "#rrggbb"
If rLightness <= 0.5 Then
rN2 = rLightness * (1 + rSaturation)
Else
rN2 = rLightness + rSaturation - rLightness * rSaturation
EndIf
rN1 = 2 * rLightness - rN2
If rSaturation = 0 Then
iR = Math.Round(rLightness * 255)
iG = Math.Round(rLightness * 255)
iB = Math.Round(rLightness * 255)
Else
rH = rHue + 120
Color_Value()
iR = iValue
rH = rHue
Color_Value()
iG = iValue
rH = rHue - 120
Color_Value()
iB = iValue
EndIf
sColor = GraphicsWindow.GetColorFromRGB(iR, iG, iB)
EndSub
Sub Color_RGBtoHSL
' Color | Convert RGB to HSL
' param sColor - "#rrggbb"
' return rHue - [0, 360) or UNDEFINED
' return rLightness - (0, 1)
' return rSaturation - (0, 1)
Color_ColorToRGB()
' rR = iR / 255 ' occurs Math.Max() bug
rR = Math.Round(iR / 255 * 10000) / 10000
' rG = iG / 255 ' occurs Math.Max() bug
rG = Math.Round(iG / 255 * 10000) / 10000
' rB = iB / 255 ' occurs Math.Max() bug
rB = Math.Round(iB / 255 * 10000) / 10000
rMax = Math.Max(rR, rG)
rMax = Math.Max(rMax, rB)
rMin = Math.Min(rR, rG)
rMin = Math.Min(rMin, rB)
rLightness = (rMax + rMin) / 2
If rMax = rMin Then ' rR = rG = rB
rSaturation = 0
rHue = UNDEFINED
Else
If rLightness <= 0.5 Then
rSaturation = (rMax - rMin) / (rMax + rMin)
Else
rSaturation = (rMax - rMin) / (2 - rMax - rMin)
EndIf
rRC = (rMax - rR) / (rMax - rMin)
rGC = (rMax - rG) / (rMax - rMin)
rBC = (rMax - rB) / (rMax - rMin)
If rR = rMax Then ' between Yellow and Magenta
rHue = rBC - rGC
ElseIf rG = rMax Then ' between Cyan and Yellow
rHue = 2 + rRC - rBC
ElseIf rB = rMax Then ' between Magenta and Cyan
rHue = 4 + rGC - rRC
Else
TextWindow.WriteLine("Error:")
TextWindow.WriteLine("rMax=" + rMax)
TextWindow.WriteLine("rR=" + rR + ",sR=" + sR)
TextWindow.WriteLine("rG=" + rG + ",sG=" + sG)
TextWindow.WriteLine("rB=" + rB + ",sB=" + sB)
EndIf
rHue = rHue * 60
If rHue < 0 Then
rHue = rHue + 360
EndIf
EndIf
EndSub
Sub Color_Value
' Color | Function value
' param rN1, rN2
' param rH - [-120, 480)
' return iValue - 0..255
If rH >= 360 Then
rH = rH - 360
EndIF
If rH < 0 Then
rH = rH + 360
EndIF
If rH < 60 Then
rV = rN1 + (rN2 - rN1) * rH / 60
ElseIf rH < 180 Then
rV = rN2
ElseIf rH < 240 Then
rV = rN1 + (rN2 - rN1) * (240 - rH) / 60
Else
rV = rN1
EndIf
iValue = Math.Round(rV * 255)
EndSub
Sub Math_Hex2Dec
' Math | Convert hexadecimal to decimal
' param sHex
' return iDec
iDec = 0
iLen = Text.GetLength(sHex)
For iPtr = 1 To iLen
iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1
EndFor
EndSub