Compucolor.org – Virtual Media

Listing of file='SOL.BAS;01' on disk='vmedia/chip_90-sector.ccvf'

10 DIM DE(51),DE$(51),BO(6,19),AC(3),CD(9),FC(7,2),PP(3)
20 FOR I= 0TO 51:READ DE$(I):NEXT I
30 FOR I= 0TO 9:READ CD(I):NEXT I
35 FOR I= 0TO 3:READ PP(I):NEXT I
45 FOR I= 0TO 2:FOR J= 0TO 7:READ FC(J,I):NEXT J,I
50 DATA "As","2s","3s","4s","5s","6s","7s"
55 DATA "8s","9s","10s","Js","Qs","Ks"
60 DATA "Ah","2h","3h","4h","5h","6h"
65 DATA "7h","8h","9h","10h","Jh","Qh","Kh"
70 DATA "Ac","2c","3c","4c","5c","6c"
75 DATA "7c","8c","9c","10c","Jc","Qc","Kc"
80 DATA "Ad","2d","3d","4d","5d","6d"
81 DATA "7d","8d","9d","10d","Jd","Qd","Kd"
82 DATA 100,1010,1110,2020,2120,2220,2320,2222,2322,2332
84 DATA 115,104,99,100
88 DATA 32,32,32,118,98,98,98,119
92 DATA 116,97,97,118,117,98,98,120
93 DATA 97,114,112,97,126,32,32,124
94 ZF= ZF+ 1:IF ZF> 1THEN 100
95 PLOT 6,2,12,15:PRINT "SOLITAIRE":PRINT
96 PRINT "DO YOU WANT RULES (R), INSTRUCTIONS (I), OR PLAY (P) & (CR)? ";
97 POKE 33278,0
98 RN= RND (1):IF PEEK (33278)= 0THEN 98
99 A$= CHR$ (PEEK (33278)):INPUT "";B$
100 REM
120 FOR I= 0TO 51:DE(I)= I:NEXT I
130 FOR I= 0TO 51:J= INT (RND (1)* 52)
140 DU= DE(I):DE(I)= DE(J):DE(J)= DU:NEXT I
150 NC= 51:FOR I= 0TO 6:FOR J= 1TO I+ 1
160 BO(I,J)= DE(NC):NC= NC- 1:NEXT J
170 FOR J= JTO 18:BO(I,J)= - 1:NEXT J
180 BO(I,19)= I:BO(I,0)= I+ 1:NEXT I
190 FOR I= 0TO 3:AC(I)= 13* I- 1:NEXT I
200 TC= 2
201 IF A$= "I"THEN 262
202 IF A$< > "R"THEN 205
203 PLOT 12:LOAD "RULES":RUN :PLOT 3,1,31
204 INPUT "DO YOU NEED INSTRUCTIONS?";A$:IF LEFT$ (A$,1)= "Y"THEN 262
205 PLOT 30,16,15,12
210 FOR I= 0TO 6
220 UC= I:US= 1:UF= BO(I,0):GOSUB 3000
230 NEXT I
240 FOR I= 7TO 11:UC= I:GOSUB 3000:NEXT I
250 PLOT 30,16,8,29,18:INPUT "WHAT IS YOUR PLAY?";A$
260 PLOT 8:PRINT TAB( 27)
261 IF LEFT$ (A$,1)< > "I"THEN 270
262 PLOT 12:LOAD "INSTR":RUN :PLOT 3,1,30
263 INPUT "PRESS ENTER WHEN READY.";A$
264 GOTO 205
270 IF LEFT$ (A$,1)= "P"THEN 205
272 IF LEFT$ (A$,1)= "C"THEN 1500
275 Z$= "":IF A$< > "QUIT"THEN 280
276 PLOT 8:POKE 33278,0:PRINT Z$;"PLAY AGAIN? ";
277 RN= RND (1):A= PEEK (33278):IF A= 0THEN 277
278 INPUT "";A$:IF A= 89THEN 94
279 PLOT 1
280 IF LEFT$ (A$,1)< > "F"THEN 320
290 IF TC= NCTHEN TC= - 1
300 TC= TC+ 3:IF TC> NCTHEN TC= NC
310 UC= 7:GOSUB 3000:GOTO 250
320 I= 1
330 IF MID$ (A$,I,1)< > " "AND MID$ (A$,I,1)< > "0"THEN I= I+ 1:GOTO 350
340 A$= LEFT$ (A$,I- 1)+ RIGHT$ (A$,LEN (A$)- I)
350 IF I< = LEN (A$)THEN 330
360 IF I= 3THEN 810
370 B$= RIGHT$ (A$,2):A$= LEFT$ (A$,2)
380 TR$= A$:GOSUB 900:IF TR= 52THEN 570
390 A= TR:TR$= B$:GOSUB 900:IF TR= 52THEN 570
400 B= TR
410 FOR I= OTO 3:IF AC(I)< > BTHEN 415
412 IF B= 51THEN 415
413 C$= LEFT$ (DE$(B+ 1),1)+ RIGHT$ (DE$(B+ 1),1)
414 IF A$= C$THEN 650
415 NEXT I
420 FOR I= - 38TO 40STEP 26
430 IF B= A+ ITHEN 450
440 NEXT I:GOTO 570
450 GOSUB 1000:IF F1= - 1THEN 570
460 IF TC< 0THEN 470
465 IF A= DE(TC)THEN 590
470 GOSUB 2000:IF F2= - 1THEN 570
480 I= 0
490 BO(F1,G1+ I+ 1)= BO(F2,G2+ I):BO(F2,G2+ I)= - 1
500 I= I+ 1:IF G2+ I< = BO(F2,0)THEN 490
520 BO(F2,0)= BO(F2,0)- I
525 BO(F1,0)= BO(F1,0)+ I
530 IF BO(F2,0)> OTHEN BO(F2,19)= BO(F2,0)- 1
540 UC= F2:US= BO(F2,19)+ 1:UF= G2+ I- 1:GOSUB 3000
550 UC= F1:US= G1:UF= G1+ I:GOSUB 3000
560 GOTO 250
570 PLOT 8,30,16,29,18:PRINT "ILLEGAL PLAY"
580 FOR I= 1TO 500:NEXT I:PLOT 8:PRINT TAB( 27):GOTO 250
590 BO(F1,G1+ 1)= DE(TC):BO(F1,0)= BO(F1,0)+ 1
600 NC= NC- 1
610 FOR I= TCTO NC:DE(I)= DE(I+ 1):NEXT I
620 TC= TC- 1:UC= 7:GOSUB 3000
630 UC= F1:US= G1:UF= G1+ 1:GOSUB 3000
640 GOTO 250
650 IF TC< 0THEN 660
655 IF A= DE(TC)THEN 740
660 DU= B:B= A:GOSUB 1000:IF F1= - 1THEN 570
665 B= DU
670 IF A< > B+ 1THEN 570
680 AC(I)= A
690 BO(F1,G1)= - 1:BO(F1,0)= BO(F1,0)- 1
700 IF BO(F1,0)< = 0THEN 710
702 IF BO(F1,19)= BO(F1,0)THEN BO(F1,19)= BO(F1,19)- 1
710 UC= F1:US= G1- 1:UF= G1:GOSUB 3000
720 UC= 8+ I:GOSUB 3000
730 GOTO 800
731 END
740 I= INT (A/ 13):IF A< > AC(I)+ 1THEN 570
750 AC(I)= A
760 NC= NC- 1
770 FOR J= TCTO NC:DE(J)= DE(J+ 1):NEXT J
780 TC= TC- 1:UC= 7:GOSUB 3000
790 UC= 8+ I:GOSUB 3000
800 FOR I= 0TO 3:IF AC(I)< > 13* I+ 12THEN 250
801 NEXT I
802 PLOT 6,2:Z$= "YOU WIN.  ":GOTO 276
810 TR$= A$:GOSUB 900:IF TR= 52THEN 570
820 A= TR:GOSUB 2000:IF F2= - 1THEN 930
830 IF A/ 13= INT (A/ 13)THEN I= A/ 13:B= A- 1:GOTO 650
840 IF (A+ 1)/ 13< > INT ((A+ 1)/ 13)THEN 570
860 FOR I= 0TO 6:IF BO(I,0)= 0THEN 880
870 NEXT I:GOTO 570
880 F1= I:G1= 0:GOTO 480
900 REM  SBR TRANSLATE
910 FOR TR= 0TO 51
915 IF LEFT$ (DE$(TR),1)+ RIGHT$ (DE$(TR),1)= TR$THEN RETURN
920 NEXT TR:RETURN
930 IF A/ 13< > INT (A/ 13)THEN 950
940 IF TC< 0THEN 950
945 IF A= DE(TC)THEN I= A/ 13:GOTO 750
950 IF (A+ 1)/ 13< > INT ((A+ 1)/ 13)THEN 570
960 FOR I= 0TO 6:IF BO(I,0)= 0THEN 980
970 NEXT I:GOTO 570
980 F1= I:G1= 0:IF TC< 0THEN 570
990 IF A= DE(TC)THEN 590
995 GOTO 570
1000 REM  SBR FIND1
1010 FOR F1= 6TO 0STEP - 1
1020 G1= BO(F1,0):IF BO(F1,G1)= BTHEN RETURN
1030 NEXT F1:RETURN
1500 IF TC> 0THEN 570
1510 FOR I= 0TO 6:IF BO(I,19)> 0THEN 570
1520 NEXT I:GOTO 802
2000 REM  SBR FIND2
2010 FOR F2= 6TO 0STEP - 1
2020 G2= BO(F2,19)+ 1:IF BO(F2,G2)= ATHEN RETURN
2030 NEXT F2:RETURN
3000 REM  SBR UPDATE
3005 IF US< 1THEN US= 1
3010 IF UC< > 7THEN 3130
3020 IF NC> = 0THEN 3040
3024 PLOT 3,3,25,30,16,32
3025 FOR UI= 1TO 6:PLOT 3,1,25+ UI,30,16,32,32,32,32,32,32:NEXT UI
3030 PLOT 3,1,26,29,18:PRINT "NO CARDS LEFT":RETURN
3040 IF TC< 0THEN TC= 2:IF TC> NCTHEN TC= NC
3045 PLOT 3,2,25,30,16,29,18:PRINT TC+ 1;" "
3050 N= DE(TC):X= 1:Y= 26:GOSUB 4000
3060 IF NC< > TCTHEN 3070
3061 PLOT 3,10,25,30,16,32
3062 FOR UI= 1TO 6:PLOT 3,8,25+ UI,30,16,32,32,32,32,32,32
3063 NEXT UI:RETURN
3070 PLOT 3,9,25,30,16,29,18:PRINT NC- TC;" "
3072 PLOT 3,8,26,30,16,29,17,116,30,17,32,32,32,32,16,29,117
3080 FOR UI= 1TO 4
3090 PLOT 3,8,26+ UI,30,17,29,16,32,96,96,96,96,32
3100 NEXT UI
3110 PLOT 3,8,31,30,16,29,17,118,30,17,32,32,32,32,16,29,119
3120 RETURN
3130 IF UC< 7THEN 3170
3140 UC= UC- 8
3150 N= AC(UC):IF N= 13* UC- 1THEN RETURN
3160 X= 28+ UC* 7:Y= 0:GOSUB 4000:RETURN
3170 X= 16+ 7* UC
3180 IF BO(UC,US)< 0THEN UZ= 5:GOTO 3420
3190 FOR UI= USTO BO(UC,0):Y= 7+ UI:UG= 0
3200 IF UI< = BO(UC,19)THEN UG= 3
3210 IF UI= 1THEN UG= UG+ 2:GOTO 3240
3220 IF UI< = BO(UC,19)+ 1THEN UG= UG+ 1
3230 IF UI> = BO(UC,19)+ 2THEN UG= UG+ 3
3240 ON UGGOTO 3250,3270,3290,3310,3330
3250 PLOT 3,X,Y,30,17,29,23,116,30,23,32,32,32,32,17,29,117
3260 GOTO 3340
3270 PLOT 3,X,Y,30,16,29,23,116,30,23,32,32,32,32,16,29,117
3280 GOTO 3340
3290 PLOT 3,X,Y,29,16,30,23,116,101,101,101,101,117
3300 GOTO 3340
3310 PLOT 3,X,Y,29,16,30,17,116,101,101,101,101,117
3320 GOTO 3340
3330 PLOT 3,X,Y,30,16,29,17,116,30,17,32,32,32,32,16,29,117
3340 IF UG> 3OR UI= BO(UC,0)THEN 3380
3350 CO= INT (BO(UC,UI)/ 13)
3360 PLOT 3,X+ 1,Y,30,23,29,16+ INT (CO/ 2- INT (CO/ 2)+ .6)
3370 PRINT DE$(BO(UC,UI))
3380 NEXT UI
3390 UZ= 0
3400 N= BO(UC,BO(UC,0)):GOSUB 4020
3410 IF UF< = BO(UC,0)THEN RETURN
3420 FOR Y= BO(UC,0)+ 13- UZTO UF+ 13
3430 PLOT 3,X,Y,30,16,32,32,32,32,32,32
3440 NEXT Y:RETURN
4000 REM  SBR SCARDS
4010 PLOT 3,X,Y,6,7,29,116,6,56,32,32,32,32,6,7,117
4020 SU= INT (N/ 13)
4025 PLOT 29
4030 PLOT 3,X,Y+ 1,6,56+ INT (SU/ 2- INT (SU/ 2)+ .6)
4040 N= N- 13* SU:IF N> 9THEN 4160
4050 PRINT STR$ (N+ 1);"   ":PLOT 3,X+ 5,Y+ 1,32
4060 IF N= 0THEN PLOT 3,X+ 1,Y+ 1,65
4070 FOR SI= 0TO 3
4080 PX= CD(N):PY= 3- SI:GOSUB 4500
4082 PLOT 3,X,Y+ 2+ SI
4084 PL= PP(SU)
4090 ON PZ+ 1GOTO 4092,4094,4096,4098
4092 PLOT 32,32,32,32,32,32:GOTO 4100
4094 PLOT 32,32,32,PL,32,32:GOTO 4100
4096 PLOT 32,32,PL,32,PL,32:GOTO 4100
4098 PLOT 32,32,PL,PL,PL,32:GOTO 4100
4100 NEXT SI
4140 PLOT 6,7,3,X,Y+ 5,118,3,X+ 5,Y+ 5,119
4150 RETURN
4160 PRINT " ";DE$(N+ 13* SU);"   "
4170 PLOT 30
4180 FOR SI= 0TO 3
4190 PLOT 3,X,Y+ 2+ SI,32,32,32,FC(SI,N- 10),FC(SI+ 4,N- 10),32
4200 NEXT SI
4210 PLOT 29
4220 GOTO 4140
4500 REM  SBR PULL
4510 IF PY= 0THEN 4540
4520 FOR PI= 1TO PY:PX= PX/ 10:NEXT PI
4530 PX= INT (PX)
4540 PZ= 10* INT (PX/ 10)
4550 PZ= PX- PZ
4560 RETURN