\ -----------------------------------------------
\ ORBITS.4TH
\ Robert L. Pyron, 7-Oct-87
\ 53 Ashford St. #3
\ Allston, MA 02142
\
\ Written in Multi-Forth, version 1.21
\
\ Copyright (C) 1987 by Robert L. Pyron
\ This program may be freely distributed for
\ non-commercial purposes.
\ -----------------------------------------------
\ We are plotting a difference equation:
\
\     x := x - (y/a)
\     y := y + (x/b)
\
\ This should give us nested ellipses with tilted axes.
\ However, we are deliberately causing the calculations
\ to overflow, which makes the screen output more interesting.
\
\ "WritePixel" (graphics 54) really slows us down; this program
\ runs at about the same speed on an Apple IIe in double-hires
\ (the Apple version is in assembly language, with table-driven
\ screen calculations).  One of these days I will try to figure
\ out how to access the bitmaps directly.
\
\ References:
\  "Serendipitous Circles" by D. J. Anderson and W. F. Galway,
\        BYTE, August 1977, page 70
\  "Serendipitous Circles Explored" by Eduardo Kellerman,
\        BYTE, April 1978, page 178
\  "How Many Ways Can You Draw a Circle?" by James F. Blinn,
\        DDJ Software Tools, September 1987, page 18
\ -----------------------------------------------


anew demomarker   \ forget back to here on reload

\ -----------------------------------------------
\ We'll use a few variables ...
\ -----------------------------------------------
global KeyFlag
global MouseFlag
global CurrentRport
global CurrentVP

\ -----------------------------------------------
\ Linear congruential random number generator.
\ These numbers were arbitrarily chosen.
\ They seem to work ok for this program, but
\ I would recommend thorough testing before using
\ them in a production system.  See Knuth, vol. 2
\ -----------------------------------------------
variable seed

\ Return a "random" 32-bit number.
: rnd  ( -- n )  seed @ 231773 * 171487 + dup seed ! ;

\ Set seed to unpredictable value
: randomize ( -- )  CurrentTime xor seed ! ;

\ Return signed 16-bit value between 0 and |n|-1, with same sign as n
: random ( n -- n' )  rnd 65535 and * -16 scale ;


\ -----------------------------------------------
\ A few useful routines
\ -----------------------------------------------

\ truncate signed 32-bit value to signed 16-bit value
\ (there must be a better way to do this)
: trunc ( n -- w) 16 scale -16 scale ;

\ pack 4 numbers (0..15) into rgb value
: rgb  ( a b c -- 0abc )
   swap rot 16* or 16* or ;

\ -----------------------------------------------
\ color table, with supporting routines
\ -----------------------------------------------
hex
create ColorTable
   00 00 00 rgb w,
   0f 0f 0f rgb w,
   00 08 0f rgb w,
   08 00 0f rgb w,
   00 0f 08 rgb w,
   08 0f 00 rgb w,
   0f 00 08 rgb w,
   0f 08 00 rgb w,
decimal

: RandomizeColors ( -- )   \ randomize values in ColorTable
   8 1 do                  \ leave color 0 alone
      4096 random
      ColorTable i 2* + w!
   loop ;

: NewColors ( -- )         \ randomize screen colors
   RandomizeColors
   CurrentVP WaitBOVP
   CurrentVP ColorTable 8 LoadRGB4 ;


\ -----------------------------------------------
\ define custom screen and window
\ -----------------------------------------------

 struct NewScreen  demoscrn
      demoscrn  InitScreen       \ copy default values to new screen
      320 demoscrn +nsWidth w!
      200 demoscrn +nsHeight w!
      3   demoscrn +nsDepth  w!   \ # bitplanes
      0   demoscrn +nsViewModes w!
      CUSTOMSCREEN  demoscrn +nsType  w!
 structend
 
 struct NewWindow  demowindow     \ define a window
      demowindow  InitWindow      \ copy default values to new window
        0 demowindow +nwLeftEdge w!
        0 demowindow +nwTopEdge  w!
      320 demowindow +nwWidth    w!
      200 demowindow +nwHeight   w!
      WINDOWCLOSE  ACTIVATE | GIMMEZEROZERO | RMBTRAP |
                    demowindow +nwFlags !
      fCLOSEWINDOW VANILLAKEY | MOUSEBUTTONS |
                    demowindow +nwIDCMPFlags  !
      CUSTOMSCREEN  demowindow +nwType w!  \  open on a custom screen
 structend


\ -----------------------------------------------
\ Handle mouse and key events
\ -----------------------------------------------

\ Do something if we detect mouse button
: ProcessMouse ( mousecode -- )
   case
      SELECTDOWN     \ left mouse button: set flag for new display
          of  TRUE to MouseFlag  endof
      MENUDOWN       \ right mouse button: randomize screen colors
          of  NewColors  FALSE to MouseFlag  endof
   endcase ;

: CleanupDemo ( -- ) \ perform whatever cleanup is necessary before leaving
   CurrentWindow @ CloseWindow
   CurrentScreen @ CloseScreen ;

: GoodBye ( -- )     \ return to WorkBench or to Multi-Forth
   ?turnkey if bye else abort then ;

: EndDemo ( -- )     \ action for when demo complete
   CleanupDemo GoodBye ;

: DemoEvents ( -- )  \ check for IDCMP event; take appropriate action
   GetEvent
   case
      fCLOSEWINDOW
         of  EndDemo  endof
      VANILLAKEY
         of  ThisEvent +eCode w@  to KeyFlag  endof
      MOUSEBUTTONS
         of  ThisEvent +eCode w@  ProcessMouse  endof
   endcase  ;
 

\ -----------------------------------------------
\ Translate weird numbers into window coordinates, and plot.
\ -----------------------------------------------
: plot  ( x y -- )
   swap  320 *  -16 scale  160 +    \ calc X coord
   swap  200 *  -16 scale  100 +    \ calc Y coord
   CurrentRport !a1 !d1 !d0 graphics 54 ;

\ -----------------------------------------------
\ We are plotting a difference equation:
\
\     x := x - (y/a)
\     y := y + (x/a)
\
\ This should give us nested ellipses with tilted axes.
\ However, we are deliberately causing the calculations
\ to overflow, which makes the screen output more
\ interesting.
\ -----------------------------------------------
: wow
   randomize
   begin
      0 to KeyFlag  0 to MouseFlag  NewColors
      99 random 1+                 \ generate random values, 1..99
         rnd 0< if negate then     \ 
      99 random 1+                 \
         rnd 0< if negate then     \
      locals| bb aa |
      clr.window
      256 0 do
\        NewColors
         CurrentRport  8 random   setapen
         rnd trunc  rnd trunc
         256 0 do
            DemoEvents
            swap over aa 100 */ - trunc
            swap over bb 100 */ + trunc
            2dup plot
            KeyFlag MouseFlag or if leave then
         loop  2drop
         KeyFlag MouseFlag or if leave then
      loop
      KeyFlag 27 =   \ look for ESCAPE (is there an equate?)
   until ;

\ -----------------------------------------------
\ main entry point for turnkey system
\ -----------------------------------------------

: orbits  ( -- )
   0" Multi-Forth version 1.21 "  demoscrn +nsDefaultTitle !
   0" Orbits "  demowindow +nwTitle  !
   demoscrn OpenScreen  verifyscreen         \ open a 4 bit plane screen
   CurrentScreen @  demowindow +nwScreen  !  \ store screen ptr in window
   demowindow OpenWindow  verifywindow       \ open demo window
   CurrentWindow @ ViewPortAddress  to CurrentVP
   Rport  to CurrentRport
   ?turnkey if  on.error EndDemo resume  then
   wow EndDemo ;

\ -----------------------------------------------
\ instructive messages, in the style of the demos
\ distributed with the Multi-Forth system
\ -----------------------------------------------

cr ." ready for demo or turnkey. "
cr ." enter:   orbits "
cr
cr ." turnkey with:   turnkey" 34 emit ."  orbits" 34 emit  ."   orbits"