Amiga Tools 5/Amiga Tools 5.iso/tools/developer-tools/amos-tools/peg_it/peg-it_src.amos/peg-it_src.amosSourceCode

AMOS Source Code | 1996-05-03 | 29.3 KB | 1,032 lines

'              -----------------------------------------
'              |        Peg-It By Paul Burkey          |
'              |           Started 1-1-94              |
'              |         Demo compiled 3-5-96          |
'              |       (C) 1994 Daisy Software         |
'              -----------------------------------------
'
' This is a cut down version of the source for the Peg-It Demo!
' It is cut down and some anotation is made to make it easier to
' understand.
'
' To make the compiled game as small as possible some of the source
' code was made as tight as can be! meaning the use of goto's and
' anything else that will make the code shorter. For example The last
' Procedure Task[z]. This was used because it saved about 1k by reducing
' the need for so many for : next loops. Don't let this confuse you there
' are a few places where the code is made as silly as can be! just because
' it compiles shorter!
'
' email me at:- [e-mail]
'
' The full version can be ordered from me for the price of �3 or the
' nearest price in your currency. Add an extra �1 for countries outside
' europe........
'
' Paul Burkey
' 32 Cottage Close
' Little Neston
' South Wirral
' L64 9RB
'
' The full version has 150 levels as well as a few other extras :)
'
'
Dim GRID(8,8),TBOB(8,8),_BOB(8,8),DREC(70),SPRINGS(4,2)
'
Global GRID(),TBOB(),_BOB(),DREC(),SPRINGS(),LEVEL,TXM,TYM,XX,TITLE,BLEEP
Global ESC,TIME,LASTTIME,JUMPS,LASTJUMPS,LASTIN,IN,OK,PASS,LEVEL$,CODE$,B
Global CHAN,SPRINGS,LANDX,LANDY,KEEPX,KEEPY,LASTLEVEL,SX,SY,_ENDIT,MES,C,AC
'
SETUP
Unpack 12 To 1 : Screen Hide 1 : CHAN=1 : Hide On
'
Do
   LA:
   '  I wonder what this next line does???
   LEVEL=1
   MAINSCREEN
   Do
      If LEVEL>50 Then End
      If _ENDIT Then PASS=0 : Exit
      LEVEL
      MAIN
   Loop
Loop
'
'                                Setup-procs
Procedure SETUP
   '
   ' All the graphics are loaded and unpacked but in this version they are
   ' already in memory!!!
   '
   XX=71 : Rem  this is where the normal sprite bank ends and the font starts NEXT!
   '
End Proc
Procedure _TEX[X,Y,T$]
   '
   ' I always have my own TEXT command to allow me to use Sprites instead
   ' of using fonts. Notice theres no fonts in the whole game. Just Sprites
   '
   '
   If PASS=2002 Then PASS=2 : Pop Proc : Rem not sure what this was for?
   BBOB=0 : AC=0
   For A=1 To Len(T$)
      C=Asc(Mid$(T$,A,1))
      If C=32
         Add AC,6
      Else
         MOV[1]
         Add C,XX-54
         Paste Bob X+AC,Y-12,C
         MOV[0]
      End If
   Next A
End Proc
Procedure MES[T$]
   AC=0 : Rem same sort of thing as tex
   For A=1 To Len(T$)
      C=Asc(Mid$(T$,A,1))
      If C=32
         Add AC,6
      Else
         MOV[2]
      End If
   Next A
   MES=160-AC/2
End Proc
Procedure MOV[XXX]
   ' this moves the next pos for the next letter
   If XXX Then If C>47 and C<58 Then Add C,7 Else If C=46 Then C=65 Else If C=63 Then C=93 Else If C=33 Then C=66 Else Add C,-30
   If XXX<>1 Then Add AC,9
End Proc
Procedure PAUSE[PAUSE]
   Timer=0
   Repeat
      Exit If Timer>PAUSE
   Until Mouse Key
   If Timer<PAUSE or Mouse Key Then PASS=2002
End Proc
Procedure LEVEL
   ' this loads in the figures for the level Time, Jumps and map data!
   Dec LEVEL
   TASK[2]
   TIME=Peek(Start(10)+LEVEL*100+59)
   JUMPS=Peek(Start(10)+LEVEL*100+69)
   '
   LEVEL$=""
   For A=0 To 9
      B=Peek(Start(10)+LEVEL*100+A+90)
      If B=0 Then B$=" " Else B$=Chr$(B)
      LEVEL$=LEVEL$+B$
   Next A
   Repeat
      If Right$(LEVEL$,1)=" " Then LEVEL$=Left$(LEVEL$,Len(LEVEL$)-1)
   Until Right$(LEVEL$,1)<>" "
   Inc LEVEL
   LEVELCODE[LEVEL] : Rem get the code for it just in case its needed!
   '
   '
End Proc
'                                Main-proc
Procedure MAIN
   Unpack 12 To 0 : Screen Hide 0 : Fade 1 : Wait 17 : Double Buffer
   Limit Mouse 240,69 To 368,197
   '
   TASK[1]
   '
   LASTIN=-1 : LASTTIME=-1 : LASTJUMPS=-1
   IN=0 : KEEPX=-1 : KEEPY=-1
   '
   SHO_FIGURES
   Paste Bob 13,47,39
   _TEX[8,21,"level"+Str$(LEVEL)]
   _TEX[8,42,LEVEL$]
   Sprite Off
   '                      Quick start
   '
   If LASTLEVEL=LEVEL Then SHO : PLACE : Sprite 9,SX*16+240,SY*16+69,37
   '
   LASTTIME=-1 : SHO_FIGURES
   '
   Screen Show 0 : Shift Down 2,27,29,1
   Fade 8 To 1
   For A=46 To 2 Step -4 : Volume CHAN,A : Sam Play CHAN,5,5000 : CHAN : Wait 6 : Next A
   Wait 5 : Volume %1111,63
   '
   If LASTLEVEL<>LEVEL Then SHO
   '
   JINGLE : Wait Vbl
   '
   ' Some people hate the Amal language but it can be the best method
   ' for some things. here it moves the sprite or pointer using the mouse
   '
   Sprite 8,X Mouse,Y Mouse,37
   Channel 1 To Sprite 8
   Wait Vbl : Amal 1,"G: L X=XM;L Y=YM;J G" : Amal On 1
   '
   Timer=0
   X=SX : Y=SY : TXM=SX : TYM=SY
   '
   '
   '   This is the main Procedure where it all starts!!!!
   '
   Do
      ESC=0 : _DOMAN[X,Y]
      If IN<2 Then FINESHED : Exit
      If TIME=0 or JUMPS=0 Then OUTA : Exit
      If ESC or Key State(69) Then Exit
      If Key State(95) Then Exit
      X=Min(8,Max(0,(X Mouse-233)/16)) : Y=Min(8,Max(0,(Y Mouse-62)/16))
      If _BOB(X,Y)>0 Then CANMOVE[X,Y,1] : If OK Then Goto JID Else If KEEPX+KEEPY>0 Then X=KEEPX : Y=KEEPY : Goto JID
      If _BOB(X,Y)=0 Then Sam Play %11,5,25000 : Repeat : Until Mouse Key=0 : If KEEPX+KEEPY>0 Then X=KEEPX : Y=KEEPY
      JID:
   Loop
   '
   '
   '
End Proc
Procedure _DOMAN[XM,YM]
   '
   ' A peg-it has been clicked on! now lets see if he can go anywhere!
   '
   MAN=_BOB(XM,YM)
   CANMOVE[XM,YM,1]
   '                That was easy, if he can't then ga back to main!
   If OK=0 Then Pop Proc
   '
   '   Now a valid peg-it has been chosen and is selected
   '   In this loop you could select another, Jump or NOT jump?
   '
   Do
      CANMOVE[XM,YM,0] : If OK=0 Then PLACE : YM=SY : XM=SX
      Sprite 9,XM*16+240,YM*16+69,37
      If TXM<>XM or TYM<>YM Then Sam Play %11,3,20000 : Repeat : SHO_FIGURES : Until Mouse Key=0 : TXM=XM : TYM=YM
      Do
         SHO_FIGURES
         X=Min(8,Max(0,(X Mouse-233)/16)) : Y=Min(8,Max(0,(Y Mouse-62)/16))
         POS=-1 : MOX=0 : MOY=0
         '
         ' We now know where you are pointing now lets see if it is valid by
         ' following the path!
         '
         If X=XM and Y=YM-2 Then FOLOW[XM,YM,0,-1,0] : If PASS Then POS=0 : MOX=0 : MOY=-2
         If Y=YM and X=XM+2 Then FOLOW[XM,YM,1,0,1] : If PASS Then POS=1 : MOX=2 : MOY=0
         If X=XM and Y=YM+2 Then FOLOW[XM,YM,0,1,2] : If PASS Then POS=2 : MOX=0 : MOY=2
         If Y=YM and X=XM-2 Then FOLOW[XM,YM,-1,0,3] : If PASS Then POS=3 : MOX=-2 : MOY=0
         '
         ' if its valid then face that direction
         '
         If POS>-1 Then If POS<>DREC(MAN) Then FACE[MAN,POS]
         If Key State(69) Then Inc ESC : Exit 2
         If Key State(95) Then Inc LEVEL : Inc ESC : Exit 2
         If TIME=0 or JUMPS=0 or IN<2 Then Exit 2
         '
         ' This is a bit tricky but if you are clicking in the right place
         ' it will now jump for you!
         '
         If Mouse Key>0 Then If POS=-1 Then PASS=1 : KEEPX=XM : KEEPY=YM : Exit 2 Else Dec JUMPS : Repeat : Gosub DREC : JUMP[XM,YM,MOX,MOY,POS] : XM=LANDX : YM=LANDY : MAN=_BOB(XM,YM) : TXM=XM : TYM=YM : Until PASS=0 : Exit
      Loop
   Loop
   Pop Proc
   '
   DREC:
   If GRID(XM,YM)=4 Then POS=0 : MOX=0 : MOY=-2
   If GRID(XM,YM)=5 Then POS=1 : MOX=2 : MOY=0
   If GRID(XM,YM)=6 Then POS=2 : MOX=0 : MOY=2
   If GRID(XM,YM)=7 Then POS=3 : MOX=-2 : MOY=0
   If XM<8 Then If GRID(XM,YM)=50 and _BOB(XM+1,YM) Then POS=1 : MOX=2 : MOY=0
   If XM>0 Then If GRID(XM,YM)=51 and _BOB(XM-1,YM) Then POS=3 : MOX=-2 : MOY=0
   Return
   '
End Proc
'                                Other-screens
Procedure MAINSCREEN
   '
   ' main title screen
   '
   TITLE=1
   Gosub SETUP
   LASTLEVEL=-1
   '
   T=0 : Timer=0
   Shift Down 2,27,29,1
   PASS=0
   Do
      If Timer>13 Then If T=0 Then Sam Play %10,6,20000 : Inc T
      If Timer>26 Then Sam Play %1,5,15000 : Timer=0 : Dec T
      If Mouse Key=1
         ZZZ=X Mouse
         BLOOP
         Fade 1
         Wait 17
         If ZZZ<287
            Repeat : Gosub NEWGAME : Until PASS=1 : PASS=0
         Else
            PASS=1
         End If
         _ENDIT=0
         Exit
      End If
      Gosub DAISY
      Wait Vbl
   Loop
   Pop Proc
   '
   '    --------------------- new game -------------
   '
   NEWGAME:
   TITLE=2
   Gosub SETUP
   '
   PASS=0
   Do
      If Mouse Key=1
         If X Mouse<287
            ' Gosub _GETCODE : I took the code out for this
         Else
            PASS=1
            BLOOP
         End If
         Exit
      End If
      Gosub DAISY
      Wait Vbl
   Loop
   Fade 1
   Wait 17
   Return
   '
   '
   SETUP:
   FRESHSCREEN[1]
   For B=0 To 5
      Ink 8+B
      Box 40-B,135-B To 145+B,160+B
      Box 175-B,135-B To 280+B,160+B
   Next B
   Limit Mouse 170,177 To 405,197
   Screen Show 0
   Fade 12 To 1
   Return
   '
   DAISY:
   If Rnd(50) Then Goto EN
   Add B,1,6 To 12
   X=Rnd(2) : Y=43 : If X=1 Then Y=65
   Bob B-5,37+X*112,Y,47
   Channel B To Bob B-5
   Move Y B,"(1,-3,6)(1,-2,6)(1,-1,6)(1,0,6)(1,1,6)(1,2,6)(1,3,6)(1,4,6)(1,5,7)(1,6,7)(1,7,7)(1,8,7)(1,9,7)"
   Z=Rnd(3)
   If Z=0 Then Move X B,"(1,-5,12)(1,-4,12)(1,-2,16)(1,-1,99)" Else If Z=1 Then Move X B,"(1,5,12)(1,4,12)(1,2,16)(1,1,99)" Else If Z=2 Then Move X B,"(1,-4,10)(1,-2,16)(1,-1,99)" Else Move X B,"(1,4,10)(1,2,16)(1,1,99)"
   Move On B
   CHAN : Sam Play CHAN,1,9000+Rnd(9000)
   EN:
   Return
   '
End Proc
Procedure FRESHSCREEN[PAZ]
   '
   ' procedure to open various screens. It is made complicated to save
   ' space. Sorry about that...
   '
   Unpack 12 To 0 : Screen Hide 0 : Fade 1 : Wait 17
   Sprite Off
   Cls 10,5,5 To 314,194
   Screen Copy 0,20,0,140,199 To 0,140,0
   For A=10 To 170 Step 10
      Screen Copy 0,0,A,319,A+10 To 0,0,A+10
   Next A
   If PAZ
      Paste Bob 12,20,39
      Paste Bob 126,42,39
      Paste Bob 242,20,39
      _TEX[35,188,"copyright 1994 daisy software"]
      Sprite 8,X Mouse,Y Mouse,42
      Channel 1 To Sprite 8 : Amal 1,"G: L X=XM;L Y=YM;J G" : Amal On 1
      If TITLE=1
         _TEX[85,25,"peg it quick blast"]
         _TEX[100,40,"by paul burkey"]
         _TEX[48,155,"play peg it"]
         _TEX[179,155,"play peg it"]
      Else
         LEVEL
         _TEX[105,25,"ready to play"]
         A$="level"+Str$(LEVEL)+". "+LEVEL$
         MES[A$] : _TEX[MES,40,A$]
         _TEX[45,155,"     "]
         _TEX[210,155,"play"]
      End If
      Double Buffer
   Else
      Paste Bob 10,8,39
      Paste Bob 10,114,39
      Paste Bob 242,8,39
      Paste Bob 242,114,39
   End If
   Limit Mouse
End Proc
Procedure SHO
   '
   B=10
   '
   ' This is the most complicated bit. It used the data bank 10 the get
   ' place the bits on the board. It also updated the grid(x,y), that
   ' stores the positions of the parts on the screen. ie. trapolines!
   ' and _bob(x,y) tels you which bob is used for which place
   '
   '
   '
   If LASTLEVEL=LEVEL Then Gosub QUICK : Pop Proc
   '
   For SC=1 To 69
      X=-1 : Y=-1
      For AA=0 To 8
         For BB=0 To 8
            GRID=0
            If GRID(AA,BB)=51 Then GRID=1 Else If GRID(AA,BB)<>50 Then GRID=GRID(AA,BB)
            If Peek(Start(13)+81+BB*9+AA)=SC and GRID>0 Then X=AA : Y=BB
         Next BB
      Next AA
      If X=-1 and Y=-1 Then Goto NOBOB
      TITLE=0 : Gosub THINGS
      '
      ' old = 10000) : Wait 3 : Goto
      '
      If PASS Then Goto NOBOB
      Channel 15 To Bob B
      DREC(B)=-1
      ZZ=Peek(Start(13)+Y*9+X)
      If ZZ=1
         Bob B,182,20,19 : OX=4 : OY=0 : MOVE[B,0,1,2]
      Else
         If ZZ=2
            Bob B,262,99,28 : OX=8 : OY=4 : MOVE[B,-1,0,3]
         Else
            If ZZ=3
               Bob B,182,179,1 : OX=4 : OY=8 : MOVE[B,0,-1,0]
            Else
               Bob B,102,99,10 : OX=0 : OY=4 : MOVE[B,1,0,1]
            End If
         End If
      End If
      '
      Repeat
         A: If OY<Y Then If _BOB(OX,OY+1)=0 and GRID(OX,OY+1)<99 Then Inc OY : MOVE[B,0,1,2] : Goto A
         B: If OX>X Then If _BOB(OX-1,OY)=0 and GRID(OX-1,OY)<99 Then Dec OX : MOVE[B,-1,0,3] : Goto B
         C: If OY>Y Then If _BOB(OX,OY-1)=0 and GRID(OX,OY-1)<99 Then Dec OY : MOVE[B,0,-1,0] : Goto C
         D: If OX<X Then If _BOB(OX+1,OY)=0 and GRID(OX+1,OY)<99 Then Inc OX : MOVE[B,1,0,1] : Goto D
      Until OX=X and OY=Y
      Anim Off 15
      FACE[B,0]
      _BOB(X,Y)=B : GRID(X,Y)=GRID(X,Y)-1
      Inc B
      Inc IN : Timer=0 : SHO_FIGURES
      NOBOB:
   Next SC
   '
   BLEEP=1 : Gosub FINGS
   Gosub SPRINGS
   PLACE
   LASTLEVEL=LEVEL
   Pop Proc
   '
   FINGS:
   For X=0 To 8
      For Y=0 To 8
         TITLE=1 : Gosub THINGS
         If PASS and BLEEP Then Sam Play %1,3,25000
      Next Y
   Next X
   Return
   '
   QUICK:
   For X=0 To 8
      For Y=0 To 8
         If GRID(X,Y)>49 and GRID(X,Y)<99 Then GRID=GRID(X,Y)-50 Else GRID=GRID(X,Y)
         If GRID=1
            Bob B,118+X*16,35+Y*16,1
            _BOB(X,Y)=B : DREC(B)=0
            Inc B : Inc IN
            GRID(X,Y)=GRID(X,Y)-1
         End If
         TITLE=1 : Gosub THINGS
      Next Y
   Next X
   BLEEP=0 : Gosub FINGS
   Gosub SPRINGS
   Return
   '
   THINGS:
   PASS=0
   GR=GRID(X,Y)
   If GR=13 or GR=22 or GR=23
      If TITLE
         Paste Bob 111+X*16,26+Y*16,46+GR
      End If
      Inc PASS : Return
   End If
   If GR=14 or GR=20 or GR=21
      If TITLE
         Paste Bob 110+X*16,28+Y*16,46+GR
      End If
      Inc PASS : Return
   End If
   If PASS=0 and GR>1 and GR<30
      If TITLE
         Paste Bob 112+X*16,29+Y*16,46+GR
      End If
      Inc PASS
   End If
   Return
   '
   SPRINGS:
   SPRINGS=0
   For Y=0 To 8
      For X=0 To 7
         If GRID(X,Y)=50
            GRID(X+1,Y)=51
            If _BOB(X,Y)
               SHAPE=0
            Else
               SHAPE=1
            End If
            Bob 5+SPRINGS,126+X*16,35+Y*16,43+SHAPE*2
            SPRINGS(SPRINGS,0)=X
            SPRINGS(SPRINGS,1)=Y
            SPRINGS(SPRINGS,2)=SHAPE
            If LASTLEVEL<>LEVEL
               Sam Play %11,7,6000
               Wait 20
            End If
            Inc SPRINGS
         End If
      Next X
   Next Y
   Return
End Proc
'                                Game-Procs
Procedure FOLOW[X,Y,MX,MY,DREC]
   '
   ' This is one of the most important procedures it will, when given
   ' the start x,y and the direction speed ie x=2,y=0  oops can't remember
   ' what DREC was for! sorry!
   '
   ' The original grid is saved in array Tgrid(x,y) and will be put back
   ' when were done
   '
   '
   TASK[0]
   TBOB(X,Y)=0
   PASS=0
   NX=X+MX*2
   NY=Y+MY*2
   '
   ' Now we have worked out the next place to land is it valid.
   '
   Do
      '
      '            Land on things or over   : DON'T
      '
      Exit If NX>8 or NX<0 or NY>8 or NY<0
      LAND=GRID(NX,NY)
      Exit If LAND=10
      If MX<>0 Then If LAND=14 or GRID(X+MX,Y)=14 or GRID(X,Y)=14 Then Exit
      If MY<>0 Then If LAND=13 or GRID(X,Y+MY)=13 or GRID(X,Y)=13 Then Exit
      If MX>0 Then If LAND=20 or GRID(X+MX,Y)=20 or GRID(X+MX,Y)=21 Then Exit
      If MX<0 Then If LAND=21 or GRID(X+MX,Y)=21 or GRID(X+MX,Y)=20 Then Exit
      If MY>0 Then If LAND=22 or GRID(X,Y+MY)=22 or GRID(X,Y+MY)=23 Then Exit
      If MY<0 Then If LAND=23 or GRID(X,Y+MY)=23 or GRID(X,Y+MY)=22 Then Exit
      Exit If TBOB(NX,NY)>0 or LAND=2 or LAND=99
      If GRID(X+MX,Y+MY)=2 Then If(GRID(X,Y)<>17 and GRID(X,Y)<>18) Then Exit
      If TBOB(X+MX,Y+MY)>0 Then If GRID(X+MX,Y+MY)=17 or GRID(X+MX,Y+MY)=18 Then If(GRID(X,Y)<>17 and GRID(X,Y)<>18) Then Exit
      '
      If X+MX>0 and X+MX<9 Then If Y+MY>0 and Y+MY<9 Then TBOB(X+MX,Y+MY)=0 : Rem          jumped bob
      '
      '           Land on floor or teletort : OK
      '
      If TBOB(NX,NY)=0
         If LAND=0 or LAND=9 or LAND=11 or LAND=12 or LAND=13 or LAND=14 or LAND=18 or LAND=17 or LAND=20 or LAND=21 or LAND=22 or LAND=23
            PASS=1 : Exit
         End If
         If LAND=8 or LAND=15 or LAND=19
            TELEPORT[NX,NY,0] : Exit
         End If
         If LAND=25
            ARROW[NX,NY,0] : Exit
         End If
      End If
      '
      If NX<8 Then If LAND=50 and TBOB(NX+1,NY)=0 Then PASS=1 : Exit
      If NX>0 Then If LAND=51 and TBOB(NX-1,NY)=0 Then PASS=1 : Exit
      '
      '           Spring or Bounce          : CHECK FURTHER
      '
      If LAND=4 Then MX=0 : MY=-1
      If LAND=5 Then MX=1 : MY=0
      If LAND=6 Then MX=0 : MY=1
      If LAND=7 Then MX=-1 : MY=0
      If LAND=16 or LAND=24 Then SLIP[NX,NY,0] : NX=LANDX : NY=LANDY
      '
      Swap TBOB(X,Y),TBOB(NX,NY)
      '
      If NX<8 Then If LAND=50 and TBOB(NX+1,NY) Then Inc NX : MX=-1 : MY=0 : Goto SPR
      If NX>0 Then If LAND=51 and TBOB(NX-1,NY) Then Dec NX : MX=1 : MY=0
      SPR:
      '
      X=NX : NX=X+MX*2
      Y=NY : NY=Y+MY*2
      '
      'this will loop over and over until a peg-it lands on a space etc. or
      'it will exit if a peg-it would jump out of the arena INVALID
      'if it does land on a trampoline ot a see'saw the new direction is
      'worked out and it will loop again!
      '
   Loop
   '
   ' You can use the End Proc[?] command to return things from procedures
   ' but I am so used to returning PASS or OK or something that makes the
   ' program easier to follow as returning things is a bit stupid in AMOS!
   ' In this procedure If I remember? it will return OK=1 if a valid jum was made
   '
End Proc
Procedure JUMP[X,Y,JX,JY,DREC]
'
' This is the actual jumping bit. Same as the prev Proc except we already
' know that it's a valid move and it just goes along with the movements!
'
   PASS=0
   MAN=_BOB(X,Y)
   MAN2=_BOB(X+JX/2,Y+JY/2)
   LANDX=X+JX : LANDY=Y+JY
   Swap _BOB(X,Y),_BOB(LANDX,LANDY)
   If(GRID(X,Y)>2 and GRID(X,Y)<8) or GRID(X,Y)=16 or GRID(X,Y)=24 Then SPRING=1
   If GRID(X,Y)=50 Then If _BOB(X+1,Y)>0 Then SPRING=1
   If GRID(X,Y)=51 Then If _BOB(X-1,Y)>0 Then SPRING=1
   If MAN2>0 Then _BOB(X+JX/2,Y+JY/2)=0
   If(GRID(LANDX,LANDY)>2 and GRID(LANDX,LANDY)<8) or GRID(LANDX,LANDY)=16 or GRID(LANDX,LANDY)=24 Then LAND=1
   If GRID(LANDX,LANDY)=50 Then If _BOB(LANDX+1,LANDY)>0 Then LAND=1
   If GRID(LANDX,LANDY)=51 Then If _BOB(LANDX-1,LANDY)>0 Then LAND=1
   '
   Channel 15 To Bob MAN
   '
   '   spring takes 17.  No spring takes 28
   '
   If SPRING
      Anim 15,"("+Str$(1+DREC*9)+",3)("+Str$(3+DREC*9)+",4)("+Str$(4+DREC*9)+",5)("+Str$(3+DREC*9)+",4)("+Str$(1+DREC*9)+",1)"
      XP$="(1,3,6)(1,2,4)(1,1,4)(1,0,1)(1,1,2)"
      XM$="(1,-3,6)(1,-2,4)(1,-1,4)(1,0,1)(1,-1,2)"
   Else
      Anim 15,"("+Str$(2+DREC*9)+",11)("+Str$(1+DREC*9)+",4)("+Str$(3+DREC*9)+",5)("+Str$(4+DREC*9)+",4)("+Str$(3+DREC*9)+",3)("+Str$(1+DREC*9)+",1)"
      XP$="(1,0,11)(1,3,6)(1,2,4)(1,1,4)(1,0,1)(1,1,2)"
      XM$="(1,0,11)(1,-3,6)(1,-2,4)(1,-1,4)(1,0,1)(1,-1,2)"
   End If
   '
   If DREC=0 Then Move Y 15,XM$ Else If DREC=1 Then Move X 15,XP$ Else If DREC=2 Then Move Y 15,XP$ Else Move X 15,XM$
   '
   Anim On 15 : Move On 15 : If(1-SPRING) Then Wait 11
   Sam Play %1000,1,20000 : SHO_FIGURES
   '
   If MAN2
      Wait 1 : Bob MAN2,,,40 : Wait 3 : Bob MAN2,,,41 : Wait 4
      Sam Play %1100,2,10000 : Bob MAN2,,,42 : Wait 4
      Sam Play %11,2,20000 : Bob Off MAN2 : Wait 5
      Dec IN : SHO_FIGURES
   Else
      Wait 17
   End If
   '
   LANDON=GRID(LANDX,LANDY)
   If LANDON=50 Then SEESAW[LANDX,LANDY,0]
   If LANDON=51 Then SEESAW[LANDX-1,LANDY,1]
   If LAND Then PASS=1 : If LANDON=16 or LANDON=24 Then Sam Play %1100,6,1500 Else Sam Play %1100,7,10000 Else If(GRID(X,Y)=18 or GRID(X,Y)=17) and LANDON=0 Then Sam Play %111,5,15000 Else Sam Play %100,5,12000+Rnd(8000)
   If LANDON=8 or LANDON=15 or LANDON=19 Then TELEPORT[LANDX,LANDY,1]
   If LANDON=25 Then ARROW[LANDX,LANDY,1]
   If LANDON=16 or LANDON=24 Then SLIP[LANDX,LANDY,1]
   If LANDON=11 Then BOMB
   If LANDON=50 Then If _BOB(LANDX+1,LANDY) Then Inc LANDX : Pop Proc Else PASS=0
   If LANDON=51 Then If _BOB(LANDX-1,LANDY) Then Dec LANDX : Pop Proc Else PASS=0
   If LANDON=9
      Wait 2 : Sam Play %1000,6,1200 : Bob MAN,,,40
      Wait 2 : Sam Play %100,6,1300 : Bob MAN,,,41
      Wait 2 : Sam Play %10,6,1400 : Bob Off MAN
      _BOB(LANDX,LANDY)=0 : Dec IN : SHO_FIGURES
      If IN>1
         PLACE : LANDX=SX : LANDY=SY : PASS=0
      End If
   End If
End Proc
Procedure FACE[MAN,DREC]
'
' Simple turn around and face a DIRECTION. These inportant procedures
' took days to write but once there done they make the whole thing work.
' The more flexable the procedures are the more you can do with your
' programme. Some new ideas can be put into the game without much work.
'
   OLD=DREC(MAN)
   NEW=DREC
   If OLD=NEW Then Goto OK
   If OLD>0 Then Repeat : Add OLD,-1,0 To 3 : Add NEW,-1,0 To 3 : Until OLD=0
   If NEW=3 Then SPIN=-1 Else SPIN=1
   '
   NEW=DREC(MAN)*2
   Repeat
      Add NEW,SPIN,0 To 7
      Bob MAN,,,Peek(Start(13)+162+NEW) : Rem temp Wait 3
   Until NEW=DREC*2
   '
   OK:
   Bob MAN,,,Peek(Start(13)+162+NEW)
   DREC(MAN)=DREC
End Proc
Procedure MOVE[MAN,MX,MY,DREC]
'
' This procedure is for moving them out at the start!
'
   If DREC(MAN)=DREC Then Goto LAA
   Anim Off 15
   If DREC(MAN)>-1 Then FACE[MAN,DREC]
   Anim 15,"("+Str$(5+DREC*9)+",3)("+Str$(6+DREC*9)+",7)("+Str$(5+DREC*9)+",3)("+Str$(1+DREC*9)+",2)("+Str$(7+DREC*9)+",3)("+Str$(8+DREC*9)+",7)("+Str$(7+DREC*9)+",3)("+Str$(1+DREC*9)+",2)L"
   Anim On 15
   DREC(MAN)=DREC
   LAA:
   C=0
   For A=0 To 14 Step 2
      Bob MAN,X Bob(MAN)+MX,Y Bob(MAN)+MY,
      Bob MAN,X Bob(MAN)+MX,Y Bob(MAN)+MY, : Wait Vbl
      If C<>6 Then If I Bob(MAN)=6+DREC*9 Then CHAN : Sam Play CHAN,5,14000 : C=6
      If C<>8 Then If I Bob(MAN)=8+DREC*9 Then CHAN : Sam Play CHAN,5,18000 : C=8
   Next A
End Proc
Procedure CANMOVE[XM,YM,BEEP]
'
' sometimes a peg-it cant move in any direction at all! this is were
' we find out. You see it just does four Folows[] and if none return
' a PASS you can't move it!
'
   OK=0
   FOLOW[XM,YM,0,-1,0]
   If PASS=0
      FOLOW[XM,YM,1,0,1]
      If PASS=0
         FOLOW[XM,YM,0,1,2]
         If PASS=0
            FOLOW[XM,YM,-1,0,3]
         End If
      End If
   End If
   If PASS Then Inc OK : Pop Proc
   If BEEP Then Sam Play %11,5,25000 : Repeat : Until Mouse Key=0
End Proc
Procedure TELEPORT[MX,MY,TELE]
'
' once a teleport has been landed on just find the matching one
' and move him!
'
   PASS=0
   For TX=0 To 8
      For TY=0 To 8
         If GRID(TX,TY)=GRID(MX,MY) Then If TX<>MX or TY<>MY Then If TBOB(TX,TY)=0 Then LANDX=TX : LANDY=TY : PASS=1 : TX=9 : TY=9 : Exit
      Next TY
   Next TX
   '
   If TELE=0 Then Pop Proc
   '
   _BOB=_BOB(MX,MY)
   SAM=0
   For A=1 To 45
      Bob _BOB,118+MX*16,35+MY*16, : Sam Play %1,1,22000-SAM : Sam Play %10,1,3000+SAM : Add SAM,220 : Wait Vbl
      Bob _BOB,118+LANDX*16,35+LANDY*16, : Sam Play %1,1,21500-SAM : Sam Play %10,1,3500+SAM : Add SAM,220 : Wait Vbl
   Next A
   Sam Play %1,1,3500+SAM
   Wait 3
   Sam Play %10,1,3000+SAM
   Swap _BOB(MX,MY),_BOB(LANDX,LANDY)
   Timer=0
   PASS=0
End Proc
Procedure ARROW[MX,MY,CAN]
'
' Shift him over mate!
'
   PASS=0
   TX=MX-1 : TY=MY
   If TBOB(TX,TY)=0 Then LANDX=TX : LANDY=TY : PASS=1
   '
   If CAN=0 Then Pop Proc
   '
   Bob _BOB(MX,MY),118+LANDX*16,35+LANDY*16,
   Sam Play %1,6,5000 : Sam Play %10,7,2000
   Swap _BOB(MX,MY),_BOB(LANDX,LANDY)
   Timer=0
   PASS=0
End Proc
Procedure SLIP[MX,MY,CAN]
'
' Similar to teleports except you go back to a jump!
'
   For TX=0 To 8
      For TY=0 To 8
         If GRID(TX,TY)=GRID(MX,MY) Then If TX<>MX or TY<>MY Then LANDX=TX : LANDY=TY : TX=9 : TY=9 : Exit
      Next TY
   Next TX
   '
   If CAN=0 Then Pop Proc
   '
   _BOB=_BOB(MX,MY)
   Bob _BOB,118+LANDX*16,35+LANDY*16,
   Swap _BOB(MX,MY),_BOB(LANDX,LANDY)
   Timer=0
End Proc
Procedure BOMB
'
' when a button is pressed blow up all the Peg-Its that are standing on bombs!
'
   PASS=0
   For A=40 To 43
      For TX=0 To 8
         For TY=0 To 8
            If GRID(TX,TY)=12
               If _BOB(TX,TY)
                  If A<43
                     Bob _BOB(TX,TY),,,A
                     CHAN : Sam Play CHAN,8,9000+Rnd(2000)
                  Else
                     Bob Off _BOB(TX,TY) : _BOB(TX,TY)=0
                     Dec IN : SHO_FIGURES
                  End If
                  Wait 1
               End If
            End If
         Next TY
      Next TX
   Next A
End Proc
Procedure SHO_FIGURES
'
' Every 250 vbl's decreace the time! and display any other changes!
'
   If Timer>250 Then Dec TIME : Timer=0
   Screen 1
   If TIME<>LASTTIME
      XXX=(4-Len(Str$(TIME)))*5
      Cls 10 : _TEX[XXX,15,Str$(TIME)]
      Screen Copy 1,0,0,38,18 To Logic(0),272,61
      Screen Copy 1,0,0,38,18 To Physic(0),272,61
      If LASTTIME>-1
         Sam Play %1,4,18000+TIME*100
         If TIME<11
            Wait 3 : Sam Play %10,4,12000+TIME*200
            If TIME<6
               Wait 3 : Sam Play %100,4,6000+TIME*400
               If TIME=0
                  Wait 3 : Sam Play %1000,4,3000 : Wait 10
               End If
            End If
         End If
      End If
   End If
   '
   If JUMPS<>LASTJUMPS
      XXX=(4-Len(Str$(JUMPS)))*5
      Cls 10 : _TEX[XXX,17,Str$(JUMPS)]
      Screen Copy 1,0,0,38,19 To Logic(0),272,135
      Screen Copy 1,0,0,38,19 To Physic(0),272,135
   End If
   '
   If IN<>LASTIN
      If IN>9
         XXX=0
      Else
         XXX=5
      End If
      Cls 10 : _TEX[XXX,17,Str$(IN)]
      Screen Copy 1,0,0,31,19 To Logic(0),32,131
      Screen Copy 1,0,0,31,19 To Physic(0),32,131
   End If
   '
   LASTTIME=TIME
   LASTJUMPS=JUMPS
   LASTIN=IN
   '
   Screen 0
End Proc
Procedure PLACE
'
' when the game starts it will select a random peg-it
' for you to start with!
'
   Do
      TX=Rnd(8) : TY=Rnd(8)
      If _BOB(TX,TY) Then CANMOVE[TX,TY,0] : If OK Then SX=TX : SY=TY : Exit
   Loop
End Proc
Procedure OUTA
'
' out a time/jumps matey!
'
   Fade 3
   If TIME
      For A=50 To 4 Step -1 : Wait 2 : Sam Play CHAN,6,1000+A*500 : CHAN : Next A
   Else
      For A=1 To 30 : Wait 4 : Sam Play CHAN,4,15000-A*40 : CHAN : Next A
   End If
   If Mouse Key Then Pop Proc
   FRESHSCREEN[0]
   Paste Bob 154,28,47
   _TEX[138,70,"sorry"]
   If TIME Then _TEX[110,90,"out of jumps"] Else _TEX[115,90,"out of time"]
   Paste Bob 154,98,47
   _TEX[98,140,"code is ."+CODE$+"."]
   Paste Bob 154,148,47
   UNTMOUSE
End Proc
Procedure FINESHED
'
' Well done!!!!!!!
'
   Sprite Off 8
   Wait 40
   Inc LEVEL
   If LEVEL>50 Then Pop Proc
   If IN=0 Then Goto SKIP
   For X=0 To 8
      For Y=0 To 8
         MAN=_BOB(X,Y)
         If MAN>0
            Bob MAN,,,40 : Wait 7
            Bob MAN,,,41 : Wait 7
            Dec IN : SHO_FIGURES
            Wait 10
            Sam Play %1100,2,10000 : Bob MAN,,,42 : Wait 3
            Sam Play %11,2,20000 : Bob Off MAN
         End If
      Next Y
   Next X
   SKIP:
   Wait 10
   Fade 3
   For A=50 To 1 Step -5
      Volume %1111,A
      Sam Play %1100,2,10000
      Wait 2
      Sam Play %11,2,20000
      Wait 10
   Next A
   Volume %1111,63
   '
   FRESHSCREEN[0]
   LEVEL
   _TEX[113,46,"well done !"]
   _TEX[98,64,"level complete"]
   Paste Bob 151,70,47
   _TEX[72,110,"get ready for level"+Str$(LEVEL)]
   MES[LEVEL$] : _TEX[MES,128,LEVEL$]
   Paste Bob 151,134,47
   _TEX[95,174,"code is ."+CODE$+"."]
   UNTMOUSE
End Proc
Procedure UNTMOUSE
'
' wait for mouse before starting next screen!
'
   Paste Bob 140,183,46
   Double Buffer
   Screen Show 0
   For A=2 To 7
      If A=2 Then Bob A,153,7,38 Else Bob A,153,10,47
      Channel A To Bob A
      Move X A,"(1,7,3)(1,6,6)(1,5,5)(1,4,5)(1,3,5)(1,2,5)(1,1,6)(1,0,5)(1,-1,6)(1,-2,5)(1,-3,5)(1,-4,5)(1,-5,5)(1,-6,6)(1,-7,6)(1,-6,6)(1,-5,5)(1,-4,5)(1,-3,5)(1,-2,5)(1,-1,6)(1,0,5)(1,1,6)(1,2,5)(1,3,5)(1,4,5)(1,5,5)(1,6,6)(1,7,3)L"
      Move Y A,"(1,0,5)(1,1,5)(1,2,5)(1,3,5)(1,4,5)(1,5,4)(1,6,4)(1,5,4)(1,4,4)(1,3,5)(1,2,5)(1,1,5)(1,0,5)(1,-1,5)(1,-2,5)(1,-3,5)(1,-4,5)(1,-5,4)(1,-6,4)(1,-5,4)(1,-4,4)(1,-3,5)(1,-2,5)(1,-1,5)(1,0,5)L"
      Move On A
      Wait A*2
   Next A
   Fade 10 To 1
   Shift Down 2,27,29,1
   Timer=0 : T=0
   Repeat
      If Timer>13 Then If T=0 Then Sam Play %10,6,20000 : Inc T
      If Timer>26 Then Sam Play %1,5,15000 : Timer=0 : Dec T
      If Key State(69) Then Inc _ENDIT : Exit
   Until Mouse Key
   Fade 3
   BLOOP
   Wait 15
End Proc
Procedure BLOOP
'
' Have a guess
'
   Sam Play %1,1,10000 : Wait 3
   Sam Play %10,2,10000 : Wait 3
   Sam Play %100,1,12000 : Wait 3
   Sam Play %1000,2,5000
End Proc
'                                Misc-Procs
Procedure SEESAW[MX,MY,STATE]
'
' move the seesaw down
'
   For A=0 To 4
      If SPRINGS(A,0)=MX and SPRINGS(A,1)=MY and SPRINGS(A,2)<>STATE
         Bob 5+A,,,44
         Wait 4
         Bob 5+A,,,43+STATE*2
         SPRINGS(A,2)=STATE
      End If
   Next A
End Proc
Procedure JINGLE
'
' start screen jingle
'
   Wait 23
   For A=1 To 5
      Sam Play %1,3,6000-A*1000
      Wait 13
   Next A
   Wait 15
   Sam Play %11,4,12000
   Wait 10
   Sam Play %11,4,12000
End Proc
Procedure LEVELCODE[L]
'
' read level codes from data bank 10
'
   CODE$=""
   For A=0 To 4
      B=Peek(Start(10)+(L-1)*100+9+A*10)
      If B=0 Then B$=" " Else B$=Chr$(B)
      CODE$=CODE$+B$
   Next A
End Proc
Procedure CHAN
'
' I usualy play a sample through channal no chan which is 1 2 4 8
' then cycle through to next channal!
'
   CHAN=CHAN*2
   If CHAN>8 Then CHAN=1
'
End Proc
Procedure TASK[Z]
   '
' misc. procedure, depends on value of z
'
   For XC=0 To 8
      For YC=0 To 8
         If Z=0
            TBOB(XC,YC)=_BOB(XC,YC)
         Else
            If Z=1
               _BOB(XC,YC)=0
            Else
               If Z=2
                  GRID(XC,YC)=Peek(Start(10)+LEVEL*100+XC+YC*10)
               End If
            End If
         End If
      Next YC
   Next XC
End Proc