diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | README.txt | 3 | ||||
| -rw-r--r-- | cantedraw.asd | 5 | ||||
| -rw-r--r-- | lib/functions.lisp | 19 | ||||
| -rw-r--r-- | lib/macros.lisp | 5 | ||||
| -rw-r--r-- | packages.lisp | 18 | ||||
| -rw-r--r-- | src/game.lisp | 4 | ||||
| -rw-r--r-- | src/main.lisp | 5 | ||||
| -rw-r--r-- | src/model.lisp | 4 | ||||
| -rw-r--r-- | src/player.lisp | 10 | ||||
| -rw-r--r-- | tests/test.lisp | 70 |
11 files changed, 76 insertions, 69 deletions
@@ -1,3 +1,3 @@ TAGS bin/ -/system-index.txt +system-index.txt @@ -23,4 +23,5 @@ Requirements: Run: $ ./build -to compile the program. +to compile the program. Binary artifact should be located under +`./bin/cantedraw`. diff --git a/cantedraw.asd b/cantedraw.asd index 617a0ce..1f0430c 100644 --- a/cantedraw.asd +++ b/cantedraw.asd @@ -2,7 +2,7 @@ :author "Aryadev Chavali <aryadev@aryadevchavali.com>" :license "GPL-2" :depends-on (:alexandria) - :in-order-to ((asdf:test-op (asdf:test-op :cantedraw/tests))) + :in-order-to ((test-op (test-op :cantedraw/tests))) :components ((:file "packages") (:module "lib" :components @@ -26,8 +26,7 @@ :components ((:module "tests" :components ((:file "test")))) - :perform (test-op (op c) (uiop:symbol-call :parachute :test - :cantedraw/tests/main))) + :perform (test-op (op c) (uiop:symbol-call :parachute :test :cantedraw/tests/main))) ;; Compress image for smaller binary size. #+nil diff --git a/lib/functions.lisp b/lib/functions.lisp index daeac0a..12b1df5 100644 --- a/lib/functions.lisp +++ b/lib/functions.lisp @@ -19,21 +19,21 @@ (in-package :cantedraw.lib.functions) -(fn range (start end &optional (step 1)) (-> (fixnum fixnum &optional fixnum) list) - "Make a list of numbers from START to END (exclusive). If STEP is given, then -each member is STEP distance apart." +(fn range (&key (start 0) (end 0) (step 1)) + (-> (&key (:start fixnum) (:end fixnum) (:step fixnum)) + list) + "Return list of integers in interval [START, END). If STEP is given, then +each member is STEP distance apart i.e. {START + n * STEP | n from 0}. + +If END is not given, return interval [0, START)." (if (< end start) (error (format nil "~a < ~a" end start)) (loop :for i :from start :to (1- end) :by step :collect i))) -(fn take (n lst) (-> (fixnum sequence) sequence) - "Return the first N elements of LST." - (subseq lst 0 n)) - (fn split (n lst) (-> (fixnum sequence) (values sequence sequence)) "Return CONS where CAR is the first N elements of LST and CDR is the rest." - (values (take n lst) + (values (subseq lst 0 n) (subseq lst n))) (fn rev-map (indicator lst &key (key-eq #'eq)) @@ -60,6 +60,3 @@ where key x in A has associations {y in LST : INDICATOR(y) = x}." :for item :in (coerce lst 'list) :if (not (member i indices)) :collect item)) - -(fn sort* (func lst) (-> (function sequence) sequence) - (sort lst func)) diff --git a/lib/macros.lisp b/lib/macros.lisp index c60b867..2c4bdd8 100644 --- a/lib/macros.lisp +++ b/lib/macros.lisp @@ -124,3 +124,8 @@ sequentially via ->>" (defmacro alist-val (key alist) "Helper macro for getting the value of KEY in ALIST." `(cdr (assoc ,key ,alist))) + +(defmacro call-rev (func-name &rest arguments) + "Call a function with arguments but in reverse +i.e. (call-rev f x1 x2 ... xn) => (f xn ... x2 x1)." + `(,func-name ,@(reverse arguments))) diff --git a/packages.lisp b/packages.lisp index 1c5f889..70d01ee 100644 --- a/packages.lisp +++ b/packages.lisp @@ -22,7 +22,7 @@ (:use :cl) (:export :--> :->> :-<> - :-> :fn + :-> :fn :call-rev :while :alist-val :$-> :$>> :$<>)) @@ -30,9 +30,8 @@ (:nicknames :5d-lib.functions) (:use :cl :5d-lib.macros) (:export - :parse-integer* :sort* - :range :take :split - :rev-map + :parse-integer* + :range :split :rev-map :remove-at-indices)) (defpackage cantedraw.model @@ -40,7 +39,7 @@ (:use :cl :5d-lib.macros :5d-lib.functions) (:export ;; Types - :int-card :rank :suit :cardset + :int-card :rank :suit :cardset :cardset-p ;; card struct :card :make-card :card-suit :card-rank :card-p ;; Converters @@ -59,9 +58,10 @@ :5d-lib.macros :5d-lib.functions :5d.model) (:export - :player - :error-player-nonexistent - :error-player-broke + ;; player struct + :player :make-player :player-name :player-balance :player-hand :player-p + :make-player-table + :error-player-nonexistent :error-player-broke :player-exists? :player-bankrupt? :player-can-pay? :player-debit :player-credit @@ -81,5 +81,5 @@ (:nicknames :5d.main) (:use :cl :5d-lib.macros :5d-lib.functions - :5d.model :5d.game) + :5d.model :5d.player :5d.game) (:export :start)) diff --git a/src/game.lisp b/src/game.lisp index e9f234f..47831f4 100644 --- a/src/game.lisp +++ b/src/game.lisp @@ -19,8 +19,8 @@ (in-package :cantedraw.game) -(fn deal-cards (n deck) (-> (fixnum cardset) (cons cardset cardset)) - (destructuring-bind (hand . rest) (split n deck) +(fn deal-cards (n deck) (-> (fixnum cardset) (cons cardset )) + (multiple-value-bind (hand rest) (split n deck) (cons (sort hand #'card<) rest))) (fn deal-hands (n deck) (-> (fixnum cardset) (cons list cardset)) diff --git a/src/main.lisp b/src/main.lisp index d8985d0..d75b08b 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -41,7 +41,7 @@ (while (null inp) (format t "Need at least one integer...~%") (force-output) - (setq inp (read-integers))) + (->> (read-integers) (setq inp))) inp)) (fn is-valid-hand-index (n) (-> (fixnum) boolean) @@ -55,7 +55,7 @@ (>= (length inp) 0))) (format t "Need at most 5 integers between 0 and 4...~%") (force-output) - (setq inp (remove-duplicates (read-integers)))) + (->> (read-integers) remove-duplicates (setq inp))) inp)) (fn read-and-confirm-valid-integers (hand) (-> (cardset) list) @@ -97,6 +97,7 @@ (->> (make-deck) alexandria:shuffle (read-redeal-print nil)) + (format t "~C[2J" #\Esc) (format t "Cards remaining: {~a} Final hand: [~a] diff --git a/src/model.lisp b/src/model.lisp index 6a3cbaf..f60ee98 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -32,9 +32,9 @@ (deftype int-card () `(integer 0 51)) -(deftype cardset () `(and list (satisfies cardsetp))) +(deftype cardset () `(and list (satisfies cardset-p))) -(fn cardsetp (lst) (-> (list) boolean) +(fn cardset-p (lst) (-> (list) boolean) (every #'card-p lst)) (fn int->suit (n) (-> (fixnum) suit) diff --git a/src/player.lisp b/src/player.lisp index 5807ac5..30eefd5 100644 --- a/src/player.lisp +++ b/src/player.lisp @@ -40,8 +40,8 @@ (id err) (balance err) (required err))))) (fn player-exists? (id table) (-> (symbol hash-table) boolean) - (and (gethash id table) - (player-p (gethash id table)))) + (let ((item (gethash id table))) + (and item (player-p item)))) (defun error-if-no-player (id table) (unless (player-exists? id table) @@ -60,12 +60,12 @@ (unless (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)) + (-<> id (gethash table) player-balance (decf amount))) (fn player-credit (id table amount) (-> (symbol hash-table fixnum) fixnum) (error-if-no-player id table) - (incf (player-balance (gethash id table)) amount)) + (-<> 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) - (setf (player-hand (gethash id table)) cards)) + (-<> id (gethash table) player-hand (setf cards))) diff --git a/tests/test.lisp b/tests/test.lisp index 75e1192..953ccc9 100644 --- a/tests/test.lisp +++ b/tests/test.lisp @@ -46,14 +46,14 @@ (define-test macro-test) (define-test (macro-test "-->") - (true (null (--> x))) + (true (null (--> x))) (is eq 'a (--> x 'a)) (is eq 2 (--> x 1 (1+ x))) (is eq 2 (--> x 1 1+)) (is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6)))) (define-test (macro-test "->>") - (true (null (->>))) + (true (null (->>))) (let ((a (gensym)) (b (gensym)) (c (gensym)) @@ -102,22 +102,12 @@ (define-test (function-test range) :compile-at :execute - (fail (range 1 0)) - (fail (range nil nil)) - (fail (range "a" "b")) - (true (null (range 1 1))) - (is equal '(1 2 3 4) (range 1 5)) - (is equal '(-3 -2 -1 0) (range -3 1))) - -(define-test (function-test take) - :depends-on ((cantedraw/tests/macros ->>)) - :compile-at :execute - (fail (take nil nil)) - (fail (take 100 nil)) - (fail (take nil 100)) - (true (->> (list 1 2 3 4) (take 0) null)) - (is equal "H" (take 1 "Hello")) - (is equal '(1 2) (take 2 '(1 2 3 4 5)))) + (fail (range :start 1 :end 0)) + (fail (range :start nil :end nil)) + (fail (range :start "a" :end "b")) + (true (null (range :start 1 :end 1))) + (is equal '(1 2 3 4) (range :start 1 :end 5)) + (is equal '(-3 -2 -1 0) (range :start -3 :end 1))) (define-test (function-test split) :compile-at :execute @@ -141,7 +131,7 @@ (fail (rev-map nil nil)) (fail (rev-map "a string" "another string" :key-eq "not a function")) (true (->> nil (rev-map #'identity) null)) - (let ((res (rev-map #'evenp (range 1 7)))) + (let ((res (rev-map #'evenp (range :start 1 :end 7)))) (false (null res)) (is equal 2 (length res)) (is equal 3 (->> (assoc t res) cdr length)) @@ -149,7 +139,7 @@ (true (->> (assoc t res) cdr (every #'evenp))) (true (->> (assoc nil res) cdr (every #'oddp)))) (let* ((mod* (lambda (n) (mod n 3))) - (res (rev-map mod* (range 1 12)))) + (res (rev-map mod* (range :start 1 :end 12)))) (false (null res)) (is equal 3 (length res)) (is equal 3 (->> (assoc 0 res) cdr length)) @@ -172,9 +162,9 @@ (true (null (remove-at-indices nil nil))) (is equal '(1 2 3) (remove-at-indices nil '(1 2 3))) (is equal '(2) (remove-at-indices '(0 2) '(1 2 3))) - (let* ((inp (range 100 200)) - (t1 (remove-at-indices (range 0 100 2) inp)) - (t2 (remove-at-indices (range 1 100 2) inp))) + (let* ((inp (range :start 100 :end 200)) + (t1 (remove-at-indices (range :start 0 :end 100 :step 2) inp)) + (t2 (remove-at-indices (range :start 1 :end 100 :step 2) inp))) (is equal 50 (length t1)) (is equal 50 (length t2)) (true (every (lambda (n) (not (member n t2))) t1)) @@ -197,7 +187,7 @@ (fail (int->rank nil)) (fail (int->rank "Not a number")) ;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed. - (let ((mapping (rev-map #'int->rank (range 0 52)))) + (let ((mapping (rev-map #'int->rank (range :start 0 :end 52)))) ;; Prove there are 13 ranks (is eq 13 (length mapping)) ;; Prove every rank is equivalent in length. @@ -207,9 +197,9 @@ length)) ;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks. (true (every #'identity - (->> (list :ace :king :queen :jack) - (append (range 2 11)) - (mapcar (lambda (rank) (assoc rank mapping)))))))) + (->> (list :ace :king :queen :jack) + (append (range :start 2 :end 11)) + (mapcar (lambda (rank) (assoc rank mapping)))))))) (define-test (model-test rank->int) :depends-on ((cantedraw/tests/macros ->>)) @@ -220,7 +210,7 @@ (fail (rank->int :still-not-a-rank)) ;; Prove ranks are mapped to unique positive integers (let ((res (->> (list :jack :queen :king :ace) - (append (range 2 11)) + (append (range :start 2 :end 11)) (mapcar #'rank->int)))) (true (every #'integerp res)) (true (every #'(lambda (x) (<= 0 x)) res)) @@ -228,9 +218,9 @@ (define-test (model-test "int->rank and rank->int are complete inverses") :depends-on (rank->int int->rank) - (let ((int-range (range 0 13)) + (let ((int-range (range :start 0 :end 13)) (rank-range (->> (list :ace :jack :queen :king) - (append (range 2 11))))) + (append (range :start 2 :end 11))))) (is equal rank-range (mapcar ($>> rank->int int->rank) rank-range)) (is equal int-range @@ -243,7 +233,7 @@ (fail (int->suit nil)) (fail (int->suit "Not a number")) ;; Proving int->suit splits 0-51 perfectly between the 4 suits - (let ((mapping (rev-map #'int->suit (range 0 53)))) + (let ((mapping (rev-map #'int->suit (range :start 0 :end 53)))) (is eq 5 (length mapping)) (let ((spades (alist-val :spades mapping)) (hearts (alist-val :hearts mapping)) @@ -285,7 +275,7 @@ (fail (int->card nil)) (fail (int->card "Not a number")) ;; Proving int->card maps 0-51 to exactly 52 unique cards - (let ((mapping (mapcar #'int->card (range 0 52)))) + (let ((mapping (mapcar #'int->card (range :start 0 :end 52)))) (is eq 52 (length (remove-duplicates mapping :test #'equal)) "52 unique elements.") (true (every #'card-p mapping) @@ -306,7 +296,7 @@ (fail (card->int 1738)) (fail (card->int "not a card")) (fail (card->int :still-not-a-card)) - (let ((ranks (append (range 2 11) (list :jack :queen :king :ace)))) + (let ((ranks (append (range :start 2 :end 11) (list :jack :queen :king :ace)))) (let ((res (->> (loop :for suit :in (list :diamonds :clubs :hearts :spades) :nconc (mapcar (lambda (rank) (make-card :rank rank :suit suit)) ranks)) @@ -323,3 +313,17 @@ "Every mapped element is outside of [0,51]") (is eq (length res) (length (remove-duplicates res)) "All mapped integers are unique.")))) + +(define-test (model-test "int->card and card->int are complete inverses") + :depends-on (card->int int->card) + (let ((int-range (range :start 0 :end 52)) + (card-range + (loop :for rank :in (append (range :start 2 :end 11) (list :ace :king :jack :queen)) + :nconcing (-<> (lambda (suit) (make-card :rank rank :suit suit)) + (mapcar (list :Diamonds :Clubs :Hearts :Spades))) + :into Y + :finally (return (sort Y #'card<))))) + (is equalp card-range (mapcar ($>> card->int int->card) card-range) + "int->card(card->int s) = s") + (is equalp int-range (mapcar ($>> int->card card->int) int-range) + "card->int(int->card i) = i"))) |