moving to git.lain.church repo

README.md

@@ -1,3 +1,8 @@
 # lisp_subdecadence
 
 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.

TODO.txt

@@ -0,0 +1,3 @@
+
+ TODO: highlight pairs/choices
+ TODO: matrix of associations with lemurs

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

src/main.lisp

@@ -0,0 +1,5 @@
+(in-package #:subdecadence.main)
+
+(defun main ()
+  (let ((g (make-instance 'aeon)))
+    (play-aeon g)))

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)

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)))))

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)

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")))))