Anyway, I thought it would be fun to reproduce, and extend to the other planets. It turns out that different numbers of orbits are "sensible" in terms of the plots, so I've added that too.
Prompted somewhat by a discussion in another thread, I thought I'd make it more like a "proper windows program", so I've added menus to facilitate the choice of planets etc, to show how easy it is. Unfortunately, that ties it to BB4W. but if you want to run it in BBC-SDL it's easy to adapt: simply delete the calls to PROCSetUpMenus and the ON SYS command (and their associated routines, if you want), delete the loop, and just put in a call to PROCDrawIt. If I'm feeling keen I'll also post a version with those amendments.
Menus are arguably an odd choice in this case: a dialogue box would probably be better, but a bit more complicated. Again, if I feel keen I'll post a version like that.
Can I interest anyone in making a nice BBC-SDL version with a dialogue box? All the libraries are there...
Best wishes,
D
Code: Select all
REM Planets, A graphical ditty based on relative planetary motions
REM Pick two planets to orbit the sun, and see the pattern drawn by the line between them
DIM year(9),distance(9) :REM Will hold the "year" and distance from the sun for each planet
year()=0,0.241,0.615,1,1.881,11.86,29.46,84.01,164.8,248.1
distance()=0,57.9,108.2,149.6,227.9,778.3,1429.4,2871,4504
MODE 23
ORIGIN 1024,768
COLOUR 8,80,80,80
PRINT TAB(5,10);"Select your planets, and the number of orbits,"
PRINT TAB(5,11);"and then choose 'Make It So!' from the first menu!"
REM Set up default planets and number of years (of planet 2)
p1 = 4
p2 = 5
numyears = 3
REM Set up The menu structure
PROCSetUpMenus
REM "ON SYS" will pick up menu selections, and pass them to a handling routine
REM Note that these are interrupts: they will override whatever else is happening at the time!
ON SYS PROCDoSys(@wparam%):RETURN
done%=FALSE
drawing% = FALSE
redraw_request% = FALSE
REM Now we are going to sit in a "game loop", doing nothing, unless a menu selection causes some action
REM A slight complication is dealing with menu requests to draw when we are already drawing
REM If this happens, the interrupt will occur inside PROCDrawIt.
REM In this case PROCDoSys sets redraw_request%, and the present iteration ends gracefully,
REM and we pick up the request inside the loop (normally PROCDrawIt is called from PROCDoSys).
REPEAT
IF redraw_request% THEN
redraw_request% = FALSE
PROCDrawIt(p1,p2,numyears)
WAIT 1
ENDIF
UNTIL done%
END
:
DEFPROCDrawIt(pl1,pl2,ny)
LOCAL p1x,p2x,p1y,p2y,t,maxt,dt,sf
IF pl1 = pl2 THEN PRINT"That's not going to be fun! Choose two different planets": ENDPROC
drawing% = TRUE
IF pl1 > pl2 THEN SWAP pl1,pl2 : REM always want the more distant planet as pl2
REM Set initial positions - aligned to the right of the sun
p1x = distance(pl1)
p1y = 0
p2x = distance(pl2)
p2y = 0
t = 0
maxt = ny * year(pl2) :REM Set the maximum time to the number of years x the length of the year
dt = maxt / (360 * ny) :REM Set the time interval between draws: basically, at 1 degree intervals
sf = 700/distance(pl2) :REM Scale factor for plotting: make the outer orbit fit within the window
CLS
REM Draw initial positions of sun and the two planets
GCOL 3
CIRCLE FILL 0,0,20 :REM Yellow sun
GCOL 3,1
CIRCLE FILL p1x*sf,p1y*sf,5 :REM Red inner planet
GCOL 3,12
CIRCLE FILL p2x*sf,p2y*sf,10 :REM Blue outer planet
REPEAT
REM OK, now we are going to plot the positions at each time point
REM First we UNplot the planets (note the use of XOR plotting) in their old positions
GCOL 3,1
CIRCLE FILL p1x*sf,p1y*sf,5
GCOL 3,12
CIRCLE FILL p2x*sf,p2y*sf,10
REM Calculate the new positions
p1x = distance(pl1) * COS(2*PI*t/year(pl1))
p1y = distance(pl1) * SIN(2*PI*t/year(pl1))
p2x = distance(pl2) * COS(2*PI*t/year(pl2))
p2y = distance(pl2) * SIN(2*PI*t/year(pl2))
REM draw a grey line between the planets.
GCOL 0,8
LINE p1x*sf,p1y*sf,p2x*sf,p2y*sf
t += dt
REM Now we redraw the sun and planets in their new positions
GCOL 0,3
CIRCLE FILL 0,0,20
GCOL 3,1
CIRCLE FILL p1x*sf,p1y*sf,5
GCOL 3,12
CIRCLE FILL p2x*sf,p2y*sf,10
WAIT 5 :REM Slow things down. Arguably naughty when interrupts are in use, but it's a short wait! ;-)
UNTIL t>maxt OR redraw_request% :REM If a redraw request has been made, terminate this one, so a new one can start
drawing% = FALSE
ENDPROC
:
DEFPROCDoSys(w%)
REM Here we handle menu choices: w% is the value passed back from the menu
REM(Defined in the statements where we set up the menu entries, below)
CASE w% OF
WHEN 1,2,3,4,5,6,7,8,9:
REM Set first planet: untick the present one, set value, and tick it
SYS "CheckMenuItem", hpop1%, p1, 0
p1 = w%
SYS "CheckMenuItem", hpop1%, w%, 8
WHEN 11,12,13,14,15,16,17,18,19:
REM Set second planet: untick the present one, set value, and tick it
SYS "CheckMenuItem", hpop2%, 10 + p2, 0
p2 = w% - 10
SYS "CheckMenuItem", hpop2%, w%, 8
WHEN 21,22,23,24,25:
REM Set number of orbits of planet 2: untick the present one, set value, and tick it
SYS "CheckMenuItem", hpop3%, 20 + numyears, 0
numyears = w% -20
SYS "CheckMenuItem", hpop3%, w%, 8
WHEN 31:
REM Let's go! Assuming we aren't already drawing. If we are, request restart
REM This gives us a way of terminating the previous procedure call cleanly
IF NOT drawing% THEN PROCDrawIt(p1,p2,numyears) ELSE redraw_request% = TRUE
WHEN 32: QUIT
ENDCASE
ENDPROC
:
DEFPROCSetUpMenus
REM Set up submenus first... Pretty much stolen from the manual, and extended!
SYS "CreatePopupMenu" TO hpop0%
SYS "AppendMenu", hpop0%, 0, 31, "Make It So!"
SYS "AppendMenu", hpop0%, 0, 32, "Quit"
:
SYS "CreatePopupMenu" TO hpop1%
SYS "AppendMenu", hpop1%, 0, 1, "Mercury"
SYS "AppendMenu", hpop1%, 0, 2, "Venus"
SYS "AppendMenu", hpop1%, 0, 3, "Earth"
SYS "AppendMenu", hpop1%, 0, 4, "Mars"
SYS "AppendMenu", hpop1%, 0, 5, "Jupiter"
SYS "AppendMenu", hpop1%, 0, 6, "Saturn"
SYS "AppendMenu", hpop1%, 0, 7, "Uranus"
SYS "AppendMenu", hpop1%, 0, 8, "Neptune"
SYS "AppendMenu", hpop1%, 0, 9, "Pluto"
:
SYS "CreatePopupMenu" TO hpop2%
SYS "AppendMenu", hpop2%, 0, 11, "Mercury"
SYS "AppendMenu", hpop2%, 0, 12, "Venus"
SYS "AppendMenu", hpop2%, 0, 13, "Earth"
SYS "AppendMenu", hpop2%, 0, 14, "Mars"
SYS "AppendMenu", hpop2%, 0, 15, "Jupiter"
SYS "AppendMenu", hpop2%, 0, 16, "Saturn"
SYS "AppendMenu", hpop2%, 0, 17, "Uranus"
SYS "AppendMenu", hpop2%, 0, 18, "Neptune"
SYS "AppendMenu", hpop2%, 0, 19, "Pluto"
:
SYS "CreatePopupMenu" TO hpop3%
SYS "AppendMenu", hpop3%, 0, 21, "1"
SYS "AppendMenu", hpop3%, 0, 22, "2"
SYS "AppendMenu", hpop3%, 0, 23, "3"
SYS "AppendMenu", hpop3%, 0, 24, "4"
SYS "AppendMenu", hpop3%, 0, 25, "5"
:
REM Now we make the main menu bar and add the submenus
SYS "CreateMenu" TO hmenu%
SYS "AppendMenu", hmenu%, 16, hpop0%, "&Go and Stop"
SYS "AppendMenu", hmenu%, 16, hpop1%, "&First Planet"
SYS "AppendMenu", hmenu%, 16, hpop2%, "&Second Planet"
SYS "AppendMenu", hmenu%, 16, hpop3%, "&Orbits"
SYS "SetMenu", @hwnd%, hmenu%
SYS "DrawMenuBar", @hwnd%
:
REM Set ticks next to the default menu options
SYS "CheckMenuItem", hpop1%, p1, 8
SYS "CheckMenuItem", hpop2%, 10 + p2, 8
SYS "CheckMenuItem", hpop3%, 20 + numyears, 8
ENDPROC