home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1990 June / 1990-06.d64 / sphere.bas (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  269 lines
  1. 10 rem copyright 1990 compute! publications, inc. - all rights reserved
  2. 20 poke54296,15:poke53280,0:poke53281,0:sys2636:dimp$(4)
  3. 30 p$(0)="   [157][157][157]   "
  4. 40 p$(1)="[146][193][194] [145][157][157][146][195][196]"
  5. 50 p$(2)="[146][197][198][157][157] [146][199][200]"
  6. 60 p$(3)="[146][201][202] [157][157][146][203][204]"
  7. 70 p$(4)="[146][205][206][145][157][157] [146][207][208]"
  8. 80 fori=1to6:readt$(i):next:s$=t$(1)
  9. 90 data "open    ","lattice ","diamonds","cyclone ","quadrate","random  "
  10. 100 t1$="[176][192][174][176][192][174][178] [178][176][192][174][176][192][174][176][192][174][176][178][174][178][192][174][176][192][174]"
  11. 110 t2$="[173][192][174][171][192][189][171][192][179][171][192] [171][178][189][221] [221] [221] [221] [221][173][192][174]"
  12. 120 t3$="[173][192][189][177]  [177] [177][173][192][189][177][173][189][173][192][189][173][177][189][177][192][189][173][192][189]"
  13. 130 tc$="[155][152][151][149][129][150][158]"
  14. 140 gosub2280
  15. 150 print"[147]";
  16. 160 s=1:mo=1:goto380
  17. 170 print"[150] selected: ";t$(s);"     shown: ";s$;" "
  18. 180 poke198,0
  19. 190 geta$
  20. 200 j=(peek(56320)andpeek(56321))
  21. 210 ifa$="[135]"thengosub1330:gosub1390
  22. 220 ifa$="[136]"thengosub1330:sys2633:sys2624:goto450
  23. 230 if(jand16)=0thengosub1330:sys2633:sys2624:goto450
  24. 240 ifa$="[134]"then320
  25. 250 if(jand8)=0then320
  26. 260 ifa$="[138]"then350
  27. 270 if(jand4)=0then350
  28. 280 ifa$="[133]"then380
  29. 290 if(jand1)=0or(jand2)=0then380
  30. 300 ifa$="[140]"thengosub1330:gosub2280:sys2633:goto450
  31. 310 goto190
  32. 320 s=s+1:ifs=7thens=1
  33. 330 gosub1330
  34. 340 goto170
  35. 350 s=s-1:ifs=0thens=6
  36. 360 gosub1330
  37. 370 goto170
  38. 380 print"[150] generating ";t$(s);"                   ":poke1024+39,160
  39. 390 poke55296+39,10
  40. 400 poke218,peek(218)or128
  41. 410 gosub1330
  42. 420 on s gosub1740,1790,1430,1590,2120,1950
  43. 430 s$=t$(s)
  44. 440 sys2630
  45. 450 ifmo=1thengosub1130
  46. 460 gosub1330
  47. 470 goto170
  48. 480 rem draw mound/depression
  49. 490 printmid$(c$,1,1);
  50. 500 fori=1tox
  51. 510 printp$(1);"[145]";
  52. 520 next
  53. 530 printmid$(c$,2,1);"";
  54. 540 fori=1tox
  55. 550 printp$(2);"";
  56. 560 next
  57. 570 fori=1to2*x
  58. 580 print"[157][157][157]";
  59. 590 next
  60. 600 printmid$(c$,3,1);
  61. 610 fori=1tox
  62. 620 printp$(3);"";
  63. 630 next
  64. 640 printmid$(c$,4,1);"[145]";
  65. 650 fori=1tox
  66. 660 printp$(4);"[145]";
  67. 670 next
  68. 680 print"[145]";
  69. 690 if x=1 then920
  70. 700 forj=x-1to1step-1
  71. 710 fori=1toj*2+1:print"[157][157][157]";:next
  72. 720 printmid$(c$,1,1);
  73. 730 fori=1toj
  74. 740 printp$(0);"[145][145][145]";
  75. 750 next
  76. 760 printmid$(c$,2,1);"";
  77. 770 fori=1toj
  78. 780 printp$(0);"";
  79. 790 next
  80. 800 fori=1to2*j
  81. 810 print"[157][157][157]";
  82. 820 next
  83. 830 printmid$(c$,3,1);
  84. 840 fori=1toj
  85. 850 printp$(0);"";
  86. 860 next
  87. 870 printmid$(c$,4,1);"[145][145]";
  88. 880 fori=1toj
  89. 890 printp$(0);"[145][145][145]";
  90. 900 next
  91. 910 next
  92. 920 return
  93. 930 rem draw teleporter
  94. 940 x=int(rnd(0)*38)
  95. 950 y=int(rnd(0)*23)+1
  96. 960 if(peek(55296+y*40+x)and15)<>4then930
  97. 970 if(peek(55296+y*40+x+1)and15)<>4then930
  98. 980 if(peek(55296+y*40+x+40)and15)<>4then930
  99. 990 if(peek(55296+y*40+x+41)and15)<>4then930
  100. 1000 rem enter here for set location
  101. 1010 poke1024+y*40+x,102
  102. 1020 poke1024+y*40+x+1,102
  103. 1030 poke1024+y*40+x+40,102
  104. 1040 poke1024+y*40+x+41,102
  105. 1050 poke55296+y*40+x,7
  106. 1060 poke55296+y*40+x+1,7
  107. 1070 poke55296+y*40+x+40,7
  108. 1080 poke55296+y*40+x+41,7
  109. 1090 m=1024+y*40+x
  110. 1100 l=m and 255:h=int(m/256)
  111. 1110 poke2639,l:poke2640,h
  112. 1120 return
  113. 1130 rem display menu
  114. 1140 mo=1
  115. 1150 gosub1240
  116. 1160 print"[129][161]f1 generate selected terrain[146][161]"
  117. 1170 print"[161]f3 increase selected terrain[146][161]"
  118. 1180 print"[161]f4 decrease selected terrain[146][161]"
  119. 1190 print"[161]f5 menu on/off              [146][161]"
  120. 1200 print"[161]f7 start battle             [146][161]"
  121. 1210 print"[161]f8 return to title screen   [146][161]"
  122. 1220 print"[188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][146][190]"
  123. 1230 return
  124. 1240 rem clr logical lines
  125. 1250 fori=217to242
  126. 1260 pokei,peek(i)or128
  127. 1270 next
  128. 1280 return
  129. 1290 rem select depression or mound
  130. 1300 ifrnd(0)<.5thenc$="[154][151][159]":goto1320
  131. 1310 c$="[155][151][152]"
  132. 1320 return
  133. 1330 rem beep
  134. 1340 poke54272,0:poke54273,200
  135. 1350 poke54277,0:poke54278,244
  136. 1360 poke54276,33:fori=1to100:next
  137. 1370 poke54276,32
  138. 1380 return
  139. 1390 rem toggle menu on/off
  140. 1400 if mo=1thenmo=0:sys2633:return
  141. 1410 gosub1130
  142. 1420 return
  143. 1430 rem diamonds
  144. 1440 sys2627
  145. 1450 poke781,12:poke782,6:poke783,0:sys65520
  146. 1460 gosub1290
  147. 1470 x=2:gosub480
  148. 1480 poke781,12:poke782,22:poke783,0:sys65520
  149. 1490 gosub1290
  150. 1500 x=2:gosub480
  151. 1510 poke781,6:poke782,14:poke783,0:sys65520
  152. 1520 gosub1290
  153. 1530 x=2:gosub480
  154. 1540 poke781,18:poke782,14:poke783,0:sys65520
  155. 1550 gosub1290
  156. 1560 x=2:gosub480
  157. 1570 x=19:y=12:gosub1000
  158. 1580 return
  159. 1590 rem cyclone
  160. 1600 sys2627
  161. 1610 poke781,3:poke782,1:poke783,0:sys65520
  162. 1620 gosub1290:x=1:gosub480
  163. 1630 poke781,3:poke782,33:poke783,0:sys65520
  164. 1640 gosub1290:x=1:gosub480
  165. 1650 poke781,21:poke782,33:poke783,0:sys65520
  166. 1660 gosub1290:x=1:gosub480
  167. 1670 poke781,21:poke782,1:poke783,0:sys65520
  168. 1680 gosub1290:x=1:gosub480
  169. 1690 poke781,12:poke782,5:poke783,0:sys65520
  170. 1700 gosub1290:x=5:gosub480
  171. 1710 gosub930
  172. 1720 return
  173. 1730 ;
  174. 1740 rem open
  175. 1750 sys2627
  176. 1760 gosub930
  177. 1770 return
  178. 1780 ;
  179. 1790 rem lattice
  180. 1800 sys2627
  181. 1810 print"";
  182. 1820 fori=1to12:print"";:t=7
  183. 1830 if(iand1)=0thenprint"";:t=6
  184. 1840 forj=1tot
  185. 1850 ifrnd(0)<.5thenprint"[193][154][200][157][157][151][201][159][208][145]";:goto1870
  186. 1860 print"[152][193][151][200][157][157][155][201][152][208][145]";
  187. 1870 print"";
  188. 1880 next
  189. 1890 ifi=12then1920
  190. 1900 print"[157][157][157]";
  191. 1910 if(iand1)=0thenprint"";
  192. 1920 next
  193. 1930 gosub930
  194. 1940 return
  195. 1950 rem random
  196. 1960 sys2627
  197. 1970 n=rnd(0)/1.5
  198. 1980 print"";
  199. 1990 fork=1to7:print"";:t=5
  200. 2000 if(kand1)=0thenprint"";:t=4
  201. 2010 forl=1tot
  202. 2020 ifrnd(0)>nthenprint"[145]";:goto2050
  203. 2030 gosub1290
  204. 2040 x=1:gosub480
  205. 2050 print"";
  206. 2060 next
  207. 2070 print"";
  208. 2080 if(kand1)=0thenprint"";
  209. 2090 next
  210. 2100 gosub930
  211. 2110 return
  212. 2120 rem quadrate
  213. 2130 sys2627
  214. 2140 poke781,7:poke782,2:poke783,0:sys65520
  215. 2150 gosub1290:x=int(rnd(0)*3)+1:ifx<3thenfori=1to3-x:print"";:next
  216. 2160 gosub480
  217. 2170 poke781,17:poke782,20:poke783,0:sys65520
  218. 2180 gosub1290:ifx<3thenfori=1to3-x:print"";:next
  219. 2190 gosub480
  220. 2200 poke781,5:poke782,25:poke783,0:sys65520
  221. 2210 gosub1290:x=int(rnd(0)*2)+1:ifx=1thenprint"";
  222. 2220 gosub480
  223. 2230 poke781,19:poke782,3:poke783,0:sys65520
  224. 2240 gosub1290:ifx=1thenprint"";
  225. 2250 gosub480
  226. 2260 gosub930
  227. 2270 return
  228. 2280 rem title screen
  229. 2290 printchr$(142);"[147]"
  230. 2300 poke53248+16,0
  231. 2310 poke2040,33:poke2041,34:poke2042,34
  232. 2320 poke53248+38,2:poke53248+39,14:poke53248+40,10:poke53248+41,5
  233. 2330 poke53248,142:poke53250,142:poke53252,142
  234. 2340 poke53249,147:poke53251,187:poke53253,227
  235. 2350 poke53248+28,7
  236. 2360 printtab(6);t1$
  237. 2370 printtab(6);t2$
  238. 2380 printtab(6);t3$
  239. 2390 printtab(12);"[152]copyright 1990"
  240. 2400 printtab(6);"compute! publications, inc."
  241. 2410 printtab(10);"[152]all rights reserved"
  242. 2420 poke53248+16,0
  243. 2430 poke53248+21,7
  244. 2440 print"battle              [193][194][145][157][195][154][198][157][199][200]       mound"
  245. 2450 print"craft               [151][201][202][157][203][159][206][145][157][207][208]"
  246. 2460 print"unarmed             [155][193][194][145][157][195][151][198][157][199][200]  depression"
  247. 2470 print"spheroid            [201][202][157][203][152][206][145][157][207][208]"
  248. 2480 print"armed                [158][166][166]   teleporter"
  249. 2490 x=0:y=0
  250. 2500 fori=0to8
  251. 2510 t1=i
  252. 2520 t2=i+1:ift2>8thent2=t2-9
  253. 2530 t3=i+2:ift3>8thent3=t3-9
  254. 2540 print"";
  255. 2550 printtab(6);mid$(tc$,t1+1,1);t1$
  256. 2560 printtab(6);mid$(tc$,t2+1,1);t2$
  257. 2570 printtab(6);mid$(tc$,t3+1,1);t3$
  258. 2580 poke781,22:poke782,23:poke783,0:sys65520
  259. 2590 ifx=0thenx=1:print"[158][166][166][157][157][166][166]":goto2610
  260. 2600 x=0:print"[158][166][166][157][157][166][166]"
  261. 2610 geta$:ifa$<>""theny=1:i=8
  262. 2620 j=(peek(56320)andpeek(56321))
  263. 2630 if(jand1)=0or(jand2)=0or(jand4)=0or(jand8)=0or(jand16)=0theny=1:i=8
  264. 2640 nexti
  265. 2650 ify=1then2670
  266. 2660 goto2500
  267. 2670 poke53248+21,0
  268. 2680 return
  269.