'============================================================================
'   G.H. George                                       Created   1993 OCT 20
'                               TROCHOID.BAS          Modified  1998 APR 30
'   to illustrate the generation of a trochoid curve.
'============================================================================

'   Subprograms:
'       AskFor:      Print message to user; ask user for value of  d/r .
'       Axes:        Go to graphics screen; draw titles and axes.
'       DrawCircle:  Draw (or erase) centre point, circle & radius vector.
'       Arc:         Draw present arc of trochoid.
'       PressAnyKey: Prompt user to press any key to continue.
'       WaitForKey:  Waits for user to press a key.
DECLARE SUB DefineCircle (d!)
DECLARE SUB Axes (d!)
DECLARE SUB AskFor (d!)
DECLARE SUB DrawCircle (Theta!, d!)
DECLARE SUB WaitForKey (KeyPressed AS STRING)
DECLARE SUB PressAnyKey ()
DECLARE SUB Arc (Theta!, d!)

'   Global Constants:
'       False:  logical false (= 0)
'       True:   logical true (= -1)
'       Pi:     3.14159265 (global constant)
DEFINT F, T
CONST False = 0, True = NOT False
CONST Pi = 3.141592654#

'   Variables:
'       Image:  array holding image of rolling circle (for PUT & GET).
'       d:      ratio (distance from centre) : (radius of circle).
'       Theta:  angle through which circle has rolled.
'       q$:     key pressed by user during drawing phase.
'       i:      FOR-NEXT loop counter.
DIM Theta AS SINGLE
COMMON SHARED Image()

CALL AskFor(d)

DO UNTIL d > 3                                  ' d > 3  ends program.
    CALL Axes(d)
    LET Theta = 0
    COLOR 2                                     ' Green circles.
    CALL DrawCircle(0, d)                       ' Draw initial circle.
    LET q$ = "Y"
   
    DO                                       ' Has user opted to skip to end?
        IF q$ = "X" THEN
            FOR i = 1 TO 100: NEXT i            ' If so, slight time delay.
        ELSE
            DO                                  ' If not, wait for user to
                CALL WaitForKey(q$)             '  press "Y", space or <CR>;
            LOOP UNTIL q$ = "Y" OR q$ = "X"     '  or "X" = skip to end.
        END IF

        COLOR 0                                 ' Black foreground.
        CALL DrawCircle(Theta, d)               ' Erase old circle.
        
        LET Theta = Theta + Pi / 72             ' Update Theta.
       
        COLOR 14                                ' Yellow colour.
        CALL Arc(Theta, d)                      ' Draw next piece of trochoid.
      
        COLOR 2                                 ' Green colour.
        CALL DrawCircle(Theta, d)               ' Draw new circle.
    LOOP UNTIL Theta > 4 * Pi

    CALL PressAnyKey
    CALL AskFor(d)                              ' Ask user for new value of d.
LOOP

END

DEFSNG F, T
SUB Arc (Theta, d)
'============================================================================
'   Draw the current piece of the trochoid curve (Theta - 1  to  Theta).
'   x = r theta - d cos theta , y = r - d sin theta ;  with  r = 25.
'============================================================================

'   Procedures:
'       <none>

'   Parameters:
'     Theta:    angle through which circle has rolled.
'         d:    ratio (distance from centre) : (radius of circle).

' Local variables:
'   x1, y1:   pixel coordinates of previous point on trochoid.
'   x2, y2:   pixel coordinates of current point on trochoid.

LET x1 = 25 * (1 + Theta - Pi / 72 - d * SIN(Theta - Pi / 72))
LET x2 = 25 * (1 + Theta - d * SIN(Theta))
LET y1 = 100 + 25 * (d * COS(Theta - Pi / 72)) * 5 / 6
LET y2 = 100 + 25 * (d * COS(Theta)) * 5 / 6     ' (5/6 due to aspect ratio)

LINE (x1, y1)-(x2, y2), 14                       ' Draw arc, yellow colour.

END SUB

SUB AskFor (d)
'============================================================================
'   Ask the user for a value for  d/r .
'============================================================================

'   No procedures or local variables.

'   Parameters:
'         d:    ratio (distance from centre) : (radius of circle).

SCREEN 0: WIDTH 80
CLS
LOCATE 3, 33: PRINT "TROCHOID GRAPH"
LOCATE 4, 33: PRINT "=============="
PRINT
PRINT "Imagine a bicycle wheel rolling on level ground in a straight line."
PRINT "The path swept out by a point on one of the spokes is a trochoid ";
PRINT "curve. "
PRINT
PRINT "You may choose how far out from the centre of the rolling wheel the ";
PRINT "point"
PRINT "is, from zero to three times the radius.   Or you may leave the ";
PRINT "program "
PRINT "by selecting a value for  d/r  of more than three."
PRINT

INPUT "Enter a value for  d/r : ", d

IF d < 0 THEN LET d = -d                ' Guard against negative ratio.

END SUB

SUB Axes (d)
'============================================================================
'   Enter graphics mode, draw cartesian axes, print legends and prepare for
'   the sketch of the trochoid.
'============================================================================

'   Subprogram:
'       DefineCircle:   defines the array  Image()  which carries the image
'                        of the rolling circle.

'   Parameters:
'         d:    ratio (distance from centre) : (radius of circle).

'   Local variables:
'       <none>

SCREEN 7                                ' Graphics screen (EGA or VGA needed)
CALL DefineCircle(d)

COLOR 15
LOCATE 1, 1: PRINT USING "d = #.### R"; d;     ' title for graph.
IF ABS(d - 1) < .0005 THEN
    PRINT TAB(25); "CYCLOID"
ELSE
    PRINT TAB(25); "TROCHOID"
END IF

COLOR 3, 0                              ' cyan f/g, black background.
LINE (0, 121)-(319, 121)                ' x-axis.
LINE (25, 0)-(25, 199)                  ' y-axis.
COLOR 3                                 ' axis labels
LOCATE 20, 23: PRINT "2"; CHR$(227)     ' 227 = pi

LOCATE 24, 1: PRINT "Press  X  to skip to end of sketch.";
LOCATE 25, 1: PRINT "Press <SPACE> to continue.";
LOCATE 1, 20

END SUB

SUB DefineCircle (d)
'============================================================================
'   Define an array which will contain the image of the rolling circle.
'============================================================================

'   Procedures:
'       <none>

'   Parameters:
'         d:    ratio (distance from centre) : (radius of circle).

'   Local variables:
'   ArraySize:  number of bytes needed to store the image in the array.
'           r:  radius of circle to be drawn = half width of image square.

DIM ArraySize AS INTEGER

LET r = 25
LET ArraySize = 4 + 2 * r * 4 * INT((2 * r * 4 / 4 + 7) / 8)

'       ArraySize = 4 + height*planes*INT((width*bits-per-pixel/planes + 7)/8)
'           where, in SCREEN 7, planes = 4, bits-per-pixel = 4 .

REDIM Image(ArraySize)

COLOR 2
CIRCLE (160, 75), r                             ' Draw defining circle.
CIRCLE (160, 75), 2                             ' Highlight centre of circle.

GET STEP(-r, -r)-STEP(2 * r, 2 * r), Image      ' Store image in array.
PUT (160 - r, 75 - r), Image, XOR               ' Erase defining circle.

END SUB

SUB DrawCircle (Theta, d)
'============================================================================
'   Draw (or erase) the centre point, the rolling circle and the radius
'    vector for the current value of rotation angle Theta.
'============================================================================

'   Procedures:
'       <none>

'   Parameters:
'     Theta:    angle through which circle has rolled.
'         d:    ratio (distance from centre) : (radius of circle).

'   Local variables:
'        xc:    x-coordinate of centre of circle (yc is always = 100).

LET xc = 25 + 25 * Theta

IF xc > 290 THEN
    CIRCLE (xc, 100), 25                       ' draw rolling circle.
    CIRCLE (xc, 100), 1                        ' highlight centre of circle.
ELSE
    PUT (xc - 25, 75), Image, XOR              ' if not out of bounds, use
END IF                                         '  stored image.  (XOR avoids
                                               '  wiping out curve & axis).

LINE (xc, 100)-(xc - 25 * d * SIN(Theta), 100 + 21 * d * COS(Theta))
'LINE (xc + 25 * SIN(Theta), 100 - 21 * COS(Theta))-(xc - 50 * SIN(Theta), 100 + 42 * COS(Theta))
                                               ' draw radius vector.
END SUB

SUB PressAnyKey
'============================================================================
'   Prompts the user to press a key -- program pauses until user complies.
'============================================================================

'   Procedures:
'      WaitForKey:  pause until any key is pressed

'   Parameters:
'     <none>

'   Local variables:
'       KeyPressed:   the key pressed by the user
DIM KeyPressed AS STRING

LOCATE 25, 1: PRINT "Press any key to continue: ";
CALL WaitForKey(KeyPressed)

END SUB

SUB WaitForKey (KeyPressed AS STRING)
'============================================================================
'                      - cause program to pause until a key is pressed.
'============================================================================

'   No procedures or local variables.

'   Parameter:
'       KeyPressed:  the key pressed by the user

DO
   LET KeyPressed = UCASE$(INKEY$)
LOOP WHILE KeyPressed = ""

IF ASC(KeyPressed) = 13 OR ASC(KeyPressed) = 32 THEN LET KeyPressed = "Y"
                ' ^--  treat <CR> and <SPACE> as a "YES" response.
                   
END SUB