Microsoft Small Basic

Program Listing: SZG869-0

List Program

' 3-D House
' Version 1.9
' Copyright © 2016-2017 Nonki Takahashi. The MIT License.
' Program ID SZG869-0

GraphicsWindow.Title = "3-D House"
bg = "#448822"
GraphicsWindow.BackgroundColor = bg
threepoint = "False"
debug = "False"
Init()
InitHouse()
bx = 8
by = 0
bz = 5
DrawBlock()

Sub Init
UNDEFINED = "N/A"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
xo = 0.8 * gw
yo = 0.6 * gh
u = 15
ru = u * Math.SquareRoot(2 / 3)
a60 = Math.GetRadians(60)
a120 = Math.GetRadians(120)
If threepoint Then
rv = 2 * gw
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
Else
rv = "∞"
EndIf
' X:Wall | D:Door | W:Window | R:Roof | P:Solar Panel | F:Floor | O:Oven
palette = "X=#EEEEEE;D=#442200;W=Transparent;R=#3333CC;"
palette = palette + "P=#111111;F=#884400;O=DimGray;"
EndSub

Sub InitHouse
xmax = 29
ymax = 12
zmax = 11

block[0][13] = "0----+----1----+----2----+----"
block[0][12] = " "
block[0][11] = " XXX "
block[0][10] = " X X "
block[0][9] = " XXX "
block[0][8] = " "
block[0][7] = "RRRRRRRRRRRRRRRRRRRRRRRRRRRRRR"
block[0][6] = " R "
block[0][5] = " R "
block[0][4] = " R "
block[0][3] = " R "
block[0][2] = " R "
block[0][1] = " R "
block[0][0] = " R "

block[1][12] = " "
block[1][11] = " XXX "
block[1][10] = " X X "
block[1][9] = " XXX "
block[1][8] = "RRRRRRRRRRRRRRRRRRRRRRRRRRRRRR"
block[1][7] = " X X X X "
block[1][6] = "RRRRR RRRRRRRRRRRRRRRRRRRRRRRR"
block[1][5] = " R R PPPP PPPP PPPP "
block[1][4] = " R R "
block[1][3] = " R R "
block[1][2] = " R R "
block[1][1] = " RXR "
block[1][0] = " R R "

block[2][12] = " "
block[2][11] = " XXX "
block[2][10] = " X X "
block[2][9] = "RRRRXXXRRRRRRRRRRRRRRRRRRRRRRR"
block[2][8] = " X X X X "
block[2][7] = " X X X X "
block[2][6] = " X X "
block[2][5] = "RRRR RRRRRRRRRRRRRRRRRRRRRRR"
block[2][4] = " R R PPPP PPPP PPPP "
block[2][3] = " R R "
block[2][2] = " R R "
block[2][1] = " RXXXR "
block[2][0] = " R R "

block[3][12] = " "
block[3][11] = " XXX "
block[3][10] = "RRRRX XRRRRRRRRRRRRRRRRRRRRRRR"
block[3][9] = " X XXX X X X "
block[3][8] = " X X X X "
block[3][7] = " X X X X "
block[3][6] = " X X "
block[3][5] = " X X "
block[3][4] = "RRR RRRRRRRRRRRRRRRRRRRRRR"
block[3][3] = " R R PPPP PPPP PPPP "
block[3][2] = " R R "
block[3][1] = " RXXXXXR "
block[3][0] = " R R "

block[4][12] = " "
block[4][11] = "RRRRXXXRRRRRRRRRRRRRRRRRRRRRRR"
block[4][10] = " X XX XX X X X "
block[4][9] = " X XXXXX X X X "
block[4][8] = " X X X X "
block[4][7] = " X X X X "
block[4][6] = " X X "
block[4][5] = " X X "
block[4][4] = " X X "
block[4][3] = "RR RRRRRRRRRRRRRRRRRRRRR"
block[4][2] = " R R "
block[4][1] = " RXXXXXXXR "
block[4][0] = " R R "

block[5][12] = "RRRRRRRRRRRRRRRRRRRRRRRRRRRRRR"
block[5][11] = " XXXXXXXXXXXXXXXXXXXXXXXXXXXX "
block[5][10] = " XXX XXX X X "
block[5][9] = " XXXXXXXXX X X "
block[5][8] = " X X X X "
block[5][7] = " X X X X "
block[5][6] = " X X "
block[5][5] = " X X "
block[5][4] = " X X "
block[5][3] = "RX XXXXXXXXXXXXXXXXXXXX "
block[5][2] = "RX XRRRRRRRRRRRRRRRRRRRR"
block[5][1] = "RXXXXXXXXXR "
block[5][0] = "R R "

block[6][12] = " "
block[6][11] = " XXXXXXXXXXXX XXXXXX XXXX "
block[6][10] = " X X WWW X WWW X "
block[6][9] = " XXX XXX X X "
block[6][8] = " X X X W "
block[6][7] = " X X X W "
block[6][6] = " X W "
block[6][5] = " W X "
block[6][4] = " W WWWW WWWW X "
block[6][3] = " W XXXX XXXX XXXX "
block[6][2] = " X DDD X "
block[6][1] = " XXX XXX "
block[6][0] = " "

For z = 7 To 9
For y = 0 To ymax
block[z][y] = block[6][y]
EndFor
EndFor

block[10][12] = " "
block[10][11] = " XXXXXXXXXXXXXXXXXXXXXXXXXXXX "
block[10][10] = " XOOOOOOOX X X "
block[10][9] = " XXXXXXXXX X X "
block[10][8] = " X X X X "
block[10][7] = " X X X X "
block[10][6] = " X X "
block[10][5] = " X X "
block[10][4] = " X X "
block[10][3] = " X XXXXXXXXXXXXXXXXXXXX "
block[10][2] = " X DDD X "
block[10][1] = " XXX XXX "
block[10][0] = " "

block[11][12] = " "
block[11][11] = " XXXXXXXXXXXXXXXXXXXXXXXXXXXX "
block[11][10] = " XOOOOOOOXFFFFFFFFXFFFFFFFFFX "
block[11][9] = " XXXXXXXXXFFFFFFFFXFFFFFFFFFX "
block[11][8] = " XFFFFFFFXFFFFFFFFXFFFFFFFFFX "
block[11][7] = " XFFFFFFFXFFFFFFFFXFFFFFFFFFX "
block[11][6] = " XFFFFFFFFFFFFFFFFFFFFFFFFFFX "
block[11][5] = " XFFFFFFFFFFFFFFFFFFFFFFFFFFX "
block[11][4] = " XFFFFFFFFFFFFFFFFFFFFFFFFFFX "
block[11][3] = " XFFFFFFFXXXXXXXXXXXXXXXXXXXX "
block[11][2] = " XFFDDDFFX "
block[11][1] = " XXX XXX "
block[11][0] = " "
EndSub

Sub DrawBlock
' param bx, by, bz - base point
' param xmax, ymax, zmax - size of block array
param = ""
For _z = zmax To 0 Step -1
param["z"] = _z + bz
For _y = ymax To 0 Step -1
param["y"] = _y + by
For _x = xmax To 0 Step -1
param["x"] = _x + bx
color = Text.GetSubText(block[_z][_y], (xmax + 1) - _x, 1)
If color <> " " Then
param["color"] = palette[color]
DrawVoxel()
EndIf
EndFor
EndFor
EndFor
EndSub
Sub CalcColors
color = param["color"]
If color = "Transparent" Then
transparent = "True"
color = "Black"
Else
transparent = "False"
EndIf
Color_NameToColor()
colorTop = color
rate = 0.2
Color_Blacken()
colorLeft = color
color = colorTop
rate = 0.4
Color_Blacken()
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 = Math.Round(x0)
y1 = Math.Round(y0 - ru)
x2 = Math.Round(x0 + ru * Math.Sin(-a60))
y2 = Math.Round(y0 - ru * Math.Cos(-a60))
x3 = Math.Round(x0 + ru * Math.Sin(a60))
y3 = Math.Round(y0 - ru * Math.Cos(a60))
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(x0 + ru * Math.Sin(-a60))
y1 = Math.Round(y0 - ru * Math.Cos(-a60))
x2 = Math.Round(x0 + ru * Math.Sin(a60))
y2 = Math.Round(y0 - ru * Math.Cos(a60))
x3 = Math.Round(x0)
y3 = Math.Round(y0)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorLeft
x1 = Math.Round(x0 + ru * Math.Sin(-a60))
y1 = Math.Round(y0 - ru * Math.Cos(-a60))
x2 = Math.Round(x0)
y2 = Math.Round(y0)
x3 = Math.Round(x0)
y3 = Math.Round(y0 + ru)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(x0 + ru * Math.Sin(-a60))
y1 = Math.Round(y0 - ru * Math.Cos(-a60))
x2 = Math.Round(x0 + ru * Math.Sin(-2 * a60))
y2 = Math.Round(y0 - ru * Math.Cos(-2 * a60))
x3 = Math.Round(x0)
y3 = Math.Round(y0 + ru)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = colorRight
x1 = Math.Round(x0 + ru * Math.Sin(a60))
y1 = Math.Round(y0 - ru * Math.Cos(a60))
x2 = Math.Round(x0)
y2 = Math.Round(y0)
x3 = Math.Round(x0)
y3 = Math.Round(y0 + ru)
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(x0 + ru * Math.Sin(a60))
y1 = Math.Round(y0 - ru * Math.Cos(a60))
x2 = Math.Round(x0 + ru * Math.Sin(2 * a60))
y2 = Math.Round(y0 - ru * Math.Cos(2 * a60))
x3 = Math.Round(x0)
y3 = Math.Round(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 = Math.Round(pxy["x"])
y1 = Math.Round(pxy["y"])
x2 = Math.Round(px["x"])
y2 = Math.Round(px["y"])
x3 = Math.Round(py["x"])
y3 = Math.Round(py["y"])
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(px["x"])
y1 = Math.Round(px["y"])
x2 = Math.Round(py["x"])
y2 = Math.Round(py["y"])
x3 = Math.Round(po["x"])
y3 = Math.Round(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 = Math.Round(px["x"])
y1 = Math.Round(px["y"])
x2 = Math.Round(pxz["x"])
y2 = Math.Round(pxz["y"])
x3 = Math.Round(pz["x"])
y3 = Math.Round(pz["y"])
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(px["x"])
y1 = Math.Round(px["y"])
x2 = Math.Round(po["x"])
y2 = Math.Round(po["y"])
x3 = Math.Round(pz["x"])
y3 = Math.Round(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 = Math.Round(py["x"])
y1 = Math.Round(py["y"])
x2 = Math.Round(po["x"])
y2 = Math.Round(po["y"])
x3 = Math.Round(pz["x"])
y3 = Math.Round(pz["y"])
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
x1 = Math.Round(py["x"])
y1 = Math.Round(py["y"])
x2 = Math.Round(pyz["x"])
y2 = Math.Round(pyz["y"])
x3 = Math.Round(pz["x"])
y3 = Math.Round(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 r, g, b - RGB values 0..255
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
EndSub

Sub Color_Blacken
' Color | Blacken given color
' param color - given color
' param rate - 0..1
' return color - color blackened
Color_NameToColor()
Color_ColorToRGB()
r = Math.Floor(r * (1 - rate))
g = Math.Floor(g * (1 - rate))
b = Math.Floor(b * (1 - rate))
color = GraphicsWindow.GetColorFromRGB(r, g, b)
EndSub

Sub Color_Whiten
' Color | Whiten given color
' param color - given color
' param rate - 0..1
' return color - color whitened
Color_NameToColor()
Color_ColorToRGB()
r = Math.Floor(r * (1 - rate) + 255 * rate)
g = Math.Floor(g * (1 - rate) + 255 * rate)
b = Math.Floor(b * (1 - rate) + 255 * rate)
color = GraphicsWindow.GetColorFromRGB(r, g, b)
EndSub

Sub Color_ColorToRGB
' Color | Convert color to RGB values
' param color - "#rrggbb" (hexadecimal values)
' return r, g, b - RGB values 0..255
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
EndSub

Sub Color_NameToColor
' Color | Convert color name to color
' param color - color name
' returns color -"#rrggbb"
If Text.StartsWith(color, "#") And 6 < Text.GetLength(color) Then
color = Text.ConvertToUpperCase(color)
Else
Stack.PushValue("local", GraphicsWindow.PenColor)
GraphicsWindow.PenColor = color
color = GraphicsWindow.PenColor
GraphicsWindow.PenColor = Stack.PopValue("local")
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_ColortoGray
' Color | Convert RGB to Gray
' param color - "#rrggbb"
' return brightness - (0, 1)
' return gray - "#rrggbb"
Color_NameToColor()
Color_ColorToRGB()
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 r, g, b - RGB values 0..255
' return hue - [0, 360) or UNDEFINED
' return lightness - (0, 1)
' return saturation - (0, 1)
' r = r / 255 ' occurs Math.Max() bug
r = Math.Round(r / 255 * 10000) / 10000
' g = g / 255 ' occurs Math.Max() bug
g = Math.Round(g / 255 * 10000) / 10000
' b = b / 255 ' occurs Math.Max() bug
b = Math.Round(b / 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..1
' return gray - "#rrggbb"
iGray = Math.Round(lightness * 255)
gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray)
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