home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 001-025 / apd021 / pacman.amos / pacman.amosSourceCode
AMOS Source Code  |  1990-10-26  |  11KB  |  361 lines
  1. Screen Open 0,320,256,16,Lowres
  2. Dim S(6,1),HS(5),NA$(5),B(27,30),G(5,3) : Dir$="apd21:Pacman/"
  3. Global S(),G(),B(),X,Y,TM,SC,LI,TR,LE,JJ,DR,NA$(),HS(),MEG,XG,YG
  4. Randomize Timer
  5. TITLE_PAGE
  6. '
  7. 'The following are the actual procedures that do all the work!!! 
  8. '
  9. Procedure TITLE_PAGE
  10. Erase 1
  11. Erase 5
  12. Erase 7
  13. Erase 6
  14. If Chip Free>250000
  15.    MEG=True
  16.    For J=1 To 6 : S(J,0)=J : S(J,1)=8000 : Next J
  17.    S(1,1)=12000 : S(2,1)=12000 : S(4,1)=12000 : S(3,1)=6500
  18. Else 
  19.    MEG=False
  20.    For J=1 To 6 : S(J,0)=1 : S(J,1)=(J+5)*1000 : Next J
  21. End If 
  22. If MEG
  23.    Reserve As Work 1,6000
  24.    Reserve As Work 5,70000
  25.    Reserve As Work 6,20000
  26.    Reserve As Work 7,9000
  27.    Load "pacsam.abk"
  28.    Load "pacbac.abk",7
  29.    Load "gameover.abk",6
  30. Else 
  31.    Load "pacsam512.abk"
  32. End If 
  33. Open In 1,"Pacscore"
  34. For J=1 To 5
  35.    Input #1,HS(J),NA$(J)
  36. Next J
  37. Close 1
  38. Paper 0 : Cls : Curs Off : Flash Off : Hide On 
  39. Load "pacman.abk"
  40. Do 
  41. If MEG
  42. Locate 5,5 : Unpack 7 To 0
  43. Flash 2,"(ff0,10)(dd0,10)(bb0,10)(880,10)(660,10)(440,10)(220,10)"
  44. Flash 10,"(00f,5)(000,5)"
  45. For LOP=1 To 4 : Channel LOP To Bob LOP : Next LOP
  46. Bob 1,96,146,2
  47. Bob 2,96,166,3
  48. Bob 3,50,186,40 : Anim 3,"(40,10)(41,10)l" : Move X 3,"(1,1,80)(1,-1,80)l"
  49. Move On : Anim On 
  50. Bob 4,96,208,54
  51. Else 
  52.    Cls : Locate 0,14 : Centre "Press Fire"
  53. End If 
  54. Clear Key : Do : If(Mouse Key=0) and Not(Fire(1)) : Exit : End If : Loop 
  55. Do 
  56. If(Mouse Key) or(Fire(1)) or(Inkey$<>"") : Exit : End If 
  57. Loop 
  58. LI=3 : LE=30 : SC=0
  59. BACK_GROUND
  60. SET_UP_VALUES
  61. Do 
  62. MOVE_MAN
  63. CHECK_STATUS
  64. If LI<0 : Goto BEGIN : End If 
  65. MOVE_THEM
  66. CHECK_POSITION
  67. SCORE
  68. If Mouse Key=2 : End : End If 
  69. Loop 
  70. BEGIN:
  71. GAME_OVER
  72. Loop 
  73. End Proc
  74. Procedure BACK_GROUND
  75. Screen Open 0,320,240,16,Lowres : Paper 0 : Cls 
  76. Screen Open 1,320,10,2,Lowres : Paper 0 : Cls : Colour 1,$FFF : Curs Off : Hide On 
  77. Print At(6,0);"SCORE:";At(22,0);"LIVES:";
  78. Screen Display 0,128,40,320,250
  79. Screen Display 1,128,280,320,10
  80. Screen 0
  81. Curs Off : Hide On : Sprite Off 
  82. Palette $0,$FFF,,$888,,$FC0,$F00,$F0,$FF,$8F,,,,,0,$FFF,,,,,,$FC0
  83. Flash Off 
  84. Flash 2,"(ff0,10)(dd0,10)(aa0,10)(880,10)(660,10)(440,10)(220,10)"
  85. Flash 10,"(00f,5)(002,5)"
  86. Restore 
  87. For K=1 To 29 : For J=1 To 26
  88. Read B(J,K) : Paste Bob 32+J*8,(K-1)*8,B(J,K)
  89. Next J : Next K : For J=1 To 29 : B(0,J)=10 : B(27,J)=10 : Next J
  90. Screen Copy Physic(0),0,0,320,250 To Logic(0),0,0
  91. Double Buffer : Autoback 1
  92. Data 4,5,5,5,5,5,5,5,5,5,5,5,6,7,5,5,5,5,5,5,5,5,5,5,5,8
  93. Data 9,2,2,2,2,2,2,2,2,2,2,2,10,11,2,2,2,2,2,2,2,2,2,2,2,9
  94. Data 9,2,12,13,13,14,2,12,13,13,14,2,10,11,2,12,13,13,14,2,12,13,13,14,2,9
  95. Data 9,3,11,1,1,10,2,11,1,1,10,2,10,11,2,11,1,1,10,2,11,1,1,10,3,9
  96. Data 9,2,15,16,16,17,2,15,16,16,17,2,18,19,2,15,16,16,17,2,15,16,16,17,2,9
  97. Data 9,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,9
  98. Data 9,2,28,16,16,26,2,20,21,2,28,16,16,16,16,26,2,20,21,2,28,16,16,26,2,9
  99. Data 9,2,27,13,13,25,2,10,11,2,27,13,14,12,13,25,2,10,11,2,27,13,13,25,2,9
  100. Data 9,2,2,2,2,2,2,10,11,2,2,2,10,11,2,2,2,10,11,2,2,2,2,2,2,9
  101. Data 22,5,5,5,5,8,2,10,15,16,26,2,10,11,2,28,16,17,11,2,4,5,5,5,5,23
  102. Data 1,1,1,1,1,9,2,10,12,13,25,2,18,19,2,27,13,14,11,2,9,1,1,1,1,1
  103. Data 1,1,1,1,1,9,2,10,11,2,2,2,1,1,2,2,2,10,11,2,9,1,1,1,1,1
  104. Data 5,5,5,5,5,23,2,18,19,2,4,5,24,24,5,8,2,18,19,2,22,5,5,5,5,5
  105. Data 1,1,1,1,1,1,2,2,2,2,9,1,1,1,1,9,2,2,2,2,1,1,1,1,1,1
  106. Data 5,5,5,5,5,8,2,20,21,2,22,5,5,5,5,23,2,20,21,2,4,5,5,5,5,5
  107. Data 1,1,1,1,1,9,2,10,11,2,2,2,2,2,2,2,2,10,11,2,9,1,1,1,1,1
  108. Data 1,1,1,1,1,9,2,10,11,2,28,16,16,16,16,26,2,10,11,2,9,1,1,1,1,1
  109. Data 4,5,5,5,5,23,2,18,19,2,27,13,14,12,13,25,2,18,19,2,22,5,5,5,5,8
  110. Data 9,2,2,2,2,2,2,2,2,2,2,2,10,11,2,2,2,2,2,2,2,2,2,2,2,9
  111. Data 9,2,28,16,16,29,2,28,16,16,26,2,10,11,2,28,16,16,26,2,30,16,16,26,2,9
  112. Data 9,2,27,13,14,11,2,27,13,13,25,2,18,19,2,27,13,13,25,2,10,12,13,25,2,9
  113. Data 9,3,2,2,10,11,2,2,2,2,2,2,2,2,2,2,2,2,2,2,10,11,2,2,3,9
  114. Data 31,16,26,2,10,11,2,20,21,2,28,16,16,16,16,26,2,20,21,2,10,11,2,28,16,32
  115. Data 33,13,25,2,18,19,2,10,11,2,27,13,14,12,13,25,2,10,11,2,18,19,2,27,13,34
  116. Data 9,2,2,2,2,2,2,10,11,2,2,2,10,11,2,2,2,10,11,2,2,2,2,2,2,9
  117. Data 9,2,28,16,16,16,16,17,15,16,26,2,10,11,2,28,16,17,15,16,16,16,16,26,2,9
  118. Data 9,2,27,13,13,13,13,13,13,13,25,2,18,19,2,27,13,13,13,13,13,13,13,25,2,9
  119. Data 9,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,9
  120. Data 22,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,23
  121. End Proc
  122. Procedure SET_UP_VALUES
  123. Make Mask 
  124. For J=1 To 6 : Channel J To Bob J : Next J
  125. X=12 : Y=22 : JJ=0
  126. For J=2 To 5
  127.    G(J,0)=J : G(J,1)=Rnd(21)+2 : G(J,2)=6 : G(J,3)=Rnd(3)
  128. Next J
  129. Sprite 8,X Hard(0,31+X*8),Y Hard(0,(Y-1)*8-2),35
  130. For J=2 To 5 : G$="("+Str$((J-2)*7+38)+",10)("+Str$((J-2)*7+39)+",10)L"
  131. XG=G(J,1)*8+31 : YG=(G(J,2)-1)*8-2
  132. SP=J : SPN=(J-2)*7+38
  133. Bob SP,XG,YG,SPN : Anim J,G$ : Next J
  134. Anim 8,"(35,5)(36,5)(37,5)(36,5)L" : Anim On 
  135. DR=1
  136. End Proc
  137. Procedure MOVE_MAN
  138. If(Jup(1)) and(B(X,Y-1)<4) : DR=3 : Goto ECDIR : End If 
  139. If(Jdown(1)) and(B(X,Y+1)<4) : DR=4 : Goto ECDIR : End If 
  140. If(Jleft(1)) and(B(X-1,Y)<4) : DR=2 : Goto ECDIR : End If 
  141. If(Jright(1)) and(B(X+1,Y)<4) : DR=1 : Goto ECDIR : End If 
  142. ECDIR:
  143. If(DR=1) and(B(X+1,Y)<4) : Amal 8,"M 8,0,8" : Amal On 8 : Inc X : End If 
  144. If(DR=1) and(X=26) : X=0 : Sprite 8,X Hard(0,31),Y Hard(0,(Y-1)*8-2),35
  145.    Goto ECDIR : End If 
  146. If(DR=2) and(B(X-1,Y)<4) : Amal 8,"M -8,0,8" : Amal On 8 : Dec X : End If 
  147. If(DR=2) and(X=1) : X=26 : Sprite 8,X Hard(0,31+X*8),Y Hard(0,(Y-1)*8-2),42
  148.    Goto ECDIR : End If 
  149. If(DR=3) and(B(X,Y-1)<4) : Amal 8,"M 0,-8,8" : Amal On 8 : Dec Y : End If 
  150. If(DR=4) and(B(X,Y+1)<4) : Amal 8,"M 0,8,8" : Amal On 8 : Inc Y : End If 
  151. If DR<>DR1
  152.    If DR=1 : Anim 8,"(35,5)(36,5)(37,5)(36,5)L" : Anim On 8 : End If 
  153.    If DR=2 : Anim 8,"(42,5)(43,5)(44,5)(43,5)L" : Anim On 8 : End If 
  154.    If DR=4 : Anim 8,"(49,5)(50,5)(51,5)(50,5)L" : Anim On 8 : End If 
  155.    If DR=3 : Anim 8,"(56,5)(57,5)(58,5)(57,5)L" : Anim On 8 : End If 
  156. End If 
  157. DR1=DR
  158. End Proc
  159. Procedure MOVE_THEM
  160. For J=2 To 5
  161. If(G(J,0)>0) and(Rnd(50)>LE)
  162. XG=G(J,1) : YG=G(J,2) : DG=G(J,3)
  163. If TM<>0
  164. DG=Rnd(3)
  165. Else 
  166. OP=1 : If Rnd(50)>25 : Goto SECOND : End If 
  167. FIRST:
  168. If(XG<X) and(B(XG+1,YG)<4) : DG=1 : Goto EXI : End If 
  169. If(XG>X) and(B(XG-1,YG)<4) : DG=2 : Goto EXI : End If 
  170. Dec OP : If OP=-1 : Goto EXI : End If 
  171. SECOND:
  172. If(YG>Y) and(B(XG,YG-1)<4) : DG=3 : Goto EXI : End If 
  173. If(YG<Y) and(B(XG,YG+1)<4) : DG=4 : Goto EXI : End If 
  174. Dec OP : If OP=0 : Goto FIRST : End If 
  175. EXI:
  176. End If 
  177. If(DG=1) and(B(XG+1,YG)<4) : Amal J,"M 8,0,8" : Inc XG : End If 
  178. If(DG=2) and(B(XG-1,YG)<4) : Amal J,"M -8,0,8" : Dec XG : End If 
  179. If(DG=3) and(B(XG,YG-1)<4) : Amal J,"M 0,-8,8" : Dec YG : End If 
  180. If(DG=4) and(B(XG,YG+1)<4) : Amal J,"M 0,8,8" : Inc YG : End If 
  181. G(J,1)=XG : G(J,2)=YG : G(J,3)=DG
  182. Amal On J
  183. End If 
  184. Next J
  185. End Proc
  186. Procedure CHECK_STATUS
  187. If TM<>0 : Dec TM : If TM=0
  188. For J=2 To 5
  189.    G$="("+Str$((J-2)*7+38)+",10)("+Str$((J-2)*7+39)+",10)L"
  190.    Anim J,G$ : Anim On J
  191. Next J
  192. End If : End If 
  193. For J=2 To 5 : If G(J,0)>0
  194. If Bobsprite Col(J,8 To 8)=-1 : G(J,0)=-1 : End If 
  195. End If : Next J
  196. If TM>0
  197. For J=2 To 5
  198. If G(J,0)=-1 : G(J,0)=-2 : Add SC,500
  199.    Sam Play 6,S(2,0),S(2,1)
  200. GHOST_RET[J] : End If 
  201. Next J
  202. End If 
  203. For J=2 To 5
  204. If G(J,0)=-2 and(Chanmv(J)=0) and(TM=0)
  205. G(J,0)=J : REPLACE_GHOST[J]
  206. End If 
  207. Next J
  208. If TM=0
  209.    Z=0
  210.    For J=2 To 5
  211.    If G(J,0)=-1 : Z=-1 : End If 
  212.    Next J : If Z : Dec LI
  213.       If LI<0 : Pop Proc : Else Boom : BACK_GROUND : SET_UP_VALUES
  214.       End If 
  215.    End If 
  216. End If 
  217. If(TR=0) and(Rnd(99)>97) : Bob 6,12*8+38,15*8,Rnd(1)+54 : TR=30 : End If 
  218. If TR<>0 : Dec TR : If TR=0 : Bob Off 6 : End If 
  219. If Spritebob Col(8,6 To 6)=-1 : Add SC,1000
  220.    Sam Play 6,S(4,0),S(4,1)
  221. Bob Off 6
  222. TR=0 : End If 
  223. End If 
  224. End Proc
  225. Procedure CHECK_POSITION
  226. If B(X,Y)=2 : B(X,Y)=1
  227. Volume 9,10 : Play 9,25,0
  228. Autoback 2 : Paste Bob 32+X*8,(Y-1)*8,62 : Add SC,10 : Autoback 1
  229. Add JJ,1
  230. End If 
  231. If B(X,Y)=3 : B(X,Y)=1
  232.     Sam Play 6,S(1,0),S(1,1)
  233. Add SC,100
  234. Add JJ,1 : For J=2 To 5 : Anim J,"(40,10)(41,10)L" : Anim On J : Next J
  235. TM=25 : Autoback 2 : Paste Bob 32+X*8,(Y-1)*8,62 : Autoback 1
  236. End If 
  237. If JJ=260 : LEVEL_INC : End If 
  238. End Proc
  239. Procedure GHOST_RET[J]
  240. Anim J,"(47,10)(48,10)L" : Anim On J
  241. DX=142-X Bob(J) : DY=109-Y Bob(J)
  242. G$="A 0,(47,10)(48,10); M"+Str$(DX)+","+Str$(DY)+",50"
  243. Amal J,G$
  244. Amal On J
  245. End Proc
  246. Procedure REPLACE_GHOST[J]
  247. Amal Off J
  248. G(J,1)=12 : G(J,2)=12 : G(J,0)=J
  249. Bob J,G(J,1)*8+31,(G(J,2)-1)*8-2,(J-2)*7+38
  250. Anim J,"("+Str$((J-2)*7+38)+",10)("+Str$((J-2)*7+39)+",10)L"
  251. Anim On J
  252. End Proc
  253. Procedure LEVEL_INC
  254. Add SC,2000
  255.    Sam Play 6,S(3,0),S(3,1)
  256. Add LE,-8 : If LE<0 : LE=0 : End If 
  257. BACK_GROUND : SET_UP_VALUES
  258. End Proc
  259. Procedure SCORE
  260. Screen 1
  261. Print At(12,0); Using "######";SC;
  262. Print At(28,0); Using "##";LI;
  263. Screen 0
  264. For J=1 To 6
  265. Repeat : Until Not Chanmv(J)
  266. Next J
  267. Repeat : Until Not Chanmv(8)
  268. End Proc
  269. Procedure GAME_OVER
  270. Sam Play 6,S(6,0),S(6,1)
  271. Sprite Off 
  272. Screen Close 0
  273. Screen Open 0,320,256,16,Lowres
  274. Paper 0 : Pen 2 : Cls : Flash Off : Curs Off : Hide On 
  275. EX=False
  276. For J=5 To 1 Step -1
  277.    If SC>HS(J) : EX=True : LE=J : End If 
  278. Next J
  279. If EX=False : Goto NBIT : End If 
  280. For J=5 To LE Step -1 : HS(J)=HS(J-1) : NA$(J)=NA$(J-1) : Next J
  281. Print At(8,15)+Border$(At(34,17),1)
  282. NAME_GET : NA$(LE)=Param$
  283. HS(LE)=SC
  284. Open Out 1,"Pacscore"
  285.    For J=1 To 5
  286.       Print #1,HS(J);",";NA$(J);",";
  287.    Next J
  288.    Print #1," "
  289. Close 1
  290. NBIT:
  291. Paper 0 : Cls : Curs Off : Flash Off 
  292. If MEG
  293.    Locate 6,6 : Unpack 6 To 0
  294. Else 
  295.    Locate 0,14 : Centre("High Score Table")
  296.    Locate 0,10 : Centre("GAME OVER")
  297. End If 
  298. Ink 5,0,0
  299. For J=1 To 5
  300.    A$=Mid$(Str$(HS(J)),2)
  301.    A$=Right$("000000"+A$,6)
  302.    Text 36,(19*J)+137,A$
  303.    Text 100,(19*J)+137,Left$(NA$(J)+Space$(28),21)
  304. Next J
  305. Clear Key 
  306. Do : If(Mouse Key=0) and(Fire(1)=0) : Exit : End If : Loop 
  307. Do : If(Mouse Key) or(Inkey$<>"") or(Fire(1)) : Exit : End If : Loop 
  308. End Proc
  309. Procedure NAME_GET
  310. Screen Open 0,320,200,2,Lowres : Show On 
  311. Colour 1,$FFF : Curs Off 
  312. Reserve Zone 29
  313. For J=1 To 26 Step 10
  314.    For K=0 To 9
  315.       If J+K<27
  316.          Print At(K*3+5,(J/10)*3+5);Zone$(Border$(Chr$(64+J+K),1),J+K);
  317.       End If 
  318.    Next K
  319. Next J
  320. Limit Mouse 150,70 To 400,150
  321. Print At(23,11);Zone$(Border$("_",1),27)
  322. Print At(26,11);Zone$(Border$("<<",1),28)
  323. Print At(30,11);Zone$(Border$("*",1),29)
  324. Print At(9,14);Border$(At(29,16),1)
  325. A$=""
  326. Do 
  327. Do 
  328. Z=Mouse Zone
  329. If Z>0 and Z<27
  330.    Dec Z : J=Z/10 : K=Z-(Z/10*10)
  331.    Inverse On : Print At(K*3+5,J*3+5);Border$(Chr$(65+J*10+K),1);
  332.    Repeat : Until Mouse Zone<>Z+1 or Mouse Key<>0
  333.    Inverse Off : Print At(K*3+5,J*3+5);Border$(Chr$(65+J*10+K),1);
  334.    Inc Z
  335. End If 
  336. If Z>26 and Z<30 : 
  337.    Inverse On 
  338.    If Z=27 : Print At(23,11);Border$("_",1); : End If 
  339.    If Z=28 : Print At(26,11);Border$("<<",1); : End If 
  340.    If Z=29 : Print At(30,11);Border$("*",1); : End If 
  341.    Repeat : Until Mouse Zone<>Z or Mouse Key<>0
  342.    Inverse Off 
  343.    If Z=27 : Print At(23,11);Border$("_",1); : End If 
  344.    If Z=28 : Print At(26,11);Border$("<<",1); : End If 
  345.    If Z=29 : Print At(30,11);Border$("*",1); : End If 
  346. End If 
  347. If Mouse Key<>0 and Z<>0 : Exit : End If 
  348. Loop 
  349. If(Z>0) and(Z<27) and(Len(A$)<20) : A$=A$+Chr$(64+Z) : End If 
  350. If(Z=27) and(Len(A$)<20) : A$=A$+" " : End If 
  351. If(Z=28) and(Len(A$)>1) : A$=Left$(A$,Len(A$)-1) : End If 
  352. If(Z=29) : Exit : End If 
  353. Print At(9,15);Space$(20)
  354. Print At(9,15);A$
  355. Bell 30+Z : Wait 5
  356. Repeat : Until Mouse Key=0
  357. Loop 
  358. If A$="" : A$="**John Dough**" : End If 
  359. A#=Len(A$)/2.0 : A$=Left$(Space$(20),10-A#)+A$ : A$=Left$(A$+Space$(20),20)
  360. Cls 
  361. End Proc[A$]