diff options
| -rw-r--r-- | cantedraw.asd | 1 | ||||
| -rw-r--r-- | packages.lisp | 12 | ||||
| -rw-r--r-- | src/player.lisp | 72 |
3 files changed, 85 insertions, 0 deletions
diff --git a/cantedraw.asd b/cantedraw.asd index 5bae167..cf9ddb3 100644 --- a/cantedraw.asd +++ b/cantedraw.asd @@ -8,6 +8,7 @@ (:module "src" :components ((:file "model") + (:file "player") (:file "game") (:file "main")))) :build-operation "program-op" diff --git a/packages.lisp b/packages.lisp index 1898e35..574da08 100644 --- a/packages.lisp +++ b/packages.lisp @@ -48,6 +48,18 @@ ;; Constructors :make-joker :make-deck)) +(defpackage cantedraw.player + (:use :cl + :cantedraw.lib.macros :cantedraw.lib.functions + :cantedraw.model) + (:export + :player + :players + :player-id :player-balance :player-hand + :player-exists? :player-bankrupt? :player-can-bet? + :player-pay + :player-receive)) + (defpackage cantedraw.game (:use :cl :cantedraw.lib.macros :cantedraw.lib.functions diff --git a/src/player.lisp b/src/player.lisp new file mode 100644 index 0000000..7979b25 --- /dev/null +++ b/src/player.lisp @@ -0,0 +1,72 @@ +;;; player.lisp - 2025-02-15 + +;; Copyright (C) 2025 Aryadev Chavali + +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for +;; details. + +;; You may distribute and modify this code under the terms of the GNU General +;; Public License Version 2, which you should have received a copy of along with +;; this program. If not, please go to <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Player management - in particular, financing and hand management. + +;;; Code: + +(in-package :cantedraw.player) + +(defun playerp (x) + (and (typep (car x) 'fixnum) + (typep (cadr x) 'fixnum) + (typep (caddr x) 'cardset))) + +(deftype player () `(and cons (satisfies playerp))) + +(deftype players () 'list) + +(fn player-id (player) (-> (player) fixnum) + (car player)) + +(fn player-balance (player) (-> (player) fixnum) + (cadr player)) + +(fn player-hand (player) (-> (player) cardset) + (caddr player)) + +(fn player-exists? (id players) (-> (fixnum players) boolean) + (assoc id players)) + +(fn player-bankrupt? (player) (-> (player) boolean) + (<= (cadr player) 0)) + +(fn player-can-bet? (min-bet player) (-> (fixnum player) boolean) + (>= (cadr player) min-bet)) + +(fn player-pay (id amount players) (-> (fixnum fixnum players) players) + (let ((p (assoc id players))) + (cond + ((not (typep p 'player)) + (error "Player [~a] does not exist.")) + ((not (player-can-bet? amount p)) + (error "Player [~a] has $~a but needs to pay ~a." + id (player-balance p) amount)) + (t + (destructuring-bind (id balance cards) p + (setf (cdr (assoc id players)) + (list (- balance amount) cards))))) + players)) + +(fn player-receive (id amount players) + (-> (fixnum fixnum players) players) + (let ((p (assoc id players))) + (if (not (typep p 'player)) + (error 'error-player-nonexistent + :id id)) + (destructuring-bind (id balance cards) p + (setf (cdr (assoc id players)) + (list (+ balance amount) cards))) + players)) |