home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol135 / poker.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.0 KB  |  486 lines
  1. 1    '**********************************************************************
  2. 2    '*                                      *
  3. 3    '*    A POKER MACHINE SIMULATOR FOR INVETERATE GAMBLERS          *
  4. 4    '*                                      *
  5. 5    '*    WRITTEN BY:    Richard Berthet                      *
  6. 6    '*                                          *
  7. 7    '*      DATE:        11/09/82                      *
  8. 8    '*                                      *
  9. 9    '*    PHONE:        H:(02)-88-1640    W:(02)-923-4801                  *
  10. 10    '*                                      *
  11. 11    '**********************************************************************    
  12. 12    '
  13. 13    '    Note, it is written for a CRT terminal that will display
  14. 14    '    reverse video and supports the following escape sequences.
  15. 15    '    You will probably have to make suitable alterations.
  16. 16    '
  17. 17    '    There are a few small bugs in the presentation which shouldn't
  18. 18    '    be difficult to clean up.
  19. 19    '    
  20. 20    '    The original version came from a photocopy of a magazine
  21. 21    '    article, the source of which I could not identify. So I give
  22. 22    '    thanks to the original author whoever he/she is?  I have
  23. 23    '    given a fairly good work over to make it pretty.
  24. 24    '
  25. 25    '    Happy gambling, you will find it terribly generous. You may
  26. 26    '    like to put a "house loading" in it so that it will rip you 
  27. 27    '       off more !
  28. 46    '    
  29. 47    '
  30. 48    '         ------ ADM-31 ASCII CONTROL CODES ------
  31. 49    '
  32. 50    '    ***************************************************************
  33. 51    '    FUNCTION NAME        STRING NAME        ASCII CODE
  34. 52    '    ***************************************************************
  35. 53    '
  36. 54    '    Bell
  37. 55                    BEL$        =    CHR$(7)
  38. 56    '
  39. 57    '    Back Space
  40. 58                    BS$        =    CHR$(8)
  41. 59    '
  42. 60    '    Horizontal Tab
  43. 61                    HT$         =    CHR$(9)
  44. 62    '
  45. 63    '    Line Feed
  46. 64                    LF$        =    CHR$(10)
  47. 65    '
  48. 66    '    Vertical Tab
  49. 67                    VT$        =    CHR$(11)
  50. 68    '
  51. 69    '    Form Feed
  52. 70                    FF$        =    CHR$(12)
  53. 71    '
  54. 72    '    Return
  55. 73                    RET$        =    CHR$(13)
  56. 74    '
  57. 75    '    Escape
  58. 76                    ESC$        =    CHR$(27)
  59. 77    '
  60. 78    '    Home
  61. 79                    HOME$        =    CHR$(30)
  62. 80    '
  63. 81    '    New Line
  64. 82                    NL$        =    CHR$(31)
  65. 83    '    Space
  66. 84                    SP$        =    CHR$(32)
  67. 85    '
  68. 86    '
  69. 87    '    ------ DYNAMIC VIDEO ATTRIBUTE CONTROL STRINGS ------
  70. 88    '    
  71. 89    '    ***************************************************************
  72. 90    '        FUNCTION NAME        STANDARD CHAR. GEN.     ALT. CHAR. GEN.
  73. 91    '    ***************************************************************
  74. 92    '    
  75. 93    '    Reset to Normal Video                          
  76. 94        STDVID$        =    ESC$+"G"+"0"                          
  77. 111    '
  78. 112    '    Reversing of Area
  79. 113        REVSTD$        =    ESC$+"G"+"4"
  80. 127    '
  81. 128    '    ------ DYNAMIC EDITING CONTROL STRINGS ------
  82. 129    '
  83. 130    '    ***************************************************************
  84. 131    '    OPERATION        HOW TO EXECUTE        DESCRIPTION
  85. 132    '    ***************************************************************
  86. 133    '    
  87. 134    '    Clear Screen                     Clears to SPACES
  88. 135        CLRSCRN$    =    ESC$+"+"
  89. 136    '    
  90. 182    '
  91. 183    '**********************************************************************
  92. 184    '
  93. 185    '    ------------- SCREEN ADDRESSES -------------
  94. 186    '
  95. 187    LHS%    =    1
  96. 188    RHS%    =    80
  97. 189    TOP%    =    1
  98. 190    BOTTOM%    =    24
  99. 191    '
  100. 192    '**********************************************************************
  101. 193    '
  102. 194    '    Definition of CURSOR LOAD Function. i.e. Pushing the Cursor
  103.                              Around Onscreen.
  104. 195        DEF FNCSRLD$(ROW%,COLUMN%) = ESC$+"="+CHR$(ROW%+31)
  105.                         +CHR$(COLUMN%+31)
  106. 196    '
  107. 200    '            
  108. 201    '    ------  FORMAT CONTROL OPERATION STRINGS ------
  109. 202    '
  110. 203    '    ***************************************************************
  111. 204    '
  112. 205    '    ***************************************************************
  113. 1000    DIM PRESREEL(3,3)    'Reels that are displayed(3 rows x 3 columns)
  114. 1050    DIM REEL(3,20)        'Holds combination of cards that each reel has
  115.                   on it. As read from DATA at programme bottom.
  116. 1100    '
  117. 1150    '
  118. 1200    '*******    INITIALISE  DATA    ********
  119. 1250    '
  120. 1300    STARTROW%    = TOP%+3
  121. 1350    NUMOFREELS%    = 3
  122. 1400    '
  123. 1450    PRINT CLRSCRN$
  124. 1500    PRINT "JACKPOT GAME":PRINT
  125. 1550    PRINT "DO YOU WANT A LIST OF PAYOFFS ? (Y=YES, <RET> = NO)";
  126. 1600    INPUT A$
  127. 1650    IF A$ = "Y"
  128.          THEN
  129.              1700
  130.          ELSE
  131.              2400
  132. 1700    PRINT CLRSCRN$
  133. 1750    PRINT "REEL 1"    ,"REEL 2"    ,"REEL 3"    ,"PAYOFF $":PRINT
  134. 1800    '
  135. 1850    PRINT "NINE"    ,"ANYTHING"    ,"ANYTHING"    ,"3"
  136. 1900    PRINT "NINE"    ,"NINE"        ,"ANYTHING"    ,"5"
  137. 1950    PRINT "JACK"    ,"JACK"        ,"ACE"        ,"6"
  138. 2000    PRINT "KING"    ,"KING"        ,"JACK"        ,"8"
  139. 2050    PRINT "TEN"    ,"TEN"        ,"TEN"        ,"10"
  140. 2100    PRINT "QUEEN"    ,"QUEEN"    ,"ANYTHING"    ,"15"
  141. 2150    PRINT "JACK"    ,"JACK"        ,"JACK"        ,"18"
  142. 2200    PRINT "QUEEN"    ,"QUEEN"    ,"QUEEN"    ,"20"
  143. 2250    PRINT "KING"    ,"KING"        ,"KING"        ,"30"
  144. 2300    PRINT "ACE"    ,"ACE"        ,"ACE"        ,"200"
  145. 2350    '
  146. 2400    FOR POSITION% = 1 TO NUMOFREELS%
  147. 2450        COLOFFSET%(POSITION%) = LHS%+OFFSET%
  148. 2500        OFFSET% = OFFSET%+15
  149. 2550    NEXT POSITION%
  150. 2600    FOR DISPLAYREEL% = 1 TO 6
  151. 2650        FOR SEG% = 1 TO 5            
  152. 2700            READ REEL$(DISPLAYREEL%,SEG%)    
  153. 2750        NEXT SEG%
  154. 2800    NEXT DISPLAYREEL%                
  155. 2850    PRINT
  156. 2900    PRINT "INPUT YOUR LUCKY NUMBER (IN THE RANGE -32766 TO 32767) TO START...";
  157. 2950    INPUT A
  158. 3000    RANDOMIZE(A)
  159. 3050    FOR CARD% = 1 TO 20
  160. 3100        FOR COLUMN% = 1 TO 3
  161. 3150            READ REEL(COLUMN%,CARD%)
  162. 3200        NEXT COLUMN%
  163. 3250    NEXT CARD%
  164. 3300    YOURCASH = 15
  165. 3350    PRINT CLRSCRN$
  166. 3351    '
  167. 3400    '>>>>>>>    LOOP RE-ENTRY POINT
  168. 3401    '
  169. 3500    '
  170. 3510    PRINT FNCSRLD$(TOP%,60);LINERA$;
  171. 3520    PRINT USING "$$#####-";YOURCASH
  172. 3550    FOR COLUMN% = 1 TO 3
  173. 3600        RANDOMCARD% = INT(20*RND+1)
  174. 3650        ' Check for boundary condition, CARD%=1
  175. 3700        IF RANDOMCARD% = 1
  176.             THEN
  177.                 PRESREEL (1,COLUMN%) = REEL(COLUMN%,20):
  178.                 GOTO 3800
  179. 3750        PRESREEL (1,COLUMN%) = REEL(COLUMN%,RANDOMCARD%-1)
  180. 3800        PRESREEL(2,COLUMN%) = REEL(COLUMN%,RANDOMCARD%)
  181. 3850        ' Check for boundary condition, CARD%=20
  182. 3900        IF RANDOMCARD% = 20
  183.             THEN
  184.                 PRESREEL (3,COLUMN%) = REEL(COLUMN%,1):
  185.                 GOTO 4000
  186. 3950        PRESREEL (3,COLUMN%) = REEL(COLUMN%,RANDOMCARD%+1)
  187. 4000        GOSUB 5550
  188. 4050    NEXT COLUMN%
  189. 4100    WINNINGS = 0 : BELLON$ = ""
  190. 4110    '
  191. 4120    'The following IF THEN statements check for winning combinations
  192. 4130    '
  193. 4150    IF PRESREEL(2,1) <> 4
  194.         THEN
  195.             4300
  196.         ELSE
  197.             IF PRESREEL(2,2) <> 4
  198.                 THEN
  199.                     4900
  200. 4200    IF PRESREEL(2,3) = 4
  201.         THEN
  202.             4250
  203.         ELSE
  204.             IF PRESREEL(2,3) <> 2
  205.                 THEN
  206.                     4900
  207.                 ELSE
  208.                     WINNINGS = 8     :
  209.                     BELLON$ = BEL$    :
  210.                     GOTO 4900
  211. 4250    WINNINGS = 30     :
  212.     BELLON$ = BEL$     :
  213.     GOTO 4900
  214. 4300    IF PRESREEL(2,1) <> 5
  215.         THEN
  216.             4400
  217.         ELSE
  218.             IF PRESREEL(2,2) <> 5
  219.                 THEN
  220.                     4900
  221.                 ELSE
  222.                     IF PRESREEL(2,3) <> 5
  223.                         THEN
  224.                             4900
  225. 4350    WINNINGS = 10     :
  226.     BELLON$    = BEL$    :
  227.     GOTO 4900
  228. 4400    IF PRESREEL(2,1) <> 3
  229.         THEN
  230.             4500
  231.         ELSE
  232.             IF PRESREEL(2,2) <> 3
  233.                 THEN
  234.                     4900
  235.                 ELSE
  236.                     IF PRESREEL(2,3) <> 3
  237.                         THEN
  238.                             4900
  239. 4450    WINNINGS = 200     :
  240.     BELLON$ = BEL$    :
  241.     GOTO 4900
  242. 4500    IF PRESREEL(2,1) <> 1
  243.         THEN
  244.             4600
  245.         ELSE
  246.             IF PRESREEL(2,2) = 1
  247.                 THEN
  248.                     4550
  249.                 ELSE
  250.                     WINNINGS = 3     :
  251.                     BELLON$ = BEL$    :
  252.                     GOTO 4900
  253. 4550    WINNINGS = 5     :
  254.     BELLON$ = BEL$    :
  255.     GOTO 4900
  256. 4600    IF PRESREEL(2,1) <> 2
  257.         THEN
  258.             4750
  259.         ELSE
  260.             IF PRESREEL(2,2) <> 2
  261.                 THEN
  262.                     4900
  263.                 ELSE
  264.                     IF PRESREEL(2,3) = 3
  265.                         THEN
  266.                             4700
  267. 4650    IF PRESREEL(2,3) <> 2
  268.         THEN
  269.             4900
  270.         ELSE
  271.             WINNINGS = 18     :
  272.             BELLON$ = BEL$    :
  273.             GOTO 4900
  274. 4700    WINNINGS = 6     :
  275.     BELLON$ = BEL$    :
  276.     GOTO 4900
  277. 4750    IF PRESREEL(2,1) <> 6
  278.         THEN
  279.             4900
  280.         ELSE
  281.             IF PRESREEL(2,2) <> 6
  282.                 THEN
  283.                     4900
  284.                 ELSE
  285.                     IF PRESREEL(2,3) = 3
  286.                         THEN
  287.                             4850
  288. 4800    IF PRESREEL(2,3) <> 6
  289.         THEN
  290.             4900
  291.         ELSE
  292.             WINNINGS = 20     :
  293.             BELLON$ = BEL$    :
  294.             GOTO 4900
  295. 4850    WINNINGS = 15    :
  296.     BELLON$ = BEL$
  297. 4900    IF WINNINGS = 200
  298.         THEN
  299.             GOSUB 6050    :
  300.             PRINT FNCSRLD$(T0P%,40);"***** JACKPOT *****"
  301. 4950    IF BELLON$ = BEL$
  302.         THEN
  303.             GOSUB 6050
  304. 5100    PRINT FNCSRLD$(TOP%,LHS%);
  305.     "To 'PULL HANDLE' hit <RETURN>, else 'N' TO END";
  306. 5150    INPUT A$
  307. 5160    YOURCASH = YOURCASH-1
  308. 5200    IF A$ = "N"
  309.          THEN
  310.              5250
  311.          ELSE
  312.              3400    
  313. 5250    IF YOURCASH < 15
  314.         THEN
  315.             5350
  316.         ELSE
  317.             PRINT FNCSRLD$(TOP%,LHS%);
  318.             LINERA$;
  319.             "CONGRATULATIONS, YOU WON ";YOURCASH-15;" DOLLARS"
  320. 5300    GOTO 10250
  321. 5350    IF YOURCASH < 0
  322.         THEN
  323.             5400
  324.         ELSE
  325.             PRINT FNCSRLD$(TOP%,LHS%);
  326.             CLRSCRN$;
  327.             "TOO BAD, YOU LOST ";15-YOURCASH;" DOLLARS"
  328. 5400    PRINT  FNCSRLD$(TOP%+1,LHS%);
  329.         "YOU HAVE TEN DAYS TO PAY ME THE ";15-YOURCASH;" AFTER THAT"
  330. 5450    PRINT FNCSRLD$(TOP%+2,LHS%);
  331.         "IT IS OUT OF MY HANDS AS TO WHAT HAPPENS TO YOU!!!"
  332. 5500    GOTO 10250
  333. 5550    IF PRESREEL(2,COLUMN%) = 1 
  334.         THEN
  335.             GOSUB 6650 : RETURN
  336. 5600    IF PRESREEL(2,COLUMN%) = 2
  337.         THEN
  338.             GOSUB 6650 : RETURN
  339. 5650    IF PRESREEL(2,COLUMN%) = 3
  340.         THEN
  341.             GOSUB 6650 : RETURN
  342. 5700    IF PRESREEL(2,COLUMN%) = 4
  343.         THEN
  344.             GOSUB 6650 : RETURN
  345. 5750    IF PRESREEL(2,COLUMN%) = 5
  346.         THEN
  347.             GOSUB 6650 : RETURN
  348. 5800    PRESREEL(2,COLUMN%) = 6
  349. 5850    GOSUB 6650
  350. 5900    RETURN
  351. 5950    '
  352. 6000    '----------------------------------------------------------------------
  353. 6050    '    Subroutine [1]: DING BELL & INCREMENT EARNINGS 
  354. 6100    '
  355. 6150    FOR LOOP = 1 TO WINNINGS
  356. 6200        PRINT BEL$;
  357. 6210        YOURCASH = YOURCASH+1
  358. 6220        PRINT FNCSRLD$(TOP%,60);LINERA$;
  359. 6230        PRINT USING "$$#####-";YOURCASH
  360. 6400    NEXT LOOP
  361. 6450    RETURN
  362. 6500    '
  363. 6550    '----------------------------------------------------------------------
  364. 6600    '
  365. 6650    '    Subroutine [2]: PRINT REELS 
  366. 6700    '
  367. 6750    '
  368. 6800    PRINTROW% = STARTROW%
  369. 6850    FOR ROW% = 1 TO 3
  370. 6900        FOR SEG%    = 1 TO 5
  371. 6950                PRINT FNCSRLD$
  372.                 (PRINTROW%+SEG%,COLOFFSET%(COLUMN%)+15);
  373.                 REVSTD$;
  374.                 REEL$(PRESREEL(ROW%,COLUMN%),SEG%);
  375.                 STDVID$
  376. 7000        NEXT SEG%
  377. 7050        PRINTROW% = PRINTROW%+6
  378. 7100    NEXT ROW%
  379. 7150    PRINT HOME$
  380. 7200    RETURN
  381. 7250    '
  382. 7300    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  383. 7350    '
  384. 7400    '    REEL DISPLAY DATA
  385. 7450    '
  386. 7500    DATA "999999999"
  387. 7550    DATA "9       9"
  388. 7600    DATA " N I N E "
  389. 7650    DATA "9       9"
  390. 7700    DATA "999999999"
  391. 7750    DATA "JJJJJJJJJ"
  392. 7800    DATA "J       J"
  393. 7850    DATA " J A C K "
  394. 7900    DATA "J       J"
  395. 7950    DATA "JJJJJJJJJ"
  396. 8000    DATA "    *    "
  397. 8050    DATA "   * *   "
  398. 8100    DATA " A  C  E "
  399. 8150    DATA " ******* "
  400. 8200    DATA "*       *"
  401. 8250    DATA "KKKKKKKKK"
  402. 8300    DATA "K\\\ ///K"
  403. 8350    DATA " K I N G "
  404. 8400    DATA "K/// \\\K"
  405. 8450    DATA "KKKKKKKKK"
  406. 8500    DATA "10     10"
  407. 8550    DATA "    T    "
  408. 8600    DATA " T  E  N "
  409. 8650    DATA "    N    "
  410. 8700    DATA "10     10"
  411. 8750    DATA "QQQQQQQQQ"
  412. 8800    DATA "Q-------Q"
  413. 8850    DATA "Q U E E N"
  414. 8900    DATA "Q-------Q"
  415. 8950    DATA "QQQQQQQQQ"
  416. 9000    '
  417. 9050    '    REEL COMBINATION DATA
  418. 9100    '
  419. 9110    ' This data is sequence the cards appear on each reel these are NOT
  420. 9120    ' the winning combinations, they are determined in the programme by
  421. 9130    ' the IF THEN statements so marked.
  422. 9131    '
  423. 9150    '      REEL 1, REEL 2, REEL 3
  424. 9200    '    
  425. 9249    '    JACK    KING    JACK
  426. 9250    DATA    2,    4,    2
  427. 9251    '
  428. 9299    '    TEN    NINE    KING
  429. 9300    DATA    5,    1,    4
  430. 9301    '
  431. 9349    '    JACK    JACK    TEN
  432. 9350    DATA    2,    2,    5
  433. 9351    '
  434. 9399    '    QUEEN    KING    QUEEN
  435. 9400    DATA    6,    4,    6
  436. 9401    '
  437. 9449    '    NINE    NINE    JACK
  438. 9450    DATA    1,    1,    2
  439. 9451    '
  440. 9499    '    KING    JACK    QUEEN
  441. 9500    DATA    4,    2,    6
  442. 9501    '
  443. 9549    '    TEN    KING    TEN
  444. 9550    DATA    5,    4,    5
  445. 9551    '
  446. 9599    '    QUEEEN    NINE    KING
  447. 9600    DATA    6,    1,    4
  448. 9601    '
  449. 9649    '    KING    TEN ***ACE***
  450. 9650    DATA    4,    5,    3
  451. 9651    '
  452. 9699    '    TEN    TEN    TEN
  453. 9700    DATA    5,    5,    5
  454. 9701    '
  455. 9749    '    NINE    NINE    JACK
  456. 9750    DATA    1,    1,    2
  457. 9751    '
  458. 9799    '    JACK    JACK    KING
  459. 9800    DATA    2,    2,    4
  460. 9801    '
  461. 9849    '    KING    KING    QUEEN
  462. 9850    DATA    4,    4,    6
  463. 9851    '
  464. 9899    '    NINE ***ACE***    JACK
  465. 9900    DATA    1,    3,    2
  466. 9901    '
  467. 9949    '   ***ACE***    KING    JACK    
  468. 9950    DATA    3,    4,    2
  469. 9951    '
  470. 9999    '    JACK    NINE    KING
  471. 10000    DATA    2,    1,    4
  472. 10001    '
  473. 10049    '    QUEEN    JACK    TEN
  474. 10050    DATA    6,    2,    5
  475. 10051    '
  476. 10099    '    NINE    KING    JACK
  477. 10100    DATA    1,    4,    2
  478. 10101    '
  479. 10149    '    KING    QUEEN    KING
  480. 10150    DATA    4,    6,    4
  481. 10151    '
  482. 10199    '    JACK    NINE    JACK
  483. 10200    DATA    2,    1,    2
  484. 10201    '
  485. 10250    END
  486.