home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 126-150 / apd137 / easy_tile_trial.amos / easy_tile_trial.amosSourceCode
Encoding:
AMOS Source Code  |  1992-06-11  |  6.1 KB  |  303 lines
  1. '  This Program is SHAREWARE 
  2. '  If you would like to receive updates etc. 
  3. '  Please send five pounds registration fee to 
  4. '  D. Ramsey, 2 The Paddocks, Haddenham< Bucks. HP17 8AG. ThankYou 
  5. On Error Goto HELP
  6. Screen Open 0,320,256,2,Lowres : Cls 0 : Hide On 
  7. Curs Off : GAME=1 : Dir$="df0:" : LEVEL=1 : 
  8. Load "music.abk" : Music 1
  9. LL:
  10. Dim TILE(5,5),NAME$(6),HISCORE(6)
  11. For T=1 To 5 : Read NAME$(T),HISCORE(T) : Next 
  12. Data "AMOS",3500,"MANDARIN",3000,"PIXEL",500,"PRECISON",200,"SOFTWARE",100
  13. Screen Open 1,320,20,2,Lowres : Cls 0 : Screen Display 1,,150,,
  14. Flash Off : 
  15. Palette 0,$111,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  16. TXT$="          Dom Ramsey Presents"
  17. Gosub FADTXT
  18. TXT$="     A Pixel Precision Production"
  19. Gosub FADTXT
  20. LLL:
  21. Hide On : Gosub TITLE : SCORE=0
  22. LLLL:
  23. GAME$=Right$(Str$(GAME),1)
  24. GAME$="screen"+GAME$+".iff"
  25. Load Iff GAME$,0
  26. Double Buffer : Screen Hide 0
  27. MNS=0 : SECS=0 : LEVEL=LEVEL+1
  28. C=0
  29. For Y=0 To 4
  30. For X=0 To 4
  31. C=C+1
  32. Get Bob 0,C,(X*40)+14,(Y*40)+46 To(X*40)+55,(Y*40)+87
  33. Next X
  34. Next Y
  35. Get Bob 0,26,244,191 To 293,240
  36. M:
  37. C=1
  38. For Y=0 To 4
  39. For X=0 To 4
  40. TILE(X,Y)=C
  41. C=C+1
  42. Next X
  43. Next Y
  44. Limit Mouse 143,89 To 340,286
  45. '
  46. 'Main loop 
  47. '
  48. GOES=0
  49. Gosub MESSBOARD
  50. Ink 31,22 : LEVEL$=Str$(LEVEL-1) : LEVEL$=Right$(LEVEL$,Len(LEVEL$)-1)
  51. LEVEL$=String$("0",3-Len(LEVEL$))+LEVEL$ : Text 255,98,LEVEL$
  52. Timer=0
  53. L:
  54. Gosub GTMOVE
  55. Gosub CHKMOVE
  56.  If NOMOVED=1 Then Goto L
  57. Gosub MOVETILE
  58. Gosub CHKDONE
  59. Goto L
  60. '
  61. '
  62. '
  63. End 
  64. '
  65. FADTXT:
  66. Ink 1,0
  67. For T=0 To 15 : Colour 1,(16*16*T)+(16*T)+T : Wait Vbl : Text 1,10,TXT$ : Wait 4 : Next T
  68. Wait 5
  69. For T=15 To 0 Step -1 : Colour 1,(16*16*T)+(16*T)+T : Wait Vbl : Text 1,10,TXT$ : Wait 4 : Next T
  70. Wait 20
  71. Return 
  72. '
  73. GTMOVE:
  74. Show On 
  75.  While Mouse Key=0
  76.   X=X Screen(X Mouse)-14
  77.   Y=Y Screen(Y Mouse)-46
  78.   T=Timer/50 : MNS=T/60 : SECS=T-(MNS*60) : SEC$=Str$(SECS)
  79.   If Len(SEC$)=2 Then SEC$="0"+Right$(SEC$,1) Else SEC$=Right$(SEC$,2)
  80.   T$=Str$(MNS)+":"+SEC$
  81.   Ink 31,22 : Text 244,138,T$
  82.  If MNS=3 Then Goto TIMEUP
  83. Wend 
  84. Hide On 
  85. X=X/40 : Y=Y/40
  86. Return 
  87. '
  88. CHKMOVE:
  89. RT=0 : LT=0 : UP=0 : DN=0 : NOMOVED=0
  90.  Gosub CHKUP
  91.  Gosub CHKDN
  92.  Gosub CHKRT
  93.  Gosub CHKLT
  94. If(LT=0 and RT=0 and UP=0 and DN=0) Then NOMOVED=1
  95. If NOMOVED=0 Then GOES=GOES+1
  96. Return 
  97. '
  98. CHKUP:
  99. If Y=0 Then Return 
  100. If TILE(X,Y-1)=1 Then UP=1
  101. Return 
  102. '
  103. CHKDN:
  104. If Y=4 Then Return 
  105. If TILE(X,Y+1)=1 Then DN=1
  106. Return 
  107. '
  108. CHKLT:
  109. If X=0 Then Return 
  110. If TILE(X-1,Y)=1 Then LT=1
  111. Return 
  112. '
  113. CHKRT:
  114. If X=4 Then Return 
  115. If TILE(X+1,Y)=1 Then RT=1
  116. Return 
  117. '
  118. '
  119. MOVETILE:
  120. If UP=1 Then Gosub MVUP
  121. If DN=1 Then Gosub MVDN
  122. If RT=1 Then Gosub MVRT
  123. If LT=1 Then Gosub MVLT
  124. Return 
  125. '
  126. MVUP:
  127. Paste Bob(X*40)+14,(Y*40)+46,1
  128. For YY=0 To 39
  129. Wait Vbl 
  130. Bob 1,(X*40)+14,(Y*40)+46-YY,TILE(X,Y)
  131. Next YY
  132. Shoot 
  133. Paste Bob(X*40)+14,((Y-1)*40)+46,TILE(X,Y)
  134. Bob Off 
  135. TILE(X,Y-1)=TILE(X,Y) : TILE(X,Y)=1
  136. Return 
  137. '
  138. MVLT:
  139. Paste Bob(X*40)+14,(Y*40)+46,1
  140. For XX=0 To 39
  141. Wait Vbl 
  142. Bob 1,(X*40)+14-XX,(Y*40)+46,TILE(X,Y)
  143. Next XX
  144. Shoot 
  145. Paste Bob((X-1)*40)+14,(Y*40)+46,TILE(X,Y)
  146. Bob Off 
  147. TILE(X-1,Y)=TILE(X,Y) : TILE(X,Y)=1
  148. Return 
  149. '
  150. MVRT:
  151. Paste Bob(X*40)+14,(Y*40)+46,1
  152. For XX=0 To 39
  153. Wait Vbl 
  154. Bob 1,(X*40)+14+XX,(Y*40)+46,TILE(X,Y)
  155. Next XX
  156. Shoot 
  157. Paste Bob((X+1)*40)+14,(Y*40)+46,TILE(X,Y)
  158. Bob Off 
  159. TILE(X+1,Y)=TILE(X,Y) : TILE(X,Y)=1
  160. Return 
  161. '
  162. MVDN:
  163. Paste Bob(X*40)+14,(Y*40)+46,1
  164. For YY=0 To 39
  165. Wait Vbl 
  166. Bob 1,(X*40)+14,(Y*40)+46+YY,TILE(X,Y)
  167. Next YY
  168. Shoot 
  169. Paste Bob(X*40)+14,(Y*40)+46+YY,TILE(X,Y)
  170. Bob Off 
  171. TILE(X,Y+1)=TILE(X,Y) : TILE(X,Y)=1
  172. Return 
  173. '
  174. '
  175. MESSBOARD:
  176. For M=1 To(15+(7*LEVEL))
  177. LP:
  178. X=Rnd(4) : Y=Rnd(4)
  179.  Gosub CHKMOVE
  180. If NOMOVED=1 Then Goto LP
  181. If DN=1 Then TILE(X,Y+1)=TILE(X,Y) : TILE(X,Y)=1
  182. If RT=1 Then TILE(X+1,Y)=TILE(X,Y) : TILE(X,Y)=1
  183. If LT=1 Then TILE(X-1,Y)=TILE(X,Y) : TILE(X,Y)=1
  184. If UP=1 Then TILE(X,Y-1)=TILE(X,Y) : TILE(X,Y)=1
  185. Next 
  186. C=0
  187. For Y=0 To 4
  188. For X=0 To 4
  189. C=C+1
  190. Paste Bob(X*40)+14,(Y*40)+46,TILE(X,Y)
  191. Next X
  192. Next Y
  193. Gosub VOLDOWN
  194. Screen Show 0
  195. Return 
  196. '
  197. CHKDONE:
  198. C=0
  199. For Y=0 To 4
  200. For X=0 To 4
  201. C=C+1 : If TILE(X,Y)<>C Then Return 
  202. Next X
  203. Next Y
  204. Gosub VOLUP
  205. S=Timer/50 : S=(300-S)*5
  206. S=(SCORE+S-(3*GOES)+(3*LEVEL))/5 : S=S*2 : SCORE=SCORE+S
  207. If SCORE<0 Then SCORE=0
  208. Load "Congrats.abk",7 : Unpack 7 To 1 : Screen Display 1,,320,, : Erase 7
  209. Ink 1,6 : Text 190,66,Str$(SCORE)
  210. Ink 1,7
  211. SECS=60-SECS : SEC$=Str$(SECS)
  212. SEC$=Right$(SEC$,Len(SEC$)-1) : If Len(SEC$)=1 Then SEC$="0"+SEC$
  213. T$=Str$(2-MNS)+":"+SEC$
  214. Text 50,48,T$
  215. For Y=300 To 120 Step -2
  216. Wait Vbl 
  217. Screen Display 1,,Y,,
  218. Next 
  219. Screen 0 : Fade 12
  220. GOES=0 : Wait 150
  221. GAME=GAME+1
  222. If GAME>10 : GAME=1 : End If 
  223. Goto LLLL
  224. Return 
  225. '
  226. '
  227. TIMEUP:
  228. Hide On 
  229. Gosub VOLUP
  230. SCORE=SCORE+(3*LEVEL)
  231. If SCORE<10 Then SCORE=0
  232. Load "BadLuck.abk",7 : Unpack 7 To 1 : Screen Display 1,,320,,
  233. Erase 7
  234. Ink 1,6 : Text 190,74,Str$(SCORE)
  235. For Y=300 To 120 Step -2
  236. Wait Vbl : Screen Display 1,,Y,,
  237. Next 
  238. Gosub CHKHISCORE
  239. Screen 0 : Fade 12 : Wait 350 : Screen 1 : GAME=1 : LEVEL=1
  240. Goto LLL
  241. '
  242. TITLE:
  243. Screen Hide 0
  244. Load Iff "titlescreen.Iff",0
  245. Screen Display 0,,320,,
  246. For Y=320 To 42 Step -4
  247. Wait Vbl 
  248. Screen Display 0,,Y,,
  249. Next 
  250. Wait 10 : Load "Hiscoretable.abk",7
  251. Unpack 7 To 1 : Screen Display 1,,320,, : SD=319 : SDX=-1
  252. Ink 6,3 : Erase 7 : For T=1 To 5 : S=15-Len(NAME$(T))
  253. T$=Str$(T)+"  "+NAME$(T)+String$(".",S)+Str$(HISCORE(T))
  254. Text 50,40+(10*T),T$
  255. Next T
  256. While Mouse Key=0
  257. SD=SD+SDX
  258. If SD<29 or SD>320 : SD=30 : End If 
  259. Wait Vbl 
  260. Screen Display 1,,SD,,
  261. If SD=320 or SD=30 Then SDX=-SDX
  262. Wend : Screen 0 : Fade 4
  263. For Y=SD To 320 : Wait Vbl : Screen Display 1,,Y,, : Next 
  264. Screen 1 : Cls 0
  265. Return 
  266. '
  267. VOLDOWN:
  268. For MV=63 To 0 Step -1 : Wait Vbl : Mvolume MV : Next 
  269. Return 
  270. VOLUP:
  271. For MV=0 To 63 : Wait Vbl : Mvolume MV : Next 
  272. Return 
  273. '
  274. '
  275. CHKHISCORE:
  276. For T=1 To 5
  277.  If SCORE=>HISCORE(T)
  278.   If T=5
  279.   HISCORE(5)=SCORE : Gosub GTNAME : Return 
  280.  End If 
  281. For S=5 To T Step -1
  282. HISCORE(S)=HISCORE(S-1) : NAME$(S)=NAME$(S-1)
  283. Next S
  284. Gosub GTNAME : Return 
  285. End If 
  286. Next T
  287. Return 
  288. '
  289. GTNAME:
  290. Hide On 
  291. Screen Open 2,320,20,2,Lowres : Screen Display 2,,320,,
  292. Paper 0 : Colour 1,$FFF : Pen 1 : Print "  ENTER YOUR NAME  (MAX 10 LETTERS)"
  293. For SD=320 To 98 Step -2 : Wait Vbl : Screen Display 2,,SD,, : Next 
  294. Locate 10,1
  295. Input NAME$(T)
  296. If Len(NAME$(T))>10 Then NAME$(T)=Left$(NAME$(T),10)
  297. NAME$(T)=Upper$(NAME$(T))
  298. HISCORE(T)=SCORE
  299. For SD=98 To 320 Step 2 : Wait Vbl : Screen Display 2,,SD,, : Next 
  300. Return 
  301. '
  302. HELP:
  303. Resume