home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 212 / 212.d81 / b.life2 / b.080d / b.a7ae (.txt)
Encoding:
Commodore BASIC  |  2002-01-01  |  49.1 KB  |  372 lines
  1. 1 rem "life2 basic" 2001.10.08
  2. 2 poke55,192:poke56,55:clr
  3. 3 gosub3002
  4. 4 gosub12:onq%goto4002
  5. 7 q%=3:gosub102:gosub124:gosub12:onq%goto4002,7:onp%(p%,1)gosub158:gosub190
  6. 8 onq%goto4002,7,7,7,4
  7. 10 :
  8. 12 : rem input
  9. 14 :
  10. 16 pokevl+39,1
  11. 18 sysml+9:i%=cr%:on1+(i%=0)goto22:sysml+60,"pehq":on1+(i%=0)goto22
  12. 20 onp%(p%,1)+1goto18,24
  13. 22 oni%gosub502,520,572,588:onq%goto26,26:onp%(p%,1)goto24:ifi%<5then18
  14. 23 gosub176:ifb%=-1then18
  15. 24 ifq%=5then18
  16. 26 pokevl+39,7
  17. 28 return
  18. 100 :
  19. 102 : rem generation
  20. 104 :
  21. 106 m%=m%+1:ifm%=10000thenm%=0
  22. 108 sysml+12,sx%+12,sy%+10,right$("  "+str$(m%),4)
  23. 110 return
  24. 112 :
  25. 114 : rem population
  26. 116 :
  27. 118 poke646,c%(5+i%):sysml+12,sx%+13,sy%+12+i%,right$(str$(n%),2):poke646,c%(2)
  28. 120 return
  29. 122 :
  30. 124 : rem player
  31. 126 :
  32. 128 p%=1-p%:f%=-1:f$="\ "+n$(p%)+" _"
  33. 130 gosub140
  34. 132 ifo%(1,0)thensysgl+96:rem paint 1x1 (show)
  35. 134 pokegu+30,p%(p%,0):rem p
  36. 136 return
  37. 138 :
  38. 140 : rem status
  39. 142 :
  40. 144 l%=21
  41. 146 sysml+30,bx%,bx%+20,0,0,160,c%(1)
  42. 148 iff%thenpoke646,c%(5+p%)
  43. 150 sysml+12,fnxc(bx%),0,f$
  44. 152 iff%thenpoke646,c%(2)
  45. 154 return
  46. 156 :
  47. 158 : rem computer
  48. 160 :
  49. 162 x=gv+232:gosub252:pokegu+32,l%:pokegu+33,h%:rem q
  50. 164 sysgl+99:rem pattern; in-p,q
  51. 166 sysgl+81:rem find move; in-p, out-n
  52. 168 b%=peek(gv+119+rnd(0)*peek(gu+26))
  53. 170 c%=20:gosub244:rem pause
  54. 172 return
  55. 174 :
  56. 176 : rem human
  57. 178 :
  58. 180 px%=(cx%-bx%)/3:py%=(cy%-by%)/3
  59. 182 b%=py%*8+px%+9
  60. 184 ifpeek(gw+b%)<>0thenb%=-1
  61. 186 return
  62. 188 :
  63. 190 : rem results
  64. 192 :
  65. 194 cx%=bx%+((b%and7)-1)*3
  66. 196 cy%=by%+(int(b%/8)-1)*3
  67. 198 ifp%(p%,1)thensysml+21,cx%,cy%
  68. 200 sysml+30,cx%,cx%+2,cy%,cy%+2,255,peek(gv+p%+1)
  69. 202 pokegw+b%,p%(p%,0)
  70. 204 pokegu+10,p%(p%,0):rem f
  71. 206 x=gw+b%:gosub252:pokegu+48,l%:pokegu+49,h%:rem y
  72. 208 sysgl+84:rem update cell's neighbors; in-f,y
  73. 210 x=gv+7+p%:pokex,peek(x)+1
  74. 212 x=gv+204:gosub252:pokegu+32,l%:pokegu+33,h%:rem q
  75. 214 sysgl+99:rem pattern; in-p,q
  76. 216 c%=40:gosub244:rem pause
  77. 218 f%=0:f$="[194]irth and [196]eath":gosub140
  78. 220 sysgl+96:rem paint 1x1 (move)
  79. 222 c%=120:gosub244:rem pause
  80. 224 sysgl+87:rem birth and death
  81. 226 sysgl+90:rem neighbors
  82. 228 sysgl+93:rem paint 3x3
  83. 230 c%=120:gosub244:rem pause
  84. 232 f%=0
  85. 234 n%=peek(gv+7):i%=0:gosub114:ifn%=0thenf%=2
  86. 236 n%=peek(gv+8):i%=1:gosub114:ifn%=0thenf%=f%or1
  87. 238 iff%>0thenq%=5:p%=f%-1:f%=(p%=0orp%=1):f$="[199]ame [207]ver":gosub140
  88. 240 return
  89. 242 :
  90. 244 : rem pause
  91. 246 :
  92. 248 sysml+24,c%*o%(2,0):return
  93. 250 :
  94. 252 : rem low/high byte
  95. 254 :
  96. 256 h%=x/d%(8):l%=x-h%*d%(8):return
  97. 500 :
  98. 502 : rem play new game
  99. 504 :
  100. 506 q%=2
  101. 508 sysml+48,bx%,bx%+20,by%,by%+20,a(0)
  102. 510 m%=0:gosub102:p%=1
  103. 512 n%=3:i%=0:gosub114:i%=1:gosub114:pokegv+7,n%:pokegv+8,n%
  104. 514 sysml+129,a(1),a(1)+55,gw+9:sysml+129,a(2),a(2)+55,gw+73
  105. 516 return
  106. 518 :
  107. 520 : rem edit setup
  108. 522 :
  109. 524 gosub640
  110. 526 sysml+42,hs%:pokemv,ls%:pokemv+2,13:pokevl+17,27
  111. 528 n%=0
  112. 530 sysml+9:ifcr%=0thensysml+60,"q":oni%+1goto530,564
  113. 532 ifcr%=13then564
  114. 534 ifcr%<11then546
  115. 536 i=cr%-11
  116. 538 w$=n$(i):sysml+156,p%(i,3)+128,p%(i,4),c%(1),c%(1),p%(i,2),0,"[145]",n$(i)
  117. 540 ifn$(i)=w$then530
  118. 542 n%=n%ord%(i+3)
  119. 544 n$(i)=w$:goto530
  120. 546 forj=0to2:i=2-j:f%=(cr%>=o%(i,1)):j=j+(j-2)*f%:next
  121. 548 ifo%(i,2)=cr%then530
  122. 550 n%=n%ord%(i)
  123. 552 i%=o%(i,2):cc%=c%(1):gosub3530:i%=cr%:cc%=c%(4):gosub3530
  124. 554 f%=cr%-o%(i,1):o%(i,2)=cr%
  125. 556 onigoto560,562
  126. 558 o%(0,0)=f%:goto530
  127. 560 o%(1,0)=f%:pokegv+6,13*f%:goto530
  128. 562 o%(2,0)=d%(f%)*60:goto530
  129. 564 sysml+39,hs%:gosub648
  130. 566 ifn%>0thengosub606
  131. 568 return
  132. 570 :
  133. 572 : rem help
  134. 574 :
  135. 576 gosub640
  136. 578 sysml+42,hh%:pokemv,lh%:pokemv+2,6:pokevl+17,27
  137. 580 sysml+210,1+128,38,3,18,c%(2),0,c%(3),c%(4),0,"",""
  138. 582 gosub648
  139. 584 return
  140. 586 :
  141. 588 : rem quit
  142. 590 :
  143. 592 gosub640
  144. 594 sysml+42,hq%:pokemv,lq%:pokemv+2,2:pokevl+17,27
  145. 596 sysml+9:i%=cr%:ifi%=0thensysml+60,"ny":ifi%=0then596
  146. 598 ifi%=2thenq%=1:goto602
  147. 600 gosub648
  148. 602 return
  149. 604 :
  150. 606 : rem new setup
  151. 608 :
  152. 610 l%=17
  153. 612 rem --- human
  154. 614 if(n%andd%(0))=0then624
  155. 616 fori=0to1:p%(i,1)=1+((o%(0,0)andd%(i))<>0):cy%=sy%+3*i+5
  156. 618 sysml+30,sx%+1,sx%+15,cy%,cy%,160,c%(1)
  157. 620 f$=t$(p%(i,1)):sysml+12,fnxc(sx%),cy%,f$
  158. 622 next
  159. 624 rem --- names
  160. 626 fori=0to1:if(n%andd%(i+3))=0then634
  161. 628 cy%=sy%+3*i+4
  162. 630 sysml+30,sx%+1,sx%+15,cy%,cy%,160,c%(1)
  163. 632 poke646,c%(5+i):f$=n$(i):sysml+12,fnxc(sx%),cy%,f$:poke646,c%(2)
  164. 634 next
  165. 636 return
  166. 638 :
  167. 640 : rem stash game screen
  168. 642 :
  169. 644 pokevl+17,11:sysml+39,hg%:return
  170. 646 :
  171. 648 : rem restore game screen
  172. 650 :
  173. 652 pokevl+17,11:sysml+42,hg%:pokemv,lg%:pokemv+2,5:pokevl+17,27:return
  174. 3000 :
  175. 3002 : rem initialize
  176. 3004 :
  177. 3006 rem --- dim
  178. 3008 dim b%,bx%,by%,c%,cc%,cr%,cx%,cy%,f%,h%,hg%,hh%,hs%,hq%,i%
  179. 3010 dim l%,l1%,l2%,lg%,lh%,ls%,lq%,m%,n%,p%,pp%,px%,py%,q%
  180. 3012 dim r1%,r2%,rg%,sc%,sl%,sx%,sy%
  181. 3014 dim dv,gl,gu,gv,gw,i,j,ml,mm,mv,vl,x,f$,w$
  182. 3016 dim c%(6),d%(8),o%(2,2),p%(1,4),a(2),n$(1),t$(1)
  183. 3018 rem --- deffn
  184. 3020 deffnxc(x)=x+(l%-len(f$))/2
  185. 3022 rem --- constants
  186. 3024 dv=peek(186):vl=53248:d%(0)=1:fori=1to8:d%(i)=d%(i-1)*2:next
  187. 3026 rem --- font
  188. 3028 readf%,f$,h%,l%:iff%thengosub3502
  189. 3030 rem --- mouse
  190. 3032 readf%,f$,h%,l%:ml=l%+h%*d%(8):mv=ml+309:iff%thengosub3502
  191. 3034 pokemv+1,93:rem region hi byte
  192. 3036 lg%=0:lh%=lg%+5*4:ls%=lh%+6*4:lq%=ls%+13*4:rem region lo bytes
  193. 3038 hg%=224:hh%=232:hs%=240:hq%=248:rem stash pages
  194. 3040 n%=98:fori=42to49:n%=n%+1:pokemv+i,n%:next
  195. 3042 rem --- mouse mate
  196. 3044 readf%,f$,h%,l%:mm=l%+h%*d%(8):iff%thengosub3502
  197. 3046 pokemm+9,0:rem disable stop
  198. 3048 rem --- ml
  199. 3050 readf%,f$,h%,l%:iff%thengosub3502
  200. 3052 readf%,f$,h%,l%:gl=l%+h%*d%(8):iff%thengosub3502
  201. 3054 readf%,f$,h%,l%:x=l%+h%*d%(8):iff%thengosub3502
  202. 3056 sysgl:sysx:rem initialize
  203. 3058 rem --- memory locations
  204. 3060 a(0)=192*d%(8):a(1)=a(0)+882:a(2)=a(1)+55
  205. 3062 gu=196*d%(8):gv=gu+104:gw=gv+247
  206. 3064 pokegu+42,104:pokegu+43,196:rem v
  207. 3066 pokegu+44,95:pokegu+45,197:rem w
  208. 3068 rem --- help text
  209. 3070 readf%,f$,h%,l%:x=l%+h%*d%(8):iff%thensysml+201,f$,8,x
  210. 3072 sysml+204,x
  211. 3074 rem ---
  212. 3076 t$(0)="([200]uman)":t$(1)="([195]omputer)":p%(0,0)=1:p%(1,0)=16
  213. 3078 fori=0to6:readc%(i):next
  214. 3080 rem --- screen off
  215. 3082 pokevl+17,11
  216. 3084 rem --- font
  217. 3086 pokevl+24,31
  218. 3088 rem --- setup
  219. 3090 pokemv,ls%:pokevl+32,c%(2):pokevl+33,c%(3)
  220. 3092 sysml+126,0,39,0,24,160,160,c%(2),c%(2):sysml+30,9,30,0,22,160,c%(0)
  221. 3094 poke646,c%(0):poke199,1
  222. 3096 fori=1to4:readcx%,cy%,f$:sysml+12,cx%,cy%,f$:next
  223. 3098 cc%=c%(1):fori=1to10:i%=i:readcx%,cy%,l%,f$:gosub3522:next
  224. 3100 l%=16:fori=0to1:i%=11+i:readcx%,cy%,f$:gosub3522
  225. 3102 p%(i,2)=l%-1:p%(i,3)=cx%:p%(i,4)=cy%:n$(i)=f$:next
  226. 3104 l%=8:i%=13:readcx%,cy%,f$:gosub3510:gosub3530
  227. 3106 cc%=c%(4):fori=0to2:reado%(i,0),o%(i,1),o%(i,2):i%=o%(i,2):gosub3530:next
  228. 3108 poke199,0
  229. 3110 sysml+39,hs%
  230. 3112 rem --- quit
  231. 3114 pokemv,lq%:pokevl+32,c%(2):pokevl+33,c%(3)
  232. 3116 sysml+126,0,39,0,24,160,160,c%(2),c%(2):sysml+30,10,29,6,15,160,c%(0)
  233. 3118 poke646,c%(0):poke199,1
  234. 3120 readcx%,cy%,f$:sysml+12,cx%,cy%,f$
  235. 3122 l%=7:cc%=c%(1):fori=1to2:i%=i:readcx%,cy%,f$:gosub3510:gosub3530:next
  236. 3124 poke199,0
  237. 3126 sysml+39,hq%
  238. 3128 rem --- help
  239. 3130 pokemv,lh%:pokevl+32,c%(0):pokevl+33,c%(1)
  240. 3132 sysml+30,0,39,0,24,160,c%(0):sysml+30,0,39,2,19,160,c%(3)+16
  241. 3134 poke646,c%(0):poke199,1:readcy%,f$:sysml+27,cy%,f$:poke199,0
  242. 3136 x=1024+40*cy%:sysml+228,x+22,x+30,0
  243. 3138 poke646,c%(3):l%=8:fori=1to4:i%=i:readcx%,cy%,f$:gosub3510:next
  244. 3140 sysml+39,hh%
  245. 3142 rem --- game
  246. 3144 pokemv,lg%:pokevl+32,c%(0):pokevl+33,c%(1)
  247. 3146 sysml+30,0,39,0,24,160,c%(0)
  248. 3148 sx%=23:sy%=0:sysml+30,sx%,sx%+16,sy%,sy%+14,160,c%(1)
  249. 3150 poke646,c%(2)
  250. 3152 sysml+12,sx%+3,sy%+1,"[171][172][175][176][179][180][183][184][164][187][188]"
  251. 3154 sysml+12,sx%+3,sy%+2,"[173][174][177][178][181][182][185][186] [189][190]"
  252. 3156 poke646,c%(2):sysml+12,sx%+1,sy%+10,"[199]eneration    1"
  253. 3158 poke646,c%(5):sysml+12,sx%+2,sy%+12,"[208]opulation  3"
  254. 3160 poke646,c%(6):sysml+12,sx%+2,sy%+13,"[208]opulation  3"
  255. 3162 bx%=0:by%=2
  256. 3164 fori=0to6:cy%=by%+3*i
  257. 3166 forj=0to6:cx%=bx%+3*j:sysml+30,cx%,cx%+2,cy%,cy%+2,160,c%(1)or16:next
  258. 3168 next
  259. 3170 poke646,c%(3):l%=8:fori=1to4:i%=i:readcx%,cy%,f$:gosub3510:next
  260. 3172 sysml+15,5,bx%,bx%+20,by%,by%+20
  261. 3174 fori=0to6:readcc%:pokegv+i,cc%:next:fori=166to189:readn%:pokegv+i,n%:next
  262. 3176 fori=9to63:pokegw+i,0:next
  263. 3178 fori=0to8:pokegw+i,255:next
  264. 3180 fori=16to56step8:pokegw+i,255:next
  265. 3182 fori=64to384step64:sysml+129,gw,gw+9,gw+i:next
  266. 3184 sysml+129,gw+9,gw+64,gw+73:sysml+129,gw+9,gw+64,gv+64
  267. 3186 sysml+129,gw+9,gw+64,gw+137:pokegw+128+18,1:pokegw+128+54,16
  268. 3188 fori=0to1:pokegu+10,p%(i,0)
  269. 3190 forj=1to3:readb%:x=gw+b%:pokex,p%(i,0):gosub252
  270. 3192 pokegu+48,l%:pokegu+49,h%:sysgl+84:rem update cell's neighbors; in-f,y
  271. 3194 next:next
  272. 3196 sysgl+93:rem paint 3x3
  273. 3198 sysml+45,bx%,bx%+20,by%,by%+20,a(0)
  274. 3200 sysml+129,gw+9,gw+64,a(1):sysml+129,gw+73,gw+128,a(2)
  275. 3202 poke646,c%(2):n%=31:gosub606:q%=5
  276. 3204 sysml+39,hg%
  277. 3206 rem --- title
  278. 3208 pokevl+32,c%(0):pokevl+33,c%(1)
  279. 3210 sysml+126,0,39,0,24,160,160,c%(0),c%(0)
  280. 3212 sysml+30,3,35,5,13,160,c%(3)+16
  281. 3214 poke646,c%(3)
  282. 3216 sysml+27,6,"[171][172] [175][176] [179][180] [183][184] [164] [187][188]"
  283. 3218 sysml+27,7,"[173][174] [177][178] [181][182] [185][186]   [189][190]"
  284. 3220 poke646,c%(2)
  285. 3222 sysml+27,9,"(c) 2001 [202] & [198] [208]ublishing, [201]nc."
  286. 3224 sysml+27,11,"by [204]ance [195]. [212]homas"
  287. 3226 rem ---
  288. 3228 pokevl+17,27:gosub3538
  289. 3230 poke198,0:wait198,15:poke198,0
  290. 3232 gosub648:gosub3538
  291. 3234 sysmm:sysml:sysml+6,192+55*d%(8):sysml+18,1,37,1,22:poke646,c%(2)
  292. 3236 ifabs((peek(53433)and128)=128)=0thenpoke53374,0:poke53366,0:poke53375,0
  293. 3238 return
  294. 3500 :
  295. 3502 : rem bload file
  296. 3504 :
  297. 3506 sys57812f$,8,0:poke780,0:poke781,l%:poke782,h%:sys65493:return
  298. 3508 :
  299. 3510 : rem command button
  300. 3512 :
  301. 3514 sysml+15,i%,cx%,cx%+l%-1,cy%,cy%+2
  302. 3516 sysml+30,cx%,cx%+l%-1,cy%,cy%+2,160,c%(1):sysml+12,fnxc(cx%),cy%+1,f$
  303. 3518 return
  304. 3520 :
  305. 3522 : rem setup region
  306. 3524 :
  307. 3526 sysml+15,i%,cx%,cx%+l%-1,cy%,cy%:sysml+12,cx%,cy%,f$:gosub3530:return
  308. 3528 :
  309. 3530 : rem paint region
  310. 3532 :
  311. 3534 sysml+36,i%,255,cc%:return
  312. 3536 :
  313. 3538 : rem pause
  314. 3540 :
  315. 3542 i=ti
  316. 3544 ifti>ithenifti-i<20then3544
  317. 3546 return
  318. 3548 :
  319. 4002 : rem *** exit
  320. 4004 :
  321. 4006 sysml+3:pokevl+21,0:sysmm+3
  322. 4009 ifabs((peek(53433)and128)=128)=0thenpoke53374,0:poke53367,0:poke53375,0
  323. 4010 goto40000
  324. 9000 :
  325. 9002 : *** data
  326. 9004 :
  327. 9006 data 00,"f.life2",56,0
  328. 9008 data 00,"mouse2.1 7k 4000",64,0
  329. 9010 data 00,"mouse mate 5c00",92,0
  330. 9012 data 00,"life2 pttrn",94,0
  331. 9014 data 00,"life2a.zml",130,0
  332. 9016 data 00,"life2b.zml",199,0
  333. 9018 data 00,"t.life2 hlp",160,0
  334. 9020 rem ---
  335. 9022 data 12,15,11,0,2,2,6:rem c%()
  336. 9024 rem --- setup
  337. 9026 data 14,2,"[204][201][198][197]-2 [211]etup"
  338. 9028 data 12,5,"[200]uman [211]how [208]ause"
  339. 9030 data 12,11,"[206]ame       ([210]ed)"
  340. 9032 data 12,14,"[206]ame      ([194]lue)"
  341. 9034 data 12,6,5,"[206]one",12,7,5,"[210]ed",12,8,5,"[194]lue",12,9,5,"[194]oth"
  342. 9036 data 18,6,4,"[206]o",18,7,4,"[217]es"
  343. 9038 data 23,6,5,"  0",23,7,5,"  1",23,8,5,"  2",23,9,5,"  4"
  344. 9040 data 12,12,"[205]elqart",12,15,"[197]shmun"
  345. 9042 data 16,18,"[[209]]uit"
  346. 9044 data 1,1,2, 0,5,5, 1,7,8
  347. 9046 rem --- quit
  348. 9048 data 14,8,"[209]uit [204][201][198][197]-2?"
  349. 9050 data 12,11,"[[206]]o ",21,11,"[[217]]es"
  350. 9052 rem --- help
  351. 9054 data 0,"[204][201][198][197]-2 [200]elp [204]ine #### of ####"
  352. 9056 data 1,21,"[[200][207][205][197]]",11,21,"[[213][208]]",21,21,"[[196][207][215][206]]",31,21,"[[209]]uit"
  353. 9058 rem --- game
  354. 9060 data 23,17,"[[208]]lay",32,17,"[[197]]dit",23,21,"[[200]]elp",32,21,"[[209]]uit"
  355. 9062 data 144,146,150:rem 3x3 color codes
  356. 9064 data 0,10,14,0:rem 1x1 color codes
  357. 9066 data 0,9,16, 0,16,9, 8,7,16, 8,16,7, 64,9,0, 64,0,9, 72,7,0, 72,0,7
  358. 9068 data 09,10,17, 63,62,55:rem initial cells
  359. 9999 :
  360. 10000 a$="life2 basic":ifdv<8ordv>29thendv=8
  361. 10010 open15,dv,15,"s0:"+a$:close15:savea$,dv:end
  362. 40000 fori=8to29:poke820+i,i:next:ifdv>8anddv<30thenpoke828,dv:poke820+dv,8
  363. 40010 a$="presenter":gosub40030:a$="hello connect":gosub40030
  364. 40020 print"[147]":poke53272,23:poke53280,11:poke53281,0:poke646,13:end
  365. 40030 forj=8to29:i=peek(820+j):ifi=14thennext
  366. 40040 close2:open2,i,2:close2:ifstthen40060
  367. 40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
  368. 40060 next:return
  369. 40070 a$="hello connect":q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
  370. 40080 print"[147]p[207]2048,0:p[207]44,8:p[207]43,1:p[207]56,160:p[207]55,0:clr:l[207]"q$a$q$","i
  371. 40090 print"run:":poke631,13:poke632,13:poke198,2:end
  372.