SuperStrict

Module api.color

ModuleInfo "Version: 1.3"
ModuleInfo "Author: Albert G."
ModuleInfo "License: LGPL"
ModuleInfo "Copyright: Dynamic bytes"
ModuleInfo "Modserver: API"

ModuleInfo "History: 1.3 Release"
ModuleInfo "History: Added TColor component"
ModuleInfo "History: 1.2 Release"
ModuleInfo "History: Added Hex2RGB()"
ModuleInfo "History: 1.1 Release"
ModuleInfo "History: Added RGB2HSB()"
ModuleInfo "History: Added HSB2RGB()"
ModuleInfo "History: 1.0 Release"
ModuleInfo "History: Initial release"

Import brl.math

Private

Function Hex:String(val:Int)
	Local buf:Short[8]
	For Local k:Int = 7 To 0 Step - 1
		Local n:Int = (val & 15) + Asc("0")
		If n > Asc("9") n = n + (Asc("A") - Asc("9") - 1)
		buf[k] = n
		val:Shr 4
	Next
	Return String.FromShorts(buf, 8)
End Function

Function GetValue:Int(v:String, no:Int)
	Select v
		Case "A" Return 10
		Case "B" Return 11
		Case "C" Return 12
		Case "D" Return 13
		Case "E" Return 14
		Case "F" Return 15
		Default Return no
	End Select
End Function

Public

Type TRGB
	Field r:Byte
	Field g:Byte
	Field b:Byte
	
End Type

Type TARGB Extends TRGB
	
End Type

Type THSB Extends TRGB
	
End Type

rem

Type THSB
	Field h:Float = 0.0
	Field s:Float = 0.0
	Field b:Float = 0.0
	
	Method SetRGB(RGB:TRGB)
		Local hsb:THSB = RGB.GetHSB()
		h = hsb.h
		s = hsb.s
		b = hsb.b
	End Method
	
	Method GetRGB:TRGB()
		Local RGB:TRGB = New TRGB
		RGB.SetHSB(Self)
		Return RGB
	End Method
	
	Method SetInt(value:Int)
		Local RGB:TRGB = New TRGB
		RGB.SetInt(value)
		Local hsb:THSB = RGB.GetHSB()
		h = hsb.h
		s = hsb.s
		b = hsb.b
	End Method
	
	Method GetInt:Int()
		Local RGB:TRGB = New TRGB
		RGB.SetHSB(Self)
		Return RGB.GetInt()
	End Method
	
	Method SetHex(value:String)
		Local RGB:TRGB = New TRGB
		RGB.SetHex(value)
		Local hsb:THSB = RGB.GetHSB()
		h = hsb.h
		s = hsb.s
		b = hsb.b
	End Method
	
	Method GetHex:String()
		Local RGB:TRGB = New TRGB
		RGB.SetHSB(Self)
		Return RGB.GetHex()
	End Method
End Type

Type TRGB
	Field r:Byte = 255
	Field g:Byte = 255
	Field b:Byte = 255
	
	Method SetInt(value:Int)
		r = (value Shr 16) & $FF
		g = (value Shr 8) & $FF
		b = value & $FF
	End Method
	
	Method GetInt:Int()
		Return Int Ptr(Varptr r)[0]
	End Method
	
	Method SetHex(value:String)
		value = value.ToUpper()
		If value.Length < 8 Then value = "00" + value
		If value.Length < 8 Then Return
		
		Local v1:String, v1no:Int, v2:String, v2no:Int
		
		v1 = value[3..4]
		v1no = GetValue(v1, Int(v1))
		v2 = value[2..3]
		v2no = GetValue(v2, Int(v2)) * 16
		
		r = v2no + v1no
		
		v1 = value[5..6]
		v1no = GetValue(v1, Int(v1))
		v2 = value[4..5]
		v2no = GetValue(v2, Int(v2)) * 16
		
		g = v2no + v1no
		
		v1 = value[7..]
		v1no = GetValue(v1, Int(v1))
		v2 = value[6..7]
		v2no = GetValue(v2, Int(v2)) * 16
		
		b = v2no + v1no
	End Method
	
	Method GetHex:String()
		Return Hex(GetInt())
	End Method
	
	Method SetHSB(hsb:THSB)
		Local i:Float, f:Float, p:Float, q:Float, t:Float, r_:Float, g_:Float, b_:Float
		If hsb.s = 0.0
			r_ = hsb.b * 255.0
			g_ = r_
			b_ = g_
		Else
			Local hue:Float = hsb.h / 60.0
			i = Floor(hue)
			f = hue - i
			p = hsb.b * (1.0 - hsb.s)
			q = hsb.b * (1.0 - hsb.s * f)
			t = hsb.b * (1.0 - hsb.s * (1.0 - f))
			Select i
				Case 0
					r_ = hsb.b
					g_ = t
					b_ = p
				Case 1
					r_ = q
					g_ = hsb.b
					b_ = p
				Case 2
					r_ = p
					g_ = hsb.b
					b_ = t
				Case 3
					r_ = p
					g_ = hsb.b
					b_ = q
				Case 4
					r_ = t
					g_ = hsb.b
					b_ = p
				Default
					r_ = hsb.b
					g_ = p
					b_ = q
			End Select
			r_:*255.0
			g_:*255.0
			b_:*255.0
		End If
		r = Max(Min(r_, 0.0), 255.0)
		g = Max(Min(g_, 0.0), 255.0)
		b = Max(Min(b_, 0.0), 255.0)
	End Method
	
	Method GetHSB:THSB()
		Local hsb:THSB = New THSB
		Local m_min:Byte = Min(Min(r, g), b)
		Local m_max:Byte = Max(Max(r, g), b)
		Local delta:Byte = m_max - m_min
		If m_max <> 0
			hsb.s = Float(delta) / Float(m_max)
			hsb.b = Float(m_max) / 255.0
			If delta <> 0
				If r = m_max
					hsb.h = Float(g - b) / Float(delta)
				ElseIf g = m_max
					hsb.h = 2 + (Float(b - r) / Float(delta))
				Else
					hsb.h = 4 + (Float(r - g) / Float(delta))
				EndIf
				hsb.h:*60.0
				If hsb.h < 0.0 Then hsb.h:+360.0
				Return hsb
			End If
		End If
	End Method
End Type

Type TARGB Extends TRGB
	Field a:Byte = 255
	
	Method SetInt(value:Int)
		a = (value Shr 24) & $FF
		Super.SetInt(value)
	End Method
	
	Method SetHex(value:String)
		value = value.ToUpper()
		If value.Length < 8 Then Return
		Local a1:String = value[1..2]
		Local a1no:Int = GetValue(a1, Int(a1))
		Local a2:String = value[..1]
		Local a2no:Int = GetValue(a2, Int(a2)) * 16
		a = a2no + a1no
		Super.SetHex(value)
	End Method
End Type