#!/bin/sh # # This is a shell archive. To extract its contents, # execute this file with /bin/sh to create the file(s): # # mksol random.4gl sol sol.4gl # # This shell archive created: Thu Jun 27 12:55:33 EDT 1996 # echo "Extracting file mksol" sed -e 's/^X//' <<\SHAR_EOF > mksol Xfglpc sol Xfglpc random Xcat sol.4go random.4go > sol.4gi SHAR_EOF if [ `wc -c < mksol` -ne 56 ] then echo "Lengths do not match -- Bad Copy of mksol" 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 "Extracting file sol" sed -e 's/^X//' <<\SHAR_EOF > sol Xfglgo sol $RANDOM $RANDOM SHAR_EOF if [ `wc -c < sol` -ne 26 ] then echo "Lengths do not match -- Bad Copy of sol" fi echo "Extracting file sol.4gl" sed -e 's/^X//' <<\SHAR_EOF > sol.4gl X# sol.4gl - Solitaire game (just like Windows!) X# Paul Hutton 1992 huttonp@ozemail.com.au X Xglobals Xdefine X g_ptr, i, j, k, X g_max, g_dp, X g_end smallint, X g_curr_funds money(10,0), X g_1st, g_2nd char(1), X g_ap array[4] of smallint, X g_newdeck, g_dis, X g_deck array[52] of record X val, suit char(1) X end record, X g_aces array[4,13] of record X val, suit char(1) X end record, X g_face array[20,7] of record X val, suit, fud char(1) X end record Xend globals X X Xmain X clear screen X call init() X call play() Xend main X X Xfunction init() X Xdefine X l_char char(1) X Xcall seed() X Xfor i = 1 to 4 X for j = 1 to 13 X case X when j = 1 let l_char = "A" X when j = 10 let l_char = "T" X when j = 11 let l_char = "J" X when j = 12 let l_char = "Q" X when j = 13 let l_char = "K" X otherwise let l_char = j using "&" clipped X end case X let g_newdeck[((i-1)*13)+j].val = l_char X X case X when i = 1 let l_char = "S" X when i = 2 let l_char = "D" X when i = 3 let l_char = "C" X when i = 4 let l_char = "H" X end case X let g_newdeck[((i-1)*13)+j].suit = l_char X end for Xend for X Xlet g_curr_funds = 0 Xlet g_end = false X Xend function X Xfunction play() X Xdefine X l_dummy char(1) X Xclear screen Xopen window w_deal at 2,2 with 22 rows, 77 columns X attribute(border, cyan) X Xopen window w_stat at 3,2 with 1 rows, 15 columns X attribute(cyan, message line 1) X Xopen window w_money at 6,4 with 1 rows, 12 columns X attribute(white) X Xwhile not g_end X call shuffle() X call deal() X call proper() X call close_cards() Xend while X Xclose window w_deal Xclose window w_stat X Xend function X Xfunction shuffle() X Xdefine X l_newused char(52), X l_cnt, l_val smallint X Xcurrent window is w_stat Xmessage "Shuffling..." attribute(white) X Xlet l_newused = "NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN" X Xlet l_cnt = 1 Xwhile l_cnt <= 52 X let l_val = rnd(52) X if l_newused[l_val] <> "Y" then X let g_deck[l_cnt].val = g_newdeck[l_val].val X let g_deck[l_cnt].suit = g_newdeck[l_val].suit X let l_newused[l_val] = "Y" X let l_cnt = l_cnt + 1 X end if Xend while X Xlet g_ptr = 1 X Xcurrent window is w_stat Xmessage "" X Xend function X Xfunction upd_money(l_amt) X Xdefine X l_amt money(10,0) X Xlet g_curr_funds = g_curr_funds + l_amt Xcurrent window is w_money Xdisplay g_curr_funds, " " at 1,1 attribute(white) X Xend function X Xfunction deal() X Xcall upd_money(-52) X Xfor i = 1 to 52 X initialize g_dis[i].* to null Xend for X Xfor i = 1 to 4 X for j = 1 to 13 X initialize g_aces[i,j].* to null X end for Xend for X Xfor i = 1 to 20 X for j = 1 to 7 X initialize g_face[i,j].* to null X end for Xend for X Xfor i = 1 to 7 X for j = i to 7 X let g_face[i,j].val = g_deck[g_ptr].val X let g_face[i,j].suit = g_deck[g_ptr].suit X X if i = j then X let g_face[i,j].fud = "U" X else X let g_face[i,j].fud = "D" X end if X X call dis_card(i, j) X let g_ptr = g_ptr + 1 X end for Xend for X Xopen window w_deck at 10,4 with 3 rows, 5 columns X attribute(border, green) X Xdisplay "#####" at 1,1 attribute(green) Xdisplay "#####" at 2,1 attribute(green) Xdisplay "#####" at 3,1 attribute(green) X Xopen window w_dis at 10,12 with 3 rows, 5 columns X attribute(border, green) X Xopen window w_ace1 at 15,4 with 3 rows, 5 columns X attribute(border, green) Xopen window w_ace2 at 15,12 with 3 rows, 5 columns X attribute(border, green) Xopen window w_ace3 at 20,4 with 3 rows, 5 columns X attribute(border, green) Xopen window w_ace4 at 20,12 with 3 rows, 5 columns X attribute(border, green) X Xend function X Xfunction dis_card(l_row, l_col) X Xdefine X l_val, l_suit char(1), X l_row, l_col, l_card, X l, l_r, l_c smallint X Xlet l_r = l_row * 2 + 1 Xif l_r > 21 then X let l_r = 21 Xend if Xlet l_c = l_col * 8 + 16 Xlet l = (l_row - 1) * 7 + l_col X Xcase X when l = 1 open window w_face11 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 2 open window w_face12 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 3 open window w_face13 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 4 open window w_face14 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 5 open window w_face15 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 6 open window w_face16 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 7 open window w_face17 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 8 open window w_face21 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 9 open window w_face22 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 10 open window w_face23 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 11 open window w_face24 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 12 open window w_face25 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 13 open window w_face26 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 14 open window w_face27 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 15 open window w_face31 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 16 open window w_face32 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 17 open window w_face33 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 18 open window w_face34 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 19 open window w_face35 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 20 open window w_face36 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 21 open window w_face37 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 22 open window w_face41 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 23 open window w_face42 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 24 open window w_face43 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 25 open window w_face44 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 26 open window w_face45 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 27 open window w_face46 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 28 open window w_face47 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 29 open window w_face51 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 30 open window w_face52 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 31 open window w_face53 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 32 open window w_face54 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 33 open window w_face55 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 34 open window w_face56 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 35 open window w_face57 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 36 open window w_face61 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 37 open window w_face62 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 38 open window w_face63 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 39 open window w_face64 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 40 open window w_face65 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 41 open window w_face66 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 42 open window w_face67 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 43 open window w_face71 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 44 open window w_face72 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 45 open window w_face73 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 46 open window w_face74 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 47 open window w_face75 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 48 open window w_face76 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 49 open window w_face77 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 50 open window w_face81 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 51 open window w_face82 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 52 open window w_face83 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 53 open window w_face84 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 54 open window w_face85 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 55 open window w_face86 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 56 open window w_face87 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 57 open window w_face91 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 58 open window w_face92 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 59 open window w_face93 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 60 open window w_face94 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 61 open window w_face95 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 62 open window w_face96 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 63 open window w_face97 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 64 open window w_face101 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 65 open window w_face102 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 66 open window w_face103 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 67 open window w_face104 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 68 open window w_face105 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 69 open window w_face106 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 70 open window w_face107 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 71 open window w_face111 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 72 open window w_face112 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 73 open window w_face113 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 74 open window w_face114 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 75 open window w_face115 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 76 open window w_face116 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 77 open window w_face117 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 78 open window w_face121 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 79 open window w_face122 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 80 open window w_face123 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 81 open window w_face124 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 82 open window w_face125 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 83 open window w_face126 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 84 open window w_face127 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 85 open window w_face131 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 86 open window w_face132 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 87 open window w_face133 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 88 open window w_face134 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 89 open window w_face135 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 90 open window w_face136 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 91 open window w_face137 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 92 open window w_face141 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 93 open window w_face142 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 94 open window w_face143 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 95 open window w_face144 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 96 open window w_face145 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 97 open window w_face146 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) X when l = 98 open window w_face147 at l_r,l_c with 3 rows, 5 columns X attribute(border, green) Xend case X Xif g_face[l_row, l_col].fud = "U" then X let l_val = g_face[l_row, l_col].val X let l_suit = g_face[l_row, l_col].suit X X if l_suit matches "[SC]" then X display l_val, l_suit at 1,1 attribute(blue) X display l_val, l_suit at 3,3 attribute(blue) X else X display l_val, l_suit at 1,1 attribute(red) X display l_val, l_suit at 3,3 attribute(red) X end if Xelse X display "#####" at 1,1 attribute(green) X display "#####" at 2,1 attribute(green) X display "#####" at 3,1 attribute(green) Xend if X Xend function X Xfunction upturn_card(l_row, l_col) X Xdefine X l_val, l_suit char(1), X l_row, l_col, l_card, X l, l_r, l_c smallint X Xlet l = (l_row - 1) * 7 + l_col X Xcase X when l = 1 current window is w_face11 X when l = 2 current window is w_face12 X when l = 3 current window is w_face13 X when l = 4 current window is w_face14 X when l = 5 current window is w_face15 X when l = 6 current window is w_face16 X when l = 7 current window is w_face17 X when l = 8 current window is w_face21 X when l = 9 current window is w_face22 X when l = 10 current window is w_face23 X when l = 11 current window is w_face24 X when l = 12 current window is w_face25 X when l = 13 current window is w_face26 X when l = 14 current window is w_face27 X when l = 15 current window is w_face31 X when l = 16 current window is w_face32 X when l = 17 current window is w_face33 X when l = 18 current window is w_face34 X when l = 19 current window is w_face35 X when l = 20 current window is w_face36 X when l = 21 current window is w_face37 X when l = 22 current window is w_face41 X when l = 23 current window is w_face42 X when l = 24 current window is w_face43 X when l = 25 current window is w_face44 X when l = 26 current window is w_face45 X when l = 27 current window is w_face46 X when l = 28 current window is w_face47 X when l = 29 current window is w_face51 X when l = 30 current window is w_face52 X when l = 31 current window is w_face53 X when l = 32 current window is w_face54 X when l = 33 current window is w_face55 X when l = 34 current window is w_face56 X when l = 35 current window is w_face57 X when l = 36 current window is w_face61 X when l = 37 current window is w_face62 X when l = 38 current window is w_face63 X when l = 39 current window is w_face64 X when l = 40 current window is w_face65 X when l = 41 current window is w_face66 X when l = 42 current window is w_face67 X when l = 43 current window is w_face71 X when l = 44 current window is w_face72 X when l = 45 current window is w_face73 X when l = 46 current window is w_face74 X when l = 47 current window is w_face75 X when l = 48 current window is w_face76 X when l = 49 current window is w_face77 X when l = 50 current window is w_face81 X when l = 51 current window is w_face82 X when l = 52 current window is w_face83 X when l = 53 current window is w_face84 X when l = 54 current window is w_face85 X when l = 55 current window is w_face86 X when l = 56 current window is w_face87 X when l = 57 current window is w_face91 X when l = 58 current window is w_face92 X when l = 59 current window is w_face93 X when l = 60 current window is w_face94 X when l = 61 current window is w_face95 X when l = 62 current window is w_face96 X when l = 63 current window is w_face97 X when l = 64 current window is w_face101 X when l = 65 current window is w_face102 X when l = 66 current window is w_face103 X when l = 67 current window is w_face104 X when l = 68 current window is w_face105 X when l = 69 current window is w_face106 X when l = 70 current window is w_face107 X when l = 71 current window is w_face111 X when l = 72 current window is w_face112 X when l = 73 current window is w_face113 X when l = 74 current window is w_face114 X when l = 75 current window is w_face115 X when l = 76 current window is w_face116 X when l = 77 current window is w_face117 X when l = 78 current window is w_face121 X when l = 79 current window is w_face122 X when l = 80 current window is w_face123 X when l = 81 current window is w_face124 X when l = 82 current window is w_face125 X when l = 83 current window is w_face126 X when l = 84 current window is w_face127 X when l = 85 current window is w_face131 X when l = 86 current window is w_face132 X when l = 87 current window is w_face133 X when l = 88 current window is w_face134 X when l = 89 current window is w_face135 X when l = 90 current window is w_face136 X when l = 91 current window is w_face137 X when l = 92 current window is w_face141 X when l = 93 current window is w_face142 X when l = 94 current window is w_face143 X when l = 95 current window is w_face144 X when l = 96 current window is w_face145 X when l = 97 current window is w_face146 X when l = 98 current window is w_face147 Xend case X Xlet l_val = g_face[l_row, l_col].val Xlet l_suit = g_face[l_row, l_col].suit X Xdisplay " " at 1,1 Xdisplay " " at 2,1 Xdisplay " " at 3,1 X Xif l_suit matches "[SC]" then X display l_val, l_suit at 1,1 attribute(blue) X display l_val, l_suit at 3,3 attribute(blue) Xelse X display l_val, l_suit at 1,1 attribute(red) X display l_val, l_suit at 3,3 attribute(red) Xend if X Xend function X Xfunction undis_card(l_row, l_col) X Xdefine X l_val, l_suit char(1), X l_row, l_col, l_card, X l smallint X Xlet l = (l_row - 1) * 7 + l_col X Xcase X when l = 1 close window w_face11 X when l = 2 close window w_face12 X when l = 3 close window w_face13 X when l = 4 close window w_face14 X when l = 5 close window w_face15 X when l = 6 close window w_face16 X when l = 7 close window w_face17 X when l = 8 close window w_face21 X when l = 9 close window w_face22 X when l = 10 close window w_face23 X when l = 11 close window w_face24 X when l = 12 close window w_face25 X when l = 13 close window w_face26 X when l = 14 close window w_face27 X when l = 15 close window w_face31 X when l = 16 close window w_face32 X when l = 17 close window w_face33 X when l = 18 close window w_face34 X when l = 19 close window w_face35 X when l = 20 close window w_face36 X when l = 21 close window w_face37 X when l = 22 close window w_face41 X when l = 23 close window w_face42 X when l = 24 close window w_face43 X when l = 25 close window w_face44 X when l = 26 close window w_face45 X when l = 27 close window w_face46 X when l = 28 close window w_face47 X when l = 29 close window w_face51 X when l = 30 close window w_face52 X when l = 31 close window w_face53 X when l = 32 close window w_face54 X when l = 33 close window w_face55 X when l = 34 close window w_face56 X when l = 35 close window w_face57 X when l = 36 close window w_face61 X when l = 37 close window w_face62 X when l = 38 close window w_face63 X when l = 39 close window w_face64 X when l = 40 close window w_face65 X when l = 41 close window w_face66 X when l = 42 close window w_face67 X when l = 43 close window w_face71 X when l = 44 close window w_face72 X when l = 45 close window w_face73 X when l = 46 close window w_face74 X when l = 47 close window w_face75 X when l = 48 close window w_face76 X when l = 49 close window w_face77 X when l = 50 close window w_face81 X when l = 51 close window w_face82 X when l = 52 close window w_face83 X when l = 53 close window w_face84 X when l = 54 close window w_face85 X when l = 55 close window w_face86 X when l = 56 close window w_face87 X when l = 57 close window w_face91 X when l = 58 close window w_face92 X when l = 59 close window w_face93 X when l = 60 close window w_face94 X when l = 61 close window w_face95 X when l = 62 close window w_face96 X when l = 63 close window w_face97 X when l = 64 close window w_face101 X when l = 65 close window w_face102 X when l = 66 close window w_face103 X when l = 67 close window w_face104 X when l = 68 close window w_face105 X when l = 69 close window w_face106 X when l = 70 close window w_face107 X when l = 71 close window w_face111 X when l = 72 close window w_face112 X when l = 73 close window w_face113 X when l = 74 close window w_face114 X when l = 75 close window w_face115 X when l = 76 close window w_face116 X when l = 77 close window w_face117 X when l = 78 close window w_face121 X when l = 79 close window w_face122 X when l = 80 close window w_face123 X when l = 81 close window w_face124 X when l = 82 close window w_face125 X when l = 83 close window w_face126 X when l = 84 close window w_face127 X when l = 85 close window w_face131 X when l = 86 close window w_face132 X when l = 87 close window w_face133 X when l = 88 close window w_face134 X when l = 89 close window w_face135 X when l = 90 close window w_face136 X when l = 91 close window w_face137 X when l = 92 close window w_face141 X when l = 93 close window w_face142 X when l = 94 close window w_face143 X when l = 95 close window w_face144 X when l = 96 close window w_face145 X when l = 97 close window w_face146 X when l = 98 close window w_face147 Xend case X Xend function X Xfunction proper() X Xlet g_max = 52 Xlet g_dp = 0 Xlet g_ap[1] = 0 Xlet g_ap[2] = 0 Xlet g_ap[3] = 0 Xlet g_ap[4] = 0 X Xwhile true X if g_ap[1] = 13 and g_ap[2] = 13 and g_ap[3] = 13 and g_ap[4] = 13 then X current window is w_stat X message "You won!" attribute(white) X sleep 3 X exit while X else X current window is w_stat X prompt "Command ? " for char g_1st attribute(white) X let g_1st = upshift(g_1st) X X case X when g_1st = "X" #### Exit X clear screen X let g_end = true X exit while X X when g_1st = "Q" #### Quit X exit while X X when g_1st = "V" #### View next X call view() X X when g_1st matches "[AD1234567]" #### Move X prompt "To ? " for char g_2nd attribute(white) X let g_2nd = upshift(g_2nd) X X if g_2nd matches "[1234567A]" and g_2nd <> g_1st then X call move(g_1st, g_2nd) X else X error " Invalid command " attribute(red, reverse) X end if X X otherwise X error " Invalid command " attribute(red, reverse) X X end case X end if Xend while X Xend function X Xfunction view() X Xif g_ptr > g_max then X call restack() Xend if X Xfor i = 1 to 3 X if g_ptr > g_max then X current window is w_deck X display " " at 1,1 X display " " at 2,1 X display " " at 3,1 X exit for X end if X X let g_dp = g_dp + 1 X let g_dis[g_dp].val = g_deck[g_ptr].val X let g_dis[g_dp].suit = g_deck[g_ptr].suit X let g_ptr = g_ptr + 1 X if g_ptr > g_max then X current window is w_deck X display " " at 1,1 X display " " at 2,1 X display " " at 3,1 X end if Xend for X Xif g_max > 0 then X current window is w_dis X if g_dis[g_dp].suit matches "[SC]" then X display g_dis[g_dp].val, g_dis[g_dp].suit at 1,1 attribute(blue) X else X display g_dis[g_dp].val, g_dis[g_dp].suit at 1,1 attribute(red) X end if Xelse X error " No cards left in deck " attribute(red, reverse) Xend if X Xend function X Xfunction restack() X Xfor i = 1 to 52 X if g_dis[i].val is not null then X let g_deck[i].val = g_dis[i].val X let g_deck[i].suit = g_dis[i].suit X initialize g_dis[i].* to null X else X exit for X end if Xend for X Xlet g_max = i - 1 Xlet g_ptr = 1 Xlet g_dp = 0 X Xcurrent window is w_deck Xdisplay "#####" at 1,1 Xdisplay "#####" at 2,1 Xdisplay "#####" at 3,1 X Xend function X Xfunction move(l_from, l_to) X Xdefine X l_from, l_to, l_from_card, X l_to_card, l_from_suit, X l_to_suit char(1), X l_col, l_card, l_from_val, X l_to_val, l_to_col, l_top, X l_bottom, X l_valid smallint X X#### Chaek validity of FROM X Xlet l_valid = false X Xif l_from = "D" then X if g_dp = 0 then X error " No cards to take from " attribute(red, reverse) X return X else X let l_from_card = g_dis[g_dp].val X let l_from_val = num_val(l_from_card) X let l_from_suit = g_dis[g_dp].suit X end if Xelse X if l_from = "A" then X let l_col = l_to X let l_card = max_face(l_col) X if l_card > 0 then X let l_to_card = g_face[l_card,l_col].val X let l_to_val = num_val(l_to_card) X let l_to_suit = g_face[l_card,l_col].suit X else X let l_to_card = null X let l_to_val = 0 X let l_to_suit = null X end if X X for i = 1 to 4 X let l_from_val = g_ap[i] X if l_from_val > 0 then X let l_from_suit = g_aces[i,l_from_val].suit X else X let l_from_suit = null X end if X X if (l_from_val = 13 and l_to_val = 0 and l_to_suit is null) X or (l_from_val = l_to_val - 1 and l_from_val > 1 X and (l_from_suit matches "[SC]" and l_to_suit matches "[HD]" X or l_from_suit matches "[HD]" and l_to_suit matches "[SC]")) then X let l_valid = true X let l_col = i X exit for X end if X end for X else X let l_col = l_from X if g_face[1,l_col].val is null then X error " No cards to take from " attribute(red, reverse) X return X else X if l_to = "A" then X let l_card = max_face(l_col) X else X let l_col = l_to X let l_card = max_face(l_col) X if l_card > 0 then X let l_to_card = g_face[l_card,l_col].val X let l_to_val = num_val(l_to_card) X let l_to_suit = g_face[l_card,l_col].suit X else X let l_to_card = null X let l_to_val = 0 X let l_to_suit = null X end if X X let l_col = l_from X let l_card = 0 X for i = 1 to 20 X if g_face[i,l_col].fud = "U" then X let l_from_card = g_face[i,l_col].val X let l_from_val = num_val(l_from_card) X let l_from_suit = g_face[i,l_col].suit X if (l_from_val = 13 and l_to_val = 0 and l_to_suit is null) X or (l_from_val = l_to_val - 1 X and (l_from_suit matches "[SC]" and l_to_suit matches "[HD]" X or l_from_suit matches "[HD]" and l_to_suit matches "[SC]")) X then X let l_valid = true X let l_card = i X let l_top = i X exit for X end if X end if X end for X end if X if l_card > 0 then X let l_from_card = g_face[l_card,l_col].val X let l_from_val = num_val(l_from_card) X let l_from_suit = g_face[l_card,l_col].suit X end if X end if X end if Xend if X X#### Check validity of TO, legal move X Xif not l_valid then X if l_to = "A" then X for i = 1 to 4 X let l_to_val = g_ap[i] X if l_to_val > 0 then X let l_to_suit = g_aces[i,l_to_val].suit X else X let l_to_suit = null X end if X if l_to_val = l_from_val - 1 X and (l_to_suit is null or l_to_suit = l_from_suit) then X let l_col = i X let l_valid = true X exit for X end if X end for X else X let l_col = l_to X let l_card = max_face(l_col) X if l_card > 0 then X let l_to_card = g_face[l_card,l_col].val X let l_to_val = num_val(l_to_card) X let l_to_suit = g_face[l_card,l_col].suit X else X let l_to_card = null X let l_to_val = 0 X let l_to_suit = null X end if X if (l_from_val = 13 and l_to_val = 0 and l_to_suit is null) X or (l_from_val = l_to_val - 1 X and (l_from_suit matches "[SC]" and l_to_suit matches "[HD]" X or l_from_suit matches "[HD]" and l_to_suit matches "[SC]")) then X let l_valid = true X end if X end if Xend if X X#### Make the move X Xif not l_valid then X error " Invalid move " attribute(red, reverse) Xelse X if l_to = "A" then X let g_ap[l_col] = g_ap[l_col] + 1 X let l_to_val = g_ap[l_col] X let g_aces[l_col,l_to_val].val = l_from_card X let g_aces[l_col,l_to_val].suit = l_from_suit X X case X when l_col = 1 current window is w_ace1 X when l_col = 2 current window is w_ace2 X when l_col = 3 current window is w_ace3 X otherwise current window is w_ace4 X end case X X if g_aces[l_col,l_to_val].suit matches "[SC]" then X display g_aces[l_col,l_to_val].val, g_aces[l_col,l_to_val].suit at 1,1 X attribute(blue) X else X display g_aces[l_col,l_to_val].val, g_aces[l_col,l_to_val].suit at 1,1 X attribute(red) X end if X X call upd_money(5) X else X let l_to_col = l_to X let l_card = max_face(l_to_col) + 1 X X if l_from matches "[1234567]" then X let l_col = l_from X # let l_top = min_face(l_col) X let l_bottom = max_face(l_col) X X #### Open cards X X for i = l_top to l_bottom X let g_face[l_card,l_to_col].* = g_face[i,l_col].* X call dis_card(l_card,l_to_col) X let l_card = l_card + 1 X end for X else X if l_from = "A" then X let g_face[l_card,l_to_col].val = g_aces[l_col,l_from_val].val X let g_face[l_card,l_to_col].suit = g_aces[l_col,l_from_val].suit X let g_face[l_card,l_to_col].fud = "U" X call dis_card(l_card,l_to_col) X else X let g_face[l_card,l_to_col].val = g_dis[g_dp].val X let g_face[l_card,l_to_col].suit = g_dis[g_dp].suit X let g_face[l_card,l_to_col].fud = "U" X call dis_card(l_card,l_to_col) X end if X end if X end if X X if l_from = "D" then X let g_dis[g_dp].val = null X let g_dis[g_dp].suit = null X let g_dp = g_dp - 1 X X current window is w_dis X if g_dp = 0 then X display " " at 1,1 X display " " at 2,1 X display " " at 3,1 X else X if g_dis[g_dp].suit matches "[SC]" then X display g_dis[g_dp].val, g_dis[g_dp].suit at 1,1 attribute(blue) X else X display g_dis[g_dp].val, g_dis[g_dp].suit at 1,1 attribute(red) X end if X end if X else X if l_from = "A" then X let g_aces[l_col,l_from_val].val = null X let g_aces[l_col,l_from_val].suit = null X let g_ap[l_col] = g_ap[l_col] - 1 X let l_from_val = g_ap[l_col] X X case X when l_col = 1 current window is w_ace1 X when l_col = 2 current window is w_ace2 X when l_col = 3 current window is w_ace3 X otherwise current window is w_ace4 X end case X X if g_aces[l_col,l_from_val].suit matches "[SC]" then X display g_aces[l_col,l_from_val].val, g_aces[l_col,l_from_val].suit X at 1,1 attribute(blue) X else X display g_aces[l_col,l_from_val].val, g_aces[l_col,l_from_val].suit X at 1,1 attribute(red) X end if X X call upd_money(-5) X else X let l_col = l_from X let l_bottom = max_face(l_col) X if l_to = "A" then X let l_top = l_bottom X else X # let l_top = min_face(l_col) X end if X X #### Close cards X X for i = l_top to l_bottom X let g_face[i,l_col].val = null X let g_face[i,l_col].suit = null X let g_face[i,l_col].fud = null X call undis_card(i,l_col) X end for X X #### Open the face down card X X if l_top > 1 then X let g_face[l_top-1,l_col].fud = "U" X call upturn_card(l_top-1,l_col) X end if X end if X end if Xend if X Xend function X Xfunction num_val(l_val) X Xdefine X l_val char(1) X Xcase l_val X when "A" return 1 X when "T" return 10 X when "J" return 11 X when "Q" return 12 X when "K" return 13 X otherwise return l_val Xend case X Xend function X Xfunction max_face(l_col) X Xdefine X l_col, i smallint X Xfor i = 1 to 20 X if g_face[i,l_col].val is null then X return i-1 X end if Xend for X Xend function X Xfunction min_face(l_col) X Xdefine X l_col, i smallint X Xfor i = 1 to 20 X if g_face[i,l_col].fud = "U" then X return i X end if Xend for X Xend function X Xfunction max_aces(l_col) X Xdefine X l_col, i smallint X Xfor i = 1 to 13 X if g_aces[i,l_col].val is null then X return i-1 X end if Xend for X Xend function X Xfunction close_cards() X Xwhenever error continue X X#### Close deck & discard X Xclose window w_deck Xclose window w_dis X X#### Close aces X Xclose window w_ace1 Xclose window w_ace2 Xclose window w_ace3 Xclose window w_ace4 X X#### Close face X Xclose window w_face11 Xclose window w_face12 Xclose window w_face13 Xclose window w_face14 Xclose window w_face15 Xclose window w_face16 Xclose window w_face17 X Xclose window w_face21 Xclose window w_face22 Xclose window w_face23 Xclose window w_face24 Xclose window w_face25 Xclose window w_face26 Xclose window w_face27 X Xclose window w_face31 Xclose window w_face32 Xclose window w_face33 Xclose window w_face34 Xclose window w_face35 Xclose window w_face36 Xclose window w_face37 X Xclose window w_face41 Xclose window w_face42 Xclose window w_face43 Xclose window w_face44 Xclose window w_face45 Xclose window w_face46 Xclose window w_face47 X Xclose window w_face51 Xclose window w_face52 Xclose window w_face53 Xclose window w_face54 Xclose window w_face55 Xclose window w_face56 Xclose window w_face57 X Xclose window w_face61 Xclose window w_face62 Xclose window w_face63 Xclose window w_face64 Xclose window w_face65 Xclose window w_face66 Xclose window w_face67 X Xclose window w_face71 Xclose window w_face72 Xclose window w_face73 Xclose window w_face74 Xclose window w_face75 Xclose window w_face76 Xclose window w_face77 X Xclose window w_face81 Xclose window w_face82 Xclose window w_face83 Xclose window w_face84 Xclose window w_face85 Xclose window w_face86 Xclose window w_face87 X Xclose window w_face91 Xclose window w_face92 Xclose window w_face93 Xclose window w_face94 Xclose window w_face95 Xclose window w_face96 Xclose window w_face97 X Xclose window w_face101 Xclose window w_face102 Xclose window w_face103 Xclose window w_face104 Xclose window w_face105 Xclose window w_face106 Xclose window w_face107 X Xclose window w_face111 Xclose window w_face112 Xclose window w_face113 Xclose window w_face114 Xclose window w_face115 Xclose window w_face116 Xclose window w_face117 X Xclose window w_face121 Xclose window w_face122 Xclose window w_face123 Xclose window w_face124 Xclose window w_face125 Xclose window w_face126 Xclose window w_face127 X Xclose window w_face131 Xclose window w_face132 Xclose window w_face133 Xclose window w_face134 Xclose window w_face135 Xclose window w_face136 Xclose window w_face137 X Xclose window w_face141 Xclose window w_face142 Xclose window w_face143 Xclose window w_face144 Xclose window w_face145 Xclose window w_face146 Xclose window w_face147 X Xend function SHAR_EOF if [ `wc -c < sol.4gl` -ne 36956 ] then echo "Lengths do not match -- Bad Copy of sol.4gl" fi echo "Done." exit 0