Epicycles

[bobalooie]

A few years ago a friend of mine and I were talking about epicycles, which had been used in an attempt to explain planetary motion (yes, we are both nerds.) I had decided to experiment with animating epicycle orbits. The original version of this program was written in FreeBASIC, this is my QB64PE translation of that program as an exercise to learn about the graphics capability of QB64PE. (interestingly, the two BASICs have fairly similar graphics facilities.)



Hopefully the comments in the code provide enough explanation of how I approached the problem.

Code: (Select All)

'Program:       Epicycles.bas
'Purpose:       A QB64PE version of Epicycles
'Version:       0.1
'Create Date:   09/23/2022
'Rev Date:      10/28/2022

OPTION _EXPLICIT
CONST PI2 = 6.2831853

TYPE ScreenPoint
    x AS LONG
    y AS LONG
END TYPE

DIM AS INTEGER ix 'general purpose use
DIM AS STRING sx 'general purpose use
DIM SHARED AS LONG lw, lh 'desktop width and height
DIM AS LONG MinX, MinY, MaxX, MaxY 'Cartesian limits of the images
DIM AS LONG r1, r2, r3 'radii of the epicycle circles
DIM AS LONG rot1, rot2, rot3 'rotation direction
DIM AS LONG step1, step2, step3 'rotation speed
DIM AS ScreenPoint sp1, sp2, sp3 'center points of the epicycle circles
DIM AS DOUBLE Angle1, Angle2, Angle3, AngleStep(1 TO 3)
DIM AS LONG lWin1, lWin2, lWin3 'handles for the three images
' The first image is the visible one. The second image plots each successive
' endpoint of the epicycle to build the pattern. The third image is where the
' epicycles are plotted. Put the second image on the third image, draw the
' epicycle on the third image, put the third image on the first image.

'set up the images and coords
lw = _DESKTOPWIDTH
lh = _DESKTOPHEIGHT
lWin1 = _NEWIMAGE(lw, lh, 32)
lWin2 = _NEWIMAGE(lw, lh, 32)
lWin3 = _NEWIMAGE(lw, lh, 32)
MaxX = lw \ 2: MinX = -MaxX
MaxY = lh \ 2: MinY = -MaxY
r1 = r2 = r3 = 0

_DEST lWin1: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
_DEST lWin2: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
_DEST lWin3: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
SCREEN lWin1: _DEST lWin1: _FULLSCREEN

'Get the user input
CLS
COLOR _RGB(255, 0, 255): PRINT "EPICYCLES DEMONSTRATION"
COLOR _RGB(0, 255, 255)
PRINT "Screen resolution is "; lw; " wide x "; lh; " high."

DO
    LOCATE 3, 1: PRINT "                                        "
    LOCATE 3, 1: COLOR _RGB(0, 255, 255)
    PRINT "Number of epicycles (1 or 2)";: INPUT ix
    IF ix = 1 OR ix = 2 THEN EXIT DO
    COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP

' show how this works
DrawExamples ix

DO
    LOCATE 5, 1: COLOR _RGB(0, 255, 255)
    PRINT "Enter a value for the main circle radius (1 to "; STR$(MaxY * 0.5); " )"
    PRINT "or 0 to quit:"
    INPUT r1
    IF r1 = 0 THEN END
    IF r1 > 0 AND r1 <= MaxY * 0.5 THEN EXIT DO
    LOCATE 7, 1: PRINT "                 " 'clear the input
    COLOR _RGB(255, 0, 0): PRINT "Try again please.";
LOOP

DO
    LOCATE 8, 1: COLOR _RGB(0, 255, 255)
    PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
    INPUT sx
    SELECT CASE sx
        CASE "CW", "cw"
            rot1 = -1
            EXIT DO
        CASE "CCW", "ccw"
            rot1 = 1
            EXIT DO
        CASE ELSE
            LOCATE 9, 1: PRINT "                              "
            COLOR _RGB(255, 0, 0): PRINT "Try again please."
    END SELECT
LOOP

DO
    LOCATE 10, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
    INPUT sx
    SELECT CASE sx
        CASE "1"
            step1 = 1
            EXIT DO
        CASE "2"
            step1 = 2
            EXIT DO
        CASE "3"
            step1 = 3
            EXIT DO
        CASE ELSE
            LOCATE 11, 1: PRINT "             " 'clear the input
            COLOR _RGB(255, 0, 0): PRINT "Try again please."
    END SELECT
LOOP

DO
    LOCATE 12, 1: COLOR _RGB(0, 255, 255): PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.50); ")"
    INPUT r2
    IF r2 > 0 AND r2 <= (MaxY * 0.50) THEN EXIT DO
    LOCATE 13, 1: PRINT "            "
    COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP

DO
    LOCATE 14, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
    INPUT sx
    SELECT CASE sx
        CASE "CW", "cw":
            rot2 = -1
            EXIT DO
        CASE "CCW", "ccw"
            rot2 = 1
            EXIT DO
        CASE ELSE
            LOCATE 15, 1: PRINT "             " 'clear the input
            COLOR _RGB(255, 0, 0): PRINT "Try again please."
    END SELECT
LOOP

DO
    LOCATE 16, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
    INPUT sx
    SELECT CASE sx
        CASE "1"
            step2 = 1
            EXIT DO
        CASE "2"
            step2 = 2
            EXIT DO
        CASE "3"
            step2 = 3
            EXIT DO
        CASE ELSE
            LOCATE 17, 1: PRINT "             " 'clear the input
            COLOR _RGB(255, 0, 0): PRINT "Try again please."
    END SELECT
LOOP

step3 = step1 'set a default value

IF (ix = 2) THEN
    DO
        LOCATE 18, 1: COLOR _RGB(0, 255, 255)
        PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.25); ")"
        INPUT r3
        IF r3 > 0 AND r3 <= (MaxY * 0.25) THEN EXIT DO
        LOCATE 19, 1: PRINT "            "
        COLOR _RGB(255, 0, 0): PRINT "Try again please."
    LOOP

    DO
        LOCATE 20, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
        INPUT sx
        SELECT CASE sx
            CASE "CW", "cw":
                rot3 = -1
                EXIT DO
            CASE "CCW", "ccw"
                rot3 = 1
                EXIT DO
            CASE ELSE
                LOCATE 21, 1: PRINT "             " 'clear the input
                COLOR _RGB(255, 0, 0): PRINT "Try again please."
        END SELECT
    LOOP
    DO
        LOCATE 22, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
        INPUT sx
        SELECT CASE sx
            CASE "1"
                step3 = 1
                EXIT DO
            CASE "2"
                step3 = 2
                EXIT DO
            CASE "3"
                step3 = 3
                EXIT DO
            CASE ELSE
                LOCATE 23, 1: PRINT "             " 'clear the input
                COLOR _RGB(255, 0, 0): PRINT "Try again please."
        END SELECT
    LOOP

END IF

PRINT "Press any key to begin."
SLEEP

'-- now the fun stuff
'Use the horizontal screen size as the step size to orbit the satellite.
'use the vertical screen size to orbit the epicycle
AngleStep(1) = PI2 / lw
AngleStep(2) = PI2 / lh
AngleStep(3) = AngleStep(1) * 3
Angle1 = Angle2 = Angle3 = 0
_LIMIT 100

'Screen lWin2 tracks the epicycle points, make sure it is cleared
_DEST lWin2: CLS
'Draw a couple axes
LINE (MinX, 0)-(MaxX, 0), _RGB(64, 64, 64)
LINE (0, MinY)-(0, MaxY), _RGB(64, 64, 64)
COLOR _RGB(0, 255, 255): LOCATE 1, 1: PRINT "Press any key to exit."


DO
    WHILE INKEY$ <> "": WEND 'clear the key buffer

    Angle1 = Angle1 + AngleStep(step1) * rot1
    IF Angle1 > PI2 THEN Angle1 = 0 'gone around one full revolution
    FindCirclePoint r1, Angle1, sp1
    Angle2 = Angle2 + AngleStep(step2) * rot2
    IF Angle2 > PI2 THEN Angle2 = 0 'gone around one full revolution
    FindCirclePoint r2, Angle2, sp2
    sp2.x = sp2.x + sp1.x: sp2.y = sp2.y + sp1.y
    Angle3 = Angle3 + AngleStep(step3) * rot3
    IF Angle3 > PI2 THEN Angle3 = 0 'gone around one full revolution
    FindCirclePoint r3, Angle3, sp3
    sp3.x = sp3.x + sp2.x: sp3.y = sp3.y + sp2.y

    'track the epicycle
    _DEST lWin2
    PSET (sp3.x, sp3.y), _RGB(0, 0, 255)
    _PUTIMAGE , lWin2, lWin3

    'draw the epicycles
    _DEST lWin3

    'Circles
    CIRCLE (0, 0), 2, _RGB(255, 255, 255)
    CIRCLE (sp1.x, sp1.y), 2, _RGB(255, 255, 255)
    CIRCLE (sp2.x, sp2.y), 2, _RGB(255, 255, 255)
    CIRCLE (sp3.x, sp3.y), 2, _RGB(255, 255, 255)

    'Radius lines
    LINE (0, 0)-(sp1.x, sp1.y), _RGB(255, 0, 255)
    LINE (sp1.x, sp1.y)-(sp2.x, sp2.y), _RGB(255, 255, 0)
    LINE (sp2.x, sp2.y)-(sp3.x, sp3.y), _RGB(0, 255, 0)

    _PUTIMAGE , lWin3, lWin1

LOOP WHILE INKEY$ = ""

' clean up
_FULLSCREEN _OFF
SCREEN 0: _DEST 0
_FREEIMAGE lWin1: _FREEIMAGE lWin2: _FREEIMAGE lWin3

END
'-------------------------- end of program -----------------------------------

SUB DrawExamples (num AS INTEGER)

    DIM AS ScreenPoint sp1, sp2, sp3
    DIM AS INTEGER ix, iy

    '-- draw the example circles
    CIRCLE (0, 0), 2, _RGB(255, 255, 255) 'center of main circle
    CIRCLE (0, 0), lh \ 4, _RGB(255, 0, 0) 'main circle
    ix = (lh \ 4) * COS(PI2 \ 8)
    sp1.x = ix: sp1.y = ix
    CIRCLE (sp1.x, sp1.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
    CIRCLE (sp1.x, sp1.y), lh \ 6, _RGB(255, 0, 0) 'orbiting circle
    sp2.x = sp1.x + lh \ 6
    sp2.y = sp1.y
    CIRCLE (sp2.x, sp2.y), 2, _RGB(255, 255, 255)
    LINE (0, 0)-(sp1.x, sp1.y), _RGB(255, 0, 255) 'main circle radius
    LINE (sp1.x, sp1.y)-(sp2.x, sp2.y), _RGB(255, 255, 0) 'orbiting circle radius

    IF (num = 2) THEN
        ix = (lh \ 10) * COS(PI2 \ 8)
        sp3.x = sp2.x + ix
        sp3.y = sp2.y - ix
        CIRCLE (sp2.x, sp2.y), _HYPOT(sp3.x - sp2.x, sp3.y - sp2.y), _RGB(255, 0, 0) 'orbiting circle
        CIRCLE (sp3.x, sp3.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
        LINE (sp2.x, sp2.y)-(sp3.x, sp3.y), _RGB(255, 255, 0) 'orbiting circle radius
        ix = (sp3.x \ 8): iy = sp3.y \ 8
        COLOR _RGB(255, 255, 255)
    END IF

END SUB
'-----------------------------------------------------------------------------
SUB FindCirclePoint (r AS INTEGER, a AS DOUBLE, st AS ScreenPoint)
    ' calculate the offset X and Y of a point given a radius and angle
    ' Assume the offset is from 0,0. Add the returned offsets to the previous point.
    ' Angle must be in radians

    st.x = INT(r * COS(a)): st.y = INT(r * SIN(a))
END SUB