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 --- src/main.lisp | 67 +++++++++++++++++++++++++++++ src/model.lisp | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 198 insertions(+) create mode 100644 src/main.lisp create mode 100644 src/model.lisp (limited to 'src') 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