From ad788bbbfdb50f81b3c45f4636b1b73ba9f518bf Mon Sep 17 00:00:00 2001 From: Ambery Rabbit Date: Fri, 29 Sep 2023 16:32:15 -0400 Subject: [PATCH] moving to git.lain.church repo --- README.md | 7 +++- TODO.txt | 3 ++ make.sh | 7 ++++ src/main.lisp | 5 +++ src/package.lisp | 21 ++++++++++++ src/subdecadence.lisp | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++ src/utilities.lisp | 63 +++++++++++++++++++++++++++++++++++ subdecadence.asd | 10 ++++++ 8 files changed, 207 insertions(+), 1 deletion(-) create mode 100644 TODO.txt create mode 100755 make.sh create mode 100644 src/main.lisp create mode 100644 src/package.lisp create mode 100644 src/subdecadence.lisp create mode 100644 src/utilities.lisp create mode 100644 subdecadence.asd diff --git a/README.md b/README.md index 29b5379..480f86e 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,8 @@ # lisp_subdecadence -A Subdecadence generator in Common Lisp \ No newline at end of file +A Subdecadence generator in Common Lisp + +I stole the project structure from [Nyx's gema project](https://git.sr.ht/~nyx_land/cl-gema). +I also learned how to make a lisp project from her repo. + +Praise Tokhatto. diff --git a/TODO.txt b/TODO.txt new file mode 100644 index 0000000..6b99fc9 --- /dev/null +++ b/TODO.txt @@ -0,0 +1,3 @@ + + TODO: highlight pairs/choices + TODO: matrix of associations with lemurs diff --git a/make.sh b/make.sh new file mode 100755 index 0000000..b9b52b6 --- /dev/null +++ b/make.sh @@ -0,0 +1,7 @@ +#!/bin/sh + +if command -v cl-launch; then + cl-launch -o subdec -d ! -Q -s subdecadence -r "subd::main" +else + echo "idk what I'm doing" +fi \ No newline at end of file diff --git a/src/main.lisp b/src/main.lisp new file mode 100644 index 0000000..156ad03 --- /dev/null +++ b/src/main.lisp @@ -0,0 +1,5 @@ +(in-package #:subdecadence.main) + +(defun main () + (let ((g (make-instance 'aeon))) + (play-aeon g))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..29cece5 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,21 @@ +(defpackage #:subdecadence.utilities + (:use :cl) + (:export :+base-deck+ :remove-nth :strip-suit + :diff :display-cross :shuffle)) + +(defpackage #:subdecadence.core + (:use :cl) + (:export :aeon :play-aeon)) + +(defpackage #:subdecadence.main + (:use :cl :subdecadence.core) + (:export :main)) + +(defpackage #:subdecadence + (:nicknames :subd) + (:use :cl + :subdecadence.utilities + :subdecadence.core + :subdecadence.main)) + +(in-package #:subdecadence) \ No newline at end of file diff --git a/src/subdecadence.lisp b/src/subdecadence.lisp new file mode 100644 index 0000000..625a6d2 --- /dev/null +++ b/src/subdecadence.lisp @@ -0,0 +1,92 @@ +(in-package #:subdecadence.core) + +(defclass aeon () + ((deck :accessor deck + :initform (subd::shuffle + (copy-list subd::+base-deck+)) + :type list + :documentation + "The deck of cards.") + + (cross-set :accessor cross-set + :initform nil + :type list + :documentation + "The Set-1 cards. They go on the cross.") + + (match-set :accessor match-set + :initform nil + :type list + :documentation + "The Set-2 cards. They are dealt face-down.") + + (score :accessor score + :initform 0 + :type integer + :documentation + "The score for the current draw.") + + (total-score :accessor total-score + :initform 0 + :type integer + :documentation + "The total score for this Aeon.")) + + (:documentation "A game of Subdecadence.")) + +(defmethod reset-deck ((self aeon)) + "Create a new deck to continue an Aeon." + (setf (deck self) (subd::shuffle + (copy-list subd::+base-deck+)))) + +(defmethod draw-sets ((self aeon)) + "Draw 5 cards for cross-set, 5 for match-set, and update deck." + (with-slots (deck cross-set match-set) self + (setf cross-set (subseq deck 0 5)) + (setf match-set (subseq deck 5 10)) + (setf deck (nthcdr 10 deck)))) + +(defmethod get-match ((self aeon) &key card) + "Find pairs for a card and calculate score." + (unless (typep card 'fixnum) (error "Card must be a fixnum.")) + (with-slots (score match-set) self + (loop :for match :in match-set + :for index :from 0 + :do (setq match (subd::strip-suit match)) + ;; if there's a pair, remove matched card from set to avoid + :when (= (+ card match) 9) ; interfering with later matches + :do (setf match-set (subd::remove-nth match-set index)) + :and :return (setf score ; and add the diff. of pair to score + (+ score (subd::diff card match))) + ;; otherwise, subtract card # from score + :finally (setf score (- score card))))) + +(defmethod make-matches ((self aeon)) + "Call get-match for every card on the cross." + (with-slots (cross-set match-set) self + (loop :for card :in cross-set + :do (get-match self :card (subd::strip-suit card))))) + +(defmethod play-draw ((self aeon)) + "Play a single draw of an Aeon." + (with-slots (cross-set match-set score) self + (draw-sets self) + (subd::display-cross cross-set) + (format t "~A~%~%" match-set) + (make-matches self) + (format t "Score: ~A~%" score))) + +(defmethod play-aeon ((self aeon)) + "Play a single Aeon." + (play-draw self) + (with-slots (total-score score deck) self + (unless deck + (reset-deck self)) + + (setf total-score (+ total-score score)) + (format t "Total Score: ~A~%" total-score) + + (when (> score 0) + (progn + (setf score 0) + (play-aeon self))))) diff --git a/src/utilities.lisp b/src/utilities.lisp new file mode 100644 index 0000000..b84d059 --- /dev/null +++ b/src/utilities.lisp @@ -0,0 +1,63 @@ +(in-package #:subdecadence.utilities) + +;;; base-deck is the unshuffled deck +;;; ♣ / C = Mj+ +;;; ♠ / S = Mj- +;;; ♥ / H = Mn+ +;;; ♦ / D = Mn- + +(defvar +base-deck+ + '("0♠" "0♣" "0♥" "0♦" + "1♠" "1♣" "1♥" "1♦" + "2♠" "2♣" "2♥" "2♦" + "3♠" "3♣" "3♥" "3♦" + "4♠" "4♣" "4♥" "4♦" + "5♠" "5♣" "5♥" "5♦" + "6♠" "6♣" "6♥" "6♦" + "7♠" "7♣" "7♥" "7♦" + "8♠" "8♣" "8♥" "8♦" + "9♠" "9♣" "9♥" "9♦")) + +(defun remove-nth (seq n) + "Remove the n-th element from the sequence `seq', returns a new sequence with the desired result, the function doesnt modify `seq'" + (unless (typep seq 'list) (error "Type error: seq must be a sequence.")) + (unless (typep n 'fixnum) (error "Type error: n must be a fixnum.")) + (remove-if #'identity seq :start n :count 1)) + +(defun strip-suit (card) + (unless (typep card 'string) (error "Type error: card must be a string.")) + "Return the integer at the beginning of a card." + (parse-integer (subseq card 0 1))) + +(defun diff (x y) + (unless (typep x 'fixnum) (error "Type error: x must be a fixnum.")) + (unless (typep y 'fixnum) (error "Type error: y must be a fixnum.")) + (abs (- x y))) + +(defun display-cross (set) + "Display 5 elements in Atlantean cross." + (unless (typep set 'list) (error "Type error: set must be a list.")) + (format t " + + ~A + + ~A ~A + + ~A + + ~A + +" + (elt set 3) + (elt set 2) + (elt set 1) + (elt set 0) + (elt set 4))) + +(defun shuffle (deck) + "Shuffle a list." + (unless (typep deck 'list) (error "Type error: deck must be a list.")) + (loop for i from (length deck) downto 2 + do (rotatef (elt deck (random i (make-random-state t))) + (elt deck (1- i)))) + deck) diff --git a/subdecadence.asd b/subdecadence.asd new file mode 100644 index 0000000..011a3cb --- /dev/null +++ b/subdecadence.asd @@ -0,0 +1,10 @@ +(asdf:defsystem "subdecadence" + :description "Automated subdecadence games in Common Lisp." + :author "Ambery Rabbit" + :version "0.4.2" + :components + ((:module "src" + :components ((:file "package") + (:file "utilities") + (:file "subdecadence") + (:file "main"))))) \ No newline at end of file