Microsoft Small Basic

Program Listing: SJV079-1

List Program

' Nine-Point Circle
' Version 0.3
' Copyright © 2020 Nonki Takahashi. The MIT License.
' Last update 2020-02-14
' Program ID SJV079-1

title = "Nine-Point Circle"
GraphicsWindow.Title = title
' initialization
Not = "False=True;True=False;"
LF = Text.GetCharacter(10)
gap = 5
v["A"] = "x=130;y=50;"
v["B"] = "x=100;y=370;"
v["C"] = "x=520;y=370;"
Form()

' main loop
While "True"
Clear()
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Black"
param = "1=A;2=B;3=C;"
DrawTriangle()
GraphicsWindow.BrushColor = "Black"
DumpTriangle()

' the foots of the perpendicular lines from the vertices
CalcFoots()
' O = orthocenter
param = "1=A;2=Fa;3=B;4=Fb;5=O;"
CalcIntersection()
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Blue"
po = v["O"]
nObj = nObj + 1
o[nObj] = Shapes.AddEllipse(6, 6)
Shapes.Move(o[nObj], po["x"] - 3, po["y"] - 3)
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Blue"
DrawPerpendicularLines()

' midpoints
param = "1=A;2=B;3=C;"
CalcMidPoints()
param = "1=Ma;2=Mb;3=Mc;"
Calc4thPoints()
' R = circumcenter
param = "1=Ma;2=Ra;3=Mb;4=Rb;5=R;"
CalcIntersection()
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Red"
pr = v["R"]
nObj = nObj + 1
o[nObj] = Shapes.AddEllipse(6, 6)
Shapes.Move(o[nObj], pr["x"] - 3, pr["y"] - 3)
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Red"
param = "1=Ma;2=R;"
DrawLine()
param = "1=Mb;2=R;"
DrawLine()
param = "1=Mc;2=R;"
DrawLine()

' N = the center of the nine-point circle
param = "1=O;2=R;3=N;"
CalcMidPoint()
pn = v["N"]
Program.Delay(100)
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Green"
nObj = nObj + 1
o[nObj] = Shapes.AddEllipse(6, 6)
Shapes.Move(o[nObj], pn["x"] - 3, pn["y"] - 3)
' the nine-point circle
pf = v["Fa"]
rx = pf["x"] - pn["x"]
ry = pf["y"] - pn["y"]
r = Math.SquareRoot(rx * rx + ry * ry) + 1
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Green"
GraphicsWindow.BrushColor = "Transparent"
nObj = nObj + 1
o[nObj] = Shapes.AddEllipse(2 * r, 2 * r)
Shapes.Move(o[nObj], pn["x"] - r, pn["y"] - r)
MoveVertex()
EndWhile

Sub CalcFoots
For i1 = 1 To 3
i2 = i1 + 1
If 3 < i2 Then
i2 = 1
EndIf
i3 = i2 + 1
If 3 < i3 Then
i3 = 1
EndIf
p1 = v[param[i1]]
p2 = v[param[i2]]
p3 = v[param[i3]]
x21 = p2["x"] - p1["x"]
y21 = p2["y"] - p1["y"]
k = x21 * (p3["x"] - p1["x"])
k = k + y21 * (p3["y"] - p1["y"])
k = k / (x21 * x21 + y21 * y21)
pf["x"] = (1 - k) * p1["x"] + k * p2["x"]
pf["y"] = (1 - k) * p1["y"] + k * p2["y"]
v["F" + Text.ConvertToLowerCase(param[i3])] = pf
EndFor
EndSub

Sub CalcIntersection
p1 = v[param[1]]
p2 = v[param[2]]
p3 = v[param[3]]
p4 = v[param[4]]
If (p1 = p3) Or (p1 = p4) Then
p5 = p1
ElseIf (p2 = p3) Or (p2 = p4) Then
p5 = p2
Else
l12["x"] = p2["x"] - p1["x"]
l12["y"] = p2["y"] - p1["y"]
l34["x"] = p4["x"] - p3["x"]
l34["y"] = p4["y"] - p3["y"]
If l12["x"] * l34["y"] = l34["x"] * l12["y"] Then
p5 = ""
Else
If l34["x"] = 0 Then
k = (p3["x"] - p1["x"]) / (p2["x"] - p1["x"])
ElseIf l34["y"] = 0 Then
k = (p3["y"] - p1["y"]) / (p2["y"] - p1["y"])
Else
k = (p1["y"] - p3["y"]) / l34["y"] - (p1["x"] - p3["x"]) / l34["x"]
k = k / (l12["x"] / l34["x"] - l12["y"] / l34["y"])
EndIf
p5["x"] = (1 - k) * p1["x"] + k * p2["x"]
p5["y"] = (1 - k) * p1["y"] + k * p2["y"]
EndIf
EndIf
v[param[5]] = p5
EndSub

Sub CalcMidPoints
For i1 = 1 To 3
i2 = i1 + 1
If 3 < i2 Then
i2 = 1
EndIf
p1 = v[param[i1]]
p2 = v[param[i2]]
pm["x"] = (p1["x"] + p2["x"]) / 2
pm["y"] = (p1["y"] + p2["y"]) / 2
i3 = i2 + 1
If 3 < i3 Then
i3 = 1
EndIf
v["M" + Text.ConvertToLowerCase(param[i3])] = pm
EndFor
EndSub

Sub CalcMidPoint
p1 = v[param[1]]
p2 = v[param[2]]
p3["x"] = (p1["x"] + p2["x"]) / 2
p3["y"] = (p1["y"] + p2["y"]) / 2
v[param[3]] = p3
EndSub

Sub Calc4thPoints
param = "1=A;2=Fa;3=Ma;4=Ra;"
Calc4thPoint()
param = "1=B;2=Fb;3=Mb;4=Rb;"
Calc4thPoint()
param = "1=C;2=Fc;3=Mc;4=Rc;"
Calc4thPoint()
EndSub

Sub Calc4thPoint
p1 = v[param[1]]
p2 = v[param[2]]
p3 = v[param[3]]
p4["x"] = p1["x"] + (p3["x"] - p2["x"])
p4["y"] = p1["y"] + (p3["y"] - p2["y"])
v[param[4]] = p4
EndSub

Sub Clear
For i = 1 To nObj
If o[i] <> "" Then
Shapes.Remove(o[i])
o[i] = ""
EndIf
EndFor
nObj = 0
EndSub

Sub DrawGrid
For x = 0 To gw Step 10
If Math.Remainder(x, 100) = 0 Then
GraphicsWindow.PenColor = "#33000000"
Else
GraphicsWindow.PenColor = "#33999999"
EndIf
GraphicsWindow.DrawLine(x, 0, x, gh)
EndFor
For y = 0 To gh Step 10
If Math.Remainder(y, 100) = 0 Then
GraphicsWindow.PenColor = "#33000000"
Else
GraphicsWindow.PenColor = "#33666666"
EndIf
GraphicsWindow.DrawLine(0, y, gw, y)
EndFor
EndSub

Sub DrawPerpendicularLines
param = "1=A;2=O;"
DrawLine()
param = "1=O;2=Fa;"
DrawLine()
param = "1=B;2=O;"
DrawLine()
param = "1=O;2=Fb;"
DrawLine()
param = "1=C;2=O;"
DrawLine()
param = "1=O;2=Fc;"
DrawLine()
EndSub

Sub DrawLine
p1 = v[param[1]]
p2 = v[param[2]]
nObj = nObj + 1
o[nObj] = Shapes.AddLine(p1["x"], p1["y"], p2["x"], p2["y"])
EndSub

Sub DrawTriangle
For i1 = 1 To 3
i2 = i1 + 1
If 3 < i2 Then
i2 = 1
EndIf
p1 = v[param[i1]]
p2 = v[param[i2]]
nObj = nObj + 1
o[nObj] = Shapes.AddLine(p1["x"], p1["y"], p2["x"], p2["y"])
EndFor
EndSub

Sub DumpTriangle
tri = "A = (" + v["A"]["x"] + ", " + v["A"]["y"] + ")" + LF
tri = tri + "B = (" + v["B"]["x"] + ", " + v["B"]["y"] + ")" + LF
tri = tri + "C = (" + v["C"]["x"] + ", " + v["C"]["y"] + ")"
Shapes.SetText(oTri, tri)
EndSub

Sub DumpVertices
n = Array.GetItemCount(v)
index = Array.GetAllIndices(v)
For i = 1 To n
TextWindow.WriteLine(index[i] + ":" + v[index[i]])
EndFor
EndSub

Sub Form
gw = GraphicsWindow.Width
gh = GraphicsWindow.Height
DrawGrid()
GraphicsWindow.BrushColor = "Blue"
GraphicsWindow.FillEllipse(402, 15, 6, 6)
GraphicsWindow.BrushColor = "Red"
GraphicsWindow.FillEllipse(402, 32, 6, 6)
GraphicsWindow.BrushColor = "Green"
GraphicsWindow.FillEllipse(402, 49, 6, 6)
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontName = "Trebuchet MS"
GraphicsWindow.FontSize = 14
GraphicsWindow.FontBold = "False"
oTri = Shapes.AddText("")
Shapes.Move(oTri, 402, 66)
legend = "Orthocenter" + LF + "Circumcenter" + LF
legend = legend + "Center of Nine-Point Circle"
GraphicsWindow.DrawText(412, 10, legend)
GraphicsWindow.MouseDown = OnMouseDown
GraphicsWindow.MouseUp = OnMouseUp
GraphicsWindow.MouseMove = OnMouseMove
EndSub

Sub MoveVertex
moved = "False"
While Not[moved]
vx[1] = v["A"]["x"]
vy[1] = v["A"]["y"]
vx[2] = v["B"]["x"]
vy[2] = v["B"]["y"]
vx[3] = v["C"]["x"]
vy[3] = v["C"]["y"]
If mouseDown Then
mx = dx
my = dy
For i = 1 To 3
_dx = dx - vx[i]
_dy = dy - vy[i]
_d = Math.SquareRoot(_dx * _dx + _dy * _dy)
If _d <= gap Then
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "#33000000"
moved = "True"
While mouseDown
GraphicsWindow.Title = title + " " + mx + ", " + my
Shapes.Remove(ot)
vx[i] = mx
vy[i] = my
ot = Shapes.AddTriangle(vx[1], vy[1], vx[2], vy[2], vx[3], vy[3])
Program.Delay(50)
EndWhile
GraphicsWindow.Title = title
Shapes.Remove(ot)
alpha = "1=A;2=B;3=C;"
v[alpha[i]]["x"] = vx[i]
v[alpha[i]]["y"] = vy[i]
EndIf
EndFor
Else
Program.Delay(100)
EndIf
EndWhile
EndSub

Sub OnMouseDown
dx = GraphicsWindow.MouseX
dy = GraphicsWindow.MouseY
mouseDown = "True"
EndSub

Sub OnMouseUp
mouseDown = "False"
EndSub

Sub OnMouseMove
mx = GraphicsWindow.MouseX
my = GraphicsWindow.MouseY
EndSub