Google
 

Trailing-Edge - PDP-10 Archives - AP-5155A-BM - binary/blkjk.cpl
There are no other files named blkjk.cpl in the archive.
  10.		/* BLKJK.CPL -- ADAPTED BY JOHN XENAKIS FROM A BASIC PROGRAM */;
  20.		DEFAULT (RANGE(*)) FIXED;
  30.		RANDOM()=0;
  40.		;
  50.		DCL STR CHAR(50) VAR;
  60.		DCL TT FILE INPUT RECORD;
  70.		OPEN FILE(TT) TITLE('TTY:');
  80.		PUT SKIP LIST('DO YOU WANT INSTRUCTIONS? (Y,N)');
  90.		READ FILE(TT) INTO(STR);
 100.		IF STR='N' ! STR='NO' THEN GOTO NOINST;
 110.		PUT LIST('THIS IS A GAME OF BLACKJACK, LAS VEGAS STYLE.');PUT SKIP;
 120.		PUT LIST('HERE ARE THE RULES OF THE HOUSE.  THE DEALER');PUT SKIP;
 130.		PUT LIST('MUST HIT ON 16 OR LESS AND WILL STAY ON 17 OR');PUT SKIP;
 140.		PUT LIST('MORE.  YOU MAY SPLIT TWO CARDS IF THEY ARE THE');PUT SKIP;
 150.		PUT LIST('SAME AND PLAY ONE HAND WITH EACH OF THEM.  ALSO,');PUT SKIP;
 160.		PUT LIST('YOU MAY DOUBLE YOUR BET AND RECEIVE EXACTLY ONE ');PUT SKIP;
 170.		PUT LIST('MORE CARD ANY TIME ON YOUR FIRST HIT.  THE TYPING');PUT SKIP;
 180.		?'INSTRUCTIONS ARE S(TAND), H(IT), D(OUBLE)' ;PUT SKIP;
 190.		?'SP(LIT) A PAIR.  INSURANCE BETS ARE AS FOLLOWS'; PUT SKIP;
 200.		PUT LIST('WHEN THE DEALER HAS AN EXPOSED ACE HE WILL ASK');PUT SKIP;
 210.		PUT LIST('YOU FOR AN INSURANCE BET.  AN INSURANCE BET WILL');PUT SKIP;
 220.		PUT LIST('RISK HALF YOUR BET FOR AN AMOUNT EQUAL TO YOUR BET');PUT SKIP;
 230.		PUT LIST('IF YOU WIN.  YOU WIN IF THE DEALER HAS A BLACKJACK');PUT SKIP;
 240.		PUT LIST('AND LOSE IF HE DOESN''T.  THE HOUSE LIMIT IS $500.00');PUT SKIP;
 250.		PUT LIST('GOOD LUCK.  OH, BY THE WAY, THE DEALER IS NOTED FOR');PUT SKIP;
 260.		PUT LIST('DEALING OFF THE BOTTOM OF THE DECK.  WATCH HIM VERY');PUT SKIP;
 270.		PUT LIST('CLOSELY.  HERE HE IS NOW.');PUT SKIP;
 280.		PUT LIST('ANY TIME YOU WANT ME TO RESHUFFLE THE CARDS SIMPLY');PUT SKIP;
 290.		?'TYPE "SHUFFLE" WHEN I ASK FOR YOUR WAGER AND I''LL BE VERY'; PUT SKIP;
 300.		?'HAPPY TO OBLIGE.  OR TYPE "QUIT" TO QUIT WHILE YOU''RE';PUT SKIP;
 310.		?'AHEAD (OR BEHIND).  O.K., HERE IS THE FIRST HAND:'; PUT SKIP;
 320.	NOINST:	K,W1=0;
 330.		DCL DA(52), (EA,VA,TA,WA)(10);
 340.		DO A=1 TO 52;
 350.		DA(A)=0;
 360.		END;
 370.		DCL QA(52);
 380.		DO A=0 TO 39 BY 13;
 390.		DO C=1 TO 13;
 400.		QA(A+C)=C;
 410.		END;
 420.		END;
 430.		PUT SKIP;
 440.	L10460:	K=K+1;
 450.		DO P=1 TO 5;
 460.		EA(P)=0;
 470.		VA(P)=0;
 480.		TA(P)=0;
 490.		END;
 500.		VA(3)=1;
 510.		PUT SKIP;
 520.	L10560:	PUT SKIP LIST('WAGER:');
 530.		P=1;
 540.		READ FILE(TT) INTO(STR);
 550.		IF LENGTH(STR)>=3 THEN IF SUBSTR(STR,1,3)='RES'!SUBSTR(STR,1,3)='SHU' THEN DO;
 560.		CALL E13130; GOTO L10560; END;
 570.		IF STR='QUIT' THEN GOTO L13210;
 580.		ON ERROR  BEGIN;
 590.		?'TYPE "SHUFFLE" OR A POSITIVE NUMBER';
 600.		GO TO L10560; END;
 610.		GET STRING(STR!!' ') LIST(W);
 620.		ON ERROR SYSTEM;
 630.		IF W<=0 THEN DO; ?'WAGER MUST BE > 0'; GOTO L10560; END;
 640.		WA(2)=W;
 650.		IF W <= 500 THEN GO TO L10670;
 660.		?'THAT''S TOO MUCH -- HOUSE LIMIT IS $500';
 670.		GOTO L10560;
 680.	L10670:	PUT SKIP;
 690.		?'I SHOW -------------->';
 700.		CALL  E11670;
 710.		IF EA(1)=0 THEN GOTO  L10720;
 720.		VA(4)=1;
 730.	L10720:	VA(5)=1;
 740.		CALL  E11670;
 750.		M=X;
 760.		P=2;
 770.		?'1ST CARD: ';
 780.		CALL  E11670;
 790.		G=X;
 800.	HIT:	?'NEXT CARD:';
 810.		CALL  E11670;
 820.		IF VA(2)>0 THEN GOTO  L11140;
 830.		S=X;
 840.		IF VA(3)^=1 THEN GOTO  L11140;
 850.		IF TA(P)^=21 THEN GOTO  L10940;
 860.		PUT LIST( '   ***BLACKJACK***   ');PUT SKIP;
 870.		PUT SKIP;
 880.		PUT LIST(' THAT''S GETTING A BIT RIDICULOUS::::');PUT SKIP;
 890.		PUT SKIP;
 900.		?'MY HOLE CARD WAS ---->';
 910.		X=M;
 920.		CALL  E12010;
 930.		W1=W1+1.5*W;
 940.		CALL  E12610;
 950.	L10940:	IF VA(4)=0 THEN GOTO  L11070;
 960.	INSURE:	?'WANT AN INSURANCE BET? (Y,N)';
 970.		READ FILE (TT) INTO (STR);
 980.		IF STR='N' ! STR='NO' THEN GOTO L11070;
 990.		IF STR ^= 'Y' & STR ^= 'YES' THEN GO TO INSURE;
1000.		IF TA(1)^=21 THEN GOTO  L11040;
1010.		W1=W1+W;
1020.		PUT SKIP;
1030.		PUT LIST( 'YOU WIN $',W,' ON YOUR INSURANCE BET');PUT SKIP;
1040.		GOTO L11070;
1050.	L11040:	W1=W1-DIVI(W,2);
1060.		PUT SKIP;
1070.		?'YOU LOST $',DIVI(W,2),'ON YOUR INSURANCE BET -- I DON''T HAVE BLACKJACK'; PUT SKIP;
1080.	L11070:	IF TA(1)^=21 THEN GOTO  L11140;
1090.		PUT SKIP;
1100.		PUT LIST('**I HAVE BLACKJACK**');PUT SKIP;
1110.		?'MY HOLE CARD WAS ---->';
1120.		X=M;
1130.		CALL  E12010;
1140.		GOTO L12540;
1150.	L11140:	IF TA(P)<=21 THEN GOTO  L11230;
1160.		IF EA(P)>0 THEN GOTO  L11210;
1170.		PUT LIST('YOU BUSTED, ');
1180.	STAND:	?'YOUR TOTAL IS',TA(P); PUT SKIP;
1190.		C1 = MOD(TA(P),5);
1200.		IF VA(2)=1 THEN GOTO  L11490;
1210.		GOTO L12290;
1220.	L11210:	EA(P)=EA(P)-1;
1230.		TA(P)=TA(P)-10;
1240.	L11230:	IF VA(1)=2 THEN GOTO STAND;
1250.		VA(3)=VA(3)+1;
1260.	L11250:	?'S(TAND) OR H(IT)';
1270.		IF VA(3)=2 THEN ?'OR D(OUBLE)';
1280.		IF VA(3)=2&QA(G)=QA(S)&VA(2)<=0 THEN ?'OR SP(LIT)';
1290.		READ FILE(TT) INTO(STR);
1300.		IF STR='S'!STR='STAND' THEN DO; VA(1)=0; GOTO STAND; END;
1310.		IF STR='H'!STR='HIT' THEN DO; VA(1)=1; GOTO HIT; END;
1320.		IF STR='D'!STR='DOUBLE' THEN DO; VA(1)=2; GOTO DOUB;END;
1330.		IF STR^='SP'&STR^='SPLIT' THEN GOTO L11250;
1340.		IF VA(2)>0 THEN GOTO  L11580;
1350.		IF VA(3)^=2 THEN GOTO  L11580;
1360.		IF QA(G)=QA(S) THEN GOTO  L11340;
1370.		PUT LIST('NOW IS THAT A PAIR?');PUT SKIP;
1380.		GOTO L11250;
1390.	L11340:	VA(2)=1;
1400.		IF QA(G)^=1 THEN GOTO  L11370;
1410.		VA(1)=2;
1420.	L11370:	P=3;
1430.		PUT LIST('       PLAY HAND ONE NOW');PUT SKIP;
1440.		?'1ST CARD: ';
1450.		WA(3)=W;
1460.		X=G;
1470.		CALL  E11440;
1480.		GO TO HIT;
1490.	E11440:	PROC;	CALL  E11920;
1500.		CALL  E12010;
1510.		VA(3)=1;
1520.		TA(P)=C;
1530.		RETURN; END;
1540.	L11490:	P=2;
1550.		VA(2)=2;
1560.		PUT LIST('       PLAY HAND TWO NOW');PUT SKIP;
1570.		?'1ST CARD: ';
1580.		X=S;
1590.		CALL  E11440;
1600.		IF QA(G) ^= 1 THEN VA(1)=0;
1610.		GO TO HIT;
1620.	L11580:	PUT LIST('NO SPLITS NOW -- TRY AGAIN');PUT SKIP;
1630.		GOTO L11250;
1640.	DOUB:;
1650.		IF VA(3)=2 THEN GOTO  L11640;
1660.		PUT LIST('TOO LATE TO DOUBLE, CHARLIE.');PUT SKIP;
1670.		GOTO L11250;
1680.	L11640:	WA(P)=2*WA(P);
1690.		IF VA(1) > 0 THEN GO TO HIT;
1700.		GOTO L11170;
1710.	E11670:	PROC;	CALL  E11740;
1720.		TA(P)=TA(P)+C;
1730.		IF VA(5)=0 THEN GOTO  L11720;
1740.		VA(5)=0;
1750.		RETURN;
1760.	L11720:	CALL  E12010;
1770.		RETURN; END;
1780.	E11740:	PROC; L11740:	IF R>=50 THEN GOTO  L11830;
1790.		X = 52 * RANDOM + 1;
1800.		IF DA(X)=0 THEN GOTO  L11900;
1810.		R=R+1;
1820.		IF R<50 THEN GOTO  L11740;
1830.	L11830:	DO A=1 TO 52;
1840.		IF DA(A)=K THEN GOTO  L11860;
1850.		DA(A)=0;
1860.	L11860:	END;
1870.		R=0;
1880.		PUT LIST('   I RESHUFFLED   ');
1890.		GOTO L11740;
1900.	L11900:	R=0;
1910.		DA(X)=K;
1920.		CALL E11920; RETURN; END;
1930.	E11920:	PROC;	IF QA(X)^=1 THEN GOTO  L11960;
1940.		C=11;
1950.		EA(P)=EA(P)+1;
1960.		RETURN;
1970.	L11960:	IF QA(X)>10 THEN GOTO  L11990;
1980.		C=QA(X);
1990.		RETURN;
2000.	L11990:	C=10;
2010.		RETURN; END;
2020.	E12010:	PROC;	CALL  E12040;
2030.		CALL  E12180;
2040.		RETURN; END;
2050.	E12040:	PROC;
2060.		IF QA(X)=1 THEN ?'ACE';
2070.		ELSE IF QA(X)=10 THEN ?'TEN';
2080.		ELSE IF QA(X)=11 THEN ?'JACK';
2090.		ELSE IF QA(X)=12 THEN ?'QUEEN';
2100.		ELSE IF QA(X)=13 THEN ?'KING';
2110.		ELSE ?QA(X);
2120.		RETURN;
2130.		END E12040;
2140.	E12180:	PROC;	IF X>39 THEN GOTO  L12230;
2150.		IF X>26 THEN GOTO  L12250;
2160.		IF X>13 THEN GOTO  L12270;
2170.		PUT LIST('OF SPADES');PUT SKIP;
2180.		RETURN;
2190.	L12230:	PUT LIST('OF CLUBS');PUT SKIP;
2200.		RETURN;
2210.	L12250:	PUT LIST('OF HEARTS');PUT SKIP;
2220.		RETURN;
2230.	L12270:	PUT LIST('OF DIAMONDS');PUT SKIP;
2240.		RETURN; END;
2250.	L12290:	P=2;
2260.		?'MY HOLE CARD WAS ---->';
2270.		X=M;
2280.		CALL  E12010;
2290.		IF TA(2)<22 THEN GOTO  L12360;
2300.		IF VA(2)=0 THEN GOTO  L12540;
2310.		IF TA(3)>21 THEN GOTO  L12540;
2320.	L12360:	P=1;
2330.		IF TA(1)<17 THEN GOTO  L12660;
2340.		IF TA(1)>17 THEN GOTO  L12400;
2350.		IF EA(1)>0 THEN GOTO  L12660;
2360.	L12400:	IF TA(1)>21 THEN GOTO  L12690;
2370.	L12410:	P=2;
2380.		PUT LIST(