|
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: 10744 (0x29f8)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »CASINO1«
└─⟦9e403ec87⟧ Bits:30008765 50001610
└─⟦this⟧ »CASINO1«
DCL SEED FIXED(10), NUM FIXED(2), DECK(52) FIXED(2), 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 FIXED(11), LL BINARY, L BINARY, SUITV BINARY, DCNT BINARY;
DCL HLIN CHAR(47)INIT('DU HAR: JAG (Q1) HAR: '),
LINE(9)CHAR(47),
BLK CHAR(47)INIT(' '),
CLIN CHAR(27), BLIN CHAR(27), B3 CHAR(3)INIT(' '), DLIN CHAR(47),
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=9 THEN GOTO P6;
PMA=PMA+1;DO II=PMA TO 9; PUT FILE(DISPLAY)EDIT(' ')(A(47));END;
P6: RETURN; END;
/* SHUFFLING CARDS */
SHUFF: PROC; PUT FILE(D)SKIP EDIT('JAG (Q1) MÅSTE BLANDA KORTEN......')(A(94))
('TRYCK RETURN NÄR DU TROR ATT DET ÄR TILLRÄCKLIGT BLANDAT')(A(94));
NUM=1;CALL KEYFUN(I);LOP:CALL KEYFUN(I);IF I THEN DO;GOTO GOTIT;END;
NUM=NUM+1;
GOTO LOP;
GOTIT:GET SKIP LIST(DUMB); SEED=123456789+L*2*NUM;
DO III=1 TO 52;DECK(III)=0;END;JJJ=1;
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;
DO III=1 TO 52;IF DECK(III)=NUM THEN GO TO AGN;END;
DECK(JJJ)=NUM;JJJ=JJJ+1;CARD=NUM;
L=L+1; RETURN; END;
/* DECODE CARD DEALT */
PCARD:PROC(PC,FLAG);DCL PC BINARY, FLAG BINARY;
DCL SUIT(4)CHAR(8)INIT('SPADER ','HJÄRTER ','RUTER ','KLÖVER ');
DCL FACE(4)CHAR(5)INIT('KNEKT','DAM ','KUNG ','ESS '), CDRC CHAR(5);
DCL CDD CHAR(2); DLIN=LINE(LL);
CK=CARD;CLIN=SUBSTR(DLIN,21,27); IF CC=2 THEN CLIN=SUBSTR(DLIN,1,27);
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,9,1)=' ' THEN CLIN=' ';
BLIN=SUIT(SUITV) CAT CDRC CAT ' ';
IF CC=2 THEN GO TO P2;
DLIN=BLIN CAT ' '; LINE(LL)=DLIN CAT CLIN;GO TO PP;
P2:IF SUBSTR(CLIN,9,1)¬=' ' THEN GOTO P22;
DLIN=' ';GO TO P23;
P22:DLIN=CLIN CAT ' ';P23: LINE(LL)=DLIN CAT BLIN;
PP: LL=LL+1; RETURN; END;
/* MAIN PROGRAM STARTS */
RULE:CALL KEYFUN(KKK);CALL CLEER(I);
IGEN:PUT FILE(D) SKIP;DO L=1 TO 3;
PUT FILE(D)EDIT('***********************************************')(A);END;
DO L=1 TO 800;END;PUT FILE(D) EDIT
('********* M.STENHARDT AB *********')(A);
DO L=1 TO 260;END;PUT FILE(D) EDIT
('********* HÄLSAR DIG VÄLKOMMEN *********')(A);
DO L=1 TO 260;END;PUT FILE(D) EDIT
('********* TILL *********')(A);
DO L=1 TO 260;END;PUT FILE(D) EDIT
('********* Q1 - CASINO *********')(A);
DO L=1 TO 800;END;DO L=1 TO 3;PUT FILE(D) EDIT
('***********************************************')
(A(47));END;DO L=1 TO 900;END;PUT FILE(D) EDIT
(' ')(A(47))(' *** TRYCK RETURN ***')(A(46));DO L=1 TO 1800;END;
CALL KEYFUN(KKK);IF KKK THEN GO TO FORTS;GO TO IGEN;
FORTS:GET SKIP LIST(DUMB); L=1; AMOUNT=250;
PUT FILE(D) SKIP EDIT(' ')(A(47))('SPELET VI SKA SPELA HETER "BLACKJACK"')
(A(94))('LAS VEGAS REGLER GÄLLER.')(A(94))('DU FÅR 250 KRONOR ATT STARTA MED.')
(A(94))('TRYCK RETURN')(A(46));GET SKIP LIST(DUMB);
CALL SHUFF;
GAME: DO I=1 TO 9; LINE(I)=BLK; END;
IF AMOUNT¬=0 THEN GOTO GGAA; PUT FILE(D)SKIP EDIT('DU ÄR PANK!!!')(A(94))
('JAG FINNS ALLTID HÄR DÅ DU KÄNNER')(A(47))('FÖR ATT FÖRLORA MER PENGAR.....')
(A(94))('TRYCK RETURN.')(A(47));GET SKIP LIST(DUMB); GOTO DONE;
GGAA: PUT FILE(D)SKIP EDIT('DU HAR ')(A(7))(AMOUNT)(P'ZZZZZZZZ9')(' KRONOR')
(A(31));IF IJK=1 THEN IJK=2;
PUT FILE(D)EDIT('HUR MYCKET SATSAR DU? ')(A(22));
GET SKIP LIST(BET);PUT FILE(D)EDIT(BET)(P'-----9')(' ')(A(19));
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(D)EDIT('SORRY, DET GÅR JAG INTE PÅ!')(A(47))
('TRYCK RETURN')(A(47));GET SKIP LIST(DUMB); GOTO GAME;
GGAB: IF BET<=AMOUNT THEN GOTO SST;
PUT FILE(D)EDIT('SORRY, MEN DU HAR INTE SÅ MYCKET!!')(A(47))('TRYCK RETURN')
(A(47));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
('VILL DU HA FLER KORT?')(A(47))('SVARA J ELLER N: ')(A(45));
GET SKIP LIST(DUMB);PUT FILE(D) EDIT(DUMB)(A(2));
IF DUMB¬='J' 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(94)); CALL POUT;
BUSP: PUT FILE(D)EDIT('DU FÖRLORADE! VILL DU FORTSÄTTA?')(A(47))
('SVARA J ELLER N:')(A(46));
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(D)EDIT('GRATTIS DU VANN!! VILL DU FORTSÄTTA?')(A(47))
('SVARA J ELLER N:')(A(46));
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(94)); 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(94));
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(6); IF SUBSTR(CLIN,5,1)¬='O' THEN CLIN=BLK; DL=5;
DLIN=CLIN CAT ' ';LINE(4)=DLIN CAT '*** BLACKJACK *** ';CALL POUT;
GO TO BUSP;
DCDD: CALL POUT;IF DCNT>PCNT THEN GOTO BUSP; IF DCNT<PCNT THEN GOTO WINP;
PUT FILE(D)EDIT('*** LIKA *** VILL DU FORTSÄTTA?')(A(47))
('SVARA J ELLER N:')(A(45));GO TO NX;
DONE: GOTO RULE;END;