DECLARE SUB Ellipse (d!, e!)
DECLARE FUNCTION ysq! (d!, e!, x!)
DECLARE SUB PromptFor (q$, source!)
DECLARE SUB Menu2 (d!, e!, de!, done!)
DECLARE SUB InfoScreen ()
DECLARE SUB Parabola (d!)
DECLARE SUB Hyperbola (d!, e!)
DECLARE SUB Menu1 (d!, e!, de!, done!)
DECLARE SUB Background (d!, e!)
DECLARE SUB TidyUp ()
DECLARE SUB Directrices (d!, e!)
DECLARE SUB Foci (d!, e!)
DECLARE SUB FixedDirectrices ()
'============================================================================
'   G.H. George                                                 1994 FEB 23
'                                CONICS3.BAS
' -- to demonstrate how conic sections deform as eccentricity changes.
'     Directrices are held fixed.
'============================================================================
'
CALL FixedDirectrices
CALL TidyUp
END

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

CALL Directrices(d, e)
CALL Foci(d, e)
END SUB

'============================================================================
'  Draw directrices.
'============================================================================
SUB Directrices (d, e)

LINE (160 - d, 0)-(160 - d, 199)' <--  left directrix.
LINE (160 + d, 0)-(160 + d, 199)' <--  right directrix.

END SUB

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

FOR x = 160 TO -160 STEP -2             ' <--  Draw lower half of ellipse.
    y = ysq(d, e, x)
    IF y >= 0 THEN
        x2 = x + 160: y = SQR(y) * .83 + 100 '  -  correct for pixel coordinates.
        LINE -(x2, y), 3
    END IF
NEXT x

END SUB

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

'============================================================================
'  Draw the foci as small circles on the  x-axis .
'============================================================================
SUB Foci (d, e)
focus = d * e * e                     ' where  d = centre-directrix distance.

CIRCLE (160 - focus, 100), 3, 2         ' <--  left focus.
CIRCLE (160 + focus, 100), 3, 2         ' <--  right focus.

END SUB

'============================================================================
'   Draw an hyperbola (with the current value of eccentricity  e).
'============================================================================
SUB Hyperbola (d, e)
PSET (-1, 0), 3                      ' <--  Start at upper left screen corner.
FOR x = -160 TO -d - 1 STEP 2         ' <--  Draw upper left part of hyperbola.
    y = ysq(d, e, x)
    IF y >= 0 THEN
        x2 = x + 160: y = -SQR(y) * .83 + 100 '   -  correct for pixel coordinates.
        LINE -(x2, y), 3
    END IF
NEXT x

FOR x = -d - 1 TO -160 STEP -2       ' <--  Draw lower left part of hyperbola.
    y = ysq(d, e, x)
    IF y >= 0 THEN
        x2 = x + 160: y = SQR(y) * .83 + 100 '   -  correct for pixel coordinates.
        LINE -(x2, y), 3
    END IF
NEXT x

PSET (320, 200), 3                  ' <--  Start at lower right screen corner.
FOR x = 160 TO -d STEP -2      ' <--  Draw lower right part of hyperbola.
    y = ysq(d, e, x)
    IF y >= 0 THEN
        x2 = x + 160: y = SQR(y) * .83 + 100 '   -  correct for pixel coordinates.
        LINE -(x2, y), 3
    END IF
NEXT x

FOR x = -d TO 160 STEP 2        ' <--  Draw upper right part of hyperbola.
    y = ysq(d, e, x)
    IF y >= 0 THEN
        x2 = x + 160: y = -SQR(y) * .83 + 100 '   -  correct for pixel coordinates.
        LINE -(x2, y), 3
    END IF
NEXT x

END SUB

'============================================================================
'   Print introductory message to screen.
'============================================================================
SUB InfoScreen
SCREEN 0: WIDTH 80: COLOR 15, 1: CLS
LOCATE 3, 28: PRINT "Subprogram FixedDirectrices"
LOCATE 4, 28: PRINT "==========================="
LOCATE 7, 1
PRINT "     This subprogram draws conic sections of various eccentricities."
PRINT "     All conic sections have their centre at the centre of the screen"
PRINT "     and the directrices remain fixed (unless you choose to alter the"
PRINT "     parameter  d )."
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"
PRINT "     of 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 (d, 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(d, 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 d, e or de, or exit).
'============================================================================
SUB Menu2 (d, 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 "D"; : COLOR 15, 1
PRINT ":  Select a new centre-directrix distance (now";
PRINT USING "### pixels)"; d
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 "D"
    LOCATE 15, 10: COLOR 13, 0: PRINT "Enter a new value for the centre-";
    INPUT "directrix distance (>0): ", d
    IF d <= 0 THEN d = 40
CASE "X"
    done = true
END SELECT

END SUB

'============================================================================
'   Draw a parabola (eccentricity  e = 1).
'============================================================================
SUB Parabola (d)
LINE (0, 100)-(319, 100), 3         ' <--  Degenerate conic; now a line.

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$ = "D" 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

FUNCTION ysq (d, e, x)
'============================================================================
'   Evaluates square of  y-coordinate on conic section, given x-coordinate.
'============================================================================

ysq = (1 - e * e) * (d * d * e * e - x * x)

END FUNCTION