Created
June 9, 2013 04:20
-
-
Save matthew-ball/5737625 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; blackjack.lisp | |
;; Copyleft Matthew Ball (2013) | |
(defclass card () | |
((value :accessor card-value | |
:initarg :name) | |
(suit :accessor card-suit | |
:initarg :suit))) | |
(defclass deck () | |
((card-values :accessor deck-card-choices | |
:initform '(("ace" . (1 . 11)) | |
("two" . 2) | |
("three" . 3) | |
("four" . 4) | |
("five" . 5) | |
("six" . 6) | |
("seven" . 7) | |
("eight" . 8) | |
("nine" . 9) | |
("ten" . 10) | |
("jack" . 10) | |
("queen" . 10) | |
("king" . 10))) | |
(suit-values :accessor deck-suit-choices | |
:initform '("spades" "clubs" "hearts" "diamonds")) | |
(cards :accessor deck-cards | |
:initform nil))) | |
(defclass player () | |
((name :accessor player-name | |
:initarg :name) | |
(hand :accessor player-hand | |
:initform nil) | |
(hand-size :accessor player-hand-size | |
:initform 2))) | |
(defun make-card (name suit) | |
(make-instance 'card :name name :suit suit)) | |
(defun make-deck () | |
(make-instance 'deck)) | |
(defun make-player (name) | |
(make-instance 'player :name name)) | |
;; --- | |
(defvar *deck* (make-deck)) | |
(defvar *players* nil) | |
(defvar *debug* t) | |
(defun add-card-to-deck (card deck) | |
(debug "add card to deck") | |
(push card (deck-cards deck))) | |
(defun delete-nth (n list) | |
(debug "delete nth") | |
(if (zerop n) | |
(cdr list) | |
(let ((cons (nthcdr (1- n) list))) | |
(if cons | |
(setf (cdr cons) (cddr cons)) | |
cons)))) | |
(defun remove-card-from-deck (deck) | |
(debug "remove card from deck") | |
(let* ((num (random (* (length (deck-suit-choices deck)) (length (deck-card-choices deck))))) | |
(card (nth num (deck-cards deck)))) | |
(delete-nth num (deck-cards deck)) | |
card)) | |
(defun deal-card-to-player (deck player) | |
(debug (format nil "deal card to player (~A)" (player-name player))) | |
(push (remove-card-from-deck deck) (player-hand player))) | |
(defun get-player-hand-total (player) | |
(debug (format nil "get player hand total (~A)" (player-name player))) | |
(let ((total 0)) | |
(dolist (card (player-hand player)) | |
(if (string= (car (card-value card)) "ace") | |
(if (< total (cdr (cdr (card-value card)))) | |
(setf total (+ (cdr (cdr (card-value card))) total)) | |
(setf total (+ (car (cdr (card-value card))) total))) | |
(setf total (+ (cdr (card-value card)) total)))) | |
total)) | |
(defun hit-player (player deck) | |
(debug (format nil "hit player ~A" (player-name player))) | |
(deal-card-to-player deck player)) | |
(defun stand () | |
(debug (format nil "stand"))) | |
(defun bust () | |
(debug (format nil "bust"))) | |
;; --- | |
(defun init-deck (deck) | |
(debug "init deck") | |
(dolist (suit (deck-suit-choices deck)) | |
(dolist (card-choice (deck-card-choices deck)) | |
(let ((card (make-card card-choice suit))) | |
(add-card-to-deck card deck))))) | |
(defun init-players () | |
(debug "init players") | |
(let ((pcs nil)) | |
(push (make-player "woolfe") pcs) | |
(push (make-player "bitsy") pcs) | |
(push (make-player "parbs") pcs) | |
(push (make-player "mez") pcs) | |
(push (make-player "chu") pcs) | |
pcs)) | |
(defun init-deal-player-hands (players deck) | |
(debug "init deal player hands") | |
(dolist (player players) | |
(loop for i from 1 to (player-hand-size player) do | |
(deal-card-to-player deck player)))) | |
;; --- | |
(defun debug (string) | |
(when *debug* | |
(print string))) | |
(defun print-card (card) | |
(print (format nil "name: ~A; suit: ~A" (car (card-value card)) (card-suit card)))) | |
(defun print-players-hands (players) | |
(dolist (player players) | |
(print (format nil "name: ~A" (player-name player))) | |
(dolist (card (player-hand player)) | |
(print-card card)) | |
(print (format nil "hand: ~A" (get-player-hand-total player))))) | |
(defun print-deck (deck) | |
(dolist (card (deck-cards deck)) | |
(print-card card))) | |
;; --- | |
(defun reset-game () | |
(setf *deck* (make-deck)) | |
(setf (deck-cards *deck*) nil) | |
(dolist (player *players*) | |
(setf (player-hand player) nil)) | |
(setf *players* nil)) | |
(defun turn-game () | |
(dolist (player *players*) | |
;;hit | |
(when (< (get-player-hand-total player) 20) | |
(hit-player player *deck*)) | |
;;stand | |
(when (eq (get-player-hand-total player) 21) | |
(stand)) | |
;;split | |
;; TODO: ... | |
;;bust | |
(when (> (get-player-hand-total player) 21) | |
(bust)) | |
)) | |
(defun start-game () | |
(init-deck *deck*) | |
(setf *players* (init-players)) | |
(init-deal-player-hands *players* *deck*) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment