C PROGRAM BLACKJACK C C WRITTEN BY MICHAEL BOORSTEIN C C DATE MARCH 11,1978 C C THIS PROGRAM PLAY BLACKJACK WITH ONE PERSON, BUT IT WILL ONLY C C USE A VT52 CRT FOR DISPLAY. C C IMPLICIT INTEGER(A-Z) REAL BET,BALNCE,TBET BYTE WHAT,SUIT,ANSWER,YES,BELL(20),NO,DOUBLE,SHUFFL BYTE TWHAT,TSUIT,UWHAT,USUIT DIMENSION WORTH(11) COMMON/NUMLFT/NUMLFT DATA YES/'Y'/ DATA BELL/20*"7/ DATA NO/'N'/ DATA DOUBLE/'D'/ DATA SHUFFL/'S'/ C C BEGIN EXECUTABLE CODE C C SET UP THE GAME C CALL ATTTRM BALNCE=150. CALL CLRSCN CALL STATUS(1) CALL ACOUNT(BALNCE) CALL SHUFLE C C BEGIN THE GAME C 10 NUMCRD=1 IF(NUMLFT.LE.17)CALL SHUFLE CALL GETBET(BET,BALNCE) CALL STATUS(' DEALING ') CALL GTNEXT(WORTH(NUMCRD),WHAT,SUIT) !DEAL FIRST CARD CALL PNTCRD(WHAT,SUIT,NUMCRD) !PRINT FIRST CARD CALL SUMALL(WORTH,LOWTOT,HITOT,NUMCRD) CALL TRACK(WHAT,SUIT,LOWTOT,HITOT,NUMCRD) !TRACK THE CARD CALL HOSFST(TWORTH,TWHAT,TSUIT) !GET DEALERS FIRST CARD NUMCRD=2 CALL GTNEXT(WORTH(NUMCRD),WHAT,SUIT) !GET SECOND CARD CALL PNTCRD(WHAT,SUIT,NUMCRD) CALL SUMALL(WORTH,LOWTOT,HITOT,NUMCRD) CALL TRACK(WHAT,SUIT,LOWTOT,HITOT,NUMCRD) CALL GTNEXT(UWORTH,UWHAT,USUIT) !GET DEALERS 2ND CARD CALL STATUS(' PLAYING ') IF(HITOT.EQ.21)GOTO 100 20 CALL QUESTN('HIT? [Y,N] ') CALL DETTRM READ(5,1000,END=22)ANSWER 1000 FORMAT(A1) 22 CALL ATTTRM IF(ANSWER.EQ.DOUBLE)GOTO 25 IF(ANSWER.EQ.YES)GOTO 30 IF(ANSWER.EQ.NO)GOTO 400 CALL QUESTN(0) CALL MESAGE('ONLY Y OR N OR D') GOTO 20 25 IF(NUMCRD.EQ.2)GOTO 26 CALL QUESTN(0) CALL MESAGE('YOU MAY ONLY DOUBLE DOWN ON THE FIRST 2 CARDS!') GOTO 20 C C INB ORDER TO DOUBLE DOWN , THE TOTAL MUST BE 10 OR 11 C 26 IF(HITOT.EQ.11.OR.HITOT.EQ.10)GOTO 27 CALL QUESTN(0) CALL MESAGE('TOTAL MUST EQUAL 10 OR 11 TO DOUBLE DOWN') GOTO 20 C C LEGAL DOUBLE DOWN C 27 TBET=2*BET TBET=AINT(TBET*100.)/100. IF(TBET.LE.BALNCE)GOTO 28 CALL QUESTN(0) CALL MESAGE('YOUR BALANCE IS NOT BIG ENOUGH TO DOUBLE YOUR BET') GOTO 20 28 CALL STATUS('DOUBLE DOWN') BET=TBET CALL PUTBET(BET,BALNCE) GOTO 30 C C NOW GET MORE CARDS IF WANTED C 30 NUMCRD=NUMCRD+1 CALL GTNEXT(WORTH(NUMCRD),WHAT,SUIT) CALL PNTCRD(WHAT,SUIT,NUMCRD) CALL SUMALL(WORTH,LOWTOT,HITOT,NUMCRD) CALL TRACK(WHAT,SUIT,LOWTOT,HITOT,NUMCRD) IF(ANSWER.EQ.DOUBLE)CALL WAIT(3,2,IDS) IF(ANSWER.EQ.DOUBLE)GOTO 400 !IF DOUBLE, DEALERS TURN IF(LOWTOT.GT.21)GOTO 300 !BUSTED IF(HITOT.EQ.21.OR.LOWTOT.EQ.21)CALL WAIT(3,2,IDS) !PLAYER 21, WAIT 3 SEC. IF(HITOT.EQ.21.OR.LOWTOT.EQ.21)GOTO 400 !NOW GO TO DEALER MOVE GOTO 20 C C BLACK JACK!!!!! C 100 DO 120 J=1,20 CALL STATUS(0) TYPE 1010,BELL 1010 FORMAT(X,20A1) 120 CALL STATUS(' BLACKJACK ') C C SEE IF THE DEALER ALSO HAS BLACKJACK C CALL WAIT(3,2,IDS) NUMCRD=2 WORTH(1)=TWORTH WORTH(2)=UWORTH CALL CLRFST CALL CLRCRD CALL PNTCRD(TWHAT,TSUIT,1) CALL PNTCRD(UWHAT,USUIT,2) CALL SUMALL(WORTH,LOWTOT,HITOT,NUMCRD) IF(HITOT.NE.21)GOTO 125 CALL MESAGE('DEALER ALSO HAS A BLACKJACK!') GOTO 590 C C DEALER DIDN'T HAVE A BLACKJACK, SO THE PLAYERS IS VALID C 125 CALL MESAGE('BLACKJACK PAYS 3 TO 2') BET=3.*BET/2. BET=AINT(BET*100.)/100. BALNCE=BALNCE+BET CALL ACOUNT(BALNCE) CALL WAIT(3,2,IDS) CALL STATUS(0) CALL QUESTN(0) GOTO 600 C C BUSTED C 300 CALL STATUS('HOUSE WINS ') CALL MESAGE('YOU WENT OVER 21') BALNCE=BALNCE-BET CALL ACOUNT(BALNCE) CALL STATUS(0) CALL QUESTN(0) GOTO 600 C C DEALERS MOVE C 400 PLATOT=HITOT IF(HITOT.GT.21)PLATOT=LOWTOT CALL STATUS('DEALER MOVE') CALL CLRCRD NUMCRD=1 WORTH(NUMCRD)=TWORTH CALL CLRFST CALL PNTCRD(TWHAT,TSUIT,NUMCRD) CALL SUMALL(WORTH,LOWHOS,HIHOS,NUMCRD) NUMCRD=2 WORTH(NUMCRD)=UWORTH CALL PNTCRD(UWHAT,USUIT,NUMCRD) 410 CALL SUMALL(WORTH,LOWHOS,HIHOS,NUMCRD) IF(LOWHOS.GT.21)GOTO 500 IF(HIHOS.NE.LOWHOS.AND.HIHOS.LT.17)GOTO 420 !STAND ON SOFT 17 IF(HIHOS.LT.17)GOTO 420 IF(HIHOS.GE.17.AND.HIHOS.GE.PLATOT.AND.HIHOS.LE.21)GOTO 550 IF(HIHOS.GE.17.AND.HIHOS.LT.PLATOT)GOTO 580 IF(LOWHOS.GE.17.AND.LOWHOS.GE.PLATOT)GOTO 550 IF(HIHOS.EQ.LOWHOS)GOTO 580 IF(LOWHOS.GE.17)GOTO 580 420 NUMCRD=NUMCRD+1 CALL GTNEXT(WORTH(NUMCRD),WHAT,SUIT) CALL PNTCRD(WHAT,SUIT,NUMCRD) GOTO 410 C C DEALER BUSTED C 500 CALL HOSTOT(LOWHOS) CALL STATUS(' YOU WIN ') CALL MESAGE('DEALER BUSTED, PAYS 1 TO 1') BALNCE=BALNCE+BET CALL ACOUNT(BALNCE) CALL STATUS(0) CALL QUESTN(0) GOTO 600 C C DEALER WINS C 550 TOTAL=HIHOS IF(HIHOS.GT.21)TOTAL=LOWHOS CALL HOSTOT(TOTAL) IF(TOTAL.EQ.PLATOT)GOTO 590 CALL STATUS('HOUSE WINS ') IF(TOTAL.GT.PLATOT)CALL MESAGE('DEALER BEAT YOUR HAND') BALNCE=BALNCE-BET CALL ACOUNT(BALNCE) CALL STATUS(0) CALL QUESTN(0) GOTO 600 C C DEALER LOOSES C 580 TOTAL=HIHOS IF(HIHOS.GT.21)TOTAL=LOWHOS CALL HOSTOT(TOTAL) CALL STATUS(' YOU WIN ') IF(LOWHOS.GT.21)CALL MESAGE('DEALER BUSTED PAYS 1 TO 1') IF(LOWHOS.LT.21)CALL MESAGE('YOUR HAND WON PAYS 1 TO 1') BALNCE=BALNCE+BET CALL ACOUNT(BALNCE) CALL STATUS(0) CALL QUESTN(0) GOTO 600 C C PUSH C 590 CALL STATUS(' PUSH ') CALL MESAGE('NOBODY WINS') CALL STATUS(0) CALL QUESTN(0) CALL ACOUNT(BALNCE) GOTO 600 C C AGAIN? C 600 IF(BALNCE.LE.0)GOTO 700 601 CALL QUESTN('GO AGAIN?') CALL DETTRM READ(5,1000,END=602)ANSWER 602 CALL ATTTRM IF(ANSWER.EQ.SHUFFL)GOTO 608 IF(ANSWER.EQ.NO)GOTO 610 IF(ANSWER.EQ.YES)GOTO 605 CALL QUESTN(0) CALL MESAGE('ONLY Y OR N OR S') GOTO 601 605 CALL RESET GOTO 10 C C FORCE A SHUFFL C 608 CALL SHUFLE CALL RESET GOTO 10 C C NICE PLAYING WITH YOU C 610 CALL MESAGE('NICE PLAYING WITH YOU! GOOD-BYE') CALL CLRSCN CALL EXIT C C BAD CREDIT C 700 CALL MESAGE('YOUR CREDIT IS NO LONGER GOOD! GOOD-BYE') CALL CLRSCN CALL EXIT END