# HG changeset patch # User Steve Losh # Date 1484762875 0 # Node ID 496f6e33e468b9a284b0d47749904a03baf09545 # Parent bd040b0b5943edaa28f05bf3563570fbdd94f6aa Update to compiling version of Chancery diff -r bd040b0b5943 -r 496f6e33e468 Makefile --- 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 diff -r bd040b0b5943 -r 496f6e33e468 src/robots/git-commands.lisp --- 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 () diff -r bd040b0b5943 -r 496f6e33e468 src/robots/rpg-shopkeeper.lisp --- 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))