Microsoft Small Basic

Program Listing: JWS691-0

List Program

' Color Calculator 0.21
' Copyright (c) 2013-2014 Nonki Takahashi. All rights reserved.
'
' History:
' 0.21 2014-05-29 Simplified Mix operator. (JWS691-0)
' o.2 2013-12-11 Added Inherit operator.
' 0.1 2013-12-09 Created. (JWS691)
'
title = "Color Calculator 0.21"
GraphicsWindow.Title = title
Not = "True=False;False=True;"
Colors_Init()
Color_OpInit()
GraphicsWindow.Width = 624
GraphicsWindow.Height = 443
GraphicsWindow.BackgroundColor = "LightGray"
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = 20
param = "caption=color1;left=20;top=20;width=200;"
AddTextBoxWithCaption()
box1 = return
color1 = "#FF9933"
Controls.SetTextBoxText(box1, color1)
param = "caption=color2;left=20;top=60;width=200;"
AddTextBoxWithCaption()
box2 = return
color2 = "#9933FF"
Controls.SetTextBoxText(box2, color2)
AddButtons()
op = "Add"
ShowResults()
Controls.TextTyped = OnTextTyped
While "True"
If statusChanged Then
ShowResults()
statusChanged = "False"
Else
Program.Delay(200)
EndIf
EndWhile
Sub AddButtons
n = Array.GetItemCount(ops)
index = Array.GetAllIndices(ops)
x = 330
y = 20
For i = 1 To n
dx = Math.Floor((index[i] - 1) / 9) * 70
dy = Math.Remainder(index[i] - 1, 9) * 44
buttonOps[i] = Controls.AddButton(ops[index[i]], x + dx, y + dy)
EndFor
Controls.ButtonClicked = OnButtonClicked
EndSub
Sub AddTextBoxWithCaption
' param["caption"] - caption text
' param["left"] - left x coordinate
' param["top"] - top y coodinate
' param["width"] - width of text box
' return return - text box
Stack.PushValue("local", local)
local["caption"] = Shapes.AddText(param["caption"])
local["fs"] = GraphicsWindow.FontSize
Shapes.Move(local["caption"], param["left"], param["top"] + Math.Floor(local["fs"] * 0.2))
local["dx"] = Math.Floor(local["fs"] * (Text.GetLength(param["caption"]) + 1) * 0.5)
return = Controls.AddTextBox(param["left"] + local["dx"], param["top"])
local["height"] = Math.Floor(local["fs"] * 1.6)
Controls.SetSize(return, param["width"], local["height"])
local = Stack.PopValue("local")
EndSub
Sub OnButtonClicked
n = Array.GetItemCount(ops)
index = Array.GetAllIndices(ops)
For i = 1 To n
If buttonOps[i] = Controls.LastClickedButton Then
op = ops[index[i]]
statusChanged = "True"
Goto break
EndIf
EndFor
break:
EndSub
Sub OnTextTyped
If Controls.LastTypedTextBox = box1 Then
color = Controls.GetTextBoxText(box1)
Color_NameToRGB()
color1 = color
statusChanged = "True"
ElseIf Controls.LastTypedTextBox = box2 Then
color = Controls.GetTextBoxText(box2)
Color_NameToRGB()
color2 = color
statusChanged = "True"
Else
statusChanged = "False"
EndIf
EndSub
Sub ShowResults
x = 40
y = 140
size = 200
GraphicsWindow.FontSize = 14
GraphicsWindow.BrushColor = "LightGray"
GraphicsWindow.FillRectangle(x, y, size, 16)
GraphicsWindow.FillRectangle(x + 40, y + size + 60 , size, 16)
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(x, y, color1)
GraphicsWindow.DrawText(x + 40 , y + size + 60, color2)
GraphicsWindow.BrushColor = color1
GraphicsWindow.FillRectangle(x, y + 20 , size, size)
GraphicsWindow.BrushColor = color2
GraphicsWindow.FillRectangle(x + 40, y + 60, size, size)
Color_Op()
color3 = color
GraphicsWindow.BrushColor = color3
GraphicsWindow.FillRectangle(x + 40, y + 60, size - 40, size - 40)
Stack.PushValue("local", op)
op = "Caption"
Color_Op()
GraphicsWindow.BrushColor = color
GraphicsWindow.DrawText(x + 40, y + 60, color3)
op = Stack.PopValue("local")
GraphicsWindow.Title = title + " | " + op + " : " + exp[op]
EndSub
Sub Color_NameToRGB
' Color | Convert Color to RGB
' param color - color name
' returns color -"#rrggbb"
If Text.StartsWith(color, "#") Then
If Text.GetLength(color) = 9 Then
color = "#" + Text.GetSubText(color, 4, 6)
EndIf
If Text.GetLength(color) = 7 Then
color = Text.ConvertToUpperCase(color)
Else
color = "#000000"
EndIf
Else
color = Text.ConvertToLowerCase(color)
color = colors[color]
If color = "" Then
color = "#000000"
EndIf
EndIf
EndSub
Sub Color_Op
' param op - operator
' param color1, color2 - for binary operation
' param color - for unary operation
' return color - result
If Array.ContainsValue(ops, op) Then
color = color1
Color_RGBToValues()
rgb1 = rgb
color = color2
Color_RGBToValues()
rgb2 = rgb
Else
Color_RGBToValues()
EndIf
If op = "Add" Then
For i = 1 To 3
rgb[i] = Math.Min(rgb1[i] + rgb2[i], 255)
EndFor
ElseIf op = "Sub" Then
For i = 1 To 3
rgb[i] = Math.Max(rgb1[i] - rgb2[i], 0)
EndFor
ElseIf op = "Mul" Then
For i = 1 To 3
rgb[i] = Math.Min(rgb1[i] * rgb2[i], 255)
EndFor
ElseIf op = "Div" Then
For i = 1 To 3
If rgb2[i] = 0 Then
rgb[i] = 255
Else
rgb[i] = Math.Floor(rgb1[i] / rgb2[i])
EndIf
EndFor
ElseIf op = "Mod" Then
For i = 1 To 3
If rgb2[i] = 0 Then
rgb[i] = 255
Else
rgb[i] = Math.Remainder(rgb1[i], rgb2[i])
EndIf
EndFor
ElseIf op = "Max" Then
For i = 1 To 3
rgb[i] = Math.Max(rgb1[i], rgb2[i])
EndFor
ElseIf op = "Min" Then
For i = 1 To 3
rgb[i] = Math.Min(rgb1[i], rgb2[i])
EndFor
ElseIf op = "Gap" Then
For i = 1 To 3
rgb[i] = Math.Abs(rgb1[i] - rgb2[i])
EndFor
ElseIf op = "Inherit" Then
i1 = Math.GetRandomNumber(6)
m1 = Math.Remainder(i1 - 1, 3) + 1
For i = 1 To 3
If (i1 <= 3 And i = m1) Or (4 <= i1 And i <> m1) Then
rgb[i] = rgb1[i]
Else
rgb[i] = rgb2[i]
EndIf
EndFor
ElseIf op = "Or" Or op = "Nor" Then
For i = 1 To 3
dec = rgb1[i]
Math_Dec2Bin()
bin1 = bin
dec = rgb2[i]
Math_Dec2Bin()
bin2 = bin
Math_Or()
Math_Bin2Dec()
If op = "Or" Then
rgb[i] = dec
Else
rgb[i] = 255 - dec
EndIf
EndFor
ElseIf op = "And" Or op = "Nand" Then
For i = 1 To 3
dec = rgb1[i]
Math_Dec2Bin()
bin1 = bin
dec = rgb2[i]
Math_Dec2Bin()
bin2 = bin
Math_And()
Math_Bin2Dec()
If op = "And" Then
rgb[i] = dec
Else
rgb[i] = 255 - dec
EndIf
EndFor
ElseIf op = "Xor" Then
For i = 1 To 3
dec = rgb1[i]
Math_Dec2Bin()
bin1 = bin
dec = rgb2[i]
Math_Dec2Bin()
bin2 = bin
Math_Xor()
Math_Bin2Dec()
rgb[i] = dec
EndFor
ElseIf op = "Ave" Then
For i = 1 To 3
rgb[i] = Math.Floor((rgb1[i] + rgb2[i]) / 2)
EndFor
ElseIf op = "Mix" Then
For i = 1 To 3
rgb[i] = Math.Max(rgb1[i] + rgb2[i] - 255, 0)
EndFor
ElseIf op = "Invert" Then
For i = 1 To 3
rgb[i] = 255 - rgb[i]
EndFor
ElseIf op = "Gray" Then
min = Math.Min(Math.Min(rgb[1], rgb[2]), rgb[3])
level = min + Math.Round(((rgb[1] - min) * 2 + (rgb[2] - min) * 4 + (rgb[2] - min) * 1 ) / 7)
For i = 1 To 3
rgb[i] = level
EndFor
ElseIf op = "Caption" Then
min = Math.Min(Math.Min(rgb[1], rgb[2]), rgb[3])
level = min + Math.Round(((rgb[1] - min) * 2 + (rgb[2] - min) * 4 + (rgb[2] - min) * 1 ) / 7)
If level < 128 Then
caption = 255
Else
caption = 0
EndIf
For i = 1 To 3
rgb[i] = caption
EndFor
EndIf
color = GraphicsWindow.GetColorFromRGB(rgb[1], rgb[2], rgb[3])
EndSub
Sub Color_OpInit
ops = "1=Add;2=Sub;3=Mul;4=Div;5=Mod;"
ops = ops + "10=Or;11=And;12=Xor;13=Nor;14=Nand;"
ops = ops + "19=Max;20=Min;21=Gap;22=Inherit;"
ops = ops + "28=Ave;29=Mix;"
exp["Add"] = "min(i1+i2,255)"
exp["Sub"] = "max(i1-i2,0)"
exp["Mul"] = "min(i1*i2,255)"
exp["Div"] = "if(i2=0)?255:(i1/i2)"
exp["Mod"] = "if(i2=0)?255:mod(i1,i2)"
exp["Or"] = "i1|i2"
exp["And"] = "i1&i2"
exp["Xor"] = "i1^i2"
exp["Nor"] = "^(i1|i2)"
exp["Nand"] = "^(i1&i2)"
exp["Max"] = "max(i1,i2)"
exp["Min"] = "min(i1,i2)"
exp["Gap"] = "|i1-i2|"
exp["Inherit"] = "i1 or i2"
exp["Ave"] = "(i1+i2)/2"
exp["Mix"] = "max(i1+i2-255,0)"
EndSub
Sub Color_RGBToValues
' param color - "#rrggbb" or color name
' return rgb[] - 0..255 for each red, green, and blue
red = Text.GetSubText(color, 2, 2)
green = Text.GetSubText(color, 4, 2)
blue = Text.GetSubText(color, 6, 2)
hex = red
Math_Hex2Dec()
rgb[1] = dec
hex = green
Math_Hex2Dec()
rgb[2] = dec
hex = blue
Math_Hex2Dec()
rgb[3] = dec
EndSub
Sub Color_RGBtoGray
' Color | Convert RGB to Gray
' param color - "#rrggbb"
' return brightness - (0, 1)
' return gray - "#rrggbb"
Color_RGBToValues()
min = Math.Min(Math.Min(rgb[1], rgb[2]), rgb[3])
level = min + Math.Round(((rgb[1] - min) * 2 + (rgb[2] - min) * 4 + (rgb[2] - min) * 1 ) / 7)
brightness = Math.Round(level / 255 * 10000) / 10000
gray = GraphicsWindow.GetColorFromRGB(level, level, level)
EndSub
Sub Colors_Init
colors["aliceblue"]="#F0F8FF"
colors["antiquewhite"]="#FAEBD7"
colors["aqua"]="#00FFFF"
colors["aquamarine"]="#7FFFD4"
colors["azure"]="#F0FFFF"
colors["beige"]="#F5F5DC"
colors["bisque"]="#FFE4C4"
colors["black"]="#000000"
colors["blanchedalmond"]="#FFEBCD"
colors["blue"]="#0000FF"
colors["blueviolet"]="#8A2BE2"
colors["brown"]="#A52A2A"
colors["burlywood"]="#DEB887"
colors["cadetblue"]="#5F9EA0"
colors["chartreuse"]="#7FFF00"
colors["chocolate"]="#D2691E"
colors["coral"]="#FF7F50"
colors["cornflowerblue"]="#6495ED"
colors["cornsilk"]="#FFF8DC"
colors["crimson"]="#DC143C"
colors["cyan"]="#00FFFF"
colors["darkblue"]="#00008B"
colors["darkcyan"]="#008B8B"
colors["darkgoldenrod"]="#B8860B"
colors["darkgray"]="#A9A9A9"
colors["darkgreen"]="#006400"
colors["darkkhaki"]="#BDB76B"
colors["darkmagenta"]="#8B008B"
colors["darkolivegreen"]="#556B2F"
colors["darkorange"]="#FF8C00"
colors["darkorchid"]="#9932CC"
colors["darkred"]="#8B0000"
colors["darksalmon"]="#E9967A"
colors["darkseagreen"]="#8FBC8F"
colors["darkslateblue"]="#483D8B"
colors["darkslategray"]="#2F4F4F"
colors["darkturquoise"]="#00CED1"
colors["darkviolet"]="#9400D3"
colors["deeppink"]="#FF1493"
colors["deepskyblue"]="#00BFFF"
colors["dimgray"]="#696969"
colors["dodgerblue"]="#1E90FF"
colors["firebrick"]="#B22222"
colors["floralwhite"]="#FFFAF0"
colors["forestgreen"]="#228B22"
colors["fuchsia"]="#FF00FF"
colors["gainsboro"]="#DCDCDC"
colors["ghostwhite"]="#F8F8FF"
colors["gold"]="#FFD700"
colors["goldenrod"]="#DAA520"
colors["gray"]="#808080"
colors["green"]="#008000"
colors["greenyellow"]="#ADFF2F"
colors["honeydew"]="#F0FFF0"
colors["hotpink"]="#FF69B4"
colors["indianred"]="#CD5C5C"
colors["indigo"]="#4B0082"
colors["ivory"]="#FFFFF0"
colors["khaki"]="#F0E68C"
colors["lavender"]="#E6E6FA"
colors["lavenderblush"]="#FFF0F5"
colors["lawngreen"]="#7CFC00"
colors["lemonchiffon"]="#FFFACD"
colors["lightblue"]="#ADD8E6"
colors["lightcoral"]="#F08080"
colors["lightcyan"]="#E0FFFF"
colors["lightgoldenrodyellow"]="#FAFAD2"
colors["lightgray"]="#D3D3D3"
colors["lightgreen"]="#90EE90"
colors["lightpink"]="#FFB6C1"
colors["lightsalmon"]="#FFA07A"
colors["lightseagreen"]="#20B2AA"
colors["lightskyblue"]="#87CEFA"
colors["lightslategray"]="#778899"
colors["lightsteelblue"]="#B0C4DE"
colors["lightyellow"]="#FFFFE0"
colors["lime"]="#00FF00"
colors["limegreen"]="#32CD32"
colors["linen"]="#FAF0E6"
colors["magenta"]="#FF00FF"
colors["maroon"]="#800000"
colors["mediumaquamarine"]="#66CDAA"
colors["mediumblue"]="#0000CD"
colors["mediumorchid"]="#BA55D3"
colors["mediumpurple"]="#9370DB"
colors["mediumseagreen"]="#3CB371"
colors["mediumslateblue"]="#7B68EE"
colors["mediumspringgreen"]="#00FA9A"
colors["mediumturquoise"]="#48D1CC"
colors["mediumvioletred"]="#C71585"
colors["midnightblue"]="#191970"
colors["mintcream"]="#F5FFFA"
colors["mistyrose"]="#FFE4E1"
colors["moccasin"]="#FFE4B5"
colors["navajowhite"]="#FFDEAD"
colors["navy"]="#000080"
colors["oldlace"]="#FDF5E6"
colors["olive"]="#808000"
colors["olivedrab"]="#6B8E23"
colors["orange"]="#FFA500"
colors["orangered"]="#FF4500"
colors["orchid"]="#DA70D6"
colors["palegoldenrod"]="#EEE8AA"
colors["palegreen"]="#98FB98"
colors["paleturquoise"]="#AFEEEE"
colors["palevioletred"]="#DB7093"
colors["papayawhip"]="#FFEFD5"
colors["peachpuff"]="#FFDAB9"
colors["peru"]="#CD853F"
colors["pink"]="#FFC0CB"
colors["plum"]="#DDA0DD"
colors["powderblue"]="#B0E0E6"
colors["purple"]="#800080"
colors["red"]="#FF0000"
colors["rosybrown"]="#BC8F8F"
colors["royalblue"]="#4169E1"
colors["saddlebrown"]="#8B4513"
colors["salmon"]="#FA8072"
colors["sandybrown"]="#F4A460"
colors["seagreen"]="#2E8B57"
colors["seashell"]="#FFF5EE"
colors["sienna"]="#A0522D"
colors["silver"]="#C0C0C0"
colors["skyblue"]="#87CEEB"
colors["slateblue"]="#6A5ACD"
colors["slategray"]="#708090"
colors["snow"]="#FFFAFA"
colors["springgreen"]="#00FF7F"
colors["steelblue"]="#4682B4"
colors["tan"]="#D2B48C"
colors["teal"]="#008080"
colors["thistle"]="#D8BFD8"
colors["tomato"]="#FF6347"
colors["turquoise"]="#40E0D0"
colors["violet"]="#EE82EE"
colors["wheat"]="#F5DEB3"
colors["white"]="#FFFFFF"
colors["whitesmoke"]="#F5F5F5"
colors["yellow"]="#FFFF00"
colors["yellowgreen"]="#9ACD32"
EndSub
Sub Math_And
' Math | Binary And
' param bin1 - binary 1
' param bin2 - binary 2
' return bin - bin1 and bin2
len1 = Text.GetLength(bin1)
len2 = Text.GetLength(bin2)
If len1 < len2 Then
bin1 = Text.Append(Text.GetSubText("00000000", 1, len2 - len1), bin1)
ElseIf len2 < len1 Then
bin2 = Text.Append(Text.GetSubText("00000000", 1, len1 - len2), bin2)
EndIf
len = Math.Max(len1, len2)
bin = ""
For ptr = 1 To len
b1 = Text.GetSubText(bin1, ptr, 1)
b2 = Text.GetSubText(bin2, ptr, 1)
If b1 = 1 And b2 = 1 Then
bin = Text.Append(bin, "1")
Else
bin = Text.Append(bin, "0")
EndIf
EndFor
EndSub
Sub Math_Bin2Dec
' Math | Convert hexadecimal to decimal
' param bin - binary
' return dec - decimal
dec = 0
len = Text.GetLength(bin)
For ptr = 1 To len
dec = dec * 2 + Text.GetSubText(bin, ptr, 1)
EndFor
EndSub
Sub Math_Dec2Bin
' Math | Convert hexadecimal to decimal
' param dec - decimal
' return bin - binary
bin = ""
While 0 < dec
bin = Text.Append(Math.Remainder(dec, 2), bin)
dec = Math.Floor(dec / 2)
EndWhile
EndSub
Sub Math_Hex2Dec
' Math | Convert hexadecimal to decimal
' param hex - hexadecimal
' return dec - decimal
dec = 0
len = Text.GetLength(hex)
For ptr = 1 To len
dec = dec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) - 1
EndFor
EndSub
Sub Math_Or
' Math | Binary Or
' param bin1 - binary 1
' param bin2 - binary 2
' return bin - bin1 or bin2
len1 = Text.GetLength(bin1)
len2 = Text.GetLength(bin2)
If len1 < len2 Then
bin1 = Text.Append(Text.GetSubText("00000000", 1, len2 - len1), bin1)
ElseIf len2 < len1 Then
bin2 = Text.Append(Text.GetSubText("00000000", 1, len1 - len2), bin2)
EndIf
len = Math.Max(len1, len2)
bin = ""
For ptr = 1 To len
b1 = Text.GetSubText(bin1, ptr, 1)
b2 = Text.GetSubText(bin2, ptr, 1)
If b1 = 0 And b2 = 0 Then
bin = Text.Append(bin, "0")
Else
bin = Text.Append(bin, "1")
EndIf
EndFor
EndSub
Sub Math_Xor
' Math | Binary Xor
' param bin1 - binary 1
' param bin2 - binary 2
' return bin - bin1 xor bin2
len1 = Text.GetLength(bin1)
len2 = Text.GetLength(bin2)
If len1 < len2 Then
bin1 = Text.Append(Text.GetSubText("00000000", 1, len2 - len1), bin1)
ElseIf len2 < len1 Then
bin2 = Text.Append(Text.GetSubText("00000000", 1, len1 - len2), bin2)
EndIf
len = Math.Max(len1, len2)
bin = ""
For ptr = 1 To len
b1 = Text.GetSubText(bin1, ptr, 1)
b2 = Text.GetSubText(bin2, ptr, 1)
If b1 = b2 Then
bin = Text.Append(bin, "0")
Else
bin = Text.Append(bin, "1")
EndIf
EndFor
EndSub