--- a/Makefile Wed Mar 27 19:58:04 2019 -0400
+++ b/Makefile Sun Aug 28 12:48:04 2022 -0400
@@ -1,38 +1,12 @@
-.PHONY: vendor binary clean deploy update-deps force-binary
-
-# Vendor ----------------------------------------------------------------------
-vendor/quickutils.lisp: vendor/make-quickutils.lisp
- cd vendor && sbcl --noinform --load make-quickutils.lisp --eval '(quit)'
-
-vendor: vendor/quickutils.lisp
+.PHONY: deploy clean
-# Clean -----------------------------------------------------------------------
-clean:
- rm -rf bin
-
-# Build -----------------------------------------------------------------------
-lisps := $(shell ffind '\.(asd|lisp|ros)$$')
-
-binary: bin/magitek
+lisps := $(shell ffind '\.(asd|lisp)$$')
-force-binary:
- rm -f bin/magitek
- sbcl --load "src/build.lisp"
-
-bin/magitek: $(lisps)
- force-binary
-
-# Deploy ----------------------------------------------------------------------
+bin/magitek:
+ sbcl --disable-debugger --load 'src/build.lisp'
-# Server
-update-deps:
- hg -R /home/sjl/lib/cl-losh -v pull -u
- hg -R /home/sjl/lib/chancery -v pull -u
- hg -R /home/sjl/lib/flax -v pull -u
- hg -R /home/sjl/lib/cl-pcg -v pull -u
+deploy: bin/magitek
+ rsync -avz bin/ jam:magitek/bin
-# Local
-deploy:
- rsync --exclude=bin --exclude=.hg --exclude=database.sqlite --exclude='*.fasl' --exclude='*.png' --exclude='*.pnm' -avz . jam:/home/sjl/src/magitek
- ssh jam make -C /home/sjl/src/magitek update-deps force-binary
-
+clean:
+ rm -rf bin/
--- a/magitek.asd Wed Mar 27 19:58:04 2019 -0400
+++ b/magitek.asd Sun Aug 28 12:48:04 2022 -0400
@@ -8,6 +8,7 @@
:depends-on (
+ :alexandria
:chancery
:chirp
:fare-quasiquote
@@ -30,10 +31,7 @@
:entry-point "magitek:main"
:serial t
- :components ((:module "vendor" :serial t
- :components ((:file "quickutils-package")
- (:file "quickutils")))
- (:file "package")
+ :components ((:file "package")
(:module "src" :serial t
:components ((:file "readtables")
(:file "database")
--- a/package.lisp Wed Mar 27 19:58:04 2019 -0400
+++ b/package.lisp Sun Aug 28 12:48:04 2022 -0400
@@ -2,8 +2,7 @@
(:use
:cl
:iterate
- :losh
- :magitek.quickutils)
+ :losh)
(:export
:tt-load-credentials
:tt-authorize
@@ -14,8 +13,7 @@
(:use
:cl
:losh
- :sqlite
- :magitek.quickutils)
+ :sqlite)
(:export
:db-connect
:db-initialize
@@ -27,8 +25,7 @@
(:use
:cl
:losh
- :iterate
- :magitek.quickutils)
+ :iterate)
(:export
:build-markov-generator
:generate-sentence))
@@ -37,8 +34,7 @@
(:use
:cl
:losh
- :iterate
- :magitek.quickutils)
+ :iterate)
(:export
:generate-heightmap))
@@ -46,40 +42,35 @@
(defpackage :magitek.robots.bit-loom
(:use
:cl
- :losh
- :magitek.quickutils)
+ :losh)
(:export :random-tweet))
(defpackage :magitek.robots.git-commands
(:use
:cl
:losh
- :chancery
- :magitek.quickutils)
+ :chancery)
(:export :random-tweet))
(defpackage :magitek.robots.lisp-talks
(:use
:cl
:losh
- :chancery
- :magitek.quickutils)
+ :chancery)
(:export :random-tweet))
(defpackage :magitek.robots.rpg-shopkeeper
(:use
:cl
:losh
- :chancery
- :magitek.quickutils)
+ :chancery)
(:export :random-tweet))
(defpackage :magitek.robots.frantic-barista
(:use
:cl
:losh
- :chancery
- :magitek.quickutils)
+ :chancery)
(:export :random-tweet))
@@ -89,7 +80,6 @@
:iterate
:losh
:magitek.twitter
- :magitek.database
- :magitek.quickutils)
+ :magitek.database)
(:export
:main))
--- a/src/database.lisp Wed Mar 27 19:58:04 2019 -0400
+++ b/src/database.lisp Sun Aug 28 12:48:04 2022 -0400
@@ -34,12 +34,13 @@
(defun db-tweeted-since-p (account minutes-ago)
(check-type minutes-ago (integer 1))
(check-db)
- (ensure-boolean
- (execute-single *database*
- "SELECT content FROM tweets
+ (if (execute-single *database*
+ "SELECT content FROM tweets
WHERE account = ?
AND timestamp > datetime('now', ?)
LIMIT 1
"
- (aesthetic-string account)
- (format nil "-~D minutes" minutes-ago))))
+ (aesthetic-string account)
+ (format nil "-~D minutes" minutes-ago))
+ t
+ nil))
--- a/src/markov.lisp Wed Mar 27 19:58:04 2019 -0400
+++ b/src/markov.lisp Sun Aug 28 12:48:04 2022 -0400
@@ -16,8 +16,8 @@
(defun markov-insert-pair (markov prefix suffix)
(vector-push-extend
suffix
- (ensure-gethash prefix (markov-database markov)
- (make-array 1 :fill-pointer 0 :adjustable t))))
+ (alexandria:ensure-gethash prefix (markov-database markov)
+ (make-array 1 :fill-pointer 0 :adjustable t))))
(defun markov-insert-beginning (markov prefix)
(vector-push-extend prefix (markov-beginnings markov)))
@@ -93,6 +93,22 @@
(car (last n-gram)))
+(defun n-grams (n sequence)
+ "Find all `n`-grams of the sequence `sequence`."
+ ;;; From quickutil
+ (assert (and (plusp n)
+ (<= n (length sequence))))
+
+ (etypecase sequence
+ ;; Lists
+ (list (loop :repeat (1+ (- (length sequence) n))
+ :for seq :on sequence
+ :collect (take n seq)))
+
+ ;; General sequences
+ (sequence (loop :for i :to (- (length sequence) n)
+ :collect (subseq sequence i (+ i n))))))
+
(defun chunk-sentence (size sentence)
(mapcar (juxt #'prefix #'suffix)
(when (>= (length sentence) size)
--- a/src/robots/rpg-shopkeeper.lisp Wed Mar 27 19:58:04 2019 -0400
+++ b/src/robots/rpg-shopkeeper.lisp Sun Aug 28 12:48:04 2022 -0400
@@ -19,7 +19,7 @@
;;;; Monsters -----------------------------------------------------------------
-(defclass* monster ()
+(defclass* (monster :conc-name monster-) ()
(singular multiplier plural adjective))
(defun make-monster (singular multiplier plural adjective)
@@ -70,7 +70,7 @@
;;;; Materials ----------------------------------------------------------------
-(defclass* material ()
+(defclass* (material :conc-name material-) ()
(kind name multiplier))
(defun make-material (kind name multiplier)
@@ -186,7 +186,7 @@
;;;; Pieces -------------------------------------------------------------------
-(defclass* piece ()
+(defclass* (piece :conc-name piece-) ()
(name base-value))
(defmethod print-object ((o piece) stream)
@@ -265,7 +265,7 @@
;;;; Armor --------------------------------------------------------------------
-(defclass* armor ()
+(defclass* (armor :conc-name armor-) ()
(material piece enchantment ornament))
(define-with-macro armor
@@ -322,8 +322,8 @@
(defun armor-value (armor)
(with-armor (armor)
- (* (+ (* (-<> piece piece-base-value)
- (-<> material material-multiplier))
+ (* (+ (* (_ piece piece-base-value)
+ (_ material material-multiplier))
(if enchantment 100 0)
(if ornament 10 0))
(enchantment-multiplier enchantment)
@@ -332,8 +332,8 @@
(defun vanilla-armor-description (vanilla-armor)
(format nil "~A ~A"
- (-<> vanilla-armor armor-material material-name)
- (-<> vanilla-armor armor-piece piece-name)))
+ (_ vanilla-armor armor-material material-name)
+ (_ vanilla-armor armor-piece piece-name)))
(defun armor-description (armor)
@@ -351,7 +351,7 @@
; ;;;; Weapons ------------------------------------------------------------------
-(defclass* weapon ()
+(defclass* (weapon :conc-name weapon-) ()
(material piece enchantment ornament))
(define-with-macro weapon
@@ -427,8 +427,8 @@
(defun weapon-value (weapon)
(with-weapon (weapon)
- (* (+ (* (-<> piece piece-base-value)
- (-<> material material-multiplier))
+ (* (+ (* (_ piece piece-base-value)
+ (_ material material-multiplier))
(if enchantment 100 0)
(if ornament 10 0))
(enchantment-multiplier enchantment)
@@ -438,8 +438,8 @@
(defun vanilla-weapon-description (vanilla-weapon)
(with-weapon (vanilla-weapon)
(format nil "~A ~A"
- (-<> material material-name)
- (-<> piece piece-name))))
+ (_ material material-name)
+ (_ piece piece-name))))
(defun weapon-description (weapon)
(let ((vanilla-description (vanilla-weapon-description weapon))
@@ -477,9 +477,9 @@
(defun round-to (n sigfigs)
(let* ((digits (ceiling (log n 10)))
(div (expt 10 (max 0 (- digits sigfigs)))))
- (-<> n
- (round <> div)
- (* <> div))))
+ (_ n
+ (round _ div)
+ (* _ div))))
(defun sanitize-price (price)
(let ((price (round-to price 3)))
@@ -490,11 +490,11 @@
(t price))))
(defun item-value (item)
- (-<> (etypecase item
+ (_ (etypecase item
(armor (armor-value item))
(weapon (weapon-value item)))
- (sanitize-price <>)
- (format nil "~:D" <>)))
+ (sanitize-price _)
+ (format nil "~:D" _)))
(define-string for-the-low-price
--- a/vendor/make-quickutils.lisp Wed Mar 27 19:58:04 2019 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(ql:quickload 'quickutil)
-
-(qtlc:save-utils-as
- "quickutils.lisp"
- :utilities '(
-
- :curry
- :ensure-boolean
- :ensure-gethash
- :n-grams
- :once-only
- :rcurry
- :symb
- :with-gensyms
-
- )
- :package "MAGITEK.QUICKUTILS")
--- a/vendor/quickutils-package.lisp Wed Mar 27 19:58:04 2019 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (find-package "MAGITEK.QUICKUTILS")
- (defpackage "MAGITEK.QUICKUTILS"
- (:documentation "Package that contains Quickutil utility functions.")
- (:use :cl))))
-
-(in-package "MAGITEK.QUICKUTILS")
-
-;; need to define this here so sbcl will shut the hell up about it being
-;; undefined when compiling quickutils.lisp. computers are trash.
-(defparameter *utilities* nil)
-
--- a/vendor/quickutils.lisp Wed Mar 27 19:58:04 2019 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,214 +0,0 @@
-;;;; This file was automatically generated by Quickutil.
-;;;; See http://quickutil.org for details.
-
-;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :N-GRAMS :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "MAGITEK.QUICKUTILS")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (find-package "MAGITEK.QUICKUTILS")
- (defpackage "MAGITEK.QUICKUTILS"
- (:documentation "Package that contains Quickutil utility functions.")
- (:use #:cl))))
-
-(in-package "MAGITEK.QUICKUTILS")
-
-(when (boundp '*utilities*)
- (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH
- :TAKE :N-GRAMS :ONCE-ONLY :RCURRY
- :MKSTR :SYMB :STRING-DESIGNATOR
- :WITH-GENSYMS))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun make-gensym-list (length &optional (x "G"))
- "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
-using the second (optional, defaulting to `\"G\"`) argument."
- (let ((g (if (typep x '(integer 0)) x (string x))))
- (loop repeat length
- collect (gensym g))))
- ) ; eval-when
-(eval-when (:compile-toplevel :load-toplevel :execute)
- ;;; To propagate return type and allow the compiler to eliminate the IF when
- ;;; it is known if the argument is function or not.
- (declaim (inline ensure-function))
-
- (declaim (ftype (function (t) (values function &optional))
- ensure-function))
- (defun ensure-function (function-designator)
- "Returns the function designated by `function-designator`:
-if `function-designator` is a function, it is returned, otherwise
-it must be a function name and its `fdefinition` is returned."
- (if (functionp function-designator)
- function-designator
- (fdefinition function-designator)))
- ) ; eval-when
-
- (defun curry (function &rest arguments)
- "Returns a function that applies `arguments` and the arguments
-it is called with to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- ;; Using M-V-C we don't need to append the arguments.
- (multiple-value-call fn (values-list arguments) (values-list more)))))
-
- (define-compiler-macro curry (function &rest arguments)
- (let ((curries (make-gensym-list (length arguments) "CURRY"))
- (fun (gensym "FUN")))
- `(let ((,fun (ensure-function ,function))
- ,@(mapcar #'list curries arguments))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest more)
- (apply ,fun ,@curries more)))))
-
-
- (defun ensure-boolean (x)
- "Convert `x` into a Boolean value."
- (and x t))
-
-
- (defmacro ensure-gethash (key hash-table &optional default)
- "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
-under key before returning it. Secondary return value is true if key was
-already in the table."
- `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
- (if ok
- (values value ok)
- (values (setf (gethash ,key ,hash-table) ,default) nil))))
-
-
- (defun take (n sequence)
- "Take the first `n` elements from `sequence`."
- (subseq sequence 0 n))
-
-
- (defun n-grams (n sequence)
- "Find all `n`-grams of the sequence `sequence`."
- (assert (and (plusp n)
- (<= n (length sequence))))
-
- (etypecase sequence
- ;; Lists
- (list (loop :repeat (1+ (- (length sequence) n))
- :for seq :on sequence
- :collect (take n seq)))
-
- ;; General sequences
- (sequence (loop :for i :to (- (length sequence) n)
- :collect (subseq sequence i (+ i n))))))
-
-
- (defmacro once-only (specs &body forms)
- "Evaluates `forms` with symbols specified in `specs` rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
- (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
- (symbol symbol)
-
-Example:
-
- (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
- (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
- (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
- (names-and-forms (mapcar (lambda (spec)
- (etypecase spec
- (list
- (destructuring-bind (name form) spec
- (cons name form)))
- (symbol
- (cons spec spec))))
- specs)))
- ;; bind in user-macro
- `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
- gensyms names-and-forms)
- ;; bind in final expansion
- `(let (,,@(mapcar (lambda (g n)
- ``(,,g ,,(cdr n)))
- gensyms names-and-forms))
- ;; bind in user-macro
- ,(let ,(mapcar (lambda (n g) (list (car n) g))
- names-and-forms gensyms)
- ,@forms)))))
-
-
- (defun rcurry (function &rest arguments)
- "Returns a function that applies the arguments it is called
-with and `arguments` to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (multiple-value-call fn (values-list more) (values-list arguments)))))
-
-
- (defun mkstr (&rest args)
- "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
-
-Extracted from _On Lisp_, chapter 4."
- (with-output-to-string (s)
- (dolist (a args) (princ a s))))
-
-
- (defun symb (&rest args)
- "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
-
-Extracted from _On Lisp_, chapter 4.
-
-See also: `symbolicate`"
- (values (intern (apply #'mkstr args))))
-
-
- (deftype string-designator ()
- "A string designator type. A string designator is either a string, a symbol,
-or a character."
- `(or symbol string character))
-
-
- (defmacro with-gensyms (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(let ,(mapcar (lambda (name)
- (multiple-value-bind (symbol string)
- (etypecase name
- (symbol
- (values name (symbol-name name)))
- ((cons symbol (cons string-designator null))
- (values (first name) (string (second name)))))
- `(,symbol (gensym ,string))))
- names)
- ,@forms))
-
- (defmacro with-unique-names (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(with-gensyms ,names ,@forms))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(curry ensure-boolean ensure-gethash n-grams once-only rcurry symb
- with-gensyms with-unique-names)))
-
-;;;; END OF quickutils.lisp ;;;;