blob: 30eefd5afbc78e4f7bdd24076ec0468155cdab4f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
;;; 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)
(defstruct player
(name "Yunkyu" :type string)
(balance 0 :type integer)
(hand nil :type (or nil cardset)))
(define-condition error-player-nonexistent (error)
((id :initarg :id :reader id))
(:report
(lambda (err stream)
(format stream "Player [~a] is non-existent or malformed" (id err)))))
(define-condition error-player-broke (error)
((id :initarg :id :reader id)
(balance :initarg :balance :reader balance)
(required :initarg :required :reader required))
(:report
(lambda (err stream)
(format stream "Player [~a] has balance $~a but $~a requested."
(id err) (balance err) (required err)))))
(fn player-exists? (id table) (-> (symbol hash-table) boolean)
(let ((item (gethash id table)))
(and item (player-p item))))
(defun error-if-no-player (id table)
(unless (player-exists? id table)
(error 'error-player-nonexistent :id id)))
(fn player-can-pay? (id table amount) (-> (symbol hash-table fixnum) boolean)
(error-if-no-player id table)
(->> (gethash id table) player-balance (<= amount)))
(fn player-bankrupt? (id table) (-> (symbol hash-table) boolean)
(error-if-no-player id table)
(->> (gethash id table) player-balance (>= 0)))
(fn player-debit (id table amount) (-> (symbol hash-table fixnum) fixnum)
(error-if-no-player id table)
(unless (player-can-pay? id table amount)
(error 'error-player-broke
:id id :balance (player-balance (gethash id table)) :required amount))
(-<> id (gethash table) player-balance (decf amount)))
(fn player-credit (id table amount) (-> (symbol hash-table fixnum) fixnum)
(error-if-no-player id table)
(-<> id (gethash table) player-balance (incf amount)))
(fn player-set-cards (id table cards) (-> (symbol hash-table cardset) t)
(error-if-no-player id table)
(-<> id (gethash table) player-hand (setf cards)))
|
