home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / demos / games / poker.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  7.2 KB  |  304 lines
  1. '***********************************************************************
  2. '    Poker.rlz                      
  3. '
  4. '    Casino-Style Draw Poker 
  5. '
  6. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  7. '    All rights reserved.
  8. '
  9. '***********************************************************************
  10.  
  11. RUN "StdArray"
  12. RUN "StdSys"
  13.  
  14. SetSys(_Size, {_Maximize})
  15.  
  16. HandString = {"nothing", "jacks or better", "two pair", "three of a kind", "a straight", "a flush", "a full house", "four of a kind", "a straight flush", "a royal flush"}
  17. Payoff = {-1, 2, 3, 5, 10, 20, 50, 100, 200, 500}
  18.  
  19. FUNC CardSuit(cn)
  20.     RETURN (cn - 1)\13 + 1
  21. END FUNC
  22.  
  23. FUNC CardVal(cn)
  24.     RETURN ((cn - 1) mod 13) + 1
  25. END FUNC
  26.  
  27. FUNC CardName(cn)
  28.     RETURN Sprint("CARDP(0).BMP", cn)
  29. END FUNC
  30.  
  31. FUNC HandCompute(cards)
  32.     LOCAL i, straight, flush
  33.     LOCAL suits, counts, groups, high1, low1, high2, low2
  34.     
  35.     counts[1:13] = 0
  36.     suits[1:4] = 0
  37.     groups[1:4] = 0 
  38.     low1 = 15
  39.     high1 = 0
  40.     low2 = 15
  41.     high2 = 0
  42.     highpair = 0
  43.  
  44.     FOR i = 1 to 5
  45.         val = ((cards[i] - 1) mod 13) + 1
  46.         suit = (cards[i] - 1)\13 + 1
  47.         counts[val] = counts[val] + 1
  48.         suits[suit] = suits[suit] + 1
  49.         low1 = Min(low1, val)
  50.         high1 = Max(high1, val)
  51.         val = IF val = 1 THEN 14 ELSE val
  52.         low2 = Min(low2, val)
  53.         high2 = Max(high2, val)
  54.     NEXT i
  55.     FOR i = 1 to 13
  56.         val = counts[i]
  57.         IF val THEN
  58.             groups[val] = groups[val] + 1
  59.             IF val = 2 THEN
  60.                 highpair = Max(highpair, IF i = 1 THEN 14 ELSE i)
  61.             END IF
  62.         END IF
  63.     NEXT i
  64.     straight = (((high1 - low1 = 4) OR (high2 - low2 = 4)) AND (groups[1] = 5))
  65.     flush = 0
  66.     FOR i = 1 to 4
  67.         IF suits[i] = 5 THEN 
  68.             flush = 1
  69.         END IF
  70.     NEXT i
  71.     IF straight AND flush THEN
  72.         IF low2 = 10 THEN
  73.             RETURN 10
  74.         ELSE
  75.             RETURN 9
  76.         END IF
  77.     END IF
  78.     IF groups[4] THEN
  79.         RETURN 8
  80.     END IF
  81.     IF groups[3]  AND groups[2]  THEN
  82.         RETURN 7
  83.     END IF
  84.     IF flush THEN
  85.         RETURN 6
  86.     END IF
  87.     IF straight THEN
  88.         RETURN 5
  89.     END IF
  90.     IF groups[3] THEN
  91.         RETURN 4
  92.     END IF
  93.     IF groups[2] = 2 THEN
  94.         RETURN 3
  95.     END IF
  96.     IF groups[2] AND highpair > 10 THEN
  97.         RETURN 2
  98.     END IF
  99.     RETURN 1
  100. END FUNC
  101.  
  102. PROC ResetCards
  103.     PDeck[1:52] = 0
  104.     IF CFlag = -1 THEN
  105.         PDeck = {49, 52, 15, 33, 50, 40, 51, 19, 37, 8}
  106.         CFlag = 1
  107.     END IF
  108. END PROC
  109.  
  110. FUNC RandomCard
  111.     LOCAL i
  112.  
  113.     IF CFlag > 0 THEN
  114.         CFlag = CFlag + 1
  115.         RETURN PDeck[CFlag - 1]
  116.     END IF
  117.     LOOP
  118.         i = Floor(rnd * 52) + 1
  119.         IF i <> 53 THEN
  120.             IF NOT(PDeck[i]) THEN
  121.                 PDeck[i] = 1
  122.                 RETURN i
  123.             END IF
  124.         END IF
  125.     END LOOP
  126. END FUNC
  127.     
  128. PROC DrawCard(cards, i)
  129.     FormSetObject(10 + i, _Bitmap, CardName(cards[i]), ((18*i) - 11) pct, 50 pct)
  130. END PROC
  131.  
  132. PROC DrawCardBack(i)
  133.     FormSetObject(10 + i, _Bitmap, "BACK.BMP", ((18*i) - 11) pct, 50 pct)
  134. END PROC
  135.  
  136. FUNC c(n, x)
  137.     RETURN IF x = n THEN _Red ELSE _Black
  138. END FUNC
  139.  
  140. PROC UpdateTitles(n)
  141.     LOCAL obj
  142.  
  143.     IF n = LastTitle THEN
  144.         EXIT PROC
  145.     END IF
  146.     IF LastTitle > 1THEN
  147.         obj = 29+2*(LastTitle-1)
  148.         FormModifyObject(obj; _Black)
  149.         FormModifyObject(obj+1; _Black)
  150.     END IF
  151.     IF n > 1 THEN
  152.         obj = 29+2*(n-1)
  153.         FormModifyObject(obj; _Red)
  154.         FormModifyObject(obj+1; _Red)
  155.     END IF
  156.     LastTitle = n
  157. END PROC
  158.  
  159. PROC DrawTitles
  160.     LOCAL c
  161.  
  162.     c = _Black
  163.     FormSetObject(31, _CaptionLeft, "Jacks or better", 10 pct, 20 pct; c)
  164.     FormSetObject(32, _CaptionRight, "2 to 1", 33 pct, 20 pct, 10 pct, _Default; c)
  165.     FormSetObject(33, _CaptionLeft, "Two Pair", 10 pct, 24.2 pct; c)
  166.     FormSetObject(34, _CaptionRight, "3 to 1", 33 pct, 24.2 pct, 10 pct, _Default; c)
  167.     FormSetObject(35, _CaptionLeft, "Three of a Kind", 10 pct, 28.4 pct; c)
  168.     FormSetObject(36, _CaptionRight, "5 to 1", 33 pct, 28.4 pct, 10 pct, _Default; c)
  169.     FormSetObject(37, _CaptionLeft, "Straight", 10 pct, 32.6 pct; c)
  170.     FormSetObject(38, _CaptionRight, "10 to 1", 33 pct, 32.6 pct, 10 pct, _Default; c)
  171.     FormSetObject(39, _CaptionLeft, "Flush", 10 pct, 36.8 pct; c)
  172.     FormSetObject(40, _CaptionRight, "20 to 1", 33 pct, 36.8 pct, 10 pct, _Default; c)
  173.     FormSetObject(41, _CaptionLeft, "Full House", 52 pct, 20 pct; c)
  174.     FormSetObject(42, _CaptionRight, "50 to 1", 75 pct, 20 pct, 10 pct, _Default; c)
  175.     FormSetObject(43, _CaptionLeft, "Four of a Kind", 52 pct, 24.2 pct; c)
  176.     FormSetObject(44, _CaptionRight, "100 to 1", 75 pct, 24.2 pct, 10 pct, _Default; c)
  177.     FormSetObject(45, _CaptionLeft, "Straight Flush", 52 pct, 28.4 pct; c)
  178.     FormSetObject(46, _CaptionRight, "200 to 1", 75 pct, 28.4 pct, 10 pct, _Default; c)
  179.     FormSetObject(47, _CaptionLeft, "Royal Flush", 52 pct, 32.6 pct; c)
  180.     FormSetObject(48, _CaptionRight, "500 to 1", 75 pct, 32.6 pct, 10 pct, _Default; c)
  181. END PROC
  182.  
  183. PROC PlayHand
  184.     LOCAL i, sel, c
  185.  
  186.     UpdateTitles(0)
  187.     FOR i = 1 to 5
  188.         DrawCardBack(i)
  189.     NEXT i
  190.     ResetCards
  191.     FOR i = 1 to 5
  192.         cards[i] = RandomCard
  193.     NEXT i
  194.     FOR i = 1 to 5
  195.         DrawCard(cards, i)
  196.     NEXT i
  197.     FormModifyObject(1, _Gray)
  198.     UpdateTitles(HandCompute(cards))
  199.     FormModifyObject(1, _Normal, "Draw")
  200.     FormModifyObject(60, _Gray)
  201.     flipped = dim(5)
  202.     PokerMode = 2
  203. END PROC
  204.  
  205. PROC ProcessMode2(sel)
  206.     LOCAL i, c, h
  207.  
  208.     SELECT CASE sel
  209.         CASE 1    'Draw
  210.             FOR i = 1 to 5
  211.                 IF flipped[i] THEN
  212.                     cards[i] = RandomCard
  213.                     DrawCard(cards, i)
  214.                 END IF
  215.             NEXT i
  216.             FormModifyObject(1, _Gray)
  217.             h = HandCompute(cards)
  218.             UpdateTitles(h)
  219.             score = score + Payoff[h] * bet
  220.             FormSetObject(62, _CaptionCenter, "Cash: $ " + sprint("P(0)", score),  32 pct, 88.8 pct)
  221.             FormModifyObject(1, _Normal, "Deal")
  222.             FormModifyObject(60, _Normal)    
  223.             IF CFlag > 1 THEN
  224.                 CFlag = 0
  225.             END IF
  226.             PokerMode = 1
  227.  
  228.         CASE 11 TO 15        'Cards
  229.             c = sel - 10
  230.             IF flipped[c] THEN
  231.                 DrawCard(cards, c)
  232.                 flipped[c] = 0
  233.             ELSE
  234.                 DrawCardBack(c)
  235.                 flipped[c] = 1
  236.             END IF
  237.     END SELECT
  238. END PROC
  239.  
  240. PROC ProcessMode1(sel)
  241.     SELECT CASE sel
  242.         CASE 1    'Deal
  243.             newbet = StrToNum(FormQStr(60))
  244.             IF newbet < 1 OR newbet > 5 THEN
  245.                 INPUT "1 to 5 coins, please";
  246.             ELSE
  247.                 bet = newbet
  248.                 PlayHand
  249.                 PokerMode = 2
  250.             END IF
  251.     END SELECT
  252. END PROC
  253.  
  254. PROC formprocPoker(params)
  255.     FormSelect(params[_FormNum])
  256.     IF params[_Invoke] = _Close OR params[_ItemNum] = 3 THEN
  257.          %%PokerFlag = 0
  258.         FormControl(_Close)
  259.         EXIT PROGRAM
  260.     END IF
  261.     IF PokerMode = 1 THEN
  262.         ProcessMode1(params[_ItemNum])
  263.     ELSE
  264.         ProcessMode2(params[_ItemNum])
  265.     END IF
  266. END PROC
  267.  
  268. PROC mpC(params)
  269.     IF CFlag = 0 THEN
  270.         CFlag = -1
  271.     END IF
  272. END PROC
  273.  
  274. CFlag = 0
  275. score = 100
  276. bet = 1
  277. AddSys(_LoadDir, QSys(_ProgDir) + "cards")
  278.  
  279. menuC = MenuQUnique
  280. MenuNew(menuC; "")
  281. MenuSetCmd(1, "", 12)
  282. MenuSetProc(mpC)
  283.  
  284. FontNew(1; "helv", 24, _Bold)
  285. Randomize StrToNum(sprint("D(m1s1)", qdate))
  286. fdPoker = FormQUnique
  287. FormNew(fdPoker; "Draw Poker", _Title + _Minimize + _Close)
  288. FormControl(_Size; 5 pct, 5 pct, 90 pct, 90 pct)
  289. FormSetColor(0.4, 1.0, 0.6)
  290. FormSetColor(_Black; _Text)
  291. FormSetColor(0.4, 1.0, 0.6; _Field)
  292. FormSetObject(20, _CaptionCenter, "Realizer Casino -- Draw Poker", 1, 0 pct, 2 pct, 100 pct, _Default)
  293. LastTitle = 0
  294. FormSetObject(1, _DefButton, "Deal", 10 pct, 87 pct, 15 pct, _Default)
  295. FormSetObject(61, _CaptionLeft, "Bet:", 51 pct, 88.8 pct)
  296. FormSetObject(60, _EditText, "1", 58 pct, 87.3 pct, 10 pct, _Default)
  297. FormSetObject(62, _CaptionCenter, "Cash: $ " + sprint("P(0)", score),  32 pct, 88.8 pct)
  298. FormSetObject(3, _Button, "Quit", 75 pct, 87 pct, 15 pct, _Default)
  299. DrawTitles
  300. PokerMode = 1 
  301. FormSetProc(formprocPoker)
  302. FormControl(_Show)
  303.  
  304.