home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64Games / KLONDIKE-SOLITAIRE (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  8.3 KB  |  287 lines
  1. 0 X=RND(-TI)
  2. 10 DIMST(7),ST$(7,12),PL(7),PL$(7,6),F$(4),D$(24),N$(52),CS$(12):POKE53269,0
  3. 20 GOSUB10000:GOSUB11000:GOSUB12000:GOSUB13000:GOSUB14000:GOSUB15000:GOSUB16000
  4. 30 GOSUB17000:POKEV+21,4:GOSUB1500
  5. 40 GOTO6000
  6. 100 REM THIS IS THE MAIN GAME PLAYING ROUTINE
  7. 105 CT=0:FORI=1TO7:CT=CT+ST(I):NEXTI:IFCT=0THENIFN=52THEN20000
  8. 110 GETI$:GOSUB500:IFI$=""THEN110
  9. 120 IFI$="R"THEN1000
  10. 130 IFI$="L"THEN2000
  11. 140 IFI$="P"THEN3000
  12. 150 IFI$="D"THEN4000
  13. 160 IFI$="F"THEN5000
  14. 170 IFI$="N"THEN6000
  15. 180 IFI$="E"THEN7000
  16. 190 IFI$=CHR$(133)THENGOSUB16500
  17. 195 IFI$=CHR$(134)THENGOSUB16300
  18. 200 GOTO100
  19. 500 REM THIS ROUTINE IS USED TO READ THE JOYSTICK
  20. 510 JS=127-PEEK(56320)
  21. 520 IFJS=0THENGOTO599
  22. 530 IFJS=1THENI$="D":GOTO590
  23. 540 IFJS=8THENI$="R":GOTO590
  24. 550 IFJS=2THENI$="P":GOTO590
  25. 560 IFJS=4THENI$="L":GOTO590
  26. 570 IFJS=18THENI$="N":GOTO590
  27. 580 IFJS=17THENI$="F":GOTO590
  28. 590 FORA=1TO50:NEXTA
  29. 599 RETURN
  30. 1000 REM THIS ROUTINE MOVES THE SPRITE TO THE RIGHT
  31. 1010 IFSC>7THEN100
  32. 1020 SC=SC+1:GOSUB1500:GOTO100
  33. 1500 REM MOVE SPRITE(S)
  34. 1510 IFSC<7THENPOKEV+16,0:POKEV+4,(SC-1)*40+22:POKEV+5,SY:GOTO1599
  35. 1520 IFSC=7THENPOKEV+21,4:POKEV+16,5:POKEV+4,7:POKEV+5,SY:GOTO1599
  36. 1530 POKEV+21,1
  37. 1599 RETURN
  38. 2000 REM THIS ROUTINE MOVES THE SPRITE TO THE LEFT
  39. 2010 IFSC<2THEN100
  40. 2020 SC=SC-1:GOSUB1500:GOTO100
  41. 3000 REM THIS ROUTINE PICKS UP CARD(S)
  42. 3010 IFH=1THENE$="YOU HAVE CARDS IN YOUR HAND":GOTO9000
  43. 3050 IFSC<8THEN3100
  44. 3060 IFD<1THENE$="THERE ARE NO CARDS TO PICK UP":GOTO9000
  45. 3070 CS$(1)=D$(D):CS=1:D=D-1:GOSUB3500:FR=SC:GOTO3199
  46. 3100 IFST(SC)<1THENE$="THERE ARE NO CARDS TO PICK UP":GOTO9000
  47. 3110 FORX=1TOST(SC):CS$(X)=ST$(SC,X):NEXTX
  48. 3120 CS=ST(SC)
  49. 3130 GOSUB3600:ST(SC)=0:FR=SC:GOTO3199
  50. 3199 H=1:GOTO100
  51. 3500 REM THIS ROUTINE PRINTS THE BACK OF A CARD AT THE BOTTOM OF THE SCREEN
  52. 3510 PRINTCHR$(19);:FORX=1TO21:PRINTCHR$(13);:NEXTX
  53. 3520 PRINTCHR$(156);:FORX=1TO3:PRINTTAB(35)"[166][166][166][166]";CHR$(13);:NEXTX
  54. 3530 Y=2018:Z=56290:Y1=102:Z1=4    
  55. 3540 FORX=1TO4:POKEY+X,Y1:POKEZ+X,Z1:NEXTX:PRINTCHR$(19);
  56. 3599 RETURN
  57. 3600 REM PRINT BACK OF CARD ON STACK
  58. 3610 PRINTCHR$(31);CHR$(19);:K=ST(SC)+3:FORX=1TOK:PRINTCHR$(13);:NEXTX    
  59. 3620 FORX=1TOK
  60. 3630 PRINTTAB((SC-1)*5)CHR$(18);"    ";CHR$(13);CHR$(145);:PRINTCHR$(145);
  61. 3640 NEXTX
  62. 3670 PRINTCHR$(146);CHR$(156);
  63. 3675 IFPL(SC)=0THEN3699
  64. 3680 FORX=1TO4:PRINTCHR$(13);TAB((SC-1)*5)"[166][166][166][166]";:NEXTX
  65. 3699 RETURN
  66. 4000 REM DROP STACK OF CARDS IN YOUR HAND
  67. 4010 REM ERROR CHECKING
  68. 4050 IFSC<8THEN4100
  69. 4060 IFCS$(1)="   "THENE$="YOU ARE NOT HOLDING ANY CARDS":GOTO9000
  70. 4065 IFFR<8THENE$="YOU CAN NOT DROP THESE CARDS HERE.":GOTO9000
  71. 4070 D=D+1:D$(D)=CS$(1):GOSUB6500:GOTO4999
  72. 4100 IFCS<1THENE$="YOU ARE NOT HOLDING ANY CARDS":GOTO9000
  73. 4101 IFST(SC)=0THEN4111
  74. 4102 SU$=CS$(1):GOSUB5500:GOSUB5600:DS=DE:SS=SU
  75. 4104 SU$=ST$(SC,ST(SC)):GOSUB5500:GOSUB5600
  76. 4106 IFDE<>DS+1THENE$="YOU CAN'T PLAY THAT CARD HERE":GOTO9000
  77. 4107 IFSS=1ORSS=3THENSS=SS+1
  78. 4108 IFSU=1ORSU=3THENSU=SU+1
  79. 4109 IFSS=SUTHENE$="YOU CAN'T PLAY THAT COLOR HERE":GOTO9000
  80. 4110 GOTO4115
  81. 4111 IFSC=FRTHEN4115
  82. 4112 IFLEFT$(CS$(1),1)<>"K"THENE$="YOU CAN ONLY PUT A KING HERE":GOTO9000
  83. 4115 FORX=1TOCS:ST(SC)=ST(SC)+1:ST$(SC,ST(SC))=CS$(X):NEXTX
  84. 4120 X=SC:GOSUB18000:IFSC=FRTHEN4999
  85. 4123 IFFR>7THEN4150
  86. 4125 IFPL(FR)>0THEN4130
  87. 4126 IFPL(FR)=0THENPRINTCHR$(19);CHR$(13);CHR$(31);:FORX=1TO4
  88. 4127 PRINTTAB((FR-1)*5)S3$;CHR$(13);:NEXTX:FR=0:GOTO4999
  89. 4130 ST(FR)=1:ST$(FR,ST(FR))=PL$(FR,PL(FR)):PL(FR)=PL(FR)-1:X=FR:GOSUB18000
  90. 4140 GOTO4999
  91. 4150 IFD>0THENGOSUB6500:GOTO4999
  92. 4160 PRINTCHR$(19);:FORX=1TO21:PRINTCHR$(13);:NEXTX                        
  93. 4170 FORX=1TO3:PRINTTAB(35)"    ";CHR$(13);:NEXTX
  94. 4180 Y=2018:Z=56290:Y1=32:Z1=1
  95. 4190 FORX=1TO4:POKEY+X,Y1:POKEZ+X,Z1:NEXTX:PRINTCHR$(19);:GOTO4999
  96. 4999 H=0:CS=0:CS$(1)="   ":GOTO100
  97. 5000 REM FOUNDATION ROUTINE
  98. 5010 IFH=1THENE$="YOU HAVE CARDS IN YOUR HAND":GOTO9000
  99. 5020 IFSC<8THEN5050
  100. 5030 IFD<1THENE$="THERE IS NO CARD TO FOUNDATION":GOTO9000
  101. 5040 SU$=D$(D):GOSUB5500:GOSUB5600:DS=DE:GOTO5100
  102. 5050 IFST(SC)<1THENE$="THERE IS NO CARD TO FOUNDATION":GOTO9000
  103. 5060 SU$=ST$(SC,ST(SC)):GOSUB5500:GOSUB5600:DS=DE
  104. 5100 SU$=F$(SU):GOSUB5600
  105. 5110 IFDE<>DS-1THENE$="YOU CAN'T FOUNDATION THIS CARD":GOTO9000
  106. 5120 IFSC<8THENF$(SU)=ST$(SC,ST(SC)):GOTO5140
  107. 5130 F$(SU)=D$(D)
  108. 5140 S1$=CO$(VAL(RIGHT$(F$(SU),1)))+CHR$(18)+CHR$(32)
  109. 5145 PRINTCHR$(19);
  110. 5150 PRINTCHR$(13);:IFSU>1THENFORX=1TO(SU-1)*5:PRINTCHR$(13);:NEXTX
  111. 5160 PRINTTAB(35)S1$;LEFT$(F$(SU),2);S2$;CHR$(13);
  112. 5170 FORZ=1TO3:PRINTTAB(35)S3$;CHR$(13);:NEXTZ:PRINTCHR$(19);
  113. 5180 IFSC<8THEN5250
  114. 5190 D=D-1:IFD>0THENGOSUB6500:GOTO100
  115. 5200 FORX=1TO21:PRINTCHR$(13);:NEXTX
  116. 5210 FORX=1TO3:PRINTTAB(35)"    ";CHR$(13);:NEXTX
  117. 5220 Y=2018:Z=56290:Y1=32:Z1=1
  118. 5230 FORX=1TO4:POKEY+X,Y1:POKEZ+X,Z1:NEXTX:PRINTCHR$(19);:GOTO100
  119. 5250 ST(SC)=ST(SC)-1:IFST(SC)>0THEN5400
  120. 5260 IFPL(SC)>0THEN5300
  121. 5265 PRINTCHR$(19);CHR$(13);CHR$(31);
  122. 5270 FORX=1TO4:PRINTTAB((SC-1)*5);S3$;CHR$(13);:NEXTX
  123. 5280 GOTO100
  124. 5300 ST(SC)=1:ST$(SC,1)=PL$(SC,PL(SC)):PL(SC)=PL(SC)-1
  125. 5310 X=SC:GOSUB18000:GOTO100
  126. 5400 IFSU>2THENPRINTCHR$(144);
  127. 5410 IFSU<3THENPRINTCHR$(28);
  128. 5420 FORX=1TOST(SC)+1:PRINTCHR$(13);:NEXTX
  129. 5430 FORX=1TO3:PRINTTAB((SC-1)*5)S3$;CHR$(13);:NEXTX
  130. 5440 PRINTCHR$(31);TAB((SC-1)*5)S3$;CHR$(19);:GOTO100
  131. 5500 REM CONVERT SUIT TO A NUMBER
  132. 5510 SU=1:IFMID$(SU$,2,1)="[216]"THENSU=2
  133. 5520 IFMID$(SU$,2,1)="[211]"THENSU=3
  134. 5530 IFMID$(SU$,2,1)="[218]"THENSU=4
  135. 5599 RETURN
  136. 5600 REM CONVERT DENOMINATION TO A NUMBER
  137. 5610 DE=VAL(LEFT$(SU$,1)):IFDE>0THEN5699
  138. 5615 IFLEFT$(SU$,1)="A"THENDE=1
  139. 5620 IFLEFT$(SU$,1)="T"THENDE=10
  140. 5630 IFLEFT$(SU$,1)="J"THENDE=11
  141. 5640 IFLEFT$(SU$,1)="Q"THENDE=12
  142. 5650 IFLEFT$(SU$,1)="K"THENDE=13
  143. 5699 RETURN
  144. 6000 REM DEAL NEXT CARD
  145. 6005 IFH=1THENE$="YOU HAVE CARDS IN YOUR HAND":GOTO9000
  146. 6010 IFN=52THENE$="THERE ARE NO MORE CARDS LEFT.":GOTO9000
  147. 6020 D=D+1:N=N+1:D$(D)=N$(N)
  148. 6030 GOSUB6500:GOTO100
  149. 6500 REM PRINT LATEST DISCARD
  150. 6510 PRINTCHR$(19);:FORX=1TO21:PRINTCHR$(13);:NEXTX
  151. 6520 S1$=CO$(VAL(RIGHT$(D$(D),1)))+CHR$(18)+CHR$(32)
  152. 6530 PRINTTAB(35)S1$;LEFT$(D$(D),2);S2$;CHR$(13);
  153. 6540 FORZ=1TO2:PRINTTAB(35)S3$;CHR$(13);:NEXTZ
  154. 6550 Y=2018:Z=56290:Y1=160:Z1=0:IFRIGHT$(D$(D),1)="1"THENZ1=2
  155. 6560 FORX=1TO4:POKEY+X,Y1:POKEZ+X,Z1:NEXTX:PRINTCHR$(19);
  156. 6599 RETURN
  157. 7000 REM THIS ROUTINE ALLOWS THE OPTION OF NEW GAME OR CONTINUATION
  158. 7010 PRINTCHR$(19);:FORX=1TO19:PRINTCHR$(13);:NEXTX
  159. 7020 PRINTCHR$(18);CHR$(31);"NEW GAME - (Y/N/C)?";CHR$(13);
  160. 7030 GETA$:IFA$=""THEN7030
  161. 7040 IFA$="Y"THENRUN
  162. 7045 IFA$="N"THEN20120
  163. 7050 PRINTCHR$(13);CHR$(145);CHR$(145);
  164. 7060 C$="        ":C$=C$+C$+C$+C$+"  "
  165. 7070 PRINTCHR$(18);C$;CHR$(13);:PRINTCHR$(18);C$;
  166. 7080 GOTO100
  167. 9000 REM DISPLAY ERROR MESSAGES ON SCREEN
  168. 9010 PRINTCHR$(19);:FORX=1TO19:PRINTCHR$(13);:NEXTX
  169. 9020 PRINTCHR$(18);CHR$(31);E$;CHR$(13);
  170. 9030 PRINTCHR$(18);"PRESS ANY KEY TO CONTINUE";
  171. 9040 GETA$:IFA$<>""THEN9050
  172. 9045 IF127-PEEK(56320)<>16THEN9040
  173. 9050 PRINTCHR$(13);CHR$(145);CHR$(145);
  174. 9060 C$="        ":C$=C$+C$+C$+C$+"  "
  175. 9070 PRINTCHR$(18);C$;CHR$(13);:PRINTCHR$(18);C$;
  176. 9080 GOTO100
  177. 10000 REM THIS ROUTINE DRAWS THE COVER SCREEN
  178. 10010 PRINTCHR$(147);:POKE53281,10:POKE53280,2
  179. 10020 FORX=1TO8:PRINTCHR$(13);:NEXTX
  180. 10030 PRINTTAB(11)CHR$(144);"S O L I T A I R E"
  181. 10040 PRINTCHR$(13):PRINTCHR$(13)
  182. 10050 PRINTTAB(18)CHR$(28);"BY";CHR$(13)
  183. 10060 PRINTTAB(10)"DONNA AND SAM SHUPE"
  184. 10070 FORX=1TO200:NEXTX
  185. 10999 RETURN
  186. 11000 REM THIS ROUTINE INITIALIZES THE ORIGINAL DECK OF CARDS
  187. 11010 Y=0:S$="[218]":C$="1":GOSUB11100:RESTORE
  188. 11020 Y=1:S$="[211]":GOSUB11100:RESTORE
  189. 11030 Y=2:S$="[193]":C$="2":GOSUB11100:RESTORE
  190. 11040 Y=3:S$="[216]":GOSUB11100
  191. 11050 GOTO11999
  192. 11100 FORX=1TO13:READN1$:N$(X+Y*13)=N1$+S$+C$:NEXT:RETURN
  193. 11110 DATA A,2,3,4,5,6,7,8,9,T,J,Q,K
  194. 11999 RETURN
  195. 12000 REM THIS ROUTINE SHUFFLES THE CARDS 2 TIMES
  196. 12010 FORN=1TO52:Y=INT(RND(1)*52)+1
  197. 12020 N1$=N$(N):N$(N)=N$(Y):N$(Y)=N1$
  198. 12030 NEXTN
  199. 12040 FORN=1TO52:Y=INT(RND(1)*52)+1
  200. 12050 N1$=N$(N):N$(N)=N$(Y):N$(Y)=N1$
  201. 12060 NEXTN
  202. 12999 RETURN
  203. 13000 REM THIS ROUTINE INITIALIZES THE SPRITE POINTER
  204. 13010 V=53248:POKE2042,13:POKE2040,14
  205. 13020 FORN=0TO62:READQ:POKE832+N,Q:NEXT
  206. 13030 POKEV+41,7
  207. 13100 DATA 0,7,224,0,7,224,0,7,224,0,7,224,0,7,224,0,7,224
  208. 13110 DATA 0,63,250,0,63,250,0,63,250,0,63,250,0,63,250,0,63,250
  209. 13120 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  210. 13130 DATA 0,0,0,0,0,0,0,0,0
  211. 13220 FORN=0TO62:READQ:POKE896+N,Q:NEXT
  212. 13230 POKEV+39,7
  213. 13300 DATA 0,15,192,0,15,192,0,15,192,0,15,255,0,15,255,0,15,255
  214. 13310 DATA 0,15,255,0,15,255,0,15,255,0,15,192,0,15,192,0,15,192
  215. 13320 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  216. 13330 DATA 0,0,0,0,0,0,0,0,0
  217. 13999 RETURN
  218. 14000 REM THIS ROUTINE INITIALIZES ALL POINTERS
  219. 14010 D=0:SC=1:SY=190:POKEV,10:POKEV+1,230
  220. 14020 FORX=1TO7:ST(X)=1:NEXT
  221. 14030 FORX=1TO7:PL(X)=X-1:NEXT
  222. 14040 CO$(1)=CHR$(28):CO$(2)=CHR$(144)
  223. 14999 RETURN
  224. 15000 REM THIS ROUTINE DEALS THE CARDS TO THE STACKS AND UNKNOWN PILES
  225. 15010 N=0
  226. 15020 FORX=1TO7
  227. 15030 IFPL(X)>0THENFORY=1TOPL(X):N=N+1:PL$(X,Y)=N$(N):NEXTY
  228. 15040 N=N+1:ST$(X,1)=N$(N)
  229. 15050 NEXTX
  230. 15999 RETURN
  231. 16000 REM THIS ROUTINE DRAWS THE INITIAL SCREEN OF CARDS
  232. 16010 PRINTCHR$(147);:POKE53281,1:POKE53280,14
  233. 16020 S2$=CHR$(32)+CHR$(146):S3$=CHR$(18)+"    "+CHR$(146)
  234. 16030 CL$="        ":CL$=CL$+"     SOLITAIRE    "+CL$
  235. 16035 PRINTCHR$(31);CHR$(18);CL$
  236. 16040 CL$="        ":CL$=CL$+CL$+CL$+CL$+"  "
  237. 16050 FORX=1TO20:PRINTCHR$(31);CHR$(18);CL$:NEXTX:Y1=160:Z1=6
  238. 16060 GOSUB16300
  239. 16120 Y=1983:Z=56255:FORX=1TO34:POKEY+X,Y1:POKEZ+X,Z1:NEXTX:PRINTCHR$(19);
  240. 16199 RETURN
  241. 16300 REM PRINT KEYBOARD INSTRUCTIONS
  242. 16310 PRINTCHR$(19);CHR$(31);:FORX=1TO21:PRINTCHR$(17);:NEXTX
  243. 16320 CL$="N-NEXT    F-FOUNDATION    E-END   "
  244. 16330 PRINTCHR$(18);CL$
  245. 16340 CL$="L-LEFT    D-DROP         F1-JOYSTK"
  246. 16350 PRINTCHR$(18);CL$
  247. 16360 CL$="R-RIGHT   P-PICK UP         INSTR "
  248. 16370 PRINTCHR$(18);CL$
  249. 16399 RETURN
  250. 16500 REM PRINT JOYSTICK INSTRUCTIONS
  251. 16510 PRINTCHR$(19);CHR$(31);:FORX=1TO21:PRINTCHR$(17);:NEXTX
  252. 16520 CL$=" ^-DROP       FIRE +      E-END   "
  253. 16530 PRINTCHR$(18);CL$
  254. 16540 CL$=" V-PICK UP  ^-FOUNDATION F3-KEYBRD"
  255. 16550 PRINTCHR$(18);CL$
  256. 16560 CL$="<->L & R    V-NEXT          INSTR "
  257. 16570 PRINTCHR$(18);CL$
  258. 16599 RETURN
  259. 17000 REM THIS ROUTINE DRAWS THE INITIAL STACKS OF CARDS
  260. 17010 FORX=1TO7
  261. 17020 GOSUB18000
  262. 17030 NEXTX
  263. 17999 RETURN
  264. 18000 REM PLACE STACK OF CARDS ON SCREEN
  265. 18010 PRINTCHR$(19);CHR$(13);
  266. 18020 FORY=1TOST(X)
  267. 18030 S1$=CO$(VAL(RIGHT$(ST$(X,Y),1)))+CHR$(18)+CHR$(32)
  268. 18050 PRINTTAB((X-1)*5)S1$;LEFT$(ST$(X,Y),2);S2$;CHR$(13);
  269. 18060 NEXTY
  270. 18070 FORZ=1TO3:PRINTTAB((X-1)*5);S3$;CHR$(13);:NEXTZ                     
  271. 18999 RETURN
  272. 20000 REM YOU FINALLY DID IT
  273. 20005 POKE53269,0
  274. 20010 PRINTCHR$(147);:FORX=1TO8:PRINTCHR$(13);:NEXTX
  275. 20020 PRINTTAB(11)CHR$(144);"CONGRATULATIONS!"
  276. 20030 FORJ=1TO10
  277. 20040 POKE53281,J:POKE53280,J+5
  278. 20050 FORI=1TO200:NEXT
  279. 20060 NEXTJ
  280. 20080 FORI=1TO5:PRINTCHR$(13):NEXTI
  281. 20090 PRINTCHR$(28);"   PLAY AGAIN? (Y/N)";
  282. 20100 GETA$:IFA$=""THEN20100
  283. 20110 IFA$="Y"THENRUN
  284. 20120 PRINTCHR$(147);CHR$(154);:POKE53281,6:POKE53280,14
  285. 20130 POKE53269,0
  286. 20999 END
  287.