|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8611 (0x21a3)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BLKJACK«
└─⟦934333717⟧ Bits:30008597 DDMQ1-0029_Demonstration_Disk_SOURCE_Single_Density_Sept_77
└─⟦this⟧ »BLKJACK«
DCL SEED FIXED(10), NUM FIXED(2), DECK(52), DUMB CHAR(1);
DCL AMTC CHAR(5), BETC CHAR(4);
DCL CK BINARY, CARD BINARY,CARDV BINARY,PFLG BINARY,DFLG BINARY,PCNT BINARY,
BET BINARY, AMOUNT BINARY, LL BINARY, L BINARY, SUITV BINARY, DCNT BINARY;
DCL HLIN CHAR(37)INIT(' PLAYER DEALER '),
LINE(5)CHAR(37),
BLK CHAR(37)INIT(' '),
CLIN CHAR(17), BLIN CHAR(17), B3 CHAR(3)INIT(' '), DLIN CHAR(37),
CD(52);
/* RANDOM NUMBER GENERATOR */
RNGEN: PROC(LOC3); DCL LOC1 FIXED(10), LOC2 FIXED(10), LOC3 FIXED(2);
IF SEED<0 THEN SEED=-SEED;
LOC1=SEED*899; SEED=LOC1; LOC2=LOC1/52; LOC3=(LOC1-LOC2*52)+1;
IF LOC3<0 THEN LOC3=-LOC3; RETURN; END;
/* OUTPUTS A PAGE TO THE DISPLAY */
POUT: PROC; PUT FILE(DISPLAY)LIST(HLIN);
PMA=PL-1; IF PL<DL THEN PMA=DL-1;
DO II=1 TO PMA; PUT FILE(DISPLAY)LIST(LINE(II)); END; IF PMA=5 THEN GOTO P6;
PMA=PMA+1;DO II=PMA TO 5; PUT FILE(DISPLAY)EDIT(' ')(A(37));END;
P6: RETURN; END;
/* SHUFFLING CARDS */
SHUFF: PROC; PUT FILE(DISPLAY)SKIP EDIT('HAVE TO SHUFFLE CARDS....')(A(74))
('PRESS RETURN TO END THE SHUFFLING')(A(37));
NUM=1;CALL KEYFUN(I);LOP:CALL KEYFUN(I);IF I THEN DO;GOTO GOTIT;END;
NUM=NUM+1;
GOTO LOP;
GOTIT: SEED=123456789+L*2*NUM;
DO II=1 TO 70; END;
RETURN; END;
XDEAL: PROC; IF DCNT<10 THEN GO TO XXD; CARD=21-DCNT;IJK=0; GO TO XXXD;
XXD: CARD=11-DCNT; XXXD: L=L+1; RETURN; END;
DEAL: PROC;AGN: CALL RNGEN(NUM); IF NUM=0 THEN GOTO AGN; CARD=NUM;
L=L+1; RETURN; END;
/* DECODE CARD DEALT */
PCARD:PROC(PC,FLAG);DCL PC BINARY, FLAG BINARY;
DCL SUIT(4)CHAR(10)INIT('SPADES ','HEARTS ','DIAMONDS ','CLUBS ');
DCL FACE(4)CHAR(3)INIT('J ','Q ','K ','A '), CDRC CHAR(3), CDD CHAR(2);
DLIN=LINE(LL);
CK=CARD;CLIN=SUBSTR(DLIN,21,17); IF CC=2 THEN CLIN=SUBSTR(DLIN,1,17);
SUITV=(CK-1)/13+1;CK=CARD-(SUITV-1)*13; CARDV=CK; IF CK=1 THEN GOTO FC;
IF CARDV>10 THEN GOTO FC;CDD=CARDV;CDRC=CDD CAT ' ';PC=PC+CARDV;
GOTO PSUIT;
FC: INDX=CARDV-10; IF CARDV=1 THEN INDX=4;
CDRC=FACE(INDX);IF CARDV=1 THEN GOTO ACE; PC=PC+10; GOTO PSUIT;
ACE: PC=PC+1; IF PC>11 THEN GOTO PSUIT; PC=PC+10; FLAG=1;
PSUIT: IF SUBSTR(CLIN,5,1)¬='O' THEN CLIN=' ';
BLIN=CDRC CAT ' OF '; BLIN=BLIN CAT SUIT(SUITV); IF CC=2 THEN GOTO P2;
DLIN=BLIN CAT ' '; LINE(LL)=DLIN CAT CLIN; GOTO PP;
P2:IF SUBSTR(CLIN,5,1)='O' THEN GOTO P22;DLIN=' ';GOTO P23;
P22:DLIN=CLIN CAT ' ';P23: LINE(LL)=DLIN CAT BLIN;
PP: LL=LL+1; RETURN; END;
/* MAIN PROGRAM STARTS */
RULE: PUT FILE(DISPLAY)SKIP LIST(' .....WELCOME to the Q1 CASINO ......',
'The name of the game is BLACKJACK. The table limit is $50. '
,'Maximum bet for each hand is $50. Las Vegas Blackjack rules apply. '
,'Are you ready? '); GET SKIP LIST(DUMB);
CALL SHUFF; L=1; AMOUNT=50;
GAME: DO I=1 TO 5; LINE(I)=BLK; END;
IF AMOUNT¬=0 THEN GOTO GGAA; PUT FILE(DISPLAY)SKIP LIST('YOU',
' ARE CLEANED, I WILL ALWAYS BE HERE ANY TIME YOU '
,' FEEL LIKE LOSING SOME MORE $$......'); GET SKIP LIST(DUMB); GOTO DONE;
GGAA: PUT FILE(DISPLAY)SKIP EDIT('YOUR BALANCE IS ')(A(16))(AMOUNT)(P'$$$$9');
IF IJK=1 THEN IJK=2;
PUT FILE(DISPLAY)EDIT(' WHAT IS YOUR BET? ')(A(35));
GET SKIP LIST(BET);PUT FILE(DISPLAY)EDIT(BET)(P'$$$$9')(' ')(A(13));
BETC=BET; AMTC=AMOUNT; IF SUBSTR(BETC,1,1)=SUBSTR(AMTC,1,1)+2 THEN IJK=1;
IF BET>0 THEN GOTO GGAB; PUT FILE(DISPLAY)LIST('SOORY, NO FOOLING AROUND!');
GET SKIP LIST(DUMB); GOTO GAME;
GGAB: IF BET<=AMOUNT THEN GOTO SST;
PUT FILE(DISPLAY)EDIT('SORRY, YOUR CREDIT IS NO GOOD!!')(A(37));
GET SKIP LIST(DUMB); GOTO GAME;
SST: PFLG=0; DFLG=0; PL=1; DL=1; PCNT=0; DCNT=0;
LL=PL;CC=1;CALL DEAL; CALL PCARD(PCNT,PFLG);PL=LL;CC=2;CALL DEAL;
LL=DL;CALL PCARD(DCNT,DFLG);DL=LL;CC=1; LL=PL;CALL DEAL;CALL PCARD(PCNT,PFLG);
PL=LL; PUT FILE(DISPLAY)SKIP;
HAND:IF PCNT=21 THEN GOTO BLKJP;CALL POUT;ND: PUT FILE(DISPLAY)EDIT
(' HIT ? ')(A(10));GET SKIP LIST(DUMB);PUT FILE(DISPLAY)EDIT(' ')(A(64));
IF DUMB¬='Y' THEN GOTO DPLAY; CALL DEAL;
CC=1;LL=PL;CALL PCARD(PCNT,PFLG);PL=LL;CALL POUT;IF PCNT<22 THEN GOTO ND;
IF PFLG¬=1 THEN GOTO BUSP1; PCNT=PCNT-10; PFLG=11; GOTO ND;
BUSP1: LL=DL;CC=2;CALL DEAL; CALL PCARD(DCNT,DFLG);DL=LL;
PUT FILE(DISPLAY)EDIT(' ')(A(74)); CALL POUT;
BUSP: PUT FILE(DISPLAY)LIST('SORRY YOU LOST...WANNA TRY MORE?');
AMOUNT=AMOUNT-BET;
NX: GET SKIP LIST(DUMB); IF DUMB='N' THEN GOTO DONE;
IF L<42 THEN GOTO GAME; CALL SHUFF; L=1;GOTO GAME;
BLKJP: LL=DL;CC=2;CALL DEAL; CALL PCARD(DCNT,DFLG); DL=LL;
LINE(4)='*** BLACKJACK **** ';LINE(3)=BLK;PL=5;
CALL POUT;
WINP: PUT FILE(DISPLAY)LIST('YOU ARE LUCKY..WANNA TRY AGAIN?');
AMOUNT=AMOUNT+BET;GOTO NX;
DPLAY: IF IJK=2 THEN GO TO XX2;
CALL DEAL;XXY: LL=DL; CC=2; CALL PCARD(DCNT,DFLG); DL=LL;
CALL POUT; PUT FILE(DISPLAY)EDIT(' ')(A(74)); IF DCNT=21 THEN GOTO BLKJD;
IF DCNT>16 THEN GOTO DCDD;DO I=1 TO 500; END;
DPLAA: IF IJK=2 THEN GO TO XX1;
CALL DEAL;XXX: CC=2; LL=DL; CALL PCARD(DCNT,DFLG); DL=LL;
CALL POUT; IF DCNT>21 THEN GOTO TTNN;DXX: PUT FILE(DISPLAY)EDIT(' ')(A(74));
IF DCNT>16 THEN GOTO DCDD;DO I=1 TO 500; END;
GOTO DPLAA;
XX1: CALL XDEAL; GO TO XXX;XX2: CALL XDEAL; GO TO XXY;
TTNN: IF DFLG¬=1 THEN GOTO WINP; DFLG=11; DCNT=DCNT-10; GOTO DXX;
BLKJD: CLIN=LINE(4); IF SUBSTR(CLIN,5,1)¬='O' THEN CLIN=BLK; DL=5;
DLIN=CLIN CAT ' ';LINE(4)=DLIN CAT '*** BLACKJACK ***';CALL POUT;GOTO BUSP;
DCDD: CALL POUT;IF DCNT>PCNT THEN GOTO BUSP; IF DCNT<PCNT THEN GOTO WINP;
PUT FILE(DISPLAY)LIST('*** DRAW *** WANNA CONTINUE?'); GOTO NX;
DONE: END;