home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 197 / 197.d81 / queen / queen.080d / queen.a7ae (.txt)
Encoding:
Commodore BASIC  |  2000-01-01  |  26.5 KB  |  376 lines
  1. 1 rem "queen basic" 2000.09.10
  2. 2 poke55,0:poke56,55:clr
  3. 3 gosub3002
  4. 4 gosub12:onq%goto4002
  5. 5 q%=3:gosub102
  6. 6 gosub12:onq%goto4002,5
  7. 7 onp%(p%,1)gosub142
  8. 8 gosub186:onq%goto4002,5,5,5,4
  9. 10 :
  10. 12 : rem input
  11. 14 :
  12. 16 pokevl+39,1
  13. 18 sysml+9:i%=cr%:on1+(i%=0)goto22:sysml+60,"pehq":on1+(i%=0)goto22
  14. 20 onp%(p%,1)+1goto18,24
  15. 22 oni%gosub502,524,574,590,162:ifq%>2thenonp%(p%,1)goto24:ifb%=-1then18
  16. 24 ifq%=5then18
  17. 26 pokevl+39,7
  18. 28 return
  19. 100 :
  20. 102 : rem next player
  21. 104 :
  22. 106 a%=b%:b%=-1
  23. 108 rem --- player
  24. 110 p%=1-p%:a$="\ "+n$(p%)+" _":gosub120
  25. 112 rem --- move #
  26. 114 m%=m%+1:cy%=14:a$="[205]ove"+right$("  "+str$(m%),4):gosub132
  27. 116 return
  28. 118 :
  29. 120 : rem update player line
  30. 122 :
  31. 124 l%=24:sysml+30,xb%,xb%+l%-1,0,0,160,c%(1)
  32. 126 poke646,c%(6):sysml+12,fnxc(xb%),0,a$:poke646,c%(2)
  33. 128 return
  34. 130 :
  35. 132 : rem update status block
  36. 134 :
  37. 136 l%=15:sysml+30,xs%,xs%+l%-1,cy%,cy%,160,c%(1):sysml+12,fnxc(xs%),cy%,a$
  38. 138 return
  39. 140 :
  40. 142 : rem find computer move
  41. 144 :
  42. 146 ifm%=1thenb%=b%(rnd(1)*(12+10*(o%(1,0)=3))):goto156
  43. 148 b%=a%(a%):ono%(1,0)goto150,152,154
  44. 150 ifb%=29orb%=43thenb%=-1
  45. 152 ifb%=39orb%=60thenb%=-1
  46. 154 ifb%=-1thenb%=a%-d%(rnd(1)*3)
  47. 156 cx%=fnx(b%):cy%=fny(b%)
  48. 157 sysml+24,o%(2,0):sysml+21,cx%+1,cy%+1:sysml+24,o%(2,0)
  49. 158 return
  50. 160 :
  51. 162 : rem check human move
  52. 164 :
  53. 166 b%=(int((cy%-yb%)/3))*8+int((cx%-xb%)/3)
  54. 168 ifm%=1thenf%=(fnr(b%)=7orfnc(b%)=7):goto178
  55. 170 f%=(b%<a%):ifnotf%then178
  56. 172 f%=(fnr(b%)=fnr(a%)):iff%then178
  57. 174 f%=(fnc(b%)=fnc(a%)):iff%then178
  58. 176 c%=a%-b%:f%=(int(c%/9)*9=c%)
  59. 178 ifnotf%thenb%=-1:goto182
  60. 180 cx%=fnx(b%):cy%=fny(b%)
  61. 182 return
  62. 184 :
  63. 186 : rem display move results
  64. 188 :
  65. 190 rem --- queen
  66. 192 gosub206
  67. 194 rem --- win
  68. 198 ifb%=0thenq%=5:a$=n$(p%)+" wins":gosub120
  69. 202 return
  70. 204 :
  71. 206 : rem position crown (sprite 3 & 4)
  72. 208 :
  73. 210 py%=cy%*8+52:px%=cx%*8+24:c%=0:ifpx%>255thenpx%=px%-256:c%=12
  74. 212 pokevl+4,px%:pokevl+5,py%:pokevl+6,px%:pokevl+7,py%:pokevl+16,c%
  75. 213 pokevl+21,15
  76. 214 return
  77. 500 :
  78. 502 : rem play new game
  79. 504 :
  80. 506 q%=2:m%=0:p%=1:gosub512
  81. 508 return
  82. 510 :
  83. 512 : rem new board
  84. 514 :
  85. 516 pokevl+21,3
  86. 518 sysml+48,xb%,xb%+23,yb%,yb%+23,a(0)
  87. 520 return
  88. 522 :
  89. 524 : rem edit setup
  90. 526 :
  91. 528 gosub636
  92. 530 sysml+42,hs%:pokemv,ls%:pokemv+2,14
  93. 532 n%=0
  94. 534 sysml+9:ifcr%=0thensysml+60,"q":oni%+1goto534,566
  95. 536 ifcr%=14then566
  96. 538 ifcr%<12then550
  97. 540 i=cr%-12
  98. 542 w$=n$(i):sysml+156,p%(i,3)+128,p%(i,4),c%(1),c%(1),p%(i,2),0,"[145]",n$(i)
  99. 544 ifn$(i)=w$then534
  100. 546 n%=n%or2^(i+3)
  101. 548 n$(i)=w$:goto534
  102. 550 forj=0to2:i=2-j:f%=(cr%>=o%(i,1)):j=j+(j-2)*f%:next
  103. 552 ifo%(i,2)=cr%then534
  104. 554 n%=n%or2^i
  105. 556 i%=o%(i,2):gosub3540:i%=cr%:gosub3552:f%=cr%-o%(i,1):o%(i,2)=cr%
  106. 558 onigoto562,564
  107. 560 o%(i,0)=f%:goto534
  108. 562 o%(i,0)=f%+1:goto534
  109. 564 o%(i,0)=2^f%*30:goto534
  110. 566 sysml+39,hs%:gosub646
  111. 568 ifn%>0thengosub608
  112. 570 return
  113. 572 :
  114. 574 : rem help
  115. 576 :
  116. 578 gosub636
  117. 580 sysml+42,hh%:pokemv,lh%:pokemv+2,6
  118. 582 sysml+210,1+128,38,3,18,c%(2),0,c%(4),c%(5),0,"",""
  119. 584 gosub646
  120. 586 return
  121. 588 :
  122. 590 : rem quit
  123. 592 :
  124. 594 gosub636
  125. 596 sysml+42,hq%:pokemv,lq%:pokemv+2,2
  126. 598 sysml+9:i%=cr%:ifi%=0thensysml+60,"ny":ifi%=0then598
  127. 600 ifi%=2thenq%=1:goto604
  128. 602 gosub646
  129. 604 return
  130. 606 :
  131. 608 : rem new setup
  132. 610 :
  133. 612 rem --- human
  134. 614 if(n%and1)=0then624
  135. 616 fori=0to1
  136. 618 p%(i,1)=1+((o%(0,0)and2^i)<>0)
  137. 620 cy%=8+3*i:a$=t$(p%(i,1)):gosub132
  138. 622 next
  139. 624 rem --- name(s)
  140. 626 fori=0to1:if(n%and2^(i+3))=0then630
  141. 628 poke646,c%(6):cy%=7+3*i:a$=n$(i):gosub132:poke646,c%(2)
  142. 630 next
  143. 632 return
  144. 634 :
  145. 636 : rem stash game screen
  146. 638 :
  147. 640 pokea(1),peek(vl+21):pokevl+21,3:sysml+39,hg%
  148. 642 return
  149. 644 :
  150. 646 : rem restore game screen
  151. 648 :
  152. 650 sysml+42,hg%:pokemv,lg%:pokemv+2,5:pokevl+21,peek(a(1))
  153. 652 return
  154. 3000 :
  155. 3002 : rem initialize
  156. 3004 :
  157. 3006 dv=peek(186)
  158. 3008 rem --- dim
  159. 3010 dim a%,b%,cc%,c%,cr%,cx%,cy%,f%,h%,hg%,hh%,hs%,hq%,i%,l%,l1%,l2%
  160. 3012 dim lg%,lh%,ls%,lq%,m%,n%,p%,pp%,px%,py%,q%,r1%,r2%,rg%,sc%,sl%,xb%,xs%,yb%
  161. 3014 dim cl,i,j,ml,mm,mv,vl,a$,f$,w$
  162. 3016 dim a%(63),b%(11),c%(6),d%(2),o%(2,2),p%(1,4),a(1),n$(1),t$(1)
  163. 3018 rem --- deffn
  164. 3020 deffnr(x)=int(x/8)
  165. 3022 deffnc(x)=x-fnr(x)*8
  166. 3023 deffnx(x)=xb%+fnc(x)*3
  167. 3024 deffny(x)=yb%+fnr(x)*3
  168. 3025 deffnxc(x)=x+(l%-len(a$))/2
  169. 3026 rem --- sprite
  170. 3028 readf%,a$,h%,l%
  171. 3030 iff%thengosub3502
  172. 3032 rem --- font
  173. 3034 readf%,a$,h%,l%
  174. 3036 iff%thengosub3502
  175. 3038 rem --- mouse
  176. 3040 readf%,a$,h%,l%
  177. 3042 iff%thengosub3502
  178. 3044 ml=h%*256+l%
  179. 3046 mv=ml+309
  180. 3048 pokemv+1,97
  181. 3050 lg%=0:lh%=lg%+5*4:ls%=lh%+6*4:lq%=ls%+14*4:rem region low bytes
  182. 3052 hg%=224:hh%=232:hs%=240:hq%=248:rem stash pages
  183. 3054 n%=98:fori=42to49:n%=n%+1:pokemv+i,n%:next
  184. 3056 rem --- mouse mate
  185. 3058 readf%,a$,h%,l%
  186. 3060 iff%thengosub3502
  187. 3062 mm=h%*256+l%
  188. 3064 pokemm+9,0:rem disable stop
  189. 3066 rem --- curtain
  190. 3068 readf%,a$,h%,l%
  191. 3070 iff%thengosub3502
  192. 3072 cl=h%*256+l%
  193. 3074 rem --- help text
  194. 3076 readf%,a$,h%,l%
  195. 3078 i=h%*256+l%
  196. 3080 iff%thensysml+201,a$,dv,i
  197. 3082 sysml+204,i
  198. 3084 rem --- memory locations
  199. 3086 a(0)=98*256:a(1)=a(0)+1152
  200. 3088 rem --- vic location
  201. 3090 vl=53248
  202. 3092 rem ---
  203. 3094 t$(0)="([200]uman)":t$(1)="([195]omputer)"
  204. 3096 fori=0to11:readb%(i):next
  205. 3098 fori=0to2:readd%(i):next
  206. 3100 fori=0to63:reada%(i):next
  207. 3102 fori=0to6:readc%(i):next
  208. 3104 rem --- screen off
  209. 3106 pokevl+17,11
  210. 3108 rem --- font
  211. 3110 pokevl+24,31
  212. 3112 rem --- setup screen
  213. 3114 pokemv,ls%:pokevl+32,c%(2):pokevl+33,c%(4)
  214. 3116 sysml+126,0,39,0,24,93,95,c%(2),c%(0):sysml+30,5,34,2,19,160,c%(0)
  215. 3119 poke646,c%(0):poke199,1
  216. 3120 fori=1to4:readcx%,cy%,a$:sysml+12,cx%,cy%,a$:next
  217. 3122 fori=1to11:i%=i:readcx%,cy%,l%,a$:gosub3524:next
  218. 3124 l%=16:fori=0to1:i%=12+i:readcx%,cy%,a$:gosub3524
  219. 3126 p%(i,2)=l%-1:p%(i,3)=cx%:p%(i,4)=cy%:n$(i)=a$:next
  220. 3128 l%=8:i%=14:readcx%,cy%,a$:gosub3510:gosub3540
  221. 3130 fori=0to2:reado%(i,0),o%(i,1),o%(i,2):i%=o%(i,2):gosub3548:next
  222. 3132 poke199,0
  223. 3134 sysml+39,hs%
  224. 3136 rem --- quit screen
  225. 3138 pokemv,lq%:pokevl+32,c%(2):pokevl+33,c%(4)
  226. 3140 sysml+126,0,39,0,24,93,95,c%(2),c%(0):sysml+30,10,29,6,15,160,c%(0)
  227. 3142 poke646,c%(0):poke199,1
  228. 3144 readcy%,a$:sysml+27,cy%,a$
  229. 3146 l%=7:fori=1to2:i%=i:readcx%,cy%,a$:gosub3510:gosub3540:next
  230. 3148 poke199,0
  231. 3150 sysml+39,hq%
  232. 3152 rem --- help screen
  233. 3154 pokemv,lh%:pokevl+32,c%(0):pokevl+33,c%(1)
  234. 3156 sysml+30,0,39,0,24,160,c%(0):sysml+30,0,39,2,19,160,c%(4)+16
  235. 3158 poke646,c%(0):poke199,1:readcy%,a$:sysml+27,cy%,a$:poke199,0
  236. 3160 sysml+228,1024+40*cy%+22,1024+40*cy%+30,0
  237. 3162 poke646,c%(3):l%=8:fori=1to4:i%=i:readcx%,cy%,a$:gosub3510:next
  238. 3164 sysml+39,hh%
  239. 3166 rem --- game screen
  240. 3168 pokemv,lg%:pokevl+32,c%(0):pokevl+33,c%(1)
  241. 3170 sysml+30,0,39,0,24,160,c%(0)
  242. 3172 xs%=25:sysml+30,xs%,xs%+14,1,15,160,c%(1)
  243. 3174 poke646,c%(2):poke199,1:a$="[176][177][178][179][180][181][180][181][182][183]":sysml+12,xs%+2,3,a$
  244. 3176 a$="[184][185][186][187][188][189][188][189][190][191]":sysml+12,xs%+2,4,a$:poke199,0
  245. 3178 poke646,c%(3):l%=6:fori=1to4:i%=i:readcx%,cy%,a$:gosub3510:next
  246. 3180 xb%=0:yb%=1:sysml+15,5,xb%,xb%+23,yb%,yb%+23
  247. 3182 sysml+30,xb%,xb%+23,0,0,160,c%(1)
  248. 3184 sysml+36,5,160,10
  249. 3186 f%=1:fori=0to7:cy%=yb%+i*3:f%=1-f%:forj=1to7step2:cx%=xb%+(j-f%)*3
  250. 3188 sysml+30,cx%,cx%+2,cy%,cy%+2,160,2:next:next
  251. 3190 sysml+45,xb%,xb%+23,yb%,yb%+23,a(0):rem board
  252. 3192 poke646,c%(2):gosub502:q%=5:n%=31:gosub608
  253. 3194 sysml+39,hg%
  254. 3196 rem --- title screen
  255. 3198 pokevl+32,c%(0)
  256. 3200 pokevl+33,c%(1)
  257. 3202 sysml+126,0,39,0,24,92,94,c%(0),c%(2)
  258. 3204 sysml+30,3,35,5,13,160,c%(4)+16
  259. 3206 poke646,c%(3)
  260. 3208 poke199,1
  261. 3210 a$="[176][177][178][179][180][181][180][181][182][183]":sysml+27,6,a$
  262. 3212 a$="[184][185][186][187][188][189][188][189][190][191]":sysml+27,7,a$
  263. 3214 poke199,0
  264. 3216 poke646,c%(4)
  265. 3218 sysml+27,9,"by [204]ance [195]. [212]homas"
  266. 3220 sysml+27,11,"(c) 2000 [202][160]& [198] [208]ublishing, [201]nc."
  267. 3222 rem ---
  268. 3224 syscl
  269. 3226 pokevl+17,27
  270. 3228 gosub3556
  271. 3230 syscl+6
  272. 3232 poke198,0:wait198,15:poke198,0
  273. 3234 syscl+9
  274. 3236 pokevl+17,11:sysml+42,hg%:pokevl+17,27
  275. 3238 gosub3556
  276. 3240 syscl+6
  277. 3242 syscl+3
  278. 3244 sysmm
  279. 3246 sysml
  280. 3248 sysml+6,55*256
  281. 3250 sysml+18,1,37,1,22
  282. 3252 poke2042,222:pokevl+41,c%(6):poke2043,223:pokevl+42,7
  283. 3254 poke646,c%(2)
  284. 3256 return
  285. 3500 :
  286. 3502 : rem bload file
  287. 3504 :
  288. 3506 sys57812a$,dv,0:poke780,0:poke781,l%:poke782,h%:sys65493:return
  289. 3508 :
  290. 3510 : rem command button
  291. 3512 :
  292. 3514 sysml+15,i%,cx%,cx%+l%-1,cy%,cy%+2
  293. 3516 sysml+30,cx%,cx%+l%-1,cy%,cy%+2,160,c%(1)
  294. 3518 sysml+12,fnxc(cx%),cy%+1,a$
  295. 3520 return
  296. 3522 :
  297. 3524 : rem setup region
  298. 3526 :
  299. 3528 sysml+15,i%,cx%,cx%+l%-1,cy%,cy%
  300. 3530 ifi%<12thensysml+12,fnxc(cx%),cy%,a$:goto3534
  301. 3532 sysml+12,cx%,cy%,a$
  302. 3534 gosub3540
  303. 3536 return
  304. 3538 :
  305. 3540 : rem region highlight off
  306. 3542 :
  307. 3544 sysml+36,i%,255,c%(1):return
  308. 3546 :
  309. 3548 : rem region highlight on
  310. 3550 :
  311. 3552 sysml+36,i%,255,c%(5):return
  312. 3554 :
  313. 3556 : rem pause
  314. 3558 :
  315. 3560 i=ti
  316. 3562 ifti>ithenifti-i<20then3562
  317. 3564 return
  318. 4000 :
  319. 4002 : rem *** exit
  320. 4004 :
  321. 4006 sysml+3
  322. 4008 pokevl+21,0
  323. 4010 sysmm+3
  324. 4012 poke646,11
  325. 4014 goto40000
  326. 9000 :
  327. 9002 : *** data
  328. 9004 :
  329. 9006 data 00,"spr.queen",55,128
  330. 9008 data 00,"f.queen",56,0
  331. 9010 data 00,"mouse2.1 7k 4000",64,0
  332. 9012 data 00,"mouse mate 6000",96,0
  333. 9014 data 00,"curtain 5c00",92,0
  334. 9016 data 00,"t.queen hlp",103,0
  335. 9018 rem ---
  336. 9020 data 39, 60, 15,23,31,47,55, 57,58,59,61,62
  337. 9022 data 1,8,9
  338. 9024 data -1,00,00,00,00,00,00,00,                00,00,-1,10,10,10,10,10
  339. 9026 data 00,-1,00,10,17,17,17,17,                00,17,17,00,17,-1,29,29
  340. 9028 data 00,17,10,17,00,10,29,-1,                00,17,10,-1,17,00,10,29
  341. 9030 data 00,17,10,43,43,17,00,10,                00,17,10,43,-1,43,17,00
  342. 9032 rem ---
  343. 9034 data 12,15,11,6,0,2,0:rem c%()
  344. 9036 rem --- setup
  345. 9038 data 14,4,"[209]ueen [211]etup"
  346. 9040 data 9,7,"[200]uman      [204]evel   [208]ause"
  347. 9042 data 7,13,"[206]ame  ([208]layer 1)"
  348. 9044 data 7,16,"[206]ame  ([208]layer 2)"
  349. 9046 data 7,8,10,"[206]one",7,9,10,"[208]layer 1",7,10,10,"[208]layer 2",7,11,10,"[194]oth"
  350. 9048 data 20,8,5,"1",20,9,5,"2",20,10,5,"3"
  351. 9050 data 28,8,5,"1",28,9,5,"2",28,10,5,"4",28,11,5,"8"
  352. 9052 data 7,14,"[205]aster [216]",7,17,"[203]nees [195]alhoon"
  353. 9054 data 25,15,"[[209]]uit"
  354. 9056 data 1,1,2, 3,5,7, 30,8,8
  355. 9058 rem --- quit
  356. 9060 data 8,"[209]uit [209]ueen?"
  357. 9062 data 12,11,"[[206]]o ",21,11,"[[217]]es"
  358. 9064 rem --- help
  359. 9066 data 0,"[209]ueen [200]elp [204]ine #### of ####"
  360. 9068 data 1,21,"[[200][207][205][197]]",11,21,"[[213][208]]",21,21,"[[196][207][215][206]]",31,21,"[[209]]uit"
  361. 9070 rem --- game
  362. 9072 data 26,17,"[173][184][185][186][187][188]",33,17,"[173][189][190][191][177][178]",26,21,"[173][179][180][181][182][183]",33,21,"[173][174][175][176][177][178]"
  363. 9999 :
  364. 10000 a$="queen basic"
  365. 10010 dv=peek(186):open15,dv,15,"s0:"+a$:close15:savea$,dv:end
  366. 40000 fori=8to29:poke820+i,i:next:ifdv>8anddv<30thenpoke828,dv:poke820+dv,8
  367. 40010 a$="presenter":gosub40030:a$="hello connect":gosub40030
  368. 40020 print"[147]":poke53272,23:poke186,8:poke2048,0:poke44,8:poke43,1:end
  369. 40030 forj=8to29:i=peek(820+j):ifi=14thennext
  370. 40040 close2:open2,i,2:close2:ifstthen40060
  371. 40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
  372. 40060 next:return
  373. 40070 a$="hello connect":q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
  374. 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
  375. 40090 print"run:":poke631,13:poke632,13:poke198,2:end
  376.