Rework player package to use structures and a hash table
Instead of an association list and a type contract, let's use a hash table and a structure. This is: more explicit, encapsulates state more effectively, generates much of the cruft (constructors, destructors) for me. A hash table is more efficient when considering large player bases. In particular, we'll be generating unique player IDs to make it a bit more difficult for a malicious agent to guess another player's ID and make bad requests.
This commit is contained in:
@@ -58,13 +58,12 @@
|
||||
:5d.model)
|
||||
(:export
|
||||
:player
|
||||
:players
|
||||
:error-player-nonexistent
|
||||
:error-player-broke
|
||||
:player-id :player-balance :player-hand
|
||||
:player-exists? :player-bankrupt? :player-can-bet?
|
||||
:player-pay
|
||||
:player-receive))
|
||||
:player-exists? :player-bankrupt? :player-can-pay?
|
||||
:player-debit
|
||||
:player-credit
|
||||
:player-set-cards))
|
||||
|
||||
(defpackage cantedraw.game
|
||||
(:nicknames :5d.game)
|
||||
|
||||
@@ -19,21 +19,16 @@
|
||||
|
||||
(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)
|
||||
(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)))))
|
||||
(format stream "Player [~a] is non-existent or malformed" (id err)))))
|
||||
|
||||
(define-condition error-player-broke (error)
|
||||
((id :initarg :id :reader id)
|
||||
@@ -42,44 +37,33 @@
|
||||
(:report
|
||||
(lambda (err stream)
|
||||
(format stream "Player [~a] has balance $~a but $~a requested."
|
||||
(id err)
|
||||
(balance err)
|
||||
(required err)))))
|
||||
(id err) (balance err) (required err)))))
|
||||
|
||||
(fn player-exists? (id table) (-> (symbol hash-table) boolean)
|
||||
(if (or (null (gethash id table))
|
||||
(not (player-p (gethash id table))))
|
||||
(error 'error-player-nonexistent :id id)
|
||||
t))
|
||||
|
||||
(fn player-id (player) (-> (player) fixnum)
|
||||
(car player))
|
||||
(fn player-can-pay? (id table amount) (-> (symbol hash-table fixnum) boolean)
|
||||
(player-exists? id table)
|
||||
(->> (gethash id table) player-balance (<= amount)))
|
||||
|
||||
(fn player-balance (player) (-> (player) fixnum)
|
||||
(cadr player))
|
||||
(fn player-bankrupt? (id table) (-> (symbol hash-table) boolean)
|
||||
(player-exists? id table)
|
||||
(->> (gethash id table) player-balance (>= 0)))
|
||||
|
||||
(fn player-hand (player) (-> (player) cardset)
|
||||
(caddr player))
|
||||
(fn player-debit (id table amount) (-> (symbol hash-table fixnum) fixnum)
|
||||
(player-exists? id table)
|
||||
(if (not (player-can-pay? id table amount))
|
||||
(error 'error-player-broke
|
||||
:id id :balance (player-balance (gethash id table)) :required amount))
|
||||
(decf (player-balance (gethash id table)) amount))
|
||||
|
||||
(fn player-exists? (id players) (-> (fixnum players) boolean)
|
||||
(assoc id players))
|
||||
(fn player-credit (id table amount) (-> (symbol hash-table fixnum) fixnum)
|
||||
(player-exists? id table)
|
||||
(incf (player-balance (gethash id table)) amount))
|
||||
|
||||
(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)))
|
||||
(if (not (typep p 'player))
|
||||
(error 'error-player-nonexistent :id id))
|
||||
(if (not (player-can-bet? amount p))
|
||||
(error 'error-player-broke
|
||||
:id id
|
||||
:balance (player-balance p)
|
||||
:required amount))
|
||||
(decf (cadr (assoc id players)) amount))
|
||||
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))
|
||||
(incf (cadr (assoc id players)) amount)
|
||||
players))
|
||||
(fn player-set-cards (id table cards) (-> (symbol hash-table cardset) t)
|
||||
(player-exists? id table)
|
||||
(setf (player-hand (gethash id table)) cards))
|
||||
|
||||
Reference in New Issue
Block a user