'============================================================================
'   G.H. George                                       Created   1992 OCT 30
'                                POLARS.BAS           Modified  1998 MAY 01
'   to illustrate the sketching of the polar plots   r = cos (n theta) .
'============================================================================

'   Procedures:
'      IntroScreen:  print welcome message
'             Axes:  plot cartesian axes & graph, polar axis & guide circle
'        DrawGraph:  plot polar graph
DECLARE SUB IntroScreen ()
DECLARE SUB Axes (n AS INTEGER)
DECLARE SUB Cartesian (n AS INTEGER)
DECLARE SUB DrawGraph (n AS INTEGER)
DECLARE SUB PressAnyKey ()
DECLARE SUB WaitForKey (KeyPressed AS STRING)

'   Global constants:
'      False:   logical false (= 0)
'       True:   logical true (= -1)
'         Pi:   pi
DEFINT F, T
CONST False = 0, True = NOT False
CONST Pi = 3.141593

'   Variables:
'          n:   loop counter = multiple of angle theta
DIM n AS INTEGER

CALL IntroScreen

FOR n = 1 TO 6
    CALL Axes(n)
    CALL DrawGraph(n)
NEXT n

END

DEFSNG F, T
SUB Axes (n AS INTEGER)
'============================================================================
'   Enter graphics mode, draw cartesian plot of  r = cos (n theta), and
'   prepare for the polar sketch below it.
'============================================================================

'   Procedures:
'      Cartesian:   plot cartesian version of  r : theta  at the top

'   Parameters:
'         n:    current multiple of theta

'   Local variables:
'       <none>

SCREEN 7                                ' Graphics screen (EGA or VGA needed)
COLOR 15, 0                             ' v-- title for graphs.
LOCATE 1, 1: PRINT "Cartesian and Polar Graphs of r = cos ";
PRINT LTRIM$(RTRIM$(STR$(n))); CHR$(233) ' 233 = theta

COLOR 3, 0                              ' cyan f/g, black background.
LINE (10, 40)-(310, 40)                 ' x-axis.
LINE (110, 60)-(110, 20)                ' y-axis.
LINE (10, 42)-(10, 38)                  ' tick mark x = -pi
LINE (60, 42)-(60, 38)                  ' tick mark x = -pi/2
LINE (160, 42)-(160, 38)                ' tick mark x = +pi/2
LINE (210, 42)-(210, 38)                ' tick mark x = +pi
LINE (260, 42)-(260, 38)                ' tick mark x = +3pi/2
LOCATE 7, 2                             ' axis labels
PRINT "-"; CHR$(227)                    ' 227 = pi
LOCATE 7, 27: PRINT CHR$(227)
LOCATE 5, 39: PRINT CHR$(233)
LOCATE 2, 14: PRINT "r"

LINE (160, 130)-(270, 130)              ' polar axis.
LOCATE 17, 38: PRINT CHR$(233); "=0"
CIRCLE (160, 130), 70

CALL Cartesian(n)                       ' cartesian sketch of r = cos n theta

END SUB

SUB Cartesian (n AS INTEGER)
'============================================================================
'   Draw cartesian graph of  r = cos (n theta) .
'============================================================================

'   Procedures:
'       <none>

'   Parameters:
'         n:    current multiple of theta

'   Local variables:
'         x:    x coordinate on the Cartesian plot
'         y:    y coordinate on the Cartesian plot; then pixel y coordinate
'     pixel:    loop counter = horizontal pixel coordinate
DIM pixel AS INTEGER

' Plot the first point (theta = - n Pi )
COLOR 2, 0
LET y = 40 - 20 * COS(n * (-Pi)) * 5 / 6    ' Aspect ratio = 5/6 in screen 1
PSET (10, y)

' Plot all remaining points [Origin at pixel (110, 40) ]

FOR pixel = 10 TO 310
    LET x = (pixel - 110) * Pi / 100
    LET y = COS(n * x)
    LET y = 40 - 20 * y * 5 / 6
    LINE -(pixel, y)
NEXT pixel

END SUB

SUB DrawGraph (n AS INTEGER)
'============================================================================
'  Draw the polar curve, 1.8 degrees at a time.
'============================================================================

'   Procedures:
'      WaitForKey:   pause until the user presses any key
'     PressAnyKey:   prompt the user to press any key

'   Parameters:
'         n:    current multiple of theta

'   Local variables:
'       pixel:  horizontal pixel coordinate
'  KeyPressed:  key pressed by user
'       Upper:  maximum horizontal pixel coordinate
'      xp, yp:  pixel coordinates for the current point on the polar curve
'oldxp, oldyp:  pixel coordinates for the previous point on the polar curve
'       theta:  polar angle for the current point
'           r:  radial displacement of the current point
'          yc:  vertical pixel coordinate of current point on Cartesian plot
'     rColour:  colour of polar arc (red if r < 0, white otherwise)
DEFINT A-Z
DIM KeyPressed AS STRING, theta AS SINGLE, r AS SINGLE

LET pixel = 110 - 50 / n            ' start at nearest zero to theta=0.
CIRCLE (pixel, 40), 1, 6            ' indicate current theta on cartesian sk.
CIRCLE (160, 130), 2, 6             ' indicate current theta on polar sketch.
CALL WaitForKey(KeyPressed)
LET Upper = 310
LET xp = 160: LET yp = 130
LET yc = 40
LET theta = (pixel - 110) * Pi / 100    ' start at theta = -pi/(2n)
                                        '  (last r=0 before theta=0)
DO UNTIL pixel >= Upper
    CIRCLE (xp, yp), 2, 0               ' erase old (r,theta) indicator.
   
    IF ((pixel - 110) / 50) <> INT((pixel - 110) / 50) THEN
        LINE (160, 130)-(xp - SGN(xp), yp - SGN(yp)), 0
                                        ' erase old radius (excl. theta=nPi).
    END IF
   
    LET oldxp = xp: LET oldyp = yp      ' remember existing polar coord.
    LET pixel = pixel + 1               ' proceed to next theta.
    LET theta = (pixel - 110) * Pi / 100
    LET r = COS(n * theta)              ' update (r,theta).
    LET xp = 160 + 70 * r * COS(theta)  ' update graphics coord. (polar sk.)
    LET yp = 130 - 70 * r * SIN(theta) * 5 / 6 ' (5/6 due to aspect ratio).
    LET yc = 40 - 20 * COS(n * theta) * 5 / 6
    IF r < 0 THEN LET rColour = 6 ELSE LET rColour = 7
    '                      point marker colour brown for r<0, white for r>=0.
    CIRCLE (pixel, yc), 1, rColour           ' draw new circles on sketches.
    CIRCLE (xp, yp), 2, rColour
   
    IF r < 0 THEN LET rColour = 12 ELSE LET rColour = 15
    '               radius and arc colour red for r<0, bright white for r>=0.
   
    LINE (160, 130)-(xp - SGN(xp), yp - SGN(yp)), rColour   ' radius
    LINE (oldxp, oldyp)-(xp, yp), rColour                   ' arc
   
    IF KeyPressed = "N" THEN
        FOR Delay = 1 TO 20000: NEXT Delay
        IF INKEY$ <> "" THEN LET KeyPressed = "Y" ' Allow user to change mind
    ELSE
        CALL WaitForKey(KeyPressed)
    END IF

LOOP

COLOR 15
CALL PressAnyKey
IF n < 6 THEN CLS

END SUB

DEFSNG A-Z
SUB IntroScreen
'============================================================================
'   Preliminary screen of information to the user.
'============================================================================

'   Procedures:
'     PressAnyKey:   prompt the user to press any key, then pause

'   No parameters or local variables.
'                                ASCII code 34 = quotes, 233 = theta
SCREEN 0: WIDTH 80
CLS
PRINT : PRINT
PRINT "       Note:   this QuickBASIC program requires a monitor capable"
PRINT "         of supporting graphics in SCREEN 7 (EGA, VGA or better)."
PRINT : PRINT
PRINT "       This program will sketch the curve whose equation in polar"
PRINT "             form is   r = cos n"; CHR$(233);
PRINT "   starting with  n = 1. "
PRINT "       Each curve will be sketched 1.8 degrees at a time, both in"
PRINT "       a cartesian sketch of  r : "; CHR$(233);
PRINT "  and a polar sketch of  r : "; CHR$(233); " ."
PRINT "       After drawing each new arc, the program will wait for you"
PRINT "                          to press any key."
PRINT
PRINT "       Press "; CHR$(34); "N"; CHR$(34); " or "; CHR$(34); "n";
PRINT CHR$(34); " if you wish to skip to the end of the"
PRINT "                           current sketch."

CALL PressAnyKey

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 (not needed here)
DIM KeyPressed AS STRING

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

END SUB

SUB WaitForKey (KeyPressed AS STRING)
'============================================================================
'    Cause the program to pause until any key is pressed.
'============================================================================

'   No procedures or local variables.

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

DO
   LET KeyPressed = UCASE$(INKEY$)
LOOP UNTIL KeyPressed <> ""

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