title = "Puzzle"
GraphicsWindow.Title = title
debug = "False"
extra = "False"
Not = "False=True;True=False;"
LF = Text.GetCharacter(10)
alpha = "1=A;2=B;3=C;4=D;5=E;6=F;7=G;8=H;9=I;10=J;"
alpha = alpha + "11=K;12=L;13=M;14=N;15=O;16=P;17=Q;18=R;"
alpha = alpha + "19=S;20=T;21=U;22=V;23=W;24=X;25=Y;26=Z;"
If extra Then
alpha = alpha + "27=α;28=β;29=γ;30=δ;31=ε;32=ζ;"
alpha = alpha + "33=η;34=θ;35=ι;36=κ;37=λ;38=μ;"
EndIf
delay = 300
gw = GraphicsWindow.Width
gh = GraphicsWindow.Height
Puzzle()
Intersection()
UpdateLine()
If debug Then
For i = 1 TO nl
i1 = Text.GetSubText(l[i], 1, Text.GetIndexOf(l[i], "-") - 1)
i2 = Text.GetSubTextToEnd(l[i], Text.GetIndexOf(l[i], "-") + 1)
TextWindow.WriteLine("l[" + i + "]=" + alpha[i1] + "-" + alpha[i2])
EndFor
EndIf
Triangle()
Sub Intersection
For i = 1 To nl - 1
pi = li[i]
ni = Array.GetItemCount(pi)
i1 = Text.GetSubText(l[i], 1, Text.GetIndexOf(l[i], "-") - 1)
i2 = Text.GetSubTextToEnd(l[i], Text.GetIndexOf(l[i], "-") + 1)
p1 = p[i1]
ni = ni + 1
pi[ni] = i1
p2 = p[i2]
ni = ni + 1
pi[ni] = i2
If p2["x"] <> p1["x"] Then
s12 = (p2["y"] - p1["y"]) / (p2["x"] - p1["x"])
Else
s12 = "∞"
EndIf
For j = i + 1 To nl
pj = li[j]
nj = Array.GetItemCount(pj)
p3 = p[Text.GetSubText(l[j], 1, Text.GetIndexOf(l[j], "-") - 1)]
p4 = p[Text.GetSubTextToEnd(l[j], Text.GetIndexOf(l[j], "-") + 1)]
If p4["x"] <> p3["x"] Then
s34 = (p4["y"] - p3["y"]) / (p4["x"] - p3["x"])
Else
s34 = "∞"
EndIf
If s12 <> s34 Then
p13["x"] = p3["x"] - p1["x"]
p13["y"] = p3["y"] - p1["y"]
denominator = (p2["x"] - p1["x"]) * (p4["y"] - p3["y"]) - (p2["y"] - p1["y"]) * (p4["x"] - p3["x"])
r12 = ((p4["y"] - p3["y"]) * p13["x"] - (p4["x"] - p3["x"]) * p13["y"]) / denominator
r34 = ((p2["y"] - p1["y"]) * p13["x"] - (p2["x"] - p1["x"]) * p13["y"]) / denominator
If 0 <= r12 And r12 <= 1 And 0 <= r34 And r34 <= 1 Then
p5["x"] = p1["x"] + Math.Floor(r12 * (p2["x"] - p1["x"]) * 100) / 100
p5["y"] = p1["y"] + Math.Floor(r12 * (p2["y"] - p1["y"]) * 100) / 100
If Array.ContainsValue(p, p5) Then
ip = 0
For k = 1 To np
If p[k] = p5 Then
ip = k
k = np
EndIf
EndFor
Else
np = np + 1
ip = np
p[np] = p5
GraphicsWindow.DrawText(px + p5["x"] + 2, py + p5["y"] + 2, alpha[np])
EndIf
ni = ni + 1
pi[ni] = ip
nj = nj + 1
pj[nj] = ip
EndIf
EndIf
li[j] = pj
EndFor
li[i] = pi
EndFor
EndSub
Sub Puzzle
px = 20 ' padding
py = 10
p[1] = "x=0;y=0;"
p[2] = "x=200;y=0;"
p[3] = "x=400;y=0;"
p[4] = "x=0;y=200;"
p[5] = "x=400;y=200;"
p[6] = "x=0;y=400;"
p[7] = "x=200;y=400;"
p[8] = "x=400;y=400;"
If extra Then
ex = ""
Else
ex = "2-4,2-5,4-7,5-7"
EndIf
np = Array.GetItemCount(p)
GraphicsWindow.PenColor = "#999"
For i = 1 To np - 1
p1 = p[i]
For j = i + 1 To np
If Not[Text.IsSubText(ex, Text.Append(i, "-") + j)] Then
p2 = p[j]
GraphicsWindow.DrawLine(px + p1["x"], py + p1["y"], px + p2["x"], py + p2["y"])
nl = nl + 1
l[nl] = Text.Append(i, "-") + j
EndIf
EndFor
EndFor
GraphicsWindow.BrushColor = "#000"
For i = 1 To np
p1 = p[i]
GraphicsWindow.DrawText(px + p1["x"] + 2, py + p1["y"] + 2, alpha[i])
EndFor
EndSub
Sub Triangle
tbox = Controls.AddMultiLineTextBox(450, 10)
Controls.SetSize(tbox, gw - 460, gh - 20)
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "#99FF0000"
tr = ""
nt = 0
For i = 1 To np - 2
p1 = p[i]
For j = i + 1 To np - 1
If Array.ContainsValue(l, Text.Append(i, "-") + j) Then
p2 = p[j]
For k = j + 1 To np
If Array.ContainsValue(l, Text.Append(i, "-") + k) And Array.ContainsValue(l, Text.Append(j, "-") + k) Then
p3 = p[k]
l12 = Math.Floor(Math.SquareRoot(Math.Power(p2["x"] - p1["x"], 2) + Math.Power(p2["y"] - p1["y"], 2)) * 100) / 100
l23 = Math.Floor(Math.SquareRoot(Math.Power(p3["x"] - p2["x"], 2) + Math.Power(p3["y"] - p2["y"], 2)) * 100) / 100
l31 = Math.Floor(Math.SquareRoot(Math.Power(p1["x"] - p3["x"], 2) + Math.Power(p1["y"] - p3["y"], 2)) * 100) / 100
If (l12 < l23 + l31) And (l23 < l31 + l12) And (l31 < l12 + l23) Then
nt = nt + 1
GraphicsWindow.Title = title + " - " + nt + " triangles"
tr = tr + nt + " ∆ " + alpha[i] + alpha[j] + alpha[k] + LF
ts = Shapes.AddTriangle(px + p1["x"], py + p1["y"], px + p2["x"], py + p2["y"], px + p3["x"], py + p3["y"])
Controls.SetTextBoxText(tbox, tr)
Program.Delay(delay)
Shapes.Remove(ts)
EndIf
EndIf
EndFor
EndIf
EndFor
EndFor
EndSub
Sub UpdateLine
For il = 1 To nl
pi = li[il]
ni = Array.GetItemCount(pi)
For ii = 1 To ni - 1
For ij = ii + 1 To ni
If pi[ii] < pi[ij] Then
pi1 = pi[ii]
pi2 = pi[ij]
Else
pi1 = pi[ij]
pi2 = pi[ii]
EndIf
If (pi1 <> pi2) And Not[Array.ContainsValue(l, Text.Append(pi1, "-") + pi2)] Then
nl = nl + 1
l[nl] = Text.Append(pi1, "-") + pi2
EndIf
EndFor
EndFor
EndFor
EndSub
Program Listing: BBL935