Microsoft Small Basic

Program Listing: KZJ575

List Program

' Truncated Icosahedron
' Copyright © 2018 Nonki Takahashi. The MIT License.

GraphicsWindow.Title = "Truncated Icosahedron"
Init()
r = 2
dx = 35
dy = 100
For i = 1 To 60
point = points[i]
x = point["x"] + dx
y = point["y"] + dy
If i <= 40 Then
color = "Black"
Else
color = "SkyBlue"
EndIf
GraphicsWindow.BrushColor = color
GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r)
GraphicsWindow.DrawText(x, y, i)
EndFor
n = Array.GetItemCount(edges)
For j = n To 1 Step -1
edge = edges[j]
h = Text.GetIndexOf(edge, "-") ' hyphen
i1 = Text.GetSubText(edge, 1, h - 1)
i2 = Text.GetSubTextToEnd(edge, h + 1)
point = points[i1]
x1 = point["x"] + dx
y1 = point["y"] + dy
point = points[i2]
x2 = point["x"] + dx
y2 = point["y"] + dy
If i1 <= 40 And i2 <= 40 Then
GraphicsWindow.PenColor = "Black"
Else
GraphicsWindow.PenColor = "SkyBlue"
EndIf
GraphicsWindow.DrawLine(x1, y1, x2, y2)
EndFor
point = points[1]
xo = point["x"]
For i = 60 To 1 Step -1
point = points[i]
If xo <= point["x"] Then
color = "Black"
Else
color = "SkyBlue"
EndIf
x = point["z"] + gw / 2 + dx
y = point["y"] + dy
GraphicsWindow.BrushColor = color
GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r)
GraphicsWindow.DrawText(x, y, i)
EndFor
GraphicsWindow.PenColor = "Black"
For j = 1 To n
edge = edges[j]
h = Text.GetIndexOf(edge, "-") ' hyphen
i1 = Text.GetSubText(edge, 1, h - 1)
i2 = Text.GetSubTextToEnd(edge, h + 1)
point = points[i1]
x1 = point["x"]
y1 = point["y"] + dy
z1 = point["z"] + gw / 2 + dx
point = points[i2]
x2 = point["x"]
y2 = point["y"] + dy
z2 = point["z"] + gw / 2 + dx
If xo <= x1 And xo <= x2 Then
GraphicsWindow.DrawLine(z1, y1, z2, y2)
EndIf
EndFor

Sub Init
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
points[1] = "x=113.90;y=72.21;z=0.00;"
points[2] = "x=151.87;y=99.80;z=0.00;"
points[3] = "x=137.37;y=144.43;z=0.00;"
points[4] = "x=90.44;y=144.43;z=0.00;"
points[5] = "x=75.94;y=99.80;z=0.00;"
points[6] = "x=113.90;y=32.29;z=24.67;"
points[7] = "x=189.84;y=87.46;z=24.67;"
points[8] = "x=160.83;y=176.73;z=24.67;"
points[9] = "x=66.97;y=176.73;z=24.67;"
points[10] = "x=37.97;y=87.46;z=24.67;"
points[11] = "x=151.87;y=19.96;z=49.35;"
points[12] = "x=189.84;y=47.54;z=49.35;"
points[13] = "x=213.30;y=119.76;z=49.35;"
points[14] = "x=198.80;y=164.39;z=49.35;"
points[15] = "x=137.37;y=209.03;z=49.35;"
points[16] = "x=90.44;y=209.03;z=49.35;"
points[17] = "x=29.00;y=164.39;z=49.35;"
points[18] = "x=14.50;y=119.76;z=49.35;"
points[19] = "x=37.97;y=47.54;z=49.35;"
points[20] = "x=75.94;y=19.96;z=49.35;"
points[21] = "x=137.37;y=0.00;z=89.27;"
points[22] = "x=160.83;y=7.62;z=129.19;"
points[23] = "x=198.80;y=35.20;z=129.19;"
points[24] = "x=213.30;y=55.16;z=89.27;"
points[25] = "x=227.80;y=99.80;z=89.27;"
points[26] = "x=227.80;y=124.47;z=129.19;"
points[27] = "x=213.30;y=169.10;z=129.19;"
points[28] = "x=198.80;y=189.07;z=89.27;"
points[29] = "x=160.83;y=216.65;z=89.27;"
points[30] = "x=137.37;y=224.27;z=129.19;"
points[31] = "x=90.44;y=224.27;z=129.19;"
points[32] = "x=66.97;y=216.65;z=89.27;"
points[33] = "x=29.00;y=189.07;z=89.27;"
points[34] = "x=14.50;y=169.10;z=129.19;"
points[35] = "x=0.00;y=124.47;z=129.19;"
points[36] = "x=0.00;y=99.80;z=89.27;"
points[37] = "x=14.50;y=55.16;z=89.27;"
points[38] = "x=29.00;y=35.20;z=129.19;"
points[39] = "x=66.97;y=7.62;z=129.19;"
points[40] = "x=90.44;y=0.00;z=89.27;"
points[41] = "x=137.37;y=15.24;z=169.11;"
points[42] = "x=198.80;y=59.88;z=169.11;"
points[43] = "x=213.30;y=104.51;z=169.11;"
points[44] = "x=189.84;y=176.73;z=169.11;"
points[45] = "x=151.87;y=204.31;z=169.11;"
points[46] = "x=75.94;y=204.31;z=169.11;"
points[47] = "x=37.97;y=176.73;z=169.11;"
points[48] = "x=14.50;y=104.51;z=169.11;"
points[49] = "x=29.00;y=59.88;z=169.11;"
points[50] = "x=90.44;y=15.24;z=169.11;"
points[51] = "x=160.83;y=47.54;z=193.78;"
points[52] = "x=189.84;y=136.33;z=193.92;"
points[53] = "x=113.90;y=191.98;z=193.78;"
points[54] = "x=37.97;y=136.33;z=193.92;"
points[55] = "x=66.97;y=47.54;z=193.78;"
points[56] = "x=137.37;y=79.84;z=218.46;"
points[57] = "x=151.87;y=124.48;z=218.55;"
points[58] = "x=113.90;y=151.62;z=218.61;"
points[59] = "x=75.94;y=124.48;z=218.55;"
points[60] = "x=90.44;y=79.84;z=218.46;"
edges = "1=1-2;2=2-3;3=3-4;4=4-5;5=5-1;"
edges = edges + "6=1-6;7=2-7;8=3-8;9=4-9;10=5-10;"
edges = edges + "11=6-11;12=7-12;13=7-13;14=8-14;15=8-15;"
edges = edges + "16=9-16;17=9-17;18=10-18;19=10-19;20=6-20;"
edges = edges + "21=11-12;22=13-14;23=15-16;24=17-18;25=19-20;"
edges = edges + "26=11-21;27=12-24;28=13-25;29=14-28;30=15-29;"
edges = edges + "31=16-32;32=17-33;33=18-36;34=19-37;35=20-40;"
edges = edges + "36=21-22;37=22-23;38=23-24;39=24-25;40=25-26;"
edges = edges + "41=26-27;42=27-28;43=28-29;44=29-30;45=30-31;"
edges = edges + "46=31-32;47=32-33;48=33-34;49=34-35;50=35-36;"
edges = edges + "51=36-37;52=37-38;53=38-39;54=39-40;55=40-21;"
edges = edges + "56=22-41;57=23-42;58=26-43;59=27-44;60=30-45;"
edges = edges + "61=31-46;62=34-47;63=35-48;64=38-49;65=39-50;"
edges = edges + "66=42-43;67=44-45;68=46-47;69=48-49;70=50-41;"
edges = edges + "71=41-51;72=42-51;73=43-52;74=44-52;75=45-53;"
edges = edges + "76=46-53;77=47-54;78=48-54;79=49-55;80=50-55;"
edges = edges + "81=51-56;82=52-57;83=53-58;84=54-59;85=55-60;"
edges = edges + "86=56-57;87=57-58;88=58-59;89=59-60;90=60-56;"
EndSub