import GUI in "%oot/lib/GUI"
class Card
export setCard, getCard, Selected, getSelected, Suit, Rank, setSuit,
printCard
var card : string
var selected : boolean := false
%Procedure : setCard
%Input : none
%Output: card
%Purpose : give card a value
%Parameters : the name of the card
procedure setCard (c : string)
card := c
end setCard
%Function : getCard
%Input : none
%Output: card
%Purpose : get the value of card
function getCard : string
result card
end getCard
procedure Selected
selected := true
end Selected
function getSelected : boolean
result selected
end getSelected
%Function : Suit
%Input : none
%Output: suit of the card
%Purpose : to find the suit of card
function Suit : int
var suit : int
if index (card, "d") = 2 then
suit := 1
elsif index (card, "c") = 2 then
suit := 2
elsif index (card, "h") = 2 then
suit := 3
elsif index (card, "s") = 2 then
suit := 4
end if
result suit
end Suit
%Function : Rank
%Input : none
%Output: Rank of the card
%Purpose : to find the rank of card
%Paramenter : card
function Rank : int
var rank : int
if index (card, "a") = 1 then
rank := 1
elsif index (card, "2") = 1 then
rank := 2
elsif index (card, "3") = 1 then
rank := 3
elsif index (card, "4") = 1 then
rank := 4
elsif index (card, "5") = 1 then
rank := 5
elsif index (card, "6") = 1 then
rank := 6
elsif index (card, "7") = 1 then
rank := 7
elsif index (card, "8") = 1 then
rank := 8
elsif index (card, "9") = 1 then
rank := 9
elsif index (card, "t") = 1 then
rank := 10
elsif index (card, "j") = 1 then
rank := 11
elsif index (card, "q") = 1 then
rank := 12
elsif index (card, "k") = 1 then
rank := 13
end if
result rank
end Rank
%Function : setSuit
%Input : suit choosen
%Output: suit
%Purpose : to change the suit of card
function setSuit : int
var newSuit : string (1) := 'x'
var rank : string
var suit : int := 0
put "Choose a suit (d=diamonds c=clubs h=hearts s=spades): " ..
loop
if hasch then
getch (newSuit)
case newSuit of
label 'd' :
card := card (1) + "d"
suit := Suit
label 'c' :
card := card (1) + "c"
suit := Suit
label 'h' :
card := card (1) + "h"
suit := Suit
label 's' :
card := card (1) + "s"
suit := Suit
label :
put ""
put "Invalid suit"
suit := 0
end case
end if
exit when suit not= 0
end loop
result suit
end setSuit
procedure printCard (x, y : int, front : boolean)
var cardPic : int
if front then
case card of
label 'ad' :
cardPic := Pic.FileNew (".\\CardsBMP\\ad.bmp")
label 'ac' :
cardPic := Pic.FileNew (".\\CardsBMP\\ac.bmp")
label 'ah' :
cardPic := Pic.FileNew (".\\CardsBMP\\ah.bmp")
label 'as' :
cardPic := Pic.FileNew (".\\CardsBMP\\as.bmp")
label '2d' :
cardPic := Pic.FileNew (".\\CardsBMP\\2d.bmp")
label '2c' :
cardPic := Pic.FileNew (".\\CardsBMP\\2c.bmp")
label '2h' :
cardPic := Pic.FileNew (".\\CardsBMP\\2h.bmp")
label '2s' :
cardPic := Pic.FileNew (".\\CardsBMP\\2s.bmp")
label '3d' :
cardPic := Pic.FileNew (".\\CardsBMP\\3d.bmp")
label '3c' :
cardPic := Pic.FileNew (".\\CardsBMP\\3c.bmp")
label '3h' :
cardPic := Pic.FileNew (".\\CardsBMP\\3h.bmp")
label '3s' :
cardPic := Pic.FileNew (".\\CardsBMP\\3s.bmp")
label '4d' :
cardPic := Pic.FileNew (".\\CardsBMP\\4d.bmp")
label '4c' :
cardPic := Pic.FileNew (".\\CardsBMP\\4c.bmp")
label '4h' :
cardPic := Pic.FileNew (".\\CardsBMP\\4h.bmp")
label '4s' :
cardPic := Pic.FileNew (".\\CardsBMP\\4s.bmp")
label '5d' :
cardPic := Pic.FileNew (".\\CardsBMP\\5d.bmp")
label '5c' :
cardPic := Pic.FileNew (".\\CardsBMP\\5c.bmp")
label '5h' :
cardPic := Pic.FileNew (".\\CardsBMP\\5h.bmp")
label '5s' :
cardPic := Pic.FileNew (".\\CardsBMP\\5s.bmp")
label '6d' :
cardPic := Pic.FileNew (".\\CardsBMP\\6d.bmp")
label '6c' :
cardPic := Pic.FileNew (".\\CardsBMP\\6c.bmp")
label '6h' :
cardPic := Pic.FileNew (".\\CardsBMP\\6h.bmp")
label '6s' :
cardPic := Pic.FileNew (".\\CardsBMP\\6s.bmp")
label '7d' :
cardPic := Pic.FileNew (".\\CardsBMP\\7d.bmp")
label '7c' :
cardPic := Pic.FileNew (".\\CardsBMP\\7c.bmp")
label '7h' :
cardPic := Pic.FileNew (".\\CardsBMP\\7h.bmp")
label '7s' :
cardPic := Pic.FileNew (".\\CardsBMP\\7s.bmp")
label '8d' :
cardPic := Pic.FileNew (".\\CardsBMP\\8d.bmp")
label '8c' :
cardPic := Pic.FileNew (".\\CardsBMP\\8c.bmp")
label '8h' :
cardPic := Pic.FileNew (".\\CardsBMP\\8h.bmp")
label '8s' :
cardPic := Pic.FileNew (".\\CardsBMP\\8s.bmp")
label '9d' :
cardPic := Pic.FileNew (".\\CardsBMP\\9d.bmp")
label '9c' :
cardPic := Pic.FileNew (".\\CardsBMP\\9c.bmp")
label '9h' :
cardPic := Pic.FileNew (".\\CardsBMP\\9h.bmp")
label '9s' :
cardPic := Pic.FileNew (".\\CardsBMP\\9s.bmp")
label 'td' :
cardPic := Pic.FileNew (".\\CardsBMP\\td.bmp")
label 'tc' :
cardPic := Pic.FileNew (".\\CardsBMP\\tc.bmp")
label 'th' :
cardPic := Pic.FileNew (".\\CardsBMP\\th.bmp")
label 'ts' :
cardPic := Pic.FileNew (".\\CardsBMP\\ts.bmp")
label 'jd' :
cardPic := Pic.FileNew (".\\CardsBMP\\jd.bmp")
label 'jc' :
cardPic := Pic.FileNew (".\\CardsBMP\\jc.bmp")
label 'jh' :
cardPic := Pic.FileNew (".\\CardsBMP\\jh.bmp")
label 'js' :
cardPic := Pic.FileNew (".\\CardsBMP\\js.bmp")
label 'qd' :
cardPic := Pic.FileNew (".\\CardsBMP\\qd.bmp")
label 'qc' :
cardPic := Pic.FileNew (".\\CardsBMP\\qc.bmp")
label 'qh' :
cardPic := Pic.FileNew (".\\CardsBMP\\qh.bmp")
label 'qs' :
cardPic := Pic.FileNew (".\\CardsBMP\\qs.bmp")
label 'kd' :
cardPic := Pic.FileNew (".\\CardsBMP\\kd.bmp")
label 'kc' :
cardPic := Pic.FileNew (".\\CardsBMP\\kc.bmp")
label 'kh' :
cardPic := Pic.FileNew (".\\CardsBMP\\kh.bmp")
label 'ks' :
cardPic := Pic.FileNew (".\\CardsBMP\\ks.bmp")
end case
else
cardPic := Pic.FileNew (".\\CardsBMP\\b.bmp")
end if
Pic.Draw (cardPic, x, y, picCopy)
Pic.Free (cardPic)
end printCard
end Card
class Deck
import Card
export emptyDeck, shuffleDeck, TopCard
var cards : array 1 .. 52 of ^Card
var size : int
var topC : string
var p : int := 1
for i : 1 .. 52
new cards (i)
end for
%Procedure : initialize
%Input : none
%Output: none
%Purpose : initializes the deck of cards and sets a logical size
procedure initialize
cards (1) -> setCard ('ad')
cards (2) -> setCard ('ac')
cards (3) -> setCard ('ah')
cards (4) -> setCard ('as')
cards (5) -> setCard ('2d')
cards (6) -> setCard ('2c')
cards (7) -> setCard ('2h')
cards (8) -> setCard ('2s')
cards (9) -> setCard ('3d')
cards (10) -> setCard ('3c')
cards (11) -> setCard ('3h')
cards (12) -> setCard ('3s')
cards (13) -> setCard ('4d')
cards (14) -> setCard ('4c')
cards (15) -> setCard ('4h')
cards (16) -> setCard ('4s')
cards (17) -> setCard ('5d')
cards (18) -> setCard ('5c')
cards (19) -> setCard ('5h')
cards (20) -> setCard ('5s')
cards (21) -> setCard ('6d')
cards (22) -> setCard ('6c')
cards (23) -> setCard ('6h')
cards (24) -> setCard ('6s')
cards (25) -> setCard ('7d')
cards (26) -> setCard ('7c')
cards (27) -> setCard ('7h')
cards (28) -> setCard ('7s')
cards (29) -> setCard ('8d')
cards (30) -> setCard ('8c')
cards (31) -> setCard ('8h')
cards (32) -> setCard ('8s')
cards (33) -> setCard ('9d')
cards (34) -> setCard ('9c')
cards (35) -> setCard ('9h')
cards (36) -> setCard ('9s')
cards (37) -> setCard ('td')
cards (38) -> setCard ('tc')
cards (39) -> setCard ('th')
cards (40) -> setCard ('ts')
cards (41) -> setCard ('jd')
cards (42) -> setCard ('jc')
cards (43) -> setCard ('jh')
cards (44) -> setCard ('js')
cards (45) -> setCard ('qd')
cards (46) -> setCard ('qc')
cards (47) -> setCard ('qh')
cards (48) -> setCard ('qs')
cards (49) -> setCard ('kd')
cards (50) -> setCard ('kc')
cards (51) -> setCard ('kh')
cards (52) -> setCard ('ks')
size := 52
end initialize
function emptyDeck : boolean
var numOfSelected : int := 0
var eD : boolean := false
for i : 1 .. 52
if cards (i) -> getSelected = true then
numOfSelected := numOfSelected + 1
end if
end for
if numOfSelected = 52 then
eD := true
end if
result eD
end emptyDeck
%Procedure : shuffleDeck
%Input : none
%Output: none
%Purpose : to shuffle the deck
procedure shuffleDeck
var a, b : int
var temp : ^Card
initialize
new temp
for i : 1 .. 52
randint (a, 1, 52)
randint (b, 1, 52)
temp -> setCard (cards (a) -> getCard)
cards (a) -> setCard (cards (b) -> getCard)
cards (b) -> setCard (temp -> getCard)
end for
%for i : 1..52
%put cards (i) -> getCard
% end for
end shuffleDeck
%Function : TopCard
%Input : none
%Output: the value of the top card on the deck
%Purpose : to find the value of the top card on the deck
function TopCard : ^Card
p := p + 1
if cards (p) -> getSelected = false then
cards (p) -> Selected
end if
result cards (p)
end TopCard
end Deck
class Hand
import Card, Mouse, Deck
export sort, print, setY, setHuman, add, useMouse, whatToPlay, remove,
emptyHand
var hand : array 1 .. 20 of ^Card
var size : int := 8
var x : int
var y : int := 20
var human : boolean := false;
for i : 1 .. 20
new hand (i)
end for
procedure sort
var t : ^Card
for n : 1 .. size - 1
for a : 1 .. size
for b : 1 .. size
if hand (a) -> Rank > hand (b) -> Rank then
t -> setCard (hand (a) -> getCard)
hand (a) -> setCard (hand (b) -> getCard)
hand (b) -> setCard (t -> getCard)
end if
end for
end for
end for
end sort
procedure add (newCard : ^Card)
var l : int
var n : string := newCard -> getCard
size := size + 1
for decreasing i : size .. 1
hand (i) -> setCard (n)
end for
hand (size) -> setCard (n)
sort
end add
procedure remove (card : ^Card)
for i : 1 .. size
if hand (i) -> getCard = card -> getCard then
hand (i) := hand (i + 1)
end if
end for
size := size - 1
end remove
function emptyHand():boolean
if size = 0 then
result true
else
result false
end if
end emptyHand
function whatToPlay (pileCard : ^Card) : ^Card
var topC : ^Card
var tCd : ^Deck
var count : int := 1
var done : boolean := false
loop
if pileCard -> Suit = hand (count) -> Suit then
done := true
result (hand (count))
elsif pileCard -> Rank = hand (count) -> Rank then
done := true
result (hand (count))
elsif count > size then
done := true
result pileCard
end if
count := count + 1
exit when done = true
end loop
end whatToPlay
function okayToPlay (pile : ^Card, card : ^Card) : boolean
if card -> Rank = pile -> Rank or card -> Suit = pile -> Suit
then
result true
else
result false
end if
end okayToPlay
function useMouse (pile : ^Card) : ^Card
var buttonnumber, buttonupdown, i : int
var temp : ^Card
var tc : string
loop
if whatToPlay (pile) = pile then
result pile
else
Mouse.ButtonWait ("down", x, y, buttonnumber,
buttonupdown)
if y > 100 and x < 20 then
i := 1
elsif y > 100 and 20 <= x and x < 40 then
i := 2
end if
if (okayToPlay (pile, hand (i))) then
temp -> setCard (hand (i) -> getCard)
remove (hand (i))
result temp
else
result pile
end if
end if
end loop
end useMouse
procedure setY (num : int)
y := num
end setY
procedure print
x:= 0
hand (1) -> printCard (x, y, human)
for i : 2 .. size
x := x + 20
hand (i) -> printCard (x, y, human)
end for
end print
procedure setHuman (h : boolean)
human := h
end setHuman
end Hand
class Game
import Deck, Card, Hand
export play1
var player : array 1 .. 4 of ^Hand
var playerName : array 1 .. 4 of string
var deck : ^Deck
var pile : ^Card
new deck
for i : 1 .. 4
new player (i)
end for
player (1) -> setY (20)
player (2) -> setY (100)
player (3) -> setY (180)
player (4) -> setY (260)
player (1) -> setHuman (true)
new pile
procedure setUp ()
var temp : int
temp := Window.Open ("graphics: 200;100, nocursor, noecho")
put "Please input name: "..
get playerName (1)
if playerName (1) = " " then
playerName (1) := "player 1"
end if
locate (3, 5)
put playerName (1)
playerName (2) := "Bob"
playerName (3) := "Sam"
playerName (4) := "Jen"
Window.Close (temp)
temp := Window.Open ("position:center, graphics:600;600")
end setUp
procedure reDraw ()
cls
for i : 1 .. 4
if i = 1 then
player (i) -> print
else
end if
end for
pile -> printCard (150, 20, true)
end reDraw
procedure deal ()
for i : 1 .. 4
for j : 1 .. 8
player (i) -> add (deck -> TopCard)
player (i) -> print
end for
end for
deck -> shuffleDeck
end deal
procedure play1 ()
var playr : int := 1
var card : ^Card
new card
setUp
deal
loop
if playr = 1 then
card := player (playr) -> useMouse (pile)
else
card := player (playr) -> whatToPlay (pile)
end if
if card = pile then
player (playr) -> add (deck -> TopCard)
else
player (playr) -> remove (card)
pile := card
end if
exit when player (playr) -> emptyHand ()
playr := playr mod 4 + 1
end loop
end play1
end Game
%test main
var w : int
var eD : boolean
var C : ^Card
var D : ^Deck
var H : ^Hand
var G : ^Game
new C
new D
new H
new G
w := Window.Open ("position:center, graphics:600;600")
G -> play1 |
Register
Wiki
Blog
Search
Turing
Chat Room
Members
