DECLARE SUB PromptFor (q$, source!)
DECLARE SUB Menu2 (a!, e!, de!, done!)
DECLARE SUB InfoScreen ()
DECLARE SUB Parabola (a!)
DECLARE SUB Hyperbola (a!, e!)
DECLARE SUB Menu1 (a!, e!, de!, done!)
DECLARE SUB Ellipse (a!, e!)
DECLARE SUB Background (a!, e!)
DECLARE SUB TidyUp ()
DECLARE SUB Directrices (a!, e!)
DECLARE SUB Foci (a!, e!)
DECLARE SUB FixedVertex ()
'============================================================================
'   G.H. George                                                 1992 FEB 26
'                                CONICS.BAS
' -- to demonstrate how conic sections deform as eccentricity changes.
'    Both vertices are held constant.
'============================================================================
'
CALL FixedVertex
CALL TidyUp
END

'============================================================================
'  Draw background for new conic section.
'============================================================================
SUB Background (a, e)
SCREEN 1: COLOR 0, 1: CLS
LINE (0, 100)-(319, 100), 1         ' <--  x-axis.
LINE (160, 0)-(160, 199), 1         ' <--  y-axis.

IF e > a / 160 THEN CALL Directrices(a, e)
IF e < 160 / a THEN CALL Foci(a, e)
END SUB

'============================================================================
'  Draw directrices.
'============================================================================
SUB Directrices (a, e)
x = a / e
LINE (160 - x, 0)-(160 - x, 199), 2     ' <--  left directrix.
LINE (160 + x, 0)-(160 + x, 199), 2     ' <--  right directrix.
END SUB

'============================================================================
'   Draw an ellipse with the current value of eccentricity  e .
'============================================================================
SUB Ellipse (a, e)
b = SQR(1 - e * e)
PSET (160 - a, 100), 3              ' <--  Start at left vertex.
FOR x = -a TO a STEP 2              ' <--  Draw upper half of ellipse.
    y = b * SQR(ABS(a * a - x * x))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x

FOR x = a TO -a STEP -2             ' <--  Draw lower half of ellipse.
    y = -b * SQR(ABS(a * a - x * x))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x

END SUB

'============================================================================
'  Draw conic sections with a fixed centre and fixed vertices (constant  a )
'============================================================================
SUB FixedVertex
CALL InfoScreen
CONST false = 0, true = NOT false
a = 40: e = 0: de = 1 / 10: done = false
DO UNTIL done
    CALL Background(a, e)
    IF e < 1 THEN
        CALL Ellipse(a, e)
    ELSEIF ABS(e - 1) < .00001 THEN
        CALL Parabola(a)
    ELSE
        CALL Hyperbola(a, e)
    END IF
    CALL Menu1(a, e, de, done)
LOOP
END SUB

'============================================================================
'  Draw the foci as small circles on the  x-axis .
'============================================================================
SUB Foci (a, e)
x = a * e
CIRCLE (160 - x, 100), 3, 2         ' <--  left focus.
CIRCLE (160 + x, 100), 3, 2         ' <--  right focus.
END SUB

'============================================================================
'   Draw an hyperbola with the current value of eccentricity  e .
'============================================================================
SUB Hyperbola (a, e)
b = SQR(e * e - 1)
y0 = -b * SQR(160 * 160 - a * a)
y0 = y0 * .83 + 100
PSET (0, y0), 3                     ' <--  Start at upper left end.
FOR x = -160 TO -a STEP 2           ' <--  Draw upper half of left branch.
    y = -b * SQR(ABS(x * x - a * a))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x

FOR x = -a TO -160 STEP -2          ' <--  Draw lower half of left branch.
    y = b * SQR(ABS(x * x - a * a))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x

y0 = -b * SQR(160 * 160 - a * a)
y0 = y0 * .83 + 100
PSET (319, y0), 3                   ' <--  Start at upper right end.
FOR x = 160 TO a STEP -2            ' <--  Draw upper half of right branch.
    y = -b * SQR(ABS(x * x - a * a))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x

FOR x = a TO 160 STEP 2             ' <--  Draw lower half of right branch.
    y = b * SQR(ABS(x * x - a * a))
    x2 = x + 160: y = y * .83 + 100 '   -  correct for pixel coordinates.
    LINE -(x2, y), 3
NEXT x
END SUB

'============================================================================
'   Print introductory message to screen.
'============================================================================
SUB InfoScreen
SCREEN 0: WIDTH 80: COLOR 15, 1: CLS
LOCATE 3, 28: PRINT "Subprogram FixedVertex"
LOCATE 4, 28: PRINT "======================"
LOCATE 7, 1
PRINT "     This subprogram draws conic sections of various eccentricities."
PRINT "     All conic sections are centred on the centre of the screen and all"
PRINT "     share the same vertex (unless you choose to alter the parameter  a )."
PRINT "     The parabola (eccentricity = 1) is thus a degenerate case."
PRINT
PRINT "     After each conic section has been drawn, you will be given options, "
PRINT "     one of which is to go to another menu to alter a parameter."
PRINT "     The default option is to draw the conic section with the next value of"
PRINT "     eccentricity."
LOCATE 23, 30
PRINT "Press any key to begin:";
CALL PromptFor(dummy$, 0)
END SUB

'============================================================================
'  Display first level menu upon completion of current conic s. drawing.
'============================================================================
SUB Menu1 (a, e, de, done)
CONST true = -1
LOCATE 21, 15: PRINT USING "e = ##.###"; e
LOCATE 22, 1: PRINT "<SPACE> = next e     `-' = previous e"
LOCATE 23, 10: PRINT "E = other options";
valid = 0
CALL PromptFor(q$, 1)
SELECT CASE q$
CASE "-"
    e = e - de
CASE "E"
    CALL Menu2(a, e, de, done)
CASE ELSE
    e = e + de
END SELECT
e = ABS(e)                         ' <--  Guard against e<0 being set by user!
END SUB

'============================================================================
'  Second level menu, for further options (change a, e or de, or exit).
'============================================================================
SUB Menu2 (a, e, de, done)
CONST true = -1
CALL TidyUp
LOCATE 3, 19: PRINT "Please select one of the following options:"
LOCATE 5, 15: COLOR 11, 0: PRINT "E"; : COLOR 15, 1
PRINT ":  Select a new value for eccentricity (now";
PRINT USING "##.###)"; e
LOCATE 7, 15: COLOR 12, 0: PRINT "S"; : COLOR 15, 1
PRINT ":  Change the step in eccentricity (now";
PRINT USING "##.###)"; de
LOCATE 9, 15: COLOR 13, 0: PRINT "A"; : COLOR 15, 1
PRINT ":  Select a new centre-vertex distance (now";
PRINT USING "### pixels)"; a
LOCATE 12, 15: COLOR 14, 0: PRINT "X"; : COLOR 15, 1
PRINT ":  EXIT from this program"
CALL PromptFor(option$, 2)
SELECT CASE option$
CASE "E"
    LOCATE 15, 19: COLOR 11, 0: PRINT "Enter a new value for eccentricity ";
    INPUT "(>=0) :", e
    IF e < 0 THEN e = 0
CASE "S"
    LOCATE 15, 19: COLOR 12, 0: PRINT "Enter a new value for the step ";
    INPUT "(<>0) :", newstep
    IF newstep <> 0 THEN de = newstep
CASE "A"
    LOCATE 15, 10: COLOR 13, 0: PRINT "Enter a new value for the centre-vertex ";
    INPUT "distance (>0): ", a
    IF a <= 0 THEN a = 40
CASE "X"
    done = true
END SELECT

END SUB

'============================================================================
'  Draw degenerate "parabola" (with centre-vertex a=const, it's the x-axis!)
'============================================================================
SUB Parabola (a)
LINE (0, 100)-(319, 100), 3
END SUB

'============================================================================
'  Prompts the user to press a key and accepts only a valid response.
'============================================================================
SUB PromptFor (q$, source)
true = -1: valid = 0
DO
    DO
        q$ = INKEY$
    LOOP WHILE q$ = ""
    q$ = UCASE$(q$)
    IF source = 0 THEN
        valid = true
    ELSEIF source = 1 THEN
        IF q$ = " " OR ASC(q$) = 13 OR q$ = "-" OR q$ = "E" THEN valid = true
    ELSEIF source = 2 THEN
        IF q$ = "A" OR q$ = "E" OR q$ = "S" OR q$ = "X" THEN valid = true
    END IF
LOOP UNTIL valid

END SUB

'============================================================================
'  Restore the screen to normal just before leaving this program.
'============================================================================
SUB TidyUp
SCREEN 0: WIDTH 80: COLOR 15, 1: CLS
END SUB