'Light
'by ronald s. hill
'
'np = number of players
'pn = player number
'mp = maximum players
'ms = maximum score
'i  = input
'x  = temporary variables
'px = termpory x position
'py = temporary y position
'md() = move direction values
'wx = size window x
'wy = size window y
'sc = maximum score
'nt = newly terminated?
'sa = snakes active -1 is yes
'mo = menu on ?
'so = snake menu on ?
'fr = starting frequency

'pc() = players color
'pd() = players device
'ph() = players heading
'pn$() = players name
'px() = players x position
'py() = players y position
'ps() = players score
'ok() = player alive? -1 is yes
'pt() = player terminated 0 alive -1 dead -2 out of round 1 out of game
'sx(pn,sp) = snake x position
'sy(pn,sp) = snake y position
'ss() = snake size
'sf() = snake full 0 is false
'sp() = snake position
'sa() = snake active 0 not snake

setup:

SCREEN 1,320,200,4,1
 WINDOW CLOSE 1
WINDOW 2,"Light......",(8,12)-(288,184),1+2+16,1
PALETTE 0,0,0,0
PALETTE 1,1,1,1
PALETTE 2,1,0,0
PALETTE 3,1,0,0
PALETTE 4,0,1,0
PALETTE 5,0,0,1
COLOR 1,0
CLS
PRINT "Light"
PRINT "Version 1.0"
PRINT "by Ronald S. Hill"
PRINT
PRINT "Use Menus to Change options"
'PRINT "Ctrl-C to return to basic"


menup:
MENU 1,0,1,"Control"
MENU 1,1,1,"Restart"
MENU 1,2,1,"Load another program"
MENU 1,3,1,"Exit to Basic"
MENU 1,4,1,"Exit to Workbench"

MENU 2,0,1,"Option"
MENU 2,1,1,"Score"
MENU 2,2,1,"  Snakes"
MENU 2,3,1,"> Bounce"
MENU 2,4,1,"Info"

FOR pn=1 TO 4
MENU 2+pn,0,1,RIGHT$(STR$(pn),1)
MENU 2+pn,1,1,"Device"

MENU 2+pn,2,1,"Score"
MENU 2+pn,3,1,"  Snake"
NEXT pn

ON MENU GOSUB menus

ON BREAK GOSUB abort 'done
MENU ON
BREAK ON

CLEAR
DEFINT A-Z
OPTION BASE 1
mp=4
DIM dp(4),pd(4),ph(mp),pn$(mp),px(mp),py(mp),pt(mp),pc(mp),ps(mp)
DIM dn$(7),mx(4),my(4)
DIM sx(4,100),sy(4,100)
DIM ss(4),sf(4),sp(4),sa(4)
pc(1)=3
pc(2)=4
pc(3)=5
pc(4)=6
'dn$(1)="Joystick 1"
dn$(2)="Joystick 2"
dn$(3)="Cursor"
'dn$(4)="Mouse"
dn$(4)="Random"
'dn$(6)="Computer - Easy"
'dn$(7)="Computer - Harder"
mx(1)=0:my(1)=-1
mx(2)=1:my(2)=0
mx(3)=0:my(3)=1
mx(4)=-1:my(4)=0
bo = -1
RANDOMIZE TIMER

GOSUB waits

questions:
GOSUB smenuon
pn=0
np=0
ok=-1

WHILE (ok)
  pn=pn+1
  GOSUB device
  IF (pn=mp OR I$=" ") AND pn<> 1 THEN ok=0
WEND
sc=10
IF pn<4  THEN np=pn-1 ELSE np=4
IF pn=4 AND I$=" " THEN np=3


restart:
GOSUB smenuon
FOR pn = 1 TO np
  ps(pn)=0
NEXT pn
fm=-1
WHILE(ps(1)<sc AND ps(2)<sc AND ps(3)<sc AND ps(4)<sc)
CLS
PALETTE 0,0,0,0
PALETTE 1,1,1,1
PALETTE 2,1,0,0
PALETTE 3,1,0,0
PALETTE 4,0,1,0
PALETTE 5,0,0,1
PALETTE 6,1,1,1
COLOR 1,0
CLS

wx=WINDOW(2)
wy=WINDOW(3)

px(1)=INT(wx/3)
py(1)=INT(wy/2)
px(2)=INT(wx*.6666)
py(2)=INT(wy/2)
px(3)=INT(wx/2)
py(3)=INT(wy/3)
px(4)=INT(wx/2)
py(4)=INT(wy*.6666)

IF fm=-1 THEN
  fm=0
  ox=1
  oy=1
  py = py(1)
  FOR px=1 TO px(1)
    PSET(px,py),pc(1)
    PSET(ox,oy),0
    ox=px
    oy=py
  NEXT px
  IF np>1 THEN
    ox=1
    oy=1
    py=py(2)
    FOR px=wx TO px(2) STEP -1
      PSET(px,py),pc(2)
      PSET(ox,oy),0
      ox=px
      oy=py
    NEXT px
  END IF
  IF np>2 THEN
    ox=1
    oy=1
    px=px(3)
    FOR py=1 TO py(3)
      PSET(px,py),pc(3)
      PSET(ox,oy),0
      ox=px
      oy=py
    NEXT py
  END IF
  IF np>3 THEN
    ox=1
    oy=1
    px=px(4)
    FOR py=wy TO py(4) STEP -1
      PSET(px,py),pc(4)
      PSET(ox,oy),0
      ox=px
      oy=py
    NEXT py
  END IF
END IF

FOR pn=1 TO np
  IF pt<> -3 THEN pt(pn)=0
  ph(pn)=1
  PSET(px(pn),py(pn)),pc(pn)
NEXT pn
GOSUB waits
GOSUB smenuoff
sf=0
FOR pn=1 TO np
  sf(pn)=0
  sp(pn)=1
NEXT pn
pt=0
nt=0
main:
WHILE (pt<np-1)
  IF sa THEN GOSUB dosnakes
  FOR pn=1 TO np
    IF pt(pn)=0 THEN
    ph=ph(pn)
    ON pd(pn) GOSUB joy1,joy2,cur,ran,ran,ran,ran
    IF ABS(ph(pn)-ph)<>2 THEN ph(pn)=ph
    px(pn)=px(pn)+mx(ph(pn))
    py(pn)=py(pn)+my(ph(pn))
    IF POINT(px(pn),py(pn))<>0 THEN
      IF POINT(px(pn),py(pn))=-1 AND bo=-1 THEN
        GOSUB dobounce
      END IF
      IF POINT(px(pn),py(pn))<>0 THEN
        pt(pn)=-1
        pt=pt+1
        ot(pt)=pn
        nt=nt+1
      END IF
    END IF

    PSET(px(pn),py(pn)),pc(pn)
    END IF
  NEXT pn
  IF nt THEN GOSUB die:nt=0
WEND


roundend:
GOSUB smenuon
FOR pn = 1 TO np
  IF pt(pn)= 0 THEN ps(pn)=ps(pn)+1
NEXT pn

FOR pn=1 TO np
  PRINT pn;" "pn$(pn);TAB(15);ps(pn);
  IF ps(pn)=sc THEN PRINT " WINS";:ov=-1
  PRINT
NEXT pn
GOSUB waits

fadeout:

IF ov = 0 THEN
GOSUB fade1
GOSUB fade2
GOSUB fade3
GOSUB fade4

END IF

WEND

PRINT
PRINT "Press R to Restart"
PRINT "      N for Newplayers"

getit:
GOSUB in:
IF I$="R" THEN GOTO restart
IF I$="N" THEN GOTO questions
GOTO getit

done:

GOSUB clean
PRINT
END

dosnakes:
FOR pn = 1 TO np
  IF sa(pn) AND pt(pn)=0 THEN
    IF sp(pn)=ss(pn) THEN
      sp(pn)=1
      sf(pn)=-1
    END IF
    IF sf(pn) THEN
       PSET(sx(pn,sp(pn)),sy(pn,sp(pn))),0
    END IF
    sx(pn,sp(pn))=px(pn)
    sy(pn,sp(pn))=py(pn)
    sp(pn)=sp(pn)+1
  END IF
NEXT pn
RETURN

joy1:
x=STICK(0)
IF x<>0 THEN IF x=-1 THEN ph=4 ELSE ph=2
x=STICK(1)
IF x<>0 THEN IF x=-1 THEN ph=1 ELSE ph=3
RETURN

joy2:
x=STICK(2)
IF x<>0 THEN IF x=-1 THEN ph=4 ELSE ph=2
x=STICK(3)
IF x<>0 THEN IF x=-1 THEN ph=1 ELSE ph=3
RETURN

cur:
I$=INKEY$
I=0
IF I$<>""THEN I=ASC(I$)
IF I = 28 THEN ph=1:RETURN
IF I = 30 THEN ph=2:RETURN
IF I = 29 THEN ph=3:RETURN
IF I = 31 THEN ph=4:RETURN
RETURN

ran:
IF INT(RND*15)=1 THEN ph=INT(RND*3)+1
IF POINT(px(pn)+mx(ph),py(pn)+my(ph))<>0 THEN
  xx=ph
  ph=0
loops:  ph = ph +1
   IF ph=xx THEN GOTO loops
   IF ph>4 THEN ph=ph(pn): GOTO loopend
   IF POINT(px(pn)+mx(ph),py(pn)+my(ph))<>0 THEN GOTO loops
loopend:
END IF
RETURN

die:

FOR tt = 1 TO 10
  FOR cc = 1 TO 3
  SOUND WAIT
  SOUND 3000+cc*100,.3,127,0
  SOUND 3000+cc*100,.3,127,1
  SOUND RESUME
  IF pt(1)=-1 THEN PALETTE pc(1),1-1/cc ,0,0
  IF np>1 AND pt(2)=-1 THEN PALETTE pc(2),0,1-1/cc,0
  IF np>2 AND pt(3)=-1 THEN PALETTE pc(3),0,0,1-1/cc
  IF np>3 AND pt(4)=-1 THEN PALETTE pc(4),1-1/cc,1-1/cc,1-1/cc
   FOR xx = 1 TO 20:NEXT xx
  NEXT cc
NEXT tt

FOR pn=1 TO np
  IF pt(pn)=-1 THEN pt(pn)=-2
NEXT pn

RETURN

dobounce:
px(pn)=px(pn)-mx(ph(pn))
py(pn)=py(pn)-my(ph(pn))
oh=ph
ph=0
wloops:  ph = ph +1
IF ph=oh THEN GOTO wloops
IF ph>4 THEN ph(pn)=oh: GOTO wloopend
IF POINT(px(pn)+mx(ph),py(pn)+my(ph))<>0 THEN GOTO wloops
ph(pn)=ph
wloopend: px(pn)=px(pn)+mx(ph(pn))
py(pn)=py(pn)+my(ph(pn))
BEEP
RETURN

fade1:
IF pt(1)<>-3 THEN
FOR cc!=1 TO 0 STEP -.01
  PALETTE pc(1),cc!,0,0
NEXT cc!
END IF
RETURN

fade2:
IF pt(2)<>-3 THEN
FOR cc!=1 TO 0 STEP -.01
  PALETTE pc(2),0,cc!,0
NEXT cc!
END IF
RETURN

fade3:
IF pt(3)<>-3 THEN
FOR cc!=1 TO 0 STEP -.01
  PALETTE pc(3),0,0,cc!
NEXT cc!
END IF
RETURN

fade4:
IF pt(4)<>-3 THEN
FOR cc!=1 TO 0 STEP -.01
  PALETTE pc(4),cc!,cc!,cc!
NEXT cc!
END IF
RETURN

in:
I$= UCASE$(INKEY$)
IF I$ = "" THEN GOTO in
RETURN

waits:
 FOR tt=1 TO 10000:NEXT tt
RETURN

clean:
WINDOW 1
SCREEN CLOSE 1
MENU RESET
'x=MOUSE(1)
RETURN

menus:
m0=MENU(0)
m1=MENU(1)
ON m0 GOSUB con,opt,pla,pla,pla,pla
RETURN

con:
IF m1=1 THEN GOSUB clean:RUN
GOSUB clean
IF m1=2 THEN LOAD:END
IF m1=3 THEN END
IF m1=4 THEN SYSTEM
RETURN

opt:

IF m1=1 THEN GOSUB scores
IF m1=2 THEN GOSUB snakes
IF m1=3 THEN GOSUB bounce
IF m1=4 THEN GOSUB info
RETURN

scores:
GOSUB open3
CLS
COLOR 1,0
PRINT
INPUT "Maximum Score:",sc
CLS
GOSUB close3
RETURN

snakes:
IF so = 0 THEN BEEP:RETURN
IF sa THEN
  sa=0
  ss=0
  MENU 2,2,1,"  Snakes"
  FOR mt = 1 TO 4
    sa(mt)=0
    ss(mt)=0
    MENU 2+pn,3,1,"  Snake"
  NEXT mt
ELSE
  GOSUB open3
  CLS
  COLOR 1,0
  PRINT
  PRINT "This option sets or"
  PRINT "clears ALL players"
  PRINT "as snakes."
  PRINT
  PRINT "Default is 200"
  INPUT "Length of Snakes:",ss
  IF ss=0 THEN ss=200
  sa=-1
  MENU 2,2,1,"> Snakes"
  FOR mt = 1 TO 4
    ss(mt)=ss
    sa(mt)=-1
    MENU 2+mt,3,1,"> Snake"
  NEXT mt
  GOSUB close3
  ERASE sx,sy
  DIM sx(4,ss),sy(4,ss)
END IF
RETURN

info:
GOSUB open3
COLOR 1,0
PRINT "Light 1.0"
PRINT "By Ronald S. Hill"
PRINT

PRINT "If you like this"
PRINT "program please send"
PRINT "$00.00 and a nice"
PRINT "message to Compuserve"
PRINT "72777,2110. Thanks"
GOSUB in
GOSUB close3
RETURN

bounce:
IF bo=-1 THEN
  bo=0
  MENU 2,3,1,"  Bounce"
ELSE
  bo = -1
  MENU 2,3,1,"> Bounce"
END IF
RETURN

pla:
IF m1=1 THEN GOSUB dev
IF m1=2 THEN GOSUB score
IF m1=3 THEN GOSUB snake
RETURN

dev:
mt=pn
pn=m0-2
GOSUB open3
GOSUB device
GOSUB close3
pn=mt
RETURN

device:

COLOR pc(pn),0
CLS
PRINT "Player ";pn
PRINT
FOR x=1 TO 7
IF dn$(x)<>"" THEN PRINT x;" - ";dn$(x)
NEXT x
IF pn<>1 OR np<>0 THEN PRINT "<space>- Continue"
PRINT
PRINT "Choose Your Weapon:"
ins: GOSUB in
I = VAL(I$)
IF I$<>" " THEN pd(pn)=I
IF (I=0 AND I$<>" ") OR I>8 THEN GOTO ins
IF I>0 AND I<4 THEN
  PRINT "Enter Name"
  LINE INPUT ":";pn$(pn)
END IF

IF pn$(pn)="" AND I>0 AND I<8 THEN pn$(pn)=dn$(pd(pn))
RETURN


score:
mt=m0-2
GOSUB open3
COLOR pc(mt),0
CLS
PRINT
PRINT "Player"mt
PRINT "Current score is"sc(mt)
INPUT "New score:",ts
IF ts<>0 THEN ps(mt)=ts
GOSUB close3
RETURN


snake:
IF so=0 THEN BEEP: RETURN
mt=m0-2
IF sa(mt) THEN
  sa(mt)=0
  ss(mt)=0
  IF sa(1)+sa(2)+sa(3)+sa(4)=0 THEN
    sa=0
    MENU 2,2,1,"  Snakes"
  END IF
  MENU 2+mt,3,1,"  Snake"
ELSE
  GOSUB open3
  COLOR 1,0
  CLS
  sa(mt)=-1
  PRINT
  PRINT "This option sets or"
  PRINT "clears one player"
  PRINT "as a snake."
  PRINT
  PRINT "Player"mt
  PRINT "Default is 200"
  INPUT "size of snake:",ss(mt)
  IF ss(mt)=0 THEN ss(mt)=200
  IF ss(mt)>ss THEN
    ss=ss(mt)
    ERASE sx,sy
    DIM sx(4,ss),sy(4,ss)
  END IF
  IF sa=0 THEN
    sa=-1
    MENU 2,2,1,"> Snakes"
  END IF
  MENU 2+mt,3,1,"> Snake"
  GOSUB close3
END IF
RETURN

open3:
'MENU OFF
WINDOW 3,,(40,30)-(250,130),1+2 ,1
RETURN

close3:
'MENU ON
WINDOW CLOSE 3
RETURN

smenuon:
so=-1
RETURN

smenuoff:
so=0
RETURN

abort:
RETURN