--- a/Makefile Wed Jan 18 00:58:51 2017 +0000
+++ b/Makefile Wed Jan 18 18:07:55 2017 +0000
@@ -1,4 +1,4 @@
-.PHONY: vendor
+.PHONY: vendor binary
# Vendor ----------------------------------------------------------------------
vendor/quickutils.lisp: vendor/make-quickutils.lisp
@@ -10,6 +10,8 @@
# Build -----------------------------------------------------------------------
lisps := $(shell ffind '\.(asd|lisp|ros)$$')
+binary: build/magitek
+
build/magitek: $(lisps)
ros build build/magitek.ros
--- a/src/robots/git-commands.lisp Wed Jan 18 00:58:51 2017 +0000
+++ b/src/robots/git-commands.lisp Wed Jan 18 18:07:55 2017 +0000
@@ -75,31 +75,31 @@
external-location)
-(define-string action
- (list "bisect" "bisecting")
- (list "clone" "cloning")
- (list "commit" "committing")
- (list "delete" "deleting")
- (list "display" "displaying")
- (list "fast-forward" "fast-forwarding")
- (list "fetch" "fetching")
- (list "merge" "merging")
- (list "move" "moving")
- (list "print" "printing")
- (list "prune" "pruning")
- (list "pull" "pulling")
- (list "push" "pushing")
- (list "record" "recording")
- (list "revert" "reverting")
- (list "remove" "removing")
- (list "rename" "renaming")
- (list "reset" "resetting")
- (list "resolve" "resolving")
- (list "show" "showing")
- (list "sign" "signing")
- (list "simplify" "simplifying")
- (list "update" "updating")
- (list "verify" "verifying"))
+(define-rule action
+ ("bisect" "bisecting")
+ ("clone" "cloning")
+ ("commit" "committing")
+ ("delete" "deleting")
+ ("display" "displaying")
+ ("fast-forward" "fast-forwarding")
+ ("fetch" "fetching")
+ ("merge" "merging")
+ ("move" "moving")
+ ("print" "printing")
+ ("prune" "pruning")
+ ("pull" "pulling")
+ ("push" "pushing")
+ ("record" "recording")
+ ("revert" "reverting")
+ ("remove" "removing")
+ ("rename" "renaming")
+ ("reset" "resetting")
+ ("resolve" "resolving")
+ ("show" "showing")
+ ("sign" "signing")
+ ("simplify" "simplifying")
+ ("update" "updating")
+ ("verify" "verifying"))
(defun action-verb ()
(first (action)))
@@ -163,15 +163,14 @@
(defun shellify (str)
(string-downcase (substitute #\- #\space str)))
+
(define-string short-option%
("-" :. letter)
("-" :. letter [noun shellify string-upcase]))
-(defparameter *noun* nil)
-
(define-string long-option%
- (eval (let ((*noun* (gen-string [noun shellify])))
- (gen-string ("--" :. *noun* :. "=<" :. *noun* :. ">"))))
+ !(let ((noun $[noun shellify]))
+ $("--" :. !noun :. "=<" :. !noun :. ">"))
("--" :. action-verb)
("--" :. extremum)
("--only-" :. adjective)
@@ -197,28 +196,26 @@
(long-option short-options))
-(defparameter *command* nil)
-(defparameter *commanding* nil)
-
-(define-string description
- (look-for location "for the" age noun "and" *command* "it")
- ("read" (eval (+ 2 (random 2000))) "bytes from" location "and" *command* "them")
- (*command* "the" extremum noun "in" git-location)
- (*command* [noun a] temporal-adverb refreshing git-location)
- (*command* "and push all" adjective [noun s] "to" location)
- (*command* "all" adjective [noun s] "in" git-location)
- (*command* "the" extremum "and merge it into" git-location)
- (*command* "some" [noun s] "from a remote")
- (*command* "two or more" [noun s] "and save them to" location)
- ("move or" *command* [noun a] "in" git-location)
- ("rebase" [noun a] "onto" location "after" *commanding* "it")
- (*command* "and" refresh git-location)
- ("list," *command* :. ", or delete" [noun s]))
+(define-string (description :arguments (command commanding))
+ (look-for location "for the" age noun "and" !command "it")
+ ("read" (eval (+ 2 (random 2000))) "bytes from" location "and" !command "them")
+ (!command "the" extremum noun "in" git-location)
+ (!command [noun a] temporal-adverb refreshing git-location)
+ (!command "and push all" adjective [noun s] "to" location)
+ (!command "all" adjective [noun s] "in" git-location)
+ (!command "the" extremum "and merge it into" git-location)
+ (!command "some" [noun s] "from a remote")
+ (!command "two or more" [noun s] "and save them to" location)
+ ("move or" !command [noun a] "in" git-location)
+ ("rebase" [noun a] "onto" location "after" !commanding "it")
+ (!command "and" refresh git-location)
+ ("list," !command :. ", or delete" [noun s]))
(defun entry ()
- (destructuring-bind (*command* *commanding*) (action)
- (gen-string
- ("git" *command* options #\newline :. [description cap]))))
+ (destructuring-bind (command commanding) (action)
+ $("git" !command options #\newline :.
+ [!(description command commanding) cap])))
+
;;;; API ----------------------------------------------------------------------
(defun random-string ()
--- a/src/robots/rpg-shopkeeper.lisp Wed Jan 18 00:58:51 2017 +0000
+++ b/src/robots/rpg-shopkeeper.lisp Wed Jan 18 18:07:55 2017 +0000
@@ -1,23 +1,11 @@
(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))
@@ -30,56 +18,55 @@
(princ (material-name o) s)))
(defmacro define-material (name multiplier)
- `(defparameter ,(symb '* name '*)
- (make-material ,(string-downcase (substitute #\space #\- (symbol-name name)))
- ,multiplier)))
+ `(defparameter ,(symb '* (string-upcase (substitute #\- #\space name)) '*)
+ (make-material ,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 "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 "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-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*)
+ !*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*))
+ (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*)
+ !*pine*
+ !*poplar*
+ !*walnut*
+ !*maple*
+ !*oak*
+ !*yew*
+ !*rosewood*)
;;;; Monsters -----------------------------------------------------------------
@@ -98,39 +85,39 @@
(princ (monster-singular o) s)))
(defmacro define-monster (singular multiplier plural adjective)
- `(defparameter ,(symb '* singular '*)
+ `(defparameter ,(symb '* (string-upcase singular) '*)
(make-monster
- ,(str singular)
+ ,singular
,multiplier
- ,(str plural)
- ,(str adjective))))
+ ,plural
+ ,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-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*))
+ (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 --------------------------------------------------------------------
@@ -287,26 +274,37 @@
;;;; Flavor -------------------------------------------------------------------
-(defparameter *monster* nil)
+(define-string scene
+ ("images of" [monster monster-plural] "fighting" [monster monster-plural])
+ ("a picture of a famous" [monster monster-singular] role))
-(define-string scene
- ("images of" [monster monster-plural]))
+(define-string picture
+ "painted with"
+ "adorned with")
+
+(define-string flavor
+ (picture scene))
(define-string sales-pitch
"Only used once!"
"Brand new!"
- ("I bought it from" [monster monster-adjective a] role)
+ ("I bought it from" [monster monster-adjective a] role :. ".")
+ "Look at the workmanship!"
"This is gonna go fast!")
;;;; Main ---------------------------------------------------------------------
-(define-rule item
- (eval (weapon-description (weapon)))
- (eval (armor-description (armor))))
+(define-rule base-item
+ !(weapon-description @weapon)
+ !(armor-description @armor))
+
+(define-string (item :distribution :weighted)
+ (2 base-item)
+ (1 (base-item :. "," flavor)))
(define-string offer
- ("FOR SALE:" #\newline :.
- [item cap] #\newline #\newline :.
+ ("FOR SALE:" [item cap]
+ :. #\newline #\newline :.
sales-pitch))