Microsoft Small Basic

Program Listing: QRC070

List Program

' Draw Cuboid
' Version 0.1
' Copyright © 2016 Nonki Takahashi. The MIT License.
'
GraphicsWindow.Title = "Draw Cuboid 0.1"
GraphicsWindow.BackgroundColor = "LightGray"
Init()
' buildings
param = "x=7;y=0;width=5;height=10;depth=1;"
For z = 0 To -12 Step -1
If Math.Remainder(z, 2) = 0 Then
param["color"] = "Blue"
Else
param["color"] = "Transparent"
EndIf
param["z"] = z
DrawCuboid()
EndFor
param = "x=0;y=0;width=5;height=10;depth=1;"
For z = 0 To -10 Step -1
If Math.Remainder(z, 2) = 0 Then
param["color"] = "White"
Else
param["color"] = "Transparent"
EndIf
param["z"] = z
DrawCuboid()
EndFor
' car
param = "x=-2;y=1;z=0;color=Black;"
DrawVoxel()
param = "x=-4;y=1;z=0;color=Black;"
DrawVoxel()
param = "x=-2;y=4;z=0;color=Black;"
DrawVoxel()
param = "x=-4;y=4;z=0;color=Black;"
DrawVoxel()
param = "x=-4;y=1;z=-1;width=3;height=5;depth=1;color=Red;"
DrawCuboid()
param = "x=-2;y=0;z=-1;color=Yellow;"
DrawVoxel()
param = "x=-3;y=0;z=-1;color=Red;"
DrawVoxel()
param = "x=-4;y=0;z=-1;color=Yellow;"
DrawVoxel()
param = "x=-4;y=1;z=-2;width=3;height=1;depth=1;color=Transparent;"
DrawCuboid()
' person
param = "x=-2;y=-2;z=0;color=Blue;"
DrawVoxel()
param = "x=-2;y=-2;z=-1;color=Yellow;"
DrawVoxel()
Sub CalcColors
sColor = param["color"]
If sColor = "Transparent" Then
transparent = "True"
sColor = "Black"
Else
transparent = "False"
EndIf
Color_NameToRGB()
colorLeft = sColor
Color_RGBtoHSL()
savedLightness = lightness
lightness = Math.Min(savedLightness * 1.2, 1)
Color_HSLtoRGB()
colorTop = sColor
lightness = Math.Max(savedLightness * 0.8, 0)
Color_HSLtoRGB()
colorRight = sColor
If transparent Then
colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2)
colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2)
colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2)
EndIf
EndSub
Sub DrawCuboid
Stack.PushValue("local", param)
xmin = param["x"]
ymin = param["y"]
zmin = param["z"]
xmax = param["width"] + xmin - 1
ymax = param["height"] + ymin - 1
zmax = param["depth"] + zmin - 1
param = "color=" + param["color"] + ";"
For _z = zmax To zmin Step -1
param["z"] = _z
For _y = ymax To ymin Step -1
param["y"] = _y
For _x = xmax To xmin Step -1
param["x"] = _x
DrawVoxel()
EndFor
EndFor
EndFor
param = Stack.PopValue("local")
EndSub
Sub DrawVoxel
CalcColors()
x0 = xo + r * Math.Sin(a60) * param["y"] + r * Math.Sin(-a60) * param["x"]
y0 = yo - r * Math.Cos(a60) * param["y"] + r * param["z"] - r * Math.Cos(-a60) * param["x"]
GraphicsWindow.BrushColor = colorTop
x1 = x0
y1 = y0 - r
x2 = x0 + r * Math.Sin(-a60)
y2 = y0 - r * Math.Cos(-a60)
x3 = x0 + r * Math.Sin(a60)
y3 = y0 - r * Math.Cos(a60)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + r * Math.Sin(-a60)
y1 = y0 - r * Math.Cos(-a60)
x2 = x0 + r * Math.Sin(a60)
y2 = y0 - r * Math.Cos(a60)
x3 = x0
y3 = y0
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorLeft
x1 = x0 + r * Math.Sin(-a60)
y1 = y0 - r * Math.Cos(-a60)
x2 = x0
y2 = y0
x3 = x0
y3 = y0 + r
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + r * Math.Sin(-a60)
y1 = y0 - r * Math.Cos(-a60)
x2 = x0 + r * Math.Sin(-2 * a60)
y2 = y0 - r * Math.Cos(-2 * a60)
x3 = x0
y3 = y0 + r
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorRight
x1 = x0 + r * Math.Sin(a60)
y1 = y0 - r * Math.Cos(a60)
x2 = x0
y2 = y0
x3 = x0
y3 = y0 + r
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + r * Math.Sin(a60)
y1 = y0 - r * Math.Cos(a60)
x2 = x0 + r * Math.Sin(2 * a60)
y2 = y0 - r * Math.Cos(2 * a60)
x3 = x0
y3 = y0 + r
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
EndSub
Sub Init
UNDEFINED = "N/A"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
xo = gw / 2
yo = gh * 3 / 4
u = 20
r = u * Math.SquareRoot(2 / 3)
a60 = Math.GetRadians(60)
Colors_Init()
EndSub
Sub Color_HSLtoRGB
' Color | Convert HSL to RGB
' param hue - [0, 360) or UNDEFINED
' param lightness - [0, 1]
' param saturation - [0, 1]
' return color - "#rrggbb"
If lightness <= 0.5 Then
rN2 = lightness * (1 + saturation)
Else
rN2 = lightness + saturation - lightness * saturation
EndIf
rN1 = 2 * lightness - rN2
If saturation = 0 Then
iR = Math.Round(lightness * 255)
iG = Math.Round(lightness * 255)
iB = Math.Round(lightness * 255)
Else
rH = hue + 120
Color_Value()
iR = iValue
rH = hue
Color_Value()
iG = iValue
rH = hue - 120
Color_Value()
iB = iValue
EndIf
sColor = GraphicsWindow.GetColorFromRGB(iR, iG, iB)
EndSub
Sub Color_NameToRGB
' Color | Convert Color to RGB
' param sColor - color name
' returns sColor -"#rrggbb"
If Text.StartsWith(sColor, "#") Then
sColor = Text.ConvertToUpperCase(sColor)
Else
sColor = Text.ConvertToLowerCase(sColor)
sColor = colors[sColor]
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 Color_RGBtoGray
' Color | Convert RGB to Gray
' param sColor - "#rrggbb"
' return rBrightness - (0, 1)
' return sGray - "#rrggbb"
Color_NameToRGB()
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
iMin = Math.Min(Math.Min(iR, iG), iB)
iLevel = iMin + Math.Round(((iR - iMin) * 2 + (iG - iMin) * 4 + (iB - iMin) * 1 ) / 7)
rBrightness = Math.Round(iLevel / 255 * 10000) / 10000
sGray = GraphicsWindow.GetColorFromRGB(iLevel, iLevel, iLevel)
EndSub
Sub Color_RGBtoHSL
' Color | Convert RGB to HSL
' param sColor - "#rrggbb"
' return hue - [0, 360) or UNDEFINED
' return lightness - (0, 1)
' return saturation - (0, 1)
Color_NameToRGB()
sR = Text.GetSubText(sColor, 2, 2)
sG = Text.GetSubText(sColor, 4, 2)
sB = Text.GetSubText(sColor, 6, 2)
sHex = sR
Math_Hex2Dec()
' rR = iDec / 255 ' occurs Math.Max() bug
rR = Math.Round(iDec / 255 * 10000) / 10000
sHex = sG
Math_Hex2Dec()
' rG = iDec / 255 ' occurs Math.Max() bug
rG = Math.Round(iDec / 255 * 10000) / 10000
sHex = sB
Math_Hex2Dec()
' rB = iDec / 255 ' occurs Math.Max() bug
rB = Math.Round(iDec / 255 * 10000) / 10000
rMax = Math.Max(rR, rG)
rMax = Math.Max(rMax, rB)
rMin = Math.Min(rR, rG)
rMin = Math.Min(rMin, rB)
lightness = (rMax + rMin) / 2
If rMax = rMin Then ' rR = rG = rB
saturation = 0
hue = UNDEFINED
Else
If lightness <= 0.5 Then
saturation = (rMax - rMin) / (rMax + rMin)
Else
saturation = (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
hue = rBC - rGC
ElseIf rG = rMax Then ' between Cyan and Yellow
hue = 2 + rRC - rBC
ElseIf rB = rMax Then ' between Magenta and Cyan
hue = 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
hue = hue * 60
If hue < 0 Then
hue = hue + 360
EndIf
EndIf
EndSub
Sub Color_GrayFromLightness
' Color | Gray from lightness
' param lightness - 0..255
' return sGray - "#rrggbb"
iGray = Math.Round(lightness * 255)
sGray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray)
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_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