|
(deftemplate card |
|
(slot rank) |
|
(slot suit)) |
|
|
|
(deftemplate deck |
|
(multislot cards)) |
|
|
|
(deffunction hand-value ($?cards) |
|
(bind ?hand-value 0) |
|
(bind ?aces 0) |
|
(foreach ?card ?cards |
|
(if (eq Ace (fact-slot-value ?card rank)) then (bind ?aces (+ 1 ?aces))) |
|
(bind ?hand-value |
|
(+ ?hand-value (switch (fact-slot-value ?card rank) |
|
(case Ace then 1) |
|
(case King then 10) |
|
(case Queen then 10) |
|
(case Jack then 10) |
|
(default (fact-slot-value ?card rank)))))) |
|
(if (and (< 0 ?aces) (<= ?hand-value 11)) |
|
then (bind ?hand-value (+ ?hand-value 10))) |
|
(return ?hand-value)) |
|
|
|
(deffunction print-card (?card) |
|
(switch (fact-slot-value ?card suit) |
|
(case clubs then (print ♣)) |
|
(case spades then (print ♠)) |
|
(case hearts then (print ♥)) |
|
(case diamonds then (print ♦))) |
|
(print (fact-slot-value ?card rank))) |
|
|
|
(deffunction announce-player-hand (?name $?cards) |
|
(println ?name) |
|
(printout t "(" (hand-value ?cards) ") ") |
|
(foreach ?card ?cards |
|
(print-card ?card) |
|
(if (neq ?card (nth$ (length$ ?cards) ?cards)) then (print ", "))) |
|
(println)) |
|
|
|
(deffunction announce-scoreboard (?player1name ?player1cards ?player2name ?player2cards) |
|
(println) |
|
(println "== Scoreboard =====") |
|
(announce-player-hand ?player1name ?player1cards) |
|
(println) |
|
(announce-player-hand ?player2name ?player2cards) |
|
(println "===================")) |
|
|
|
(deffacts init |
|
(suit clubs) |
|
(suit spades) |
|
(suit hearts) |
|
(suit diamonds) |
|
(rank 2) |
|
(rank 3) |
|
(rank 4) |
|
(rank 5) |
|
(rank 6) |
|
(rank 7) |
|
(rank 8) |
|
(rank 9) |
|
(rank 10) |
|
(rank Jack) |
|
(rank Queen) |
|
(rank King) |
|
(rank Ace)) |
|
|
|
(defrule shuffle |
|
=> |
|
(seed (integer (time))) |
|
(bind ?cards (create$)) |
|
(do-for-all-facts ((?s suit) (?r rank)) TRUE |
|
(bind ?cards (create$ ?cards (assert (card (suit (nth$ 1 ?s:implied)) (rank (nth$ 1 ?r:implied))))))) |
|
(loop-for-count (?from 1 52) |
|
(bind ?to (random 1 52)) |
|
(bind ?cards |
|
(replace$ (replace$ ?cards ?from ?from (nth$ ?to ?cards)) ?to ?to (nth$ ?from ?cards)))) |
|
(assert (deck (cards ?cards)))) |
|
|
|
(defrule deal-cards |
|
?deck <- (deck (cards $?cards&:(= (length$ ?cards) 52))) |
|
=> |
|
(assert (player-hand (create$ (nth$ 1 ?cards) (nth$ 3 ?cards)))) |
|
(assert (dealer-hand (create$ (nth$ 2 ?cards) (nth$ 4 ?cards)))) |
|
(modify ?deck (cards (subseq$ ?cards 5 52)))) |
|
|
|
(defrule prompt-user-for-choice |
|
(player-hand $?cards&:(> 21 (hand-value ?cards))) |
|
(dealer-hand $?d&:(> 21 (hand-value ?d))) |
|
(not (player-choice ?)) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(printout t "Hit or Stay (h/s)?: ") |
|
(assert (player-choice (readline)))) |
|
|
|
(defrule wrong-choice |
|
?p <- (player-choice ~"h"&~"s") |
|
=> |
|
(println "Invalid choice") |
|
(retract ?p)) |
|
|
|
(defrule player-hit |
|
?choice <- (player-choice "h") |
|
?hand <- (player-hand $?c) |
|
?deck <- (deck (cards ?top $?cards)) |
|
=> |
|
(retract ?choice ?hand) |
|
(println) |
|
(printout t "--> Player hits and draws ") |
|
(print-card ?top) |
|
(println) |
|
(assert (player-hand ?c ?top)) |
|
(modify ?deck (cards ?cards))) |
|
|
|
(defrule player-bust |
|
(player-hand $?cards&:(> (hand-value ?cards) 21)) |
|
(dealer-hand $?d) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Player busted! Game over...")) |
|
|
|
(defrule dealer-hit |
|
(player-hand $?p) |
|
?hand <- (dealer-hand $?c&:(> 17 (hand-value ?c))) |
|
?deck <- (deck (cards ?top $?cards)) |
|
(or |
|
(player-choice "s") |
|
(and |
|
(test (< 2 (length$ ?p))) |
|
(test (= 21 (hand-value ?p))))) |
|
=> |
|
(retract ?hand) |
|
(println) |
|
(printout t "--> Dealer hits and draws ") |
|
(print-card ?top) |
|
(println) |
|
(assert (dealer-hand ?c ?top)) |
|
(modify ?deck (cards (subseq$ ?cards 2 (length$ ?cards))))) |
|
|
|
(defrule dealer-blackjack |
|
(player-hand $?cards&:(> 21 (hand-value ?cards))) |
|
(dealer-hand $?d&:(= (hand-value ?d) 21)&:(= 2 (length$ ?d))) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Dealer blackjack, automatic loss :(")) |
|
|
|
(defrule player-blackjack |
|
(player-hand $?cards&:(= 2 (length$ ?cards))&:(= 21 (hand-value ?cards))) |
|
(dealer-hand $?d&:(<> (hand-value ?d) 21)) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Player blackjack! You win!")) |
|
|
|
(defrule push |
|
(player-hand $?cards&:(>= 21 (hand-value ?cards))) |
|
(dealer-hand $?d&:(>= (hand-value ?d) 17)) |
|
(test (= (hand-value ?cards) (hand-value ?d))) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Push (Tie)...")) |
|
|
|
(defrule player-wins |
|
(player-hand $?cards) |
|
(dealer-hand $?d&:(>= (hand-value ?d) 17)) |
|
(test (> (hand-value ?cards) (hand-value ?d))) |
|
(test (or |
|
(and (= 2 (length$ ?cards)) (> 21 (hand-value ?cards))) |
|
(and (< 2 (length$ ?cards)) (>= 21 (hand-value ?cards))))) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Player wins!")) |
|
|
|
(defrule dealer-wins |
|
(player-hand $?cards&:(> 21 (hand-value ?cards))) |
|
(dealer-hand $?d&:(>= (hand-value ?d) 17)&:(>= 21 (hand-value ?d))) |
|
(player-choice "s") |
|
(test (< (hand-value ?cards) (hand-value ?d))) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Dealer wins...")) |
|
|
|
(defrule dealer-busted |
|
(player-hand $?cards) |
|
(dealer-hand $?d&:(> (hand-value ?d) 21)) |
|
=> |
|
(announce-scoreboard Player ?cards Dealer ?d) |
|
(println) |
|
(println "--> Dealer busted. Player wins!")) |
