DECLARE SUB Ellipse (a!, e!)
DECLARE FUNCTION ysq! (a!, e!, x!)
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 Background (a!, e!)
DECLARE SUB TidyUp ()
DECLARE SUB Directrices (a!, e!)
DECLARE SUB Foci (a!, e!)
DECLARE SUB FixedFocus ()
'============================================================================
'   G.H. George                                                 1992 FEB 26
'                                CONICS2.BAS
' -- to demonstrate how conic sections deform as eccentricity changes.
'    One focus and vertex are held constant.
'============================================================================
'
CALL FixedFocus
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.

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

'============================================================================
'  Draw directrices.
'============================================================================
SUB Directrices (a, e)
IF e > .001 THEN
    left = a * (1 + e) / e
    IF left < 160 THEN
        LINE (160 - left, 0)-(160 - left, 199)' <--  left directrix.
        IF ABS(e - 1) > .001 THEN
            right = 2 * a * e / (1 - e) + left
            IF ABS(right) < 160 THEN
                LINE (160 + right, 0)-(160 + right, 199)' <--  right directrix.
            END IF
        END IF
    END IF
END IF
END SUB

'============================================================================
'   Draw an ellipse (with the current value of eccentricity  e).
'============================================================================
SUB Ellipse (a, e)
PSET (160 - a, 100), 3              ' <--  Start at left vertex.
FOR x = -160 TO 160 STEP 2              ' <--  Draw upper half of ellipse.
    y = ysq(a, 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(a, 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  a )
'============================================================================
SUB FixedFocus
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)
CIRCLE (160, 100), 3, 2         ' <--  left focus (at screen centre).
IF ABS(e - 1) > .001 THEN
    interfocal = 2 * a * e / (1 - e)
    IF ABS(interfocal) < 160 THEN
        CIRCLE (160 + interfocal, 100), 3, 2         ' <--  right focus.
    END IF
END IF
END SUB

'============================================================================
'   Draw an hyperbola (with the current value of eccentricity  e).
'============================================================================
SUB Hyperbola (a, e)
PSET (-1, 0), 3                      ' <--  Start at upper left screen corner.
FOR x = -160 TO -a - 1 STEP 2         ' <--  Draw upper left part of hyperbola.
    y = ysq(a, 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 = -a - 1 TO -160 STEP -2       ' <--  Draw lower left part of hyperbola.
    y = ysq(a, 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 -a STEP -2      ' <--  Draw lower right part of hyperbola.
    y = ysq(a, 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 = -a TO 160 STEP 2        ' <--  Draw upper right part of hyperbola.
    y = ysq(a, 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 FixedFocus"
LOCATE 4, 28: PRINT "====================="
LOCATE 7, 1
PRINT "     This subprogram draws conic sections of various eccentricities."
PRINT "     All conic sections have one focus at the centre of the screen and"
PRINT "     the corresponding vertex is fixed (unless you choose to alter the"
PRINT "     parameter  a )."
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 (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 focus-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 focus-vertex ";
    INPUT "distance (>0): ", a
    IF a <= 0 THEN a = 40
CASE "X"
    done = true
END SELECT

END SUB

'============================================================================
'   Draw a parabola (eccentricity  e = 1).
'============================================================================
SUB Parabola (a)
PSET (160 - a, 100), 3              ' <--  Start at vertex.
FOR x = -160 TO 160 STEP 2              ' <--  Draw upper half of parabola.
    y = ysq(a, 1, 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 parabola.
    y = ysq(a, 1, 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

'============================================================================
'  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

FUNCTION ysq (a, e, x)
bracket = a * a * (1 + e) + 2 * a * e * x + (e - 1) * x * x
ysq = (1 + e) * bracket
END FUNCTION