blob: e9f234f52d4881977c112c94191bfd58e79aa10b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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))))))
|
