home *** CD-ROM | disk | FTP | other *** search
/ Antic Magazine 1987 May / Antic_Magazine_1987_05_Antic_Side_B.atr / towers.bas < prev    next >
BASIC Source File  |  2023-02-26  |  10KB  |  375 lines
  1.  
  2. 1000  '
  3. 1010  'Antic Towers
  4. 1020  '(c) 1987 Antic Publishing V. 010487
  5. 1030  'Written by Steve Everman & Paul Pratt
  6. 1040  '
  7. 1050  '----------------------------------------
  8. 1060   A$=chr$(0)+chr$(0)+chr$(0)+chr$(0): BELL$=chr$( 7 )
  9. 1070   A=varptr( A$ ): A1=int( A/65536 ): A2=A-( A1*65536 )
  10. 1080   randomize 0
  11. 1090   HANDLE=2: EXIT=2: TRUE=1: FALSE=( not TRUE )
  12. 1100   GRAF.MKSTATE=79: FORM.ALERT=52: WIND.SET=105
  13. 1110  '
  14. 1120   A#=GB
  15. 1130   CONTROL=peek( A# )
  16. 1140   GINTOUT=peek( A#+12 )
  17. 1150   GINTIN=peek( A#+8 )
  18. 1160   dim STACK( 3, 9 ),KOL%( 16 )
  19. 1170   gosub SET.PALETTE
  20. 1180   fullw 2: clearw 2
  21. 1190   if peek( SYSTAB )<>4 then gosub WARNING
  22. 1200   if peek( SYSTAB )<>4 then gosub ALERTBOX
  23. 1210   if CHOICE=EXIT then end
  24. 1220   gotoxy 0,0: print BELL$;: color 1,0,0
  25. 1230   for X=0 to 20
  26. 1240      gosub POLYLINE
  27. 1250   next X
  28. 1260   gosub ED.BOX: gosub FIND.HI
  29. 1270   OLD.DISK=NUMDISK
  30. 1280   gosub SET.ARRAY: gosub SCREEN.SET.UP
  31. 1290   gotoxy 14,2: print "[ READY ]"
  32. 1300  '
  33. 1310  '----------------------------
  34. 1320  MAIN:
  35. 1330   gosub GET.MOUSE
  36. 1340   while NEW.PRESS <>3
  37. 1350      gosub GET.MOUSE
  38. 1360      gosub SHOW
  39. 1370      while STACK( 2,8-NUMDISK )=0 and STACK( 3,8-NUMDISK )=0
  40. 1380           gosub GET.MOUSE
  41. 1390           if NEW.PRESS=1 and FALL=1 and INAIR=0 then gosub PULL
  42. 1400           if NEW.PRESS=1 and FALL=1 and INAIR>0 then gosub DOWN
  43. 1410      wend
  44. 1420      gosub REWARD
  45. 1430      gosub NEW.GAME
  46. 1440   wend
  47. 1450   color 5
  48. 1460  end
  49. 1470  '
  50. 1480  '------------------------
  51. 1490  FIND.HI:
  52. 1500   color 10: gotoxy 5,1: print "How many disks do you want?"
  53. 1510   R=4: gosub REVERSE: color 11
  54. 1520   for X=0 to 6
  55. 1530      S$=chr$( 32 )+chr$( 49+X )+chr$( 32 )
  56. 1540      gotoxy 4+X*4,3: print  S$
  57. 1550   next X
  58. 1560   gotoxy 15,5: print "EXIT"
  59. 1570   R=1: gosub REVERSE: color 1
  60. 1580   while NEW.PRESS<>1 or MX>277 or MX <30 or MY>65 or MY<40
  61. 1590      gosub GET.MOUSE
  62. 1600      X.CHECK=FALSE: Y.CHECK=FALSE
  63. 1610      if MX>135 and MX<168 then X.CHECK=TRUE
  64. 1620      if MY>68 and MY<77 then Y.CHECK=TRUE
  65. 1630      if NEW.PRESS and X.CHECK and Y.CHECK then end
  66. 1640   wend
  67. 1650   gosub HIDE
  68. 1660   for X=1 to 5
  69. 1670      gotoxy 2,X: print "                                   "
  70. 1680   next
  71. 1690   gosub SHOW: NUMDISK=int(( MX+8 )/36 )
  72. 1700  return
  73. 1710  '
  74. 1720  '----------------------------------
  75. 1730  FIND.TOP:
  76. 1740   gosub GET.MOUSE
  77. 1750   SOURCEX=154: DISK.POLE=2
  78. 1760   if MX>199 then SOURCEX=246: DISK.POLE=3
  79. 1770   if MX<107 then SOURCEX=62: DISK.POLE=1
  80. 1780   for Y=1 to 8
  81. 1790      if STACK( DISK.POLE,Y-1 )=0 then TOP=Y
  82. 1800   next Y
  83. 1810  return
  84. 1820  '
  85. 1830  '----------------------------------
  86. 1840  PULL:
  87. 1850   gosub FIND.TOP: if TOP>7 then return
  88. 1860   INAIR=STACK( DISK.POLE, TOP )
  89. 1870  '
  90. 1880  PULL.UP:
  91. 1890   gosub HIDE
  92. 1900   X1=SOURCEX-40: X2=SOURCEX+40
  93. 1910   Y1=87+TOP*11: Y2=Y1+10
  94. 1920   XD1=115: XD2=195: YD1=40: YD2=50
  95. 1930   gosub VRO.COPYFORM
  96. 1940   XD1=X1: XD2=X2: YD1=Y1: YD2=Y2
  97. 1950   X1=22: X2=102: Y1=87: Y2=97
  98. 1960   gosub VRO.COPYFORM: gosub SHOW
  99. 1970   STACK( DISK.POLE, TOP )=0
  100. 1980  return
  101. 1990  '
  102. 2000  '----------------------------------
  103. 2010  DOWN:
  104. 2020   gosub FIND.TOP
  105. 2030   if INAIR > STACK( DISK.POLE, TOP ) then return
  106. 2040  '
  107. 2050  PUT.DOWN:
  108. 2060   gosub HIDE
  109. 2070   X1=115: X2=195: Y1=40: Y2=50
  110. 2080   XD1=SOURCEX-40: XD2=SOURCEX+40
  111. 2090   YD1=76+TOP*11: YD2=YD1+10
  112. 2100   OLD.DISK=NUMDISK
  113. 2110   gosub VRO.COPYFORM
  114. 2120   gosub SHOW
  115. 2130   STACK( DISK.POLE, TOP-1 )=INAIR
  116. 2140  '
  117. 2150  ERRASE:
  118. 2160   X1=15: X2=95: Y1=55: Y2=65
  119. 2170   XD1=115: XD2=195: YD1=40: YD2=50
  120. 2180   gosub VRO.COPYFORM
  121. 2190   INAIR=0: print BELL$;
  122. 2200  return
  123. 2210  '
  124. 2220  '---------------------------------
  125. 2230  NEW.GAME:
  126. 2240   gosub FIND.HI
  127. 2250   gosub SET.ARRAY
  128. 2260   if NUMDISK>OLD.DISK then gosub SEE.DISKS
  129. 2270   while NUMDISK<OLD.DISK
  130. 2280      TOP=TOP+1
  131. 2290      gosub PULL.UP
  132. 2300      gotoxy 0,0
  133. 2310      for D=0 to 350: next D
  134. 2320      gosub ERRASE
  135. 2330      OLD.DISK=OLD.DISK-1
  136. 2340   wend
  137. 2350   gotoxy 14,2: print "[ READY ]"
  138. 2360  return
  139. 2370  '
  140. 2380  '------------------------------
  141. 2390  SET.ARRAY:
  142. 2400   for X=0 to 8
  143. 2410      STACK( 1, X )=X*10
  144. 2420      STACK( 2, X )=0
  145. 2430      STACK( 3, X )=0
  146. 2440   next X
  147. 2450   for Y=0 to 7-NUMDISK
  148. 2460      STACK( 1, Y )=0
  149. 2470   next Y
  150. 2480   for X=0 to 3
  151. 2490      STACK( X, 8 )=80
  152. 2500   next X
  153. 2510  return
  154. 2520  '
  155. 2530  '-------------------------------
  156. 2540  SCREEN.SET.UP:
  157. 2550   gosub HIDE
  158. 2560   FC=10: gosub FILCOL
  159. 2570   X1=8: Y1=175: X2=300: Y2=188
  160. 2580   gosub DISK
  161. 2590   Y1=80: Y2=180
  162. 2600   for X1=59 to 265 step 92
  163. 2610      X2=X1+6
  164. 2620      gosub DISK
  165. 2630   next X1
  166. 2640  '
  167. 2650  SEE.DISKS:
  168. 2660   Y1=164: Y2=174
  169. 2670   for Y=7 to 8-NUMDISK step -1
  170. 2680      gosub DRAW.DISK
  171. 2690   next Y
  172. 2700  return
  173. 2710  '
  174. 2720  '-------------------------------
  175. 2730  DRAW.DISK:
  176. 2740   gotoxy 0, 0: print  BELL$;
  177. 2750   FC=1+STACK( 1, Y )/10: gosub FILCOL
  178. 2760   X1=57-( STACK( 1, Y )/2 )
  179. 2770   X2=X1+STACK( 1, Y )+10
  180. 2780   gosub DISK
  181. 2790   Y1=Y1-11: Y2=Y2-11
  182. 2800  return
  183. 2810  '
  184. 2820  '-------------------------------
  185. 2830  REWARD:
  186. 2840   for Y=NUMDISK-1 to 0 step -1
  187. 2850      color TOP+Y: gotoxy 10,1: print "CONGRATULATIONS"
  188. 2860      for X=0 to 7
  189. 2870           print  BELL$;
  190. 2880           for D=0 to 100: next D
  191. 2890      next X
  192. 2900      color 1
  193. 2910   next Y
  194. 2920   gotoxy 10,1: print "                 "
  195. 2930  '
  196. 2940  MOVE.BACK:
  197. 2950   SX=SOURCEX
  198. 2960   for TOP=7 to 8-NUMDISK step -1
  199. 2970      for Q=1 to 6
  200. 2980           gosub ROTATE
  201. 2990           sound 1, 2+Q*2, 1, Q, 2
  202. 3000      next Q
  203. 3010      SOURCEX=SX: gosub PULL.UP: TOP=TOP+1
  204. 3020      for Q=1 to 6
  205. 3030           gosub ROTATE
  206. 3040           sound 1, 16-Q*2, 1, 7-Q, 2
  207. 3050      next Q
  208. 3060      SOURCEX=62: gosub PUT.DOWN: TOP=TOP-1
  209. 3070   next TOP
  210. 3080   sound 0, 0, 0, 0, 0: gosub SET.PALETTE
  211. 3090  return
  212. 3100  '
  213. 3110  '----------------------------------
  214. 3120  ROTATE:
  215. 3130   HOLD=KOL%( 1 )
  216. 3140   for X=1 to 7
  217. 3150      KOL%( X )=KOL%( X+1 )
  218. 3160   next X
  219. 3170   KOL%( 7 )=HOLD
  220. 3180   defdbl C: C=1114
  221. 3190   poke C,varptr( KOL%( 0 ))
  222. 3200  return
  223. 3210  '
  224. 3220  '------------------------------------
  225. 3230  SET.PALETTE:
  226. 3240   restore COLOR.PALETTE
  227. 3250   for ENTRY=0 to 15
  228. 3260      read PALETTE.COLOR
  229. 3270      KOL%( ENTRY )=PALETTE.COLOR
  230. 3280   next ENTRY
  231. 3290  '
  232. 3300  COLOR.PALETTE:
  233. 3310   data 1911,1792,1856,85,1904,7
  234. 3320   data 80,1285,0,0,785,0
  235. 3330   data 0,0,0,785,1074
  236. 3340  '
  237. 3350   defdbl C: C=1114
  238. 3360   poke C,varptr( KOL%( 0 ))
  239. 3370  return
  240. 3380  '
  241. 3390  '-------------------------------------
  242. 3400  GET.MOUSE:
  243. 3410   gemsys( GRAF.MKSTATE )
  244. 3420   MX=peek( GINTOUT+2 )
  245. 3430   MY=peek( GINTOUT+4 )
  246. 3440   NEW.PRESS=peek( GINTOUT+6 )
  247. 3450   if OLD.PRESS<>NEW.PRESS then FALL=1 else FALL=0
  248. 3460   OLD.PRESS=NEW.PRESS
  249. 3470  return
  250. 3480  '
  251. 3490  '-------------------------------------
  252. 3500  VRO.COPYFORM:
  253. 3510   poke CONTRL,109
  254. 3520   poke CONTRL+2,4
  255. 3530   poke CONTRL+6,1
  256. 3540   poke CONTRL+12,HANDLE
  257. 3550   poke CONTRL+14,A1
  258. 3560   poke CONTRL+16,A2
  259. 3570   poke CONTRL+18,A1
  260. 3580   poke CONTRL+20,A2
  261. 3590   poke INTIN,3
  262. 3600   poke PTSIN,X1
  263. 3610   poke PTSIN+2,Y1
  264. 3620   poke PTSIN+4,X2
  265. 3630   poke PTSIN+6,Y2
  266. 3640   poke PTSIN+8,XD1
  267. 3650   poke PTSIN+10,YD1
  268. 3660   poke PTSIN+12,XD2
  269. 3670   poke PTSIN+14,YD2
  270. 3680   vdisys( 0 )
  271. 3690  return
  272. 3700  '
  273. 3710  '-------------------------------------
  274. 3720  HIDE:
  275. 3730   poke CONTRL,123
  276. 3740   poke CONTRL+2,0
  277. 3750   poke CONTRL+6,0
  278. 3760   poke CONTRL+12,HANDLE
  279. 3770   vdisys( 0 )
  280. 3780  return
  281. 3790  '
  282. 3800  '-------------------------------------
  283. 3810  SHOW:
  284. 3820   poke CONTRL,122
  285. 3830   poke CONTRL+2,0
  286. 3840   poke CONTRL+6,1
  287. 3850   poke CONTRL+12,HANDLE
  288. 3860   poke INTIN,1
  289. 3870   vdisys( 0 )
  290. 3880  return
  291. 3890  '
  292. 3900  '-------------------------------------
  293. 3910  ALERTBOX:
  294. 3920   ADDRIN=peek( A#+16 )
  295. 3930   B#=ADDRIN
  296. 3940   poke GINTIN,0
  297. 3950   TEXT$=TEXT$+chr$( 0 )+chr$( 0 )
  298. 3960   poke B#,varptr( TEXT$ )
  299. 3970   gemsys( FORM.ALERT )
  300. 3980   CHOICE=peek( GINTOUT )
  301. 3990  return
  302. 4000  '
  303. 4010  '----------------------------------
  304. 4020  WARNING:
  305. 4030   TEXT$="[0][|This program works best |"
  306. 4040   TEXT$=TEXT$+"   in LOW resolution.  |]"
  307. 4050   TEXT$=TEXT$+"[ Run | EXIT ]"
  308. 4060  return
  309. 4070  '
  310. 4080  '---------------------------------
  311. 4090  ED.BOX:
  312. 4100   REPLACE$="     "+chr$( 127 )+"   Antic Towers  "
  313. 4110   REPLACE$=REPLACE$+chr$( 127 )+"     "+chr$( 0 )
  314. 4120   poke GINTIN+0,peek( SYSTAB+8 )
  315. 4130   C#=GINTIN+4: poke GINTIN+2,2
  316. 4140   poke C#,varptr( REPLACE$ )
  317. 4150   gemsys( WIND.SET )
  318. 4160  return
  319. 4170  '
  320. 4180  '----------------------------------
  321. 4190  REVERSE:
  322. 4200   poke CONTRL,32
  323. 4210   poke CONTRL+2,0
  324. 4220   poke CONTRL+6,1
  325. 4230   poke CONTRL+12,HANDLE
  326. 4240   poke INTIN,R
  327. 4250  vdisys( 1 )
  328. 4260  return
  329. 4270  '
  330. 4280  '----------------------------------
  331. 4290  POLYLINE:
  332. 4300   poke CONTRL,6
  333. 4310   poke CONTRL+2,6
  334. 4320   poke CONTRL+4,0
  335. 4330   poke CONTRL+12,HANDLE
  336. 4340   poke PTSIN,0+X
  337. 4350   poke PTSIN+2,0+X
  338. 4360   poke PTSIN+4,639-X
  339. 4370   poke PTSIN+6,0+X
  340. 4380   poke PTSIN+8,639-X
  341. 4390   poke PTSIN+10,199-X
  342. 4400   poke PTSIN+12,0+X
  343. 4410   poke PTSIN+14,199-X
  344. 4420   poke PTSIN+16,0+X
  345. 4430   poke PTSIN+18,0+X
  346. 4440   vdisys( 1 )
  347. 4450  return
  348. 4460  '
  349. 4470  '------------------------------------
  350. 4480  DISK:
  351. 4490   poke CONTRL,11
  352. 4500   poke CONTRL+2,2
  353. 4510   poke CONTRL+6,0
  354. 4520   poke CONTRL+10,9
  355. 4530   poke CONTRL+12,2
  356. 4540   poke PTSIN,X1
  357. 4550   poke PTSIN+2,Y1
  358. 4560   poke PTSIN+4,X2
  359. 4570   poke PTSIN+6,Y2
  360. 4580   vdisys( 0 )
  361. 4590  return
  362. 4600  '
  363. 4610  '-----------------------------------
  364. 4620  FILCOL:
  365. 4630   poke CONTRL,25
  366. 4640   poke CONTRL+2,0
  367. 4650   poke CONTRL+6,1
  368. 4660   poke CONTRL+12,2
  369. 4670   poke INTIN,FC
  370. 4680   vdisys( 0 )
  371. 4690  return
  372.  
  373.  
  374.  
  375.