home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 139 / 139side2.d64 / morris (.txt) < prev    next >
Commodore BASIC  |  2022-08-29  |  17KB  |  545 lines
  1. 1 poke53281,0:poke53280,0:poke788,52
  2. 2 dv=peek(186):i=rnd(-ti)
  3. 5 sys57812"resource $1c80",dv,0:poke780,0:poke781,128:poke782,28:sys65493
  4. 6 sys57812"morris ml$c000",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  5. 9 rem*
  6. 10 rem*************************
  7. 20 rem* nine men's morris v1.0
  8. 30 rem* by: robert mundschau
  9. 40 rem* last modified 09/15/95
  10. 50 rem*************************
  11. 60 rem*
  12. 99 rem** main caller
  13. 100 gosub 1000:rem* initialize
  14. 110 gosub 2000:rem* draw title
  15. 120 gosub 2500:rem* main menu
  16. 130 rem* handle main menu selection
  17. 140 if m=3 then sys49162:gosub9200:goto110:rem*display game rules
  18. 150 if m=4 then goto 900:rem*loadstar
  19. 199 rem* m=2 start game
  20. 200 gosub 3000:rem* pre-game set-up
  21. 209 rem* main game loop
  22. 210 lt=ct:ct=(ct+1)and1:gosub9300
  23. 220 ifnp(ct)=0then8700:rem*patched code
  24. 299 rem* yes, place a piece.
  25. 300 w1=2:gosub9400:poke1539,176+np(ct):rem* dsply # left
  26. 310 on (pt(ct)+1) gosub 4000,5000
  27. 320 sp%(sn%(cx,cy))=ct:np(ct)=np(ct)-1
  28. 330 gosub8100:gosub9600:rem*appear
  29. 340 goto500
  30. 399 rem* move a piece. (patch return)
  31. 400 w1=8:gosub9400:rem* dsply your move
  32. 405 on (pt(ct)+1) gosub 4200,6000
  33. 410 ifk<>4then430:rem* move was made
  34. 415 gosub8050:gosub9300:w1=11:gosub9400:gosub9200:gosub9300:goto400:rem* cancel
  35. 420 goto8700:rem* entrapment scan
  36. 429 rem*animate move
  37. 430 gosub9350:sp%(sn%(cx,cy))=2:gosub8900:sp%(sn%(ma(k,0),ma(k,1)))=ct
  38. 435 poke2040,sb+4:gosub9650
  39. 440 gosub8200:fort=4to1step-1:poke2040,sb+t:pokes+1,t*3:forw1=1to50:next:next
  40. 450 w1=(ma(k,0)-cx)*2:w2=(ma(k,1)-cy)*2:rem* dot velocity
  41. 460 fort=12to1step-1:pokes+1,t:pokev,peek(v)+w1:pokev+1,peek(v+1)+w2:next
  42. 470 fort=2to4:poke2040,sb+t:forw1=1to75:next:next
  43. 480 cx=ma(k,0):cy=ma(k,1):gosub9650:poke2040,sb+5
  44. 499 rem* check if mill formed
  45. 500 w1=sn%(cx,cy):m%=0
  46. 510 if(sp%(as%(w1,0))=ct)and(sp%(as%(w1,1))=ct)thenm%=m%+1
  47. 520 if(sp%(as%(w1,2))=ct)and(sp%(as%(w1,3))=ct)thenm%=m%+1
  48. 550 if m%=0 then680:rem* no mill
  49. 599 rem* player formed a mill
  50. 600 gosub8300:gosub9300:w1=5:gosub9400:rem* dsply you have formed a mill.
  51. 610 on(pt(ct)+1)gosub 4500,7000
  52. 620 sp%(sn%(cx,cy))=2:rem* remove piece
  53. 630 gosub8150:gosub9950:rem* animate
  54. 640 m%=m%-1:ifm%>0then600
  55. 649 rem* check for winner
  56. 650 gosub9700:rem* piece count
  57. 660 if(w1+np(0))<3thenqf=1:goto700:rem* moon win
  58. 670 if(w2+np(1))<3thenqf=1:goto800:rem* sun win
  59. 679 rem* has q been pressed
  60. 680 if qf>0 then on (lt+1) goto 800,700
  61. 690 goto210:rem* next player
  62. 699 rem* moons win
  63. 700 gosub9000:poke53280,0:gosub8500:printc$(1)pp$(1):w1$=left$(l$,12)
  64. 710 print"[153]"w1$"  the moon has":printw1$"eclipsed the sun"
  65. 720 printw1$"in their contest":printw1$"  for the sky!"
  66. 730 goto825                                      
  67. 799 rem* suns win
  68. 800 gosub9000:poke53280,6:gosub8500:printc$(0)pp$(0):w1$=left$(l$,11)
  69. 810 poke53281,6:print"[153]"w1$"hip! hip! hooray!":printw1$"      the sun"
  70. 820 printw1$"   has won the":printw1$"       day!"
  71. 825 print"press fire or return"
  72. 830 gosub9050:gosub9200:gosub8100:goto110
  73. 899 rem* return to loadstar
  74. 900 w1$=left$(l$,19):print"[147]"w1$c$(0)pp$(0)
  75. 910 print"[155]do you wish to return to loadstar?"
  76. 920 printw1$"[157][157]([153]y[155]/[150]n[155])?":printw1$c$(1)pp$(1)
  77. 930 getm$:ifm$="n"then110
  78. 940 ifm$<>"y"then930
  79. 950 print"[147][154]thank-you for playing 9 men's morris."
  80. 960 print"[153]please check that the disk is ready and"
  81. 965 print"then press return."
  82. 970 gosub 9200:sys49432:rem* irqs off
  83. 980 poke53272,peek(53272)and240or4:poke44,8:poke43,1:poke2048,0
  84. 990 goto40000
  85. 999 rem* initialize
  86. 1000 print"[147]";:poke53272,peek(53272)and240or14
  87. 1010 l$="":d$=""
  88. 1020 fort=0to10step2:print""left$(d$,t);:fork=0to(22-t):poke646,t*2+7
  89. 1030 w1$=left$(l$,t)+left$("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@",40-t*2)
  90. 1040 fork=0to(22-t*2):printw1$:next:next
  91. 1050 print""left$(l$,11)left$(d$,11)"[159]  setting up...  "
  92. 1059 rem*
  93. 1060 sys 49206:rem* engage irqs
  94. 1065 rem*
  95. 1070 dim gb%(7,7),mf%(7,7),sn%(7,7),as%(24,3),sp%(24),xy%(24,1),pf%(18,1)
  96. 1075 dim ps%(35),cf%(35),cl%(24),ts%(24),mr%(13,17)
  97. 1080 dim jv(31),jx(4),jy(4),pt(1),ma(4,1),np(1)
  98. 1090 dim ms$(13),mc$(1),c$(3),cs$(1),pp$(3),pt$(1)
  99. 1100 mc$(0)="[158]":mc$(1)="[159]":rem* text window color and rvs.
  100. 1110 c$(0)="[158]":c$(1)="[159]"
  101. 1120 pp$(0)="[192][193][157][157][160][161]":pp$(1)="[200][201][157][157][168][169]":pp$(2)="  [157][157]  ":pp$(3)=""
  102. 1130 pt$(0)="[155] person ":pt$(1)="[155]computer"
  103. 1140 cs$(0)="[153]novice":cs$(1)="[129] best "
  104. 1150 mm$(0)="player selection":mm$(1)="computer skill"
  105. 1160 mm$(2)="start game":mm$(3)="game rules":mm$(4)="return to loadstar"
  106. 1170 fort=0to31:jv(t)=4:next:jv(30)=0:jv(29)=2:jv(27)=3:jv(23)=1
  107. 1180 jx(1)=1:jx(3)=-1:jy(0)=-1:jy(2)=1:qf=1
  108. 1199 rem* sprite set-up
  109. 1200 sb=150:v=53248
  110. 1210 pokev+21,1:pokev+16,0:pokev+28,0:pokev+23,30:pokev+27,0:pokev+29,30
  111. 1299 rem* sound set-up
  112. 1300 s=54272:fort=0to24:pokes+t,0:next
  113. 1310 pokes+24,15
  114. 1399 rem* read data
  115. 1400 forcy=0to7:forcx=0to7:readw1:gb%(cx,cy)=w1:next:next
  116. 1410 forcy=0to6:forcx=0to6:readw1:mf%(cx,cy)=w1:next:next
  117. 1420 forcy=0to6:forcx=0to6:readw1:sn%(cx,cy)=w1:next:next
  118. 1430 forcy=0to6:forcx=0to6:w1=sn%(cx,cy):xy%(w1,0)=cx:xy%(w1,1)=cy:next:next
  119. 1439 rem* unpack strings
  120. 1440 fort=0to13:read w1$:w1=len(w1$):w2=1
  121. 1450 ms$(t)=ms$(t)+mid$(w1$,w2,12)+"[157][157][157][157][157][157][157][157][157][157][157][157]":w2=w2+12:ifw2<w1then1450
  122. 1460 next
  123. 1480 fort=1to24:fork=0to3:readw1:as%(t,k)=w1:next:next
  124. 1490 fort=0to18:fork=0to1:readw:pf%(t,k)=w:next:next
  125. 1500 fort=0to35:readw:ps%(t)=w:next
  126. 1510 fort=0to35:readw:cf%(t)=w:next
  127. 1520 fort=1to24:readw:ts%(t)=w:next
  128. 1530 fort=0to17:fork=0to13:readw:mr%(k,t)=w:next:next
  129. 1990 return
  130. 1999 rem* draw title
  131. 2000 gosub9000:print"[147]":poke53280,0:poke53281,0:pokev+21,0
  132. 2010 w1$=""
  133. 2020 printw1$"[220][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][221]"
  134. 2030 printw1$"[255][158][207][208][146] [209][210][211][212][213][214][215][216][217]";
  135. 2040 print"[146]  [209][210][218][219][220][221][220][221][255][223][216][217][146][191]"
  136. 2050 printw1$"[255][159][175][176][146] [177][178][179][180][181][182][183][184][185]";
  137. 2060 print"[146]  [177][178][186][187][188][189][188][189][190][191][184][185][146][191]"
  138. 2070 printw1$"[188][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][189]"
  139. 2100 w2$=left$(l$,10):printw2$"by: robert mundschau"
  140. 2110 printw1$c$(0)pp$(0)w2$"menu[145]"w2$c$(1)pp$(1)
  141. 2120 printw2$"<"w1$w2$">"
  142. 2130 printw2$"<"w1$w2$">"
  143. 2140 printw1$c$(0)pp$(0)w1$w1$w1$w1$"[145]"c$(1)pp$(1)
  144. 2150 print"use [153]joy2 or [153]crsr keys and [153]return"
  145. 2160 printw1$"to make your selections.";
  146. 2170 return
  147. 2499 rem* main menu
  148. 2500 m=0:gosub2900:gosub9050
  149. 2510 gosub2900:gosub9100
  150. 2520 if(cr=1)and(m>1)then:gosub8250:return
  151. 2530 on j goto 2560,2540,2560,2510
  152. 2540 m=m+jy(j):if(m<0)or(m>4)thenm=m-jy(j)
  153. 2550 goto2510
  154. 2560 on (m+1) goto 2700,2600,2510,2510,2510
  155. 2600 cs=(cs+1)and1:gosub8250:goto2510
  156. 2700 ifj=3thenpt(0)=(pt(0)+1)and1:goto2720
  157. 2710 pt(1)=(pt(1)+1)and1:ifpt(1)+pt(0)=2thenpt(0)=0:goto2730
  158. 2720 if pt(1)+pt(0)=2thenpt(1)=0
  159. 2730 gosub8250:goto2510
  160. 2899 rem* update menu
  161. 2900 print""pt$(pt(0))""pt$(pt(1))
  162. 2910 print""cs$(cs)""cs$(cs)"[145][145][145][145]"
  163. 2920 fort=0to4:w2$="[156]":ifm=tthenw2$=c$(p):p=(p+1)and1
  164. 2930 print w2$:print""mm$(t):next:return
  165. 2999 rem** pre-game setup
  166. 3000 gosub9000:poke53280,2
  167. 3010 sys 49157:rem* draw gameboard
  168. 3020 sp%(0)=3:fort=1to24:sp%(t)=2:next
  169. 3030 np(0)=9:np(1)=9:ct=int(rnd(1)*2):poke2040,sb:pokev+21,31
  170. 3039 rem* sprites for thin red strips
  171. 3040 fort=0to3:pokev+40+t,2:poke2041+t,sb+t+6:next
  172. 3050 pokev+2,79:pokev+3,105:pokev+4,135:pokev+5,105:pokev+6,135:pokev+7,161
  173. 3060 pokev+8,79:pokev+9,161
  174. 3080 print""left$(d$,24)"[155] to quit press (q) during your move ";
  175. 3090 qf=0:gosub9050:return
  176. 3999 rem*** human-where place a piece?
  177. 4000 w1=3:gosub9400:rem* dsply select
  178. 4010 gosub9500:rem* pick space routine
  179. 4020 ifsp%(sn%(cx,cy))=2thenreturn
  180. 4030 gosub9300:w1=4:g