Source Code
(def objects '(whiskey-bottle bucket frog chain)) ;; Helpers (defn spel-print [list] (map (fn [x] (symbol (name x))) list)) ;; map is in namespace, so we use game-map. Clojure has no association ;; lists, but it has hash maps, so we put the map in a hash map (def game-map (hash-map 'living-room '((you are in the living-room of a wizards house - there is a wizard snoring loudly on the couch -) (west door garden) (upstairs stairway attic)) 'garden '((you are in a beautiful garden - there is a well in front of you -) (east door living-room)) 'attic '((you are in the attic of the wizards house - there is a giant welding torch in the corner -) (downstairs stairway living-room)))) ;; Object locations in a hash map (def object-locations (hash-map 'whiskey-bottle 'living-room 'bucket 'living-room 'chain 'garden 'frog 'garden)) (def location 'living-room) (defn describe-location [location game-map] (first (location game-map))) ;; in clojure backquote mode, the ~ escapes the mode instead of the comma (defn describe-path [path] `(there is a ~(second path) going ~(first path) from here -)) (defn describe-paths [location game-map] (apply concat (map describe-path (rest (get game-map location))))) (defn is-at? [obj loc obj-loc] (= (obj obj-loc) loc)) (defn describe-floor [loc objs obj-loc] (apply concat (map (fn [x] `(you see a ~x on the floor -)) (filter (fn [x] (is-at? x loc obj-loc)) objs)))) (defn look [] (spel-print (concat (describe-location location game-map) (describe-paths location game-map) (describe-floor location objects object-locations)))) (defn walk-direction [direction] (let [next (first (filter (fn [x] (= direction (first x))) (rest (location game-map))))] (cond next (do (def location (nth next 2)) (look)) :else '(you cannot go that way -)))) ;; SPELS (Macros) ;; Note that Clojure does not have a &rest keyword - instead of ;; (&rest rest), we use [& rest] to achieve the same, Clojure also uses "~" instead ;; of "," in a backquote expression (defmacro defspel [& rest] `(defmacro ~@rest)) (defspel walk [direction] `(walk-direction '~direction)) (defn pickup-object [object] (cond (is-at? object location object-locations) (do (def object-locations (assoc object-locations object 'body)) `(you are now carrying the ~object)) :else '(you cannot get that.))) (defspel pickup [object] `(spel-print (pickup-object '~object))) (defn inventory [] (filter (fn [x] (is-at? x 'body object-locations)) objects)) (defn have? [object] (some #{object} (inventory))) ;; Page 25 (def chain-welded false) ;; weld implemented as a function ;(defn weld [subject object] ; (cond (and (= location 'attic) ; (= subject 'chain) ; (= object 'bucket) ; (have? 'chain) ; (have? 'bucket) ; (not chain-welded)) ; (do (def chain-welded true) ; '(the chain is now securely welded to the bucket -)) ; :else '(you cannot weld like that -))) ;; Page 26 (def bucket-filled false) ;; dunk implemented as a function ;(defn dunk [subject object] ; (cond (and (= location 'garden) ; (= subject 'bucket) ; (= object 'well) ; (have? 'bucket) ; chain-welded) ; (do (def bucket-filled true) ; '(the bucket is now full of water)) ; :else '(you cannot dunk like that -))) (defspel game-action [command subj obj place & args] `(defspel ~command [subject# object#] `(spel-print (cond (and (= location '~'~place) (= '~subject# '~'~subj) (= '~object# '~'~obj) (have? '~'~subj)) ~@'~args :else '(i cannot ~'~command like that -))))) (game-action weld chain bucket attic (cond (and (have? 'bucket) (def chain-welded true)) '(the chain is now securely welded to the bucket -) :else '(you do not have a bucket -))) (game-action dunk bucket well garden (cond chain-welded (do (def bucket-filled true) '(the bucket is now full of water)) :else '(the water level is too low to reach -))) (game-action splash bucket wizard living-room (cond (not bucket-filled) '(the bucket has nothing in it -) (have? 'frog) '(the wizard awakens and sees that you stole his frog - he is so upset he banishes you to the netherworlds - you lose! the end -) :else '(the wizard awakens from his slumber and greets you warmly - he hands you the magic low-carb donut - you win! the end -))) ;; Game start (look)