home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 5 / 005.d81 / solataire (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  10KB  |  284 lines
  1. 10 rem card game
  2. 20 rem by donna k. woody
  3. 25 printchr$(147):s=54272:pokes+24,8:pokes+6,0:pokes+1,255:pokes+4,8
  4. 30 poke783,peek(783)and254:poke53281,1:rem clear plot flag
  5. 40 gosub4999:rem initialize deck
  6. 50 gosub6000:rem title page
  7. 60 gosub5300:rem shuffle deck
  8. 70 gosub5400:rem print out movement info
  9. 80 printchr$(19):rem home but don't clear
  10. 90 h=0:v=2:z=0:pi=0:co=0:qq=0:forx=1to8:pa$(x)="":next
  11. 94 t=1:rem print out numbers for piles
  12. 95 forx=1to8:printtab(t);x;
  13. 96 t=t+5
  14. 97 next
  15. 100 forco=1to52:rem deal cards
  16. 104 pi=pi+1:ifpi>8thenpi=8:goto260
  17. 105 qq=52-co:q=23:w=25-(len(str$(qq))-1)
  18. 106 q$=" "+right$(str$(qq),len(str$(qq))-1):gosub200
  19. 107 rem line 105 & 106 prints # of cards left in deck
  20. 108 pa$(pi)=d$(co)
  21. 110 q=v:w=h:q$=ca$:gosub200:rem print card
  22. 120 q=v+1:w=h+1:q$=pa$(pi):gosub200:gosub340:rem print rank
  23. 122 q=v+5:w=11:q$=wa$:gosub200:rem get choice
  24. 123 gosub500:ifk>0thenk=o:goto600:rem ck to see if valid moves if not quit
  25. 124 gosub220:rem get key press
  26. 125 if(a$=chr$(34)ora$=chr$(19)ora$=chr$(147))then124
  27. 126 q=v+5:w=27:q$=a$:gosub200:rem print keypress
  28. 127 ifa$="n"then145:rem get next card
  29. 128 ifa$="e"thengosub900:rem end game
  30. 130 ifasc(a$)>48andasc(a$)<58then1000:rem if number pickup card
  31. 140 goto124
  32. 145 h=h+5
  33. 146 ifco=53then122
  34. 170 nextco:rem deal next card
  35. 175 gosub500:ifk>0thenk=o:goto600:rem ck to see if valid moves if not quit
  36. 180 ifpi=1andco=0then300:rem you won
  37. 181 goto122
  38. 198 :
  39. 199 ren *** print card ***
  40. 200 poke781,q:poke782,w:sys65520:printq$;
  41. 210 return
  42. 218 :
  43. 219 rem *** get character from keyboard ***
  44. 220 a$="":poke198,0:wait198,1:geta$
  45. 230 return
  46. 240 :
  47. 250 rem *** try to have more than 8 piles ***
  48. 260 q=16:w=0:q$="you are limited to 8 piles.            ":gosub200
  49. 270 q=18:w=0:q$="play on the piles you already have.":gosub200:goto122
  50. 298 :
  51. 299 rem *** you won ***
  52. 300 printchr$(147)
  53. 310 forx=1to100:print"*** you won!!![160]***";:next
  54. 320 goto950
  55. 329 :
  56. 330 rem *** sound effects ***
  57. 340 pokes+24,6:pokes+5,128:pokes+4,129:fori=1to50:next:pokes+4,128:pokes+5,.
  58. 350 pokes+24,.:pokes+24,15:pokes+4,129:pokes+4,128:return
  59. 398 :
  60. 399 rem *** you lost ***
  61. 400 q=12:w=0:q$="that's too bad.                        ":gosub200
  62. 410 q=14:w=0:q$="you lost this game.                    ":gosub200
  63. 415 print:print:print"                                       [145][145][145]"
  64. 420 ifpi>1thenprint:print:print"you had  "pi"  piles left.             ":goto430
  65. 425 print:print:print"                                       "
  66. 430 goto950
  67. 498 :
  68. 499 rem *** check to see if you can move ***
  69. 500 ifpa$(8)=""thenk=o:return
  70. 505 k=0
  71. 510 for lc = 1 to 4
  72. 520 if right$(pa$(lc),1)=right$(pa$(lc+4),1) then k=k+1:rem check suit
  73. 530 next
  74. 540 if k <4  thenk=0:return
  75. 550 for pc=1to7
  76. 560 forlc = pc+1 to pc+3
  77. 570 if mid$(pa$(pc),2,1)=mid$(pa$(lc),2,1) then k=0 :pc=5:lc=pc+3
  78. 575 next
  79. 580 next
  80. 590 return
  81. 598 :
  82. 599 rem *** no valid moves - end? ***
  83. 600 q=16:w=0:q$="there are no legal plays left.":gosub200
  84. 610 q=18:w=0:q$="press space bar to continue.           ":gosub200:gosub220
  85. 620 goto410:rem print out score
  86. 698 :
  87. 699 rem *** invalid move ***
  88. 700 q=16:w=0:q$="you can only move to an adjacent pile  ":gosub200
  89. 710 q=18:w=0:q$="or jump one or two piles.              ":gosub200
  90. 720 goto1170
  91. 898 :
  92. 899 rem *** end game or another ***
  93. 900 q=16:w=0:q$="do you want to end this game (y/n)?   ":gosub200
  94. 910 q=18:w=0:q$="                                       ":gosub200
  95. 920 gosub220:ifa$="y"then 400
  96. 930 ifa$="n"thenq=16:w=0:q$="                                    ":gosub200:return
  97. 940 goto920
  98. 950 q=18:w=0:q$="do you want to play again (y/n)?    ":gosub200
  99. 960 gosub220:ifa$="y"thengoto60
  100. 970 ifa$="n"then 990
  101. 980 goto960
  102. 990 print"[147]load"chr$(34)"payload"chr$(34)",8":print"run"
  103. 992 poke631,13:poke632,13:poke198,2:end
  104. 998 :
  105. 999 rem *** pick up card ***
  106. 1000 a=val(a$):rem 'a' is card to pick up
  107. 1005 ifa=1then124
  108. 1020 ifa<=pithen1050:rem check for valid pile
  109. 1030 goto124:rem not valid pile
  110. 1039 :
  111. 1040 rem *** blank out card ***
  112. 1050 h1=5*(a-1):rem horizontal location
  113. 1060 q=v:w=h1:q$=ba$:gosub200
  114. 1070 :
  115. 1080 rem *** drop card ***
  116. 1090 q=v+5:w=11:q$=wc$:gosub200:rem drop where
  117. 1100 gosub220:q=v+5:w=30:q$=a$:gosub200:rem print keypress
  118. 1105 b=val(a$):rem b is where to drop card
  119. 1110 ifb<=pithen1122:rem check for valid pile
  120. 1120 goto1090:rem not valid pile
  121. 1122 lz=a-b:iflz<1then700:rem not valid move
  122. 1123 iflz>3then700:rem not valid move
  123. 1129 :
  124. 1130 rem *** does suit or rank match ***
  125. 1140 ifright$(pa$(a),1)=right$(pa$(b),1)then1205:rem suit match
  126. 1150 ifmid$(pa$(a),2,1)=mid$(pa$(b),2,1)then1205:rem rank match
  127. 1159 :
  128. 1160 rem *** illegal play ***
  129. 1170 q=v:w=h1:q$=bl$:gosub200:rem white out background
  130. 1180 q=v+1:w=h1+1:q$=pa$(a):gosub200:rem print rank
  131. 1190 goto122:rem go back to get another choice
  132. 1199 :
  133. 1200 rem *** legal play drop card ***
  134. 1205 h2=5*(b-1):rem horizontal location
  135. 1210 q=v+1:w=h2+1:iflen(pa$(a))=4thenq$=pa$(a):gosub200:gosub340:goto1240
  136. 1220 q$=pa$(a)+" ":gosub200:gosub340:rem print suit
  137. 1229 :
  138. 1230 rem *** erase picked up card ***
  139. 1240 q=v:w=h1:q$=er$:gosub200:rem erase card
  140. 1242 pa$(b)=pa$(a):pa$(a)="":rem erase value for card
  141. 1249 :
  142. 1250 rem *** was 'a' last card in line ***
  143. 1260 ifa=pithenpi=pi-1:z=z-1:h=h-5:goto122:rem no blank spaces
  144. 1269 :
  145. 1270 rem *** fill in blank spaces ***
  146. 1280 fore=b+1topi-1:rem from card moved +1to last pile
  147. 1290 ifpa$(e)<>""then 1370
  148. 1300 pa$(e)=pa$(e+1):rem move card down
  149. 1310 h=5*(e-1):rem horizontal location for card
  150. 1320 q=v:w=h:q$=ca$:gosub200:rem print card
  151. 1330 q=v+1:w=h+1:q$=pa$(e):gosub200:gosub340:rem print rank
  152. 1340 h=h+5:rem erase e+1 card location
  153. 1350 q=v:w=h:q$=er$:gosub200:rem erase card
  154. 1360 pa$(e+1)=""
  155. 1370 nexte
  156. 1379 :
  157. 1380 rem *** return to get another choice
  158. 1390 h=h-5:pi=pi-1:z=z-1:goto122
  159. 4996 :
  160. 4997 rem *** set up card arrays ***
  161. 4999 dimd$(52),pa$(24)
  162. 5000 forx=1to13:x$=str$(x):d$(x)=right$(x$,len(x$)-1):next
  163. 5010 forx=14to26:x$=str$(x-13):d$(x)=right$(x$,len(x$)-1):next
  164. 5020 forx=27to39:x$=str$(x-26):d$(x)=right$(x$,len(x$)-1):next
  165. 5030 forx=40to52:x$=str$(x-39):d$(x)=right$(x$,len(x$)-1):next
  166. 5040 d$(1)="a":d$(11)="j":d$(12)="q":d$(13)="k":d$(24)="j":d$(25)="q":d$(26)="k"
  167. 5050 d$(37)="j":d$(38)="q":d$(39)="k":d$(50)="j":d$(51)="q":d$(52)="k"
  168. 5060 d$(14)="a":d$(27)="a":d$(40)="a"
  169. 5070 forx=1to13:d$(x)=""+d$(x)+"[211]":next
  170. 5080 forx=14to26:d$(x)="[144]"+d$(x)+"[193]":next
  171. 5090 forx=27to39:d$(x)=""+d$(x)+"[218]":next
  172. 5100 forx=40to52:d$(x)="[144]"+d$(x)+"[216]":next
  173. 5198 :
  174. 5199 rem *** card shape ***
  175. 5200 ca$="[144][176][195][195][195][174][157][157][157][157][157][194]   [194][157][157][157][157][157][194]   [194][157][157][157][157][157][194]   [194][157][157][157][157][157][173][195][195][195][189]"
  176. 5210 ba$="[159][166][166][166][157][157][157][157][157][166][166][166][157][157][157][157][157][166][166][166][157][157][157][157][157]"
  177. 5220 bl$="   [157][157][157][157][157]   [157][157][157][157][157]   [157][157][157][157][157][146]"
  178. 5230 er$="[146]     [157][157][157][157][157]     [157][157][157][157][157]     [157][157][157][157][157]     [157][157][157][157][157]     [146]"
  179. 5240 wa$="[144]which (1-8,e,n)?      [157][157][157][157][157]"
  180. 5250 wc$="[144]drop on which pile?[160]"
  181. 5290 return
  182. 5298 :
  183. 5299 rem *** shuffle deck ***
  184. 5300 printchr$(147):q=22:w=13:q$="shuffling deck":gosub200
  185. 5310 forco=1to52:rem rnd deck & print * while waiting
  186. 5320 c%=(rnd(q9)*52)+1
  187. 5330 t$=d$(co):d$(co)=d$(c%):d$(c%)=t$:rem interchange cards - shuffle
  188. 5340 a%=(rnd(q9)*20)+1:b%=(rnd(q9)*39)+1:rem rnd points for star
  189. 5350 poke781,a%:poke782,b%:sys65520:print"*"
  190. 5360 next
  191. 5370 return
  192. 5398 :
  193. 5399 rem *** print out movement info ***
  194. 5400 printchr$(147):rem clear home
  195. 5410 poke781,22:poke782,0:sys65520
  196. 5420 print"[144]<1-8> - pick up card   <n> - next card"
  197. 5430 print"[144]<e>   - exit game          - cards left"
  198. 5440 return
  199. 5998 :
  200. 5999 rem *** title page ***
  201. 6000 printchr$(147);chr$(142);chr$(8):rem clear home
  202. 6010 forx=1to30:rem print cards for title page
  203. 6020 h%=(rnd(1)*34)+1:rem rnd horizontal position
  204. 6030 v%=(rnd(1)*15)+1:rem rnd vertical position
  205. 6040 c%=(rnd(1)*52)+1:rem rnd card
  206. 6050 q=v%:w=h%:q$=ca$:gosub200:rem print card
  207. 6060 q=v%+1:w=h%+1:q$=d$(c%):gosub200:gosub340:rem print rank
  208. 6070 n