shen/release/test_programs/whist.shen in shen-ruby-0.10.0 vs shen/release/test_programs/whist.shen in shen-ruby-0.11.0
- old
+ new
@@ -1,240 +1,240 @@
-(synonyms
- card (rank * suit)
- cscore number
- pscore number )
-
-(datatype rank
-
- if (element? Rank [2 3 4 5 6 7 8 9 10 11 12 13 14])
- ___________________________________________________
- Rank : rank;
-
- Rank : rank;
- ___________
- Rank : number;)
-
-(datatype suit
-
- if (element? Suit [c d h s])
- ____________________________
- Suit : suit;)
-
-(datatype lead
-
- if (element? L [player computer])
- _________________________________
- L : lead;)
-
-(define whist
- {lead --> string}
- Lead -> (whist-loop (deal-whist 13 (deck _) (@p [] [])) 0 0 Lead))
-
-(define deck
- {A --> (list card)}
- _ -> (cartprod [2 3 4 5 6 7 8 9 10 11 12 13 14] [c d h s]))
-
-(define cartprod
- {(list A) --> (list B) --> (list (A * B))}
- [] _ -> []
- [X | Y] Z -> (append (map (/. W (@p X W)) Z) (cartprod Y Z)))
-
-(define deal-whist
- {number --> (list card) --> ((list card) * (list card)) --> ((list card) * (list card))}
- 0 _ (@p Computer Player) -> (@p Computer Player)
- N Deck (@p Computer Player)
- -> (let CCard (deal-card Deck)
- Deck-1 (remove CCard Deck)
- PCard (deal-card Deck-1)
- Deck-2 (remove PCard Deck-1)
- (deal-whist (- N 1) Deck-2 (@p [CCard | Computer] [PCard | Player]))))
-
-(define deal-card
- {(list card) --> card}
- Cards -> (nth (+ (random (length Cards)) 1) Cards))
-
-(define random
- {A --> A}
- X -> X)
-
-(define whist-loop
- {((list card) * (list card)) --> cscore --> pscore --> lead --> string}
- Hands Cscore Pscore _
- -> (if (> Cscore Pscore)
- (output "~%Computer tricks: ~A, Player tricks: ~A; ~%Computer wins!~%"
- Cscore Pscore)
- (output "~%Computer tricks: ~A, Player tricks: ~A; ~%You win!~%"
- Cscore Pscore))
- where (game-over? Hands)
- (@p Computer Player) Cscore Pscore computer
- -> (let Ccard (computer-shows (play-computer-lead Computer))
- Pcard (determine-legal (play-player Player) Ccard Player)
- Winner (return-winner (determine-winner Ccard Pcard computer))
- Computer-1 (remove Ccard Computer)
- Player-1 (remove Pcard Player)
- (if (= Winner computer)
- (whist-loop (@p Computer-1 Player-1)
- (+ 1 Cscore)
- Pscore
- computer)
- (whist-loop (@p Computer-1 Player-1)
- Cscore
- (+ Pscore 1)
- player)))
- (@p Computer Player) Cscore Pscore player
- -> (let Pcard (play-player Player)
- Ccard (computer-shows (play-computer-follow Computer Pcard))
- Winner (return-winner (determine-winner Ccard Pcard player))
- Computer-1 (remove Ccard Computer)
- Player-1 (remove Pcard Player)
- (if (= Winner computer)
- (whist-loop (@p Computer-1 Player-1)
- (+ 1 Cscore)
- Pscore
- computer)
- (whist-loop (@p Computer-1 Player-1)
- Cscore
- (+ Pscore 1)
- player))))
-
-(define determine-legal
- {card --> card --> (list card) --> card}
- Pcard Ccard Player -> Pcard where (legal? Pcard Ccard Player)
- _ Ccard Player -> (do (output "You must follow suit!" [])
- (determine-legal (play-player Player)
- Ccard
- Player)))
-
-(define legal?
- {card --> card --> (list card) --> boolean}
- (@p _ Suit) (@p _ Suit) _ -> true
- _ (@p _ Suit) Player -> (void-of-suit? Suit Player))
-
-(define void-of-suit?
- {suit --> (list card) --> boolean}
- Suit Player -> (empty? (same-suit Player Suit)))
-
-(define same-suit
- {(list card) --> suit --> (list card)}
- [] _ -> []
- [(@p Rank Suit) | Cards] Suit -> [(@p Rank Suit) | (same-suit Cards Suit)]
- [_ | Cards] Suit -> (same-suit Cards Suit))
-
-(define determine-winner
- {card --> card --> lead --> lead}
- (@p Rank1 Suit) (@p Rank2 Suit) _ -> (if (> Rank1 Rank2) computer player)
- _ _ Lead -> Lead)
-
-(define return-winner
- {lead --> lead}
- computer -> (do (output "~%Computer wins the trick.~%____________________________________________~%" [])
- computer)
- player -> (do (output "~%Player wins the trick.~%____________________________________________~%" [])
- player))
-
-(define game-over?
- {((list card) * (list card)) --> boolean}
- (@p [] []) -> true
- _ -> false)
-
-(define play-computer-lead
- {(list card) --> card}
- Cards -> (select-highest Cards))
-
-(define computer-shows
- {card --> card}
- (@p Rank Suit) -> (do (output "~%Computer plays the ~A of ~A~%"
- (map-rank Rank) (map-suit Suit))
- (@p Rank Suit)))
-
-(define map-rank
- {rank --> string}
- 14 -> "ace"
- 13 -> "king"
- 12 -> "queen"
- 11 -> "jack"
- N -> (make-string "~A" N))
-
-(define map-suit
- {suit --> string}
- c -> "c#5;"
- d -> "c#4;"
- h -> "c#3;"
- s -> "c#6;")
-
-(define select-highest
- {(list card) --> card}
- [Card | Cards] -> (select-highest-help Card Cards))
-
-(define select-highest-help
- {card --> (list card) --> card}
- Card [] -> Card
- Card1 [Card2 | Cards]
- -> (select-highest-help Card2 Cards) where (higher? Card2 Card1)
- Card [_ | Cards] -> (select-highest-help Card Cards))
-
-(define higher?
- {card --> card --> boolean}
- (@p Rank1 _) (@p Rank2 _) -> (> Rank1 Rank2))
-
-(define play-computer-follow
- {(list card) --> card --> card}
- Cards (@p Rank Suit)
- -> (let FollowSuit (sort lower? (same-suit Cards Suit))
- (if (empty? FollowSuit)
- (select-lowest Cards)
- (let Ccard (select-higher (@p Rank Suit) FollowSuit)
- (if (= (determine-winner Ccard (@p Rank Suit) player) computer)
- Ccard
- (head FollowSuit))))))
-
-(define sort
- {(A --> A --> boolean) --> (list A) --> (list A)}
- R X -> (fix (/. Y (sort-help R Y)) X))
-
-(define sort-help
- {(A --> A --> boolean) --> (list A) --> (list A)}
- _ [] -> []
- _ [X] -> [X]
- R [X Y | Z] -> [Y | (sort-help R [X | Z])] where (R Y X)
- R [X | Y] -> [X | (sort-help R Y)])
-
-(define select-higher
- {card --> (list card) --> card}
- _ [Card] -> Card
- Card1 [Card2 | _] -> Card2 where (higher? Card2 Card1)
- Card [_ | Cards] -> (select-higher Card Cards))
-
-(define select-lowest
- {(list card) --> card}
- [Card | Cards] -> (select-lowest-help Card Cards))
-
-(define select-lowest-help
- {card --> (list card) --> card}
- Card [] -> Card
- Card1 [Card2 | Cards]
- -> (select-lowest-help Card2 Cards) where (lower? Card2 Card1)
- Card [_ | Cards] -> (select-lowest-help Card Cards))
-
-(define lower?
- {card --> card --> boolean}
- (@p Rank1 _) (@p Rank2 _) -> (< Rank1 Rank2))
-
-(define play-player
- {(list card) --> card}
- Cards -> (do (output "~%Your hand is ~%~%")
- (show-cards 1 Cards)
- (let N (input+ number)
- (if (in-range? N Cards)
- (nth N Cards)
- (play-player Cards)))))
-
-(define show-cards
- {number --> (list card) --> string}
- _ [] -> (output "~%~%Choose a Card: ")
- N [(@p Rank Suit) | Cards]
- -> (do (output "~%~A. ~A of ~A" N (map-rank Rank) (map-suit Suit))
- (show-cards (+ N 1) Cards)))
-
-(define in-range?
- {number --> (list card) --> boolean}
+(synonyms
+ card (rank * suit)
+ cscore number
+ pscore number )
+
+(datatype rank
+
+ if (element? Rank [2 3 4 5 6 7 8 9 10 11 12 13 14])
+ ___________________________________________________
+ Rank : rank;
+
+ Rank : rank;
+ ___________
+ Rank : number;)
+
+(datatype suit
+
+ if (element? Suit [c d h s])
+ ____________________________
+ Suit : suit;)
+
+(datatype lead
+
+ if (element? L [player computer])
+ _________________________________
+ L : lead;)
+
+(define whist
+ {lead --> string}
+ Lead -> (whist-loop (deal-whist 13 (deck _) (@p [] [])) 0 0 Lead))
+
+(define deck
+ {A --> (list card)}
+ _ -> (cartprod [2 3 4 5 6 7 8 9 10 11 12 13 14] [c d h s]))
+
+(define cartprod
+ {(list A) --> (list B) --> (list (A * B))}
+ [] _ -> []
+ [X | Y] Z -> (append (map (/. W (@p X W)) Z) (cartprod Y Z)))
+
+(define deal-whist
+ {number --> (list card) --> ((list card) * (list card)) --> ((list card) * (list card))}
+ 0 _ (@p Computer Player) -> (@p Computer Player)
+ N Deck (@p Computer Player)
+ -> (let CCard (deal-card Deck)
+ Deck-1 (remove CCard Deck)
+ PCard (deal-card Deck-1)
+ Deck-2 (remove PCard Deck-1)
+ (deal-whist (- N 1) Deck-2 (@p [CCard | Computer] [PCard | Player]))))
+
+(define deal-card
+ {(list card) --> card}
+ Cards -> (nth (+ (random (length Cards)) 1) Cards))
+
+(define random
+ {A --> A}
+ X -> X)
+
+(define whist-loop
+ {((list card) * (list card)) --> cscore --> pscore --> lead --> string}
+ Hands Cscore Pscore _
+ -> (if (> Cscore Pscore)
+ (output "~%Computer tricks: ~A, Player tricks: ~A; ~%Computer wins!~%"
+ Cscore Pscore)
+ (output "~%Computer tricks: ~A, Player tricks: ~A; ~%You win!~%"
+ Cscore Pscore))
+ where (game-over? Hands)
+ (@p Computer Player) Cscore Pscore computer
+ -> (let Ccard (computer-shows (play-computer-lead Computer))
+ Pcard (determine-legal (play-player Player) Ccard Player)
+ Winner (return-winner (determine-winner Ccard Pcard computer))
+ Computer-1 (remove Ccard Computer)
+ Player-1 (remove Pcard Player)
+ (if (= Winner computer)
+ (whist-loop (@p Computer-1 Player-1)
+ (+ 1 Cscore)
+ Pscore
+ computer)
+ (whist-loop (@p Computer-1 Player-1)
+ Cscore
+ (+ Pscore 1)
+ player)))
+ (@p Computer Player) Cscore Pscore player
+ -> (let Pcard (play-player Player)
+ Ccard (computer-shows (play-computer-follow Computer Pcard))
+ Winner (return-winner (determine-winner Ccard Pcard player))
+ Computer-1 (remove Ccard Computer)
+ Player-1 (remove Pcard Player)
+ (if (= Winner computer)
+ (whist-loop (@p Computer-1 Player-1)
+ (+ 1 Cscore)
+ Pscore
+ computer)
+ (whist-loop (@p Computer-1 Player-1)
+ Cscore
+ (+ Pscore 1)
+ player))))
+
+(define determine-legal
+ {card --> card --> (list card) --> card}
+ Pcard Ccard Player -> Pcard where (legal? Pcard Ccard Player)
+ _ Ccard Player -> (do (output "You must follow suit!" [])
+ (determine-legal (play-player Player)
+ Ccard
+ Player)))
+
+(define legal?
+ {card --> card --> (list card) --> boolean}
+ (@p _ Suit) (@p _ Suit) _ -> true
+ _ (@p _ Suit) Player -> (void-of-suit? Suit Player))
+
+(define void-of-suit?
+ {suit --> (list card) --> boolean}
+ Suit Player -> (empty? (same-suit Player Suit)))
+
+(define same-suit
+ {(list card) --> suit --> (list card)}
+ [] _ -> []
+ [(@p Rank Suit) | Cards] Suit -> [(@p Rank Suit) | (same-suit Cards Suit)]
+ [_ | Cards] Suit -> (same-suit Cards Suit))
+
+(define determine-winner
+ {card --> card --> lead --> lead}
+ (@p Rank1 Suit) (@p Rank2 Suit) _ -> (if (> Rank1 Rank2) computer player)
+ _ _ Lead -> Lead)
+
+(define return-winner
+ {lead --> lead}
+ computer -> (do (output "~%Computer wins the trick.~%____________________________________________~%" [])
+ computer)
+ player -> (do (output "~%Player wins the trick.~%____________________________________________~%" [])
+ player))
+
+(define game-over?
+ {((list card) * (list card)) --> boolean}
+ (@p [] []) -> true
+ _ -> false)
+
+(define play-computer-lead
+ {(list card) --> card}
+ Cards -> (select-highest Cards))
+
+(define computer-shows
+ {card --> card}
+ (@p Rank Suit) -> (do (output "~%Computer plays the ~A of ~A~%"
+ (map-rank Rank) (map-suit Suit))
+ (@p Rank Suit)))
+
+(define map-rank
+ {rank --> string}
+ 14 -> "ace"
+ 13 -> "king"
+ 12 -> "queen"
+ 11 -> "jack"
+ N -> (make-string "~A" N))
+
+(define map-suit
+ {suit --> string}
+ c -> "c#5;"
+ d -> "c#4;"
+ h -> "c#3;"
+ s -> "c#6;")
+
+(define select-highest
+ {(list card) --> card}
+ [Card | Cards] -> (select-highest-help Card Cards))
+
+(define select-highest-help
+ {card --> (list card) --> card}
+ Card [] -> Card
+ Card1 [Card2 | Cards]
+ -> (select-highest-help Card2 Cards) where (higher? Card2 Card1)
+ Card [_ | Cards] -> (select-highest-help Card Cards))
+
+(define higher?
+ {card --> card --> boolean}
+ (@p Rank1 _) (@p Rank2 _) -> (> Rank1 Rank2))
+
+(define play-computer-follow
+ {(list card) --> card --> card}
+ Cards (@p Rank Suit)
+ -> (let FollowSuit (sort lower? (same-suit Cards Suit))
+ (if (empty? FollowSuit)
+ (select-lowest Cards)
+ (let Ccard (select-higher (@p Rank Suit) FollowSuit)
+ (if (= (determine-winner Ccard (@p Rank Suit) player) computer)
+ Ccard
+ (head FollowSuit))))))
+
+(define sort
+ {(A --> A --> boolean) --> (list A) --> (list A)}
+ R X -> (fix (/. Y (sort-help R Y)) X))
+
+(define sort-help
+ {(A --> A --> boolean) --> (list A) --> (list A)}
+ _ [] -> []
+ _ [X] -> [X]
+ R [X Y | Z] -> [Y | (sort-help R [X | Z])] where (R Y X)
+ R [X | Y] -> [X | (sort-help R Y)])
+
+(define select-higher
+ {card --> (list card) --> card}
+ _ [Card] -> Card
+ Card1 [Card2 | _] -> Card2 where (higher? Card2 Card1)
+ Card [_ | Cards] -> (select-higher Card Cards))
+
+(define select-lowest
+ {(list card) --> card}
+ [Card | Cards] -> (select-lowest-help Card Cards))
+
+(define select-lowest-help
+ {card --> (list card) --> card}
+ Card [] -> Card
+ Card1 [Card2 | Cards]
+ -> (select-lowest-help Card2 Cards) where (lower? Card2 Card1)
+ Card [_ | Cards] -> (select-lowest-help Card Cards))
+
+(define lower?
+ {card --> card --> boolean}
+ (@p Rank1 _) (@p Rank2 _) -> (< Rank1 Rank2))
+
+(define play-player
+ {(list card) --> card}
+ Cards -> (do (output "~%Your hand is ~%~%")
+ (show-cards 1 Cards)
+ (let N (input+ number)
+ (if (in-range? N Cards)
+ (nth N Cards)
+ (play-player Cards)))))
+
+(define show-cards
+ {number --> (list card) --> string}
+ _ [] -> (output "~%~%Choose a Card: ")
+ N [(@p Rank Suit) | Cards]
+ -> (do (output "~%~A. ~A of ~A" N (map-rank Rank) (map-suit Suit))
+ (show-cards (+ N 1) Cards)))
+
+(define in-range?
+ {number --> (list card) --> boolean}
N Cards -> (and (integer? N) (and (> N 0) (<= N (length Cards)))))
\ No newline at end of file