home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Amotrix / Amotrix.AMOS / Amotrix.amosSourceCode next >
Encoding:
AMOS Source Code  |  1997-05-30  |  17.3 KB  |  635 lines
  1. 'Set Buffer 10 
  2. Dim PD(1,28),CD(7),F(1,11,21),HI$(11),HI(11,2),P$(1),C(31),L(4)
  3. Dim MUS$(29)
  4. Hide 
  5. 'Request Off 
  6. 'On Error Goto ERR 
  7.  Extension_8_0EA2 "Amotrix.sam",-11
  8. 'Load "Amotrix.abk",11 : Bank Temporary 11 
  9.  Extension_8_142A 11
  10. 'Load "Amotrix.sam",11 
  11. MUSDIR$=Dir$
  12. If Extension_8_09B4 
  13.   C$=Upper$(Command Line$)
  14. Else 
  15.   C$=Upper$( Extension_8_09D6( Extension_8_09C2 ))
  16. End If 
  17. P=Instr(C$,"MODDIR=")
  18. If P
  19.   MUSDIR$="" : Add P,7 : BR=0
  20.   Do 
  21.     Exit If P>Len(C$)
  22.     A$=Mid$(C$,P,1)
  23.     If A$='"' : BR=1-BR : A$="" : End If 
  24.     Exit If(A$<=" ") and BR=0
  25.     MUSDIR$=MUSDIR$+A$
  26.     Inc P
  27.   Loop 
  28. End If 
  29. If Exist(MUSDIR$)=0 Then MUSDIR$=Dir$
  30.  Extension_8_063A MUSDIR$
  31. M=0
  32. Do 
  33.   F$= Extension_8_064C 
  34.   Exit If F$="" or M=30
  35.   If Left$(F$,4)="mod."
  36.     MUS$(M)=F$ : Inc M
  37.   End If 
  38. Loop 
  39. NUMMUS=M : CURMUS=Rnd(NUMMUS-1)
  40. If NUMMUS Then Extension_8_0EA2 Extension_8_03EC(MUSDIR$)+MUS$(CURMUS),-3
  41. SET=1 : Gosub LOASET
  42. For A=1 To 10
  43.   HI$(A)="* CHRISI *"
  44.   HI(A,0)=(11-A)*1000
  45.   HI(A,1)=5-(A-1)/2
  46.   HI(A,2)=1
  47. Next 
  48. For A=0 To 7 : Read CD(A) : Next 
  49. Unpack 14 To 1 : Screen Hide 1
  50. For A=0 To 31 : C(A)=Colour(A) : Next 
  51. If NUMMUS Then Extension_8_10F2 125 : Extension_8_108E 3
  52. HI=0 : MU=1 : SO=1 : HLF=1
  53. Gosub LOAHIS
  54. Repeat 
  55.   Repeat 
  56.     Gosub TITLE : HI=1
  57.     Gosub MENU
  58.   Until I$<>" "
  59.   If I$<>Chr$(27) Then Gosub GAME : I$=""
  60. Until I$=Chr$(27)
  61. For A=64 To 0 Step -2 : Extension_8_10C6 A : Multi Wait : Next 
  62. Sprite Off : Extension_8_10A8 
  63. Screen Close 1
  64.  Extension_8_1400 15
  65. End 
  66. MENU:
  67.   Unpack 15 To 0 : Screen Hide 0
  68.   Screen 1 : Get Palette 0
  69.   Screen 0 : For A=0 To 31 : Colour A,0 : Next 
  70.   Multi Wait : Screen Show 0
  71.   Gr Writing 0
  72.   T["WELCOME TO AMOTRIX!",76,2]
  73.   T["WRITTEN BY",90,4]
  74.   T["CHRISTOPHER HODGES",102,5]
  75.   T["PLEASE SELECT PLAYERS",120,1]
  76.   T["FIRE ON PORT 1: ONE PLAYER ",132,3]
  77.   T["FIRE ON PORT 0: TWO PLAYERS",142,6]
  78.   T["OTHER KEY-FUNCTIONS ARE NOW...",154,0]
  79.   T["SPC: VIEW HIGHSCORES     ",164,0]
  80.   T["ESC: QUIT OUT!           ",174,0]
  81.   T["1-3: LOAD NEW GRAPHIC SET",184,0]
  82.   T["INGAME KEYS ARE...",194,0]
  83.   T["'P': PAUSE (VIEW SETTINGS)",204,0]
  84.   T["'S': TOGGLE SOUND",214,0]
  85.   T["'M': TOGGLE MUSIC; 'C': CHANGE MODULE",224,0]
  86.   T["'H': HALF SPEED      ",234,0]
  87.   T["ESC: MAIN MENU       ",246,0]
  88.   Multi Wait : Fade 3 To 1
  89.   A=0
  90.   Repeat 
  91.     Multi Wait : I$=Upper$(Inkey$) : Inc A
  92.     If Fire(1) Then I$="P1"
  93.     If Fire(0) Then I$="P2"
  94.     If(I$=>"1") and(I$<"4") and Val(I$)<>SET Then SET=Val(I$) : Gosub LOASET : A=0
  95.     If A>500 Then I$=" "
  96.     If I$="M" and NUMMUS<>0 Then MU=1-MU
  97.     If I$="S" Then SO=1-SO
  98.     If I$="H" Then HLF=3-HLF
  99.     If I$="P" Then P=2 : Gosub PAUSE
  100.     If I$="C" Then SONGEND=2
  101.     Gosub TESTMUSIC
  102.   Until(I$="P1") or(I$="P2") or(I$=Chr$(27)) or(I$=" ")
  103.   If I$="P1" Then PL=0
  104.   If I$="P2" Then PL=1
  105.   Gr Writing 1
  106.   Fade 3
  107.   If MU=0 and(I$<>" ")
  108.     If NUMMUS
  109.       For A=64 To 0 Step -2 : Extension_8_10C6 A : Multi Wait : Next 
  110.        Extension_8_10A8 : WAI[16]
  111.     End If 
  112.   Else 
  113.     WAI[48]
  114.   End If 
  115.   Screen Close 0
  116. Return 
  117. TITLE:
  118.   Unpack 12 To 0 : Screen Hide 0 : Screen Display 0,,10,,1
  119.   Screen 1 : Get Palette 0
  120.   Screen 0 : For A=0 To 31 : Colour A,0 : Next 
  121.   Multi Wait : Screen Show 0 : Screen To Front 0
  122.   If HI
  123.     Gr Writing 0
  124.     A=Rnd(3)
  125.     If A=0 : A$="TODAYS HISCORE" : End If 
  126.     If A=1 : A$="FOREVER REMEMBERED" : End If 
  127.     If A=2 : A$="BEST AMOTRIXERS" : End If 
  128.     If A=3 : A$="COOLEST STACKERS" : End If 
  129.     T[A$,96,2]
  130.     T[" RNK    NAME    SCORE LV SET",111,3]
  131.     For A=1 To 10
  132.       T$=Str$(HI(A,0))-" "
  133.       T$=Str$(A)+". "+HI$(A)+" "+String$("0",5-Len(T$))+T$+" "
  134.       If A<10 : T$=" "+T$ : End If 
  135.       A$=Str$(HI(A,1))-" "
  136.       T$=T$+String$("0",2-Len(A$))+A$+" "+Str$(HI(A,2))+" "
  137.       T[T$,A*10+115,5]
  138.     Next 
  139.     Gr Writing 1
  140.   End If 
  141.   If MU=0 and(I$<>" ") and NUMMUS Then Extension_8_108E 3 : Extension_8_10C6 64
  142.   Multi Wait : Fade 3 To 1
  143.   For A=0 To 128 Step 4
  144.     Multi Wait : Screen Display 0,,168-A,,A*2+2
  145.   Next 
  146.   For A=1 To 400
  147.     Multi Wait 
  148.     Exit If Fire(0)+Fire(1)+(Inkey$<>"")
  149.     Gosub TESTMUSIC
  150.   Next 
  151.   Fade 3
  152.   For A=0 To 128 Step 4
  153.     Multi Wait : Screen Display 0,,41+A,,256-A*2
  154.   Next 
  155.   WAI[16] : Screen Close 0
  156. Return 
  157. GAME:
  158.   Unpack 15 To 0 : Screen Hide 0
  159.   Screen 1 : Get Palette 0
  160.   Screen 0 : For A=0 To 31 : Colour A,0 : Next 
  161.   If PL=1 Then PD(0,0)=3 : PD(1,0)=163 : PD(0,1)=72 : PD(1,1)=232
  162.   If PL=0 Then PD(0,0)=89 : PD(0,1)=158
  163.   For P=0 To PL
  164.     Gosub CLEARFIELD
  165.   Next 
  166.   Multi Wait : Screen Show 0
  167.   Multi Wait : Fade 3 To 1 : WAI[48]
  168.   For P=0 To PL
  169.     Gosub NEWSTONE
  170.   Next 
  171.   TIM=0
  172.   Repeat 
  173.     Gosub TESTMUSIC
  174.     Gosub FUNCHECK
  175.     If(PL=0 and PD(0,24)) or(PL=1 and PD(0,24) and PD(1,24)) Then Inc TIM
  176.     I$=Upper$(Inkey$)
  177.     For P=0 To PL
  178.       If PD(P,24)=4 Then Gosub RETHISCORE2 : TIM=0
  179.       If PD(P,24)=3 Then Gosub RETHISCORE : TIM=0
  180.       If PD(P,24)=2 and PD(P,27) Then PD(P,25)=100
  181.       If PD(P,24)=2 Then Inc PD(P,25) : If PD(P,25)>100 Then PD(P,24)=0 : Gosub RETNEXTLEV
  182.       If PD(P,24)=1 and PD(P,27) Then PD(P,24)=0 : Gosub CLEARFIELD : Gosub NEWSTONE2
  183.       If PD(P,24)=0 Then Gosub AMOTRIX : TIM=0
  184.       PD(P,27)=0 : PD(P,28)=0
  185.     Next 
  186.     If PD(0,24)<>3 and PD(1,24)<>3
  187.       If I$="P" : P=0 : Gosub PAUSE : End If 
  188.       If I$="M"
  189.         If NUMMUS
  190.           MU=1-MU
  191.           If MU=0
  192.              Extension_8_10A8 
  193.           Else 
  194.              Extension_8_108E 3 : Extension_8_10C6 64
  195.           End If 
  196.         End If 
  197.       End If 
  198.       If I$="S" : SO=1-SO : End If 
  199.       If I$="H" : HLF=3-HLF : End If 
  200.       If I$="C" : SONGEND=2 : End If 
  201.       If I$=Chr$(27) and PD(0,24)=1 and(PD(1,24)=1 or PL=0) : Exit : End If 
  202.       If I$=Chr$(27)
  203.         P=0 : Sprite Off : Gosub GAMEOVER : Gosub NEWSTONE
  204.         If PL=1 : P=1 : Gosub GAMEOVER : Gosub NEWSTONE : End If 
  205.       End If 
  206.     End If 
  207.     T=Timer
  208.     If T<HLF Then For A=1 To HLF : Gosub FUNCHECK : Multi Wait : Next 
  209.     Timer=0
  210.   Until TIM>200
  211.   Sprite Off 
  212.   Fade 3 : WAI[48]
  213. Return 
  214. End 
  215. TESTMUSIC:
  216.   If NUMMUS<2 Then Return 
  217.   If Extension_8_10B6 =$FF Then SONGEND=1
  218.   If SONGEND=0 Then Return 
  219.   If SONGEND
  220.     If Extension_8_15F0 <3 or Extension_8_15F0 >60 or SONGEND=2
  221.        Extension_8_10A8 
  222.       Erase 3
  223.       Repeat : NEXMUS=Rnd(NUMMUS-1) : Until NEXMUS<>CURMUS
  224.       CURMUS=NEXMUS
  225.        Extension_8_0EA2 Extension_8_03EC(MUSDIR$)+MUS$(NEXMUS),-3
  226.        Extension_8_108E 3
  227.       SONGEND=0
  228.     End If 
  229.   End If 
  230. Return 
  231. LOASET:
  232.   A$=Str$(SET)-" "
  233.   Erase 1
  234.    Extension_5_0120 "Amotrixset"+A$+".dat",1
  235.    Extension_8_025A SET+6 To 13 : Extension_8_008A 13
  236. Return 
  237. SAVHIS:
  238.   Trap Open Out 1,"Amotrix.his"
  239.     If Errtrap Then Return 
  240.     For A=1 To 10
  241.       B=HI(A,0)
  242.       Print #1, Extension_8_08D2(HI(A,0))+Chr$(HI(A,1))+Chr$(HI(A,2))+HI$(A);
  243.     Next 
  244.   Close 1
  245. Return 
  246. LOAHIS:
  247.   If Exist("Amotrix.his")=0 Then Return 
  248.   Open In 1,"Amotrix.his"
  249.     For A=1 To 10
  250.       A$=Input$(1,6)
  251.       HI(A,0)= Extension_8_0998(A$)
  252.       HI(A,1)=Asc(Mid$(A$,5))
  253.       HI(A,2)=Asc(Mid$(A$,6))
  254.       HI$(A)=Input$(1,10)
  255.     Next 
  256.   Close 1
  257. Return 
  258. FUNCHECK:
  259.   If Fire(1) Then PD(0,27)=-1
  260.   If Fire(0) Then PD(1,27)=-1
  261.   R=Jleft(1)-Jright(1)
  262.   If R Then PD(0,28)=R
  263.   R=Jleft(0)-Jright(0)
  264.   If R Then PD(1,28)=R
  265. Return 
  266. PAUSE:
  267.   Sprite Off 
  268.   If P=0 Then Screen 1 : Get Palette 0 : Screen 0
  269.   Multi Wait : Fade 1
  270.   For A=0 To 127 Step 8
  271.     Screen Display 0,,43+A,,256-A*2 : Multi Wait 
  272.   Next 
  273.   WAI[17]
  274.   Screen Open 2,320,256,2,0
  275.   Curs Off : Cls 0
  276.   Palette 0,$FFF
  277.   A$="; A: L R0=1280+R8; L R1=400; L R2=R9; L R3=R5; L A=R7+34; L R6=R7/4; "
  278.   A$=A$+"B: L X=R0/10; L Y=R1/10; P; L R0=R0+R2; L R1=R1+R3; L R3=R3+1; "
  279.   A$=A$+"   I R1<2640 J B; L R4=1; I R3<30 J A; L R3=0-R3/2; L R1=2639; J B; "
  280.   For A=0 To 3
  281.     Sprite A,0,0,1
  282.     Channel A To Sprite A*2
  283.     Amal A,String$("P",A*40)+A$
  284.   Next 
  285.   C=0
  286.   Locate 0,7 : Centre "GAME PAUSED!"
  287.   A$="MUSIC IS O"
  288.   If MU Then A$=A$+"N. ("+MUS$(CURMUS)+")" Else A$=A$+"FF."
  289.   Locate 0,10 : Centre A$
  290.   A$="SOUND IS O"
  291.   If SO Then A$=A$+"N." Else A$=A$+"FF."
  292.   Locate 0,12 : Centre A$
  293.   Locate 0,14 : Centre "GRAPHIC SET"+Str$(SET)+" IS LOADED."
  294.   A$="DROPPING SPEED IS "
  295.   If HLF=2 Then A$=A$+"ON HALF!" Else A$=A$+"NORMAL!"
  296.   Locate 0,16 : Centre A$
  297.   Locate 0,19 : Centre "PRESS ANY KEY OR FIRE TO RETURN."
  298.   Draw 0,255 To 320,255
  299.   Repeat 
  300.     For A=0 To 3
  301.       Amreg(A,8)=Rnd(2870) : Amreg(A,9)=Rnd(19)-10 : Amreg(A,7)=Rnd(31)
  302.       B=Amreg(A,6) : Amreg(A,5)=Rnd(30)
  303.       Colour 17+A*4,C(CD(B)) : Colour 18+A*4,C(CD(B)+1)
  304.       Colour 19+A*4,C(CD(B)+2)
  305.       If Amreg(A,4)=1 Then Amreg(A,4)=0 : Extension_8_145A Extension_8_04F8(A),1,10000+Rnd(200)
  306.     Next 
  307.     If C=0 Then Amal On : C=1
  308.     Gosub TESTMUSIC
  309.     Multi Wait 
  310.   Until(Inkey$<>"") or Fire(1) or Fire(0)
  311.   Amal Off : Sprite Off 
  312.   Screen Close 2
  313.   Screen Display 0,,10,,1
  314.   For A=0 To 31 : Colour A,0 : Next 
  315.   Multi Wait : Fade 1 To 1
  316.   For A=0 To 128 Step 8
  317.     Multi Wait : Screen Display 0,,170-A,,A*2+2
  318.   Next 
  319.   Wait 16
  320. Return 
  321. AMOTRIX:
  322.   Add PD(P,4),PD(P,6)*Min(PD(P,26),2)
  323.   If PD(P,27)=0 Then PD(P,7)=21
  324.   If PD(P,4) mod 8=0 Then PD(P,6)=0
  325.   R=Jdown(1-P)-Jup(1-P)*PD(P,23)
  326.   If R Then Gosub ENERGY
  327.   PD(P,5)=PD(P,5)-Sgn(R)*PD(P,26)+PD(P,26)
  328.   Sprite 4+P*2,PD(P,1)+PD(P,4)+128,123+PD(P,5),34+PD(P,2)*4+PD(P,3)
  329.   If PD(P,5)/8<>PD(P,8) Then Gosub CHECK : PD(P,8)=PD(P,5)/8
  330.   If PD(P,28) Then PD(P,6)=PD(P,28) : If PD(P,4) mod 8=0 Then Gosub MOVE
  331.   Inc PD(P,7)
  332.   If PD(P,27) and PD(P,7)>20 and PD(P,5)>-1 Then Gosub ROTATE
  333. Return 
  334. ENERGY:
  335.   If PD(P,5)<0 Then R=Min(0,R) : Return 
  336.   PD(P,9)=Max(Min(1280,PD(P,9)-R),8)
  337.   If PD(P,9)=8 and R>0 Then R=0
  338.   If PD(P,9)<1280 Then Ink 0 : Draw PD(P,0)+153,248-PD(P,9)/8 To PD(P,0)+154,248-PD(P,9)/8
  339.   Ink 6 : Draw PD(P,0)+153,249-PD(P,9)/8 To PD(P,0)+154,249-PD(P,9)/8
  340. Return 
  341. CHECK:
  342.   S=PD(P,2)*4+PD(P,3) : XX=PD(P,4)/8 : YY=Max(PD(P,5)/8,0)
  343.   For X=0 To 3
  344.     For Y=0 To 3
  345.       A=Peek(Start(13)+S*16+X+Y*4)
  346.       If XX+X>10 or XX+X<-1 Then Exit 
  347.       If A and F(P,XX+X+1,YY+Y+1) Then Gosub PASTESTONE : Gosub NEWSTONE : Exit 2
  348.     Next 
  349.   Next 
  350. Return 
  351. MOVE:
  352.   S=PD(P,2)*4+PD(P,3) : XX=PD(P,4)/8+PD(P,6) : YY=Max(PD(P,5)/8,0)
  353.   If YY<0 Then Return 
  354.   For X=0 To 3
  355.     For Y=0 To 3
  356.       A=Peek(Start(13)+S*16+X+Y*4)
  357.       If XX+X>10 or XX+X<-1 Then Exit 
  358.       If A and F(P,XX+X+1,YY+Y+1) Then PD(P,6)=0 : Exit 2
  359.     Next 
  360.   Next 
  361. Return 
  362. ROTATE:
  363.   B=PD(P,3)
  364.   Add PD(P,3),1,0 To 3
  365.   S=PD(P,2)*4+PD(P,3) : XX=PD(P,4)/8+PD(P,6) : YY=Max(PD(P,5)/8,0)
  366.   If YY<0 Then Return 
  367.   For X=0 To 3
  368.     For Y=0 To 3
  369.       A=Peek(Start(13)+S*16+X+Y*4)
  370.       If XX+X>10 or XX+X<-1 Then Exit 
  371.       If A and F(P,XX+X+1,YY+Y+1) Then PD(P,3)=B : Exit 2
  372.     Next 
  373.   Next 
  374.   If B<>PD(P,3) and SO Then Extension_8_145A 1,1,4000
  375.   PD(P,7)=0
  376. Return 
  377. PASTESTONE:
  378.   Sprite Off 4+P*2
  379.   If PD(P,2)=7 Then Goto DROP
  380.   If SO Then Extension_8_145A 1,1,10000
  381.   Paste Bob PD(P,4)/8*8+PD(P,1),81+PD(P,5)/8*8,2+PD(P,2)*4+PD(P,3)
  382.   For X=0 To 3
  383.     For Y=0 To 3
  384.       If Y+YY<1 Then Gosub GAMEOVER : Pop : Exit 2
  385.       A=Peek(Start(13)+S*16+X+Y*4)
  386.       If A Then F(P,XX+X+1,YY+Y)=1
  387.     Next 
  388.   Next 
  389. Return 
  390. GAMEOVER:
  391.   Ink 6,0 : Text PD(P,1),111,"GAME OVER!"
  392.   If PD(P,20)>HI(10,0)
  393.     If PL=1 and PD(1-P,24)=3
  394.       Ink 9,0 : Text PD(P,1)+16,167,"PLEASE"
  395.       Ink 9,0 : Text PD(P,1)+24,175,"WAIT"
  396.       PD(P,24)=4 : PD(P,23)=1
  397.       P$(P)="          "
  398.     Else 
  399.       Ink 9,0 : Text PD(P,1),167,"YOU HAVE A"
  400.       Text PD(P,1)+8,175,"HISCORE!"
  401.       Text PD(P,1),183,"ENTER NAME"
  402.       PD(P,24)=3 : PD(P,23)=1
  403.       P$(P)="          "
  404.       Text PD(P,1),199,P$(P)
  405.     End If 
  406.   Else 
  407.     Ink 3,0 : Text PD(P,1),135,"PRESS FIRE"
  408.     Ink 3,0 : Text PD(P,1)+8,143,"TO PLAY!"
  409.     PD(P,24)=1
  410.   End If 
  411. Return 
  412. RETHISCORE2:
  413.   If PD(1-P,24)=3 Then Return 
  414.   Ink 9,0 : Text PD(P,1),167,"YOU HAVE A"
  415.   Text PD(P,1)+8,175,"HISCORE!"
  416.   Text PD(P,1),183,"ENTER NAME"
  417.   Text PD(P,1),199,P$(P)
  418.   PD(P,24)=3
  419. Return 
  420. RETHISCORE:
  421.   POS=PD(P,23)
  422.   If I$="" Then Return 
  423.   If(I$>=" ") and(I$<="Z")
  424.     P$(P)=Left$(P$(P),POS-1)+I$+Right$(P$(P),10-POS)
  425.     POS=Min(POS+1,10)
  426.   End If 
  427.   If I$=Chr$(8)
  428.     POS=Max(POS-1,1)
  429.     P$(P)=Left$(P$(P),POS-1)+" "+Right$(P$(P),10-POS)
  430.     If POS=9 : P$(P)=Left$(P$(P),8)+"  " : End If 
  431.   End If 
  432.   PD(P,23)=POS
  433.   If I$=Chr$(13) Then I$="" : Gosub MAKEENTRY
  434.   Ink 3,0 : Text PD(P,1),199,P$(P)
  435. Return 
  436. MAKEENTRY:
  437.   Ink 3,0 : Text PD(P,1),135,"PRESS FIRE"
  438.   Ink 3,0 : Text PD(P,1)+8,143,"TO PLAY!"
  439.   Ink 0
  440.   For A=0 To 39
  441.     Box A+PD(P,1),161+A To PD(P,1)+79-A,200-A
  442.     If A and 4 Then Multi Wait 
  443.   Next 
  444.   POS=1
  445.   For A=1 To 10
  446.     If HI(A,0)>PD(P,20) Then POS=A+1
  447.   Next 
  448.   For A=11 To POS Step -1
  449.     HI(A,0)=HI(A-1,0) : HI$(A)=HI$(A-1)
  450.   Next 
  451.   A=Rnd(9) : B=(P$(P)="          ")
  452.   If B and A=0 Then P$(P)="BAD LAMER!"
  453.   If B and A=1 Then P$(P)="LOSER GUY!"
  454.   If B and A=2 Then P$(P)="MR.NO NAME"
  455.   If B and A=3 Then P$(P)="AMIGAFREAK"
  456.   If B and A=4 Then P$(P)="HOPELESS!!"
  457.   If B and A=5 Then P$(P)="INVALIDE!!"
  458.   If B and A=6 Then P$(P)="NO-FINGER!"
  459.   If B and A=7 Then P$(P)="HALF-BRAIN"
  460.   If B and A=8 Then P$(P)="MANIAC GUY"
  461.   If B and A=9 Then P$(P)="GHOST-MAN!"
  462.   HI(POS,0)=PD(P,20) : HI$(POS)=P$(P)
  463.   HI(POS,1)=PD(P,21) : HI(POS,2)=SET
  464.   PD(P,24)=1
  465.   Gosub SAVHIS
  466.   Pop 
  467. Return 
  468. DROP:
  469.   If SO Then Extension_8_145A 1,2,8000
  470.   XX=PD(P,4)/8+1 : YY=Max(PD(P,5)/8,0)+1
  471.   For A=0 To 4
  472.     Y=YY : X=XX : D=0
  473.     For C=0 To 19
  474.       B=0
  475.       If F(P,X,Y+1)=0 Then Inc Y : B=1
  476.       If F(P,X+1,Y)=0 and F(P,X+1,Y+1)=0 and B=0 Then Inc X : Inc Y : D=1 : B=1
  477.       If F(P,X-1,Y)=0 and F(P,X-1,Y+1)=0 and B=0 Then Dec X : Inc Y : D=-1 : B=1
  478.       If F(P,X+1,Y)=0 and B=0 and D=1 Then Inc X : B=1
  479.       If F(P,X-1,Y)=0 and B=0 and D=-1 Then Dec X : B=1
  480.       If F(P,X+1,Y) and B=0 and D=1 Then Exit 
  481.       If F(P,X-1,Y) and B=0 and D=-1 Then Exit 
  482.       If F(P,X+1,Y) and F(P,X-1,Y) and F(P,X,Y+1) and B=0 Then Exit 
  483.     Next 
  484.     If F(P,X,Y)=0 Then F(P,X,Y)=1 : Paste Bob X*8+PD(P,1)-8,81+Y*8,74
  485.   Next 
  486. Return 
  487. NEWSTONE:
  488.   B=0
  489.   For Y=2 To 20
  490.     For X=1 To 10
  491.       If F(P,X,Y)=0 Then Exit 
  492.     Next 
  493.     If X=11 Then L(B)=Y : Inc B
  494.   Next 
  495.   If B>3 and SO Then Extension_8_145A 14,3,16000
  496.   If B Then Add PD(P,20),(B*B*150)/HLF Else Add PD(P,20),10/HLF
  497.   If B Then Gosub PUSH
  498.   PD(P,22)=Max(PD(P,22)-B,0)
  499.   If PD(P,22)=0 Then Gosub NEXLEVEL : Return 
  500. NEWSTONE2:
  501.   PD(P,2)=PD(P,11) : PD(P,11)=Rnd(7) : PD(P,3)=0 : PD(P,4)=24 : PD(P,5)=-15 : PD(P,6)=0
  502.   PD(P,12+PD(P,2))=Min(PD(P,12+PD(P,2))+1,35)
  503.   Gosub UPDAT
  504.   X=PD(P,0)+(PD(P,2) mod 4)*16+7
  505.   Y=187+PD(P,2)/4*48-PD(P,12+PD(P,2))
  506.   Ink CD(PD(P,2)) : Plot X+3,Y+1
  507.   Ink CD(PD(P,2))+1 : Plot X+3,Y : Draw X+1,Y+1 To X+2,Y+1
  508.   Ink CD(PD(P,2))+2 : Draw X,Y To X+2,Y
  509.   Colour 25+P*4,Colour(CD(PD(P,2))) : Colour 26+P*4,Colour(CD(PD(P,2))+1)
  510.   Colour 27+P*4,Colour(CD(PD(P,2))+2)
  511.   Ink 0 : Bar 45+PD(P,0),122 To 60+PD(P,0),137
  512.   Paste Bob 45+PD(P,0),122,PD(P,11)+66
  513. Return 
  514. NEXLEVEL:
  515.   For X=1 To 10
  516.     For Y=1 To 20
  517.       If F(P,X,Y) Then Exit 
  518.       Paste Bob X*8+PD(P,1)-8,81+Y*8,74
  519.       If SO Then Extension_8_145A 1,1,16000
  520.       Add PD(P,20),2/HLF
  521.       T$=Str$(PD(P,20))-" "
  522.       T$=String$("0",5-Len(T$))+T$
  523.       Ink 3,0 : Text PD(P,0)+12,97,T$
  524.     Next 
  525.     Multi Wait 
  526.   Next 
  527.   Timer=0
  528.   Ink 3,0 : Text PD(P,1)+20,143,"LEVEL"
  529.   Text PD(P,1),159,"COMPLETED!"
  530.   Add PD(P,20),PD(P,21)*200/HLF
  531.   Gosub UPDAT
  532.   BAAA=0
  533.   Repeat 
  534.     Add BAAA,1,0 To 3
  535.     If SO Then Extension_8_145A 1,5,PD(P,9)*12+4000
  536.     R=8 : Gosub ENERGY
  537.     Add PD(P,20),(PD(P,21)-1)/HLF+1
  538.     T$=Str$(PD(P,20))-" "
  539.     T$=String$("0",5-Len(T$))+T$
  540.     Ink 3,0 : Text PD(P,0)+12,97,T$
  541.     If BAAA=0 Then Multi Wait 
  542.   Until PD(P,9)=8
  543.   PD(P,24)=2 : PD(P,25)=0
  544. Return 
  545. RETNEXTLEV:
  546.   Gosub CLEARFIELD2
  547.   Inc PD(P,21)
  548.   PD(P,22)=PD(P,21)*5+5
  549.   PD(P,23)=Min(PD(P,23)+1,8)
  550.   If(PD(P,21) and 1) and(PD(P,21)>3) Then Inc PD(P,26)
  551.   Gosub NEWSTONE2
  552. Return 
  553. UPDAT:
  554.   T$=Str$(PD(P,20))-" "
  555.   T$=String$("0",5-Len(T$))+T$
  556.   Ink 3,0 : Text PD(P,0)+12,97,T$
  557.   T$=Str$(PD(P,21))-" "
  558.   If PD(P,21)<10 Then T$="0"+T$
  559.   Ink 18,0 : Text PD(P,0)+25,115,T$
  560.   T$=Str$(PD(P,22))-" "
  561.   If PD(P,22)<10 Then T$="0"+T$
  562.   Ink 9,2 : Text PD(P,1),86,"LINES - "+T$
  563. Return 
  564. DAMAGE:
  565.   For C=1 To 49
  566.     XX=Rnd(9)+1 : YY=Rnd(18)+2
  567.     If F(1-P,XX,YY)
  568.       F(1-P,XX,YY)=0
  569.       Ink 0
  570.       For C=0 To 3
  571.         If SO : Extension_8_145A 1,5,10000 : End If 
  572.         Box PD(1-P,1)+XX*8-8+C,81+YY*8+C To PD(1-P,1)+XX*8-1-C,88+YY*8-C
  573.         Multi Wait 
  574.       Next 
  575.       Exit 
  576.     End If 
  577.   Next 
  578. Return 
  579. PUSH:
  580.   If SO Then Extension_8_145A 1,4,16000
  581.   Colour 25+P*4,$444
  582.   For A=0 To B-1
  583.     Ink 25+P*4 : Bar PD(P,1),81+L(A)*8 To PD(P,1)+79,88+L(A)*8
  584.   Next 
  585.   For A=$444 To $FFF Step $111
  586.     Colour 25+P*4,A : Wait 2
  587.   Next 
  588.   Wait 4
  589.   For A=$FFF To 0 Step -$111
  590.     Colour 25+P*4,A : Multi Wait 
  591.   Next 
  592.   For A=0 To B-1
  593.     If PL=1 and PD(1-P,24)=0 Then Gosub DAMAGE
  594.     For C=L(A)-1 To 1 Step -1
  595.       For X=1 To 10
  596.         F(P,X,C+1)=F(P,X,C)
  597.       Next 
  598.     Next 
  599.     Screen Copy 0,PD(P,1),89,PD(P,1)+80,81+L(A)*8 To 0,PD(P,1),97
  600.     Screen Copy 1,197,PD(P,10)*8+9,277,PD(P,10)*8+17 To 0,PD(P,1),89
  601.     Add PD(P,10),-1,0 To 13
  602.   Next 
  603. Return 
  604. CLEARFIELD:
  605.   PD(P,20)=0 : PD(P,9)=8 : PD(P,21)=1 : PD(P,22)=10 : PD(P,23)=1 : PD(P,26)=1
  606. CLEARFIELD2:
  607.   PD(P,24)=0 : PD(P,10)=13 : PD(P,11)=Rnd(7)
  608.   For A=12 To 19 : PD(P,A)=0 : Next 
  609.   Ink 0 : Bar PD(P,0)+153,88 To PD(P,0)+154,248
  610.   Screen Copy 1,SET*64-64,0,SET*64,170 To 0,PD(P,0),80
  611.   Screen Copy 1,192,0,284,170 To 0,PD(P,0)+64,80
  612.   For X=1 To 10
  613.     For Y=0 To 20
  614.       F(P,X,Y)=0
  615.     Next 
  616.   Next 
  617.   For X=0 To 11
  618.     F(P,X,21)=1
  619.   Next 
  620.   For Y=0 To 21
  621.     F(P,0,Y)=1 : F(P,11,Y)=1
  622.   Next 
  623.   Gosub UPDAT
  624. Return 
  625. ERR:
  626.   Resume Next 
  627. Data 7,4,10,19,13,22,1,16
  628. Procedure T[T$,Y,C]
  629.   X=160-Len(T$)*4
  630.   Ink C*3+1 : Text X+1,Y+7,T$
  631.   Ink C*3+3 : Text X,Y+6,T$
  632. End Proc
  633. Procedure WAI[T]
  634.   For AAA=1 To T : Multi Wait : Next 
  635. End Proc