Compucolor.org – Virtual Media

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

0 PLOT 6,4,14,29,12:PRINT "POKER SOLITAIRE.":PRINT
1 POKE 33278,0:PRINT "DO YOU NEED ";
2 CLEAR 200:PRINT "INSTRUCTIONS? ";
3 RN= RND (1):IF PEEK (33278)= 0THEN 3
4 A= PEEK (33278):INPUT "";A$
5 IF A= 89THEN 10000
10 DIM DE$(51),S$(3),CD(9),CL(3)
11 DIM DE(51),BO(4,4)
13 DEF FN R(X)= X- INT (X/ 13)* 13
14 DIM H(4)
15 DIM FC(7,2)
20 FOR I= 0TO 51:READ DE$(I):NEXT I
30 FOR I= 0TO 3:READ S$(I):NEXT I
40 FOR I= 0TO 9:READ CD(I):NEXT I
50 FOR I= 0TO 3:READ CL(I):NEXT I
55 FOR I= 0TO 2:FOR J= 0TO 7:READ FC(J,I):NEXT J,I
60 DATA "As","2s","3s","4s","5s","6s","7s"
70 DATA "8s","9s","10s","Js","Qs","Ks"
80 DATA "Ah","2h","3h","4h","5h","6h","7h"
90 DATA "8h","9h","10h","Jh","Qh","Kh"
100 DATA "Ac","2c","3c","4c","5c","6c","7c"
110 DATA "8c","9c","10c","Jc","Qc","Kc"
120 DATA "Ad","2d","3d","4d","5d","6d","7d"
130 DATA "8d","9d","10d","Jd","Qd","Kd"
140 DATA "s","h","c","d"
150 DATA 100,1010,1110,2020,2120,2220,2320,2222,2322,2332
160 DATA 0,10,101,111
162 DATA 32,32,32,118,98,98,98,119
164 DATA 116,97,97,118,117,98,98,120
166 DATA 97,114,112,97,126,32,32,124
169 GOTO 2000
170 REM  SBR TCARDS
171 IF N> 51THEN 1500
190 SU= INT (N/ 13)
200 PLOT 6,56+ INT (SU/ 2- INT (SU/ 2)+ .6)
210 N= N- 13* SU:IF N> 9THEN 500
220 PLOT 3,X,Y:PRINT N+ 1;"  "
225 PLOT 6,7,3,X,Y,116,3,X+ 4,Y,117,6,56+ INT (SU/ 2- INT (SU/ 2)+ .6)
230 IF N= 0THEN PLOT 3,X+ 1,Y,65
240 FOR SI= 0TO 3
250 PX= CD(N):PY= 3- SI:GOSUB 1000
260 SJ= PZ:PLOT 3,X,Y+ 1+ SI:PRINT " ";:FOR SK= 0TO 2
270 PX= CL(SJ):PY= 2- SK:GOSUB 1000
280 IF PZ= 0THEN PRINT " ";:GOTO 300
290 PRINT S$(SU);
300 NEXT SK:PRINT " ":NEXT SI
400 PLOT 6,7,3,X,Y+ 4,118,3,X+ 4,Y+ 4,119
410 RETURN
500 PLOT 3,X,Y,6,7,116,6,56+ INT (SU/ 2- INT (SU/ 2)+ .6)
501 PRINT DE$(N+ 13* SU);" ":PLOT 3,X+ 4,Y,6,7,117
505 PLOT 6,56+ INT (SU/ 2- INT (SU/ 2)+ .6)
506 PLOT 30
510 FOR SI= 0TO 3
520 PLOT 3,X,Y+ 1+ SI,32,32,FC(SI,N- 10),FC(SI+ 4,N- 10),32
530 NEXT SI
535 PLOT 29
540 GOTO 400
1000 REM  SBR PULL
1010 IF PY= 0THEN 1040
1020 FOR PI= 1TO PY:PX= PX/ 10:NEXT PI
1030 PX= INT (PX)
1040 PZ= 10* INT (PX/ 10)
1050 PZ= PX- PZ
1060 RETURN
1500 PLOT 3,X+ 2,Y+ 3,14,6,4,N,15
1510 RETURN
2000 FOR I= 0TO 51:DE(I)= I:NEXT I
2010 FOR I= 0TO 51:J= INT (RND (1)* 51)
2020 DU= DE(I):DE(I)= DE(J):DE(J)= DU
2030 NEXT I
3010 FOR I= 0TO 4:FOR J= 0TO 4:BO(I,J)= 65+ 5* I+ J:NEXT J,I
3020 PLOT 12
3030 FOR I= 0TO 4:FOR J= 0TO 4
3040 X= 20+ 7* J:Y= 6* I:N= BO(I,J):GOSUB 170
3050 NEXT J,I
3051 FOR I= 0TO 4:J= I:GOSUB 4000:PLOT 8:PRINT :NEXT I
3052 PLOT 6,5:IF RT= 1THEN RT= 0:GOTO 11000
3053 PLOT 3,0,20:PRINT "RF   500"
3054 PRINT "SF   300":PRINT "4K   160":PRINT "STR  120"
3055 PRINT "FH   100":PRINT "3K    60":PRINT "FLU   50"
3056 PRINT "2P    30":PRINT "1P    10"
3060 PLOT 8,6,2:X= 5:Y= 5:N= DE(K)
3070 GOSUB 170
3075 POKE 33278,0:PLOT 3,1,11:PRINT "WHERE? ";
3080 RN= RND (1):IF PEEK (33278)= 0THEN 3080
3090 A= PEEK (33278)- 65
3091 IF A= - 53THEN 3030
3092 PLOT 6,1,11
3093 IF A< 0OR A> 24THEN 3075
3095 I= INT (A/ 5):J= A- 5* I
3100 IF BO(I,J)< 60THEN 3075
3105 BO(I,J)= DE(K)
3120 N= DE(K):X= 20+ 7* J:Y= 6* I:GOSUB 170
3125 GOSUB 4000
3130 K= K+ 1
3131 IF K< 25THEN 3060
3132 PLOT 6,6:FOR I= 5TO 10:PLOT 3,5,I,32,32,32,32,32:NEXT I
3133 PLOT 14:PRINT :PRINT "FINAL SCORE =";
3134 PLOT 6,5:PRINT TS:GOTO 7000
3135 PLOT 6,6,15,3,1,15:INPUT "PLAY AGAIN? ";A$
3136 IF LEFT$ (A$,1)= "Y"THEN CLEAR :GOTO 10
3139 PLOT 1
3140 GOTO 3060
4000 FOR L= 0TO 4
4010 H(L)= BO(I,L):IF H(L)> 51THEN 4050
4020 NEXT L:GOSUB 5000
4030 TS= TS+ HS* SF
4040 PLOT 6,5,3,55,3+ 6* I,14:PRINT HS;:PLOT 15
4050 FOR L= 0TO 4
4060 H(L)= BO(L,J):IF H(L)> 51THEN 4100
4070 NEXT L:GOSUB 5000
4080 TS= TS+ HS* SF
4090 PLOT 6,5,3,21+ 7* J,31,14:PRINT HS;:PLOT 15
4100 IF I< > JTHEN 4160
4110 FOR L= 0TO 4
4120 H(L)= BO(L,L):IF H(L)> 51THEN 4160
4130 NEXT L:GOSUB 5000
4140 TS= TS+ HS* SF
4150 PLOT 6,5,3,55,31,14:PRINT HS;:PLOT 15
4160 IF J< > 4- ITHEN 4220
4170 FOR L= 0TO 4
4180 H(L)= BO(L,4- L):IF H(L)> 51THEN 4220
4190 NEXT L:GOSUB 5000
4200 TS= TS+ HS* SF
4210 PLOT 6,5,3,15,31,14:PRINT HS;:PLOT 15
4220 SF= 1:RETURN
5000 GOSUB 6000
5005 FOR L= 0TO 3
5010 IF INT (H(L)/ 13)< > INT (H(L+ 1)/ 13)THEN 5060
5020 NEXT L:HS= 50
5030 IF H(0)= H(4)- 4THEN HS= 300
5040 IF FN R(H(0))= 0AND FN R(H(1))= 9THEN HS= 500
5050 RETURN
5060 FOR L= 0TO 4:H(L)= FN R(H(L)):NEXT L
5065 GOSUB 6000
5080 IF H(0)= H(3)OR H(1)= H(4)THEN HS= 160:RETURN
5090 FOR L= 0TO 2:IF H(L)= H(L+ 2)THEN 5110
5100 NEXT L:GOTO 5140
5110 IF L= 0AND H(3)= H(4)THEN HS= 100:RETURN
5120 IF L= 2AND H(0)= H(1)THEN HS= 100:RETURN
5130 HS= 60:RETURN
5140 PR= 0:FOR L= 0TO 3
5150 IF H(L)= H(L+ 1)THEN PR= PR+ 1
5160 NEXT L
5165 IF PR= 0THEN 5180
5170 HS= 20* PR- 10:RETURN
5180 IF H(0)= H(4)- 4THEN HS= 120:RETURN
5190 IF H(0)= 0AND H(1)= 9THEN HS= 120:RETURN
5200 HS= 0:RETURN
6000 FOR M= 0TO 4:FOR N= 0TO M
6010 IF H(M)> H(N)THEN 6030
6020 HD= H(M):H(M)= H(N):H(N)= HD
6030 NEXT N,M:RETURN
7000 GOTO 3135:REM  SKIP HIGH SCORE ROUTINE
7050 GOSUB 7100:GOTO 7300
7100 FILE "R",1,"POKREC",1
7200 GET 1,1;A1$[1],A2$[1]
7210 RS= ASC (A1$)+ 256* ASC (A2$)
7250 RETURN
7300 IF RS> TSTHEN 3135
7400 K= 3:FOR I= 0TO 4:FOR J= 0TO 4
7500 PUT 1,1,K;CHR$ (BO(I,J))[1]
7600 K= K+ 1:NEXT J,I
7650 A1= INT (TS/ 256):A2= TS- 256* A1
7660 PUT 1,1;CHR$ (A2)+ CHR$ (A1)[2]
7700 PLOT 8,6,65:PRINT "RECORD SCORE"
7710 PLOT 6,6,15:PRINT :PRINT
7720 INPUT "NAME: ";N$
7730 INPUT "DATE: ";D$
7740 PUT 1,1,28;N$[20],D$[20]
7800 FILE "C",1
7900 GOTO 3135
8000 RT= 1
8010 K= 3
8011 IF A= 77THEN K= 100
8020 GOSUB 7100
8040 FOR I= 0TO 4:FOR J= 0TO 4
8050 GET 1,1,K;A1$[1]:BO(I,J)= ASC (A1$)
8060 K= K+ 1:NEXT J,I
8061 IF A= 77THEN 8065
8062 GET 1,1;A1$[1],A2$[1]:RS= ASC (A1$)+ 256* ASC (A2$)
8063 GET 1,1,28;N$[20],D$[17]
8065 FILE "C",1
8070 GOTO 3030
9000 GOTO 2
10000 PLOT 15,12
10010 PRINT "     THE CARDS ARE DEALT ONE AT A TIME, AND ARRANGED IN"
10020 PRINT "A FIVE BY FIVE SQUARE.  ONCE A CARD IS PLACED, IT CANNOT"
10030 PRINT "BE MOVED.  THE OBJECT OF THE GAME IS TO MAKE THE BEST "
10040 PRINT "TWELVE POKER HANDS POSSIBLE IN THE FIVE ROWS, FIVE COLUMNS,"
10050 PRINT "AND ON THE TWO DIAGONALS.  SCORING IS AS FOLLOWS:"
10060 PRINT
10070 PRINT "ROYAL FLUSH            500"
10080 PRINT "STRAIGHT FLUSH         300"
10090 PRINT "4 OF A KIND            160"
10100 PRINT "STRAIGHT               120"
10110 PRINT "FULL HOUSE             100"
10120 PRINT "3 OF A KIND             60"
10130 PRINT "FLUSH                   50"
10140 PRINT "2 PAIR                  30"
10150 PRINT "PAIR                    10"
10160 PRINT
10170 PRINT "     WHEN A CARD IS DEALT, ENTER THE LETTER CORRESPONDING"
10180 PRINT "TO WHERE YOU WANT IT TO GO.  DO NOT PRESS 'RETURN'.  TO RE-"
10190 PRINT "PRINT THE SCREEN, PRESS 'ERASE PAGE'."
10200 PRINT
10300 INPUT "PRESS 'ENTER' WHEN READY";A$
10310 GOTO 10
11000 PLOT 8,6,3,14
11001 IF A= 77THEN 18000
12000 PRINT "RECORD SCORE --";RS
13000 PRINT "SCORED BY"
14000 PRINT N$
15000 PRINT "ON ";D$
15010 PRINT
15020 POKE 33278,0
16000 PRINT "NEED ";
17000 GOTO 9000
18000 PRINT "MAXIMUM SCORE - 3340"
18010 GOTO 15010
20077 CLEAR :A= 77:RT= 1:GOTO 10
20082 CLEAR :A= 82:RT= 1:GOTO 10