!!! Starburst in ACTION!

{{{
MODULE 

; Starburst 1.0 By Dan Rhea
   
; Modified from my Micrsoft Basic
; version 7/85

DEFINE YES="1",  ; Define logical flags
       NO ="0"

CARD tc01,       ; Scratch Card 1

     console=[53279], ; Console Keys
     option =[3],     ; OPTION
     select =[5],     ; SELECT
     start  =[6],     ; START
     lmargin=[82],    ; left margin
     cursor =[752],   ; cursor control
     attract=[77]     ; attract mode

INT  ARRAY x(8), ; 8 possible x coordinates
           y(8)  ; 8 possible y coordinates

CARD xaxis       ; X axis for ploting
BYTE yaxis       ; Y axis for ploting

BYTE xmax=[48],  ; Maximum x coordinate
     ymax=[48],  ; Maximum y coordinate
     xtot=[95],  ; Reflected maximum for xmax
     ytot=[95],  ; Reflected maximum for ymax
     bias=[32],  ; X coordinate offset from 0 (centers output)
     lcol=[0],   ; last color selected
     mseg=[50],  ; Maximum segment length (75 with 50 default)
     adjx,       ; X coordinate adjustment
     adjy,       ; Y coordinate adjustment
     dirc,       ; Direction of plot travel (1 to 8)
     colr,       ; Color of segment (1 to 3)
     segl,       ; Length of segment (1 to mseg)
     move,       ; movement counter
     spot,       ; plot counter/pointer
     wrap=[YES], ; Wraparound flag
     glue=[YES], ; Connected segments flag
     tb01,       ; Scratch byte 1
     voic,       ; Voice
     pitc,       ; Pitch
     dist,       ; Distortion
     volu,       ; Volume
     ckey        ; Console key

CHAR ansr        ; Prompt answer

PROC Intro ()
                           
; Introduction to Starburst

   PrintE ("}")
   Graphics (18)

   Position (0,1) 
   PrintDE (6," OoOoOoOoOoOoOoOoO")
   PrintDE (6," o               o")
   PrintDE (6," O StArBuRsT 1.0 O")
   PrintDE (6," o               o")
   PrintDE (6," O  BY DAN rhea  O")
   PrintDE (6," o               o")
   PrintDE (6," OoOoOoOoOoOoOoOoO")
   Position (0,10) 
   PrintDE (6,"   PRESS [start]")

   DO
      FOR tc01=0 TO 3 ; Register select
      DO
         tb01=tc01
         colr=Rand(16) 
         SetColor(tb01,colr,6)
      OD
      ckey=Peek(console)
      IF ckey <> start THEN
         FOR tc01=0 TO 10000 ; Delay
         DO
            ; Tarry a bit
         OD
      FI
   UNTIL ckey = start
   OD

RETURN

PROC Setup ()

; Set up drawing parameters

   Graphics (0)
   SndRst ()
   Poke (lmargin,1)
   PrintE ("-") 
   PrintE ("--------------------------------------")
   PrintE ("|                                    |")
   PrintE ("| Starburst 1.0 By Dan Rhea 07/15/85 |")
   PrintE ("|                                    |")
   PrintE ("--------------------------------------")
   PrintE ("--------------------------------------")
   PrintE ("|This program will produce geometric |")
   PrintE ("|patterns in Graphics Mode 7 using an|")
   PrintE ("|8 way reflection algorithm. You can |")
   PrintE ("|modify the type of patterns that are|")
   PrintE ("|generated by altering the following:|")
   PrintE ("|                                    |")
   PrintE ("| 1. Wraparound (line wrap or not)   |")
   PrintE ("| 2. Connected Lines (does the next  |")
   PrintE ("|    line start where the last one   |")
   PrintE ("|    completed)                      |")
   PrintE ("| 3. Extent (Maximum line length in a|")
   PrintE ("|    random direction)               |")
   PrintE ("--------------------------------------")

   Poke (cursor,1) ; Cursor off

; Determine if wraparound is wanted

   DO
      Position (1,20)
      PrintE ("--------------------------------------")
      PrintE ("|Wraparound Enable? (Y/N) :          |")
      PrintE ("--------------------------------------")
      Position (28,21)
      ansr=GetD(7)      
      IF ansr = 'Y OR ansr = 'y THEN
         wrap = YES 
         tb01 = YES
      ELSEIF ansr = 'N OR ansr = 'n THEN
         wrap = NO
         tb01 = YES
      ELSE
         tb01 = NO
      FI
   UNTIL tb01 = YES
   OD

; Determine if connected lines are wanted

   DO
      Position (1,20)
      PrintE ("--------------------------------------")
      PrintE ("|Connected lines required? (Y/N) :   |")
      PrintE ("--------------------------------------")
      Position (35,21)
      ansr=GetD(7)      
      IF ansr = 'Y OR ansr = 'y THEN
         glue = YES 
         tb01 = YES
      ELSEIF ansr = 'N OR ansr = 'n THEN
         glue = NO
         tb01 = YES
      ELSE
         tb01 = NO
      FI
   UNTIL tb01 = YES
   OD

; Determine maximum line segment extent

   DO
      Position (1,20)
      PrintE ("--------------------------------------")
      PrintE ("|Maximum segment length (1-75) :     |")
      PrintE ("--------------------------------------")
      Position (33,21)
      mseg=InputB()     
      IF mseg < 1 THEN
         tb01 = NO
      ELSEIF mseg > 75 THEN
         tb01 = NO
      ELSE
         tb01 = YES
      FI
   UNTIL tb01 = YES
   OD

; Give the user operating instructions during the draw mode

   Position (1,20)
   PrintE ("--------------------------------------")
   PrintE ("|START:Draw OPTION:Menu SELECT:Freeze|")
   PrintE ("--------------------------------------")
   DO               
      ckey=Peek(console)
   UNTIL ckey = start
   OD            
   DO
      ckey=Peek(console)
   UNTIL ckey <> start
   OD

   Poke (cursor,0) ; Restore cursor

RETURN                         

PROC Getxy ()
 
; Set random X Y starting coordinates

   x(1)=Rand(xmax) ; 0 to xmax-1
   y(1)=Rand(ymax) ; 0 to ymax-1

RETURN

PROC Docld ()

; Set Color, Length and Direction

   dirc=Rand(8)      ; 0 to 7 
   DO
      colr=Rand(4)   ; 0 to 3
   UNTIL colr <> lcol
   OD
   lcol=colr
   segl=Rand(mseg)+1 ; 1 to mseg

RETURN

PROC Clamp ()

; Clamp the line or wrap it around as needed

   IF wrap = YES THEN
      IF x(1) < 0 THEN
         adjx = xmax-1
      ELSEIF x(1) >= xmax THEN
         adjx = 0
      ELSE
         adjx = x(1)
      FI
      x(1) = adjx
      IF y(1) < 0 THEN
         adjy = ymax-1
      ELSEIF y(1) >= ymax THEN
         adjy = 0
      ELSE
         adjy = y(1)
      FI
      y(1) = adjy
   ELSE
      IF x(1) < 0 THEN
         adjx = 0      
      ELSEIF x(1) >= xmax THEN
         adjx = xmax-1
      ELSE
         adjx = x(1)
      FI
      x(1) = adjx
      IF y(1) < 0 THEN
         adjy = 0
      ELSEIF y(1) >= ymax THEN
         adjy = ymax-1
      ELSE
         adjy = y(1)
      FI
      y(1) = adjy
   FI

RETURN

PROC Flect ()

; DO 8 way reflection

   x(2) = xtot-x(1)
   x(3) = x(2)
   x(4) = x(1)
   x(5) = y(1)
   x(6) = xtot-x(5)
   x(7) = x(6)
   x(8) = x(5)
   y(2) = y(1)
   y(3) = ytot-y(1)
   y(4) = y(3)
   y(5) = x(1)
   y(6) = y(5)
   y(7) = ytot-y(6)
   y(8) = y(7)

RETURN 

PROC Paint ()

; Draw the sucker

   FOR spot = 1 TO 8
   DO
      xaxis=x(spot)+bias
      yaxis=y(spot)
      Plot (xaxis,yaxis)
   OD
 
RETURN

PROC Slide ()

; Move the guy in cell 1 in the desired direction

   IF dirc = 0 THEN
      x(1)==+1
   ELSEIF dirc = 1 THEN
      x(1)==+1
      y(1)==+1
   ELSEIF dirc = 2 THEN
      y(1)==+1
   ELSEIF dirc = 3 THEN
      x(1)==-1
      y(1)==+1
   ELSEIF dirc = 4 THEN
      x(1)==-1
   ELSEIF dirc = 5 THEN
      x(1)==-1
      y(1)==-1
   ELSEIF dirc = 6 THEN
      y(1)==-1
   ELSEIF dirc = 7 THEN
      x(1)==+1
      y(1)==-1
   ELSE
      ; Do Nothin Meng'
   FI

RETURN

PROC Noise ()
 
; Use screen data for sound

   BYTE base=[63]

   voic = colr
   pitc = x(1)+(colr*base)
   volu = y(1)/4
   dist = 10

   Sound(voic,pitc,dist,volu)

RETURN

PROC Main ()

   Intro ()

   DO
      Setup ()
      Getxy ()
      Graphics (23)
      DO
         Poke(attract,0)
         Docld ()
         color=colr  
         FOR move = 1 TO segl
         DO
            Clamp () ; Wrap/Nowrap
            Flect () ; Reflect   
            Paint () ; Plot all 8
            Noise () ; Make some
            Slide () ; Move # 1
         OD
         IF glue = NO THEN
            Getxy ()
         FI
         ckey = Peek(console)
         IF ckey = select THEN
            DO 
               ckey = Peek(console)
            UNTIL ckey <> select
            OD
         FI
         IF ckey = start THEN
            DO
               ckey = Peek(console)
            UNTIL ckey <> start
            OD
            Graphics(23)
         FI
      UNTIL ckey = option
      OD
   OD

RETURN

}}}