home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 226 / 226.d81 / petals.pkd / petals.080d / petals.a7ae (.txt)
Encoding:
Commodore BASIC  |  2003-01-01  |  48.7 KB  |  266 lines
  1. 1 rem "petals.bas" 2003.07.14
  2. 2 poke55,0:poke56,56:clr:gosub3002
  3. 10 rem --- play new game
  4. 12 q=0:p=1:n=13:cc%=47:fora=0to12:x=x%(a,1):gosub620:a%(a,0)=-1:next
  5. 14 rem --- next move
  6. 16 o=p:p=1-p:m=2:cc%=102:x=y%(o,1):gosub620:cc%=230:x=y%(p,1):gosub620
  7. 18 rem --- input
  8. 20 sysml+9:ifcr%>0theni%=cr%:goto28
  9. 22 ifl2%thenonp%(p)goto36
  10. 24 ifr2%theni=1-p:gosub614:i=p:gosub614:goto30
  11. 26 sysml+60,"qp12":ifi%=0then30
  12. 28 oni%goto40000,10,34,34
  13. 30 onqgoto20:onp%(p)goto20
  14. 32 gosub302:goto50
  15. 34 i=i%-3:gosub614:goto20
  16. 36 rem --- human
  17. 38 ifsc%=32then20
  18. 40 ifsc%=13thenonmgoto14,20
  19. 42 ifm=1thenifa=sc%then14
  20. 44 ifnota%(sc%,0)then20
  21. 46 ifm=1thenifa%(a,1)<>sc%anda%(a,2)<>sc%then20
  22. 48 a=sc%:gosub608:ifmthenifa%(a%(a,1),0)ora%(a%(a,2),0)then20
  23. 50 rem --- results
  24. 52 ifnthen14
  25. 54 q=1:goto18:rem win
  26. 300 :
  27. 302 : rem computer                          :
  28. 304 ifm=1then464:human move
  29. 306 ifn=13theni%=13*rnd(0):a=i%:i%=2*rnd(0):m=i%+1:goto458:1st move
  30. 308 rem --- find groups
  31. 310 i=0:j=-1:k=0
  32. 312 ifa%(i,0)=jthen318
  33. 314 ifj=0thenb%(0,0)=i:b%(0,2)=0:goto322:1st occupied petal
  34. 316 j=0
  35. 318 i=a%(i,2)
  36. 320 goto312
  37. 322 ifa%(i,0)thenb%(k,1)=i:b%(k,2)=b%(k,2)+1:goto334
  38. 324 k=k+1
  39. 326 i=a%(i,2)
  40. 328 ifi=b%(0,0)then340:found
  41. 330 ifa%(i,0)thenb%(k,0)=i:b%(k,2)=0:goto322
  42. 332 goto326
  43. 334 i=a%(i,2)
  44. 336 ifi=b%(0,0)then340:found
  45. 338 goto322
  46. 340 rem --- one group
  47. 342 ifk=1thenh=0:m=2-(nand1):goto440
  48. 344 rem ---
  49. 346 i=k-1:h=i:j=i
  50. 348 i=i-1
  51. 350 ifb%(i,2)>b%(h,2)thenh=i
  52. 352 ifb%(i,2)<b%(j,2)thenj=i
  53. 354 ifi>0then348
  54. 356 m=1:rem if loss take 1 from largest
  55. 358 if(kand1)=1then400
  56. 360 rem --- two,four or six groups
  57. 362 ifb%(h,2)=b%(j,2)then440:loss
  58. 364 ifk=6then398
  59. 366 l=b%(h,2)-b%(j,2)
  60. 368 ifl>2then398
  61. 370 ifk=2then396
  62. 372 i=k:l1%=0:l2%=0:r1%=0:r2%=0
  63. 374 i=i-1
  64. 376 ifb%(i,2)=b%(h,2)thenl1%=l1%+1:goto386
  65. 378 ifb%(i,2)=b%(j,2)thenl2%=l2%+1:goto386
  66. 380 ifr1%=0theni%=i:r1%=b%(i,2):goto386
  67. 382 ifb%(i,2)=r1%thenr1%=r1%+1:goto386
  68. 384 r2%=b%(i,2)
  69. 386 ifi>0then374
  70. 388 ifl1%=2andl2%=2then440:loss
  71. 390 ifr1%=1andr2%=1then440:loss
  72. 392 ifl1%=2andl2%=1thenh=i%:l=1:goto396
  73. 394 ifl1%=1andl2%=2thenl=1
  74. 396 a=b%(h,0):m=l:goto458
  75. 398 m=1+(b%(h,2)and1):goto440
  76. 400 rem --- three or five groups
  77. 402 ifb%(h,2)=1thenm=1:goto440:all 1
  78. 404 ifb%(h,2)=2thenifb%(j,2)=2thenm=2:goto440:all 2
  79. 406 ifb%(h,2)=b%(j,2)then440:loss
  80. 408 i=k:l1%=0:l2%=0:i%=-1
  81. 410 i=i-1
  82. 412 ifb%(i,2)=b%(h,2)thenl1%=l1%+1:goto418
  83. 414 ifb%(i,2)=b%(j,2)thenl2%=l2%+1:goto418
  84. 416 i%=i:rem only for 3 groups
  85. 418 ifi>0then410
  86. 420 ifk=5then436
  87. 422 ifl1%=1then428
  88. 424 ifb%(j,2)>2then440:loss
  89. 426 h=j:goto438:l1%=2, l2%=1
  90. 428 ifi%=-1then438
  91. 430 l=b%(h,2)-b%(j,2)-b%(i%,2)
  92. 432 ifl=1orl=2thena=a%(b%(h,0),2):m=l:goto458
  93. 434 goto440:loss
  94. 436 ifl1%=2andl2%=3thenh=j:rem b%(h,2)=1
  95. 438 m=2-(b%(h,2)and1)
  96. 440 rem --- 1st petal
  97. 442 i%=(b%(h,2)-1)/2
  98. 444 oni%goto448,450,452,454,456
  99. 446 a=b%(h,0):goto458
  100. 448 a=a%(b%(h,0),2):goto458
  101. 450 a=a%(a%(b%(h,0),2),2):goto458
  102. 452 a=a%(a%(a%(b%(h,0),2),2),2):goto458
  103. 454 a=a%(a%(a%(a%(b%(h,0),2),2),2),2):goto458
  104. 456 a=a%(a%(a%(a%(a%(b%(h,0),2),2),2),2),2)
  105. 458 rem --- move
  106. 460 gosub602
  107. 462 ifm=1thena=a%(a,2):gosub602
  108. 464 return
  109. 600 :
  110. 602 : rem move pointer                      :
  111. 604 sysml+24,15:sysml+21,x%(a,0),y%(a,0):sysml+24,30:gosub608:return
  112. 606 :
  113. 608 : rem clear marker                      :
  114. 610 cc%=255:x=x%(a,1):gosub620:a%(a,0)=0:m=m-1:n=n-1:return
  115. 612 :
  116. 614 : rem toggle player                     :
  117. 616 p%(i)=1-p%(i):pokesp+2+i,i%(p%(i)):pokev+41+i,i%(p%(i)+2):return
  118. 618 :
  119. 620 : rem paint 2x2 block                   :
  120. 622 pokex,cc%:pokex+1,cc%:pokex+40,cc%:pokex+41,cc%
  121. 624 return
  122. 3000 :
  123. 3002 : rem init                              :
  124. 3006 dim cc%,cr%,cx%,cy%,i%,l1%,l2%,pp%,px%,py%,r1%,r2%,rg%,sc%
  125. 3010 dim a,d,gs,h,i,j,k,l,m,ml,mm,mv,n,o,p,pb,pc,sc,sp,q,v,x
  126. 3020 dim a%(12,2),b%(5,2),i%(3),p%(1),x%(12,1),y%(12,1)
  127. 3038 v=53248:d=peek(186):ifd<8thend=8
  128. 3040 deffnpx(x)=x*sin(a)+160.5
  129. 3042 deffnpy(x)=x*cos(a)+100.5
  130. 3100 rem --- font
  131. 3102 gosub3502
  132. 3104 rem --- player sprites                      i%(0+p) - ptr; i%(2+p) - color
  133. 3106 gosub3502:i%(0)=1:i%(1)=2:i%(2)=6:i%(3)=10
  134. 3108 rem --- grafscripter
  135. 3110 gosub3502:gs=x:sc=39936:pb=96:pc=92
  136. 3112 rem --- mouse
  137. 3114 gosub3502:ml=x:mv=x+156:pokemv+1,203
  138. 3116 gosub3502:mm=x:pokemm+9,0
  139. 3118 poke53280,6:poke53281,6:poke53282,15:rem colors
  140. 3196 rem --- colors
  141. 3198 poke53280,6:poke53281,6:poke53282,15
  142. 3200 rem ---                                     x%() & y%() are pixel x,y
  143. 3202 sysgs,pb,pc:rem open
  144. 3204 sysgs+3,5:rem mode
  145. 3206 poke53265,11
  146. 3208 a=0:i=2*(NULL)/13
  147. 3210 forj=0to12:a=a+i
  148. 3212 x%(j,0)=fnpx(32):y%(j,0)=fnpy(24):x%(j,1)=fnpx(120):y%(j,1)=fnpy(90)
  149. 3214 next
  150. 3216 i=1:cc%=1:gosub3514
  151. 3218 sysgs+27,160,100,cc%:rem fill
  152. 3220 i=0:cc%=0:gosub3514
  153. 3222 sysgs+27,160,100,cc%
  154. 3224 forj=0to12
  155. 3226 sysgs+6,x%(j,0),y%(j,0),cc%:rem plot
  156. 3228 sysgs+9,x%(j,1),y%(j,1),cc%:rem line
  157. 3230 next
  158. 3232 rem ---
  159. 3234 syssc,pb,pc,56
  160. 3236 syssc+3,"[154]"
  161. 3238 syssc+6,17,0,"[181][182][183][184][185][186]"
  162. 3240 syssc+3,"[158]"
  163. 3242 f$="[187][187][187][187][187][187][187][187]"
  164. 3244 syssc+6,18,10,left$(f$,4):syssc+6,17,11,left$(f$,6)
  165. 3246 syssc+6,17,12,left$(f$,6)
  166. 3248 syssc+6,17,13,left$(f$,6):syssc+6,18,14,left$(f$,4)
  167. 3250 rem ---
  168. 3254 rem x%(,0) & y%(,0) are char x,y            for markers
  169. 3255 rem x%(,1) is color memory address          for markers (address < 32768)
  170. 3256 rem y%(0,1) is color memory address         for p0 move (address < 32768)
  171. 3257 rem y%(1,1) is color memory address         for p1 move (address < 32768)
  172. 3258 rem screen codes @ 1024 mark petals         (0-12), center(13) & n/a(32)
  173. 3259 sysml+30,0,39,0,24,32,14:rem n/a
  174. 3260 syssc+3,"[155][151]"
  175. 3262 l=8
  176. 3264 fori=1to4
  177. 3266 readcx%,cy%,f$
  178. 3268 gosub3524
  179. 3270 next
  180. 3271 syssc+3,"[155]"
  181. 3272 l=2:f$="[188][189][190][191]"
  182. 3274 fori=0to12
  183. 3276 readx%(i,0),y%(i,0)
  184. 3278 cx%=x%(i,0):cy%=y%(i,0):gosub3530
  185. 3280 x%(i,1)=pc*256+cy%*40+cx%
  186. 3282 next
  187. 3283 syssc+3,""
  188. 3284 l=2:f$="[177][178][179][180]":cx%=35:cy%=4
  189. 3286 fori=0to1
  190. 3288 cx%=38-cx%
  191. 3290 gosub3530
  192. 3292 y%(i,1)=pc*256+cy%*40+cx%
  193. 3294 next
  194. 3384 fori=0to12
  195. 3386 readpp%:x=1024+pp%
  196. 3388 readi%:ifi%>-1thenx=x+i%:pokex,i:goto3388
  197. 3390 next
  198. 3392 i=13
  199. 3394 sysml+30,18,21,10,14,i,14
  200. 3396 sysml+30,17,17,11,13,i,14:sysml+30,22,22,11,13,i,14
  201. 3400 rem ---                                     spr ptr @ colormappg*256+1016
  202. 3402 sysml+6,64*256
  203. 3404 sp=pc*256+1016:pokesp,0:pokesp+1,0
  204. 3406 pokev+37,2:pokev+38,9:pokev+28,12
  205. 3408 pokev+4,60:pokev+5,53:pokev+6,60:pokev+7,53:pokev+16,8
  206. 3410 p%(0)=0:p%(1)=1:fori=0to1:gosub614:next
  207. 3416 fori=0to12:reada%(i,1),a%(i,2):next
  208. 3418 sysmm:sysml:sysml+18,0,38,0,22:pokev+21,15
  209. 3420 poke53265,59
  210. 3422 return
  211. 3500 :
  212. 3502 : rem bload                             :
  213. 3506 readl,h,f$:x=l+h*256
  214. 3508 rem sys57812f$,d,0:poke780,0:poke781,l:poke782,h:sys65493
  215. 3510 return
  216. 3512 :
  217. 3514 : rem circle                            :
  218. 3516 sysgs+6,x%(12,i),y%(12,i),cc%
  219. 3518 forj=0to12:sysgs+9,x%(j,i),y%(j,i),cc%:next
  220. 3520 return
  221. 3522 :
  222. 3524 : rem region                            :
  223. 3526 gosub3530:sysml+15,i,cx%,cx%+l-1,cy%,cy%+i%:return
  224. 3528 :
  225. 3530 : rem print block                       :
  226. 3532 i%=len(f$)/l-1:forh=0toi%:syssc+6,cx%,cy%+h,mid$(f$,h*l+1,l):next:return
  227. 9000 :
  228. 9002 data 000, 056, f.petals
  229. 9004 data 064, 064, spr.petals
  230. 9006 data 000, 144, grafscripter
  231. 9008 data 000, 192, mouse2.1 jr c000
  232. 9010 data 000, 202, mouse mate ca00
  233. 9101 data 32,22,"         [[209]]uit         "
  234. 9102 data  0,22,"         [[208]]lay         "
  235. 9103 data  0, 0,"         [1]            "
  236. 9104 data 32, 0,"         [2]            "
  237. 9106 data 26,18, 30,15, 31,10, 28,07,             24,04, 19,03, 14,04, 10,07
  238. 9114 data 07,10, 08,15, 12,18, 16,20,             22,20
  239. 9206 data 623,0,41,1,39,1,1,1,38,1,1,1,1,37,1,1,1,37,1,1,-1
  240. 9207 data 585,0,1,1,1,1,1,1,1,1,34,1,1,1,1,1,37,1,1,1,39,-1
  241. 9208 data 393,0,36,1,1,1,1,33,1,1,1,1,1,1,1,32,1,1,1,1,1,1,1,1,-1
  242. 9209 data 229,0,39,1,1,37,1,1,1,1,35,1,1,1,1,1,34,1,1,1,36,-1
  243. 9210 data 144,0,1,1,37,1,1,1,1,1,35,1,1,1,37,1,1,37,1,1,38,1,39,-1
  244. 9211 data 97,0,1,1,1,1,1,36,1,1,1,37,1,1,1,37,1,1,1,38,1,39,1,39,1,-1
  245. 9212 data 133,0,1,1,36,1,1,1,1,1,37,1,1,1,38,1,1,39,1,1,39,1,40,-1
  246. 9213 data 210,0,39,1,1,37,1,1,1,1,36,1,1,1,1,1,38,1,1,1,41,-1
  247. 9214 data 366,0,40,1,1,1,1,36,1,1,1,1,1,1,1,33,1,1,1,1,1,1,1,1,-1
  248. 9215 data 566,0,1,1,1,1,1,1,1,1,33,1,1,1,1,1,35,1,1,1,38,-1
  249. 9216 data 616,0,38,1,37,1,1,1,35,1,1,1,1,36,1,1,1,38,1,1,-1
  250. 9217 data 658,0,1,38,1,1,38,1,1,37,1,1,1,36,1,1,1,1,36,1,1,1,1,37,1,1,1,-1
  251. 9218 data 660,0,1,39,1,1,38,1,1,38,1,1,1,37,1,1,1,1,36,1,1,1,1,36,1,1,1,-1
  252. 9300 data 12,1, 0,2, 1,3, 2,4, 3,5, 4,6, 5,7, 6,8, 7,9, 8,10, 9,11, 10,12, 11,0
  253. 9999 :
  254. 10000 d=8:f$="0:petals.bas":open15,d,15,"s"+f$:close15:savef$,d:end
  255. 40000 pokev+21,0:print"[147]";:sysgs+3,4:sysml+3:sysmm+3:poke53280,14:poke646,14
  256. 40004 fori=8to29:poke820+i,i:next:ifd>8andd<30thenpoke828,d:poke820+d,8
  257. 40010 f$="presenter":gosub40030:f$="hello connect":gosub40030
  258. 40020 poke186,8:poke2048,0:poke44,8:poke43,1:poke56,160:poke55,0:clr:new
  259. 40030 forj=8to29:i=peek(820+j):ifi=14thennext
  260. 40040 close2:open2,i,2:close2:ifstthen40060
  261. 40050 close15:open15,i,15,"r0:"+f$+"="+f$:input#15,er:close15:ifer=63then40070
  262. 40060 next:return
  263. 40070 f$="hello connect":q$=chr$(34):poke646,peek(53281)
  264. 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$f$q$","i
  265. 40090 print"run:":poke631,13:poke632,13:poke198,2:end
  266.