DECLARE SUB FIND.SIMSON.LINE ()
DECLARE SUB CALC.TRI.DATA ()
DECLARE SUB CIRCUM.CIRCLE ()
DECLARE SUB DRAW.CIRCLE ()
DECLARE SUB DRAW.TRIANGLE ()
DECLARE SUB COMP.TRI ()
DECLARE SUB USER.TRI ()
COMMON SHARED XC, YC, RC, RO: REM BASIC DISPLAY PARAMETERS
COMMON SHARED CX, CY, RAD, CC: REM DRAW CIRCLE PARAMETERS
COMMON SHARED X1, Y1, X2, Y2, X3, Y3: REM TRIANGLE VERTICES
COMMON SHARED AZ1, AZ2, AZ3: REM TRIANGLE VERTEX AZIMUTHS
COMMON SHARED S12, S23, S31, S: REM EDGE LENGTHS
COMMON SHARED A12, A23, A31: REM ANGLES
COMMON SHARED XCTD, YCTD: REM CENTROID
COMMON SHARED XCC, YCC, RCC: REM CIRCUMCIRCLE PARAMETERS
COMMON SHARED PCC, QCC, P1, Q1, P2, Q2, P3, Q3: REM PASS PARAMETERS
COMMON SHARED XSG, YSG: REM SIMSON'S LINE GENERATING POINT
COMMON SHARED XSL12, YSL12: REM SIMSON'S LINE POINT ON EDGE 12
COMMON SHARED XSL23, YSL23: REM SIMSON'S LINE POINT ON EDGE 23
COMMON SHARED XSL31, YSL31: REM SIMSON'S LINE POINT ON EDGE 31

XC = 160: YC = 80: RC = 60
SCREEN 0: WIDTH 80
CONST PI = 3.141593
RANDOMIZE TIMER
BLK$ = "                                       "
CLS : COLOR 12: PRINT "DELTOID": PRINT
COLOR 5: PRINT "THE DELTOID IS A HYPOCYCLOID FORMED BY A CIRCLE OF RADIUS R"
PRINT "ROLLING ON THE INSIDE OF A CIRCLE OF RADIUS 3R."
COLOR 14: PRINT : PRINT "THE DELTOID HAS ANOTHER INTERESTING PROPERTY: IT IS THE"
PRINT "ENVELOPE OF ALL THE SIMSON'S LINES OF A TRIANGLE"
COLOR 10: PRINT : PRINT "SIMSON'S LINES ARE GENERATED THUS:"
PRINT "PICK A POINT ON THE CIRCUMFERENCE OF THE CIRCUMCIRCLE OF THE TRIANGLE."
PRINT "FROM THIS POINT, DROP PERPENDICULARS TO EACH OF THE THREE SIDES."
PRINT "EXTEND THE SIDES, IF NECESSARY. THE FEET OF THE THREE PERPENDICULARS"
PRINT "WILL LIE ON A STRAIGHT LINE."
COLOR 3: PRINT : PRINT "THIS LINE IS A SIMSON'S LINE (NOTE: NO 'P')."
PRINT : PRINT "ALTITUDES OF THE TRIANGLE ARE SIMSON'S LINES FOR SOME POINT (WHY?)"
PRINT : PRINT "EDGES OF THE TRIANGLE ARE SIMSON'S LINES FOR SOME POINT (WHY?)"
COLOR 6: PRINT : PRINT "ALL THE SIMSON'S LINES OF A GIVEN TRIANGLE TRACE OUT THE DELTOID."
COLOR 4: PRINT : PRINT "PRESS ANY KEY TO CONTINUE"
U$ = INPUT$(1)
CLS
COLOR 13: PRINT : PRINT "THE DELTOID ALWAYS HAS REGULAR THREE-FOLD SYMMETRY REGARDLESS OF HOW"
PRINT "ASYMETRICAL THE GENERATING TRIANGLE IS"
COLOR 11: PRINT : PRINT "THERE'S ONE OTHER SURPRISING THREEFOLD SYMMETRY HERE. IF YOU TRISECT"
PRINT "THE ANGLES OF THE GENERATING TRIANGLE, LOCATE THE INTERSECTIONS OF"
PRINT "ADJACENT TRISECTORS, AND CONNECT THOSE THREE POINTS, YOU GET A TRIANGLE"
PRINT "CALLED MORLEY'S TRIANGLE. MORLEY'S TRIANGLE IS ALWAYS EQUILATERAL"
PRINT "REGARDLESS OF THE SHAPE OF THE GENERATING TRIANGLE. THE VERTICES OF"
PRINT "MORLEY'S TRIANGLE POINT AWAY FROM THE CUSPS OF THE DELTOID."
COLOR 12: PRINT : PRINT "PROVING THIS MUST HAVE BEEN A BEAR. PROVING THAT AN ENVELOPE RESULTS"
PRINT "IN A GIVEN CURVE IS FAIRLY COMPLEX CALCULUS. THE MATHEMATICS OF SIMSON'S"
PRINT "LINE IS COMPLEX. PUTTING THE TWO TOGETHER MUST HAVE BEEN A REAL BEAST."
COLOR 14: PRINT : PRINT "THE PROOF WAS ESTABLISHED BY J. STEINER IN 1858. STEINER IS ALSO"
PRINT "REMEMBERED FOR STEINER CHAINS, ANOTHER VERY SUBTLE GEOMETRICAL TIDBIT."
PRINT "STEINER MUST HAVE HAD A REAL LOVE FOR GEOMETRY AS WELL AS DIFFICULT PROOFS"
COLOR 10: PRINT : PRINT "THE DELTOID AS ENVELOPE OF SIMSON'S LINE IS SOMETIMES (JUSTLY)"
PRINT "CALLED STEINER'S HYPOCYCLOID"
COLOR 4: PRINT : PRINT "PRESS ANY KEY TO CONTINUE"
U$ = INPUT$(1)
CLS : COLOR 14: PRINT "IT IS VERY HARD TO PREDICT JUST WHERE A GIVEN LINE INTERSECTS"
PRINT "THE DELTOID. THE ALGORITHM IN THIS PROGRAM CALCULATES SIMSON'S LINE"
PRINT "BETWEEN THE FEET OF THE PERPENDICULARS AND EXTENDS IT SOME DISTANCE"
PRINT "BEYOND. THEREFORE THE SIMSON'S LINES EXTEND BEYOND THE DELTOID"
COLOR 12: PRINT : PRINT "IF YOU CONSTRUCT YOUR OWN TRIANGLE, THE LINES MAY NOT BE LONG"
PRINT "ENOUGH IF THE TRIANGLE IS VERY SMALL OR NARROW. IN SUCH CASES PART"
PRINT "OF THE DELTOID WILL BE CUT OFF. FOR BEST RESULTS PICK TRIANGLES"
PRINT "THAT INCLUDE THE CENTER OF THE CIRCUMCIRCLE"

CHOICE:
COLOR 11: PRINT : PRINT "TYPE D TO SEE A DEMONSTRATION OF SIMSON'S LINE"
PRINT "OR ANY OTHER KEY TO CONSTRUCT THE DELTOID"
U$ = INPUT$(1)
IF U$ <> "D" AND U$ <> "d" THEN GOTO MAIN.DISPLAY
REM RUN DEMO
CALL COMP.TRI
SCREEN 1
CALL CALC.TRI.DATA
CALL DRAW.TRIANGLE

DRAW.DEMO:
REM DEMONSTRATE SIMSON'S LINE
LOCATE 22, 1: PRINT "START WITH A TRIANGLE"
LOCATE 23, 1: PRINT "PRESS ANY KEY FOR NEXT STEP"
U$ = INPUT$(1)
CALL DRAW.TRIANGLE: REM DRAW TRIANGLE
LOCATE 22, 1: PRINT BLK$
LOCATE 22, 1: PRINT "CONSTRUCT CIRCUMCIRCLE"
REM DRAW CIRCUMCIRCLE
CX = XCC: CY = YCC: RAD = RO: CC = 3: CALL DRAW.CIRCLE
U$ = INPUT$(1)
T = 2 * PI * RND(1): XSG = XCC + RO * COS(T): YSG = YCC + RO * SIN(T)
LOCATE 21, 1: PRINT "SELECT A POINT ON CIRCUMCIRCLE"
LOCATE 22, 1: PRINT "OR ENTER FOR RANDOM POINT     "
LOCATE 23, 1: INPUT "INPUT AZIMUTH OF POINT        "; AZ$
IF AZ$ <> "" THEN
 AZ = PI * VAL(AZ$) / 180:
 XSG = XCC + RO * COS(AZ): YSG = YCC - RO * SIN(AZ)
 END IF
LINE (XSG - 2, YSG - 2)-(XSG + 2, YSG + 2), 3, B
LOCATE 21, 1: PRINT BLK$
LOCATE 22, 1: PRINT "POINT SELECTED                "
LOCATE 23, 1: PRINT "PRESS ANY KEY FOR NEXT STEP   "
U$ = INPUT$(1)
REM CALCULATIONS FOR GENERATION
CALL FIND.SIMSON.LINE
REM NOW DROP PERPENDICULARS
LOCATE 21, 1: PRINT BLK$
LOCATE 22, 1: PRINT BLK$: LOCATE 23, 1: PRINT BLK$
LOCATE 22, 1: PRINT "DROPPING PERPENDICULARS TO SIDES"
LOCATE 23, 1: PRINT "PRESS ANY KEY FOR NEXT STEP     "
REM SHOW PERPENDICULARS
LINE (XSG, YSG)-(XSL12, YSL12), 1, , 13107
LINE (XSG, YSG)-(XSL23, YSL23), 1, , 13107
LINE (XSG, YSG)-(XSL31, YSL31), 1, , 13107
LINE (X1, Y1)-(XSL12, YSL12), 2, , 3855
LINE (X2, Y2)-(XSL23, YSL23), 2, , 3855
LINE (X3, Y3)-(XSL31, YSL31), 2, , 3855
LINE (XSL23 - 2, YSL23 - 2)-(XSL23 + 2, YSL23 + 2), 3, B
LINE (XSL31 - 2, YSL31 - 2)-(XSL31 + 2, YSL31 + 2), 3, B
LINE (XSL12 - 2, YSL12 - 2)-(XSL12 + 2, YSL12 + 2), 3, B
U$ = INPUT$(1)
LOCATE 22, 1: PRINT BLK$: LOCATE 23, 1: PRINT BLK$
LOCATE 22, 1: PRINT "DRAWING SIMSON'S LINE"
LOCATE 23, 1: PRINT "PRESS ANY KEY FOR NEXT STEP"
LINE (XSL31, YSL31)-(XSL23, YSL23), 3
LINE (XSL31, YSL31)-(XSL12, YSL12), 3
REM NOW SHOW SIMSON'S LINE
U$ = INPUT$(1)
LOCATE 22, 1: PRINT BLK$
LOCATE 23, 1: PRINT BLK$
LOCATE 22, 1: PRINT "ANOTHER DEMO WITH THIS"
LOCATE 23, 1: PRINT "DIAGRAM - Y/N ?": U$ = INPUT$(1)
IF U$ = "Y" OR U$ = "y" THEN
  CLS : CALL DRAW.TRIANGLE: GOTO DRAW.DEMO
  END IF
LOCATE 22, 1: PRINT BLK$
LOCATE 23, 1: PRINT BLK$
LOCATE 22, 1: PRINT "DRAW A DIFFERENT"
LOCATE 23, 1: PRINT "DIAGRAM - Y/N ?": U$ = INPUT$(1)
IF U$ = "Y" OR U$ = "y" THEN
 CALL COMP.TRI
 CALL CALC.TRI.DATA
 CLS : CALL DRAW.TRIANGLE: GOTO DRAW.DEMO
 END IF
REM END OF DEMO SEGMENT

MAIN.DISPLAY:
SCREEN 1: CLS
LOCATE 23, 1: PRINT "USER- OR COMPUTER-GENERATED - U/C?": U$ = INPUT$(1)
CALL COMP.TRI
IF U$ = "U" OR U$ = "u" THEN CALL USER.TRI
CLS

REM DRAW TRIANGLE
CALL DRAW.TRIANGLE
CALL CALC.TRI.DATA
REM DRAW CIRCUMCIRCLE
CX = XCC: CY = YCC: RAD = RO: CC = 2: CALL DRAW.CIRCLE
FOR T = 0 TO 2 * PI STEP PI / 20
 XSG = XCC + RO * COS(T): YSG = YCC + RO * SIN(T)
 CALL FIND.SIMSON.LINE
 LF = (ABS(XSL12 - XSL23) + ABS(YSL12 - YSL23))
 IF LF = 0 THEN LF = 2 ELSE LF = 80 / LF
 XP1 = (LF + 1) * XSL12 - LF * XSL23: YP1 = (LF + 1) * YSL12 - LF * YSL23
 XP2 = (LF + 1) * XSL23 - LF * XSL12: YP2 = (LF + 1) * YSL23 - LF * YSL12
 LINE (XP1, YP1)-(XP2, YP2), 3
 LF = (ABS(XSL31 - XSL23) + ABS(YSL31 - YSL23))
 LF = (ABS(XSL12 - XSL23) + ABS(YSL12 - YSL23))
 XP1 = (LF + 1) * XSL31 - LF * XSL23: YP1 = (LF + 1) * YSL31 - LF * YSL23
 XP2 = (LF + 1) * XSL23 - LF * XSL31: YP2 = (LF + 1) * YSL23 - LF * YSL31
 LINE (XP1, YP1)-(XP2, YP2), 3
 LF = (ABS(XSL12 - XSL31) + ABS(YSL12 - YSL31))
 LF = (ABS(XSL12 - XSL23) + ABS(YSL12 - YSL23))
 XP1 = (LF + 1) * XSL31 - LF * XSL12: YP1 = (LF + 1) * YSL31 - LF * YSL12
 XP2 = (LF + 1) * XSL12 - LF * XSL31: YP2 = (LF + 1) * YSL12 - LF * YSL31
 LINE (XP1, YP1)-(XP2, YP2), 3
NEXT T
LOCATE 23, 1: PRINT "PRESS ANY KEY TO CONTINUE"
U$ = INPUT$(1)
CLS : LOCATE 1, 1: PRINT "AND NOW, BART SIMPSON'S LINE..."
LINE (100, 100)-(100, 50), 3
LINE (100, 50)-(120, 70), 3
LINE (120, 70)-(140, 50), 3
LINE (140, 50)-(160, 70), 3
LINE (160, 70)-(180, 50), 3
LINE (180, 50)-(200, 70), 3
LINE (200, 70)-(220, 50), 3
LINE (220, 100)-(220, 50), 3
LOCATE 14, 10: PRINT "DON'T HAVE A COW, MAN"
LOCATE 22, 1: PRINT "TYPE Q TO QUIT"
LOCATE 23, 1: PRINT "OR PRESS ANY OTHER KEY TO CONTINUE"
U$ = INPUT$(1)
IF U$ <> "Q" AND U$ <> "q" THEN
  SCREEN 0: WIDTH 80
  GOTO CHOICE
  END IF
SCREEN 0: WIDTH 80: CLS
END

SUB CALC.TRI.DATA
REM CALCULATE PARTS OF TRIANGLE
S12 = SQR((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
IF S12 = 0 THEN S12 = .01
S23 = SQR((X3 - X2) ^ 2 + (Y3 - Y2) ^ 2)
IF S23 = 0 THEN S23 = .01
S31 = SQR((X1 - X3) ^ 2 + (Y1 - Y3) ^ 2)
IF S31 = 0 THEN S31 = .01
S = (S12 + S23 + S31) / 2
REM CENTROID
XCTD = (X1 + X2 + X3) / 3: YCTD = (Y1 + Y2 + Y3) / 3
REM CALCULATE CIRCUMCIRCLE
P1 = X1: Q1 = Y1: P2 = X2: Q2 = Y2: P3 = X3: Q3 = Y3
CALL CIRCUM.CIRCLE
XCC = PCC: YCC = QCC: RO = RCC
END SUB

SUB CIRCUM.CIRCLE
REM COMPUTE CIRCUMCENTER PCC,QCC FOR P1,Q1 P2,Q2 P3,Q3
A = (P1 * (Q2 - Q3) + P2 * (Q3 - Q1) + P3 * (Q1 - Q2))
R1 = (P1 * P1 + Q1 * Q1): R2 = (P2 * P2 + Q2 * Q2): R3 = (P3 * P3 + Q3 * Q3)
D = -(R1 * (Q2 - Q3) + R2 * (Q3 - Q1) + R3 * (Q1 - Q2)) / (2 * A)
E = (R1 * (P2 - P3) + R2 * (P3 - P1) + R3 * (P1 - P2)) / (2 * A)
F = -(R1 * (P2 * Q3 - P3 * Q2) + R2 * (P3 * Q1 - P1 * Q3) + R3 * (P1 * Q2 - P2 * Q1)) / A
RCC = SQR(D * D + E * E - F): PCC = -D: QCC = -E
END SUB

SUB COMP.TRI
REM COMPUTER CREATED TRIANGLE
A = 2 * PI * RND(1)
T = A + PI * RND(1) / 2: X1 = RC * COS(T): Y1 = RC * SIN(T)
T = A + PI * (2 + RND(1)) / 2: X2 = RC * COS(T): Y2 = RC * SIN(T)
T = A + PI * RND(1) / 2: X1 = RC * COS(T): Y1 = RC * SIN(T)
T = A + PI * (4 + RND(1)) / 2: X3 = RC * COS(T): Y3 = RC * SIN(T)
XCTD = (X1 + X2 + X3) / 3: YCTD = (Y1 + Y2 + Y3) / 3
X1 = X1 - XCTD + XC: Y1 = Y1 - YCTD + YC: X2 = X2 - XCTD + XC: Y2 = Y2 - YCTD + YC
X3 = X3 - XCTD + XC: Y3 = Y3 - YCTD + YC
END SUB

SUB DRAW.CIRCLE
REM DRAW CIRCLES
X00 = RAD: Y00 = 0: FOR T = 0 TO .52 * PI STEP .02 * PI
X01 = RAD * COS(T): Y01 = RAD * SIN(T)
LINE (CX + X00, CY + Y00)-(CX + X01, CY + Y01), CC
LINE (CX - X00, CY + Y00)-(CX - X01, CY + Y01), CC
LINE (CX + X00, CY - Y00)-(CX + X01, CY - Y01), CC
LINE (CX - X00, CY - Y00)-(CX - X01, CY - Y01), CC
X00 = X01: Y00 = Y01: NEXT T
END SUB

SUB DRAW.TRIANGLE
REM DRAW TRIANGLE
LINE (X1, Y1)-(X2, Y2), 2
LINE (X3, Y3)-(X2, Y2), 2
LINE (X1, Y1)-(X3, Y3), 2
END SUB

SUB FIND.SIMSON.LINE
REM GENERATE SIMSON'S LINE GIVEN XSG,YSG
S1 = S12: S2 = SQR((XSG - X1) ^ 2 + (YSG - Y1) ^ 2): S3 = SQR((XSG - X2) ^ 2 + (YSG - Y2) ^ 2)
S = (S1 + S2 + S3) / 2
IF S = S1 THEN S = S + .01
IF S = S2 THEN S = S + .01
IF S = S3 THEN S = S + .01
A1 = 2 * ATN(SQR((S - S2) * (S - S3) / (S * (S - S1))))
A2 = 2 * ATN(SQR((S - S3) * (S - S1) / (S * (S - S2))))
A3 = 2 * ATN(SQR((S - S1) * (S - S2) / (S * (S - S3))))
XSL12 = (X1 * S3 * COS(A2) + X2 * S2 * COS(A3)) / S1
YSL12 = (Y1 * S3 * COS(A2) + Y2 * S2 * COS(A3)) / S1
S1 = S23: S2 = SQR((XSG - X2) ^ 2 + (YSG - Y2) ^ 2): S3 = SQR((XSG - X3) ^ 2 + (YSG - Y3) ^ 2)
S = (S1 + S2 + S3) / 2: A1 = 2 * ATN(SQR((S - S2) * (S - S3) / (S * (S - S1))))
A2 = 2 * ATN(SQR((S - S3) * (S - S1) / (S * (S - S2))))
A3 = 2 * ATN(SQR((S - S1) * (S - S2) / (S * (S - S3))))
XSL23 = (X2 * S3 * COS(A2) + X3 * S2 * COS(A3)) / S1
YSL23 = (Y2 * S3 * COS(A2) + Y3 * S2 * COS(A3)) / S1
S1 = S31: S2 = SQR((XSG - X3) ^ 2 + (YSG - Y3) ^ 2): S3 = SQR((XSG - X1) ^ 2 + (YSG - Y1) ^ 2)
S = (S1 + S2 + S3) / 2
IF S = S1 THEN S = S + .01
IF S = S2 THEN S = S + .01
IF S = S3 THEN S = S + .01
A1 = 2 * ATN(SQR((S - S2) * (S - S3) / (S * (S - S1))))
A2 = 2 * ATN(SQR((S - S3) * (S - S1) / (S * (S - S2))))
A3 = 2 * ATN(SQR((S - S1) * (S - S2) / (S * (S - S3))))
XSL31 = (X3 * S3 * COS(A2) + X1 * S2 * COS(A3)) / S1
YSL31 = (Y3 * S3 * COS(A2) + Y1 * S2 * COS(A3)) / S1
END SUB

SUB USER.TRI
REM USER CREATED TRIANGLE
CLS : CX = XC: CY = YC: RAD = RC: CC = 1: CALL DRAW.CIRCLE
LOCATE 21, 1: INPUT "INPUT AZIMUTH 1 "; AZ$
AZ1 = VAL(AZ$) * PI / 180
X1 = XC + RC * COS(AZ1): Y1 = YC - RC * SIN(AZ1)
LINE (X1 - 2, Y1 - 2)-(X1 + 2, Y1 + 2), 2, B
LOCATE 22, 1: INPUT "INPUT AZIMUTH 2 "; AZ$
INPUT.AZ2:
AZ2 = VAL(AZ$) * PI / 180
IF SIN(AZ2) = SIN(AZ1) AND COS(AZ2) = COS(AZ1) THEN GOTO INPUT.AZ2
X2 = XC + RC * COS(AZ2): Y2 = YC - RC * SIN(AZ2)
LINE (X1, Y1)-(X2, Y2)
LINE (X2 - 2, Y2 - 2)-(X2 + 2, Y2 + 2), 2, B
LOCATE 23, 1: INPUT "INPUT AZIMUTH 3 "; AZ$
INPUT.AZ3:
AZ3 = VAL(AZ$) * PI / 180
IF SIN(AZ3) = SIN(AZ1) AND COS(AZ3) = COS(AZ1) THEN GOTO INPUT.AZ3
IF SIN(AZ3) = SIN(AZ2) AND COS(AZ3) = COS(AZ2) THEN GOTO INPUT.AZ3
X3 = XC + RC * COS(AZ3): Y3 = YC - RC * SIN(AZ3)
LINE (X3 - 2, Y3 - 2)-(X3 + 2, Y3 + 2), 2, B
LINE (X2, Y2)-(X3, Y3)
LINE (X3, Y3)-(X1, Y1)
REM RESET TRIANGLE
DX = XC - (X1 + X2 + X3) / 3
DY = (Y1 + Y2 + Y3) / 3 - YC
X1 = X1 - DX: Y1 = Y1 - DY
X2 = X2 - DX: Y2 = Y2 - DY
X3 = X3 - DX: Y3 = Y3 - DY
END SUB