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

Make card a structure

Browse Source 
Card is a structure instead of just a type.  Stronger type checking,
automatic constructor, destructors and existence check.
This commit is contained in:
Aryadev Chavali
2025-02-22 23:00:17 +00:00
parent 62f92114ee
commit a80b64b045
2 changed files with 38 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
packages.lisp
View File

@@ -40,16 +40,18 @@
(:use :cl :5d-lib.macros :5d-lib.functions) (:use :cl :5d-lib.macros :5d-lib.functions)
(:export (:export
;; Types ;; Types
:int-card :rank :suit :card :cardset :int-card :rank :suit :cardset
;; card struct
:card :make-card :card-suit :card-rank :card-p
;; Converters ;; Converters
:int->suit :int->rank :int->card :int->suit :int->rank :int->card
:suit->int :rank->int :card->int :suit->int :rank->int :card->int
;; Comparators ;; Comparators
:suit< :rank< :card< :suit< :rank< :card<
;; Serialisers ;; Serialisers
:suit->str :rank->str :card->str :cardset->str :suit->str :rank->str :cardset->str
;; Constructors ;; Constructors
:make-joker :make-deck)) :make-deck))
(defpackage cantedraw.player (defpackage cantedraw.player
(:nicknames :5d.player) (:nicknames :5d.player)

48
src/model.lisp
View File

@@ -26,16 +26,18 @@
(deftype suit () (deftype suit ()
`(member :Diamonds :Clubs :Hearts :Spades :Joker)) `(member :Diamonds :Clubs :Hearts :Spades :Joker))
(deftype card () `(cons rank suit)) (defstruct card
(rank :Ace :type rank)
(suit :Joker :type suit))
(deftype int-card () `(integer 0 51)) (deftype int-card () `(integer 0 51))
(deftype cardset () `(and list (satisfies cardsetp))) (deftype cardset () `(and list (satisfies cardsetp)))
(fn cardsetp (lst) (-> (list) boolean) (fn cardsetp (lst) (-> (list) boolean)
(every #'(lambda (x) (typep x 'card)) lst)) (every #'card-p lst))
(fn int->suit (n) (-> (int-card) suit) (fn int->suit (n) (-> (fixnum) suit)
(case (floor n 13) (case (floor n 13)
(0 :Diamonds) (0 :Diamonds)
(1 :Clubs) (1 :Clubs)
@@ -51,7 +53,7 @@
(:Spades 3) (:Spades 3)
(t 4))) (t 4)))
(fn int->rank (n) (-> (int-card) rank) (fn int->rank (n) (-> (fixnum) rank)
(let ((n (mod n 13))) (let ((n (mod n 13)))
(case n (case n
(9 :Jack) (9 :Jack)
@@ -68,15 +70,17 @@
(:Ace 12) (:Ace 12)
(t (- rank 2)))) (t (- rank 2))))
(fn int->card (num) (-> (int-card) card) (fn int->card (num) (-> (fixnum) card)
(cons (int->rank num) (make-card :rank (int->rank num)
(int->suit num))) :suit (int->suit num)))
(fn card->int (card) (-> (card) int-card) (fn card->int (card) (-> (card) int-card)
(destructuring-bind (rank . suit) card (with-slots ((rank rank) (suit suit)) card
(->> (suit->int suit) (let ((rank (rank->int rank))
(suit (suit->int suit)))
(->> suit
(* 13) (* 13)
(+ (rank->int rank))))) (+ rank)))))
(fn suit< (s1 s2) (-> (suit suit) boolean) (fn suit< (s1 s2) (-> (suit suit) boolean)
(< (suit->int s1) (suit->int s2))) (< (suit->int s1) (suit->int s2)))
@@ -85,7 +89,8 @@
(< (rank->int r1) (rank->int r2))) (< (rank->int r1) (rank->int r2)))
(fn card< (c1 c2) (-> (card card) boolean) (fn card< (c1 c2) (-> (card card) boolean)
(destructuring-bind ((r1 . s1) (r2 . s2)) (list c1 c2) (with-slots ((r1 rank) (s1 suit)) c1
(with-slots ((r2 rank) (s2 suit)) c2
(cond (cond
;; Check for jokers! ;; Check for jokers!
((and (eq s1 :Joker) ((and (eq s1 :Joker)
@@ -94,7 +99,7 @@
((eq s1 :Joker) nil) ((eq s1 :Joker) nil)
((eq s2 :Joker) t) ((eq s2 :Joker) t)
((eq r1 r2) (suit< s1 s2)) ((eq r1 r2) (suit< s1 s2))
(t (rank< r1 r2))))) (t (rank< r1 r2))))))
(fn suit->str (suit) (-> (suit) string) (fn suit->str (suit) (-> (suit) string)
(case suit (case suit
@@ -112,26 +117,21 @@
(:King "King") (:King "King")
(t (format nil "~a" rank)))) (t (format nil "~a" rank))))
(fn card->str (card) (-> (card) string) (defmethod print-object ((card card) s)
(destructuring-bind (rank . suit) card (with-slots ((rank rank) (suit suit)) card
(if (eq suit :Joker) (if (eq suit :Joker)
"Joker" (format s "Joker")
(format nil "~a[~a]" (format s "~a[~a]"
(rank->str rank) (rank->str rank)
(suit->str suit))))) (suit->str suit)))))
(fn cardset->str (cardset) (-> (cardset) string) (fn cardset->str (cardset) (-> (cardset) string)
(->> cardset (format nil "~{~a~^, ~}" cardset))
(mapcar #'card->str)
(format nil "~{~a~^, ~}")))
(fn make-joker (&optional (rank :ACE)) (-> (&optional rank) card)
(cons rank :Joker))
(fn make-deck (&optional (n 1)) (-> (&optional fixnum) cardset) (fn make-deck (&optional (n 1)) (-> (&optional fixnum) cardset)
(append (append
(loop :for _ :from 1 :to n (loop :for _ :from 1 :to n
:nconc (loop :for j :from 1 :to 52 :nconc (loop :for j :from 1 :to 52
collect (int->card (1- j)))) collect (int->card (1- j))))
(mapcar ($ x int->rank make-joker) (loop :for _ :from 1 :to (* 2 n)
(range 0 (* 2 n))))) :collect (make-card))))