# HG changeset patch # User Steve Losh # Date 1484699550 0 # Node ID 1a365d4ae7bc8d4fe60c030db152c7b1e221dffd # Parent 6c0ee26dbcbdad40bdb188578d66db3f26046721 Just go ahead and start the shopkeeper We'll work on making it better when I'm less drunk. diff -r 6c0ee26dbcbd -r 1a365d4ae7bc Makefile --- a/Makefile Tue Jan 17 11:08:42 2017 +0000 +++ b/Makefile Wed Jan 18 00:32:30 2017 +0000 @@ -15,11 +15,9 @@ update-deps: hg -R /home/sjl/chancery -v pull -u + hg -R /home/sjl/cl-losh -v pull -u -/opt/antipodes/antipodes: update-deps build/antipodes - rm -f /opt/antipodes/antipodes - cp build/antipodes /opt/antipodes/antipodes - -deploy: build/magitek +deploy: build/magitek update-deps rsync --exclude=build/magitek --exclude=.hg --exclude=database.sqlite --exclude=corpora -avz . silt:/home/sjl/magitek + ssh silt make -C /home/sjl/magitek update-deps ssh silt make -C /home/sjl/magitek build/magitek diff -r 6c0ee26dbcbd -r 1a365d4ae7bc magitek.asd --- a/magitek.asd Tue Jan 17 11:08:42 2017 +0000 +++ b/magitek.asd Wed Jan 18 00:32:30 2017 +0000 @@ -37,5 +37,6 @@ (:file "markov") (:module "robots" :components ((:file "git-commands") - (:file "hacker-booze"))) + (:file "hacker-booze") + (:file "rpg-shopkeeper"))) (:file "main"))))) diff -r 6c0ee26dbcbd -r 1a365d4ae7bc package.lisp --- a/package.lisp Tue Jan 17 11:08:42 2017 +0000 +++ b/package.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -46,6 +46,16 @@ :magitek.quickutils) (:export :random-string)) +(defpackage :magitek.robots.rpg-shopkeeper + (:use + :cl + :iterate + :cl-arrows + :losh + :chancery + :magitek.quickutils) + (:export :random-string)) + (defpackage :magitek.robots.hacker-booze (:use :cl diff -r 6c0ee26dbcbd -r 1a365d4ae7bc src/main.lisp --- a/src/main.lisp Tue Jan 17 11:08:42 2017 +0000 +++ b/src/main.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -28,4 +28,6 @@ (db-initialize) (tt-load-credentials) (run-bot :git-commands #'magitek.robots.git-commands:random-string + :hours 12) + (run-bot :rpg-shopkeeper #'magitek.robots.rpg-shopkeeper:random-string :hours 12)) diff -r 6c0ee26dbcbd -r 1a365d4ae7bc src/robots/hacker-booze.lisp --- a/src/robots/hacker-booze.lisp Tue Jan 17 11:08:42 2017 +0000 +++ b/src/robots/hacker-booze.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -17,8 +17,8 @@ ;;;; Hacker News -------------------------------------------------------------- (defparameter *errors* 0) -(defparameter *stories-per-corpus* 20) -(defparameter *max-comments-per-story* 100) +(defparameter *stories-per-corpus* 30) +(defparameter *max-comments-per-story* 200) (defparameter *hn-corpus-path* "corpora/hacker-news.txt") (defun firebase-get (url) diff -r 6c0ee26dbcbd -r 1a365d4ae7bc src/robots/rpg-shopkeeper.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/robots/rpg-shopkeeper.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -0,0 +1,314 @@ +(in-package :magitek.robots.rpg-shopkeeper) +(named-readtables:in-readtable :chancery) + + +(eval-when (:compile-toplevel :load-toplevel :execute) + ;;; please just end my life + (defmacro ea (&body body) + `(eval-when (:compile-toplevel :load-toplevel :execute) + ,@body))) + + +;;;; General ------------------------------------------------------------------ +(define-rule (bonus :distribution (:zipf :exponent 1.8)) + 1 2 3 4 5) + + +(ea (defun str (symbol) + (string-downcase (symbol-name symbol)))) + + +;;;; Materials ---------------------------------------------------------------- +(defclass* material () + (name multiplier)) + +(defun make-material (name multiplier) + (make-instance 'material :name name :multiplier multiplier)) + +(defmethod print-object ((o material) s) + (print-unreadable-object (o s :type t) + (princ (material-name o) s))) + +(defmacro define-material (name multiplier) + `(defparameter ,(symb '* name '*) + (make-material ,(string-downcase (substitute #\space #\- (symbol-name name))) + ,multiplier))) + + +(define-material iron 1.0) +(define-material steel 1.5) +(define-material silver 2.0) +(define-material meteoric-iron 4.0) +(define-material mithril 10.0) +(define-material adamantine 11.0) + + +(define-material cloth 1.0) +(define-material leather 1.5) +(define-material silk 2.0) +(define-material spider-silk 6.0) + + +(define-material pine 1.0) ; http://www.wood-database.com/wood-articles/bow-woods/ +(define-material poplar 1.2) +(define-material walnut 1.3) +(define-material maple 2.0) +(define-material oak 3.0) +(define-material yew 5.0) +(define-material rosewood 10.0) + + +(define-rule (metal :distribution :zipf) + *iron* + *steel* + *silver* + *meteoric-iron* + *mithril* + *adamantine*) + +(define-rule (textile :distribution :weighted) + (1.00 *cloth*) + (1.00 *leather*) + (0.80 *silk*) + (0.01 *spider-silk*)) + +(define-rule (wood :distribution (:zipf :exponent 0.8)) + *pine* + *poplar* + *walnut* + *maple* + *oak* + *yew* + *rosewood*) + + +;;;; Monsters ----------------------------------------------------------------- +(defclass* monster () + (singular multiplier plural adjective)) + +(defun make-monster (singular multiplier plural adjective) + (make-instance 'monster + :singular singular + :multiplier multiplier + :plural plural + :adjective adjective)) + +(defmethod print-object ((o monster) s) + (print-unreadable-object (o s :type t) + (princ (monster-singular o) s))) + +(defmacro define-monster (singular multiplier plural adjective) + `(defparameter ,(symb '* singular '*) + (make-monster + ,(str singular) + ,multiplier + ,(str plural) + ,(str adjective)))) + + +(define-monster goblin 1.00 goblins goblin) +(define-monster kobold 1.00 kobolds kobold) +(define-monster elf 1.00 elves elven) +(define-monster dwarf 1.00 dwarves dwarven) +(define-monster halfling 1.00 halflings halfling) +(define-monster gnome 1.00 gnomes gnomish) +(define-monster gnoll 1.10 gnolls gnollish) +(define-monster ogre 1.20 ogres ogre) +(define-monster troll 1.60 trolls troll) +(define-monster vampire 5.00 vampires vampire) +(define-monster dragon 9.00 dragons dragon) + + +(define-rule (monster :distribution :weighted) + (1.00 *goblin*) + (1.00 *kobold*) + (1.00 *elf*) + (1.00 *dwarf*) + (1.00 *halfling*) + (1.00 *gnome*) + (1.00 *ogre*) + (1.00 *troll*) + (1.00 *gnoll*) + (0.10 *vampire*) + (0.01 *dragon*)) + + +;;;; Roles -------------------------------------------------------------------- +(define-rule role + "cleric" + "warrior" + "wizard" + "rogue") + + +;;;; Elements ----------------------------------------------------------------- +(define-rule element + ("ice" "icy") + ("fire" "flaming") + ("electricity" "electrified") + ("poison" "venomous")) + + +;;;; Armor -------------------------------------------------------------------- +(define-rule armor-piece + "scale mail" + "ring mail" + "chain mail" + "plate mail") + +(define-rule clothing-piece + "robe" + "shirt" + "pants" + "dress" + "skirt") + + +(define-rule armor-enchantment + (:protection-from monster) + (:resistance element) + (:bonus bonus)) + +(define-rule vanilla-armor + (metal armor-piece) + (textile clothing-piece)) + +(define-rule (armor :distribution :weighted) + (2 (vanilla-armor nil)) + (1 (vanilla-armor armor-enchantment))) + + +(defgeneric enchanted-armor-description + (base enchantment-type enchantment-arguments)) + +(defmethod enchanted-armor-description + (base (e (eql :protection-from)) enchantment-args) + (destructuring-bind (monster) enchantment-args + (format nil "~A of protection from ~A" base (monster-plural monster)))) + +(defmethod enchanted-armor-description + (base (e (eql :resistance)) enchantment-args) + (destructuring-bind ((noun adjective)) enchantment-args + (declare (ignore adjective)) + (format nil "~A of ~A resistance" base noun))) + +(defmethod enchanted-armor-description + (base (e (eql :bonus)) enchantment-args) + (destructuring-bind (val) enchantment-args + (format nil "+~D ~A" val base))) + + +(defun vanilla-armor-description (vanilla-armor) + (destructuring-bind (material piece) vanilla-weapon + (format nil "~A ~A" (material-name material) piece))) + + +(defun armor-description (armor) + (destructuring-bind (vanilla enchant) armor + (let ((vanilla-description (vanilla-armor-description vanilla))) + (if enchant + (enchanted-armor-description vanilla-description + (first enchant) + (rest enchant)) + vanilla-description)))) + + +;;;; Weapons ------------------------------------------------------------------ +(define-rule melee-weapon + "dagger" + "longsword" + "short sword" + "hand axe" + "battleaxe" + "spear" + "halberd" + "scythe" + "scimitar" + "lance" + "hammer" + "staff" + "mace" + "flail") + +(define-rule (bow-weapon :distribution :weighted) + (2 "shortbow") + (2 "longbow") + (1 "crossbow") + (1 "compound bow")) + + +(define-rule weapon-enchantment + (:slaying monster) + (:element element) + (:bonus bonus)) + + +(define-rule vanilla-weapon + (metal melee-weapon) + (wood bow-weapon)) + +(define-rule (weapon :distribution :weighted) + (1 (vanilla-weapon nil)) + (1 (vanilla-weapon weapon-enchantment))) + + +(defgeneric enchanted-weapon-description + (base enchantment-type enchantment-arguments)) + +(defmethod enchanted-weapon-description + (base (e (eql :slaying)) enchantment-args) + (destructuring-bind (monster) enchantment-args + (format nil "~A of ~A-slaying" base (monster-singular monster)))) + +(defmethod enchanted-weapon-description + (base (e (eql :element)) enchantment-args) + (destructuring-bind (element) enchantment-args + (format nil "~A ~A" (second element) base))) + +(defmethod enchanted-weapon-description + (base (e (eql :bonus)) enchantment-args) + (destructuring-bind (val) enchantment-args + (format nil "+~D ~A" val base))) + + +(defun vanilla-weapon-description (vanilla-weapon) + (destructuring-bind (material piece) vanilla-weapon + (format nil "~A ~A" (material-name material) piece))) + + +(defun weapon-description (weapon) + (destructuring-bind (vanilla enchant) weapon + (let ((vanilla-description (vanilla-weapon-description vanilla))) + (if enchant + (enchanted-weapon-description vanilla-description + (first enchant) + (rest enchant)) + vanilla-description)))) + + +;;;; Flavor ------------------------------------------------------------------- +(defparameter *monster* nil) + +(define-string sales-pitch + "Only used once!" + "Brand new!" + ("I bought it from" [(eval (monster-adjective (monster))) a] role :. ".") + "This is gonna go fast!") + + +;;;; Main --------------------------------------------------------------------- +(define-rule item + (eval (weapon-description (weapon))) + (eval (armor-description (armor)))) + +(define-string offer + ("FOR SALE:" #\newline :. + [item cap] #\newline :. + sales-pitch)) + + +;;;; API ---------------------------------------------------------------------- +(defun random-string () + (offer)) + + diff -r 6c0ee26dbcbd -r 1a365d4ae7bc vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Tue Jan 17 11:08:42 2017 +0000 +++ b/vendor/make-quickutils.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -4,6 +4,7 @@ "quickutils.lisp" :utilities '( + :compose :curry :ensure-boolean :ensure-gethash @@ -12,6 +13,7 @@ :once-only :rcurry :read-file-into-string + :symb :with-gensyms :write-string-into-file diff -r 6c0ee26dbcbd -r 1a365d4ae7bc vendor/quickutils.lisp --- a/vendor/quickutils.lisp Tue Jan 17 11:08:42 2017 +0000 +++ b/vendor/quickutils.lisp Wed Jan 18 00:32:30 2017 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :N-GRAMS :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :WITH-GENSYMS :WRITE-STRING-INTO-FILE) :ensure-package T :package "MAGITEK.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :N-GRAMS :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS :WRITE-STRING-INTO-FILE) :ensure-package T :package "MAGITEK.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "MAGITEK.QUICKUTILS") @@ -14,11 +14,11 @@ (when (boundp '*utilities*) (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION - :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH - :ENSURE-LIST :TAKE :N-GRAMS :ONCE-ONLY - :RCURRY :WITH-OPEN-FILE* - :WITH-INPUT-FROM-FILE - :READ-FILE-INTO-STRING + :COMPOSE :CURRY :ENSURE-BOOLEAN + :ENSURE-GETHASH :ENSURE-LIST :TAKE + :N-GRAMS :ONCE-ONLY :RCURRY + :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE + :READ-FILE-INTO-STRING :MKSTR :SYMB :STRING-DESIGNATOR :WITH-GENSYMS :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE)))) @@ -46,6 +46,35 @@ (fdefinition function-designator))) ) ; eval-when + (defun compose (function &rest more-functions) + "Returns a function composed of `function` and `more-functions` that applies its ; +arguments to to each in turn, starting from the rightmost of `more-functions`, +and then calling the next one with the primary value of the last." + (declare (optimize (speed 3) (safety 1) (debug 1))) + (reduce (lambda (f g) + (let ((f (ensure-function f)) + (g (ensure-function g))) + (lambda (&rest arguments) + (declare (dynamic-extent arguments)) + (funcall f (apply g arguments))))) + more-functions + :initial-value function)) + + (define-compiler-macro compose (function &rest more-functions) + (labels ((compose-1 (funs) + (if (cdr funs) + `(funcall ,(car funs) ,(compose-1 (cdr funs))) + `(apply ,(car funs) arguments)))) + (let* ((args (cons function more-functions)) + (funs (make-gensym-list (length args) "COMPOSE"))) + `(let ,(loop for f in funs for arg in args + collect `(,f (ensure-function ,arg))) + (declare (optimize (speed 3) (safety 1) (debug 1))) + (lambda (&rest arguments) + (declare (dynamic-extent arguments)) + ,(compose-1 funs)))))) + + (defun curry (function &rest arguments) "Returns a function that applies `arguments` and the arguments it is called with to `function`." @@ -210,6 +239,23 @@ :while (= bytes-read buffer-size))))))) + (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." @@ -281,8 +327,8 @@ (write-sequence string file-stream))) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(curry ensure-boolean ensure-gethash ensure-list n-grams once-only - rcurry read-file-into-string with-gensyms with-unique-names - write-string-into-file))) + (export '(compose curry ensure-boolean ensure-gethash ensure-list n-grams + once-only rcurry read-file-into-string symb with-gensyms + with-unique-names write-string-into-file))) ;;;; END OF quickutils.lisp ;;;;