{_____________________________________________________________________________ | Filename: CODE.PAS | Title: Spite & Malice | Written By: Benjamin Arnoldy and Raechel Kula |_____________________________________________________________________________ | Contents: | The procedures: Deal, WhoseTurn, PickupCards, Decision, GetMove, | CheckMove, MoveCard | Oject: Pile |_____________________________________________________________________________ | Synopsis: | This program allows the user to select either another person, or the computer as the opponent, then play the opponent in the card game | Spite & Malice. The interface is textual. |_____________________________________________________________________________ | Description: | No references at this time. |_____________________________________________________________________________ | Environment: | TurboPASCAL for the PC. |_____________________________________________________________________________ | Version History: | | Version 5.1 -- May 8, 1996 | Raechel Kula & Benjamin Arnoldy | Improved interface and Decision. | | Version 5.0 -- May 7, 1996 | Raechel Kula & Benjamin Arnoldy | Code is cleaned up and ready for presentation. | | Version 4.3 -- May 6, 1996 | Raechel Kula & Benjamin Arnoldy | Additional testing, more tinkering with weights. | | Version 4.2 -- May 5, 1996 | Raechel Kula & Benjamin Arnoldy | Added provisions in decision for jokers. | | Version 4.1 -- May 4, 1996 | Raechel Kula & Benjamin Arnoldy | Testing and tinkering with weights to make | the computer a better opponent. | | Version 4.0 -- May 3, 1996 | Raechel Kula & Benjamin Arnoldy | An "operable" Decision procedure is | in place. | | Version 3.1 -- May 2, 1996 | Raechel Kula & Benjamin Arnoldy | Various Embellishments to make it an operable | 2 player game (e.g. end of game stuff). | | Version 3.0 -- May 1, 1996 | Raechel Kula & Benjamin Arnoldy | Ascii Graphical Interface is instituted. | | Version 2.9 -- April 30, 1996 | Raechel Kula & Benjamin Arnoldy | Small display functions (CardString) coded. | | Version 2.2 -- April 28, 1996 | Raechel Kula & Benjamin Arnoldy | CheckMove procedure ironed out. | | Version 2.1 -- April 26, 1996 | Raechel Kula & Benjamin Arnoldy | Basic Main Program Procedures Modified to fit with new | object structure. | | Version 2.0 -- April 25, 1996 | Raechel Kula & Benjamin Arnoldy | Object Pile Coded. | | MidApril -- Meeting with Prof Squier & Subsequent Major Rethinking | | Version 1.1 -- Apr. 7, 1996 | Raechel Kula & Benjamin Arnoldy | Pieces of Decision and CheckMove procedures are | completed. | | Version 1.0 -- Mar. 29, 1996 | Raechel Kula & Benjamin Arnoldy | WhoseTurn, PickupCards, MoveCard procedures are coded. | The code successfully compiles. | | Version 0.2 -- Mar. 12, 1996 | Raechel Kula & Benjamin Arnoldy | Deal and GetMove procedures are coded. | | Version 0.2 -- Mar. 5, 1996 | Raechel Kula & Benjamin Arnoldy | GetValue and GetPlace procedures are coded. | | Version 0.1 -- Feb. 30, 1996 | Raechel Kula & Benjamin Arnoldy | Main Program and Stubs | Version 0.0 |____________________________________________________________________________} program SpiteMalice; uses CRT; {============================================================================= CONSTANTS =============================================================================} const DRAWPILE_MAX = 108; HAND_MAX = 6; SCOREPILE_MAX = 14; DISCARDPILE_MAX = 108; ACEPILE_MAX = 13; TRASHPILE_MAX = 108; MAXSIZE = 108; NULL = -1; {============================================================================= TYPES =============================================================================} type CardVal_t = integer; Pos_t = integer; CardArray_t = array [1..108] of CardVal_t; CardValTable_t = array [1..26] of CardVal_t; choiceTable_t = array [1..26, 1..19] of integer; {============================================================================= OBJECT DECLARATION =============================================================================} type Pile = object {public} procedure Init; procedure RandomShuffle; procedure PutOnTop (CardtoPutOn: CardVal_t); function RemoveFromTop: CardVal_t; function SeeRandom (Pos: Pos_t): CardVal_t; function DeleteByValue (value : CardVal_t): CardVal_t; function IsPresent (CardtoFind: CardVal_t): boolean; function NumCards: integer; private data: CardArray_t; top: Pos_t; {top = slot with top card in it.} end; {Object declaration} {============================================================================= OBJECT DEPENEDENT TYPES =============================================================================} Type pilepointer_t = ^Pile; stack_t = array [1..26] of pilepointer_t; {============================================================================= GLOBAL VARIABLES =============================================================================} var DrawPile: Pile; PlayerHand: Pile; ComputerHand: Pile; PlayerScorePile: Pile; ComputerScorePile: Pile; PlayerDiscardPile1: Pile; PlayerDiscardPile2: Pile; PlayerDiscardPile3: Pile; PlayerDiscardPile4: Pile; ComputerDiscardPile1: Pile; ComputerDiscardPile2: Pile; ComputerDiscardPile3: Pile; ComputerDiscardPile4: Pile; AcePile1: Pile; AcePile2: Pile; AcePile3: Pile; AcePile4: Pile; TrashPile: Pile; ComputerTurn: boolean; Game: boolean; Valid, Discard, DecisionDiscard: boolean; From, Tto: integer; PosTable : stack_t; TopCardTable: CardValTable_t; pos: integer; Winner: string; ChoiceRate: choiceTable_t; AnotherGame: boolean; TwoPlayer: boolean; MustMove: boolean; {============================================================================= OBJECT PROCEDURES & FUNCTIONS =============================================================================} {____________________________________________________________________ | Init | Initializes a pile's array (data) and pointer (top) |___________________________________________________________________} procedure Pile.Init; var Count: integer; begin top := MAXSIZE + 1; for Count := 1 to MAXSIZE do Pile.PutOnTop (NULL); {Stores NULL values in entire array.} top := MAXSIZE + 1; end; {procedure Init} {____________________________________________________________________ | RandomShuffle | Shuffles the cards in a pile. |___________________________________________________________________} procedure Pile.RandomShuffle; var ShuffleArray: Pile; {Temporary Storage Pile} Counter: Pos_t; RandSlot: integer; DeckSize: integer; TopofDeck: Pos_t; begin DeckSize := DrawPile.NumCards; TopofDeck := (MAXSIZE - DeckSize) + 1; ShuffleArray.Init; {Initializing ShuffleArray} ShuffleArray.top := TopofDeck; for Counter := 1 to DeckSize do begin RandSlot := Random (DeckSize) + 1; {'+1' due to Random range.} While ShuffleArray.SeeRandom (RandSlot) <> NULL do RandSlot := Random (DeckSize) + 1; ShuffleArray.top := TopofDeck + Randslot; {Set ShuffleArray's "top" pointer to slot beneath empty slot, so that PutOnTop will put the card in the empty slot.} ShuffleArray.PutOnTop (DrawPile.RemoveFromTop); ShuffleArray.top := TopofDeck; end; {for} ShuffleArray.top := TopofDeck; {Set ShuffleArray's "top" pointer to the top of the stack.} for Counter := 1 to DeckSize do DrawPile.PutOnTop (ShuffleArray.RemoveFromTop); {Transfered shuffled ShuffleArray to DrawPile.} end; {Procedure RandomShuffle} {____________________________________________________________________ | PutOnTop | Places a card value on the top of the pile. | |___________________________________________________________________} procedure Pile.PutOnTop (CardtoPutOn: CardVal_t); begin top := top - 1; {Advance the top pointer to the empty slot above it.} If top < 0 then begin writeln ('ERROR. Array Overflow.'); HALT; {Program is stopped if program attempts to a put a card on top of what should be a full pile. This should never never happen given that the size of the pile arrays are the same size as the number of cards.} end; data [top] := CardtoPutOn; end; {procedure PutOnTop} {____________________________________________________________________ | RemoveFromTop | Removes the top card from a pile and return the value of | of the card. |___________________________________________________________________} function Pile.RemoveFromTop: CardVal_t; begin RemoveFromTop := data [top]; data [top] := NULL; top := top + 1; {Adjusts the top pointer so it points at the top card.} end; {Procedure RemoveFromTop} {____________________________________________________________________ | SeeRandom | Allows the program to view the card value in any given | position in a stack. |___________________________________________________________________} function Pile.SeeRandom (pos: Pos_t): CardVal_t; begin SeeRandom := data [top + pos - 1]; {The "- 1" in the equation defines position 1 as the top card.} if (top + pos - 1) > MAXSIZE then SeeRandom := NULL; {if the seek excedes the boundaries, a null value is returned.} end; {Procedure SeeRandom} {____________________________________________________________________ | DeleteByValue | Searches through a pile for a designated value, and "pulls" | the card out, returning the card's value. After the card is | removed, the gap in the stack is filled in by readjusting the | cards. |___________________________________________________________________} function Pile.DeleteByValue (value : CardVal_t): CardVal_t; var count:integer; hold : CardVal_t; begin count:=0; Repeat count :=count+1; Until (data[count] = value); hold := data[top]; data[top] := value; data[count] := hold; hold := Pile.RemoveFromTop; end; {Procedure DeleteByValue} {____________________________________________________________________ | IsPresent | Searches through a pile, looking to see if a designated card | value is present. |___________________________________________________________________} function Pile.IsPresent (CardtoFind: CardVal_t): boolean; var ValuePresent: boolean; begin ValuePresent := FALSE; while ((ValuePresent = FALSE) OR (top > MAXSIZE)) do begin top := top + 1; If data [top] = CardtoFind then ValuePresent := TRUE; end; {While} If ValuePresent = FALSE then IsPresent := FALSE else IsPresent := TRUE; end; {Function IsPresent} {____________________________________________________________________ | NumCards | Returns the number of cards in a pile. |___________________________________________________________________} function Pile.NumCards: integer; begin NumCards := (MAXSIZE - top) + 1; {The "+ 1" in the equation takes into account that the position of top contains a card.} end; {function NumCards} {============================================================================ GENERAL FUNCTIONS ============================================================================} {____________________________________________________________________ | CardValue | Converts card value (4..111) to orderinal value. | (0 = Joker, 1,2,3,...10,11 = JACK,...) |___________________________________________________________________} function CardValue (Card: CardVal_t): integer; begin if Card = NULL then CardValue := NULL else CardValue := Card DIV 8; end; {function CardValue} {____________________________________________________________________ | CardString | Converts a card value to a string, for representation on the | screen. |___________________________________________________________________} function CardString (Card: CardVal_t): string; var Number: integer; Output: string; begin Number := Card DIV 8; if Card = NULL then Output := '' else if Number = 0 then Output := 'JO' else if Number = 1 then Output := 'AC' else if Number = 2 then Output := '02' else if Number = 3 then Output := '03' else if Number = 4 then Output := '04' else if Number = 5 then Output := '05' else if Number = 6 then Output := '06' else if Number = 7 then Output := '07' else if Number = 8 then Output := '08' else if Number = 9 then Output := '09' else if Number = 10 then Output := '10' else if Number = 11 then Output := 'JA' else if Number = 12 then Output := 'QU' else if Number = 13 then Output := 'KI' else Output := 'ERROR'; Number := Card MOD 4; if Card = NULL then Output := '' else if (Card DIV 8) = 0 then Output := Output + '!' else if Number = 0 then Output := Output + chr(3) else if Number = 1 then Output := Output + chr(4) else if Number = 2 then Output := Output + chr(5) else if Number = 3 then Output := Output + chr(6) else Output := 'ERROR'; CardString := Output; end; {function CardSuit} {___________________________________________________________________ | AceTopCard | Due to the possibility of a joker on an ace pile, this | function returns the ordinal value of the card on the top of | an ace pile -- if there's a joker it is converted to its | ordinal value within the pile. |___________________________________________________________________} function AceTopCard (Number: integer): integer; var position: integer; begin position := 1; while (CardValue (PosTable [Number]^.SeeRandom (position)) = 0) do position := position + 1; AceTopCard := CardValue (PosTable [Number]^.SeeRandom (position)) + position - 1; end; {function AceTopCard} {============================================================================ MAIN PROGRAM PROCEDURES (Grouped with corresponding sub-procedures) ============================================================================} {___________________________________________________________________ | Initialize | Does all the Non-Object initialization. |__________________________________________________________________} procedure Initialize; var count:integer; begin Randomize; DrawPile.Init; PlayerHand.Init; ComputerHand.Init; PlayerScorePile.Init; ComputerScorePile.Init; PlayerDiscardPile1.Init; PlayerDiscardPile2.Init; PlayerDiscardPile3.Init; PlayerDiscardPile4.Init; ComputerDiscardPile1.Init; ComputerDiscardPile2.Init; ComputerDiscardPile3.Init; ComputerDiscardPile4.Init; AcePile1.Init; AcePile2.Init; AcePile3.Init; AcePile4.Init; TrashPile.Init; Game := TRUE; {Set up Position Table} PosTable[1] := @PlayerHand; PosTable[2] := @PlayerHand; PosTable[3] := @PlayerHand; PosTable[4] := @PlayerHand; PosTable[5] := @PlayerHand; PosTable[6] := @PlayerHand; PosTable[7] := @PlayerScorePile; PosTable[8] := @PlayerDiscardPile1; PosTable[9] := @PlayerDiscardPile2; PosTable[10] := @PlayerDiscardPile3; PosTable[11] := @PlayerDiscardPile4; PosTable[12] := @AcePile1; PosTable[13] := @AcePile2; PosTable[14] := @AcePile3; PosTable[15] := @AcePile4; PosTable[16] := @ComputerDiscardPile1; PosTable[17] := @ComputerDiscardPile2; PosTable[18] := @ComputerDiscardPile3; PosTable[19] := @ComputerDiscardPile4; PosTable[20] := @ComputerHand; PosTable[21] := @ComputerHand; PosTable[22] := @ComputerHand; PosTable[23] := @ComputerHand; PosTable[24] := @ComputerHand; PosTable[25] := @ComputerHand; PosTable[26] := @ComputerScorePile; end; {procedure Initialize} {___________________________________________________________________ | InitTable | Refreshes the values for the TopCardTable, which stores the | values of the top card in all 26 positions. |__________________________________________________________________} procedure InitTable; var count:integer; begin for count := 1 to 6 Do TopCardTable[count] := PosTable[count]^.SeeRandom (count); for count := 7 to 19 Do TopCardTable[count] := PosTable[count]^.SeeRandom (1); for count := 20 to 25 Do TopCardTable[count] := PosTable[count]^.SeeRandom(count-19); TopCardTable[26] := PosTable[26]^.SeeRandom(1); end; {procedure InitTable} {___________________________________________________________________ | Deal | Deals the cards at the beginning of each game and decides, | based on the outcome of the deal, who will go first. |__________________________________________________________________} procedure Deal; var Card: CardVal_t; Counter: integer; PlayerScoreTop: CardVal_t; ComputerScoreTop: CardVal_t; begin for Card := (1 +3) to (MAXSIZE +3) do {Put 2 decks of cards in draw pile, +3 is necessary for the div and mod to operate correctly.} DrawPile.PutOnTop (Card); DrawPile.RandomShuffle; {Shuffle the draw pile.} for Counter := 1 to 5 do begin {Deal the hands} PlayerHand.PutOnTop (DrawPile.RemoveFromTop); ComputerHand.PutOnTop (DrawPile.RemoveFromTop); end; {for} for Counter := 1 to 14 do begin {Deal the score piles} PlayerScorePile.PutOnTop (DrawPile.RemoveFromTop); ComputerScorePile.PutOnTop (DrawPile.RemoveFromTop); end; {for} PlayerDiscardPile1.PutOnTop (DrawPile.RemoveFromTop); PlayerDiscardPile2.PutOnTop (DrawPile.RemoveFromTop); PlayerDiscardPile3.PutOnTop (DrawPile.RemoveFromTop); PlayerDiscardPile4.PutOnTop (DrawPile.RemoveFromTop); ComputerDiscardPile1.PutOnTop (DrawPile.RemoveFromTop); ComputerDiscardPile2.PutOnTop (DrawPile.RemoveFromTop); ComputerDiscardPile3.PutOnTop (DrawPile.RemoveFromTop); ComputerDiscardPile4.PutOnTop (DrawPile.RemoveFromTop); {Decide whose turn it is. ComputerTurn set to opposite, because it will be reversed in upcoming WhoseTurn procedure.} PlayerScoreTop := CardValue (PlayerScorePile.SeeRandom(1)); ComputerScoreTop := CardValue (ComputerScorePile.SeeRandom(1)); if PlayerScoreTop = 0 then ComputerTurn := FALSE else if ComputerScoreTop = 0 then ComputerTurn := TRUE else if PlayerScoreTop = ComputerScoreTop then ComputerTurn := FALSE else if PlayerScoreTop > ComputerScoreTop then ComputerTurn := TRUE else ComputerTurn := FALSE; end; {Deal} {___________________________________________________________________ | OutString | One of the procedures involving the interface. | This procedure receives x,y coordinates for a screen position | and outputs a string starting at that position. |__________________________________________________________________} procedure OutString (x,y: integer; toPrint: string); begin GotoXY (x,y); write (toPrint); end; {procedure OutString} {____________________________________________________________________ | ColorDim | One of the procedures involving the interface. | Sets colors for displaying things involving the player whose | turn it is not (hence, they are dimmed.) |___________________________________________________________________} procedure ColorDim; begin TextColor (LIGHTgray); TextBackground (BLACK); end; {procedure ColorDim} {___________________________________________________________________ | ColorCard | One of the procedures involving the interface. | Sets colors for displaying a card of the player whose turn it | is. |___________________________________________________________________} procedure ColorCard; begin TextColor (YELLOW); TextBackGround (BLUE); end; {procedure ColorCard} {____________________________________________________________________ | ColorFrame | One of the procedures involving the interface. | Sets colors for highlighting the section of the frame | involving the player whose turn it is. |___________________________________________________________________} procedure ColorFrame; begin TextColor (YELLOW); TextBackground (BLACK); end; {procedure ColorFrame} {____________________________________________________________________ | ColorNormalText | One of the procedures involving the interface. | Sets colors for normal text and is also the colors which the | game returns to upon exiting. |___________________________________________________________________} procedure ColorNormalText; begin TextColor (WHITE); TextBackground (BLACK); end; {procedure ColorNormalText} {___________________________________________________________________ | ColorPosition | One of the procedures involving the interface. | Sets colors for the display of position indicators. |__________________________________________________________________} procedure ColorPosition; begin TextColor (WHITE); TextBackground (RED); end; {procedure ColorPosition} {___________________________________________________________________ | TitleScreen | Displays a title screen and asks whether the user would like | a one-player or a two-player game. Accompanying procedures are | called by TitleScreen |__________________________________________________________________} procedure Heart; begin TextColor (red); TextBackground (LightGray); write (char(3)); end; procedure Club; begin TextColor (black); TextBackground (LightGray); write (char(5)); end; procedure Diamond; begin TextColor (red); TextBackground (lightgray); write (char(4)); end; procedure Spade; begin TextColor (black); TextBackground (lightgray); write (char(6)); end; procedure SuitsCol (x, y, count: integer); var c :integer; begin c := 0; while (count > 0) Do begin GotoXY (x, y+c*4); Heart; GotoXY (x, y+c*4+1); Club; GotoXY (x, y+c*4+2); Diamond; GotoXY (x, y+c*4+3); Spade; c := c + 1; count := count - 1; TextBackGround (black); end; {while loop} end; {SuitsCol} procedure SuitsRow (x, y, count: integer); var c :integer; begin c := 0; while (count > 0) Do begin GotoXY (x + (4*c), y); Heart; Club; Diamond; Spade; c := c + 1; count := count - 1; TextBackground (black); end; {while loop} end; {SuitsRow} procedure DrawTitleBox; Begin SuitsCol (25, 7, 2); SuitsRow (25, 7, 8); SuitsRow (25, 15, 8); SuitsCol (57, 7, 2); GotoXY (57, 15); Heart; end; {DrawTitleBox} procedure Title; begin TextColor (white); TextBackground (black); OutString (28, 9, 'Welcome to Spite & Malice!'); end; procedure Info (var TwoPlayer : boolean); var response : char; begin repeat OutString (33, 12, 'How many players?'); OutString (37, 13, '('); TextColor (lightred); OutString (38, 13, '1 '); TextColor (white); OutString (40, 13, 'or '); TextColor (lightred); OutString (43, 13, '2'); TextColor (white); OutString (44, 13, ')'); GotoXY (40, 14); readln (response); until ((response = '1') OR (response = '2')); if response = '1' then TwoPlayer := FALSE else TwoPlayer := TRUE; end; procedure TitleScreen (var TwoPlayer:boolean); var response: char; Begin TextBackground (black); clrscr; TextBackground (black); DrawTitleBox; Title; Info (TwoPlayer); TextBackground (black); TextColor (white); End; {procedure TitleScreen} {___________________________________________________________________ | DrawFrame | One of the procedures involving the interface. | This procedure draws the ascii graphical skeleton of the | screen. It also takes into account the turn in its choice of | colors. |__________________________________________________________________} procedure DrawFrame (ComputerTurn: boolean); var Row: integer; Column: integer; begin {Clear screen with Black background.} TextBackGround (BLACK); TextColor (BLACK); For Row:= 1 to 25 do For Column := 1 to 80 do begin if NOT ((Row = 25) and (Column = 80)) then OutString (Column, Row, chr(219)); end; {for column} if ComputerTurn = TRUE then ColorDim else ColorFrame; OutString (1,1,chr(201)); OutString (1,24,chr(200)); OutString (31,1,chr(203)); OutString (31,24,chr(202)); for Column := 2 to 30 do begin OutString (Column,1,chr(205)); OutString (Column,24,chr(205)); end; {for} For Row := 2 to 23 do begin OutString (1,Row,chr(186)); OutString (31,Row,chr(186)); end; {for} Outstring (1,18,chr(204)); Outstring (31,18,chr(185)); For Row := 2 to 30 do OutString (Row,18,chr(205)); OutString (31,5,chr(204)); OutString (31,13,chr(204)); if ComputerTurn = TRUE then ColorFrame else ColorDim; For Column := 51 to 79 do begin OutString (Column,1,chr(205)); OutString (Column,18,chr(205)); OutString (Column,24,chr(205)); end; {for} For Row := 2 to 23 do begin OutString (50,Row,chr(186)); OutString (80,Row,chr(186)); end; {for} OutString (50,1,chr(203)); OutString (50,24,chr(202)); OutString (50,5,chr(185)); OutString (50,13,chr(185)); OutString (50,18,chr(204)); OutString (80,1,chr(187)); OutString (80,24,chr(188)); ColorFrame; For Column := 32 to 49 do begin OutString (Column,1,chr(205)); OutString (Column,5,chr(205)); OutString (Column,13,chr(205)); OutString (Column,24,chr(205)); end; {for} TextColor (BLUE); for Row := 2 to 4 do for Column := 32 to 49 do OutString (Column,Row,chr(219)); TextColor (WHITE); TextBackground (BLUE); OutString (34,2,'Spite & Malice'); OutString (34,3,'By Ben Arnoldy'); OutString (34,4,'& Raechel Kula'); end; {procedure DrawFrame} {___________________________________________________________________ | DrawDiscards | One of the procedures involved with the interface. | This procedure sets up the discard portions of the screen. |__________________________________________________________________} procedure DrawDiscards (ComputerTurn:boolean); var Counter: Pos_t; begin if ComputerTurn = TRUE then ColorDim else ColorNormalText; OutString (9,2,'Player Discard'); if ComputerTurn = TRUE then ColorNormalText else ColorDim; if (TwoPlayer = FALSE) then OutString (58,2,'Computer Discard') else if (TwoPlayer = TRUE) then OutString (58,2,'Opponent Discard'); ColorPosition; OutString (3,3,'H'+chr(26)); OutString (10,3,'I'+chr(26)); OutString (17,3,'J'+chr(26)); OutString (24,3,'K'+chr(26)); OutString (52,3,'P'+chr(26)); OutString (59,3,'Q'+chr(26)); OutString (66,3,'R'+chr(26)); OutString (73,3,'S'+chr(26)); for Counter := 1 to 14 do begin if ComputerTurn = TRUE then ColorDim else ColorCard; OutString(6,2+Counter, CardString (PlayerDiscardPile1.SeeRandom(Counter))); OutString(13,2+Counter, CardString (PlayerDiscardPile2.SeeRandom(Counter))); OutString(20, 2+Counter, CardString (PlayerDiscardPile3.SeeRandom(Counter))); OutString(27, 2+Counter, CardString (PlayerDiscardPile4.SeeRandom(Counter))); if ComputerTurn = FALSE then ColorDim else ColorCard; OutString(55, 2+Counter, CardString (ComputerDiscardPile1.SeeRandom(Counter))); OutString(62, 2+Counter, CardString (ComputerDiscardPile2.SeeRandom(Counter))); OutString(69, 2+Counter, CardString (ComputerDiscardPile3.SeeRandom(Counter))); OutString(76, 2+Counter, CardString (ComputerDiscardPile4.SeeRandom(Counter))); end; {for} {if there are too many cards in a discard pile to display...} TextColor (LIGHTred); TextBackground (BLACK); for Counter := 1 to 4 do begin if PosTable [7+Counter]^.NumCards > 14 then OutString ((-2 + (Counter*7)),17,'more'); if PosTable [15+Counter]^.NumCards > 14 then OutString ((44 + (Counter*7)),17,'more'); end; {for} end; {procedure DrawDiscards} {___________________________________________________________________ | DrawHands | One of the procedures involved with the interface. | This procedure displays the hands and scorepiles. |__________________________________________________________________} procedure DrawHands (ComputerTurn:boolean); var CardFace: string; begin if ComputerTurn = TRUE then ColorDim else ColorNormalText; GotoXY (2,19); write ('Player''s Hand:'); if ComputerTurn = FALSE then ColorDim else ColorNormalText; if (TwoPlayer = FALSE) then begin GotoXY (51,19); write ('Computer''s Hand:'); end else if (TwoPlayer = TRUE) then begin GotoXY (51,19); write ('Opponent''s Hand:'); end; ColorPosition; OutString (3,21,'A'+chr(24)); OutString (8,21,'B'+chr(24)); OutString (13,21,'C'+chr(24)); OutString (18,21,'D'+chr(24)); OutString (23,21,'E'+chr(24)); OutString (28,21,'F'+chr(24)); OutString (52,21,'T'+chr(24)); OutString (57,21,'U'+chr(24)); OutString (62,21,'V'+chr(24)); OutString (67,21,'W'+chr(24)); OutString (72,21,'X'+chr(24)); OutString (77,21,'Y'+chr(24)); If ComputerTurn = TRUE then ColorDim else ColorCard; OutString(3,20,CardString (PlayerHand.SeeRandom(1))); OutString(8,20,CardString (PlayerHand.SeeRandom(2))); OutString(13,20,CardString (PlayerHand.SeeRandom(3))); OutString(18,20,CardString (PlayerHand.SeeRandom(4))); OutString(23,20,CardString (PlayerHand.SeeRandom(5))); OutString(28,20,CardString (PlayerHand.SeeRandom(6))); If ComputerTurn = FALSE then ColorDim else ColorCard; If TwoPlayer then begin OutString(52,20,CardString (ComputerHand.SeeRandom(1))); OutString(57,20,CardString (ComputerHand.SeeRandom(2))); OutString(62,20,CardString (ComputerHand.SeeRandom(3))); OutString(67,20,CardString (ComputerHand.SeeRandom(4))); OutString(72,20,CardString (ComputerHand.SeeRandom(5))); OutString(77,20,CardString (ComputerHand.SeeRandom(6))); end {if} else begin CardFace := chr(168) + chr(63); if ComputerHand.NumCards > 0 then OutString(52,20,CardFace); if ComputerHand.NumCards > 1 then OutString(57,20,CardFace); if ComputerHand.NumCards > 2 then OutString(62,20,CardFace); if ComputerHand.NumCards > 3 then OutString(67,20,CardFace); if ComputerHand.NumCards > 4 then OutString(72,20,CardFace); if ComputerHand.NumCards > 5 then OutString(77,20,CardFace); end; {if-else} if ComputerTurn = TRUE then ColorDim else ColorNormalText; GotoXY (2,23); write ('Score Pile: ', PlayerScorePile.NumCards, ' cards> '); ColorPosition; write('G'+chr(26)); TextColor (BLACK); TextBackground (BLACK); write(' '); if ComputerTurn = TRUE then ColorDim else ColorCard; write (CardString (PlayerScorePile.SeeRandom(1))); if ComputerTurn = FALSE then ColorDim else ColorNormalText; GotoXY (51,23); write ('Score Pile: ', ComputerScorePile.NumCards, ' cards> '); ColorPosition; write('Z'+chr(26)); TextColor (BLACK); TextBackground (BLACK); write(' '); if ComputerTurn = FALSE then ColorDim else ColorCard; write (CardString (ComputerScorePile.SeeRandom(1))); end; {procedure DrawHands} {___________________________________________________________________ | DrawAcePiles | One of the procedures involved with the interface. | This procedure draws the AcePile portion of the screen. |__________________________________________________________________} procedure DrawAcePiles; var Counter: integer; begin ColorNormalText; OutString (36,5,'Ace Piles:'); ColorPosition; OutString (38,8,'L'+chr(26)); OutString (38,9,'M'+chr(26)); OutString (38,10,'N'+chr(26)); OutString (38,11,'O'+chr(26)); ColorCard; for Counter := 1 to 4 do begin OutString(41,7+Counter,CardString (TopCardTable [11+Counter] )); if CardValue( TopCardTable [11+Counter] )=0 then if AceTopCard (11+Counter) < 10 then OutString(45,7+Counter,chr(AceTopCard (11+Counter) + 48)) else if AceTopCard (11+Counter) = 10 then OutString(45,7+Counter,'10') else if AceTopCard (11+Counter) = 11 then OutString(45,7+Counter,'JA') else if AceTopCard (11+Counter) = 12 then OutString(45,7+Counter,'QU') else if AceTopCard (11+Counter) = 13 then OutString(45,7+Counter,'KI'); end; {for} end; {Display} {___________________________________________________________________ | DrawMessageBox | One of the procedures involved with the interface. | This procedure clears the message portion of the screen and | prints a message displaying the turn. |__________________________________________________________________} procedure DrawMessageBox (ComputerTurn: boolean); var Column: integer; Row: integer; begin TextColor (BLACK); TextBackground (BLACK); for Column := 32 to 49 do for Row := 14 to 23 do OutString (Column,Row,chr(219)); ColorNormalText; if ((ComputerTurn = TRUE) AND (TwoPlayer = FALSE)) then begin GotoXY (33,15); write ('Computer''s Turn'); end else if ((ComputerTurn = TRUE) AND (TwoPlayer = TRUE)) then begin GotoXY (33,15); write ('Opponent''s Turn'); end else begin GotoXY (34,15); write ('Player''s Turn'); end; end; {procedure DrawMessageBox} {___________________________________________________________________ | Display | This procedure directs the interface procedures for a complete | redrawing of the screen. |__________________________________________________________________} procedure Display; begin clrscr; DrawFrame (ComputerTurn); DrawDiscards (ComputerTurn); DrawHands (ComputerTurn); DrawAcePiles; DrawMessageBox (ComputerTurn); end; {Display} {___________________________________________________________________ | PickUpHand | Picks up the required number of cards from the draw pile and | places them in the hand of the person whose turn it is. | This procedure also checks to see if the draw pile has run out | of cards. If so the trash pile is placed in the draw pile and | the draw pile is subsequently reshuffled. |___________________________________________________________________} Procedure PickupHand (var Hand : pile); var numToGet, count, Counter : integer; begin If (Hand.NumCards > 3)Then numToGet := 1 Else numToGet := (5 - Hand.NumCards); For count := 1 to numToGet Do begin If DrawPile.NumCards = 0 then begin {Draw pile out of card, replenish} For Counter := 1 to TrashPile.NumCards do DrawPile.PutOnTop (TrashPile.RemoveFromTop); DrawPile.RandomShuffle; end; {if} Hand.PutOnTop (DrawPile.RemoveFromTop); end; {for} end; {procedure PickupHand} {____________________________________________________________________ | PickUpCards | Sends correct hand to the PickupHand procedure according to | whose turn it is. |___________________________________________________________________} Procedure PickupCards; begin If ComputerTurn Then PickupHand (ComputerHand) Else PickupHand (PlayerHand); InitTable; {Refresh the Top Card Table} end; {PickupCards} {____________________________________________________________________ | HouseKeeping | Performs some checks after a card has been moved. | These checks include: removing completed ace piles, | checking for completed game, and checking for | insufficient cards to discard. |___________________________________________________________________} procedure HouseKeeping; var Counter: integer; Counter2: integer; begin InitTable; {Keep current top card information updated.} {Clean up any full ace piles.} for Counter := 12 to 15 do if PosTable [Counter]^.NumCards = 13 then for Counter2 := 1 to 13 do TrashPile.PutOnTop (PosTable [Counter]^.RemoveFromTop); {Check for Game over.} if ComputerScorePile.NumCards = 0 then begin Game := FALSE; Discard := TRUE; Winner := 'Computer'; end; {if} if PlayerScorePile.NumCards = 0 then begin Game := FALSE; Discard := TRUE; Winner := 'Player'; end; {if} {Run out of cards before discard.} If ((Discard = FALSE) AND ComputerTurn AND (ComputerHand.NumCards = 0)) then PickUpCards; If ((Discard = FALSE) AND (NOT ComputerTurn) AND (PlayerHand.NumCards = 0)) then PickUpCards; end; {procedure HouseKeeping} {____________________________________________________________________ | MoveCard | Moves a card from one pile to another as specified. |___________________________________________________________________} Procedure MoveCard (From, Tto : integer); var frompile : pilepointer_t; value: CardVal_t; dummy: integer; begin if ((From < 7) Or ((From > 19) AND (From < 26))) then begin frompile :=PosTable[From]; value := TopCardTable[From]; dummy := frompile^.DeleteByValue(value); PosTable[Tto]^.PutOnTop(value); end else PosTable[Tto]^.PutOnTop (PosTable[From]^.RemoveFromTop); HouseKeeping; {Calls the HouseKeeping procedure} end; {procedure MoveCard} {____________________________________________________________________ | WhoseTurn | This procedure changes the turns. |___________________________________________________________________} Procedure WhoseTurn (var ComputerTurn : boolean); begin If ComputerTurn Then ComputerTurn := False Else ComputerTurn := True; end; {WhoseTurn} {____________________________________________________________________ | CheckMove | Checks to see if the move proposed is a) valid, and | b) a discard. |___________________________________________________________________} Procedure CheckMove(var From, Tto: integer); var TopCard: integer; position: Pos_t; Counter: Pos_t; EmptyAcePile: boolean; begin InitTable; Valid := TRUE; Discard := FALSE; MustMove := FALSE; If TopCardTable [From] = NULL then Valid := FALSE; {Invalid if moving from empty space.} If (Valid AND ((Tto < 8) OR (Tto > 19))) then Valid := FALSE;{Invalid if proposed to move card to ScorePiles or Hands} If (Valid AND ComputerTurn AND ((Tto < 12) OR (From < 12))) then Valid := FALSE; {Invalid if computer proposed to or from player's side.} If (VALID AND (NOT ComputerTurn) AND ((Tto > 15) OR (From > 15))) then Valid := FALSE; {Invalid if player proposed to or from computer's side.} If (VALID AND ((From > 11) AND (From < 16))) then Valid := FALSE; {Invalid if to Acepile from Acepile.} if (VALID AND (((Tto > 7) AND (Tto < 12)) OR ((Tto > 15) AND (Tto < 20))) AND (((From < 12) AND (From > 6)) OR ((From = 26) OR ((From > 15) AND (From < 20))))) then Valid := FALSE; {Invalid if to discard from a discard or score pile.} {Ace on top of Discard Pile must be played first.} EmptyAcePile := FALSE; for Counter := 1 to 4 do if PosTable [Counter + 11]^.NumCards = 0 then EmptyAcePile := TRUE; if (EmptyAcePile AND Valid) then for Counter := 1 to 4 do begin if ((ComputerTurn) AND (CardValue (TopCardTable [Counter + 15]) = 1) AND (From <> (Counter + 15)) AND (NOT(CardValue(TopCardTable[From])=1))) then Valid := FALSE; if ((NOT ComputerTurn) AND (CardValue (TopCardTable[Counter+7]) = 1) AND (From <> (Counter + 7)) AND (NOT(CardValue(TopCardTable[From])=1))) then Valid := FALSE; end; {for} if (EmptyAcePile AND Valid) then for Counter := 1 to 4 do begin if ((ComputerTurn) AND (CardValue (TopCardTable [Counter + 15]) = 1) AND (From = (Counter + 15)) OR (CardValue(TopCardTable[From])=1)) then begin Valid := True; MustMove := True; end; {if} end; {for} {forces computer to play ace when To/From scores below threshold} {Ace Piles Check} if (VALID AND ((Tto > 11) AND (Tto < 16))) then begin TopCard := AceTopCard (Tto); If ((TopCard = NULL) AND (CardValue (TopCardTable [From]) <> 1)) then Valid := FALSE {If placing non-ace on empty ace pile.} else if TopCard = NULL then Valid := TRUE else if CardValue(TopCardTable[From]) = 0 then Valid := TRUE {In all cases but as ace, joker is valid.} else if ((TopCard + 1) <> CardValue (TopCardTable[From])) then Valid := FALSE; {If it is not next card in series.} end; {if} {Discard Check} if (Valid AND ((ComputerTurn AND ((Tto < 20) AND (Tto > 15) AND (From > 19) AND (From < 26))) OR (NOT ComputerTurn AND ((Tto < 12) AND (Tto > 7) AND (From < 7) AND (From > 0))))) then if PosTable [Tto]^.NumCards > 0 then begin Discard := TRUE; if ComputerTurn then For Counter := 16 to 19 do if PosTable [Counter]^.NumCards = 0 then begin Valid := FALSE; Discard := FALSE; end; {if} if NOT ComputerTurn then For Counter := 8 to 11 do if PosTable [Counter]^.NumCards = 0 then begin Valid := FALSE; Discard := FALSE; end; {if} end; {if} end;{CheckMove} {____________________________________________________________________ | GetMove | Requested a proposal for a move from the player. |___________________________________________________________________} Procedure GetMove (var From, Tto: integer); var FromChar, ToChar: char; begin Display; ColorNormalText; OutString (33,17,'Enter positions'); ColorDim; OutString (35,18,'(@ to Quit)'); ColorNormalText; OutString (33,19,'Move a card'); OutString (33,20,'from: '); readln (FromChar); OutString (33,21,'to: '); readln (ToChar); From := ord(UpCase(FromChar)) - 64; Tto := ord(UpCase(ToChar)) - 64; {-64 to adjust for alphabet's position in ASCII table.} if ((From = 0) OR (Tto = 0)) then begin {quit} ColorNormalText; clrscr; HALT; end; {if} if ((From < 1) OR (From > 26) OR (Tto < 1) OR (From > 26)) then begin From := 1; Tto := 1; end; {if} end; {GetMove} {____________________________________________________________________ | ResultsofCheck | Displays a message regarding the results of the check in | CheckMove. |___________________________________________________________________} procedure ResultsofCheck; begin DrawMessageBox (ComputerTurn); {Calls the DrawMessageBox procedure} ColorNormalText; OutString (33,17,'Proposed Move:'); GotoXY (33,18); write ('From: ',chr(From + 64)); GotoXY (33,19); write ('To: ',chr(Tto + 64)); GotoXY (33,21); if NOT Valid then begin TextColor (WHITE+BLINK); write ('Is NOT Valid!!'); end else begin TextColor (WHITE); write ('Is Valid.'); end; {if else} TextColor (RED+BLINK); OutString (33,23,'Press ...'); readln; end; {ResultsofCheck} {_____________________________________________________________________ | PlayAgainBox | Displays Box and asks player if he/she wants to play again |_____________________________________________________________________} procedure PlayAgainBox; Begin ColorNormalText; clrscr; DrawTitleBox; ColorNormalText; OutString (27, 11, 'Would you like to play again?'); OutString (37, 12, '('); TextColor (LightRed); OutString (38, 12, 'Y '); TextColor (white); OutString (40, 12, 'or '); TextColor (lightRed); OutString (43, 12, 'N'); TextColor (white); OutString (44, 12, ')'); End; {____________________________________________________________________ | GameOverDisplay | Notifies player that the game is over, displays who won, and | asks the player if he/she would like to play again. |___________________________________________________________________} Procedure GameOverDisplay (Winner: string); var Response: char; Valid: boolean; begin ColorNormalText; clrscr; DrawTitleBox; ColorNormalText; OutString (36, 10, 'Game Over!!'); OutString (32, 12, 'The '); OutString (36, 12, Winner); OutString (44, 12, ' wins!'); readln; {Play Again?} Valid := FALSE; Repeat PlayAgainBox; readln (Response); if (Upcase (Response) = 'Y') then begin AnotherGame := TRUE; Valid := TRUE; end else if (Upcase (Response) = 'N') then begin AnotherGame := FALSE; Valid := TRUE; end else Valid := FALSE; Until Valid; end; {function AnotherGame} {___________________________________________________________________ | SetUp | One of Decision's evaluative functions. | This function adds a negative weight if a play will result in | setting up the player to play from his/her score pile. |__________________________________________________________________} Function SetUp: integer; const WEIGHT = -20; SWEIGHT =-10; var position: integer; Points: integer; CardCanPlay: integer; ScoreCard: integer; CardPlayed: integer; begin Points := 0; ScoreCard := CardValue (TopCardTable [7]); CardPlayed := AceTopCard (Tto) + 1; CardCanPlay := CardPlayed + 1; If CardCanPlay = ScoreCard then begin Points := WEIGHT; For position := 16 to 26 do begin if CardValue (TopCardTable [position]) = ScoreCard then Points := 0; if position = From then if CardValue (PosTable [position]^.SeeRandom(2)) = ScoreCard then Points := 0; end; {for} end; {if} If (Points = WEIGHT) AND (From = 26) then Points := SWEIGHT; SetUp := Points; end; {function SetUp} {___________________________________________________________________ | Block | One of Decision's evaluative functions. | This function adds a positive weight if the play results in | preventing the player from playing from his score pile. |__________________________________________________________________} function Block: integer; const WEIGHT = 25; var Points: integer; ScoreCard: integer; CardPlayed: integer; begin Points := 0; ScoreCard := CardValue (TopCardTable [7]); CardPlayed := AceTopCard (Tto) + 1; If CardPlayed = ScoreCard then Points := WEIGHT; Block := points; end; {Block} {___________________________________________________________________ | PlayMore | One of Decision's evaluative functions. | This function adds a positive weight if a play results in the | computer being able to play more cards. | It also adds a positive weight if a play allows the computer to | move a card. |___________________________________________________________________} function PlayMore: integer; const WEIGHT = 15; {If move allows the computer to move more cards.} WEIGHT2 = 10; {If Computer can move a card.} var position: integer; Points: integer; CardCanPlay: integer; CardPlayed: integer; begin Points := WEIGHT2; {Just for being able to play a card.} CardPlayed := AceTopCard (Tto) + 1; CardCanPlay := CardPlayed + 1; position := 16; While (Position < 27) do begin if CardValue (TopCardTable [position]) = CardCanPlay then Points := WEIGHT; if position = From then if CardValue(PosTable [position]^.SeeRandom (2)) = CardCanPlay then Points := WEIGHT; position := position + 1; end; {While} {Special case for Jokers} If CardValue (TopCardTable [From]) = 0 then Points := Points - WEIGHT; PlayMore := Points; end; {function PlayMore} {____________________________________________________________________ | MoreCards | One of Decision's evaluative functions | This function adds weight to a play that will result in the | computer being able to pick up more cards at the beginning of | its next turn. Additional weight is given to a play that will | result in the computer being able to pick up 5 more cards this | turn. |____________________________________________________________________} function MoreCards: integer; const WEIGHT = 10; WEIGHT2 = 20; var HolestoFill: integer; Counter: integer; Points: integer; begin Points := 0; {creates empty discard pile, ie a hole to fill} If ((From >15) AND (From <20) AND (PosTable [From]^.NumCards = 1) AND (NOT CardValue(TopCardTable [From]) = 0)) then Points := WEIGHT; {takes into account the holes} HolestoFill := 0; If ((From > 19) AND (From < 26 )) then begin Points := WEIGHT; For Counter := 16 to 19 do begin If PosTable [Counter]^.NumCards = 0 then HolestoFill := HolestoFill + 1; end; {for} If (ComputerHand.NumCards - HolestoFill) = 0 then Points := WEIGHT2; {special case for Jokers} If CardValue (TopCardTable [From]) = 0 then Points := Points - WEIGHT; end; {if} MoreCards := Points; end; {MoreCards} {_____________________________________________________________________ | HelpScore | One of Decision's evaluative functions | This function will add positive weight to a play that results | in the computer being able to play from its score pile. |____________________________________________________________________} function HelpScore: integer; const WEIGHT = 30; var ScoreCard: integer; CardPlayed: integer; CardCanPlay: integer; Points: integer; begin Points := 0; ScoreCard := CardValue (TopCardTable [26]); CardPlayed := AceTopCard (Tto) + 1; CardCanPlay := CardPlayed + 1; If CardCanPlay = ScoreCard then Points := WEIGHT; HelpScore := Points; end; {function HelpScore} {_____________________________________________________________________ | Score | One of Decision's evaluative functions. | This function adds positive weight to a score pile play. |____________________________________________________________________} function Score: integer; const WEIGHT = 60; WEIGHT2 = 10; var ScoreCard: integer; position: integer; Points: integer; Begin Points := 0; if From = 26 then begin ScoreCard := CardValue (TopCardTable [26]); if (((AceTopCard (Tto) + 1) = ScoreCard) OR (ScoreCard = 0)) then begin Points := WEIGHT; if ((ScoreCard + 1) = CardValue (TopCardTable [7])) then begin Points := WEIGHT2; position := 16; while (position < 26) do begin position := position + 1; if ((TopCardTable [position] = 0) OR (TopCardTable [position] = (ScoreCard +1))) then Points := WEIGHT; end; {While} end; {if} end; {if} end; {if} Score := Points; end; {function Score} {_____________________________________________________________________ | SameScore | One of DiscardDecision's evaluative functions | This function adds a negative weight to a discard | of a card that is the same value as the computer's score | pile. |____________________________________________________________________} function SameScore: integer; const WEIGHT = -5; JWEIGHT = -20; var Points: integer; begin Points := 0; If (CardValue(TopCardTable[From]) = CardValue (TopCardTable[26])) then Points := WEIGHT; {special case for Jokers} If CardValue (TopCardTable[From]) = 0 then Points := JWEIGHT; SameScore := Points; end; {function SameScore} {_____________________________________________________________________ | Order | One of DecisionDiscard's evaluative functions | This function uses weights to prioritize a discard to the closest | possible lower value in relation to the top cards of the discard | piles. |____________________________________________________________________} function Order: integer; const WEIGHT1 = 20; WEIGHT2 = 11; WEIGHT3 = 4; WEIGHT4 = -5; JWEIGHT = -20; var next: CardVal_t; Points: integer; begin next := CardValue (TopCardTable [Tto]) - 1; if (CardValue (TopCardTable [From]) = next) then Points := WEIGHT1; if ((CardValue (TopCardTable [From]) + 1) = next) then Points := WEIGHT2; if ((CardValue (TopCardTable[From]) + 1) < next) then Points := WEIGHT3; if (CardValue (TopCardTable [From]) > next) then Points := WEIGHT4; {special case for Jokers} if CardValue (TopCardTable [From]) = 0 then Points := JWEIGHT; Order := Points; end; {Order} {_____________________________________________________________________ | HighCard | One of DecisionDiscard's evaluative functions. | This function weights the possible cards to fill in a space | in the discard piles. It adds most weight to the highest | valued card. |____________________________________________________________________} function HighCard: integer; var count, Points: integer; begin Points := 0; if ((PosTable [16]^.NumCards = 0) OR (PosTable [17]^.NumCards = 0) OR (PosTable [18]^.NumCards = 0) OR (PosTable [19]^.NumCards = 0)) then for count := 20 to 25 do if (CardValue(TopCardTable [From]) > CardValue (TopCardTable [count])) then Points := Points + 1; HighCard := Points * 2; end; {function HighCard} {_____________________________________________________________________ | DiscardDecision | This procedure is responsible for applying the various weights | on to the decision surrounding the computer's discard. |____________________________________________________________________} Procedure DiscardDecision (var From, Tto: integer); var max: integer; f, t: integer; Begin For f := 20 to 25 Do For t := 16 to 19 Do begin From := f; Tto := t; CheckMove (From, Tto); If Not (Valid) Then ChoiceRate[f, t] := -10000 Else ChoiceRate[f, t] := ((HighCard) + (Order) + (SameScore)); end; {for} From := 20; Tto := 16; max := 0; For f := 20 to 25 Do For t := 16 to 19 Do begin If (ChoiceRate[f, t] > ChoiceRate[From, Tto]) Then begin max := ChoiceRate[f, t]; From := f; Tto := t; end; {if} end; {for} End; {DiscardDecision} {_____________________________________________________________________ | Decision | This procedure is responsible for applying the weights to the | decision surrounding the computer's choice of moves. |____________________________________________________________________} Procedure Decision (var From, Tto: integer); const Threshold = 10; var Max: integer; f, t: integer; Begin Display; For f := 1 to 26 do For t := 1 to 19 do ChoiceRate [f, t] := 0; For f := 16 to 26 Do For t := 12 to 15 Do begin From := f; Tto := t; CheckMove(From, Tto); If Not (Valid) Then ChoiceRate[f, t] := -10000 Else ChoiceRate[f, t] := ((SetUp) + (Block) + (PlayMore) + (MoreCards) + (HelpScore) + (Score)); end; {for} {Tests Threshold} From := 16; Tto := 12; max := 0; For f := 16 to 26 Do For t := 12 to 15 Do begin If (ChoiceRate[f, t] > ChoiceRate[From, Tto]) Then begin max := ChoiceRate[f, t]; From := f; Tto := t; end; {if} end; {for} If (Max < Threshold) AND (NOT(MustMove)) Then DiscardDecision (From, Tto); End; {Decision} {============================================================================ MAIN PROGRAM ============================================================================} BEGIN {Main Program} Repeat TitleScreen (TwoPlayer); Initialize; Deal; While (Game) Do begin WhoseTurn (ComputerTurn); PickupCards; Repeat If ((ComputerTurn) AND (NOT TwoPlayer)) Then Decision (From, Tto) Else GetMove (From, Tto); CheckMove(From, Tto); ResultsofCheck; If Valid then MoveCard (From, Tto); Until (Discard); End; {While Loop} GameOverDisplay (Winner); Until (NOT AnotherGame); END. {Main Program}