home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 326-350 / apd343 / savethetrees.amos / savethetrees.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-06-13  |  11.3 KB  |  588 lines
  1. Default 
  2. Make Mask 
  3. Priority On 
  4. Reserve Zone 6
  5. Dim NAST(3),TREE(5,2)
  6. Global LIVES,SCORE,FON,MUS,NAST(),DIFF,TREE(),TERMINATE,UPD
  7. Proc INIT
  8. Procedure INIT
  9. Flash Off 
  10. Curs Off 
  11. Hide On 
  12. Double Buffer 
  13. Bob Update Off 
  14. Cls 0
  15. Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  16. Pen 5 : Paper 0
  17. Locate 0,0
  18. Centre "Please note" : Print 
  19. Centre "If you have access to any young trees" : Print 
  20. Centre "And it's still before the end of Nov.91" : Print 
  21. Centre "Please consider donating a sapling" : Print 
  22. Centre "In order to help improve the environment" : Print 
  23. Centre "Send donations to" : Print 
  24. Centre "Thirsk school,Topcliffe road,Thirsk" : Print 
  25. Centre "North Yorkshire,England" : Print 
  26. Centre "We're running a tree " : Print 
  27. Centre "distribution project" : Print 
  28. Centre "To improve the environment" : Print 
  29. Centre "Please enjoy this game" : Print 
  30. Centre "Produced using AMOS" : Print 
  31. Fade 15 To -1
  32. Wait 600
  33. End Proc
  34. 1
  35. Proc TITLE[0]
  36. Goto 2
  37. NULEV: Proc TITLE[1]
  38. Procedure TITLE[N]
  39. If N=1 Then Goto SKIP
  40. Autoback 2
  41. Fade 10
  42. Wait 150
  43. Music 1
  44. For T=1 To 4
  45. Sprite T+7,(T*65)+120,245,1
  46. Channel T-1 To Sprite T+7
  47. Amal T-1,"A0,(1,5)(7,5);L:M0,-40,"+Str$((T*5)+10)+";M0,40,"+Str$((T*5)+20)+";JL"
  48. Amal On T-1
  49. Next T
  50. 3
  51. Cls 0
  52. Paste Bob 135,150,44
  53. For X=0 To 1
  54. For Y=0 To 5
  55. Paste Bob X*280,Y*32,Rnd(1)+24
  56. Next Y
  57. Next X
  58. Locate 0,10
  59. Centre "Save The Trees"
  60. Locate 0,12
  61. Centre "By Mark Potter"
  62. Print : Centre "press fire to play"
  63. Print : Centre "T=toggle Music/Fx"
  64. Print : Centre "C=Controls"
  65. Fade 15 To -1
  66. Wait 255
  67. For T=0 To 15
  68. Colour(T+16),Colour(T)
  69. Next T
  70. MUS=1
  71. While Fire(1)=0 : Paste Bob Rnd(200)+50,Rnd(50),Rnd(1)+24
  72. I$=Upper$(Inkey$)
  73. If I$="T"
  74. MUS=1-MUS
  75. Locate 0,16
  76. If MUS=1
  77. Centre "MUSIC"
  78. Else 
  79. Centre "SOUND"
  80. End If 
  81. End If 
  82. If I$="C"
  83. Cls 0
  84. Locate 0,0
  85. Print "controls:"
  86. Print "up/down/left/right=obvious"
  87. Print "fire while stationary=raise/lower scoop"
  88. Print "fire while moving=fire missile"
  89. Print "(if scoop is up)"
  90. Print "P=Pause game-anykey restarts"
  91. Wait Key 
  92. Goto 3
  93. End If 
  94. Wend 
  95. Amal Off 
  96. Sprite Off 
  97. Cls 0
  98. LIVES=3 : SCORE=0 : FON=0 : TERMINATE=0 : UPD=0 : DIFF=0
  99. SKIP:
  100. Bob 0,160,50,1
  101. Channel 0 To Bob 0
  102. A$="LRA=0;LR1=0;S:P;LR0=J1;IR0=1JU;IR0=8JR;IR0=2JD;IR0=4JL;IR0=16JC;JS"
  103. A$=A$+";C:P;IR1=0JB;LR1=0;LA=A-6;M0,0,5;JS;B:LR1=6;LA=A+6;M0,0,5;JS"
  104. A$=A$+";U:IY<1JS;LRB=1;A0,(1+R1,3)(2+R1,3);W:P;LR0=J1;M0,-2,1;IY<1JT;IR0<>1JM;JW;M:IR0<16JT;LRA=1;JW"
  105. A$=A$+";R:IX>319JS;LRB=2;A0,(5+R1,3)(6+R1,3);X:P;LR0=J1;M2,0,1;IX>319JT;IR0<>8JN;JX;N:IR0<16JT;LRA=1;JX"
  106. A$=A$+";D:IY>199JS;LRB=3;A0,(3+R1,3)(4+R1,3);Y:P;LR0=J1;M0,2,1;IY>199JT;IR0<>2JO;JY;O:IR0<16JT;LRA=1;JY"
  107. A$=A$+";L:IX<1JS;LRB=4;A0,($8000+R1+5,3)($8000+R1+6,3);V:P;LR0=J1;M-2,0,1;IX<1JT;IR0<>4JQ;JV;Q:IR0<16JT;LRA=1;JV"
  108. A$=A$+";T:LR2=A;A1,(R2,1);JS"
  109. Amal 0,A$
  110. Amal On 0
  111. For T=1 To 6
  112. Bob T,Rnd(200)+60,Rnd(60)+90,22
  113. Set Zone T,X Bob(T)-5,Y Bob(T)-5 To X Bob(T)+5,Y Bob(T)+5
  114. TREE(T-1,0)=X Bob(T)
  115. TREE(T-1,1)=Y Bob(T)
  116. TREE(T-1,2)=100
  117. Channel T+5 To Bob T
  118. Amal T+5,"LR0=0:A1,(22,2000)(24,1000)(25,1000);M0,0,4000;LR0=1"
  119. Amal On T+5
  120. Amreg(T+5,0)=0
  121. Next T
  122. If MUS=0 Then Music Off 
  123. Autoback 0
  124. Amreg(25)=0
  125. UPD=2
  126. For T=0 To 3
  127. NAST(T)=0
  128. Next T
  129. End Proc
  130. 2
  131. Do 
  132. Bob Clear 
  133. Proc CHECKFIRE
  134. Proc NAST
  135. Proc ROVER
  136. Proc HITNME
  137. Proc CUTDOWN
  138. Proc WHOOPS
  139. If UPD>0 Then Dec UPD : Pen 1 : Paper 0 : Locate 0,23 : Print LIVES;"   ";SCORE;"      "
  140. If TERMINATE=2 or LIVES=0 Then Bob Update On : Wait 50 : Bob Update Off : Proc GAMEOVER : Goto 1
  141. If TERMINATE=1 Then Inc TERMINATE
  142. If Amreg(25)>0 Then Amreg(25)=Amreg(25)-1
  143. For T=0 To 5
  144. If TREE(T,2)>0
  145. If Amreg(T+6,0)=1
  146. Proc WONSCREEN : Goto NULEV
  147. End If 
  148. End If 
  149. Next T
  150. If Upper$(Inkey$)="P" Then Amal Freeze : Wait Key : Amal On 
  151. Bob Draw 
  152. Screen Swap 
  153. Wait Vbl 
  154. Loop 
  155. Procedure CHECKFIRE
  156. If Amreg(0)=1 and Amreg(0,1)=6
  157. If FON=0
  158. FON=1
  159. A=Amreg(1)
  160. If A=1
  161. B=13 : V=-4 : H=0
  162. End If 
  163. If A=2
  164. B=16 : V=0 : H=4
  165. End If 
  166. If A=3
  167. B=14 : V=4 : H=0
  168. End If 
  169. If A=4
  170. B=15 : V=0 : H=-4
  171. End If 
  172. Sprite 8,X Hard(X Bob(0)),Y Hard(Y Bob(0)),B
  173. Channel 1 To Sprite 8
  174. Amal 1,"LR0=0;L:M"+Str$(H)+","+Str$(V)+",1;IX>450JM;IX<126JM;IY<48JM;IY>252JM;P;JL;M:LR0=1"
  175. Amal On 1
  176. If MUS=0
  177. Sam Raw %1111,Start(12),13086,10000
  178. End If 
  179. Else 
  180. Amreg(0)=0
  181. End If 
  182. End If 
  183. If FON=1
  184. If Amreg(1,0)=1
  185. FON=0 : Sprite Off 8
  186. End If 
  187. End If 
  188. End Proc
  189. Procedure NAST
  190. Amreg(23)=X Bob(0)
  191. Amreg(24)=Y Bob(0)
  192. For T=0 To 3
  193. If NAST(T)=-1
  194. If Amreg(T+2,9)=1
  195. NAST(T)=0
  196. Bob T+10,-50,-50,
  197. End If 
  198. End If 
  199. Next T
  200. CCC=0
  201. If DIFF>2 Then CCC=2
  202. For T=CCC To 3
  203. If NAST(T)=4
  204. If Amreg(T+2,3)>0
  205. A=Amreg(T+2,3)
  206. Y=0
  207. If A=1
  208. N=36 : Y=-10
  209. End If 
  210. If A=2
  211. N=35
  212. End If 
  213. If A=3
  214. N=37
  215. End If 
  216. If A=4
  217. N=34
  218. End If 
  219. Bob T+8,X Bob(T+10),Y Bob(T+10)+Y,N
  220. Channel T To Bob T+8
  221. Amal T,""
  222. Amal On T
  223. Amreg(T,9)=1
  224. NAST(T-2)=-1
  225. End If 
  226. End If 
  227. If NAST(T)=5
  228. If Amreg(T+2,3)>0
  229. A=Amreg(T+2,3)
  230. If A=1
  231. N=13
  232. End If 
  233. If A=2
  234. N=16
  235. End If 
  236. If A=3
  237. N=14
  238. End If 
  239. If A=4
  240. N=15
  241. End If 
  242. Bob T+8,X Bob(T+10),Y Bob(T+10),N
  243. Channel T To Bob T+8
  244. Amal T,"M0,0,1;IR0=1JU;IR0=2JR;IR0=3JD;IR0=4JL;U:A1,(13,1);M0,-250,100;JT;L:A1,(15,1);M-350,0,150;JT;D:A1,(14,1);M0,250,100;JT;R:A1,(16,1);M350,0,150;T:LX=-10;LY=-10;LR9=1;LA=33"
  245. Amal On T
  246. Amreg(T,0)=A
  247. NAST(T-2)=-1
  248. End If 
  249. End If 
  250. If NAST(T)>0
  251. If Amreg(T+2,2)<6
  252. Amreg(T+2,0)=TREE(Amreg(T+2,2),0)
  253. Amreg(T+2,1)=TREE(Amreg(T+2,2),1)
  254. Else 
  255. Amreg(T+2,0)=X Bob(0)
  256. Amreg(T+2,1)=Y Bob(0)
  257. End If 
  258. End If 
  259. If NAST(T)=0
  260. If DIFF>0
  261. NAST(T)=Rnd(DIFF)
  262. Else NAST(T)=0
  263. End If 
  264. If DIFF>2
  265. If DIFF>3
  266. NAST(T)=Rnd(DIFF-3)+3
  267. Else NAST(T)=3
  268. End If 
  269. End If 
  270. Inc NAST(T)
  271. N=5
  272. If NAST(T)=1
  273. A=26
  274. A$="A0,(26,5)(27,5);S:IX<R0JR;A:IX>R0JL;B:IY>R1JU;C:IY<R1JD;P;JS"
  275. A$=A$+";U:M0,-1,3;JC;D:M0,1,3;JS;L:M-1,0,3;JB;R:M1,0,3;JA"
  276. N=5
  277. End If 
  278. If NAST(T)=2
  279. A=29
  280. A$="S:P;IX<R0JR;IX>R0JL;IY>R1JU;IY<R1JD;JS"
  281. A$=A$+";U:A1,(32,1);M0,-1,1;JS;D:A1,(31,1);M0,1,1;JS;L:A1,(29,1);M-1,0,1;JS;R:A1,(30,1);M1,0,1;JS"
  282. N=6
  283. End If 
  284. If NAST(T)=3
  285. A=38
  286. A$="A0,(38,2)(39,3);S:IX<R0JR;A:IX>R0JL;B:IY>R1JU;C:IY<R1JD;P;JS"
  287. A$=A$+";U:M0,-1,1;JC;D:M0,1,1;JS;L:M-1,0,1;JB;R:M1,0,1;JA"
  288. N=6
  289. End If 
  290. If NAST(T)=4
  291. A=33
  292. A$="A1,(33,1);S:IX=RXJF;IY=RYJG;N:IX<R0JR;A:IX>R0JL;B:IY>R1JU;C:IY<R1JD;P;JS"
  293. A$=A$+";U:M0,-1,1;JC;D:M0,1,1;JS;L:M-1,0,1;JB;R:M1,0,1;JA"
  294. A$=A$+";F:IY>RYJE;LR3=3;JN;E:LR3=1;JN;G:IX>RXJH;LR3=4;JN;H:LR3=2;JN"
  295. Bob T+8,-10,-10,13
  296. N=10
  297. End If 
  298. If NAST(T)=5
  299. A=40
  300. A$="LR4=0;S:P;LR3=0;LR4=R4-1;IX=RXJF;IY=RYJA;N:IX<R0JR;IX>R0JL;IY>R1JU;IY<R1JD;JS"
  301. A$=A$+";U:A1,(43,1);M0,-1,2;JS;D:A1,(42,1);M0,1,2;JS;L:A1,(40,1);M-1,0,2;JS;R:A1,(41,1);M1,0,2;JS"
  302. A$=A$+";F:IR4>0JN;IR3>0JN;LR4=100;IY>RYJB;LR3=3;JN;B:LR3=1;JN;A:IR4>0JN;IR3>0JN;LR4=100;IX>RXJC;LR3=2;JN;C:LR3=4;JN"
  303. Bob T+8,-10,-10,13
  304. N=8
  305. End If 
  306. If Rnd(1)=0
  307. X=Rnd(320) : Y=Rnd(1)*200
  308. Else 
  309. X=Rnd(1)*320 : Y=Rnd(200)
  310. End If 
  311. Bob T+10,X,Y,A
  312. Channel T+2 To Bob T+10
  313. Amal T+2,A$
  314. Amal On T+2
  315. Amreg(T+2,2)=Rnd(N)
  316. End If 
  317. Next T
  318. End Proc
  319. Procedure ROVER
  320. If Bob Col(0,10 To 13)=-1
  321. For T=10 To 13
  322. If Col(T)=-1
  323. If NAST(T-10)>0 or(NAST(T-10)=-1 and T<12 and DIFF>2)
  324. If NAST(T-10)=1
  325. Amal T-8,"LR9=0;A0,(28,1);M0,0,150;LR9=1"
  326. Amal On T-8
  327. Inc SCORE
  328. UPD=2
  329. If MUS=0
  330. Shoot 
  331. End If 
  332. NAST(T-10)=-1
  333. Else 
  334. D=1
  335. If Amreg(25)>0
  336. D=0
  337. End If 
  338. If Amreg(0,1)=0
  339. If Amreg(1)=1 and Y Bob(T)<Y Bob(0)
  340. D=0
  341. End If 
  342. If Amreg(1)=2 and X Bob(T)>X Bob(0)
  343. D=0
  344. End If 
  345. If Amreg(1)=3 and Y Bob(T)>Y Bob(0)
  346. D=0
  347. End If 
  348. If Amreg(1)=4 and X Bob(T)<X Bob(0)
  349. D=0
  350. End If 
  351. End If 
  352. If NAST(T-10)=-1 and T<12 and DIFF>2
  353. If NAST(T-8)=4
  354. Goto SKP2
  355. End If 
  356. End If 
  357. Amal T-8,"LR9=0;A1,(17,2)(18,2)(19,2)(20,2);M0,0,8;LR9=1"
  358. Amal On T-8
  359. If NAST(T-10)=-1 and T<12 and DIFF>2
  360. If NAST(T-8)=5
  361. Bob T,-10,-10,
  362. End If 
  363. End If 
  364. SCORE=SCORE+NAST(T-10)
  365. NAST(T-10)=-1
  366. If MUS=0
  367. Boom 
  368. End If 
  369. UPD=2
  370. SKP2:
  371. If D=1
  372. D=0
  373. Proc DEATH
  374. End If 
  375. End If 
  376. End If 
  377. End If 
  378. Next T
  379. End If 
  380. End Proc
  381. Procedure HITNME
  382. If Spritebob Col(8,10 To 13)=-1
  383. For T=10 To 13
  384. If Col(T)=-1 and NAST(T-10)>0
  385. Amal 1,"A1,(17,2)(18,2)(19,2)(20,2);M0,0,8;LR0=1"
  386. Amal On 1
  387. If MUS=0
  388. Boom 
  389. End If 
  390. If NAST(T-10)>0
  391. SCORE=SCORE+NAST(T-10)
  392. UPD=2
  393. NAST(T-10)=0
  394. End If 
  395. End If 
  396. Next T
  397. End If 
  398. End Proc
  399. Procedure CUTDOWN
  400. For T=10 To 13
  401. If NAST(T-10)>0
  402. Z=Zone(X Bob(T),Y Bob(T))
  403. If Z>0
  404. If TREE(Z-1,2)>0
  405. Dec TREE(Z-1,2)
  406. If TREE(Z-1,2)<1
  407. Bob Z,,,23
  408. If MUS=0
  409. Boom 
  410. End If 
  411. Amal Off Z+5
  412. Reset Zone Z
  413. TERMINATE=1
  414. For R=0 To 5
  415. If TREE(R,2)<1
  416. For S=0 To 5
  417. If TREE(S,2)>0
  418. TREE(R,0)=TREE(S,0)
  419. TREE(R,1)=TREE(S,1)
  420. TERMINATE=0
  421. End If 
  422. Next S
  423. End If 
  424. Next R
  425. End If 
  426. End If 
  427. End If 
  428. End If 
  429. Next T
  430. End Proc
  431. Procedure WHOOPS
  432. Z=Zone(X Bob(0),Y Bob(0))
  433. If Z>0
  434. If Amreg(0,1)=0
  435. If MUS=0
  436. Boom 
  437. End If 
  438. Amal Off Z+5
  439. Reset Zone Z
  440. Bob Z,,,23
  441. TREE(Z-1,2)=0
  442. TERMINATE=1
  443. For R=0 To 5
  444. If TREE(R,2)<1
  445. For S=0 To 5
  446. If TREE(S,2)>0
  447. TREE(R,0)=TREE(S,0)
  448. TREE(R,1)=TREE(S,1)
  449. TERMINATE=0
  450. End If 
  451. Next S
  452. End If 
  453. Next R
  454. Else 
  455. If Amreg(25)<1
  456. Proc DEATH
  457. End If 
  458. End If 
  459. End If 
  460. End Proc
  461. Procedure DEATH
  462. Dec LIVES
  463. UPD=2
  464. If MUS=0 Then Boom 
  465. A$="LRZ=200;A1,(17,3)(18,3)(19,3)(20,3)(21,3);M0,0,100;LRZ=100;LRA=0;LR1=0;S:P;LR0=J1;IR0=1JU;IR0=8JR;IR0=2JD;IR0=4JL;IR0=16JC;JS"
  466. A$=A$+";C:P;IR1=0JB;LR1=0;LA=A-6;M0,0,5;JS;B:LR1=6;LA=A+6;M0,0,5;JS"
  467. A$=A$+";U:IY<1JS;LRB=1;A0,(1+R1,3)(2+R1,3);W:P;LR0=J1;M0,-2,1;IY<1JT;IR0<>1JM;JW;M:IR0<16JT;LRA=1;JW"
  468. A$=A$+";R:IX>319JS;LRB=2;A0,(5+R1,3)(6+R1,3);X:P;LR0=J1;M2,0,1;IX>319JT;IR0<>8JN;JX;N:IR0<16JT;LRA=1;JX"
  469. A$=A$+";D:IY>199JS;LRB=3;A0,(3+R1,3)(4+R1,3);Y:P;LR0=J1;M0,2,1;IY>199JT;IR0<>2JO;JY;O:IR0<16JT;LRA=1;JY"
  470. A$=A$+";L:IX<1JS;LRB=4;A0,($8000+R1+5,3)($8000+R1+6,3);V:P;LR0=J1;M-2,0,1;IX<1JT;IR0<>4JQ;JV;Q:IR0<16JT;LRA=1;JV"
  471. A$=A$+";T:LR2=A;A1,(R2,1);JS"
  472. Amal 0,A$
  473. Amal On 0
  474. End Proc
  475. Procedure WONSCREEN
  476. If MUS=0 Then Bell 
  477. Autoback 2
  478. Pen 5
  479. For T=10 To 13 : Bob Off T : NAST(T-10)=0 : Next T
  480. Cls 0
  481. Locate 0,0
  482. Centre "Well Done,Level "+Str$(DIFF+1)+" Solved"
  483. Paste Bob 135,150,44
  484. N=0
  485. For T=0 To 5
  486. If TREE(T,2)>0 Then Inc N
  487. Next T
  488. Wait 50
  489. Locate 0,5
  490. Pen 4
  491. Print "Tree Bonus: "+Str$(N)+" X 100 =";Str$(N*100)
  492. SCORE=SCORE+(N*100)
  493. Wait 50
  494. For T=1 To 100
  495. Paste Bob Rnd(320),Rnd(200),22
  496. Next T
  497. Bob Off 
  498. Sprite Off 
  499. FON=0
  500. Bob Draw 
  501. Inc DIFF
  502. UPD=2
  503. Cls 0
  504. Screen Swap 
  505. Bob Clear 
  506. Bob Draw 
  507. Cls 0
  508. Autoback 0
  509. Bob Draw 
  510. If DIFF>4 Then TERMINATE=1
  511. End Proc
  512. Procedure GAMEOVER
  513. Bob Off 
  514. Sprite Off 
  515. Bob Clear 
  516. Cls 0
  517. Screen Swap 
  518. Bob Clear 
  519. Cls 0
  520. Pen 4
  521. Locate 0,0
  522. Centre "Game Over"
  523. Print 
  524. A$="Your Score:"+Str$(SCORE)
  525. Centre A$
  526. Print 
  527. Print 
  528. Pen 5
  529. If DIFF=0
  530. Print "Total failure,the trees are all "
  531. Print "destroyed."
  532. Print "causing the atmosphere to deteriorate"
  533. Print "until all life suffocates."
  534. Print "The sun's unshielded rays cause the"
  535. Print " seas to boil."
  536. Print "All life is wiped out,the earth is"
  537. Print "reduced to a ball of lifeless rock."
  538. Paste Bob 135,160,48
  539. End If 
  540. If DIFF=1
  541. Print "Disaster"
  542. Print "The destruction of the trees"
  543. Print "leads to the destruction of the "
  544. Print "atmosphere."
  545. Print "The human race becomes extinct"
  546. Print "life is reduced to single celled"
  547. Print " organisms."
  548. Print "it takes millions of years to restore"
  549. Print "the balance"
  550. Paste Bob 135,160,47
  551. End If 
  552. If DIFF=2
  553. Print "Pretty bad"
  554. Print "The destruction of the trees"
  555. Print " and industrial pollution"
  556. Print "desecrates 1/3 of the worlds"
  557. Print " land surface."
  558. Print "9/10 of the human race die"
  559. Paste Bob 135,160,45
  560. End If 
  561. If DIFF=3 or DIFF=4
  562. Print "bad"
  563. Print "The destruction of many trees creates"
  564. Print "holes in the ozone layer."
  565. Print "The full unshielded power of the sun"
  566. Print " causes "
  567. Print "The poles to melt,causing flooding"
  568. Print "And putting most of the planet's"
  569. Print "surface beneath the sea"
  570. Print "1/3 of the human race die"
  571. Paste Bob 135,160,46
  572. End If 
  573. If DIFF=5
  574. Pen 4
  575. Print "well done"
  576. Print "Due to your actions,global deforestation "
  577. Print "has"
  578. Print "been put to an end.The environment is "
  579. Print "safe"
  580. Print "and the human race is saved from it's"
  581. Print "ignorance and greed."
  582. Print "(apart from captain chainsaw and his "
  583. Print "men)"
  584. Paste Bob 135,160,44
  585. End If 
  586. Screen Swap 
  587. While Fire(1)=0 : Wend 
  588. End Proc