From 334ece1ee77c7d76a8fec046681b2f4a817685a9 Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Fri, 14 Feb 2025 21:46:15 +0000 Subject: Split source code into different modules for cleanliness --- cantedraw.asd | 12 +++-- lib.functions.lisp | 56 ----------------------- lib.macros.lisp | 91 ------------------------------------- lib/functions.lisp | 56 +++++++++++++++++++++++ lib/macros.lisp | 91 +++++++++++++++++++++++++++++++++++++ main.lisp | 67 --------------------------- model.lisp | 131 ----------------------------------------------------- src/main.lisp | 67 +++++++++++++++++++++++++++ src/model.lisp | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 353 insertions(+), 349 deletions(-) delete mode 100644 lib.functions.lisp delete mode 100644 lib.macros.lisp create mode 100644 lib/functions.lisp create mode 100644 lib/macros.lisp delete mode 100644 main.lisp delete mode 100644 model.lisp create mode 100644 src/main.lisp create mode 100644 src/model.lisp diff --git a/cantedraw.asd b/cantedraw.asd index c3dcc4e..e3b64b4 100644 --- a/cantedraw.asd +++ b/cantedraw.asd @@ -1,10 +1,14 @@ (asdf:defsystem :cantedraw :depends-on (:alexandria) :components ((:file "packages") - (:file "lib.macros") - (:file "lib.functions") - (:file "model") - (:file "main")) + (:module "lib" + :components + ((:file "macros") + (:file "functions"))) + (:module "src" + :components + ((:file "model") + (:file "main")))) :build-operation "program-op" :build-pathname "bin/cantedraw" :entry-point "cantedraw.main:start") diff --git a/lib.functions.lisp b/lib.functions.lisp deleted file mode 100644 index 99796c9..0000000 --- a/lib.functions.lisp +++ /dev/null @@ -1,56 +0,0 @@ -;;; lib.functions.lisp - 2025-02-09 - -;; 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 . - -;;; Commentary: - -;; Helpful functions for usage throughout the project. - -;;; Code: - -(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." - (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 list) list) - "Return the first N elements of LST." - (subseq lst 0 n)) - -(fn split (n lst) (-> (fixnum list) list) - "Return CONS where CAR is the first N elements of LST and CDR is the rest." - (cons (take n lst) - (subseq lst n))) - -(fn rev-map (indicator lst &key (key-eq #'eq)) - (-> (function list &key (:key-eq function)) list) - "Given LST and INDICATOR: LST -> A, return an association list A -> 2^LST -where key x in A has associations {y in LST : INDICATOR(y) = x}." - (loop :with assoc-list := nil - :for element :in lst - :for key := (funcall indicator element) - :if (assoc key assoc-list :test key-eq) - :do (->> (alist-val key assoc-list) - (cons element) - (setf (alist-val key assoc-list))) - :else - :do (setq assoc-list (cons (list key element) assoc-list)) - :finally (return assoc-list))) - -(fn parse-integer* (inp) (-> (string) (or integer list)) - "Given string INP, attempt to parse an integer. Return NIL otherwise." - (parse-integer inp :junk-allowed t)) diff --git a/lib.macros.lisp b/lib.macros.lisp deleted file mode 100644 index d182ce0..0000000 --- a/lib.macros.lisp +++ /dev/null @@ -1,91 +0,0 @@ -;;; lib.macros.lisp - 2025-02-09 - -;; 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 . - -;;; Commentary: - -;; Helpful macros for usage throughout the project. - -;;; Code: - -(in-package :cantedraw.lib.macros) - -(defmacro --> (placeholder &body forms) - "Lexically bind current form as `placeholder' for use in the next form, returning -the result of the last form. - -i.e. - -(--> (a1 a2...) (b1 b2...) (c1 c2...)) = -(let* ((placeholder (a1 a2 ...)) - (placeholder (b1 b2 ...)) - (placeholder (c1 c2 ...))) - _ ) - -Also includes transformer where symbols are considered unary functions i.e. -(--> x y) <-> (--> x (y placeholder)). -" - (if (null forms) - nil - (let ((assignment-forms - (loop :for f :in forms - :for canon-f := (if (symbolp f) - (list f placeholder) - f) - :collect `(,placeholder ,canon-f)))) - `(let* ,assignment-forms - ,placeholder)))) - -(defmacro ->> (&rest forms) - "Make current form the last argument of the next form, returning the last - form. - -i.e. -(->> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 c2 ... (b1 b2 ... (a1 a2 ...))) - -Also includes transformer where symbols are considered unary functions. - -Like the `|>' operator in Ocaml." - (if (null forms) - nil - (loop :with acc = (car forms) - :for func :in (cdr forms) - :for canon-func = (if (symbolp func) (list func) func) - :do (setq acc (append canon-func (list acc))) - :finally (return acc)))) - -(defmacro while (condition &body body) - `(loop :while ,condition - :do - (progn ,@body))) - -(deftype -> (args result) - "Type alias for function." - `(function ,args ,result)) - -(defmacro fn (name lambda-list type &body body) - "Construct a function `NAME' with a declared function type `TYPE' that takes -arguments `LAMBDA-LIST' with body `BODY'." - `(progn - (declaim (ftype ,type ,name)) - (defun ,name ,lambda-list - ,@body))) - -(defmacro $ (&rest forms) - "Given a sequence of FORMS, return a unary function which applies each form -sequentially" - `(lambda (x) - (->> x ,@forms))) - -(defmacro alist-val (key alist) - "Helper macro for getting the value of KEY in ALIST." - `(cdr (assoc ,key ,alist))) diff --git a/lib/functions.lisp b/lib/functions.lisp new file mode 100644 index 0000000..99796c9 --- /dev/null +++ b/lib/functions.lisp @@ -0,0 +1,56 @@ +;;; lib.functions.lisp - 2025-02-09 + +;; 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 . + +;;; Commentary: + +;; Helpful functions for usage throughout the project. + +;;; Code: + +(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." + (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 list) list) + "Return the first N elements of LST." + (subseq lst 0 n)) + +(fn split (n lst) (-> (fixnum list) list) + "Return CONS where CAR is the first N elements of LST and CDR is the rest." + (cons (take n lst) + (subseq lst n))) + +(fn rev-map (indicator lst &key (key-eq #'eq)) + (-> (function list &key (:key-eq function)) list) + "Given LST and INDICATOR: LST -> A, return an association list A -> 2^LST +where key x in A has associations {y in LST : INDICATOR(y) = x}." + (loop :with assoc-list := nil + :for element :in lst + :for key := (funcall indicator element) + :if (assoc key assoc-list :test key-eq) + :do (->> (alist-val key assoc-list) + (cons element) + (setf (alist-val key assoc-list))) + :else + :do (setq assoc-list (cons (list key element) assoc-list)) + :finally (return assoc-list))) + +(fn parse-integer* (inp) (-> (string) (or integer list)) + "Given string INP, attempt to parse an integer. Return NIL otherwise." + (parse-integer inp :junk-allowed t)) diff --git a/lib/macros.lisp b/lib/macros.lisp new file mode 100644 index 0000000..d182ce0 --- /dev/null +++ b/lib/macros.lisp @@ -0,0 +1,91 @@ +;;; lib.macros.lisp - 2025-02-09 + +;; 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 . + +;;; Commentary: + +;; Helpful macros for usage throughout the project. + +;;; Code: + +(in-package :cantedraw.lib.macros) + +(defmacro --> (placeholder &body forms) + "Lexically bind current form as `placeholder' for use in the next form, returning +the result of the last form. + +i.e. + +(--> (a1 a2...) (b1 b2...) (c1 c2...)) = +(let* ((placeholder (a1 a2 ...)) + (placeholder (b1 b2 ...)) + (placeholder (c1 c2 ...))) + _ ) + +Also includes transformer where symbols are considered unary functions i.e. +(--> x y) <-> (--> x (y placeholder)). +" + (if (null forms) + nil + (let ((assignment-forms + (loop :for f :in forms + :for canon-f := (if (symbolp f) + (list f placeholder) + f) + :collect `(,placeholder ,canon-f)))) + `(let* ,assignment-forms + ,placeholder)))) + +(defmacro ->> (&rest forms) + "Make current form the last argument of the next form, returning the last + form. + +i.e. +(->> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 c2 ... (b1 b2 ... (a1 a2 ...))) + +Also includes transformer where symbols are considered unary functions. + +Like the `|>' operator in Ocaml." + (if (null forms) + nil + (loop :with acc = (car forms) + :for func :in (cdr forms) + :for canon-func = (if (symbolp func) (list func) func) + :do (setq acc (append canon-func (list acc))) + :finally (return acc)))) + +(defmacro while (condition &body body) + `(loop :while ,condition + :do + (progn ,@body))) + +(deftype -> (args result) + "Type alias for function." + `(function ,args ,result)) + +(defmacro fn (name lambda-list type &body body) + "Construct a function `NAME' with a declared function type `TYPE' that takes +arguments `LAMBDA-LIST' with body `BODY'." + `(progn + (declaim (ftype ,type ,name)) + (defun ,name ,lambda-list + ,@body))) + +(defmacro $ (&rest forms) + "Given a sequence of FORMS, return a unary function which applies each form +sequentially" + `(lambda (x) + (->> x ,@forms))) + +(defmacro alist-val (key alist) + "Helper macro for getting the value of KEY in ALIST." + `(cdr (assoc ,key ,alist))) diff --git a/main.lisp b/main.lisp deleted file mode 100644 index 53d9bec..0000000 --- a/main.lisp +++ /dev/null @@ -1,67 +0,0 @@ -;;; main.lisp - 2025-02-11 - -;; 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 . - -;;; Commentary: - -;; Defines the entrypoint of the program, handling any input from the user and -;; passing it into the system. - -;;; Code: - -(in-package :cantedraw.main) - -(fn read-input (&optional (prompt "> ")) (-> (&optional string) string) - (format t "~a" prompt) - (force-output) - (read-line)) - -(fn parse-integers (input) (-> (string) list) - (->> input - uiop:split-string - (mapcar #'parse-integer*) - (remove-if #'null))) - -(fn read-integers () (-> nil list) - (->> "Enter numbers: " - read-input - parse-integers)) - -(fn read-until-integers () (-> nil list) - (let ((inp (read-integers))) - (while (null inp) - (format t "Need at least one integer...~%") - (force-output) - (setq inp (read-integers))) - inp)) - -(fn is-valid-hand-index (n) (-> (fixnum) boolean) - (and (< n 5) - (>= n 0))) - -(fn read-until-valid-integers () (-> nil list) - (let ((inp (remove-duplicates (read-integers)))) - (while (not (every #'is-valid-hand-index inp)) - (format t "Need at most 5 integers between 0 and 4...~%") - (force-output) - (setq inp (remove-duplicates (read-integers)))))) - -(defun generate-hand () - (->> (make-deck) - alexandria:shuffle - (split 5))) - -(defun start () - (destructuring-bind (hand . rest) (generate-hand) - (declare (ignore rest)) - (->> hand cardset->str (format t "Hand=[~a]~%")) - (force-output))) diff --git a/model.lisp b/model.lisp deleted file mode 100644 index 5652b9c..0000000 --- a/model.lisp +++ /dev/null @@ -1,131 +0,0 @@ -;;; model.lisp - 2025-02-14 - -;; 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 . - -;;; Commentary: - -;; Model of cards and sets of cards in Lisp. - -;;; Code: - -(in-package :cantedraw.model) - -(deftype rank () - `(or (member :Jack :Queen :King :Ace) - (integer 2 10))) - -(deftype suit () - `(member :Diamonds :Clubs :Hearts :Spades :Joker)) - -(deftype card () `(cons rank suit)) - -(deftype int-card () `(integer 0 51)) - -(fn cardsetp (lst) (-> (list) boolean) - (every #'(lambda (x) (typep x 'card)) lst)) - -(deftype cardset () `(and list (satisfies cardsetp))) - -(fn int->suit (n) (-> (int-card) suit) - (case (floor n 13) - (0 :Diamonds) - (1 :Clubs) - (2 :Hearts) - (3 :Spades) - (t :Joker))) - -(fn suit->int (item) (-> (suit) (integer 0 4)) - (case item - (:Diamonds 0) - (:Clubs 1) - (:Hearts 2) - (:Spades 3) - (t 4))) - -(fn int->rank (n) (-> (int-card) rank) - (let ((n (mod n 13))) - (case n - (9 :Jack) - (10 :Queen) - (11 :King) - (12 :Ace) - (t (+ n 2))))) - -(fn rank->int (rank) (-> (rank) (integer 0 12)) - (case rank - (:Jack 9) - (:Queen 10) - (:King 11) - (:Ace 12) - (t (- rank 2)))) - -(fn int->card (num) (-> (int-card) card) - (cons (int->rank num) - (int->suit num))) - -(fn card->int (card) (-> (card) int-card) - (destructuring-bind (rank . suit) card - (->> (suit->int suit) - (* 13) - (+ (rank->int rank))))) - -(fn suit< (s1 s2) (-> (suit suit) boolean) - (< (suit->int s1) (suit->int s2))) - -(fn rank< (r1 r2) (-> (rank rank) boolean) - (< (rank->int r1) (rank->int r2))) - -(fn card< (c1 c2) (-> (card card) boolean) - (destructuring-bind ((r1 . s1) (r2 . s2)) (list c1 c2) - (if (eq r1 r2) - (suit< s1 s2) - (rank< r1 r2)))) - -(fn suit->str (suit) (-> (suit) string) - (case suit - (:Diamonds "◆") - (:Clubs "♣") - (:Hearts "♥") - (:Spades "♠") - (t "Joker"))) - -(fn rank->str (rank) (-> (rank) string) - (case rank - (:Ace "Ace") - (:Jack "Jack") - (:Queen "Queen") - (:King "King") - (t (format nil "~a" rank)))) - -(fn card->str (card) (-> (card) string) - (destructuring-bind (rank . suit) card - (if (eq suit :Joker) - "Joker" - (format nil "~a[~a]" - (rank->str rank) - (suit->str suit))))) - -(fn cardset->str (cardset) (-> (cardset) string) - (->> 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) - (append - (loop :for _ :from 1 :to n - :nconc (loop :for j :from 1 :to 52 - collect (int->card (1- j)))) - (mapcar ($ int->rank make-joker) - (range 0 (* 2 n))))) diff --git a/src/main.lisp b/src/main.lisp new file mode 100644 index 0000000..53d9bec --- /dev/null +++ b/src/main.lisp @@ -0,0 +1,67 @@ +;;; main.lisp - 2025-02-11 + +;; 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 . + +;;; Commentary: + +;; Defines the entrypoint of the program, handling any input from the user and +;; passing it into the system. + +;;; Code: + +(in-package :cantedraw.main) + +(fn read-input (&optional (prompt "> ")) (-> (&optional string) string) + (format t "~a" prompt) + (force-output) + (read-line)) + +(fn parse-integers (input) (-> (string) list) + (->> input + uiop:split-string + (mapcar #'parse-integer*) + (remove-if #'null))) + +(fn read-integers () (-> nil list) + (->> "Enter numbers: " + read-input + parse-integers)) + +(fn read-until-integers () (-> nil list) + (let ((inp (read-integers))) + (while (null inp) + (format t "Need at least one integer...~%") + (force-output) + (setq inp (read-integers))) + inp)) + +(fn is-valid-hand-index (n) (-> (fixnum) boolean) + (and (< n 5) + (>= n 0))) + +(fn read-until-valid-integers () (-> nil list) + (let ((inp (remove-duplicates (read-integers)))) + (while (not (every #'is-valid-hand-index inp)) + (format t "Need at most 5 integers between 0 and 4...~%") + (force-output) + (setq inp (remove-duplicates (read-integers)))))) + +(defun generate-hand () + (->> (make-deck) + alexandria:shuffle + (split 5))) + +(defun start () + (destructuring-bind (hand . rest) (generate-hand) + (declare (ignore rest)) + (->> hand cardset->str (format t "Hand=[~a]~%")) + (force-output))) diff --git a/src/model.lisp b/src/model.lisp new file mode 100644 index 0000000..5652b9c --- /dev/null +++ b/src/model.lisp @@ -0,0 +1,131 @@ +;;; model.lisp - 2025-02-14 + +;; 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 . + +;;; Commentary: + +;; Model of cards and sets of cards in Lisp. + +;;; Code: + +(in-package :cantedraw.model) + +(deftype rank () + `(or (member :Jack :Queen :King :Ace) + (integer 2 10))) + +(deftype suit () + `(member :Diamonds :Clubs :Hearts :Spades :Joker)) + +(deftype card () `(cons rank suit)) + +(deftype int-card () `(integer 0 51)) + +(fn cardsetp (lst) (-> (list) boolean) + (every #'(lambda (x) (typep x 'card)) lst)) + +(deftype cardset () `(and list (satisfies cardsetp))) + +(fn int->suit (n) (-> (int-card) suit) + (case (floor n 13) + (0 :Diamonds) + (1 :Clubs) + (2 :Hearts) + (3 :Spades) + (t :Joker))) + +(fn suit->int (item) (-> (suit) (integer 0 4)) + (case item + (:Diamonds 0) + (:Clubs 1) + (:Hearts 2) + (:Spades 3) + (t 4))) + +(fn int->rank (n) (-> (int-card) rank) + (let ((n (mod n 13))) + (case n + (9 :Jack) + (10 :Queen) + (11 :King) + (12 :Ace) + (t (+ n 2))))) + +(fn rank->int (rank) (-> (rank) (integer 0 12)) + (case rank + (:Jack 9) + (:Queen 10) + (:King 11) + (:Ace 12) + (t (- rank 2)))) + +(fn int->card (num) (-> (int-card) card) + (cons (int->rank num) + (int->suit num))) + +(fn card->int (card) (-> (card) int-card) + (destructuring-bind (rank . suit) card + (->> (suit->int suit) + (* 13) + (+ (rank->int rank))))) + +(fn suit< (s1 s2) (-> (suit suit) boolean) + (< (suit->int s1) (suit->int s2))) + +(fn rank< (r1 r2) (-> (rank rank) boolean) + (< (rank->int r1) (rank->int r2))) + +(fn card< (c1 c2) (-> (card card) boolean) + (destructuring-bind ((r1 . s1) (r2 . s2)) (list c1 c2) + (if (eq r1 r2) + (suit< s1 s2) + (rank< r1 r2)))) + +(fn suit->str (suit) (-> (suit) string) + (case suit + (:Diamonds "◆") + (:Clubs "♣") + (:Hearts "♥") + (:Spades "♠") + (t "Joker"))) + +(fn rank->str (rank) (-> (rank) string) + (case rank + (:Ace "Ace") + (:Jack "Jack") + (:Queen "Queen") + (:King "King") + (t (format nil "~a" rank)))) + +(fn card->str (card) (-> (card) string) + (destructuring-bind (rank . suit) card + (if (eq suit :Joker) + "Joker" + (format nil "~a[~a]" + (rank->str rank) + (suit->str suit))))) + +(fn cardset->str (cardset) (-> (cardset) string) + (->> 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) + (append + (loop :for _ :from 1 :to n + :nconc (loop :for j :from 1 :to 52 + collect (int->card (1- j)))) + (mapcar ($ int->rank make-joker) + (range 0 (* 2 n))))) -- cgit v1.2.3-13-gbd6f