RCRPG/Clojure

Clojure version of RCRPG. The code can also be checked out and contributed to on github .

Code

<lang lisp> (ns rosettacode.rcrpg.clojure) (use '[clojure.string :only (join split)])

(defn split-keys

 "returns map m (with string keys) creating multiple entries for keys separated by regex splitter."
 [m splitter]
 (apply hash-map (flatten
   (map #(let [splitted (split (first %) splitter)]
           (if (> (count splitted) 1)
               (map vector splitted (repeat (second %)))
               %)) m))))

(def *translation-map*

 (split-keys {"drop" "drop-item"
              "get|take" "take-item"
              "i|inv" "inventory"
              "n|north" "move north"
              "w|west" "move west"
              "s|south" "move south"
              "e|east" "move east"
              "u|up" "move up"
              "d|down" "move down"
              "alias" "alias-command"
              "name" "name-room"} #"\|"))

(def *base-valid-actions* #{:drop-item :take-item :inventory :move :alias-command :name-room :dig :help :equip :look})

(defn valid-actions

 [aliases]
 (into #{}
   (concat
     (map keyword (keys aliases))
     *base-valid-actions*)))

room = (x y z [on-the-ground])

(def *world-state* {:maze {[0 0 0] #{:sledge}

                          [1 1 5] #{:lots-of-gold}}
                   :inventory #{}
                   :current-room [0 0 0]
                   :equipped nil
                   :aliases *translation-map*
                   :named-rooms {[0 0 0] "the starting room"
                                 [1 1 5] "the prince room"}})

(def *directions* [:north :west :south :east :up :down])

(def *coords*

 (zipmap *directions*  [[0  1  0 ]
                        [-1 0  0 ]
                        [0 -1  0 ]
                        [1  0  0 ]
                        [0  0  1 ]
                        [0  0  -1]]))

(defn translate

 "if source is a key of target, returns the value as a sequence (split by spaces), else returns source."
 [source target]
 (split (if-let [t (get target source)] t source) #" "))

** utilities ** ;;

(defn coord-at

 "given a coordinate (eg. [1 1 1]) and a direction (eg. :north) returns the coordinate for the direction (eg. [1 2 1])"
 [current direction]
 (vec (map + (direction *coords*) current)))

(defn current-room

 "returns the room the player is in, eg. [[1 2 3] #{:gold}]"
 [world]
 [(:current-room world) ((world :maze) (world :current-room ))])

(defn room-position

 "returns the coordinate for room (eg. [1 2 1])"
 [room]
 (first room))

(defn room-ground

 "returns the content of room (eg. #{gold})"
 [room]
 (second room))

(defn in?

 "returns true if k is in sequence"
 [coll k]
 (some #{k} coll))

(defn in-inv?

 "returns true if the player has item in her inventory"
 [world item]
 (in? (world :inventory) item))

(defn new-room-at

 "returns a new room relative to the player's current position, towards direction"
 [world direction]
 [(coord-at (world :current-room) direction) (hash-set (rand-nth [:gold :sledge :ladder]))])

(defn valid-direction

 "fn if direction is valid, otherwise prints an error message, else fnelse"
 [direction]
 (in? *directions* direction))

** describing rooms ** ;;

(defn find-exits

 "returns a list of directions with the exit directions for room, eg. (:north :east)"
 [room world]
 (let [calc-neighbour #(map + (room-position room) (second %))
       maze (world :maze)]
   (->> *coords* (filter #(contains? maze (calc-neighbour %))) (map key))))

(defn exit?

 "returns true if room has an exit towards direction"
 [room world direction]
 (in? (find-exits room world) direction))

(defn describe-exits

 "returns string describing the exits in room"
 [room world]
 (let [exits-to-string (fn [exits]
         (cond
         (= (count exits) 1) (str " There is an exit " (name (first exits)) "ward")
         (not-empty exits) (str " There are exits at " (->> exits (map name) (join ", ")) ".")
         :else ""))]
   (exits-to-string (find-exits room world))))

(defn describe-items

 "returns a description of items"
 [items]
 (let [i (reduce #(conj %1
           (case %2
             :sledge "a sledge"
             :gold "some gold coins"
             :ladder "a ladder lying down"
             :lots-of-gold "LOTS of gold!"))
           [] items)]
    (str
      (join ", " (drop-last 2 i))
      (when (> (count i) 2) ", ")
      (join " and " (take-last 2 i)))))

(defn describe-ground

 "returns string describing the exits in room"
 [room]
 (let [room-content (room-ground room)]
 (if  (not-empty room-content)
    (str " On the ground you can see: " (describe-items room-content) "."))))

(defn describe

 "prints a description of room"
 [room world]
 (let [room-name (if-let [r ((world :named-rooms) (room-position room))]
         (str " (" r ")")
         nil)]
   (str "You are at "
     (join " "  (room-position room))
     room-name "."
     (describe-ground room)
     (describe-exits room world))))

(defn perform-action

 [world action args]
 (let [result (apply (resolve (symbol action)) (conj args world ))]
   (cond
     (string? result) (do (println result) world)
     (vector? result) (do (println (first result)) (second result) ))))

** actions ** ;;

(defn look [world]

 "describes the room the player is in"
 (describe (current-room world) world))

(defn dig

 "digs a new room towards direction if there's not a room already and the player has a sledge"
 ([world direction]
   (let [dir (keyword direction)]
     (if (valid-direction dir)
       (if (exit? (current-room world) world dir)
         "There is already a room!"
         (if (= (world :equipped) :sledge)
           [(str "You dig a new room " direction "ward.")
             (assoc world :maze (merge (world :maze) (new-room-at world dir)))]
           "You need to equip a sledge in order to dig the wall!"))
       "Where?!")))
 ([world] "Where do you want to dig?"))

(defn move

 "moves the player to an adjacent room and describes it"
 ([world direction]
   (let [dir (keyword direction)
         target-coord (coord-at (room-position (current-room world)) dir)]
     (if (valid-direction dir)
       (if (exit? (current-room world) world dir)
         (if (and (= dir :up) (not ((room-ground (current-room world)) :ladder)))
           "You cannot go up if there's no ladder in the room."
           (let [updated-world (assoc world :current-room target-coord)]
             [(describe (current-room updated-world) updated-world)
              updated-world]))
         "There's no exit in that direction!")
       "Where?!")))
 ([world] "Where do you want to go?"))

(defn equip

 "equips an item if specified and if the player has it in her inventory"
 ([world item]
   (let [i (keyword item)]
     (if (in-inv? world i)
       ["Equipped!"
        (assoc world :equipped i)])
       "You haven't such an item"))
 ([world] "What do you want to equip?"))

(defn drop-item

 "drops an item in the inventory or all of them leaving it in the room"
 ([world item]
   (let [i (keyword item)
         current-position (get world :current-room)
         current-ground (room-ground (current-room world))
         current-maze (world :maze)
         current-inventory (world :inventory)
         update-room (partial assoc current-maze current-position)
         equipped-item (world :equipped)]
     (if (= i :all)
       ["Everything dropped!"
        (assoc world
           :equipped nil
           :inventory #{}
           :maze (update-room (clojure.set/union current-ground current-inventory)))]
       (if (in-inv? world i)
         ["Item dropped!"
          (assoc world
            :equipped (if (= equipped-item i) nil equipped-item)
            :inventory (disj current-inventory i)
            :maze (update-room (conj current-ground i)))]
         "You haven't such an item"))))
 ([world] "What do you want to drop?"))

(defn take-item

 "picks up an item from the ground or all of them putting them into the inventory"
 ([world item]
   (let [i (keyword item)
         current-position (get world :current-room)
         current-ground (room-ground (current-room world))
         current-maze (:maze world)
         current-inventory (world :inventory)
         update-room (partial assoc current-maze current-position)
         equipped-item (world :equipped)]
     (if (= i :all)
       ["Everything taken!"
        (assoc world
          :inventory (clojure.set/union current-inventory current-ground)
          :maze (update-room #{}))]
       (if (in? current-ground i)
         ["Item taken!"
          (assoc world
            :inventory (conj current-inventory i)
            :maze (update-room (disj current-ground i)))]
         "There is not such item on the ground!"))))
 ([world] "What do you want to pick up?"))

(defn inventory

 "prints what the player is carrying"
 [world]
 (let [inv (world :inventory)]
   (if (empty? inv)
      "You are not carrying anything"
      (str "You are carrying: " (describe-items inv)))))

(defn equip

 ([world item]
   (let [i (keyword item)]
     (if (in-inv? world i)
       ["Item equipped." (assoc world :equipped i)]
       "You haven't such item")))
 ([world] "What do you want to equip?"))

(defn alias-command

 "aliases command to alias"
 ([world alias & commands]
   (let [command (join " " commands)
         current-aliases (world :aliases)]
     [(str "Alias created for the command " command) (assoc world :aliases (assoc current-aliases alias command))]))
 ([world] "Alias what?")
 ([world alias] (str "Alias '" alias "' to what?")))

(defn name-room

 "tags the current location with alias"
 ([world & alias]
   (let [a (join " " alias)
         current-named-room (world :named-rooms)
         current-location (room-position (current-room world))]
     ["Done!" (assoc world :named-rooms (assoc current-named-room current-location a))]))
 ([world]  "What name?"))

(defn help

 "prints an help message"
 [world]
 (str
   "Welcome to the dungeon!\n"
   "You need a sledge to dig rooms and ladders to go upwards.\n"
   "Valid commands are: directions (north, south...), dig, take, drop, equip, inventory and look.\n"
   "Additionally you can tag rooms with the 'name' command and alias commands with 'alias'.\n"
   "Have fun!\n"))

** user input ** ;;

(defn sanitize-input

 "lowercases input, splits it into words and trims the tokens"
 [input]
 (remove empty? (-> input .toLowerCase .trim (split #" "))))

(defn parse-input

 "interprets user input. returns an updated world state if the game has to continue, nil if the user inputs 'exit'"
 [input world]
 (if (not-empty input)
   (let [sanitized-input (sanitize-input input)
         command (translate (first sanitized-input) (world :aliases))
         i (concat command (rest sanitized-input))
         [action & args] i
         current-valid-actions (world :aliases)]
     (cond
       (= (first i) "exit") nil
       (contains? (valid-actions current-valid-actions) (keyword action))
         (try (perform-action world action args)
         (catch IllegalArgumentException e (println "Invalid arguments") world))
       :else (do (println "What do you mean?") world)))
   (do
     (println "Hm?!")
     world)))

main loop

(defn run

 "the main game loop"
 []
 (do
   (println "Welcome to the dungeon!\nGrab the sledge and make your way to room 1,1,5 for a non-existant prize!")
   (loop [input (read-line)
          world *world-state*]
     (if-let [w (parse-input input world)]
             (recur (read-line) w)
             (println "See you next time!")))))

(run) </lang>