#!/bin/sh # # This is a shell archive. To extract its contents, # execute this file with /bin/sh to create the file(s): # # bj bj.per mkbj random.4gl # bj.4gl # # This shell archive created: Thu Jun 27 12:53:31 EDT 1996 # echo "Extracting file bj" sed -e 's/^X//' <<\SHAR_EOF > bj Xfglgo bj $RANDOM $RANDOM SHAR_EOF if [ `wc -c < bj` -ne 25 ] then echo "Lengths do not match -- Bad Copy of bj" fi echo "Extracting file bj.4gl" sed -e 's/^X//' <<\SHAR_EOF > bj.4gl X# bj.4gl - Blackjack simulator X# Paul Hutton 1992 huttonp@ozemail.com.au X Xglobals Xdefine X g_opened, X g_no_players, g_end, g_ptr, X g_burn, g_dealer_tot, g_sim smallint, X gpa_player array[4] of record X hc char(1), X player_name char(10), X curr_funds money(10,0) X end record, X g_deck char(312), X ga_bet, ga_sbet, ga_lbet array[4] of money(10,0), X ga_cards, ga_scards array[4] of char(7), X ga_last array[4] of char(1), X g_dealer char(7), X g_spl, g_dbl, g_sdbl char(4), X i, j, p, a, s smallint Xend globals X Xmain X call ini_bj() X call get_options() X call play() Xend main X Xfunction ini_bj() X Xcall seed() X Xlet g_end = false Xlet g_sim = true Xlet g_ptr = 1 Xlet g_burn = 1 Xfor i = 1 to 4 X initialize gpa_player[i].* to null Xend for X Xend function X Xfunction get_options() X Xdefine X l_curr_funds money(10,0) Xclear screen X Xlet l_curr_funds = 0 Xwhile l_curr_funds < 1 X prompt "Enter starting float (ENTER = 100) " for l_curr_funds X if l_curr_funds is null then X let l_curr_funds = 100 X end if Xend while X Xlet g_no_players = 0 Xwhile g_no_players < 1 or g_no_players > 4 X prompt "Enter the number of players (1-4, ENTER = 1) " for char g_no_players X if g_no_players is null then X let g_no_players = 1 X end if Xend while X Xfor i = 1 to g_no_players X let gpa_player[i].hc = " " X while gpa_player[i].hc not matches "[HC]" X prompt "Is player ", i, " (Human/Computer, ENTER = Computer) ? " X for char gpa_player[i].hc X if length(gpa_player[i].hc) = 0 then X let gpa_player[i].hc = "C" X end if X X let gpa_player[i].hc = upshift(gpa_player[i].hc) X if gpa_player[i].hc = "H" then X let g_sim = false X end if X end while X X if gpa_player[i].hc = "H" then X prompt "Enter name of player ", i, " " for gpa_player[i].player_name X if length(gpa_player[i].player_name) = 0 then X let gpa_player[i].player_name = "Human", i using "&" clipped X end if X else X let gpa_player[i].player_name = "Computer", i using "&" clipped X end if X X let gpa_player[i].curr_funds = l_curr_funds Xend for X Xend function X Xfunction play() X Xdefine X l_dummy char(1) X Xclear screen Xopen window w_deal at 2,2 with 4 rows, 77 columns X attribute(border, cyan) Xdisplay "Dealer" at 2,20 attribute(cyan) X Xopen window w_scards at 7,2 with 4 rows, 77 columns X attribute(border, cyan) Xopen window w_cards at 12,2 with 4 rows, 77 columns X attribute(border, cyan) Xopen window w_stat at 17,2 with form "bj" X attribute(border, cyan, form line 1, prompt line last - 1, X message line last - 1) X Xwhile not g_end X call place_bets() X call init_deal() X let g_dealer_tot = card_total(0, "") X call res_hands() X call res_funds() X X if not g_sim then X current window is w_stat X prompt "Press ENTER to continue " for char l_dummy X attribute(white) X end if X X call close_cards() Xend while X Xclose window w_deal Xclose window w_scards Xclose window w_cards Xclose window w_stat X Xend function X Xfunction place_bets() X Xdefine X l_ok char(1) X Xcurrent window is w_stat Xclear form Xfor i = 1 to g_no_players X display gpa_player[i].curr_funds, gpa_player[i].player_name X to sa_player[i].* attribute(green) X X initialize ga_bet[i] to null X initialize ga_sbet[i] to null X X if ga_lbet[i] is null then X let ga_lbet[i] = 1 X end if X X if ga_last[i] is null then X let ga_last[i] = 'S' ### If starting out, then last was a standoff X end if X X initialize ga_cards[i] to null X initialize ga_scards[i] to null X let g_spl[i] = "N" X let g_dbl[i] = "N" X let g_sdbl[i] = "N" Xend for X Xinitialize g_dealer to null X Xmessage "Enter your bets" attribute(white) Xwhile true X for p = 1 to g_no_players X if gpa_player[p].curr_funds > 0 then X if gpa_player[p].hc = "C" then X X # Evaluate computer bet based on last bet X case X when ga_last[p] = "W" let ga_bet[p] = 1 X when ga_last[p] = "S" let ga_bet[p] = ga_lbet[p] X when ga_last[p] = "L" X let ga_bet[p] = ga_lbet[p] * 2 X if ga_bet[p] > 100 then X let ga_bet[p] = 100 X end if X end case X X if ga_bet[p] > gpa_player[p].curr_funds then X let ga_bet[p] = gpa_player[p].curr_funds X end if X X display ga_bet[p] to sa_bet[p].curr_bet attribute(white) X else X input ga_bet[p] without defaults from sa_bet[p].* attribute(white) X X before field curr_bet X if ga_bet[p] is null then X let ga_bet[p] = 1 X end if X X display ga_bet[p] to sa_bet[p].curr_bet attribute(white) X X after field curr_bet X if ga_bet[p] > gpa_player[p].curr_funds then X error " You cannot bet more than you have " X attribute(red, reverse) X next field curr_bet X end if X X end input X end if X end if X end for X X if not g_sim then X prompt "Bets correct (Yes/No, ENTER = Yes) ? " for char l_ok X attribute(white) X let l_ok = upshift(l_ok) X if length(l_ok) = 0 then X let l_ok = "Y" X else X if l_ok not matches "[YN]" then X let l_ok = "N" X end if X end if X X if l_ok = "Y" then X exit while X end if X else X exit while X end if Xend while X Xfor i = 1 to g_no_players X if ga_bet[i] is null then X let ga_bet[i] = 0 X display ga_bet[i] to sa_bet[i].curr_bet attribute(white) X end if X X let gpa_player[i].curr_funds = gpa_player[i].curr_funds - ga_bet[i] X display gpa_player[i].curr_funds to sa_player[i].curr_funds X attribute(green) Xend for X Xend function X Xfunction init_deal() X Xfor p = 1 to g_no_players X if ga_bet[p] <> 0 then X call deal(p, "") X end if Xend for X Xcall deal(0, "") X Xfor p = 1 to g_no_players X if ga_bet[p] <> 0 then X call deal(p, "") X end if Xend for X Xend function X Xfunction deal(l_no, l_spl) X Xdefine X l_no, l smallint, X l_spl, l_card char(1), X l_cards char(7) X Xif g_ptr >= g_burn then X call shuffle() Xend if X Xif l_no = 0 then X let l = length(g_dealer) + 1 X let l_card = g_deck[g_ptr] X let g_dealer = g_dealer clipped, l_card X X case X when l = 1 X open window w_deal1 at 3,30 with 2 rows, 3 columns X attribute(border, white) X when l = 2 X open window w_deal2 at 3,32 with 2 rows, 3 columns X attribute(border, white) X when l = 3 X open window w_deal3 at 3,34 with 2 rows, 3 columns X attribute(border, white) X when l = 4 X open window w_deal4 at 3,36 with 2 rows, 3 columns X attribute(border, white) X when l = 5 X open window w_deal5 at 3,38 with 2 rows, 3 columns X attribute(border, white) X when l = 6 X open window w_deal6 at 3,40 with 2 rows, 3 columns X attribute(border, white) X when l = 7 X open window w_deal7 at 3,42 with 2 rows, 3 columns X attribute(border, white) X end case X X display l_card at 1,1 attribute(white) X display l_card at 2,3 attribute(white) Xelse X if l_spl = "S" then X let l_cards = ga_scards[l_no] X let l = length(l_cards) + 1 X let l = l + ((l_no - 1) * 7) X let l_card = g_deck[g_ptr] X let ga_scards[l_no] = ga_scards[l_no] clipped, l_card X X case X when l = 1 X open window w_scard11 at 8,6 with 2 rows, 3 columns X attribute(border, white) X when l = 2 X open window w_scard12 at 8,8 with 2 rows, 3 columns X attribute(border, white) X when l = 3 X open window w_scard13 at 8,10 with 2 rows, 3 columns X attribute(border, white) X when l = 4 X open window w_scard14 at 8,12 with 2 rows, 3 columns X attribute(border, white) X when l = 5 X open window w_scard15 at 8,14 with 2 rows, 3 columns X attribute(border, white) X when l = 6 X open window w_scard16 at 8,16 with 2 rows, 3 columns X attribute(border, white) X when l = 7 X open window w_scard17 at 8,18 with 2 rows, 3 columns X attribute(border, white) X X when l = 8 X open window w_scard21 at 8,25 with 2 rows, 3 columns X attribute(border, white) X when l = 9 X open window w_scard22 at 8,27 with 2 rows, 3 columns X attribute(border, white) X when l = 10 X open window w_scard23 at 8,29 with 2 rows, 3 columns X attribute(border, white) X when l = 11 X open window w_scard24 at 8,31 with 2 rows, 3 columns X attribute(border, white) X when l = 12 X open window w_scard25 at 8,33 with 2 rows, 3 columns X attribute(border, white) X when l = 13 X open window w_scard26 at 8,35 with 2 rows, 3 columns X attribute(border, white) X when l = 14 X open window w_scard27 at 8,37 with 2 rows, 3 columns X attribute(border, white) X X when l = 15 X open window w_scard31 at 8,44 with 2 rows, 3 columns X attribute(border, white) X when l = 16 X open window w_scard32 at 8,46 with 2 rows, 3 columns X attribute(border, white) X when l = 17 X open window w_scard33 at 8,48 with 2 rows, 3 columns X attribute(border, white) X when l = 18 X open window w_scard34 at 8,50 with 2 rows, 3 columns X attribute(border, white) X when l = 19 X open window w_scard35 at 8,52 with 2 rows, 3 columns X attribute(border, white) X when l = 20 X open window w_scard36 at 8,54 with 2 rows, 3 columns X attribute(border, white) X when l = 21 X open window w_scard37 at 8,56 with 2 rows, 3 columns X attribute(border, white) X X when l = 22 X open window w_scard41 at 8,63 with 2 rows, 3 columns X attribute(border, white) X when l = 23 X open window w_scard42 at 8,65 with 2 rows, 3 columns X attribute(border, white) X when l = 24 X open window w_scard43 at 8,67 with 2 rows, 3 columns X attribute(border, white) X when l = 25 X open window w_scard44 at 8,69 with 2 rows, 3 columns X attribute(border, white) X when l = 26 X open window w_scard45 at 8,71 with 2 rows, 3 columns X attribute(border, white) X when l = 27 X open window w_scard46 at 8,73 with 2 rows, 3 columns X attribute(border, white) X when l = 28 X open window w_scard47 at 8,75 with 2 rows, 3 columns X attribute(border, white) X end case X X display l_card at 1,1 attribute(white) X display l_card at 2,3 attribute(white) X else X let l_cards = ga_cards[l_no] X let l = length(l_cards) + 1 X let l = l + ((l_no - 1) * 7) X let l_card = g_deck[g_ptr] X let ga_cards[l_no] = ga_cards[l_no] clipped, l_card X X case X when l = 1 X open window w_card11 at 13,6 with 2 rows, 3 columns X attribute(border, white) X when l = 2 X open window w_card12 at 13,8 with 2 rows, 3 columns X attribute(border, white) X when l = 3 X open window w_card13 at 13,10 with 2 rows, 3 columns X attribute(border, white) X when l = 4 X open window w_card14 at 13,12 with 2 rows, 3 columns X attribute(border, white) X when l = 5 X open window w_card15 at 13,14 with 2 rows, 3 columns X attribute(border, white) X when l = 6 X open window w_card16 at 13,16 with 2 rows, 3 columns X attribute(border, white) X when l = 7 X open window w_card17 at 13,18 with 2 rows, 3 columns X attribute(border, white) X X when l = 8 X open window w_card21 at 13,25 with 2 rows, 3 columns X attribute(border, white) X when l = 9 X open window w_card22 at 13,27 with 2 rows, 3 columns X attribute(border, white) X when l = 10 X open window w_card23 at 13,29 with 2 rows, 3 columns X attribute(border, white) X when l = 11 X open window w_card24 at 13,31 with 2 rows, 3 columns X attribute(border, white) X when l = 12 X open window w_card25 at 13,33 with 2 rows, 3 columns X attribute(border, white) X when l = 13 X open window w_card26 at 13,35 with 2 rows, 3 columns X attribute(border, white) X when l = 14 X open window w_card27 at 13,37 with 2 rows, 3 columns X attribute(border, white) X X when l = 15 X open window w_card31 at 13,44 with 2 rows, 3 columns X attribute(border, white) X when l = 16 X open window w_card32 at 13,46 with 2 rows, 3 columns X attribute(border, white) X when l = 17 X open window w_card33 at 13,48 with 2 rows, 3 columns X attribute(border, white) X when l = 18 X open window w_card34 at 13,50 with 2 rows, 3 columns X attribute(border, white) X when l = 19 X open window w_card35 at 13,52 with 2 rows, 3 columns X attribute(border, white) X when l = 20 X open window w_card36 at 13,54 with 2 rows, 3 columns X attribute(border, white) X when l = 21 X open window w_card37 at 13,56 with 2 rows, 3 columns X attribute(border, white) X X when l = 22 X open window w_card41 at 13,63 with 2 rows, 3 columns X attribute(border, white) X when l = 23 X open window w_card42 at 13,65 with 2 rows, 3 columns X attribute(border, white) X when l = 24 X open window w_card43 at 13,67 with 2 rows, 3 columns X attribute(border, white) X when l = 25 X open window w_card44 at 13,69 with 2 rows, 3 columns X attribute(border, white) X when l = 26 X open window w_card45 at 13,71 with 2 rows, 3 columns X attribute(border, white) X when l = 27 X open window w_card46 at 13,73 with 2 rows, 3 columns X attribute(border, white) X when l = 28 X open window w_card47 at 13,75 with 2 rows, 3 columns X attribute(border, white) X end case X X display l_card at 1,1 attribute(white) X display l_card at 2,3 attribute(white) X end if Xend if X Xlet g_ptr = g_ptr + 1 X Xend function X Xfunction shuffle() X Xdefine X l_cnt array[13] of smallint, X l_val smallint X Xcurrent window is w_stat Xmessage "Shuffling ..... please wait" attribute(white) X Xfor i = 1 to 13 X let l_cnt[i] = 0 Xend for X Xfor i = 1 to 312 X while true X let l_val = rnd(13) X if l_cnt[l_val] < 24 then X let l_cnt[l_val] = l_cnt[l_val] + 1 X case X when l_val = 1 X let g_deck[i] = "A" X when l_val = 10 X let g_deck[i] = "T" X when l_val = 11 X let g_deck[i] = "J" X when l_val = 12 X let g_deck[i] = "Q" X when l_val = 13 X let g_deck[i] = "K" X otherwise X let g_deck[i] = l_val using "&" clipped X end case X exit while X end if X end while Xend for X Xlet g_burn = 312 - rnd(51) Xlet g_ptr = 1 X Xcurrent window is w_stat Xmessage "" X Xend function X Xfunction special_bets(p) X Xdefine X p, l_tot smallint, X l_cards char(7), X l_spl, l_dbl char(1) X X if gpa_player[p].curr_funds >= ga_bet[p] then #### Check enough funds X X #### Split X X let g_spl[p] = "N" X X let l_cards = ga_cards[p] X if l_cards[1] = l_cards[2] then X if gpa_player[p].hc = "C" then X if l_cards[1] matches "[8A]" then X let g_spl[p] = "Y" X end if X else X let g_spl[p] = " " X while g_spl[p] not matches "[YN]" X current window is w_stat X prompt gpa_player[p].player_name clipped, X ", do you wish to split (Yes/No, ENTER = No) ? " for char l_spl X attribute(white) X let l_spl = upshift(l_spl) X if length(l_spl) = 0 then X let l_spl = "N" X end if X X let g_spl[p] = l_spl X end while X end if X end if X X if g_spl[p] = "Y" then X let gpa_player[p].curr_funds = gpa_player[p].curr_funds - ga_bet[p] X let ga_sbet[p] = ga_bet[p] X current window is w_stat X display ga_bet[p], ga_sbet[p] to sa_bet[p].*, sa_sbet[p].* X attribute(white) X display gpa_player[p].curr_funds to sa_player[p].curr_funds X attribute(green) X let l_cards = l_cards[1] X let ga_cards[p] = l_cards X let ga_scards[p] = l_cards X X case X when p = 1 X close window w_card12 X open window w_scard11 at 8,6 with 2 rows, 3 columns X attribute(border, white) X when p = 2 X close window w_card22 X open window w_scard21 at 8,25 with 2 rows, 3 columns X attribute(border, white) X when p = 3 X close window w_card32 X open window w_scard31 at 8,44 with 2 rows, 3 columns X attribute(border, white) X when p = 4 X close window w_card42 X open window w_scard41 at 8,63 with 2 rows, 3 columns X attribute(border, white) X end case X X display l_cards at 1,1 attribute(white) X display l_cards at 2,3 attribute(white) X X call deal(p, "") X call deal(p, "S") X end if X X #### Double down X X let g_dbl[p] = "N" X X let l_tot = card_total(p, "") X if l_tot > 8 and l_tot < 12 then X if gpa_player[p].hc = "C" then X if l_tot = 9 and g_dealer_tot < 7 X or l_tot = 10 and g_dealer_tot < 10 X or l_tot = 11 and g_dealer_tot < 11 then X let g_dbl[p] = "Y" X end if X else X let g_dbl[p] = " " X while g_dbl[p] not matches "[YN]" X current window is w_stat X prompt gpa_player[p].player_name clipped, X ", do you wish to double (Yes/No, ENTER = No) ? " for char l_dbl X attribute(white) X let l_dbl = upshift(l_dbl) X if length(l_dbl) = 0 then X let l_dbl = "N" X end if X X let g_dbl[p] = l_dbl X end while X end if X end if X X if g_dbl[p] = "Y" then X let gpa_player[p].curr_funds = gpa_player[p].curr_funds - ga_bet[p] X let ga_bet[p] = ga_bet[p] * 2 X current window is w_stat X display ga_bet[p] to sa_bet[p].* attribute(white) X display gpa_player[p].curr_funds to sa_player[p].curr_funds X attribute(green) X end if X X #### Double a split X X let g_sdbl[p] = "N" X if g_spl[p] = "Y" and gpa_player[p].curr_funds >= ga_sbet[p] then X let l_tot = card_total(p, "S") X if l_tot > 8 and l_tot < 12 then X if gpa_player[p].hc = "C" then X if l_tot > g_dealer_tot then X let g_sdbl[p] = "Y" X end if X else X let g_sdbl[p] = " " X while g_sdbl[p] not matches "[YN]" X current window is w_stat X prompt gpa_player[p].player_name clipped, X " (split), do you wish to double (Yes/No, ENTER = No) ? " X for char l_dbl attribute(white) X let l_dbl = upshift(l_dbl) X if length(l_dbl) = 0 then X let l_dbl = "N" X end if X X let g_sdbl[p] = l_dbl X end while X end if X end if X X if g_sdbl[p] = "Y" then X let gpa_player[p].curr_funds = gpa_player[p].curr_funds - ga_sbet[p] X let ga_sbet[p] = ga_sbet[p] * 2 X current window is w_stat X display ga_sbet[p] to sa_sbet[p].* attribute(white) X display gpa_player[p].curr_funds to sa_player[p].curr_funds X attribute(green) X end if X end if X end if X Xend function X Xfunction res_hands() X Xdefine X hs char(1), X l_tot smallint X Xfor p = 1 to g_no_players X if ga_bet[p] > 0 then X call special_bets(p) X X while true X let l_tot = card_total(p, "") X if l_tot >= 21 then X if l_tot > 21 then X current window is w_stat X display "Bust" to sa_pstat[p].p_stat attribute(white) X else X if l_tot = 21 and bj(p, "") then X current window is w_stat X display "BJ" to sa_pstat[p].p_stat attribute(white) X end if X end if X X exit while X else X if gpa_player[p].hc = "C" then X let hs = sim_hs(p, "") X else X if g_dbl[p] = "Y" or card_total(p, "") < 12 then X let hs = "H" X else X let hs = " " X while hs not matches "[HS]" and g_dbl[p] <> "D" X current window is w_stat X prompt gpa_player[p].player_name clipped, ", you have ", X l_tot, ". (Hit/Stick, ENTER = Hit) ? " for char hs X attribute(white) X if length(hs) = 0 then X let hs = "H" X end if X let hs = upshift(hs) X end while X end if X end if X X if hs = "H" then X call deal(p, "") X X #### Set double flag X X if g_dbl[p] = "Y" then X let g_dbl[p] = "D" X end if X else X exit while X end if X end if X end while X end if X X #### Handle splits X X if g_spl[p] = "Y" then X while true X let l_tot = card_total(p, "S") X if l_tot >= 21 then X if l_tot > 21 then X current window is w_stat X display "Bust" to sa_sstat[p].s_stat attribute(white) X else X if l_tot = 21 and bj(p, "S") then X current window is w_stat X display "BJ" to sa_sstat[p].s_stat attribute(white) X end if X end if X X exit while X else X if gpa_player[p].hc = "C" then X let hs = sim_hs(p, "S") X else X if g_sdbl[p] = "Y" or card_total(p, "S") < 12 then X let hs = "H" X else X let hs = " " X while hs not matches "[HS]" and g_sdbl[p] <> "D" X current window is w_stat X prompt gpa_player[p].player_name clipped, " (split), you have ", X l_tot, ". (Hit/Stick, ENTER = Hit) ? " for char hs X attribute(white) X if length(hs) = 0 then X let hs = "H" X end if X let hs = upshift(hs) X end while X end if X end if X X if hs = "H" then X call deal(p, "S") X X #### Set double flag X X if g_sdbl[p] = "Y" then X let g_sdbl[p] = "D" X end if X else X exit while X end if X end if X end while X end if X Xend for X Xlet l_tot = card_total(0, "") Xwhile l_tot < 17 X call deal(0, "") X let l_tot = card_total(0, "") Xend while X Xlet g_dealer_tot = l_tot Xif g_dealer_tot > 21 then X open window w_dstat at 3,50 with 1 rows, 5 columns X display "Bust" at 1,1 attribute(white) Xelse X if g_dealer_tot = 21 and bj(0, "") then X open window w_dstat at 3,50 with 1 rows, 5 columns X display "BJ" at 1,1 attribute(white) X end if Xend if X Xend function X Xfunction sim_hs(p, l_spl) X Xdefine X p, l_tot smallint, X l_spl char(1) X Xlet l_tot = card_total(p, l_spl) X Xcase X when l_tot > 16 X return "S" X when l_tot < 12 X return "H" X when l_tot - 10 > g_dealer_tot X return "S" X otherwise X return "H" Xend case X Xend function X Xfunction card_total(l_no, l_spl) X Xdefine X l_no, l_tot, l_no_aces, l, X l_num smallint, X l_spl, l_ch char(1), X l_str char(7) X Xlet l_tot = 0 Xlet l_no_aces = 0 X Xif l_no = 0 then X let l_str = g_dealer Xelse X if l_spl = "S" then X let l_str = ga_scards[l_no] X else X let l_str = ga_cards[l_no] X end if Xend if X Xfor l = 1 to length(l_str) X let l_ch = l_str[l] X case X when l_ch = "A" X let l_tot = l_tot + 11 X let l_no_aces = l_no_aces + 1 X when l_ch matches "[TJQK]" X let l_tot = l_tot + 10 X otherwise X let l_num = l_ch X let l_tot = l_tot + l_num X end case Xend for X Xwhile l_no_aces > 0 and l_tot > 21 X let l_tot = l_tot - 10 X let l_no_aces = l_no_aces - 1 Xend while X Xreturn l_tot X Xend function X Xfunction res_funds() X Xfor p = 1 to g_no_players X if ga_bet[p] > 0 then X case who_won(p, "") X when "S" #### Stand X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + ga_bet[p] X let ga_last[p] = "S" X current window is w_stat X display "Stand" to sa_pstat[p].p_stat attribute(white) X X when "P" #### Player win X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + X (ga_bet[p] * 2) X let ga_last[p] = "W" X current window is w_stat X display "Win" to sa_pstat[p].p_stat attribute(white) X X when "B" #### BJ X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + X (ga_bet[p] * 3) X let ga_last[p] = "W" X current window is w_stat X display "BJ" to sa_pstat[p].p_stat attribute(white) X X otherwise #### Lose X let ga_last[p] = "L" X current window is w_stat X display "Lose" to sa_pstat[p].p_stat attribute(white) X X end case X X display gpa_player[p].curr_funds to sa_player[p].curr_funds X attribute(green) X X if g_spl[p] = "Y" then X case who_won(p, "S") X when "S" #### Stand X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + ga_sbet[p] X current window is w_stat X display "Stand" to sa_sstat[p].s_stat attribute(white) X X when "P" #### Player win X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + X (ga_sbet[p] * 2) X X case X when ga_last[p] = "L" let ga_last[p] = "S" X when ga_last[p] = "S" let ga_last[p] = "W" X end case X X current window is w_stat X display "Win" to sa_sstat[p].s_stat attribute(white) X X when "B" #### BJ X let gpa_player[p].curr_funds = gpa_player[p].curr_funds + X (ga_sbet[p] * 3) X X case X when ga_last[p] = "L" or ga_last[p] = "S" let ga_last[p] = "W" X end case X X current window is w_stat X display "BJ" to sa_sstat[p].s_stat attribute(white) X X otherwise #### Lose X X case X when ga_last[p] = "W" let ga_last[p] = "S" X when ga_last[p] = "S" let ga_last[p] = "L" X end case X X current window is w_stat X display "Lose" to sa_sstat[p].s_stat attribute(white) X X end case X X display gpa_player[p].curr_funds to sa_player[p].curr_funds X attribute(green) X end if X end if Xend for X Xfor p = 1 to g_no_players X if gpa_player[p].curr_funds > 0 then X exit for X end if Xend for X Xif p > g_no_players then X let g_end = true Xend if X Xend function X Xfunction who_won(l_no, l_spl) X Xdefine X l_player_tot, X l_no smallint, X l_spl char(1) X Xlet l_player_tot = card_total(l_no, l_spl) X Xif l_player_tot > 21 then X return "L" Xelse X if l_player_tot = 21 and bj(l_no, l_spl) then X if g_dealer_tot = 21 and bj(0, "") then X return "S" X else X return "B" X end if X else X if g_dealer_tot > 21 then X return "P" X else X if g_dealer_tot = 21 and bj(0, "") then X return "L" X else X case X when l_player_tot > g_dealer_tot X return "P" X when l_player_tot < g_dealer_tot X return "L" X otherwise X return "S" X end case X end if X end if X end if Xend if X Xend function X Xfunction bj(l_no, l_spl) X Xdefine X l_no smallint, X l_spl char(1) X Xif l_no = 0 then X if length(g_dealer) = 2 then X return true X end if Xelse X if l_spl = "S" then X if length(ga_scards[l_no]) = 2 then X return true X end if X else X if length(ga_cards[l_no]) = 2 then X return true X end if X end if Xend if X Xreturn false X Xend function X Xfunction close_cards() X Xwhenever error continue X X#### Close dealer display window X Xclose window w_dstat X X#### Close dealer cards X Xclose window w_deal1 Xclose window w_deal2 Xclose window w_deal3 Xclose window w_deal4 Xclose window w_deal5 Xclose window w_deal6 Xclose window w_deal7 X X#### Close cards X Xclose window w_card11 Xclose window w_card12 Xclose window w_card13 Xclose window w_card14 Xclose window w_card15 Xclose window w_card16 Xclose window w_card17 X Xclose window w_card21 Xclose window w_card22 Xclose window w_card23 Xclose window w_card24 Xclose window w_card25 Xclose window w_card26 Xclose window w_card27 X Xclose window w_card31 Xclose window w_card32 Xclose window w_card33 Xclose window w_card34 Xclose window w_card35 Xclose window w_card36 Xclose window w_card37 X Xclose window w_card41 Xclose window w_card42 Xclose window w_card43 Xclose window w_card44 Xclose window w_card45 Xclose window w_card46 Xclose window w_card47 X X#### Close splits if any X Xclose window w_scard11 Xclose window w_scard12 Xclose window w_scard13 Xclose window w_scard14 Xclose window w_scard15 Xclose window w_scard16 Xclose window w_scard17 X Xclose window w_scard21 Xclose window w_scard22 Xclose window w_scard23 Xclose window w_scard24 Xclose window w_scard25 Xclose window w_scard26 Xclose window w_scard27 X Xclose window w_scard31 Xclose window w_scard32 Xclose window w_scard33 Xclose window w_scard34 Xclose window w_scard35 Xclose window w_scard36 Xclose window w_scard37 X Xclose window w_scard41 Xclose window w_scard42 Xclose window w_scard43 Xclose window w_scard44 Xclose window w_scard45 Xclose window w_scard46 Xclose window w_scard47 X Xwhenever error stop X Xend function SHAR_EOF if [ `wc -c < bj.4gl` -ne 29871 ] then echo "Lengths do not match -- Bad Copy of bj.4gl" fi echo "Extracting file bj.per" sed -e 's/^X//' <<\SHAR_EOF > bj.per Xdatabase formonly Xscreen X{ X [f008][f009 ] [f008][f009 ] [f008][f009 ] [f008][f009 ] X [f002][f005 ] [f002][f005 ] [f002][f005 ] [f002][f005 ] X X [f001 ] [f001 ] [f001 ] [f001 ] X [f000 ] [f000 ] [f000 ] [f000 ] [a] X X} Xattributes Xa = formonly.dummy type char, noentry; Xf000 = formonly.player_name type char, noentry; Xf001 = formonly.curr_funds type money, noentry; X Xf002 = formonly.curr_bet type money, X include = (0 to 100), comments = X "Enter the amount to bet for this player (0 to 100, ENTER = 1)"; Xf005 = formonly.p_stat type char, noentry; X Xf008 = formonly.supp_bet type money, noentry; Xf009 = formonly.s_stat type char, noentry; Xinstructions Xdelimiters " " Xscreen record sa_player[4] (curr_funds, player_name) Xscreen record sa_bet[4] (curr_bet) Xscreen record sa_pstat[4] (p_stat) Xscreen record sa_sbet[4] (supp_bet) Xscreen record sa_sstat[4] (s_stat) SHAR_EOF if [ `wc -c < bj.per` -ne 969 ] then echo "Lengths do not match -- Bad Copy of bj.per" fi echo "Extracting file mkbj" sed -e 's/^X//' <<\SHAR_EOF > mkbj Xfglpc bj Xfglpc random Xcat bj.4go random.4go > bj.4gi SHAR_EOF if [ `wc -c < mkbj` -ne 53 ] then echo "Lengths do not match -- Bad Copy of mkbj" fi echo "Extracting file random.4gl" sed -e 's/^X//' <<\SHAR_EOF > random.4gl X# random.4gl - Informix Random number routine based on current time X# Paul Hutton 1993 huttonp@ozemail.com.au X Xdefine X S1 integer, X S2 integer X X################################################################################ X Xfunction ldiv(numer, denom) X X define X numer integer, X denom integer, X X quotient integer, X remainder integer X X let quotient = numer / denom X let remainder = numer mod denom X X return quotient, remainder X Xend function X X################################################################################ X Xfunction seed() X X define X seed1 integer, X seed2 integer, X tmp_str char(8) X X if num_args() < 2 then X let tmp_str = time X let seed1 = tmp_str[4,5] X let seed2 = tmp_str[7,8] X else X let seed1 = arg_val(1) X let seed2 = arg_val(2) X end if X X let S1 = seed1 mod 2147483562 + 1 X let S2 = seed2 mod 2147483398 + 1 X Xend function X X################################################################################ X Xfunction xrnd() X X define X T integer, X quotient integer, X remainder integer X X if S1 = 0 X then X let S1 = 1 X end if X X if S2 = 0 X then X let S2 = 1 X end if X X call ldiv(S1, 53668) X returning quotient, remainder X X let S1 = 40014 * remainder - 12211 * quotient X X if S1 < 0 X then X let S1 = S1 + 2147483563 X end if X X call ldiv(S2, 52774) X returning quotient, remainder X X let S2 = 40692 * remainder - 3791 * quotient X X if S2 < 0 X then X let S2 = S2 + 2147483399 X end if X X let T = S1 - S2 X X if t < 1 X then X let T = T + 2147483562 X end if X X return T - 1 X Xend function X X################################################################################ X Xfunction rnd(x) Xdefine X x integer X X return xrnd() mod x + 1 X Xend function SHAR_EOF if [ `wc -c < random.4gl` -ne 2024 ] then echo "Lengths do not match -- Bad Copy of random.4gl" fi echo "Done." exit 0