Microsoft Small Basic

Program Listing: QRC070-3
' Draw Cuboid
' Version 0.4
' Copyright © 2016 Nonki Takahashi. The MIT License.
' Program ID QRC070-3
'
GraphicsWindow.Title = "Draw Cuboid 0.4"
GraphicsWindow.BackgroundColor = "White"
threepoint = "True"
debug = "False"
Init()
param = "x=6;y=5;z=0;width=6;height=6;depth=6;color=#FF6600"
DrawCuboid()
param = "x=0;y=6;z=2;width=5;height=5;depth=5;color=#00CCFF;"
DrawCuboid()
param = "x=4;y=0;z=3;width=4;height=4;depth=4;color=#00FF33;"
DrawCuboid()
Sub Init
UNDEFINED = "N/A"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
xo = 0.45 * gw
yo = 0.66 * gh
u = 30
ru = u * Math.SquareRoot(2 / 3)
If threepoint THen
rv = 4 * gw
Else
rv = "∞"
EndIf
a60 = Math.GetRadians(60)
Colors_Init()
vx["x"] = xo + rv * Math.Sin(-a60)
vx["y"] = yo - rv * Math.Cos(-a60)
vy["x"] = xo + rv * Math.Sin(a60)
vy["y"] = yo - rv * Math.Cos(a60)
vz["x"] = xo
vz["y"] = yo + rv
EndSub
Sub CalcColors
color = param["color"]
If color = "Transparent" Then
transparent = "True"
color = "Black"
Else
transparent = "False"
EndIf
Color_NameToRGB()
colorLeft = color
Color_RGBtoHSL()
savedLightness = lightness
lightness = Math.Min(savedLightness * 1.2, 1)
Color_HSLtoRGB()
colorTop = color
lightness = Math.Max(savedLightness * 0.8, 0)
Color_HSLtoRGB()
colorRight = color
If transparent Then
colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2)
colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2)
colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2)
EndIf
EndSub
Sub CalcVertex
' Calcurate vertex between line p1-p2 and line p3-p4
a = p1["x"] * p2["y"] - p1["y"] * p2["x"]
b = p1["y"] - p2["y"]
c = p1["x"] - p2["x"]
d = p3["x"] * p4["y"] - p3["y"] * p4["x"]
e = p3["y"] - p4["y"]
f = p3["x"] - p4["x"]
If b = 0 Then
p["y"] = a / c
p["x"] = (f * p["y"] - d) / e
ElseIf c = 0 Then
p["x"] = -a / b
p["y"] = (e * p["x"] + d) / f
Else
p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f))
p["y"] = (a + b * p["x"]) / c
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()
If rv = "∞" Then
x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"]
y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"]
GraphicsWindow.BrushColor = colorTop
x1 = x0
y1 = y0 - ru
x2 = x0 + ru * Math.Sin(-a60)
y2 = y0 - ru * Math.Cos(-a60)
x3 = x0 + ru * Math.Sin(a60)
y3 = y0 - ru * Math.Cos(a60)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + ru * Math.Sin(-a60)
y1 = y0 - ru * Math.Cos(-a60)
x2 = x0 + ru * Math.Sin(a60)
y2 = y0 - ru * Math.Cos(a60)
x3 = x0
y3 = y0
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorLeft
x1 = x0 + ru * Math.Sin(-a60)
y1 = y0 - ru * Math.Cos(-a60)
x2 = x0
y2 = y0
x3 = x0
y3 = y0 + ru
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + ru * Math.Sin(-a60)
y1 = y0 - ru * Math.Cos(-a60)
x2 = x0 + ru * Math.Sin(-2 * a60)
y2 = y0 - ru * Math.Cos(-2 * a60)
x3 = x0
y3 = y0 + ru
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorRight
x1 = x0 + ru * Math.Sin(a60)
y1 = y0 - ru * Math.Cos(a60)
x2 = x0
y2 = y0
x3 = x0
y3 = y0 + ru
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = x0 + ru * Math.Sin(a60)
y1 = y0 - ru * Math.Cos(a60)
x2 = x0 + ru * Math.Sin(2 * a60)
y2 = y0 - ru * Math.Cos(2 * a60)
x3 = x0
y3 = y0 + ru
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
Else
GraphicsWindow.BrushColor = colorTop
sx = param["x"] + 1
sy = param["y"] + 1
sz = param["z"]
Map2D()
pxy = p
sx = param["x"] + 1
sy = param["y"]
sz = param["z"]
Map2D()
px = p
sx = param["x"]
sy = param["y"] + 1
sz = param["z"]
Map2D()
py = p
sx = param["x"]
sy = param["y"]
sz = param["z"]
Map2D()
po = p
x1 = pxy["x"]
y1 = pxy["y"]
x2 = px["x"]
y2 = px["y"]
x3 = py["x"]
y3 = py["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = px["x"]
y1 = px["y"]
x2 = py["x"]
y2 = py["y"]
x3 = po["x"]
y3 = po["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorLeft
sx = param["x"] + 1
sy = param["y"]
sz = param["z"] + 1
Map2D()
pxz = p
sx = param["x"]
sy = param["y"]
sz = param["z"] + 1
Map2D()
pz = p
x1 = px["x"]
y1 = px["y"]
x2 = pxz["x"]
y2 = pxz["y"]
x3 = pz["x"]
y3 = pz["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = px["x"]
y1 = px["y"]
x2 = po["x"]
y2 = po["y"]
x3 = pz["x"]
y3 = pz["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorRight
sx = param["x"]
sy = param["y"] + 1
sz = param["z"] + 1
Map2D()
pyz = p
x1 = py["x"]
y1 = py["y"]
x2 = po["x"]
y2 = po["y"]
x3 = pz["x"]
y3 = pz["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = py["x"]
y1 = py["y"]
x2 = pyz["x"]
y2 = pyz["y"]
x3 = pz["x"]
y3 = pz["y"]
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
EndIf
EndSub
Sub Map2D
' param sx, sy, sz ≧ 0
' return p["x"], p["y"]
k = (rv - ru) / (rv + ru)
If sx = 0 Then
rx = 0
Else
rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru
EndIf
If sy = 0 Then
ry = 0
Else
ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru
EndIf
If sz = 0 Then
rz = 0
Else
rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru
EndIf
If debug Then
TextWIndow.WriteLine("sz=" + sz)
TextWIndow.WriteLine("logsz=" + Math.Log(sz))
TextWindow.WriteLine("rx=" + rx)
TextWindow.WriteLine("ry=" + ry)
TextWindow.WriteLine("rz=" + rz)
EndIf
_px["x"] = xo + rx * Math.Sin(-a60)
_px["y"] = yo - rx * Math.Cos(-a60)
If debug Then
GraphicsWindow.PenColor = "Black"
GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"])
EndIf
_py["x"] = xo + ry * Math.Sin(a60)
_py["y"] = yo - ry * Math.Cos(a60)
If debug Then
GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"])
EndIf
_pz["x"] = xo
_pz["y"] = yo + rz
If debug Then
GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"])
EndIf
p1 = _px
p2 = vy
p3 = _py
p4 = vx
CalcVertex()
If debug Then
GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"])
GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"])
EndIf
_pxy = p
p1 = _px
p2 = vz
p3 = _pz
p4 = vx
CalcVertex()
If debug Then
GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"])
GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"])
EndIf
_pxz = p
p1 = _pxz
p2 = vy
p3 = _pxy
p4 = vz
CalcVertex()
If debug Then
GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"])
GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"])
GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5)
GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5)
bc = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")")
GraphicsWindow.BrushColor = bc
EndIf
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
n2 = lightness * (1 + saturation)
Else
n2 = lightness + saturation - lightness * saturation
EndIf
n1 = 2 * lightness - n2
If saturation = 0 Then
r = Math.Round(lightness * 255)
g = Math.Round(lightness * 255)
b = Math.Round(lightness * 255)
Else
h = hue + 120
Color_Value()
r = value
h = hue
Color_Value()
g = value
h = hue - 120
Color_Value()
b = value
EndIf
color = GraphicsWindow.GetColorFromRGB(r, g, b)
EndSub
Sub Color_NameToRGB
' Color | Convert Color to RGB
' param color - color name
' returns color -"#rrggbb"
If Text.StartsWith(color, "#") Then
color = Text.ConvertToUpperCase(color)
Else
color = Text.ConvertToLowerCase(color)
color = colors[color]
EndIf
EndSub
Sub Color_Value
' Color | Function value
' param n1, n2
' param h - [-120, 480)
' return value - 0..255
If h >= 360 Then
h = h - 360
EndIF
If h < 0 Then
h = h + 360
EndIF
If h < 60 Then
v = n1 + (n2 - n1) * h / 60
ElseIf h < 180 Then
v = n2
ElseIf h < 240 Then
v = n1 + (n2 - n1) * (240 - h) / 60
Else
v = n1
EndIf
value = Math.Round(v * 255)
EndSub
Sub Color_RGBtoGray
' Color | Convert RGB to Gray
' param color - "#rrggbb"
' return brightness - (0, 1)
' return gray - "#rrggbb"
Color_NameToRGB()
sR = Text.GetSubText(color, 2, 2)
sG = Text.GetSubText(color, 4, 2)
sB = Text.GetSubText(color, 6, 2)
hex = sR
Math_Hex2Dec()
r = dec
hex = sG
Math_Hex2Dec()
g = dec
hex = sB
Math_Hex2Dec()
b = dec
min = Math.Min(Math.Min(r, g), b)
level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7)
brightness = Math.Round(level / 255 * 10000) / 10000
gray = GraphicsWindow.GetColorFromRGB(level, level, level)
EndSub
Sub Color_RGBtoHSL
' Color | Convert RGB to HSL
' param color - "#rrggbb"
' return hue - [0, 360) or UNDEFINED
' return lightness - (0, 1)
' return saturation - (0, 1)
Color_NameToRGB()
sR = Text.GetSubText(color, 2, 2)
sG = Text.GetSubText(color, 4, 2)
sB = Text.GetSubText(color, 6, 2)
hex = sR
Math_Hex2Dec()
' r = dec / 255 ' occurs Math.Max() bug
r = Math.Round(dec / 255 * 10000) / 10000
hex = sG
Math_Hex2Dec()
' g = dec / 255 ' occurs Math.Max() bug
g = Math.Round(dec / 255 * 10000) / 10000
hex = sB
Math_Hex2Dec()
' b = dec / 255 ' occurs Math.Max() bug
b = Math.Round(dec / 255 * 10000) / 10000
max = Math.Max(r, g)
max = Math.Max(max, b)
min = Math.Min(r, g)
min = Math.Min(min, b)
lightness = (max + min) / 2
If max = min Then ' r = g = b
saturation = 0
hue = UNDEFINED
Else
If lightness <= 0.5 Then
saturation = (max - min) / (max + min)
Else
saturation = (max - min) / (2 - max - min)
EndIf
rc = (max - r) / (max - min)
gc = (max - g) / (max - min)
bc = (max - b) / (max - min)
If r = max Then ' between Yellow and Magenta
hue = bc - gc
ElseIf g = max Then ' between Cyan and Yellow
hue = 2 + rc - bc
ElseIf b = max Then ' between Magenta and Cyan
hue = 4 + gc - rc
Else
TextWindow.WriteLine("Error:")
TextWindow.WriteLine("max=" + max)
TextWindow.WriteLine("r=" + r + ",sR=" + sR)
TextWindow.WriteLine("g=" + g + ",sG=" + sG)
TextWindow.WriteLine("b=" + b + ",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 gray - "#rrggbb"
iGray = Math.Round(lightness * 255)
gray = 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 hex
' return dec
dec = 0
len = Text.GetLength(hex)
For ptr = 1 To len
dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1))
EndFor
EndSub