Microsoft Small Basic

Program Listing: PRL427-1
' Menger Sponge
' Version 0.2
' Copyright © 2016 Nonki Takahashi. The MIT License.
' Program ID PRL427-1
' Last update 2016-09-24
'
title = "Menger Sponge 0.2"
GraphicsWindow.Title = title
GraphicsWindow.BackgroundColor = "SkyBlue"
threepoint = "True"
level = 3
size = Math.Power(3, level)
Init()
param = "x=0;y=0;z=0;color=White;"
param["size"] = size
DrawSponge()

Sub CalcColors
color = param["color"]
If color = "Transparent" Then
alpha = "33"
color = "White"
ElseIf Text.GetLength(color) = 9 Then
alpha = Text.GetSubText(color, 2, 2)
color = "#" + Text.GetSubTextToEnd(color, 4)
Else
alpha = "FF"
EndIf
Color_NameToColor()
colorTop = color
rate = 0.2
Color_Blacken()
colorLeft = color
color = colorTop
rate = 0.4
Color_Blacken()
colorRight = color
If alpha <> "FF" Then
colorTop = "#" + alpha + Text.GetSubTextToEnd(colorTop, 2)
colorLeft = "#" + alpha + Text.GetSubTextToEnd(colorLeft, 2)
colorRight = "#" + alpha + 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 DrawSponge
' stack cubes
StackCube()

' draw
GraphicsWindow.Title = title + " - drawing"
Stack.PushValue("local", param)
xmin = param["x"]
ymin = param["y"]
zmin = param["z"]
xmax = param["size"] + xmin - 1
ymax = param["size"] + ymin - 1
zmax = param["size"] + 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
line = block[_z + 1][_y + 1]
_n = Array.GetItemCount(line)
index = Array.GetAllIndices(line)
For _i = _n To 1 Step -1
_x = index[_i] - 1
param["x"] = _x
DrawVoxel()
EndFor
EndFor
EndFor
param = Stack.PopValue("local")
GraphicsWindow.Title = title
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 Init
UNDEFINED = "N/A"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
xo = gw / 2
yo = 0.45 * gh
u = 270 / size
ru = u * Math.SquareRoot(2 / 3)
If threepoint THen
rv = 1.5 * gw
Else
rv = "∞"
EndIf
a60 = Math.GetRadians(60)
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 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
_px["x"] = xo + rx * Math.Sin(-a60)
_px["y"] = yo - rx * Math.Cos(-a60)
_py["x"] = xo + ry * Math.Sin(a60)
_py["y"] = yo - ry * Math.Cos(a60)
_pz["x"] = xo
_pz["y"] = yo + rz
p1 = _px
p2 = vy
p3 = _py
p4 = vx
CalcVertex()
_pxy = p
p1 = _px
p2 = vz
p3 = _pz
p4 = vx
CalcVertex()
_pxz = p
p1 = _pxz
p2 = vy
p3 = _pxy
p4 = vz
CalcVertex()
EndSub

Sub PopValues
zz = Stack.PopValue("local")
yy = Stack.PopValue("local")
xx = Stack.PopValue("local")
n1 = Stack.PopValue("local")
col = Stack.PopValue("local")
row = Stack.PopValue("local")
rack = Stack.PopValue("local")
size1_3 = Stack.PopValue("local")
param = Stack.PopValue("local")
EndSub

Sub PushValues
Stack.PushValue("local", param)
Stack.PushValue("local", size1_3)
Stack.PushValue("local", rack)
Stack.PushValue("local", row)
Stack.PushValue("local", col)
Stack.PushValue("local", n1)
Stack.PushValue("local", xx)
Stack.PushValue("local", yy)
Stack.PushValue("local", zz)
EndSub

Sub StackCube
' param["x"], param["y"], param["z"] - start corner of the cube
' param["size"] - size of the cube
size1_3 = param["size"] / 3
For rack = 0 To 2
If rack = 1 Then
n1 = 1
Else
n1 = 0
EndIf
For row = 0 To 2
If row = 1 Then
n1 = n1 + 1
EndIf
For col = 0 To 2
If col = 1 Then
n1 = n1 + 1
EndIf
xx = param["x"] + size1_3 * col
yy = param["y"] + size1_3 * row
zz = param["z"] + size1_3 * rack
If n1 < 2 Then
If size = param["size"] Then
pos = "(" + rack + "," + row + "," + col + ")"
GraphicsWindow.Title = title + " - stacking " + pos + " cubes"
EndIF
If 3 <= size1_3 Then
PushValues()
param["x"] = xx
param["y"] = yy
param["z"] = zz
param["size"] = size1_3
StackCube()
PopValues()
Else
For _z = zz + 1 To zz + size1_3
For _y = yy + 1 To yy + size1_3
For _x = xx + 1 To xx + size1_3
block[_z][_y][_x] = 1
EndFor
EndFor
EndFor
EndIf
EndIf
If col = 1 Then
n1 = n1 - 1
EndIf
EndFor
If row = 1 Then
n1 = n1 - 1
EndIf
EndFor
EndFor
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_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 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