oreodave/cantedraw
Archived
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rework player package to use structures and a hash table

Browse Source 
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:
Aryadev Chavali
2025-02-15 20:05:01 +00:00
parent 0c04a32251
commit a56355da7d
2 changed files with 33 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
packages.lisp
View File

@@ -58,13 +58,12 @@
:5d.model) :5d.model)
(:export (:export
:player :player
:players
:error-player-nonexistent :error-player-nonexistent
:error-player-broke :error-player-broke
:player-id :player-balance :player-hand :player-exists? :player-bankrupt? :player-can-pay?
:player-exists? :player-bankrupt? :player-can-bet? :player-debit
:player-pay :player-credit
:player-receive)) :player-set-cards))
(defpackage cantedraw.game (defpackage cantedraw.game
(:nicknames :5d.game) (:nicknames :5d.game)

74
src/player.lisp
View File

@@ -19,21 +19,16 @@
(in-package :cantedraw.player) (in-package :cantedraw.player)
(defun playerp (x) (defstruct player
(and (typep (car x) 'fixnum) (name "Yunkyu" :type string)
(typep (cadr x) 'fixnum) (balance 0 :type integer)
(typep (caddr x) 'cardset))) (hand nil :type (or nil cardset)))
(deftype player () `(and cons (satisfies playerp)))
(deftype players () 'list)
(define-condition error-player-nonexistent (error) (define-condition error-player-nonexistent (error)
((id :initarg :id :reader id)) ((id :initarg :id :reader id))
(:report (:report
(lambda (err stream) (lambda (err stream)
(format stream "Player [~a] is non-existent or malformed" (format stream "Player [~a] is non-existent or malformed" (id err)))))
(id err)))))
(define-condition error-player-broke (error) (define-condition error-player-broke (error)
((id :initarg :id :reader id) ((id :initarg :id :reader id)
@@ -42,44 +37,33 @@
(:report (:report
(lambda (err stream) (lambda (err stream)
(format stream "Player [~a] has balance $~a but $~a requested." (format stream "Player [~a] has balance $~a but $~a requested."
(id err) (id err) (balance err) (required 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) (fn player-can-pay? (id table amount) (-> (symbol hash-table fixnum) boolean)
(car player)) (player-exists? id table)
(->> (gethash id table) player-balance (<= amount)))
(fn player-balance (player) (-> (player) fixnum) (fn player-bankrupt? (id table) (-> (symbol hash-table) boolean)
(cadr player)) (player-exists? id table)
(->> (gethash id table) player-balance (>= 0)))
(fn player-hand (player) (-> (player) cardset) (fn player-debit (id table amount) (-> (symbol hash-table fixnum) fixnum)
(caddr player)) (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) (fn player-credit (id table amount) (-> (symbol hash-table fixnum) fixnum)
(assoc id players)) (player-exists? id table)
(incf (player-balance (gethash id table)) amount))
(fn player-bankrupt? (player) (-> (player) boolean) (fn player-set-cards (id table cards) (-> (symbol hash-table cardset) t)
(<= (cadr player) 0)) (player-exists? id table)
(setf (player-hand (gethash id table)) cards))
(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))