Post by sprezzo on Nov 28, 2022 7:05:24 GMT
(QB64 code. Not yet ported to qbjs.)
'MouseButton1 = Re-center
'MouseButton3 = Zoom x2 (in)
'MouseButton2 = Zoom /2 (out)
'Mousewheel = Rotate colorwheel
'Leftarrow = Next plot
'Rightarrow = Previous plot
'Uparrow = Increase iterations (where applicable)
'DownArrow = Decrease iterations (where applicable)
' ] = Next palette
' [ = Previous palette
' R = Random RGB basis
' X = Re-center perspective
Option _Explicit
Do Until _ScreenExists: Loop
_Title "Domain Coloring"
On Error GoTo errhand
Dim Shared As Long MainScreen, BackScreen
Dim As Integer ScrWid, ScrHgt
ScrWid = 600: ScrHgt = 600
'ScrWid = 1920: ScrHgt = 1080
MainScreen = _NewImage(ScrWid, ScrHgt, 32)
BackScreen = _NewImage(ScrWid, ScrHgt, 32)
Screen MainScreen
_Dest MainScreen
_ScreenMove 100, 100
'Screen _NewImage(250, 250, 32)
'Screen _NewImage(400, 400, 32)
'Screen _NewImage(600, 600, 32)
'Screen _NewImage(800, 800, 32)
'Screen _NewImage(1024, 768, 32)
'Screen _NewImage(1920, 1080, 32)
Dim Shared As Long j
Dim Shared As String ActiveExhibitLabel
Dim Shared As String ActivePaletteLabel
Dim Shared PlotOption(20) As Double
Dim As String dat
If (Command$ = "") Then
ActiveExhibitLabel = "Condenser"
ActivePaletteLabel = "starry nights"
PlotOption(1) = 400 ' Zoom ' Mouse3
PlotOption(2) = 0 ' Xshift ' Mouse1
PlotOption(3) = 0 ' Yshift ' Mouse1
PlotOption(4) = 2 ' Contour scale ' K
PlotOption(5) = 3 ' Contour character ' L
PlotOption(6) = 10 ' Iteration depth, when applicable ' Up/Dn
PlotOption(7) = .5 ' Initial shading option ' I
PlotOption(8) = 0 ' Palette phase shift ' MouseWheel
PlotOption(9) = -1 ' Cartesian grid ' G
PlotOption(10) = -1 ' Cartesian mesh ' M
PlotOption(11) = -1 ' Cartesian checkers ' C
PlotOption(12) = 1 ' Polar grid ' H
PlotOption(13) = 1 ' Polar mesh ' N
PlotOption(14) = 1 ' Polar checkers ' V
PlotOption(15) = -1 ' CMYK Tweaks ' Y
PlotOption(16) = -1 ' Greyscale ' B
PlotOption(17) = -1 ' Antialiasing toggle ' A
PlotOption(18) = -1 ' Oil paint ' S
PlotOption(19) = -1 ' Brush strokes ' O
PlotOption(20) = -1 ' Gradient map ' P
Else
Print Command$
Print "Loading..."
Open Command$ For Input As #1
Line Input #1, dat
ActiveExhibitLabel = _Trim$(dat)
Line Input #1, dat
ActivePaletteLabel = _Trim$(dat)
j = 0
Do While Not EOF(1)
j = j + 1
Line Input #1, dat
PlotOption(j) = Val(dat)
Print dat
Loop
Close #1
Print "Done."
End If
ReDim Shared Exhibit(99) As String
j = 0
j = j + 1: Exhibit(j) = "Vanilla"
j = j + 1: Exhibit(j) = "Monomial"
j = j + 1: Exhibit(j) = "Pole"
j = j + 1: Exhibit(j) = "Shifts"
j = j + 1: Exhibit(j) = "Geometric Series"
j = j + 1: Exhibit(j) = "Taylor"
j = j + 1: Exhibit(j) = "Exponential"
j = j + 1: Exhibit(j) = "Logarithm"
j = j + 1: Exhibit(j) = "Sqrt"
j = j + 1: Exhibit(j) = "Branch"
j = j + 1: Exhibit(j) = "Sine"
j = j + 1: Exhibit(j) = "Cosine"
j = j + 1: Exhibit(j) = "Tangent"
j = j + 1: Exhibit(j) = "Essential"
j = j + 1: Exhibit(j) = "Gamma"
j = j + 1: Exhibit(j) = "Condenser"
j = j + 1: Exhibit(j) = "Inductor"
j = j + 1: Exhibit(j) = "Mandelbrot"
j = j + 1: Exhibit(j) = "Julia"
j = j + 1: Exhibit(j) = "Newton"
j = j + 1: Exhibit(j) = "Vince"
j = j + 1: Exhibit(j) = "CIF1"
j = j + 1: Exhibit(j) = "CIF2"
j = j + 1: Exhibit(j) = "CIF3"
j = j + 1: Exhibit(j) = "Canonical Logarithm"
ReDim _Preserve Exhibit(j) As String
Type Vector2D
x As Double
y As Double
End Type
Type Vector3D
x As Double
y As Double
z As Double
End Type
Type Vector3UL
x As _Unsigned Long
y As _Unsigned Long
z As _Unsigned Long
End Type
Type Vector4D
x As Double
y As Double
z As Double
t As Double
End Type
Type Crayon
Index As Long
Label As String
Shade As _Unsigned Long
End Type
Type BasisPalatte
Index As Long
Label As String
Shades As Vector3UL
End Type
Dim Shared ScreenBufferMain(0 To _Width, 0 To _Height) As _Unsigned Long
Dim Shared ScreenBufferOilPaint(0 To _Width, 0 To _Height) As _Unsigned Long
Dim Shared ScreenBufferStrokes(0 To _Width, 0 To _Height) As _Unsigned Long
Dim Shared BrushStrokes(Int(5 * Sqr(_Width ^ 2 + _Height ^ 2)), 25) As Vector2D
Dim Shared BrushStrokeIndex(UBound(BrushStrokes)) As Long
Dim Shared GradientMap(0 To _Width, 0 To _Height) As Vector2D
Dim Shared Pi As Double
Dim Shared epsilon As Double
Pi = 4 * Atn(1)
epsilon = 10 ^ -9
Randomize Timer
ReDim Shared Spectrum(999) As Crayon
Dim Shared SpectrumCount As Long
SpectrumCount = 0
Call AddAllShades
ReDim _Preserve Spectrum(SpectrumCount) As Crayon
ReDim Shared CustomPalette(999) As BasisPalatte
Dim Shared PaletteCount As Long
Call AddAllPalettes
ReDim _Preserve CustomPalette(PaletteCount) As BasisPalatte
Dim As Long ActiveExhibitIndex
Dim As Long ActivePaletteIndex
ActiveExhibitIndex = ExhibitIndexFromLabel(ActiveExhibitLabel)
ActivePaletteIndex = PaletteIndexFromLabel(ActivePaletteLabel)
Dim Shared BasisRed As _Unsigned Long
Dim Shared BasisGreen As _Unsigned Long
Dim Shared BasisBlue As _Unsigned Long
BasisRed = CustomPalette(ActivePaletteIndex).Shades.x
BasisGreen = CustomPalette(ActivePaletteIndex).Shades.y
BasisBlue = CustomPalette(ActivePaletteIndex).Shades.z
Dim InitTime As Double
InitTime = Timer
Call DrawPlot
' Can end here or not.
If (0 = 1) Then
Do
If (Timer - InitTime >= 6) Then System
Loop
End If
' Runtime interaction
Dim As Integer kh, mw, redrawflag
Do
Do While _MouseInput: Loop ' Gather mouse input
redrawflag = 0
mw = mw + _MouseWheel
If (_MouseButton(1)) Then
PlotOption(2) = PlotOption(2) + (_MouseX - _Width / 2) / PlotOption(1)
PlotOption(3) = PlotOption(3) - (_MouseY - _Height / 2) / PlotOption(1)
Do While _MouseInput: Loop
redrawflag = 1
End If
If (_MouseButton(2)) Then
PlotOption(1) = PlotOption(1) * 1 / 2
Do While _MouseInput: Loop
redrawflag = 1
End If
If (_MouseButton(3)) Then
PlotOption(1) = PlotOption(1) * 2
Do While _MouseInput: Loop
redrawflag = 1
End If
If (mw <> 0) Then
PlotOption(8) = PlotOption(8) - mw * (360 / 16)
'
'If PlotOption(8) > 360 Then PlotOption(8) = PlotOption(8) - 360
'If PlotOption(8) < 0 Then PlotOption(8) = 360 - PlotOption(8)
'
mw = 0
redrawflag = 1
End If
Do While _MouseInput: Loop ' Clear mouse buffer
kh = _KeyHit
_KeyClear
If (kh = 19712) Then
ActiveExhibitIndex = ActiveExhibitIndex + 1
If (ActiveExhibitIndex > UBound(Exhibit)) Then ActiveExhibitIndex = 1
ActiveExhibitLabel = Exhibit(ActiveExhibitIndex)
End If
If (kh = 19200) Then
ActiveExhibitIndex = ActiveExhibitIndex - 1
If (ActiveExhibitIndex < 1) Then ActiveExhibitIndex = UBound(Exhibit)
ActiveExhibitLabel = Exhibit(ActiveExhibitIndex)
End If
If (kh = Asc("]")) Then
ActivePaletteIndex = ActivePaletteIndex + 1
If (ActivePaletteIndex > UBound(CustomPalette)) Then ActivePaletteIndex = 1
BasisRed = CustomPalette(ActivePaletteIndex).Shades.x
BasisGreen = CustomPalette(ActivePaletteIndex).Shades.y
BasisBlue = CustomPalette(ActivePaletteIndex).Shades.z
ActivePaletteLabel = CustomPalette(ActivePaletteIndex).Label
End If
If (kh = Asc("[")) Then
ActivePaletteIndex = ActivePaletteIndex - 1
If (ActivePaletteIndex < 1) Then ActivePaletteIndex = UBound(CustomPalette)
BasisRed = CustomPalette(ActivePaletteIndex).Shades.x
BasisGreen = CustomPalette(ActivePaletteIndex).Shades.y
BasisBlue = CustomPalette(ActivePaletteIndex).Shades.z
ActivePaletteLabel = CustomPalette(ActivePaletteIndex).Label
End If
If ((kh = Asc("r")) Or (kh = Asc("R"))) Then
ActivePaletteLabel = ""
ActivePaletteIndex = 1
BasisRed = Spectrum(1 + Int(Rnd * UBound(Spectrum))).Shade
BasisGreen = Spectrum(1 + Int(Rnd * UBound(Spectrum))).Shade
BasisBlue = Spectrum(1 + Int(Rnd * UBound(Spectrum))).Shade
PlotOption(8) = 0
End If
If ((kh = Asc("x")) Or (kh = Asc("X"))) Then
PlotOption(2) = 0
PlotOption(3) = 0
End If
If ((kh = Asc("k")) Or (kh = Asc("K"))) Then
PlotOption(4) = PlotOption(4) + 1
If (PlotOption(4) > 3) Then PlotOption(4) = 1
End If
If ((kh = Asc("l")) Or (kh = Asc("L"))) Then
PlotOption(5) = PlotOption(5) + 1
If (PlotOption(5) > 3) Then PlotOption(5) = 1
End If
If (kh = 18432) Then
PlotOption(6) = PlotOption(6) + 1
End If
If (kh = 20480) Then
PlotOption(6) = PlotOption(6) - 1
If (PlotOption(6) < 0) Then PlotOption(6) = 0
End If
If ((kh = Asc("i")) Or (kh = Asc("I"))) Then
PlotOption(7) = PlotOption(7) + .5
If ((PlotOption(7) > 1)) Then PlotOption(7) = 0
End If
If ((kh = Asc("g")) Or (kh = Asc("G"))) Then PlotOption(9) = -PlotOption(9)
If ((kh = Asc("m")) Or (kh = Asc("M"))) Then PlotOption(10) = -PlotOption(10)
If ((kh = Asc("c")) Or (kh = Asc("C"))) Then PlotOption(11) = -PlotOption(11)
If ((kh = Asc("h")) Or (kh = Asc("H"))) Then PlotOption(12) = -PlotOption(12)
If ((kh = Asc("n")) Or (kh = Asc("N"))) Then PlotOption(13) = -PlotOption(13)
If ((kh = Asc("v")) Or (kh = Asc("V"))) Then PlotOption(14) = -PlotOption(14)
If ((kh = Asc("y")) Or (kh = Asc("Y"))) Then PlotOption(15) = -PlotOption(15)
If ((kh = Asc("b")) Or (kh = Asc("B"))) Then PlotOption(16) = -PlotOption(16)
If ((kh = Asc("a")) Or (kh = Asc("A"))) Then PlotOption(17) = -PlotOption(17)
If ((kh = Asc("o")) Or (kh = Asc("O"))) Then PlotOption(18) = -PlotOption(18)
If ((kh = Asc("s")) Or (kh = Asc("S"))) Then PlotOption(19) = -PlotOption(19)
If ((kh = Asc("p")) Or (kh = Asc("P"))) Then PlotOption(20) = -PlotOption(20)
If ((kh <> 0) And (kh <> 27) And (kh <> -27)) Then redrawflag = 1
If (redrawflag = 1) Then
Call DrawPlot
End If
Loop
errhand:
Resume Next
Sleep
System
Sub Calculate (x As Double, y As Double)
Dim As Integer j, m, n
Dim As Double re, im, u, v, u0, v0, uu, vv, fu, fv, xx, yy, p, q, t
Select Case ActiveExhibitLabel
Case "Vanilla"
re = x
im = y
Case "Monomial"
're = x ^ 2 - y ^ 2
'im = 2 * x * y
'cexp re, im, x, y, 2, 0
cexp re, im, x, y, 3, 0
Case "Pole"
'cexp re, im, x, y, -1, 0
cexp re, im, x, y, -2, 0
Case "Shifts"
'cdiv u, v, x + 1, y, x - 1, y
cdiv u, v, x, y, x - 1, y
re = u
im = v
Case "Geometric Series"
p = 0
q = 0
u = 1
v = 0
cadd u0, v0, p, q, u, v
For m = 1 To PlotOption(6)
cexp uu, vv, x, y, m, 0
cadd p, q, u0, v0, uu, vv
u0 = p
v0 = q
Next
re = u0
im = v0
Case "Taylor"
p = 0
q = 0
u = 1
v = 0
cadd u0, v0, p, q, u, v
For m = 1 To PlotOption(6)
cexp uu, vv, x, y, m, 0
cdiv u, v, uu, vv, facto&(m), 0
cadd p, q, u0, v0, u, v
u0 = p
v0 = q
Next
re = u0
im = v0
Case "Exponential"
cexp re, im, Exp(1), 0, x, y
Case "Logarithm"
clog re, im, x, y
Case "Sqrt"
cexp re, im, x, y, 1 / 2, 0
Case "Branch"
cdiv p, q, x + 2, y + 1, x - 2, y - 1
clog re, im, p, q
Case "Sine"
sinz re, im, x, y
Case "Cosine"
cosz re, im, x, y
Case "Tangent"
tanz re, im, x, y
Case "Essential"
cexp u, v, x, y, -1, 0
cexp re, im, Exp(1), 0, u, v
Case "Gamma"
cgamma re, im, x, y
'cgamma2 u, v, x, y
'cexp re, im, Exp(1), 0, u, v
Case "Condenser"
re = 1
im = 0
For j = 0 To 7
cmul u, v, 1, 0, -0.1 * (j - 3.5), 0
cmul re, im, re, im, x - u, y - v - 0.1
cdiv re, im, re, im, x - u, y - v + 0.1
Next
Case "Inductor"
re = 1
im = 0
For j = 0 To 5
cmul u, v, 1, 0, 0, -0.18 * (j - 2.5)
cmul re, im, re, im, x - u - 0.2, y - v
cdiv re, im, re, im, x - u + 0.2, y - v + 0.1
Next
Case "Mandelbrot"
u = x
v = y
For m = 0 To PlotOption(6)
u0 = u
v0 = v
u = u0 ^ 2 - v0 ^ 2 + x
v = 2 * u0 * v0 + y
Next
re = u
im = v
Case "Julia"
u = x
v = y
For m = 0 To PlotOption(6)
u0 = u
v0 = v
u = u0 ^ 2 - v0 ^ 2 + 0.35
v = 2 * u0 * v0 + 0 '0.5
Next
re = u
im = v
Case "Newton"
u = x
v = y
For m = 0 To 10 'PlotOption(6)
u0 = u
v0 = v
tanz p, q, u0, v0
cadd u, v, u0, v0, -p, -q
Next
re = u
im = v
Case "Vince"
u = x * 1000
v = y * 1000
uu = u
vv = v
p = 0
For t = 0 To 50 Step 1
xx = 100 * t * Cos(.6 * t)
yy = 100 * t * Sin(.6 * t)
If (p) Then
cmul uu, vv, uu, vv, u + xx, v - yy
Else
cdiv uu, vv, uu, vv, u + xx, v + yy
End If
p = p Xor 1
Next
re = uu
im = vv
Case "CIF1"
' Riemann sum resolution
n = PlotOption(6) '25
xx = 0
yy = 0
For j = 0 To n - 1
' Integration contour
' 1:
'u = 3 * (2 * COS(j * 2 * pi / n))
'v = 3 * (2 * SIN(j * 2 * pi / n))
' 2:
'u = 4 * (2 * Cos(j * 2 * Pi / n))
'v = 4 * (2 * Sin(j * 2 * Pi / n) * Cos(j * 2 * Pi / n))
' 3:
u = 4 * (Cos(j * 2 * Pi / n))
v = 4 * (Sin(j * 2 * Pi / n))
' f(z)
fu = 1 'u - v 'u ^ 2 - v ^ 2
fv = 1 'u + v '2 * u * v
' f(z) / (z - z_0)
cdiv uu, vv, fu, fv, u - x, v - y
' z'(t) = derivative of integration contour
' 1:
'cmul re, im, uu, vv, 3 * (-2 * SIN(j * 2 * pi / n)), 3 * (2 * COS(j * 2 * pi / n))
' 2:
'cmul re, im, uu, vv, 4 * (-2 * Sin(j * 2 * Pi / n)), 4 * (2 * Cos(j * 4 * Pi / n))
' 3:
cmul re, im, uu, vv, 4 * (-Sin(j * 2 * Pi / n)), 4 * (Cos(j * 4 * Pi / n))
' Integral height calculation
If ((j = 0) Or (j = n - 1)) Then
xx = xx + 0.5 * re
yy = yy + 0.5 * im
Else
xx = xx + re
yy = yy + im
End If
Next
' Integral base calculation
xx = xx * 2 * Pi / n
yy = yy * 2 * Pi / n
' Rescale by 1/(2*pi*i)
cmul re, im, xx, yy, 0, -1 / (2 * Pi)
Case "CIF2"
' Riemann sum resolution
n = PlotOption(6) '10
xx = 0
yy = 0
Dim xr As Double
Dim xi As Double
xr = 2.0
xi = 0.0
For j = 0 To n - 1
' Integration contour
u = 3 * 3 * Cos(j * 2 * Pi / n)
v = 3 * 2 * Sin(j * 2 * Pi / n)
' f(z)
sinz fu, fv, u, v
' f(z) / (z - z_0)^(xr + i xi)
p = u - x
q = v - y
cexp p, q, p, q, xr, xi
cdiv uu, vv, fu, fv, p, q
' z'(t) = derivative of integration contour
cmul re, im, uu, vv, 3 * -3 * Sin(j * 2 * Pi / n), 2 * Cos(j * 2 * Pi / n)
' Integral height calculation
If ((j = 0) Or (j = n - 1)) Then
xx = xx + 0.5 * re
yy = yy + 0.5 * im
Else
xx = xx + re
yy = yy + im
End If
Next
' Integral base calculation
xx = xx * 2 * Pi / n
yy = yy * 2 * Pi / n
' rescale by Gamma(xr + i ri)/(2*pi*i)
cgamma u, v, xr + 1, xi
cmul re, im, xx, yy, u, v
cmul re, im, re, im, 0, -1 / (2 * Pi)
Case "CIF3"
xx = 0
yy = 0
For t = 0 To 3 Step 0.1
uu = t * Cos(5 * t)
vv = t * Sin(5 * t)
cexp p, q, Exp(1), 0, uu, vv
cdiv u0, v0, p, q, uu - x, vv - y
cmul p, q, u0, v0, Cos(5 * t) - 5 * t * Sin(5 * t), Sin(5 * t) + 5 * t * Cos(5 * t)
If ((t = 0) Or (t = 3)) Then
xx = xx + 0.5 * p
yy = yy + 0.5 * q
Else
xx = xx + 1 * p
yy = yy + 1 * q
End If
Next
xx = xx * 0.01
yy = yy * 0.01
cmul re, im, xx, yy, 0, -1 / (2 * Pi)
Case "Canonical Logarithm"
Dim As Double a0, k0, sx0, sy0, tx0, ty0
a0 = .5
k0 = 0.09
sx0 = 2
sy0 = 1
tx0 = a0 * Exp(k0 * 16) * Cos(16) + sx0
ty0 = a0 * Exp(k0 * 16) * Sin(16) + sy0
re = 0
im = 0
For t = 0 To 16 Step .1
p = a0 * Exp(k0 * t) * Cos(t) + sx0 - tx0
q = a0 * Exp(k0 * t) * Sin(t) + sy0 - ty0
cdiv uu, vv, 1, 0, p - x, q - y
cmul xx, yy, uu, vv, a0 * Exp(k0 * t) * (k0 * Cos(t) - Sin(t)), a0 * Exp(k0 * t) * (k0 * Sin(t) + Cos(t))
re = re + xx
im = im + yy
Next
For t = 16 - .1 To 0 Step -.1
p = -a0 * Exp(k0 * t) * Cos(t) - sx0 + tx0
q = -a0 * Exp(k0 * t) * Sin(t) - sy0 + ty0
cdiv uu, vv, 1, 0, p - x, q - y
cmul xx, yy, uu, vv, a0 * Exp(k0 * t) * (k0 * Cos(t) - Sin(t)), a0 * Exp(k0 * t) * (k0 * Sin(t) + Cos(t))
re = re + xx
im = im + yy
Next
re = re * 0.1
im = im * 0.1
cmul uu, vv, re, im, 0, -1 / (2 * Pi)
re = uu
im = vv
Case Else
End Select
x = re
y = im
End Sub
Sub ShadePixel (red As Double, grn As Double, blu As Double, alf As Double, re As Double, im As Double)
Dim As _Unsigned Long c0, c1, cf
Dim As Double r, a, h, s, v, l, c, y, k, k1, k2
r = Sqr(re * re + im * im)
Select Case PlotOption(4)
Case 1
k1 = .5
Case 2
k1 = 1
Case 3
k1 = 2
End Select
Select Case PlotOption(5)
Case 1
k2 = r
Case 2
k2 = Log(1 + r)
Case 3
k2 = Log(r + 1 / r)
End Select
k = k1 * k2
' Color scheme: RGB
'a = .5 + _Atan2(im, -re) / (2 * Pi)
'a = 1 - (.5 + _Atan2(im, -re) / (2 * Pi))
a = .5 - _Atan2(im, -re) / (2 * Pi)
c0~& = hrgb~&(a)
' Color scheme: HSV
h = a * 360
s = 75 + 25 ' * Sin(Pi * k)
v = 100
'c1~& = HSVtoRGB~&(h, s, v)
' Color scheme: HSL
h = a * 360
s = 100
l = 25 + 25 ' * Sin(Pi * k)
c1~& = HSLtoRGB~&(h, s, l)
' Weighted average of color schemes
cf~& = ShadeBlend~&(PlotOption(7), c0~&, c1~&)
If (PlotOption(9) = 1) Then ' Cartesian grid
RGBtoHSL h, s, l, cf~&
l = l * Abs(Sin(re * 2 * Pi) * Sin(im * 2 * Pi)) ^ .125
cf~& = HSLtoRGB~&(h, s, l)
End If
If (PlotOption(10) = 1) Then ' Cartesian mesh
cf~& = ShadeMesh~&(cf~&, 64 * (2 * re - Int(2 * re)), 64 * (2 * im - Int(2 * im)))
End If
If (PlotOption(11) = 1) Then ' Cartesian checkers
RGBtoHCY h, c, y, cf~&
If (Abs(re - Int(re)) Xor Abs(im - Int(im))) <> 0 Then
y = y * Abs(.2 * Sin(re * 2 * Pi) * Sin(im * 2 * Pi)) ^ .25
End If
cf~& = HCYtoRGB~&(h, c, y)
End If
If (PlotOption(12) = 1) Then ' Polar grid
RGBtoHSL h, s, l, cf~&
l = l * Abs(Sin(k * Pi)) ^ .125
cf~& = HSLtoRGB~&(h, s, l)
RGBtoHSL h, s, l, cf~&
l = l * Abs(Sin(a * 16 * Pi)) ^ .125
cf~& = HSLtoRGB~&(h, s, l)
End If
If (PlotOption(13) = 1) Then ' Polar mesh
cf~& = ShadeMesh~&(cf~&, 64 * (k - Int(k)), 64 * ((a * 16) - Int(a * 16)))
'cf~& = ShadeMesh~&(cf~&, 64 * Sin(k * Pi), 64 * Sin(a * 16 * Pi))
End If
If (PlotOption(14) = 1) Then ' Polar checkers
RGBtoHCY h, c, y, cf~&
If ((.5 * k - Int(.5 * k)) > .5) Xor ((((1000 * 2 * a * 360) Mod (1000 * 90)) > (1000 * 45)) <> 0) Then
y = y * Abs(.2 * Sin(k * Pi) * Sin(a * 16 * Pi)) ^ .25
End If
cf~& = HCYtoRGB~&(h, c, y)
End If
red = _Red32(cf~&)
grn = _Green32(cf~&)
blu = _Blue32(cf~&)
alf = _Alpha32(cf~&)
End Sub
Sub DrawPlot
Dim As _Unsigned Long TheShade
Dim As Integer ii
Dim As Double j, k, x0, y0, re, im, red, grn, blu, alf, nr, ng, nb, na, d, f, jj, kk
Dim As Double r(99), g(99), b(99), a(99), w(99)
Dim As Vector4D cmyk
Dim As String plotopts, labeltmp
Dim As Integer abort
abort = 0
For ii = 1 To UBound(PlotOption)
plotopts = plotopts + Str$(PlotOption(ii))
Next
plotopts = ActiveExhibitLabel + plotopts + " " + ActivePaletteLabel
_Title plotopts
labeltmp = Spectrum(IndexFromShade(BasisRed)).Label
_PrintString (_Width - (Len(labeltmp) + 3) * 8, 2 * 16), labeltmp
labeltmp = Spectrum(IndexFromShade(BasisGreen)).Label
_PrintString (_Width - (Len(labeltmp) + 3) * 8, 3 * 16), labeltmp
labeltmp = Spectrum(IndexFromShade(BasisBlue)).Label
_PrintString (_Width - (Len(labeltmp) + 3) * 8, 4 * 16), labeltmp
_KeyClear
For j = 0 To _Width
For k = 0 To _Height
If (_KeyHit = 27) Then abort = 1
If (PlotOption(17) = -1) Then
x0 = (j) - _Width / 2
y0 = -(k) + _Height / 2
re = x0 / PlotOption(1) + PlotOption(2)
im = y0 / PlotOption(1) + PlotOption(3)
Calculate re, im
ShadePixel red, grn, blu, alf, re, im
Else
f = 2
d = .25
ii = 0
For jj = j - f * d To j + f * d Step d
For kk = k - f * d To k + f * d Step d
ii = ii + 1
x0 = (jj - d) - _Width / 2
y0 = -(kk - d) + _Height / 2
re = x0 / PlotOption(1) + PlotOption(2)
im = y0 / PlotOption(1) + PlotOption(3)
Calculate re, im
ShadePixel red, grn, blu, alf, re, im
r(ii) = red
g(ii) = grn
b(ii) = blu
a(ii) = alf
w(ii) = Exp(-1 * ((j - jj) ^ 2 + (k - kk) ^ 2))
Next
Next
red = 0
grn = 0
blu = 0
alf = 0
nr = 0
ng = 0
nb = 0
na = 0
For jj = 1 To ii
red = red + r(jj) * w(ii)
grn = grn + g(jj) * w(ii)
blu = blu + b(jj) * w(ii)
alf = alf + a(jj) * w(ii)
nr = nr + w(ii)
ng = ng + w(ii)
nb = nb + w(ii)
na = na + w(ii)
Next
red = red / nr
grn = grn / ng
blu = blu / nb
alf = alf / na
End If
TheShade = _RGB32(red, grn, blu, alf)
' Rotate colorwheel if nonzero
If (PlotOption(8) <> 0) Then TheShade = ShadeRotate~&(TheShade, PlotOption(8))
' Update RGB basis
TheShade = ShadeThreeShift~&(TheShade, BasisRed, BasisGreen, BasisBlue)
'''
'Dim As Double di, dd, fac
'di = Sqr((j - _Width / 2) ^ 2 + (k - _Height / 2) ^ 2)
'dd = Sqr((_Width / 2) ^ 2 + (_Height / 2) ^ 2)
'fac = (di / dd)
'TheShade = ShadeThreeShift~&(TheShade, _RGB32(255 * (1 - fac), 0, 255 * fac, 255), _RGB32(255 * fac, 255 * (1 - fac), 0, 255), _RGB32(0, 255 * fac, 255 * (1 - fac), 255))
'''
' CMYK tweaks
If (PlotOption(15) = 1) Then
RGBtoCMYK cmyk.x, cmyk.y, cmyk.z, cmyk.t, TheShade
cmyk.x = Sqr(cmyk.x)
cmyk.t = cmyk.t ^ .5
TheShade = CMYKtoRGB~&(cmyk.x, cmyk.y, cmyk.z, cmyk.t)
End If
If (PlotOption(16) = 1) Then TheShade = ShadeGreyscale~&(TheShade)
ScreenBufferMain(j, k) = TheShade
Call CPset(x0, y0, TheShade)
If (abort = 1) Then Exit For
Next
Line (j + 2, 0)-(j + 2, _Height), _RGB(255, 255, 255, 255)
If (abort = 1) Then Exit For
Next
Call CalcGradientMap
' Oil paint
If (PlotOption(18) = 1) Then
Call CalcOilPaint
End If
' Brush strokes
If (PlotOption(19) = 1) Then
Call CalcBrushStrokes
End If
' Final display
'Cls
For j = 0 To _Width
For k = 0 To _Height
'PSet (j, k), ScreenBufferMain(j, k)
If (PlotOption(18) = 1) Then
'PSet (j, k), ScreenBufferOilPaint(j, k)
End If
If (PlotOption(19) = 1) Then
PSet (j, k), ScreenBufferStrokes(j, k)
End If
If (PlotOption(20) = 1) Then
f = 5 * 255 * Sqr(Abs(.5 * (GradientMap(j, k).x + GradientMap(j, k).y)) / 255)
PSet (j, k), _RGB32(f, f, f, 255)
End If
Next
Next
End Sub
Sub CalcGradientMap
Dim As Integer j, k, w
Dim As Double pxl, pxr, pyl, pyr, dLdx, dLdy
w = 1
For j = 0 To _Width
For k = 0 To _Height
pxr = Luminosity#(ScreenBufferMain(j + w, k))
pxl = Luminosity#(ScreenBufferMain(j - w, k))
pyr = Luminosity#(ScreenBufferMain(j, k + w))
pyl = Luminosity#(ScreenBufferMain(j, k - w))
dLdx = pxl - pxr
dLdy = pyl - pyr
GradientMap(j, k).x = 255 * dLdx / (2 * w)
GradientMap(j, k).y = 255 * dLdy / (2 * w)
Next
Next
End Sub
Sub CalcBrushStrokes
Dim As _Unsigned Long ct
Dim As Integer abort
Dim As Double StrokeRadius, filter
Dim As Double j, k, x0, y0, d, f, p, q, pmax
Dim As Double w0, w1, w2, w3, w4
Dim As Double magvf
Dim As Vector2D positionf, positioni, gradient, velocityi, velocityf
abort = 0
StrokeRadius = 5
filter# = .5
For q = 1 To UBound(BrushStrokes, 1)
BrushStrokeIndex(q) = 0
j = 5 + Int(Rnd * (_Width - 10))
k = 5 + Int(Rnd * (_Height - 10))
x0 = j
y0 = k
positioni.x = j
positioni.y = k
positionf.x = positioni.x
positionf.y = positioni.y
For p = 1 To UBound(BrushStrokes)
gradient.x = GradientMap(Int(positioni.x), Int(positioni.y)).x
gradient.y = GradientMap(Int(positioni.x), Int(positioni.y)).y
If ((StrokeRadius * Sqr(gradient.x ^ 2 + gradient.y ^ 2)) >= 1) Then
velocityf.x = -gradient.y
velocityf.y = gradient.x
If (p > 1) Then
If (velocityi.x * velocityf.x + velocityi.y * velocityf.y) < 0 Then
velocityf.x = -velocityf.x
velocityf.y = -velocityf.y
End If
End If
velocityf.x = filter# * velocityf.x + (1 - filter#) * velocityi.x
velocityf.y = filter# * velocityf.y + (1 - filter#) * velocityi.y
Else
If (p > 1) Then
velocityf.x = velocityi.x
velocityf.y = velocityi.y
Else
Exit For
End If
End If
magvf = Sqr(velocityf.x ^ 2 + velocityf.y ^ 2) + epsilon
positionf.x = positioni.x + StrokeRadius * velocityf.x / magvf
positionf.y = positioni.y + StrokeRadius * velocityf.y / magvf
If (p > Int(.1 * UBound(BrushStrokes, 2))) Then
If (ShadeDiff##(ScreenBufferMain(Int(positionf.x), Int(positionf.y)), ScreenBufferMain(Int(x0), Int(y0))) > 40) Then
Exit For
End If
If (Luminosity#(ScreenBufferMain(Int(positionf.x), Int(positionf.y))) > .9) Then
Exit For
End If
End If
BrushStrokeIndex(q) = BrushStrokeIndex(q) + 1
BrushStrokes(q, BrushStrokeIndex(q)).x = positionf.x
BrushStrokes(q, BrushStrokeIndex(q)).y = positionf.y
positioni.x = positionf.x
positioni.y = positionf.y
velocityi.x = velocityf.x
velocityi.y = velocityf.y
Next
Next
Screen BackScreen
_Dest BackScreen
_Source BackScreen
Cls
For q = 1 To UBound(BrushStrokes, 1)
For p = 2 To BrushStrokeIndex(q)
Line (BrushStrokes(q, p - 1).x, BrushStrokes(q, p - 1).y)-(BrushStrokes(q, p).x, BrushStrokes(q, p).y), _RGB32(255, 255, 255, 255)
Next
Next
For j = 0 To _Width
For k = 0 To _Height
ct = Point(j, k)
If (Luminosity#(ct) < .5) Then
ScreenBufferStrokes(j, k) = _RGB32(0, 0, 0, 0)
Else
ScreenBufferStrokes(j, k) = ct
End If
Next
Next
pmax = 30
For p = 0 To pmax
For j = 1 To _Width - 1
For k = 1 To _Height - 1
If (_KeyHit = 27) Then abort = 1
w0 = _Alpha32(ScreenBufferStrokes(j, k))
w1 = _Alpha32(ScreenBufferStrokes(j - 1, k))
w2 = _Alpha32(ScreenBufferStrokes(j + 1, k))
w3 = _Alpha32(ScreenBufferStrokes(j, k - 1))
w4 = _Alpha32(ScreenBufferStrokes(j, k + 1))
f = Cos((Pi / 2) * (p / pmax)) ^ 2
d = f * w0 + (1 - f) * .25 * (w1 + w2 + w3 + w4)
w1 = 255 * (_Red32(ScreenBufferMain(j, k)) / 255) ^ .25
w2 = 255 * (_Green32(ScreenBufferMain(j, k)) / 255) ^ .25
w3 = 255 * (_Blue32(ScreenBufferMain(j, k)) / 255) ^ .25
w4 = d
ScreenBufferStrokes(j, k) = _RGB32(w1, w2, w3, w4)
PSet (j, k), _RGB32(w1, w2, w3, w4)
If (abort = 1) Then Exit For
Next
If (abort = 1) Then Exit For
Next
If (abort = 1) Then Exit For
Next
For j = 0 To _Width
For k = 0 To _Height
w1 = _Red32(ScreenBufferStrokes(j, k))
w2 = _Green32(ScreenBufferStrokes(j, k))
w3 = _Blue32(ScreenBufferStrokes(j, k))
w4 = _Alpha32(ScreenBufferStrokes(j, k)) * (Luminosity#(ScreenBufferMain(j, k)) ^ 1)
ScreenBufferStrokes(j, k) = _RGB32(w1, w2, w3, w4)
Next
Next
Screen MainScreen
_Dest MainScreen
_Source MainScreen
End Sub
Sub CalcOilPaint
Dim As Long maxintensindex
Dim As Integer j, k, p, jj, kk
Dim As Double red, grn, blu, alf, d, f, intens, maxintens
Dim As Double Intensity(0 To 255), avered(0 To 255), avegrn(0 To 255), aveblu(0 To 255), avealf(0 To 255)
Dim As Integer abort
abort = 0
For p = 1 To 2 Step 1
For j = 0 To _Width
For k = 0 To _Height
If (_KeyHit = 27) Then abort = 1
For jj = LBound(Intensity) To UBound(Intensity)
Intensity(jj) = 0
avered(jj) = 0
avegrn(jj) = 0
aveblu(jj) = 0
avealf(jj) = 0
Next
f = Int((2 - p) * (6) + (p - 1) * (4))
d = 1
For jj = j - f To j + f Step d
For kk = k - f To k + f Step d
red = _Red32(ScreenBufferMain(jj, kk))
grn = _Green32(ScreenBufferMain(jj, kk))
blu = _Blue32(ScreenBufferMain(jj, kk))
alf = _Alpha32(ScreenBufferMain(jj, kk))
intens = Int(.333 * (red + grn + blu) / 3)
Intensity(intens) = Intensity(intens) + 1
avered(intens) = avered(intens) + red
avegrn(intens) = avegrn(intens) + grn
aveblu(intens) = aveblu(intens) + blu
avealf(intens) = avealf(intens) + alf
Next
Next
maxintens = 0
maxintensindex = 0
For jj = LBound(Intensity) To UBound(Intensity)
If (Intensity(jj) > maxintens) Then
If ((avered(jj) + aveblu(jj) + avegrn(jj)) > 66) Then
maxintens = Intensity(jj)
maxintensindex = jj
End If
End If
Next
red = avered(maxintensindex) / maxintens
grn = avegrn(maxintensindex) / maxintens
blu = aveblu(maxintensindex) / maxintens
alf = avealf(maxintensindex) / maxintens
ScreenBufferOilPaint(j, k) = _RGB32(red, grn, blu, alf)
PSet (j, k), _RGB32(red, grn, blu, alf)
If (abort = 1) Then Exit For
Next
Line (j + 2, 0)-(j + 2, _Height), _RGB(255, 255, 255, 255)
If (abort = 1) Then Exit For
Next
Next
End Sub
Function Luminosity# (x As _Unsigned Long)
Dim As Double r0, g0, b0
r0 = _Red32(x) / 255
g0 = _Green32(x) / 255
b0 = _Blue32(x) / 255
Luminosity# = .3 * r0 + .59 * g0 + .11 * b0
End Function
Function ShadeDiff## (x As _Unsigned Long, y As _Unsigned Long)
Dim As Double dr, dg, db
dr = Abs(_Red32(x) - _Red32(y))
dg = Abs(_Green32(x) - _Green32(y))
db = Abs(_Blue32(x) - _Blue32(y))
ShadeDiff## = dr + dg + db
End Function
' modified from vince
Function hrgb~& (h As Double)
Dim As Double r, g, b
r = Abs((0.5 - 0.5 * Sin(2 * Pi * h - Pi / 2)))
g = Abs((0.5 + 0.5 * Sin(2 * Pi * h * 1.5 - Pi / 2)) * -(h < (2 / 3)))
b = Abs((0.5 + 0.5 * Sin(2 * Pi * h * 1.5 + Pi / 2)) * -(h > (1 / 3)))
hrgb~& = _RGB32(255 * r, 255 * g, 255 * b, 255)
End Function
Function fmod## (numer As Double, denom As Double)
fmod## = numer - Int(numer / denom) * denom
End Function
Sub RGBtoHSV (h As Double, s As Double, v As Double, r As Double, g As Double, b As Double)
Dim As Double maxshade, minshade
minshade = Min3##(r, g, b)
If (minshade < 1) Then minshade = 1
maxshade = Max3##(r, g, b)
If (maxshade > 255) Then maxshade = 255
If (maxshade > 0) Then
v = maxshade / 255
s = 1 - minshade / maxshade
End If
If (maxshade = 0) Then
s = 0
End If
If (g = b) Then
h = 0
End If
If (g > b) Then
h = (180 / Pi) * _Acos((r - .5 * g - .5 * b) / Sqr(r * r + g * g + b * b - r * g - r * b - g * b + epsilon))
End If
If (g < b) Then
h = 360 - (180 / Pi) * _Acos((r - .5 * g - .5 * b) / Sqr(r * r + g * g + b * b - r * g - r * b - g * b + epsilon))
End If
s = s * 100
v = v * 100
End Sub
Sub RGBtoHSL (h As Double, s As Double, l As Double, shade As _Unsigned Long)
Dim As Double r0, g0, b0
Dim As Double maxshade, minshade, delta
r0 = _Red32(shade) / 255
g0 = _Green32(shade) / 255
b0 = _Blue32(shade) / 255
minshade = Min3##(r0, g0, b0)
If (minshade < 0) Then minshade = 0
maxshade = Max3##(r0, g0, b0)
delta = maxshade - minshade
h = 0
s = 0
l = 0
If (delta = 0) Then
h = 0
ElseIf (maxshade = r0) Then
h = ((g0 - b0) / delta)
If (h < 0) Then h = h + 6
ElseIf (maxshade = g0) Then
h = (b0 - r0) / delta + 2
Else
h = (r0 - g0) / delta + 4
End If
h = h * 60
If (h < 0) Then
h = h + 360
End If
l = (maxshade + minshade) / 2
If (delta = 0) Then
s = 0
Else
s = delta / (1 - Abs(2 * l - 1))
End If
l = l * 100
s = s * 100
If l > 100 Then l = 100
If s > 100 Then s = 100
End Sub
Function HSVtoRGB~& (h As Double, s As Double, v As Double)
Dim As Double c, x, m, r, g, b
If ((h > 360) Or (h < 0) Or (s > 100) Or (s < 0) Or (v > 100) Or (v < 0)) Then
Print "HSVtoRGB Out of range:"; h; s; v
Sleep
End If
s = s / 100
v = v / 100
c = s * v
x = c * (1 - Abs(fmod##(h / 60, 2) - 1))
m = v - c
If ((h >= 0) And (h < 60)) Then
r = c
g = x
b = 0
End If
If ((h >= 60) And (h < 120)) Then
r = x
g = c
b = 0
End If
If ((h >= 120) And (h < 180)) Then
r = 0
g = c
b = x
End If
If ((h >= 180) And (h < 240)) Then
r = 0
g = x
b = c
End If
If ((h >= 240) And (h < 300)) Then
r = x
g = 0
b = c
End If
If ((h >= 300) And (h <= 360)) Then
r = c
g = 0
b = x
End If
r = (r + m) * 255
g = (g + m) * 255
b = (b + m) * 255
HSVtoRGB~& = _RGB32(r, g, b, 255)
End Function
Function HSLtoRGB~& (h As Double, s As Double, l As Double)
Dim As Double c, x, m, r, g, b
If ((h > 360) Or (h < 0) Or (s > 100) Or (s < 0) Or (l > 100) Or (l < 0)) Then
Print "HSLtoRGB Out of range:"; h; s; l
Sleep
End If
s = s / 100
l = l / 100
c = (1 - Abs(2 * l - 1)) * s
x = c * (1 - Abs(fmod##(h / 60, 2) - 1))
m = l - c / 2
If ((h >= 0) And (h < 60)) Then
r = c
g = x
b = 0
End If
If ((h >= 60) And (h < 120)) Then
r = x
g = c
b = 0
End If
If ((h >= 120) And (h < 180)) Then
r = 0
g = c
b = x
End If
If ((h >= 180) And (h < 240)) Then
r = 0
g = x
b = c
End If
If ((h >= 240) And (h < 300)) Then
r = x
g = 0
b = c
End If
If ((h >= 300) And (h <= 360)) Then
r = c
g = 0
b = x
End If
r = (r + m) * 255
g = (g + m) * 255
b = (b + m) * 255
HSLtoRGB~& = _RGB32(r, g, b, 255)
End Function
Function HueToRGB~& (x As Double)
Dim As Double r, g, b
r = Abs(x * 6 - 3) - 1
g = 2 - Abs(x * 6 - 2)
b = 2 - Abs(x * 6 - 4)
HueToRGB~& = _RGB32(255 * r, 255 * g, 255 * b, 255)
End Function
Sub RGBtoHCV (h As Double, c As Double, v As Double, shade As _Unsigned Long)
Dim As Double r0, g0, b0
Dim As Vector4D p, q
r0 = _Red32(shade) / 255
g0 = _Green32(shade) / 255
b0 = _Blue32(shade) / 255
If (g0 < b0) Then
p.x = b0
p.y = g0
p.z = -1
p.t = 2 / 3
Else
p.x = g0
p.y = b0
p.z = 0
p.t = -1 / 3
End If
If (r0 < p.x) Then
q.x = p.x
q.y = p.y
q.z = p.t
q.t = r0
Else
q.x = r0
q.y = p.y
q.z = p.z
q.t = p.x
End If
c = q.x - Min2##(q.t, q.y)
h = Abs((q.t - q.y) / (6 * c + epsilon) + q.z)
v = q.x
End Sub
Sub RGBtoHCY (h As Double, c As Double, y As Double, shade As _Unsigned Long)
Dim As Double r0, g0, b0
Dim As Double v, t, z
Dim As Vector3D hcywts, w
r0 = _Red32(shade) / 255
g0 = _Green32(shade) / 255
b0 = _Blue32(shade) / 255
hcywts.x = .299
hcywts.y = .587
hcywts.z = .114
RGBtoHCV h, c, v, shade
t = (r0 * hcywts.x) + (g0 * hcywts.y) + (b0 * hcywts.z)
w.x = _Red32(HueToRGB~&(h)) / 255
w.y = _Green32(HueToRGB~&(h)) / 255
w.z = _Blue32(HueToRGB~&(h)) / 255
z = (w.x * hcywts.x) + (w.y * hcywts.y) + (w.z * hcywts.z)
If (t < z) Then
c = c * z / (epsilon + t)
Else
c = c * (1 - z) / (epsilon + 1 - t)
End If
y = t
End Sub
Function HCYtoRGB~& (h As Double, c As Double, y As Double)
Dim As Double r0, g0, b0
Dim As Double z, cf
Dim As _Unsigned Long shade
Dim As Vector3D hcywts
hcywts.x = .299
hcywts.y = .587
hcywts.z = .114
shade~& = HueToRGB~&(h)
r0 = _Red32(shade~&) / 255
g0 = _Green32(shade~&) / 255
b0 = _Blue32(shade~&) / 255
z = (r0 * hcywts.x) + (g0 * hcywts.y) + (b0 * hcywts.z)
If (y < z) Then
cf = c * y / z
ElseIf (z < 1) Then
cf = c * (1 - y) / (1 - z)
End If
r0 = (r0 - z) * cf + y
g0 = (g0 - z) * cf + y
b0 = (b0 - z) * cf + y
HCYtoRGB~& = _RGB32(r0 * 255, g0 * 255, b0 * 255, 255)
End Function
Sub RGBtoCMYK (c As Double, y As Double, m As Double, k As Double, shade As _Unsigned Long)
Dim As Double r0, g0, b0
Dim As Double maxshade
r0 = _Red32(shade~&) / 255
g0 = _Green32(shade~&) / 255
b0 = _Blue32(shade~&) / 255
maxshade = Max3##(r0, g0, b0)
k = 1 - maxshade
c = (1 - r0 - k) / (1 - k)
m = (1 - g0 - k) / (1 - k)
y = (1 - b0 - k) / (1 - k)
End Sub
Function CMYKtoRGB~& (c As Double, y As Double, m As Double, k As Double)
CMYKtoRGB~& = _RGB32(255 * (1 - c) * (1 - k), 255 * (1 - m) * (1 - k), 255 * (1 - y) * (1 - k), 255)
End Function
Sub SeedPalette (x As _Unsigned Long, y As Double, z As Double, r1 As Double, g1 As Double, b1 As Double, r2 As Double, g2 As Double, b2 As Double)
Dim As _Unsigned Long t1, t2
t1~& = ShadeRotate~&(x, y)
t2~& = ShadeRotate~&(x, y + z)
r1 = _Red32(t1~&)
g1 = _Green32(t1~&)
b1 = _Blue32(t1~&)
r2 = _Red32(t2~&)
g2 = _Green32(t2~&)
b2 = _Blue32(t2~&)
End Sub
Function ShadeRotate~& (c As _Unsigned Long, x As Double)
Dim As Double h, s, v
RGBtoHSV h, s, v, _Red32(c), _Green32(c), _Blue32(c)
h = h + x
Do While (h < 0)
h = 360 + h
Loop
Do While (h > 360)
h = h - 360
Loop
ShadeRotate~& = HSVtoRGB~&(h, s, v)
End Function
Function ShadeThreeShift~& (c As _Unsigned Long, x As _Unsigned Long, y As _Unsigned Long, z As _Unsigned Long)
Dim As Double r, g, b
Dim As Double xr, xg, xb, yr, yg, yb, zr, zg, zb
Dim As Double redf, grnf, bluf
r = _Red32(c) / 255
g = _Green32(c) / 255
b = _Blue32(c) / 255
xr = _Red32(x) / 255
xg = _Green32(x) / 255
xb = _Blue32(x) / 255
yr = _Red32(y) / 255
yg = _Green32(y) / 255
yb = _Blue32(y) / 255
zr = _Red32(z) / 255
zg = _Green32(z) / 255
zb = _Blue32(z) / 255
redf = (r * xr + g * yr + b * zr) * 255
grnf = (r * xg + g * yg + b * zg) * 255
bluf = (r * xb + g * yb + b * zb) * 255
ShadeThreeShift~& = _RGB32(redf, grnf, bluf, 255)
End Function
Function ShadeBlend~& (f As Double, x As _Unsigned Long, y As _Unsigned Long)
Dim As Double red, grn, blu, alf
red = (1 - f) * (_Red32(x)) + f * (_Red32(y))
grn = (1 - f) * (_Green32(x)) + f * (_Green32(y))
blu = (1 - f) * (_Blue32(x)) + f * (_Blue32(y))
alf = (1 - f) * (_Alpha32(x)) + f * (_Alpha32(y))
ShadeBlend~& = _RGB32(red, grn, blu, alf)
End Function
Function ShadeGreyscale~& (x As _Unsigned Long)
Dim As Double a
a = (1 / 3) * (_Red32(x) + _Green32(x) + _Blue32(x))
ShadeGreyscale~& = _RGB32(a, a, a, _Alpha32(x))
End Function
Function ShadeMesh~& (c As _Unsigned Long, x As Double, y As Double)
Dim As Double f
f = -x - y
ShadeMesh~& = ShadeIncrement~&(c, f, f, f, 0)
End Function
Function ShadeIncrement~& (c As _Unsigned Long, r As Double, g As Double, b As Double, a As Double)
Dim As Double red, grn, blu, alf
red = r + _Red32(c)
grn = g + _Green32(c)
blu = b + _Blue32(c)
alf = a + _Alpha32(c)
ShadeIncrement~& = _RGB32(red, grn, blu, alf)
End Function
Sub CPset (x0 As Double, y0 As Double, shade As _Unsigned Long)
PSet (_Width / 2 + x0, -y0 + _Height / 2), shade
End Sub
Function Min2## (x As Double, y As Double)
Dim TheReturn As Double
TheReturn = x
If (y < TheReturn) Then TheReturn = y
Min2## = TheReturn
End Function
Function Min3## (x As Double, y As Double, z As Double)
Dim TheReturn As Double
TheReturn = x
If (y < TheReturn) Then TheReturn = y
If (z < TheReturn) Then TheReturn = z
Min3## = TheReturn
End Function
Function Max3## (x As Double, y As Double, z As Double)
Dim TheReturn As Double
TheReturn = x
If (y > TheReturn) Then TheReturn = y
If (z > TheReturn) Then TheReturn = z
Max3## = TheReturn
End Function
Sub cadd (u As Double, v As Double, xx As Double, yy As Double, aa As Double, bb As Double)
Dim As Double x, y, a, b
x = xx
y = yy
a = aa
b = bb
u = x + a
v = y + b
End Sub
Sub cmul (u As Double, v As Double, xx As Double, yy As Double, aa As Double, bb As Double)
Dim As Double x, y, a, b
x = xx
y = yy
a = aa
b = bb
u = x * a - y * b
v = x * b + y * a
End Sub
Sub cdiv (u As Double, v As Double, xx As Double, yy As Double, aa As Double, bb As Double)
Dim As Double x, y, a, b, d
x = xx
y = yy
a = aa
b = bb
d = a * a + b * b
u = (x * a + y * b) / d
v = (y * a - x * b) / d
End Sub
Sub cexp (u As Double, v As Double, xx As Double, yy As Double, aa As Double, bb As Double)
Dim As Double x, y, a, b, lnz, argz, mag, ang
x = xx
y = yy
a = aa
b = bb
lnz = x * x + y * y
If (lnz = 0) Then
u = 0
v = 0
Else
lnz = 0.5 * Log(lnz)
argz = _Atan2(y, x)
mag = Exp(a * lnz - b * argz)
ang = a * argz + b * lnz
u = mag * Cos(ang)
v = mag * Sin(ang)
End If
End Sub
Sub clog (u As Double, v As Double, xx As Double, yy As Double)
Dim As Double x, y, lnz, argz
x = xx
y = yy
lnz = x * x + y * y
If (lnz = 0) Then
u = 0
v = 0
Else
lnz = 0.5 * Log(lnz)
argz = _Atan2(y, x)
u = lnz
v = argz
End If
End Sub
Function cosh## (x As Double)
cosh## = 0.5## * (Exp(x) + Exp(-x))
End Function
Function sinh## (x As Double)
sinh## = 0.5## * (Exp(x) - Exp(-x))
End Function
Sub sinz (u As Double, v As Double, xx As Double, yy As Double)
Dim As Double x, y
x = xx
y = yy
u = Sin(x) * cosh##(y)
v = Cos(x) * sinh##(y)
End Sub
Sub cosz (u As Double, v As Double, xx As Double, yy As Double)
Dim As Double x, y
x = xx
y = yy
u = Cos(x) * cosh##(y)
v = -Sin(x) * sinh##(y)
End Sub
Sub tanz (u As Double, v As Double, xx As Double, yy As Double)
Dim As Double x, y, a, b, c, d
x = xx
y = yy
sinz a, b, xx, yy
cosz c, d, xx, yy
cdiv u, v, a, b, c, d
End Sub
Function rgamma## (x)
rgamma## = Sqr(2 * Pi * x) * ((x / Exp(1)) ^ x)
End Function
Function facto& (x As Long)
If (x = 1) Then facto& = 1
If (x > 1) Then facto& = x * facto&(x - 1)
End Function
Sub cgamma (u As Double, v As Double, zx As Double, zy As Double)
'https://en.wikipedia.org/wiki/Lanczos_approximation
Dim As Double zzx, zzy, xx, xy, gx, gy, hx, hy, kx, ky, sx, sy, tx, ty, wx, wy
Dim As Integer i
Dim coeffs(8) As Double
coeffs(1) = 676.5203681218851
coeffs(2) = -1259.1392167224028
coeffs(3) = 771.32342877765313
coeffs(4) = -176.61502916214059
coeffs(5) = 12.507343278686905
coeffs(6) = -0.13857109526572012
coeffs(7) = 9.9843695780195716E-6
coeffs(8) = 1.5056327351493116E-7
If (zx < .5) Then
cadd tx, ty, 1, 0, -zx, -zy ' t = 1 - z
cgamma gx, gy, tx, ty ' g = gamma(t)
cmul wx, wy, Pi, 0, zx, zy ' w = pi * z
sinz sx, sy, wx, wy ' s = sin(w)
cmul hx, hy, gx, gy, sx, sy ' h = g * s
cdiv tx, ty, Pi, 0, hx, hy ' t = pi / h
u = tx ' y = t
v = ty
Else
cadd zzx, zzy, zx, zy, -1, 0 ' zz = z - 1
xx = 0.99999999999980993 ' x = 1
xy = 0
For i = 1 To UBound(coeffs)
tx = 1 ' t = 1
ty = 0
cadd tx, ty, tx, ty, i, 0 ' t = t + i
cadd tx, ty, tx, ty, zzx, zzy ' t = t + zz
cdiv gx, gy, coeffs(i), 0, tx, ty ' g = pval / t
cadd xx, xy, xx, xy, gx, gy ' x = x + g
Next
tx = -.5 ' t = -.5
ty = 0
cadd tx, ty, tx, ty, zzx, zzy ' t = t + zz
cadd tx, ty, tx, ty, UBound(coeffs), 0 ' t = t + len(p)
cadd gx, gy, zzx, zzy, .5, 0 ' g = zz + .5
cexp sx, sy, tx, ty, gx, gy ' s = t ^ g
cexp wx, wy, Exp(1), 0, -tx, -ty ' w = e^(-t)
cmul hx, hy, wx, wy, xx, xy ' h = w * x
cmul kx, ky, sx, sy, hx, hy ' k = s * h
cmul wx, wy, Sqr(2 * Pi), 0, kx, ky ' w = sqrt(2pi) * k
u = wx ' y = w
v = wy
End If
End Sub
Sub cgamma2 (u As Double, v As Double, zx As Double, zy As Double)
'http://www.mrob.com/pub/ries/lanczos-gamma.html
Dim As Double zzx, zzy, xx, xy, gx, gy, hx, hy, kx, ky, sx, sy, tx, ty, wx, wy
Dim As Integer i
Dim coeffs(8) As Double
coeffs(1) = 676.5203681218851
coeffs(2) = -1259.1392167224028
coeffs(3) = 771.32342877765313
coeffs(4) = -176.61502916214059
coeffs(5) = 12.507343278686905
coeffs(6) = -0.13857109526572012
coeffs(7) = 9.9843695780195716E-6
coeffs(8) = 1.5056327351493116E-7
If (zx < .5) Then
cadd tx, ty, 1, 0, -zx, -zy ' t = 1 - z
cgamma2 gx, gy, tx, ty ' g = gamma(t)
cmul wx, wy, Pi, 0, zx, zy ' w = pi * z
sinz sx, sy, wx, wy ' s = sin(w)
cdiv hx, hy, Pi, 0, sx, sy ' h = pi / sin(w)
clog tx, ty, hx, hy ' t = log(h)
cadd u, v, tx, ty, -gx, -gy ' y = t - g
Else
Dim As Double basex, basey, lnsqrt2pi
lnsqrt2pi = 0.91893853320467274178
cadd zzx, zzy, zx, zy, -1, 0 ' zz = z - 1
cadd basex, basey, zzx, zzy, 8 + .5, 0 ' base = z + 8 + .5
xx = 0 ' x = 0
xy = 0
For i = UBound(coeffs) To 2 Step -1
cadd tx, ty, zzx, zzy, i, 0 ' t = z + i
cdiv wx, wy, coeffs(i), 0, tx, ty ' w = pval / t
cadd xx, xy, xx, xy, wx, wy ' x = x + w
Next
cadd xx, xy, xx, xy, coeffs(1), 0
cadd tx, ty, zzx, zzy, .5, 0 ' t = z + .5
clog wx, wy, basex, basey ' w = log(base)
cmul kx, ky, wx, wy, tx, ty ' k = w * t
clog sx, sy, xx, xy ' s = log(x)
cadd gx, gy, lnsqrt2pi, 0, sx, sy ' g = lnsqrt2pi + log(x)
cadd hx, hy, gx, gy, -basex, -basey ' h = g - base
cadd u, v, hx, hy, kx, ky ' y = h + k
End If
End Sub
Sub AddShade (TheLabel As String, TheShade As _Unsigned Long)
SpectrumCount = SpectrumCount + 1
Spectrum(SpectrumCount).Index = SpectrumCount
Spectrum(SpectrumCount).Label = TheLabel
Spectrum(SpectrumCount).Shade = TheShade
End Sub
Function PaletteIndexFromLabel (x As String)
Dim TheReturn As Long
TheReturn = -1
Dim j As Long
For j = 1 To UBound(CustomPalette)
If (x = CustomPalette(j).Label) Then
TheReturn = j
End If
Next
PaletteIndexFromLabel = TheReturn
End Function
Function IndexFromShadeLabel (x As String)
Dim TheReturn As Long
TheReturn = -1
Dim j As Long
For j = 1 To UBound(Spectrum)
If (x = Spectrum(j).Label) Then
TheReturn = j
End If
Next
IndexFromShadeLabel = TheReturn
End Function
Function IndexFromShade (x As _Unsigned Long)
Dim TheReturn As Long
TheReturn = -1
Dim j As Long
For j = 1 To UBound(Spectrum)
If (x = Spectrum(j).Shade) Then
TheReturn = j
End If
Next
IndexFromShade = TheReturn
End Function
Sub AddPaletteByLabel (TheLabel As String, Shade1 As String, Shade2 As String, Shade3 As String)
PaletteCount = PaletteCount + 1
CustomPalette(PaletteCount).Index = PaletteCount
CustomPalette(PaletteCount).Label = TheLabel
CustomPalette(PaletteCount).Shades.x = Spectrum(IndexFromShadeLabel(Shade1)).Shade
CustomPalette(PaletteCount).Shades.y = Spectrum(IndexFromShadeLabel(Shade2)).Shade
CustomPalette(PaletteCount).Shades.z = Spectrum(IndexFromShadeLabel(Shade3)).Shade
End Sub
Sub AddPaletteByLiteral (TheLabel As String, Shade1 As _Unsigned Long, Shade2 As _Unsigned Long, Shade3 As _Unsigned Long)
PaletteCount = PaletteCount + 1
CustomPalette(PaletteCount).Index = PaletteCount
CustomPalette(PaletteCount).Label = TheLabel
CustomPalette(PaletteCount).Shades.x = Shade1
CustomPalette(PaletteCount).Shades.y = Shade2
CustomPalette(PaletteCount).Shades.z = Shade3
End Sub
Sub AddPaletteBySeed (TheLabel As String, x As _Unsigned Long, y As Double, z As Double)
Dim As Vector3D ctmp1, ctmp2
SeedPalette x, y, z, ctmp1.x, ctmp1.y, ctmp1.z, ctmp2.x, ctmp2.y, ctmp2.z
Call AddPaletteByLiteral(TheLabel, x, _RGB32(ctmp1.x, ctmp1.y, ctmp1.z, 255), _RGB32(ctmp2.x, ctmp2.y, ctmp2.z, 255))
End Sub
Sub AddPaletteAnalogous (TheLabel As String, x As _Unsigned Long)
Dim As Vector3D ctmp1, ctmp2
SeedPalette x, 30, 30, ctmp1.x, ctmp1.y, ctmp1.z, ctmp2.x, ctmp2.y, ctmp2.z
Call AddPaletteByLiteral(TheLabel, x, _RGB32(ctmp1.x, ctmp1.y, ctmp1.z, 255), _RGB32(ctmp2.x, ctmp2.y, ctmp2.z, 255))
End Sub
Sub AddPaletteGradient (TheLabel As String, x As _Unsigned Long, y As _Unsigned Long)
Call AddPaletteByLiteral(TheLabel, x, y, ShadeBlend~&(.5, x, y))
End Sub
Sub AddPaletteSplitCom (TheLabel As String, x As _Unsigned Long)
Dim As Vector3D ctmp1, ctmp2
SeedPalette x, 30, 140, ctmp1.x, ctmp1.y, ctmp1.z, ctmp2.x, ctmp2.y, ctmp2.z
Call AddPaletteByLiteral(TheLabel, x, _RGB32(ctmp1.x, ctmp1.y, ctmp1.z, 255), _RGB32(ctmp2.x, ctmp2.y, ctmp2.z, 255))
End Sub
Sub AddPaletteTriadic (TheLabel As String, x As _Unsigned Long)
Dim As Vector3D ctmp1, ctmp2
SeedPalette x, 120, 120, ctmp1.x, ctmp1.y, ctmp1.z, ctmp2.x, ctmp2.y, ctmp2.z
Call AddPaletteByLiteral(TheLabel, x, _RGB32(ctmp1.x, ctmp1.y, ctmp1.z, 255), _RGB32(ctmp2.x, ctmp2.y, ctmp2.z, 255))
End Sub
Function ExhibitIndexFromLabel& (x As String)
Dim TheReturn As Long
TheReturn = -1
Dim j As Long
For j = 1 To UBound(Exhibit)
If (x = Exhibit(j)) Then
TheReturn = j
End If
Next
ExhibitIndexFromLabel& = TheReturn
End Function
Sub AddAllPalettes
Call AddPaletteByLabel("rgb", "red", "lime", "blue")
'
Call AddPaletteByLabel("americana", "dark red", "snow", "cyan-blue azure")
Call AddPaletteByLabel("apple tree", "dark red", "light green", "beauty bush")
Call AddPaletteAnalogous("blue analogous", Spectrum(IndexFromShadeLabel("blue")).Shade)
Call AddPaletteGradient("blue grey gradient", Spectrum(IndexFromShadeLabel("blue")).Shade, Spectrum(IndexFromShadeLabel("grey")).Shade)
Call AddPaletteSplitCom("blue split com", Spectrum(IndexFromShadeLabel("blue")).Shade)
Call AddPaletteTriadic("blue triadic", Spectrum(IndexFromShadeLabel("blue")).Shade)
Call AddPaletteByLabel("couceiro", "orchid white", "shadow green", "harley davidson orange")
Call AddPaletteByLabel("cub scout", "sandy brown", "cyan-blue azure", "dark golden rod")
Call AddPaletteByLabel("dobra", "scarlet", "orange", "raw umber")
Call AddPaletteByLabel("e ink", "medium carmine", "kaitoke green", "jelly bean")
Call AddPaletteByLabel("e ink 2", "medium carmine", "rob roy", "cello")
Call AddPaletteByLabel("endor", "rosy brown", "tropical rain forest", "tan")
Call AddPaletteByLabel("egypt", "sandy brown", "purple", "orange")
Call AddPaletteByLabel("gorn", "tenne", "islamic green", "dark grey 2")
Call AddPaletteByLabel("kasana", "tropical rain forest", "electric lime", "gorse")
Call AddPaletteAnalogous("lime analogous", Spectrum(IndexFromShadeLabel("lime")).Shade)
Call AddPaletteGradient("lime blue gradient", Spectrum(IndexFromShadeLabel("lime")).Shade, Spectrum(IndexFromShadeLabel("blue")).Shade)
Call AddPaletteSplitCom("lime split com", Spectrum(IndexFromShadeLabel("lime")).Shade)
Call AddPaletteTriadic("lime triadic", Spectrum(IndexFromShadeLabel("lime")).Shade)
Call AddPaletteByLabel("lylac bush", "spring green", "dark orchid", "dark grey")
Call AddPaletteByLabel("nightsun", "sunglow", "medium slate blue", "firebrick")
Call AddPaletteByLabel("plasma rifle", "navy", "cyan", "st. patrick's blue")
Call AddPaletteAnalogous("red analogous", Spectrum(IndexFromShadeLabel("red")).Shade)
Call AddPaletteGradient("red blue gradient", Spectrum(IndexFromShadeLabel("red")).Shade, Spectrum(IndexFromShadeLabel("blue")).Shade)
Call AddPaletteSplitCom("red split com", Spectrum(IndexFromShadeLabel("red")).Shade)
Call AddPaletteTriadic("red triadic", Spectrum(IndexFromShadeLabel("red")).Shade)
Call AddPaletteByLabel("rites of spring", "straw", "brown derby", "saltpan")
Call AddPaletteByLabel("sea dawn", "dark slate grey", "pale golden rod", "orange")
Call AddPaletteByLabel("starry nights", "st. patrick's blue", "cyan-blue azure", "carrot orange")
Call AddPaletteByLabel("van interior", "dim grey", "navajo white", "grey")
Call AddPaletteByLabel("vietnam", "tropical rain forest", "cadet blue", "brown derby")
End Sub
Sub AddAllShades
'https://www.color-blindness.com/color-name-hue/
Call AddShade("black", _RGB32(0, 0, 0, 255))
Call AddShade("white", _RGB32(255, 255, 255, 255))
'
Call AddShade("red", _RGB32(255, 0, 0, 255))
Call AddShade("lime", _RGB32(0, 255, 0, 255))
Call AddShade("blue", _RGB32(0, 0, 255, 255))
'
Call AddShade("cyan", _RGB32(0, 255, 255, 255))
Call AddShade("magenta", _RGB32(255, 0, 255, 255))
Call AddShade("yellow", _RGB32(255, 255, 0, 255))
'
Call AddShade("alice blue", _RGB32(240, 248, 255, 255))
Call AddShade("antique white", _RGB32(250, 235, 215, 255))
Call AddShade("apache", _RGB32(214, 173, 96, 255))
Call AddShade("aprocot white", _RGB32(244, 235, 208, 255))
Call AddShade("aqua", _RGB32(0, 255, 255, 255))
Call AddShade("aqua marine", _RGB32(127, 255, 212, 255))
Call AddShade("azure", _RGB32(240, 255, 255, 255))
Call AddShade("beauty bush", _RGB32(232, 180, 184, 255))
Call AddShade("beige", _RGB32(245, 245, 220, 255))
Call AddShade("bisque", _RGB32(255, 228, 196, 255))
Call AddShade("blanched almond", _RGB32(255, 235, 205, 255))
Call AddShade("blue violet", _RGB32(138, 43, 226, 255))
Call AddShade("booger buster", _RGB32(232, 225, 99, 255))
Call AddShade("burgundy", _RGB32(135, 10, 48, 255))
Call AddShade("bridesmaid", _RGB32(250, 232, 224, 255))
Call AddShade("brown", _RGB32(165, 42, 42, 255))
Call AddShade("brown derby", _RGB32(94, 80, 60, 255))
Call AddShade("burly wood", _RGB32(222, 184, 135, 255))
Call AddShade("cadet blue", _RGB32(95, 158, 160, 255))
Call AddShade("cardin green", _RGB32(18, 38, 32, 255))
Call AddShade("carrot orange", _RGB32(219, 144, 28, 255))
Call AddShade("cello", _RGB32(57, 71, 84, 255))
Call AddShade("charlotte", _RGB32(160, 231, 229, 255))
Call AddShade("chartreuse", _RGB32(127, 255, 0, 255))
Call AddShade("cinnabar", _RGB32(269, 63, 55, 255))
Call AddShade("chocolate", _RGB32(210, 105, 30, 255))
Call AddShade("christalle", _RGB32(38, 33, 97, 255))
Call AddShade("classic rose", _RGB32(242, 197, 224, 255))
Call AddShade("coral", _RGB32(255, 127, 80, 255))
Call AddShade("corn flower blue", _RGB32(100, 149, 237, 255))
Call AddShade("corn silk", _RGB32(255, 248, 220, 255))
Call AddShade("crimson", _RGB32(220, 20, 60, 255))
Call AddShade("cruise", _RGB32(182, 226, 211, 255))
Call AddShade("cyan-blue azure", _RGB32(72, 136, 200, 255))
Call AddShade("dark blue", _RGB32(0, 0, 139, 255))
Call AddShade("dark cerulean", _RGB32(5, 68, 94, 255))
Call AddShade("dark cyan", _RGB32(0, 139, 139, 255))
Call AddShade("dark golden rod", _RGB32(184, 134, 11, 255))
Call AddShade("dark grey", _RGB32(169, 169, 169, 255))
Call AddShade("dark grey 2", _RGB32(170, 170, 170, 255))
Call AddShade("dark green", _RGB32(0, 100, 0, 255))
Call AddShade("dark khaki", _RGB32(189, 183, 107, 255))
Call AddShade("dark magenta", _RGB32(139, 0, 139, 255))
Call AddShade("dark olive green", _RGB32(85, 107, 47, 255))
Call AddShade("dark orchid", _RGB32(153, 50, 204, 255))
Call AddShade("dark orange", _RGB32(255, 140, 0, 255))
Call AddShade("dark red", _RGB32(139, 0, 0, 255))
Call AddShade("dark salmon", _RGB32(233, 150, 122, 255))
Call AddShade("dark sea green", _RGB32(143, 188, 143, 255))
Call AddShade("dark sky blue", _RGB32(127, 197, 220, 255))
Call AddShade("dark slate blue", _RGB32(72, 61, 139, 255))
Call AddShade("dark slate grey", _RGB32(47, 79, 79, 255))
Call AddShade("dark turquoise", _RGB32(0, 206, 209, 255))
Call AddShade("dark violet", _RGB32(148, 0, 211, 255))
Call AddShade("deep cerise", _RGB32(212, 55, 144, 255))
Call AddShade("deep pink", _RGB32(255, 20, 147, 255))
Call AddShade("deep sky blue", _RGB32(0, 191, 255, 255))
Call AddShade("dim grey", _RGB32(105, 105, 105, 255))
Call AddShade("dodger blue", _RGB32(30, 144, 255, 255))
Call AddShade("electric lime", _RGB32(189, 233, 2, 255))
Call AddShade("dusty grey", _RGB32(164, 147, 147, 255))
Call AddShade("firebrick", _RGB32(178, 34, 34, 255))
Call AddShade("floral white", _RGB32(255, 250, 240, 255))
Call AddShade("forest green", _RGB32(34, 139, 34, 255))
Call AddShade("gainsboro", _RGB32(220, 220, 220, 255))
Call AddShade("ghost white", _RGB32(248, 248, 255, 255))
Call AddShade("gold", _RGB32(255, 215, 0, 255))
Call AddShade("golden rod", _RGB32(218, 165, 32, 255))
Call AddShade("gorse", _RGB32(254, 240, 39, 255))
Call AddShade("grey", _RGB32(128, 128, 128, 255))
Call AddShade("green", _RGB32(0, 128, 0, 255))
Call AddShade("green yellow", _RGB32(173, 255, 47, 255))
Call AddShade("harley davidson orange", _RGB32(231, 50, 19, 255))
Call AddShade("honeydew", _RGB32(240, 255, 240, 255))
Call AddShade("hot pink", _RGB32(255, 105, 180, 255))
Call AddShade("indigo", _RGB32(75, 0, 130, 255))
Call AddShade("indian red", _RGB32(205, 92, 92, 255))
Call AddShade("islamic green", _RGB32(0, 170, 0, 255))
Call AddShade("ivory", _RGB32(255, 255, 240, 255))
Call AddShade("jelly bean", _RGB32(73, 124, 143, 255))
Call AddShade("kaitoke green", _RGB32(39, 86, 70, 255))
Call AddShade("khaki", _RGB32(240, 230, 140, 255))
Call AddShade("lavender", _RGB32(230, 230, 250, 255))
Call AddShade("lavender blush", _RGB32(255, 240, 245, 255))
Call AddShade("lawn green", _RGB32(124, 252, 0, 255))
Call AddShade("lemon chiffon", _RGB32(255, 250, 205, 255))
Call AddShade("licorice", _RGB32(51, 54, 82, 255))
Call AddShade("light blue", _RGB32(173, 216, 230, 255))
Call AddShade("light coral", _RGB32(239, 124, 142, 255))
Call AddShade("light coral 2", _RGB32(240, 128, 128, 255))
Call AddShade("light cyan", _RGB32(224, 255, 255, 255))
Call AddShade("light golden rod yellow", _RGB32(250, 250, 210, 255))
Call AddShade("light grey", _RGB32(211, 211, 211, 255))
Call AddShade("light green", _RGB32(144, 238, 144, 255))
Call AddShade("light pink", _RGB32(255, 174, 188, 255))
Call AddShade("light pink 2", _RGB32(255, 182, 193, 255))
Call AddShade("light salmon", _RGB32(255, 160, 122, 255))
Call AddShade("light sea green", _RGB32(24, 54, 180, 255))
Call AddShade("light sea green 2", _RGB32(32, 178, 170, 255))
Call AddShade("light slate grey", _RGB32(119, 136, 153, 255))
Call AddShade("light sky blue", _RGB32(135, 206, 250, 255))
Call AddShade("light steel blue", _RGB32(176, 196, 222, 255))
Call AddShade("light yellow", _RGB32(255, 255, 224, 255))
Call AddShade("lime green", _RGB32(50, 205, 50, 255))
Call AddShade("linen", _RGB32(250, 240, 230, 255))
Call AddShade("maastricht blue", _RGB32(11, 30, 56, 255))
Call AddShade("magic mint", _RGB32(180, 248, 200, 255))
Call AddShade("marigold", _RGB32(182, 141, 64, 255))
Call AddShade("maroon", _RGB32(128, 0, 0, 255))
Call AddShade("medium aqua marine", _RGB32(102, 205, 170, 255))
Call AddShade("medium blue", _RGB32(0, 0, 205, 255))
Call AddShade("medium carmine", _RGB32(182, 55, 49, 255))
Call AddShade("medium orchid", _RGB32(186, 85, 211, 255))
Call AddShade("medium purple", _RGB32(147, 112, 219, 255))
Call AddShade("medium sea green", _RGB32(60, 179, 113, 255))
Call AddShade("medium slate blue", _RGB32(123, 104, 238, 255))
Call AddShade("medium spring green", _RGB32(0, 250, 154, 255))
Call AddShade("medium turquoise", _RGB32(72, 209, 204, 255))
Call AddShade("medium violet red", _RGB32(199, 21, 133, 255))
Call AddShade("midnight blue", _RGB32(25, 25, 112, 255))
Call AddShade("mint cream", _RGB32(245, 255, 250, 255))
Call AddShade("misty rose", _RGB32(255, 228, 225, 255))
Call AddShade("moccasin", _RGB32(255, 228, 181, 255))
Call AddShade("my sin", _RGB32(251, 175, 65, 255))
Call AddShade("navajo white", _RGB32(255, 222, 173, 255))
Call AddShade("navy", _RGB32(0, 0, 128, 255))
Call AddShade("navy 2", _RGB32(0, 12, 102, 255))
Call AddShade("oasis", _RGB32(251, 231, 198, 255))
Call AddShade("olive", _RGB32(128, 128, 0, 255))
Call AddShade("olive drab", _RGB32(107, 142, 35, 255))
Call AddShade("onahau", _RGB32(212, 241, 244, 255))
Call AddShade("orange", _RGB32(255, 165, 0, 255))
Call AddShade("orange 2", _RGB32(255, 166, 0, 255))
Call AddShade("orange red", _RGB32(255, 69, 0, 255))
Call AddShade("orchid", _RGB32(218, 112, 214, 255))
Call AddShade("orchid white", _RGB32(239, 230, 213, 255))
Call AddShade("old lace", _RGB32(253, 245, 230, 255))
Call AddShade("pale chestnut", _RGB32(216, 167, 177, 255))
Call AddShade("pale golden rod", _RGB32(238, 232, 170, 255))
Call AddShade("pale green", _RGB32(152, 251, 152, 255))
Call AddShade("pale turquoise", _RGB32(175, 238, 238, 255))
Call AddShade("pale violet red", _RGB32(219, 112, 147, 255))
Call AddShade("papaya whip", _RGB32(255, 239, 213, 255))
Call AddShade("peach puff", _RGB32(255, 218, 185, 255))
Call AddShade("peru", _RGB32(205, 133, 63, 255))
Call AddShade("pink", _RGB32(255, 192, 203, 255))
Call AddShade("plum", _RGB32(221, 160, 221, 255))
Call AddShade("pot pourri", _RGB32(238, 214, 211, 255))
Call AddShade("powder blue", _RGB32(176, 224, 230, 255))
Call AddShade("purple", _RGB32(128, 0, 128, 255))
Call AddShade("raw umber", _RGB32(77, 105, 16, 255))
Call AddShade("rob roy", _RGB32(218, 166, 82, 255))
Call AddShade("rosy brown", _RGB32(188, 143, 143, 255))
Call AddShade("royal blue", _RGB32(65, 105, 225, 255))
Call AddShade("saddle brown", _RGB32(139, 69, 19, 255))
Call AddShade("salmon", _RGB32(250, 128, 114, 255))
Call AddShade("saltpan", _RGB32(229, 240, 222, 255))
Call AddShade("sandy brown", _RGB32(244, 164, 96, 255))
Call AddShade("sapphire", _RGB32(5, 10, 48, 255))
Call AddShade("scarlet", _RGB32(255, 23, 0, 255))
Call AddShade("sea green", _RGB32(46, 139, 87, 255))
Call AddShade("sea shell", _RGB32(255, 245, 238, 255))
Call AddShade("shadow green", _RGB32(157, 190, 183, 255))
Call AddShade("shocking", _RGB32(236, 143, 208, 255))
Call AddShade("sienna", _RGB32(160, 82, 45, 255))
Call AddShade("silver", _RGB32(192, 192, 192, 255))
Call AddShade("sky blue", _RGB32(135, 206, 235, 255))
Call AddShade("slate blue", _RGB32(106, 90, 205, 255))
Call AddShade("slate grey", _RGB32(112, 128, 144, 255))
Call AddShade("snow", _RGB32(255, 250, 250, 255))
Call AddShade("spray", _RGB32(126, 200, 227, 255))
Call AddShade("spring green", _RGB32(0, 255, 127, 255))
Call AddShade("st. patrick's blue", _RGB32(23, 54, 121, 255))
Call AddShade("straw", _RGB32(217, 175, 122, 255))
Call AddShade("steel blue", _RGB32(70, 130, 180, 255))
Call AddShade("sunglow", _RGB32(250, 208, 44, 255))
Call AddShade("tan", _RGB32(210, 180, 140, 255))
Call AddShade("teal", _RGB32(0, 128, 128, 255))
Call AddShade("tenne", _RGB32(170, 85, 0, 255))
Call AddShade("thistle", _RGB32(216, 191, 216, 255))
Call AddShade("tomato", _RGB32(255, 99, 71, 255))
Call AddShade("tropical rain forest", _RGB32(1, 133, 88, 255))
Call AddShade("turquoise", _RGB32(64, 224, 208, 255))
Call AddShade("turquoise blue", _RGB32(117, 230, 218, 255))
Call AddShade("violet", _RGB32(238, 130, 238, 255))
Call AddShade("wheat", _RGB32(245, 222, 179, 255))
Call AddShade("white smoke", _RGB32(245, 245, 245, 255))
Call AddShade("yellow green", _RGB32(154, 205, 50, 255))
Call AddShade("zambezi", _RGB32(103, 89, 94, 255))
End Sub
