diff options
| -rw-r--r-- | cantedraw.asd | 1 | ||||
| -rw-r--r-- | packages.lisp | 11 | ||||
| -rw-r--r-- | src/game.lisp | 47 |
3 files changed, 58 insertions, 1 deletions
diff --git a/cantedraw.asd b/cantedraw.asd index e3b64b4..5bae167 100644 --- a/cantedraw.asd +++ b/cantedraw.asd @@ -8,6 +8,7 @@ (:module "src" :components ((:file "model") + (:file "game") (:file "main")))) :build-operation "program-op" :build-pathname "bin/cantedraw" diff --git a/packages.lisp b/packages.lisp index e12156e..1898e35 100644 --- a/packages.lisp +++ b/packages.lisp @@ -48,8 +48,17 @@ ;; Constructors :make-joker :make-deck)) -(defpackage cantedraw.main +(defpackage cantedraw.game (:use :cl :cantedraw.lib.macros :cantedraw.lib.functions :cantedraw.model) + (:export + :deal-cards + :deal-hands + :redeal-hand)) + +(defpackage cantedraw.main + (:use :cl + :cantedraw.lib.macros :cantedraw.lib.functions + :cantedraw.model :cantedraw.game) (:export :start)) diff --git a/src/game.lisp b/src/game.lisp new file mode 100644 index 0000000..e9f234f --- /dev/null +++ b/src/game.lisp @@ -0,0 +1,47 @@ +;;; game.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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Game mechanic code. + +;;; Code: + +(in-package :cantedraw.game) + +(fn deal-cards (n deck) (-> (fixnum cardset) (cons cardset cardset)) + (destructuring-bind (hand . rest) (split n deck) + (cons (sort hand #'card<) rest))) + +(fn deal-hands (n deck) (-> (fixnum cardset) (cons list cardset)) + (if (< (length deck) (* 5 n)) + (error "Require at least ~a cards for ~a hands, but have ~a cards!" + n (* 5 n) (length deck))) + (loop :for i :from 1 :to n + :for (hand . rest) = (deal-cards 5 deck) :then (deal-cards 5 rest) + :collect hand :into x + :finally (return (cons x rest)))) + +(fn redeal-hand (hand indices deck) (-> (cardset list cardset) + (cons cardset cardset)) + (cond + ((null indices) (cons hand deck)) + ((= 5 (length indices)) (deal-cards 5 deck)) + (t + (destructuring-bind (new-cards . deck) + (deal-cards (length indices) deck) + (--> it + (remove-at-indices indices hand) + (append it new-cards) + (sort it #'card<) + (cons it deck)))))) |