├── webserver ├── foo.file ├── doc │ └── intro.md ├── .gitignore ├── README.md ├── project.clj ├── src │ └── thornydev │ │ ├── web │ │ ├── handlers.clj │ │ └── server.clj │ │ └── clj_sockets.clj └── test │ └── thornydev │ └── web │ └── server_test.clj ├── .gitignore ├── evolution ├── doc │ └── intro.md ├── .gitignore ├── test │ └── thornydev │ │ └── evolution │ │ └── sim_test.clj ├── README.md ├── project.clj └── src │ └── thornydev │ └── evolution │ └── sim.clj ├── orc-battle ├── doc │ └── intro.md ├── .gitignore ├── README.md ├── project.clj ├── src │ └── thornydev │ │ └── orc │ │ ├── util.clj │ │ └── game.clj └── test │ └── thornydev │ └── orc │ ├── monsters.clj │ └── game_test.clj ├── dice-of-doom ├── doc │ └── intro.md ├── .gitignore ├── test │ └── thornydev │ │ └── doomdice │ │ └── game_test.clj ├── README.md ├── project.clj └── src │ └── thornydev │ └── doomdice │ └── game.clj ├── grand-theft-wumpus ├── doc │ └── intro.md ├── .gitignore ├── test │ └── thornydev │ │ └── wumpus │ │ └── game_test.clj ├── src │ └── thornydev │ │ └── wumpus │ │ ├── bench.clj │ │ ├── graphing.clj │ │ └── game.clj ├── README.md └── project.clj ├── wizards-adventure ├── doc │ ├── intro.md │ └── wizards_game.lisp ├── .gitignore ├── test │ └── thornydev │ │ └── wizadv │ │ └── game_test.clj ├── README.md ├── project.clj └── src │ └── thornydev │ ├── graph │ └── graphing.clj │ └── wizadv │ └── game.clj ├── notes-on-branches.org └── README.md /webserver/foo.file: -------------------------------------------------------------------------------- 1 | Line 1 2 | EOL -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | repl-port 2 | *.dot 3 | *.svg 4 | *.swp 5 | /attack-of-the-robots 6 | -------------------------------------------------------------------------------- /evolution/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to evolution 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /orc-battle/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to orc-battle 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /webserver/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to webserver 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /dice-of-doom/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to dice-of-doom 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /grand-theft-wumpus/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to wumpus 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /dice-of-doom/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /evolution/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /orc-battle/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /webserver/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /wizards-adventure/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to wizards-adventure 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /grand-theft-wumpus/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /notes-on-branches.org: -------------------------------------------------------------------------------- 1 | attack-robots branch: not finished, not merged 2 | => probably will not finish 3 | doomdice: in progress, merge into master once finsih webserver project 4 | -------------------------------------------------------------------------------- /wizards-adventure/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | *.dot 12 | *.svg 13 | -------------------------------------------------------------------------------- /evolution/test/thornydev/evolution/sim_test.clj: -------------------------------------------------------------------------------- 1 | (ns evolution.core-test 2 | (:use clojure.test 3 | evolution.core)) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) -------------------------------------------------------------------------------- /grand-theft-wumpus/test/thornydev/wumpus/game_test.clj: -------------------------------------------------------------------------------- 1 | (ns wumpus.core-test 2 | (:use clojure.test 3 | wumpus.core)) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) -------------------------------------------------------------------------------- /wizards-adventure/test/thornydev/wizadv/game_test.clj: -------------------------------------------------------------------------------- 1 | (ns wizards-adventure.core-test 2 | (:use clojure.test 3 | wizards-adventure.core)) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) -------------------------------------------------------------------------------- /dice-of-doom/test/thornydev/doomdice/game_test.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.doomdice.game-test 2 | (:use clojure.test 3 | thornydev.doomdice.game)) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) 8 | -------------------------------------------------------------------------------- /grand-theft-wumpus/src/thornydev/wumpus/bench.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.wumpus.bench 2 | (:require [thornydev.wumpus.game :refer :all] 3 | [criterium.core :refer [bench]])) 4 | 5 | 6 | 7 | (defn run-bench [] 8 | (bench (make-city-edges)) 9 | ) 10 | 11 | -------------------------------------------------------------------------------- /evolution/README.md: -------------------------------------------------------------------------------- 1 | # evolution 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /webserver/README.md: -------------------------------------------------------------------------------- 1 | # webserver 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /orc-battle/README.md: -------------------------------------------------------------------------------- 1 | # orc-battle 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /dice-of-doom/README.md: -------------------------------------------------------------------------------- 1 | # dice-of-doom 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /grand-theft-wumpus/README.md: -------------------------------------------------------------------------------- 1 | # wumpus 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /wizards-adventure/README.md: -------------------------------------------------------------------------------- 1 | # wizards-adventure 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2012 FIXME 12 | 13 | Distributed under the Eclipse Public License, the same as Clojure. 14 | -------------------------------------------------------------------------------- /evolution/project.clj: -------------------------------------------------------------------------------- 1 | (defproject evolution "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"]]) 7 | -------------------------------------------------------------------------------- /orc-battle/project.clj: -------------------------------------------------------------------------------- 1 | (defproject orc-battle "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"]]) 7 | -------------------------------------------------------------------------------- /dice-of-doom/project.clj: -------------------------------------------------------------------------------- 1 | (defproject dice-of-doom "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"]]) 7 | -------------------------------------------------------------------------------- /wizards-adventure/project.clj: -------------------------------------------------------------------------------- 1 | (defproject wizards-adventure "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"]]) 7 | -------------------------------------------------------------------------------- /grand-theft-wumpus/project.clj: -------------------------------------------------------------------------------- 1 | (defproject wumpus "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"] 7 | [criterium "0.3.0"]]) 8 | -------------------------------------------------------------------------------- /webserver/project.clj: -------------------------------------------------------------------------------- 1 | (defproject webserver "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"] 7 | [server-socket "1.0.0"]] 8 | :profiles {:dev {:dependencies [[midje "1.4.0"] 9 | [lazytest "1.2.3"]] 10 | :plugins [[lein-midje "2.0.1"]]}}) 11 | -------------------------------------------------------------------------------- /webserver/src/thornydev/web/handlers.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.web.handlers) 2 | 3 | (defn html [s] 4 | (format "%s" s)) 5 | 6 | (defn body [s] 7 | (format "%s" s)) 8 | 9 | (defn hello-request-handler [path mheader params] 10 | (if (re-find #"^greeting" path) 11 | (if (and params (params "name")) 12 | (println (html (body (str "Nice to meet you " (params "name"))))) 13 | (println (html (body "
What is your name?
")))) 14 | (println (html (body "Sorry don't know that page"))))) 15 | 16 | (comment 17 | (hello-request-handler "greeting" {"name" "Larry"} nil) 18 | ) 19 | -------------------------------------------------------------------------------- /webserver/src/thornydev/clj_sockets.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.clj-sockets 2 | (:import (java.io BufferedReader IOException InputStreamReader PrintWriter) 3 | (java.net ServerSocket Socket InetAddress))) 4 | 5 | (defn socket-server [port] 6 | (println "socket server being created") 7 | (ServerSocket. port)) 8 | 9 | (defn socket-accept [^ServerSocket server-socket] 10 | (println "socket accept") 11 | (.accept server-socket)) 12 | 13 | (defn socket-reader [^Socket socket] 14 | (println "socket-reader called") 15 | (BufferedReader. (InputStreamReader. (.getInputStream socket)))) 16 | 17 | (defn socket-writer [^Socket socket] 18 | (println "socket-writer called") 19 | (PrintWriter. (.getOutputStream socket) true)) 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Land of Lisp in Clojure 2 | 3 | As I did with [The Little Schemer](https://github.com/midpeter444/little-schemer) and [The Seasoned Schemer](https://github.com/midpeter444/little-schemer/tree/master/clojure/seasoned-schemer), I read along Conrad Barski's [Land of Lisp](http://landoflisp.com/) by doing all the exercises in Clojure. My Clojure skills are much stronger than they were when I did the Schemer books, so I hope the Clojure code is more idiomatic. 4 | 5 | In many cases, I did not literally follow Barski's Lisp code, but rather used the data structure most appropriate and idiomatic to Clojure. 6 | 7 | ## Status 8 | 9 | So far I have read through Ch. 14. So the webserver code and all previous chapters are done. I am in the middle of doing Ch. 15 - Dice of Doom version 1. 10 | 11 | Last updated: Dec 2012 12 | -------------------------------------------------------------------------------- /orc-battle/src/thornydev/orc/util.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.orc.util) 2 | 3 | ;; macro from Chas Emerick 2010 blog post to have default values 4 | ;; specified in a defrecord definition 5 | ;; not sure if there is a more "standard" way to do it yet 6 | ;; source: http://cemerick.com/2010/08/02/defrecord-slot-defaults/ 7 | 8 | (defmacro defrecord+defaults 9 | "Defines a new record, along with a new-RecordName factory function that 10 | returns an instance of the record initialized with the default values 11 | provided as part of the record's slot declarations. e.g. 12 | (defrecord+ Foo [a 5 b \"hi\"]) 13 | (new-Foo) 14 | => #user.Foo{:a 5, :b \"hi\"}" 15 | [name slots & etc] 16 | (let [fields (->> slots (partition 2) (map first) vec) 17 | defaults (->> slots (partition 2) (map second))] 18 | `(do 19 | (defrecord ~name 20 | ~fields 21 | ~@etc) 22 | (defn ~(symbol (str "new-" name)) 23 | ~(str "A factory function returning a new instance of " name 24 | " initialized with the defaults specified in the corresponding defrecord+ form.") 25 | [] 26 | (~(symbol (str name \.)) ~@defaults)) 27 | ~name))) 28 | 29 | 30 | (defn randval 31 | "Generates a random positive integer from 1 .. n inclusive" 32 | [n] 33 | (inc (rand-int (max 1 n)))) 34 | -------------------------------------------------------------------------------- /wizards-adventure/src/thornydev/graph/graphing.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.graph.graphing 2 | (:require [clojure.string :as str] 3 | [clojure.java.io :as io] 4 | [clojure.java.shell :refer [sh]])) 5 | 6 | (defn substitute-if [val predfn coll] 7 | (map #(if (predfn %) val %) coll)) 8 | 9 | (defn dot-name [kw] 10 | (str/upper-case (str/replace (name kw) "-" "_"))) 11 | 12 | (defn dot-label [vpath] 13 | (let [body (apply str (interpose " " (map name vpath)))] 14 | (str "(" body ")"))) 15 | 16 | (defn edges->dot [edges] 17 | (doseq [start (keys edges) 18 | [end vpath] (start edges)] 19 | (print (dot-name start)) 20 | (print "->") 21 | (print (dot-name end)) 22 | (println (str "[label=\"" (dot-label vpath) "\"];")))) 23 | 24 | (defn uedges->dot [edges] 25 | (let [mkpair (fn [e1 e2] 26 | (map name (sort [e1 e2])))] 27 | (loop [nodes (keys edges) pairs-seen #{}] 28 | (if (empty? nodes) 29 | pairs-seen 30 | (let [start (first nodes) 31 | vpairs (for [[end vpath] (start edges)] 32 | (let [pair (mkpair start end)] 33 | (when-not (pairs-seen pair) 34 | (print (dot-name start)) 35 | (print "--") 36 | (print (dot-name end)) 37 | (println (str "[label=\"" (dot-label vpath) "\"];"))) 38 | pair))] 39 | (recur (rest nodes) (apply conj pairs-seen vpairs))))))) 40 | 41 | (defn graph->dot [edges] 42 | (println "digraph {") 43 | (edges->dot edges) 44 | (println "}")) 45 | 46 | (defn ugraph->dot [edges] 47 | (println "graph {") 48 | (uedges->dot edges) 49 | (println "}")) 50 | 51 | (defn graph-it [m] 52 | (with-open [w (io/writer (:fname m))] 53 | (binding [*out* w] 54 | ((:dotfn m) (:edges m)) 55 | ) 56 | ) 57 | (sh "dot" 58 | (str "-T" (name (:out-type m))) 59 | (:fname m) 60 | "-o" (str "wizout." (name (:out-type m)))) 61 | ) 62 | 63 | (defn graph->svg [fname edges] 64 | (let [args {:fname fname 65 | :edges edges 66 | :dotfn graph->dot 67 | :out-type :svg}] 68 | (graph-it args))) 69 | 70 | (defn ugraph->svg [fname edges] 71 | (let [args {:fname fname 72 | :edges edges 73 | :dotfn ugraph->dot 74 | :out-type :svg}] 75 | (graph-it args))) 76 | 77 | -------------------------------------------------------------------------------- /dice-of-doom/src/thornydev/doomdice/game.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.doomdice.game) 2 | 3 | (def ^:dynamic *num-players* 2) 4 | (def ^:dynamic *max-dice* 3) 5 | (def ^:dynamic *board-size* 2) 6 | (def ^:dynamic *board-hexnum* (* *board-size* *board-size*)) 7 | 8 | (defn board-vector [lst] 9 | (vec lst)) 10 | 11 | ;; TODO: add way to get known board for testing 12 | (defn gen-board [] 13 | (board-vector 14 | (for [n (range *board-hexnum*)] 15 | (vector (rand-int *num-players*) (inc (rand-int *max-dice*)))))) 16 | 17 | (defn player-letter [n] (char (+ 97 n))) 18 | 19 | (defn do-draw-board [board] 20 | (doseq [y (range *board-size*)] 21 | (do 22 | (println) 23 | (dotimes [_ (- *board-size* y)] (print " ")) 24 | (doseq [x (range *board-size*)] 25 | (let [hex (nth board (+ x (* *board-size* y)))] 26 | (print (str (player-letter (first hex)) "-" (second hex) " "))))))) 27 | 28 | (defn game-tree 29 | "@params 30 | board - ??? 31 | player - integer (eg., 0 for white, 1 for black) 32 | spare-dice - integer: number of dice WHERE?? 33 | first-move? - bool: whether is player's first move for this turn 34 | @return ???" 35 | [board player spare-dice first-move?] 36 | (vector player 37 | board 38 | (add-passing-move board 39 | player 40 | spare-dice 41 | first-move? 42 | (attacking-moves board player spare-dice)))) 43 | 44 | ;; TODO: data all the things => something to try here? 45 | (defn add-passing-move 46 | "@params 47 | board - ??? 48 | player - integer (eg., 0 for white, 1 for black) 49 | spare-dice - integer: number of dice WHERE?? 50 | first-move? - bool: whether is player's first move for this turn 51 | moves - ??? (list?) of moves : probably attacking moves ??? 52 | @return ???" 53 | [board player spare-dice first-move? moves] 54 | (if first-move? 55 | moves ;; cannot pass on first-move, so return attack-moves 56 | (cons (list nil ;; desc of the move => nil means "passing" 57 | (game-tree (add-new-dice board player (dec spare-dice)) 58 | (mod (inc player) *num-players*) ;; change to next player 59 | 0 ;; no spare dice 60 | true)) ;; first-move 61 | moves))) 62 | 63 | (comment 64 | (gen-board) 65 | (player-letter 0) 66 | (do-draw-board (gen-board)) 67 | ) 68 | -------------------------------------------------------------------------------- /grand-theft-wumpus/src/thornydev/wumpus/graphing.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.wumpus.graphing 2 | (:require [clojure.string :as str] 3 | [clojure.java.io :as io] 4 | [clojure.java.shell :refer [sh]])) 5 | 6 | (defn dot-name [kw] 7 | (str/upper-case (str/replace (name kw) "-" "_"))) 8 | 9 | (defn dot-label 10 | "@param path: either a keyword or a seq/vec of keywords 11 | that will be put as the label 12 | @return string with label in parens (in the string), 13 | such as '(cops)'" 14 | [path] 15 | (if (coll? path) 16 | (let [body (apply str (interpose " " (map name path)))] 17 | (str "(" body ")")) 18 | (str "(" (name path) ")"))) 19 | 20 | (defn nodes->dot [nodes] 21 | (doseq [n nodes] 22 | (when (< 1 (count n)) 23 | (let [currpos (some #{"*"} (rest n))] 24 | (print (first n)) 25 | (print "[label=\"") 26 | (print (first n)) 27 | (print " - ") 28 | (print (apply str (interpose " " (map name (rest n))))) 29 | (if currpos 30 | (print "\", color = red]") 31 | (println "\"];")) 32 | (flush)) 33 | ) 34 | ) 35 | ) 36 | 37 | (defn uedges->dot [edges] 38 | (loop [nodes (keys edges) pairs-seen #{}] 39 | (if (empty? nodes) 40 | pairs-seen 41 | (let [start (first nodes) 42 | vpairs (for [[end info] (edges start)] 43 | (let [pair (vec (sort [start end]))] 44 | (when-not (pairs-seen pair) 45 | (print start) 46 | (print "--") 47 | (print end) 48 | (if info 49 | (println (str "[label=\"" 50 | (dot-label info) "\"];")) 51 | (println ";") 52 | )) 53 | pair))] 54 | (recur (rest nodes) (apply conj pairs-seen vpairs)))))) 55 | 56 | (defn ugraph->dot [edges nodes] 57 | (println "graph {") 58 | (nodes->dot nodes) 59 | (uedges->dot edges) 60 | (println "}")) 61 | 62 | (defn graph-it [m] 63 | (with-open [w (io/writer (str (:fname m) ".dot"))] 64 | (binding [*out* w] 65 | ((:dotfn m) (:edges m) (:nodes m)))) 66 | (sh "dot" 67 | (str "-T" (name (:out-type m))) 68 | (str (:fname m) ".dot") 69 | "-o" (str (:fname m) "." (name (:out-type m)))) 70 | ) 71 | 72 | (defn ugraph->svg [fname edges nodes] 73 | (let [args {:fname fname 74 | :edges edges 75 | :nodes nodes 76 | :dotfn ugraph->dot 77 | :out-type :svg}] 78 | (graph-it args))) 79 | 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /webserver/test/thornydev/web/server_test.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.web.server-test 2 | (:use clojure.test 3 | midje.sweet 4 | thornydev.web.server) 5 | (:require [clojure.java.io :as jio])) 6 | 7 | 8 | 9 | ;; ---[ parse-params ]--- ;; 10 | (def input1 "name1=value1&foo=bar&gender=M&height=11.3") 11 | (def input2 "name1=value1&foo=bar+baz&gender=M&height=") 12 | 13 | (deftest test-parse-params 14 | (testing "all nv pairs present (none blank" 15 | (let [exp {"name1" "value1" 16 | "foo" "bar" 17 | "gender" "M" 18 | "height" "11.3"}] 19 | (is (= exp (parse-params input1)))))) 20 | 21 | (fact (parse-params input1) => {"name1" "value1" 22 | "foo" "bar" 23 | "gender" "M" 24 | "height" "11.3"}) 25 | 26 | (fact (parse-params input2) 27 | => (and (contains {"height" ""}) 28 | (contains {"foo" "bar+baz"}))) 29 | 30 | (fact (parse-params input2) => {"name1" "value1" 31 | "foo" "bar+baz" 32 | "gender" "M" 33 | "height" ""}) 34 | 35 | (fact (parse-params "foo=bar") => {"foo" "bar"}) 36 | (fact (parse-params "foo=") => {"foo" ""}) 37 | (fact (parse-params "foo=&quux=") => {"foo" "", "quux" ""}) 38 | 39 | ;; (fact (parse-params-pairs input1) 40 | ;; => (and (contains '(("foo" "bar"))) 41 | ;; (contains '(("height" "11.3"))) 42 | ;; (contains '(("gender" "M"))) 43 | ;; (contains '(("name1" "value1"))))) 44 | 45 | ;; (fact (parse-params-pairs input2) 46 | ;; => (and (contains '(("foo" "bar"))) 47 | ;; (contains '(("height" ""))) 48 | ;; (contains '(("gender" "M"))) 49 | ;; (contains '(("name1" "value1"))))) 50 | 51 | ;; (fact (count (parse-params-pairs input2)) => 4) 52 | 53 | ;; (fact (parse-params-pairs "foo=") => '(("foo" ""))) 54 | 55 | ;; ---[ http-char ]--- ;; 56 | (fact (http-char \3 \F) => \?) 57 | (fact (http-char \Z \F) => \space) ;; if doesn't parse, returns space 58 | 59 | ;; ---[ decode-param (2 versions) ]--- ;; 60 | (fact (decode-param-recurse "foo%3F") => "foo?") 61 | (fact (decode-param-re "foo%3F") => "foo?") 62 | (fact (decode-param-recurse "foo+bar") => "foo bar") 63 | (fact (decode-param-re "foo+bar") => "foo bar") 64 | 65 | 66 | ;; ---[ parse-url ]--- ;; 67 | (fact (parse-url "GET /lolcats.html HTTP/1.1") => ["lolcats.html"]) 68 | (fact (parse-url "GET /lolcats.html?extra-funny=yes HTTP/1.1") 69 | => ["lolcats.html" {"extra-funny" "yes"}]) 70 | (fact (parse-url "GET /lolcats.html?extra-funny=yes&foo= HTTP/1.1") 71 | => ["lolcats.html" {"extra-funny" "yes", "foo" ""}]) 72 | 73 | ;; ---[ get-header ]--- ;; 74 | 75 | (let [strm (jio/reader (.getBytes "foo: bar\na: b, 123"))] 76 | (fact (get-header strm) => {"foo" "bar", "a" "b, 123"})) 77 | 78 | ;; two newlines causes "a: b, 123" to be considered in the body, not header 79 | (let [strm (jio/reader (.getBytes "foo: bar\n\na: b, 123"))] 80 | (fact (get-header strm) => {"foo" "bar"})) 81 | 82 | 83 | ;; ---[ get-content-params ]--- ;; 84 | 85 | (let [strm (jio/reader (.getBytes "Content-Length: 9\n\na=b&abc=123"))] 86 | (fact (get-content-params (get-header strm) strm) => {"a" "b", "abc" "123"})) 87 | 88 | 89 | -------------------------------------------------------------------------------- /wizards-adventure/doc/wizards_game.lisp: -------------------------------------------------------------------------------- 1 | (defparameter *nodes* '((living-room (you are in the living-room. 2 | a wizard is snoring loudly on the couch.)) 3 | (garden (you are in a beautiful garden. 4 | there is a well in front of you.)) 5 | (attic (you are in the attic. 6 | there is a giant welding torch in the corner.)))) 7 | 8 | (defun describe-location (location nodes) 9 | (cadr (assoc location nodes))) 10 | 11 | (defparameter *edges* '((living-room (garden west door) 12 | (attic upstairs ladder)) 13 | (garden (living-room east door)) 14 | (attic (living-room downstairs ladder)))) 15 | 16 | (defun describe-path (edge) 17 | `(there is a ,(caddr edge) going ,(cadr edge) from here.)) 18 | 19 | (defun describe-paths (location edges) 20 | (apply #'append (mapcar #'describe-path (cdr (assoc location edges))))) 21 | 22 | (defparameter *objects* '(whiskey bucket frog chain)) 23 | 24 | (defparameter *object-locations* '((whiskey living-room) 25 | (bucket living-room) 26 | (chain garden) 27 | (frog garden))) 28 | 29 | (defun objects-at (loc objs obj-loc) 30 | (labels ((is-at (obj) 31 | (eq (cadr (assoc obj obj-loc)) loc))) 32 | (remove-if-not #'is-at objs))) 33 | 34 | (defun describe-objects (loc objs obj-loc) 35 | (labels ((describe-obj (obj) 36 | `(you see a ,obj on the floor.))) 37 | (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc))))) 38 | 39 | (defparameter *location* 'living-room) 40 | 41 | (defun look () 42 | (append (describe-location *location* *nodes*) 43 | (describe-paths *location* *edges*) 44 | (describe-objects *location* *objects* *object-locations*))) 45 | 46 | (defun walk (direction) 47 | (labels ((correct-way (edge) 48 | (eq (cadr edge) direction))) 49 | (let ((next (find-if #'correct-way (cdr (assoc *location* *edges*))))) 50 | (if next 51 | (progn (setf *location* (car next)) 52 | (look)) 53 | '(you cannot go that way.))))) 54 | 55 | (defun pickup (object) 56 | (cond ((member object (objects-at *location* *objects* *object-locations*)) 57 | (push (list object 'body) *object-locations*) 58 | `(you are now carrying the ,object)) 59 | (t '(you cannot get that.)))) 60 | 61 | (defun inventory () 62 | (cons 'items- (objects-at 'body *objects* *object-locations*))) 63 | 64 | (defun have (object) 65 | (member object (cdr (inventory)))) 66 | 67 | (defun game-repl () 68 | (let ((cmd (game-read))) 69 | (unless (eq (car cmd) 'quit) 70 | (game-print (game-eval cmd)) 71 | (game-repl)))) 72 | 73 | (defun game-read () 74 | (let ((cmd (read-from-string (concatenate 'string "(" (read-line) ")")))) 75 | (flet ((quote-it (x) 76 | (list 'quote x))) 77 | (cons (car cmd) (mapcar #'quote-it (cdr cmd)))))) 78 | 79 | (defparameter *allowed-commands* '(look walk pickup inventory)) 80 | 81 | (defun game-eval (sexp) 82 | (if (member (car sexp) *allowed-commands*) 83 | (eval sexp) 84 | '(i do not know that command.))) 85 | 86 | (defun tweak-text (lst caps lit) 87 | (when lst 88 | (let ((item (car lst)) 89 | (rest (cdr lst))) 90 | (cond ((eql item #\space) (cons item (tweak-text rest caps lit))) 91 | ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit))) 92 | ((eql item #\") (tweak-text rest caps (not lit))) 93 | (lit (cons item (tweak-text rest nil lit))) 94 | (caps (cons (char-upcase item) (tweak-text rest nil lit))) 95 | (t (cons (char-downcase item) (tweak-text rest nil nil))))))) 96 | 97 | (defun game-print (lst) 98 | (princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string lst)) 'list) t nil) 'string)) 99 | (fresh-line)) -------------------------------------------------------------------------------- /wizards-adventure/src/thornydev/wizadv/game.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.wizadv.game 2 | (:require [clojure.string :as str])) 3 | 4 | ;; ---[ data structures ]--- ;; 5 | 6 | (def nodes 7 | {:living-room "You are in the living-room. A wizard is snoring loudly on the couch." 8 | :garden "You are in a beautiful garden. There is a well in front of you." 9 | :attic "You are in the attic. There is a giant welding torch in the corner."}) 10 | 11 | (def edges 12 | {:living-room {:garden [:west :door], 13 | :attic [:upstairs :ladder]} 14 | :garden {:living-room [:east :door]} 15 | :attic {:living-room [:downstairs :ladder]}}) 16 | 17 | (def objects [:whiskey :bucket :frog :chain]) 18 | 19 | ;; TODO: this may need to be an atom if the loc can change 20 | (def object-locations (atom 21 | {:whiskey :living-room 22 | :bucket :living-room 23 | :chain :garden 24 | :frog :garden})) 25 | 26 | (def location (atom :living-room)) 27 | 28 | ;; ---[ pure functions ]--- ;; 29 | 30 | (defn describe-location 31 | "@param 32 | mnodes map of game nodes 33 | loc location symbol to look up in mnodes 34 | @return string description" 35 | [mnodes loc] 36 | [(loc mnodes)]) 37 | 38 | (defn describe-path [edges from to] 39 | (let [descvec (to (from edges))] 40 | (str "There is a " (name (second descvec)) " going " 41 | (name (first descvec)) " from here."))) 42 | 43 | (defn describe-all-paths 44 | "@param 45 | loc: symbol of the location find all paths out of (eg, :attic) 46 | edges: map of edges between nodes 47 | @return list of text phrases describing the paths out" 48 | [edges loc] 49 | (map #(describe-path edges loc %) (keys (loc edges)))) 50 | 51 | (defn objects-at 52 | "@param 53 | loc: keyword specifying location (eg, :garden) 54 | obj-locs map of objects to their locations (all entries are keywords) 55 | @return list of objects (as keywords) in the location specified" 56 | [loc obj-locs] 57 | (map first (loc (group-by second obj-locs)))) 58 | 59 | (defn describe-objects [loc obj-locs] 60 | (let [desc #(str "You see a " (name %) " on the floor.")] 61 | (map desc (objects-at loc obj-locs)))) 62 | 63 | 64 | ;; ---[ Imperative Shell ]--- ;; 65 | 66 | (defn look [] 67 | (str/join " " 68 | (concat 69 | (describe-location @location nodes) 70 | (describe-all-paths @location edges) 71 | (describe-objects @location @object-locations)))) 72 | 73 | (defn fwalk [direction] 74 | (let [attempt (for [e (@location edges) 75 | :when (= direction (get-in e [1 0]))] 76 | (first e))] 77 | (if (empty? attempt) 78 | "You cannot go that way." 79 | (do 80 | (reset! location (first attempt)) 81 | (look))))) 82 | 83 | (defmacro walk [direction] 84 | (fwalk (keyword direction))) 85 | 86 | 87 | (defn fpickup [object] 88 | (if (= @location (object @object-locations)) 89 | (do (swap! object-locations assoc object :body) 90 | (str "You are now carrying the " object)) 91 | "You cannot get that.")) 92 | 93 | (defmacro pickup [object] (fpickup (keyword object))) 94 | 95 | (defn inventory [] 96 | (->> (filter #(= :body (second %)) @object-locations) 97 | (map #(name (first %))) 98 | (str/join ", ") 99 | (apply str "Items: "))) 100 | 101 | 102 | ;; ---[ REPL functions ]--- ;; 103 | 104 | (def allowed-commands-set #{'look 'walk 'pickup 'inventory}) 105 | 106 | (defn game-read [] 107 | (let [cmd (read-string (str "(" (read-line) ")"))] 108 | (cons (first cmd) 109 | (map keyword (rest cmd))))) 110 | 111 | (defn game-eval [sexp] 112 | (if (allowed-commands-set (first sexp)) 113 | (eval sexp) 114 | "I do not know that command.")) 115 | 116 | (comment 117 | (game-eval (game-read))) 118 | 119 | (defn game-print [txt] 120 | (doseq [s (map str/trim (re-seq #"[^.?!]+[.?!]?" txt))] 121 | (println s))) 122 | 123 | (defn game-repl [] 124 | (loop [cmd (game-read)] 125 | (when-not (= :quit (keyword (first cmd))) 126 | (game-print (game-eval cmd)) 127 | (recur (game-read))))) 128 | 129 | -------------------------------------------------------------------------------- /orc-battle/test/thornydev/orc/monsters.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.orc.monsters 2 | (:require [thornydev.orc.util :refer [defrecord+defaults 3 | randval]])) 4 | 5 | (declare monster-dead?) 6 | 7 | (defn generic-monster-hit 8 | "General monster hit fn. 9 | Note that this fn does NOT modify the monsters atom. 10 | Instead it returns a new monster that the caller needs to 11 | modify the monsters atom to keep game state consistent" 12 | [mon x] 13 | (let [mon2 (into mon {:health (- (:health mon) x)}) 14 | mon-type (second (re-find #"\.(\w+)$" (str (type mon))))] 15 | (if (monster-dead? mon2) 16 | (println (str "You killed the " mon-type "!")) 17 | (println "You hit the" (str mon-type ", knocking off") x "health points!")) 18 | mon2)) 19 | 20 | 21 | ;; do- methods indicate non-pure functions that return 22 | ;; void and are invoked to alter state (or just print to *out* 23 | (defprotocol Monster 24 | "Generic super type for all the monsters in the orc-battle game" 25 | (do-monster-show [this] "Describes the type of monster") 26 | (monster-attack [this player] 27 | "Monster attacks player. Modifies player health. 28 | @return string description of what happened.") 29 | (monster-hit [this x] 30 | "Player attacks/hits the monster. 31 | @params 32 | mon - monster to 'hit' (subtract health from) 33 | x - amount of hit 34 | @returns a new Monster with the new health value") 35 | ) 36 | 37 | ;; ---[ Orc ]--- ;; 38 | ;; this macro auto-generates a factory function called 39 | ;; new-Monster that uses the defaults defined here 40 | (defrecord+defaults Orc [health (randval 10) club-level (randval 8)] 41 | Monster 42 | (do-monster-show 43 | [this] 44 | (println (format "A wicked Orc with a level %d club", 45 | (:club-level this)))) 46 | (monster-attack 47 | [this player] 48 | (let [pts (randval (:club-level this))] 49 | (swap! player update-in [:health] - pts) 50 | (println "An orc swings his club at you and knocks off" 51 | pts "of your health points")) 52 | this) 53 | 54 | (monster-hit [this x] (generic-monster-hit this x)) 55 | ) 56 | 57 | ;; ---[ Hydra ]--- ;; 58 | (defrecord+defaults Hydra [health (randval 10)] 59 | Monster 60 | (do-monster-show 61 | [this] 62 | (println (format "A malicious hydra with %d heads" (:health this)))) 63 | 64 | (monster-attack 65 | [this player] 66 | (let [x (randval (bit-shift-right (:health this) 1))] 67 | (print "A hydra attacks you with" x "of its heads! ") 68 | (println "It also grows back one more head.") 69 | (swap! player update-in [:health] - x) 70 | (->Hydra (inc (:health this))) 71 | )) 72 | 73 | (monster-hit 74 | [this x] 75 | (let [hyd (->Hydra (- (:health this) x))] 76 | (if (monster-dead? hyd) 77 | (println "The corpse of the fully decapitated hydra falls to the floor.") 78 | (println "You lopped" x "of the hydra's heads!") 79 | ) 80 | hyd)) 81 | ) 82 | 83 | ;; ---[ SlimeMold ]--- ;; 84 | 85 | (defrecord+defaults SlimeMold [health (randval 10) 86 | sliminess (randval 5)] 87 | Monster 88 | (do-monster-show 89 | [this] 90 | (println (format "A slime mold with a sliminess of %d" (:sliminess this)))) 91 | 92 | (monster-attack 93 | [this player] 94 | (let [pts (randval (:sliminess this))] 95 | (println "A slime mold wraps around your legs decreasing your agility by" 96 | (str pts "!")) 97 | (swap! player update-in [:agility] - pts) 98 | (when (zero? (rand-int 2)) 99 | (println "It also squirts in your face, taking away a health point!") 100 | (swap! player update-in [:health] dec))) 101 | this 102 | ) 103 | 104 | (monster-hit [this x] (generic-monster-hit this x)) 105 | ) 106 | 107 | ;; ---[ Brigand ]--- ;; 108 | (defrecord+defaults Brigand [health (randval 10)] 109 | Monster 110 | (do-monster-show 111 | [this] 112 | (println "A brigand appears before you with" 113 | (:health this) "health points")) 114 | 115 | (monster-attack 116 | [this player] 117 | (let [[attr val] (first (sort-by val > @player))] 118 | (case attr 119 | :health (do (println "A brigand hits you with his slingshot," 120 | "taking off 2 health points!") 121 | (swap! player update-in [:health] - 2)) 122 | :agility (do (println "A brigand catches your leg with his whip," 123 | "taking off 2 agility points") 124 | (swap! player update-in [:agility] - 2)) 125 | :strength (do (println "A brigand cuts your arm with his whip," 126 | "taking off 2 strength points") 127 | (swap! player update-in [:strength] - 2)) 128 | )) 129 | this) 130 | 131 | (monster-hit [this x] (generic-monster-hit this x)) 132 | ) 133 | 134 | 135 | (defn monsters-dead? [monsters] 136 | (every? #(<= (:health @%) 0) monsters)) 137 | 138 | (defn monster-dead? [mon] 139 | (<= (:health mon) 0)) 140 | 141 | (defn random-monster [monsters] 142 | (let [mon (monsters (rand-int (count monsters)))] 143 | (if (monster-dead? @mon) 144 | (random-monster monsters) 145 | mon 146 | ) 147 | ) 148 | ) 149 | -------------------------------------------------------------------------------- /orc-battle/test/thornydev/orc/game_test.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.orc.game-test 2 | (:use clojure.test 3 | thornydev.orc.game 4 | thornydev.orc.monsters)) 5 | 6 | (deftest test-player-dead? 7 | (testing "after player init" 8 | (init-player) 9 | (is (not (player-dead?))) 10 | )) 11 | 12 | (deftest test-get-monster-choice 13 | (testing "after monster init" 14 | (binding [*monster-num* 3] 15 | (let [predef-mon [(atom (->Orc 10 10)) 16 | (atom (->Brigand 0)) 17 | (atom (->SlimeMold 3 4))]] 18 | (binding [*monsters* predef-mon] 19 | (is (= (->Orc 10 10) @(get-monster-choice 1))) 20 | (is (= (->SlimeMold 3 4) @(get-monster-choice 3))) 21 | (is (thrown? IllegalArgumentException (get-monster-choice -1))) 22 | (is (thrown? IllegalArgumentException 23 | (get-monster-choice (inc *monster-num*)))) 24 | ;; this one is already dead, so throws exception 25 | (is (thrown? IllegalArgumentException 26 | (get-monster-choice 2)))) 27 | ) 28 | ) 29 | ) 30 | ) 31 | 32 | (deftest test-Orc 33 | (init-player) 34 | 35 | ;; use reader-form constructor notation 36 | (let [orc #thornydev.orc.monsters.Orc{:health 8, :club-level 5}] 37 | (testing "show" 38 | (let [show-out (with-out-str (do-monster-show orc))] 39 | (is (re-find #"level 5 club" show-out)) 40 | ) 41 | ) 42 | (testing "attack" 43 | (let [b4-player-strength (:health @player) 44 | attack-out 45 | (with-out-str 46 | ;; should get back the same orc 47 | ;; (attacking doesn't change the orc) 48 | (let [mon (monster-attack orc player)] 49 | (is (= 8 (:health mon))) 50 | (is (identical? orc mon)) 51 | )) 52 | [_ hit] (first 53 | (re-seq #"knocks off (\d+) of your health" attack-out))] 54 | ;; ensure current strength decreased by amount reported 55 | ;; from the monster-attack method 56 | (is (= (Integer/valueOf hit) 57 | (- b4-player-strength (:health @player)))) 58 | ) 59 | ) 60 | (testing "hit: damage the orc" 61 | (let [hit-out 62 | (with-out-str 63 | (let [mon (monster-hit orc 2)] 64 | (is (= 6 (:health mon))) 65 | (is (not (identical? mon orc))) 66 | (is (= (:club-level mon) (:club-level orc))) 67 | )) 68 | [_ hit] (first 69 | (re-seq #"off (\d+) health points" hit-out))] 70 | (is (= 2 (read-string hit))) 71 | ) 72 | ) 73 | (testing "hit: kill the orc" 74 | (let [hit-out 75 | (with-out-str 76 | (let [mon (monster-hit orc 8)] 77 | (is (= 0 (:health mon))) 78 | (is (monster-dead? mon))))] 79 | (is (re-seq #"(?i)you killed the orc" hit-out)) 80 | ) 81 | ) 82 | )) 83 | 84 | (deftest test-Hydra 85 | (let [hyd (new-Hydra) 86 | orig-health (:health hyd)] 87 | 88 | (testing "show" 89 | (let [show-out (with-out-str (do-monster-show hyd)) 90 | pat (re-pattern (str "hydra with " orig-health " heads"))] 91 | (is (re-find pat show-out)))) 92 | 93 | (testing "attack" 94 | (let [b4-plyr-strength (:health @player) 95 | attack-out 96 | (with-out-str 97 | (let [mon (monster-attack hyd player)] 98 | ;; when the hydra attacks it gets one of its heads back 99 | ;; so you get a new hydra back from this method 100 | (is (not (identical? mon hyd))) 101 | (is (= (inc orig-health) (:health mon))) 102 | )) 103 | [_ hit] (first 104 | (re-seq #"attacks you with (\d+) of its heads" attack-out)) 105 | hit-int (Integer/valueOf hit) 106 | ] 107 | (is (= (:health @player) (- b4-plyr-strength hit-int))) 108 | ) 109 | ) 110 | 111 | (testing "hit" 112 | (with-out-str 113 | (let [mon1 (monster-hit hyd (dec orig-health)) 114 | mon2 (monster-hit hyd orig-health)] 115 | (is (= 1 (:health mon1))) 116 | (is (not (monster-dead? mon1))) 117 | (is (= 0 (:health mon2))) 118 | (is (monster-dead? mon2)))) 119 | ) 120 | )) 121 | 122 | 123 | (deftest test-monsters-dead? 124 | (binding [*monster-builders* [new-Orc new-Hydra 125 | new-SlimeMold new-Brigand]] 126 | (binding [*monster-num* 4] 127 | (binding [*monsters* (create-random-monsters)] 128 | 129 | (testing "all monsters with non-zero health" 130 | (is (= 4 (count *monsters*))) 131 | (is (not (monsters-dead? *monsters*)))) 132 | 133 | (testing "some monsters with non-zero health" 134 | (binding [*monsters* (assoc (create-random-monsters) 0 135 | (atom (->Hydra 0)))] 136 | (is (monster-dead? @(first *monsters*))) 137 | (is (not (monster-dead? @(second *monsters*)))) 138 | (is (not (monsters-dead? *monsters*))) 139 | ) 140 | ) 141 | 142 | (testing "all monsters with non-zero health = all dead" 143 | (binding [*monsters* [(atom (->Hydra 0)) 144 | (atom (->Brigand 0)) 145 | (atom (->SlimeMold 0 0)) 146 | (atom (->Orc 0 0))]] 147 | (is (monster-dead? @(first *monsters*))) 148 | (is (monster-dead? @(second *monsters*))) 149 | (is (monsters-dead? *monsters*)))) 150 | )))) 151 | 152 | (prn (run-tests)) 153 | -------------------------------------------------------------------------------- /webserver/src/thornydev/web/server.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.web.server 2 | (:require [clojure.string :as str] 3 | [thornydev.clj-sockets :as sk] 4 | [server.socket :refer [create-server close-server]] 5 | [thornydev.web.handlers :as hdlr]) 6 | ;; (:import (java.io BufferedReader InputStreamReader PrintWriter) 7 | ;; (java.util.concurrent CyclicBarrier)) 8 | ) 9 | 10 | (defn rrest [coll] 11 | (rest (rest coll))) 12 | 13 | (defn rrrest [coll] 14 | (rest (rest (rest coll)))) 15 | 16 | (defn http-char [c1 c2 & optional] 17 | (try 18 | (char (Integer/parseInt (str c1 c2), 16)) 19 | (catch NumberFormatException e 20 | \space))) 21 | 22 | (defn decode-param-recurse [s]- 23 | (loop [ochars (seq s) nchars []] 24 | (if-not (seq ochars) 25 | (apply str nchars) 26 | (case (first ochars) 27 | \% (recur (rrrest ochars) 28 | (conj nchars (http-char (first (rest ochars)) 29 | (first (rrest ochars))))) 30 | \+ (recur (rest ochars) (conj nchars \space)) 31 | (recur (rest ochars) (conj nchars (first ochars))))))) 32 | 33 | (defn decode-param-re [s] 34 | (let [frep (fn [str-match] 35 | (case (first str-match) 36 | \% (str (apply http-char (rest (seq str-match)))) 37 | \+ " "))] 38 | (str/replace s #"\+|%.." frep))) 39 | 40 | (def decode-param decode-param-re) 41 | 42 | (defn parse-params [s] 43 | (let [to-pairs (fn [qstr] 44 | (let [nvpairs (str/split qstr #"&|=")] 45 | (if (odd? (count nvpairs)) 46 | (conj nvpairs "") 47 | nvpairs)))] 48 | (->> s to-pairs (apply array-map)))) 49 | 50 | ;; (defn parse-params-pairs [s] 51 | ;; (let [to-pairs (fn [qstr] 52 | ;; (let [nvpairs (str/split qstr #"&|=")] 53 | ;; (if (odd? (count nvpairs)) 54 | ;; (conj nvpairs "") 55 | ;; nvpairs)))] 56 | ;; (->> s to-pairs (partition 2)))) 57 | 58 | 59 | (defn triml-char 60 | "if +ch+ is the first character of the string +s+ 61 | a new string without that first char will be returned, 62 | otherwise +s+ is returned" 63 | [s ch] 64 | (if (= ch (first s)) (subs s 1) s)) 65 | 66 | (defn parse-url 67 | "parses URL (string) into a vector where the first 68 | entry is a string of the URL minus any query string. 69 | If the input has a query string, the second entry in the 70 | vector is a seq of name-value pairs (as a sequence pair)" 71 | [s] 72 | (let [[url qstr] (-> s 73 | (str/split #"\s+") 74 | second 75 | (triml-char \/) 76 | (str/split #"\?"))] 77 | (if qstr 78 | [url (parse-params qstr)] 79 | [url]))) 80 | 81 | 82 | (defn get-header 83 | "Reads the HTTP header in from *in*, so that should 84 | be bound to the socket stream reader 85 | @return map of key-values from the headers" 86 | [] 87 | (loop [s (read-line) headers {}] 88 | (if-not (seq s) 89 | headers 90 | (recur (read-line) 91 | (->> (str/split s #":\s+") 92 | (apply array-map) 93 | (merge headers)))))) 94 | 95 | 96 | ;; TODO: we could write a slurp-some that takes a limit of 97 | ;; how much to read 98 | (defn get-content-params 99 | "Parses HTTP encoded query params from the *body* of an HTTP request. 100 | It reads the body from *in*, so make sure that is bound to the 101 | socket stream reader before calling this fn. 102 | @params 103 | header: the header map pulled from HTTP request 104 | @return map of name-values from query string in the body or 105 | nil if no body found (or no Content-Length header present)" 106 | [header] 107 | (when-let [length (header "Content-Length")] 108 | (parse-params (slurp *in*)))) 109 | 110 | ;; try with server.socket again: see this: http://angeleah.com/blog/2012/11/27/adding-conditions-to-the-clojure-echo-server.html 111 | 112 | (defn close-all [& args] 113 | (doseq [closeable args] (.close closeable))) 114 | 115 | (def keep-running (atom true)) 116 | 117 | (defn serve [request-handler] 118 | (with-open [server (sk/socket-server 8080)] 119 | (while @keep-running 120 | (with-open [socket (sk/socket-accept server) 121 | sreader (sk/socket-reader socket) 122 | swriter (sk/socket-writer socket)] 123 | (binding [*in* sreader 124 | *out* swriter] 125 | (let [url (parse-url (read-line)) 126 | path (first url) 127 | header (get-header) 128 | params (merge (first (rest url)) 129 | (get-content-params header))] 130 | (if (= "quit" path) 131 | (reset! keep-running false) 132 | (request-handler path header params)))))))) 133 | 134 | ;; (def barrier (CyclicBarrier. 2)) 135 | 136 | ;; (defn http-server [in out] 137 | ;; (binding [*in* (BufferedReader. (InputStreamReader. in)) 138 | ;; *out* (PrintWriter. out)] 139 | ;; (let [url (parse-url (read-line)) 140 | ;; path (first url) 141 | ;; header (get-header) 142 | ;; params (merge (first (rest url)) 143 | ;; (get-content-params header))] 144 | ;; (if (= "quit" path) 145 | ;; (reset! keep-running false) 146 | ;; (hdlr/hello-request-handler path header params)))) 147 | ;; (.await barrier)) 148 | 149 | ;; (defn serv2 [] 150 | ;; (while @keep-running 151 | ;; (let [socket-server (create-server 8080 http-server)] 152 | ;; (try 153 | ;; (.await barrier) 154 | ;; (finally 155 | ;; (close-server socket-server) 156 | ;; (.reset barrier)))))) 157 | -------------------------------------------------------------------------------- /orc-battle/src/thornydev/orc/game.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.orc.game 2 | (:require [thornydev.orc.util :refer [randval]] 3 | [thornydev.orc.monsters :refer :all])) 4 | 5 | ;; ---[ global state, types and initializations ]--- ;; 6 | 7 | (def player (atom {:health nil 8 | :agility nil 9 | :strength nil})) 10 | 11 | (defn create-default-monsters 12 | "This creates a default set of monsters to have a known 13 | defined set for testing or basic play. If you want just 14 | this set, either do not call init-monsters or call it: 15 | (init-monsters (create-default-monsters)" 16 | [] 17 | [(atom (->Orc 6 5)) (atom (->Brigand 8)) 18 | (atom (->Hydra 7)) (atom (->SlimeMold 5 7))] ) 19 | 20 | (def ^:dynamic *monster-builders* []) ;; vector 21 | (def ^:dynamic *monsters* (create-default-monsters)) 22 | (def ^:dynamic *monster-num* (count *monsters*)) ;; # monsters per fight seq 23 | 24 | (defn init-player [] 25 | (swap! player merge {:health 30, :agility 30, :strength 30})) 26 | 27 | (defn player-dead? [] 28 | (<= (:health @player) 0)) 29 | 30 | (defn create-random-monsters 31 | "Creates a random vector of monsters based on *monster-num* 32 | and *monster-builders* being set before this fn is called. 33 | It does not modify *monsters*. It returns a vector of monsters 34 | (of size *monster-num*). It is intended to be called in a 35 | binding form that sets *monsters*." 36 | [] 37 | (mapv (fn [_] 38 | (atom ((nth *monster-builders* 39 | (rand-int (count *monster-builders*)))))) 40 | (range *monster-num*))) 41 | 42 | 43 | ;; ---[ player functions ]--- ;; 44 | (defn show-player 45 | "Meta: imperative. 46 | Prints current status to *out*." 47 | [] 48 | (println) 49 | (println "You are a valiant knight with health of" 50 | (str (:health @player) 51 | ", an agility of " (:agility @player) 52 | ", and a strength of " (:strength @player)))) 53 | 54 | (defn get-monster-choice 55 | "Looks up the monster from the monster atom 56 | by the idx passed in (using 1-based indexing) 57 | @return the atom for the monster referenced by the index 58 | as long as it is not dead 59 | @throws IllegalArgumentException if the idx is out of 60 | bounds for the monster array or the monster is dead." 61 | [^Integer x] 62 | (if (or (< x 1) (> x *monster-num*)) 63 | (throw (IllegalArgumentException. "That is not a valid monster number.")) 64 | (let [mon (nth *monsters* (dec x))] 65 | (if (monster-dead? @mon) 66 | (throw (IllegalArgumentException. "That monster is already dead.")) 67 | mon)))) 68 | 69 | 70 | (defn pick-monster 71 | "Meta: imperative 72 | Queries user for which monster to target and 73 | delegates to the functional get-monster-choice fn" 74 | [] 75 | (println) 76 | (println "Monster #: ") 77 | (flush) 78 | (let [input (read-line)] 79 | (if (re-matches #"\d+" input) 80 | (try 81 | (get-monster-choice (read-string input)) 82 | (catch IllegalArgumentException e 83 | (println (.getMessage e)) 84 | (pick-monster)) 85 | )))) 86 | 87 | 88 | (defn stab-player-attack [] 89 | (let [mon (pick-monster)] 90 | (reset! mon 91 | (monster-hit 92 | @mon 93 | (+ 2 (randval (bit-shift-right (:health @player) 1))))))) 94 | 95 | 96 | 97 | (defn double-swing-player-attack [] 98 | (let [x (randval (/ (:strength @player) 6))] 99 | (println "Your double swing has a strength of" x) 100 | ;; once this works, refactor to be DRY (loop-recur?) 101 | (let [mon (pick-monster)] 102 | (reset! mon (monster-hit @mon x))) 103 | (when-not (monsters-dead? *monsters*) 104 | (let [mon (pick-monster)] 105 | (reset! mon (monster-hit @mon x))) 106 | ))) 107 | 108 | (defn roundhouse-player-attack [] 109 | (dotimes [_ (inc (randval (/ (:strength @player) 3)))] 110 | (when-not (monsters-dead? *monsters*) 111 | (let [mon (random-monster *monsters*)] 112 | (reset! mon (monster-hit @mon 1))) 113 | ))) 114 | 115 | (defn player-attack [] 116 | "Meta: imperative 117 | Queries user for type of attack and then delegates 118 | to the functional core method do-player-attack" 119 | (println) 120 | (println "Attack style: [s]tab [d]ouble swing [r]oundhouse: ") 121 | (flush) 122 | (loop [input (read-line)] 123 | (case input 124 | "s" (stab-player-attack) 125 | "d" (double-swing-player-attack) 126 | "r" (roundhouse-player-attack) 127 | (do (println "Input not recognized") 128 | (recur (read-line))) 129 | ) 130 | ) 131 | ) 132 | 133 | 134 | ;; ---[ monster functions ]--- ;; 135 | (defn show-monsters 136 | "Meta: imperative" 137 | [] 138 | (println "Your foes:") 139 | (doseq [[idx mon] (map vector (iterate inc 1) *monsters*)] 140 | (print " " (str idx ": ")) 141 | (if (monster-dead? @mon) 142 | (println "**dead**") 143 | (do (print "Health =" (:health @mon) " ") 144 | (do-monster-show @mon)) 145 | ))) 146 | 147 | 148 | (defn pause [] 149 | (print "Press Enter to Continue: ") 150 | (flush) 151 | (read-line)) 152 | 153 | (defn game-loop 154 | "Main game loop. 155 | Ends when either the player dies or when all the monsters are dead." 156 | [] 157 | (when-not (or (player-dead?) (monsters-dead? *monsters*)) 158 | (show-player) 159 | (pause) 160 | (dotimes [k (inc (/ (max 0 (:agility @player)) 15))] 161 | (when-not (monsters-dead? *monsters*) 162 | (show-monsters) 163 | (player-attack))) 164 | (println) 165 | (doseq [mon *monsters*] 166 | (when-not (monster-dead? @mon) 167 | (reset! mon (monster-attack @mon player)))) 168 | (recur))) 169 | 170 | 171 | ;; ---[ main game fns ]--- ;; 172 | 173 | (defn orc-battle 174 | "start the game" 175 | [nmonsters] 176 | (binding [*monster-builders* [new-Orc new-Hydra new-SlimeMold new-Brigand]] 177 | (binding [*monster-num* nmonsters] 178 | (binding [*monsters* (create-random-monsters)] 179 | (init-player) 180 | (game-loop) 181 | (cond 182 | (player-dead?) 183 | (println "You have been killed. Game over.") 184 | 185 | (monsters-dead? *monsters*) 186 | (println "Congratulations! You have vanquished your foes."))))) 187 | ) 188 | -------------------------------------------------------------------------------- /evolution/src/thornydev/evolution/sim.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.evolution.sim 2 | (:require [clojure.string :as str])) 3 | 4 | ;; (def ^:dynamic *width* 100) 5 | (def ^:dynamic *width* 82) 6 | (def ^:dynamic *height* 30) 7 | (def ^:dynamic *plant-energy* 80) 8 | (def ^:dynamic *reproduction-energy* 200) 9 | ;; rectangle on map where the jungle is 10 | ;; first two: x,y of top left corener; 11 | ;; last two: width and height 12 | (def ^:dynamic *jungle* [45 10 10 10]) 13 | 14 | ;; ---[ util fns ]--- ;; 15 | 16 | (defn half [n] 17 | (bit-shift-right n 1)) 18 | 19 | (defn pr+flush [& strs] 20 | (apply print strs) 21 | (flush)) 22 | 23 | (defn prn+flush [& strs] 24 | (apply println strs) 25 | (flush)) 26 | 27 | ;; ---[ domain fns ]--- ;; 28 | 29 | (defn random-plant 30 | "chooses a random x,y coordinate within the rectangle 31 | described by the params. 32 | @return tuple (vector) of x,y coordinates" 33 | [left top width height] 34 | (vector (+ left (rand-int width)) (+ top (rand-int height)))) 35 | 36 | (defn add-plants 37 | "Takes the existing plant set and returns a new one 38 | updated with one new plant in the jungle and one in the steppe." 39 | [plantset] 40 | (into plantset 41 | (vector 42 | (apply random-plant *jungle*) 43 | (random-plant 0 0 *width* *height*)))) 44 | 45 | (defn make-animal [] 46 | {:x (half *width*) 47 | :y (half *height*) 48 | :energy 1000 49 | :dir 0 50 | :genes (into [] (take 8 (repeatedly #(inc (rand-int 10)))))}) 51 | 52 | (defn move [animal] 53 | (let [x (mod (+ (:x animal) *width* 54 | (cond 55 | (#{1 5} (:dir animal)) 0 56 | (#{2 3 4} (:dir animal)) 1 57 | :else -1)) 58 | *width*) 59 | 60 | y (mod (+ (:y animal) *height* 61 | (cond 62 | (#{7 3} (:dir animal)) 0 63 | (#{0 1 2} (:dir animal)) 1 64 | :else -1)) 65 | *height*) 66 | 67 | energy (dec (:energy animal))] 68 | (into animal [[:x x] 69 | [:y y] 70 | [:energy energy]]) 71 | )) 72 | 73 | (defn turn 74 | "Turns the aninal by selecting a dir based on the genes of the animal. 75 | @return a new animal with a newly selected dir (could be the same 76 | dir as before)" 77 | [animal] 78 | (letfn [(angle [genes x] 79 | (let [xnu (- x (first genes))] 80 | (if (< xnu 0) 81 | 0 82 | (inc (angle (rest genes) xnu)))))] 83 | (let [xrand (rand-int (apply + (:genes animal))) 84 | newdir {:dir (mod (+ (:dir animal) 85 | (angle (:genes animal) xrand)) 86 | (count (:genes animal)))} 87 | ] 88 | (merge animal newdir)))) 89 | 90 | 91 | (defn eat 92 | "The animal will eat the plant at its location, if one is there. 93 | @return tuple pair of animal and plant-set after the attempt to eat, 94 | both modified if the animal ate a plant" 95 | [animal plants] 96 | (if-let [plant-pos (plants [(:x animal) (:y animal)])] 97 | [(assoc-in animal [:energy] (+ (:energy animal) *plant-energy*)) 98 | (disj plants plant-pos)] 99 | [animal plants])) 100 | 101 | (defn reproduce 102 | [animal] 103 | (let [e (:energy animal)] 104 | (if (< e *reproduction-energy*) 105 | [animal] 106 | (let [ani1 (update-in animal [:energy] half) 107 | genes (:genes animal) 108 | mutation (rand-int (count genes)) 109 | new-gene-val (max 1 (+ (nth genes mutation) (dec (rand-int 3)))) 110 | ani2 (assoc-in ani1 [:genes mutation] new-gene-val)] 111 | (vector ani1 ani2) 112 | )))) 113 | 114 | 115 | (defn eat-cycle 116 | "Steps through all the animals and lets them attempt to eat 117 | one at a time. 118 | @return new list of 'fattened' animals and revised plant 119 | map with those gone that were eaten" 120 | [animals plants] 121 | (loop [orig animals fattened [] plset plants] 122 | (if-not (seq orig) 123 | [fattened plset] 124 | (let [[a p] (eat (first orig) plset)] 125 | (recur (rest orig) (conj fattened a) p)) 126 | ) 127 | ) 128 | ) 129 | 130 | (defn update-world 131 | "@params 132 | animals seq of animals 133 | plants set of plants (coordinates only) 134 | @return vector of animals (a seq) and plants (a set)" 135 | [animals plants] 136 | (let [animals-1 (filter #(> (:energy %) 0) animals) 137 | animals-2 (map #(-> % turn move) animals-1) 138 | [animals-3 plants-1] (eat-cycle animals-2 plants) 139 | animals-nu (flatten (map reproduce animals-3))] 140 | (vector animals-nu (add-plants plants-1)))) 141 | 142 | 143 | (defn draw-world 144 | [animals plants] 145 | (doseq [y (range *height*)] 146 | (do 147 | (println) 148 | (print "|") 149 | (doseq [x (range *width*)] 150 | (do 151 | (print (cond 152 | (some #(and (= x (:x %)) (= y (:y %))) animals) \M 153 | (plants [x y]) \* 154 | :else \space)) 155 | (print "|") 156 | ))))) 157 | 158 | (defn read-int 159 | "Attempts to read the first integer from a string. 160 | If an integer is found, that integer is returned as a number. 161 | If none found, false is returned." 162 | [input] 163 | (let [stripped (str/replace input #",|_" "")] 164 | (if-let [n (re-find #"\d+" stripped)] 165 | (read-string n) 166 | false))) 167 | 168 | (defn evolve-cycles [n animals plants] 169 | (loop [anims animals plset plants i n] 170 | (if (= i 0) 171 | [anims plset] 172 | (let [[anims-nu plants-nu] (update-world anims plset)] 173 | (when (zero? (mod i 1000)) 174 | (pr+flush \.)) 175 | (recur anims-nu plants-nu (dec i)) 176 | ) 177 | ) 178 | ) 179 | ) 180 | 181 | (defn evolution [] 182 | (loop [animals [(make-animal)] plants (add-plants #{})] 183 | (draw-world animals plants) 184 | (pr+flush "\n'quit' or number of rounds: ") 185 | 186 | (let [input (str/trim (read-line))] 187 | (if (re-matches #":?quit" input) 188 | (do 189 | ;; set as global so it can be inpected when leave game loop 190 | (def anivec animals) 191 | (prn+flush ":done")) 192 | (if-let [x (read-int input)] 193 | (let [[anims-nu plants-nu] (evolve-cycles x animals plants)] 194 | (recur anims-nu plants-nu)) 195 | (do 196 | (pr+flush "Input not recognized (number or quit allowed)." 197 | "Press enter to continue:") 198 | (read-line) 199 | (recur animals plants))) 200 | ) 201 | ) 202 | ) 203 | ) 204 | 205 | ;; ---[ manual testing helpers ]--- ;; 206 | ;; (defn setup [] 207 | ;; (def anivec [(make-animal) (make-animal)]) 208 | ;; (def plset (add-plants #{})) 209 | ;; (def ppr #'clojure.pprint/pprint)) 210 | -------------------------------------------------------------------------------- /grand-theft-wumpus/src/thornydev/wumpus/game.clj: -------------------------------------------------------------------------------- 1 | (ns thornydev.wumpus.game 2 | (:require [thornydev.wumpus.graphing :refer [ugraph->svg]])) 3 | 4 | (def city-nodes (atom nil)) 5 | (def city-edges (atom nil)) 6 | 7 | ;; TODO: these three should probably be part of a single atom 8 | (def player-pos (ref nil)) 9 | (def visited-nodes (ref #{})) 10 | (def player-status (atom :in-progress)) 11 | 12 | ;; TODO: no point in making these dynamic unless you write a game-repl 13 | ;; loop in which they can be dynamically bound 14 | (def ^:dynamic *node-num* 30) 15 | (def ^:dynamic *edge-num* 45) 16 | (def ^:dynamic *worm-num* 3) 17 | (def ^:dynamic *cop-odds* 15) ; 1/15 change of police roadblock on an edge 18 | 19 | 20 | (defn filterb 21 | "Filter varient that returns nil (a falsy value) if 22 | nothing passes the filter. If anything is retained 23 | by the filter, than it returns what filter normally does." 24 | [pred coll] 25 | (let [rt (filter pred coll)] 26 | (if (empty? rt) 27 | nil 28 | rt))) 29 | 30 | (defn all-nodes [] 31 | (range 1 (inc *node-num*))) 32 | 33 | (defn rand-node 34 | "Get integer position of a random node, starting 35 | index at 1 (range 1 .. *node-num** inclusive)" 36 | [] 37 | (inc (rand-int *node-num*))) 38 | 39 | (defn edge-pair [x y] 40 | (when-not (= x y) 41 | [[x y] [y x]])) 42 | 43 | (defn make-edge-vec [] 44 | (->> (repeatedly #(edge-pair (rand-node) (rand-node))) 45 | (take *edge-num*) 46 | (apply concat) 47 | set 48 | vec)) 49 | 50 | (defn get-connected 51 | "@return set of all nodes that are connected in the edge-list" 52 | [edge-list] 53 | (set (mapcat identity edge-list))) 54 | 55 | (defn find-islands 56 | "@return seq/list of nodes not connected to other nodes" 57 | [node-list edge-list] 58 | (filter (complement (get-connected edge-list)) node-list)) 59 | 60 | (defn connect-all-islands 61 | "@param 62 | connected-nodes that are already connected in edge-list 63 | edge-vec: created via make-edge-vec" 64 | [edge-vec] 65 | (let [connected-nodes (vec (get-connected edge-vec))] 66 | (concat 67 | (mapcat (fn [island] 68 | (edge-pair 69 | island 70 | (nth connected-nodes (rand-int (count connected-nodes))))) 71 | (find-islands (all-nodes) edge-vec)) 72 | edge-vec))) 73 | 74 | ;; this correlates to edges-to-alist in the LOL book 75 | (defn edges-map [edges-vec edges-with-cops] 76 | (let [cops-set (set edges-with-cops) 77 | adorn-edge (fn [edge] 78 | (if (cops-set (sort edge)) 79 | [[(second edge) :COPS]] 80 | [[(second edge)]]))] 81 | (apply merge-with (fn [& args] (vec (apply concat args))) 82 | (map #(assoc {} (first %) (adorn-edge %)) edges-vec)))) 83 | 84 | (defn add-cops 85 | "picks a random subset of edges (form [x y]) that 86 | will have cops on the edge (not on the node) 87 | @return seq of edges (eg., ([3 14] [6 8])" 88 | [edges-vec] 89 | (map sort 90 | (filter (fn [e] (zero? (rand-int *cop-odds*))) edges-vec))) 91 | 92 | (defn make-city-edges [] 93 | (let [all-edges (connect-all-islands (make-edge-vec)) 94 | edges-with-cops (add-cops all-edges)] 95 | (edges-map all-edges edges-with-cops))) 96 | 97 | (defn neighbors 98 | "@params 99 | node: integer representing the node 100 | edges-map: map of edges created by make-city-edges 101 | @return set of neighbors for +node+" 102 | [node edges-map] 103 | (set (map first (get edges-map node)))) 104 | 105 | 106 | (defn within-one [nd1 nd2 edges-map] 107 | (boolean 108 | ((neighbors nd1 edges-map) nd2))) 109 | 110 | 111 | (defn within-two [nd1 nd2 edges-map] 112 | (or (within-one nd1 nd2 edges-map) 113 | (boolean 114 | (some #(within-one % nd2 edges-map) 115 | (neighbors nd1 edges-map))))) 116 | 117 | 118 | (defn make-city-nodes [edges-map] 119 | (let [wumpus (rand-node) 120 | glow-worms (->> (range *node-num*) 121 | (reduce (fn [st _] (conj st (rand-node))) #{}) 122 | shuffle 123 | (take 3) 124 | set)] 125 | (vec 126 | (for [k (keys edges-map)] 127 | (vec (concat 128 | [k] 129 | (cond 130 | (= k wumpus) [:WUMPUS] 131 | (within-two k wumpus edges-map) [:BLOOD!] 132 | :else []) 133 | (cond 134 | (glow-worms k) [:GLOW-WORM] 135 | (some #(within-one k % edges-map) glow-worms) [:LIGHTS!] 136 | :else []) 137 | (when (some #(first (rest %)) (get edges-map k)) 138 | [:SIRENS!]))))))) 139 | 140 | (defn find-empty-node [] 141 | (if-let [empty-nd (first 142 | (filter #(= 1 (count %)) 143 | (shuffle @city-nodes)))] 144 | (first empty-nd) 145 | (throw (IllegalStateException. "No empty nodes available. Try another game configuration.")))) 146 | 147 | 148 | (defn draw-city [] 149 | (ugraph->svg "wumpus" @city-edges @city-nodes)) 150 | 151 | 152 | (defn known-city-nodes [] 153 | (let [visited (keep (fn [nd] 154 | (when (@visited-nodes (first nd)) 155 | (if (= @player-pos (first nd)) 156 | (conj nd "*") 157 | nd))) 158 | @city-nodes) 159 | visited-idxs-set (set (map first visited)) 160 | visible (for [seen-node visited 161 | newnd (@city-edges (first seen-node)) 162 | :when (not (visited-idxs-set (first newnd)))] 163 | (vector (first newnd) "?"))] 164 | (vec (concat visited visible)))) 165 | 166 | 167 | (defn known-city-edges [] 168 | (let [remove-cops (fn [v] 169 | (mapv #(vec (take 1 %)) v))] 170 | (reduce #(assoc % %2 (remove-cops (@city-edges %2))) {} @visited-nodes))) 171 | 172 | 173 | (defn draw-known-city [] 174 | (ugraph->svg "known-city" (known-city-edges) (known-city-nodes))) 175 | 176 | ;; ---[ user invokable helpers ]--- ;; 177 | 178 | (declare status) 179 | 180 | (defn game-over [win-lose msg] 181 | (reset! player-status win-lose) 182 | (println msg)) 183 | 184 | 185 | (defn do-move [pos edge type] 186 | (let [node (first (filter #(#{pos} (first %)) @city-nodes)) 187 | has-worm (and (some #{:GLOW-WORM} node) 188 | (not (@visited-nodes pos)))] 189 | 190 | (dosync 191 | (ref-set player-pos pos) 192 | (alter visited-nodes conj pos)) 193 | 194 | (draw-known-city) 195 | 196 | (cond 197 | (some #{:COPS} edge) (game-over :lose "You ran into the cops. Game over.") 198 | (some #{:WUMPUS} node) (if (= type :charge) 199 | (game-over :win "You found and terminated the wumpus!") 200 | (game-over :lose "The wumpus has wumped you with his AK47.")) 201 | (= type :charge) (println "You wasted your last bullet. Game over.") 202 | has-worm (let [new-pos (rand-node)] 203 | (println "You ran to a Glow Worm Gang! You're now at" new-pos) 204 | (do-move new-pos nil :move)) 205 | :else (status)))) 206 | 207 | (defn move-to 208 | [pos type] 209 | (case @player-status 210 | :lose (println "You cannot move as you have died or been captured.") 211 | :win (println "No moves left - you alread won.") 212 | :in-progress (if-let [edge-ls (filterb #(#{pos} (first %)) 213 | (@city-edges @player-pos))] 214 | (do-move pos (first edge-ls) type) 215 | (println "You cannot go to that location from where you are!")) 216 | )) 217 | 218 | ;; ---[ user invokable 'commands' ]--- ;; 219 | 220 | (defn status [] 221 | (println "Current position:" @player-pos) 222 | (println "Visted nodes:" @visited-nodes) 223 | (println "Known roads: " (known-city-edges))) 224 | 225 | 226 | (defn new-game [] 227 | (reset! city-edges (make-city-edges)) 228 | (reset! city-nodes (make-city-nodes @city-edges)) 229 | (dosync 230 | (ref-set player-pos (find-empty-node)) 231 | (ref-set visited-nodes #{@player-pos})) 232 | (draw-city) 233 | (draw-known-city)) 234 | 235 | (defn walk [pos] 236 | (move-to pos :walk)) 237 | 238 | (defn charge [pos] 239 | (move-to pos :charge)) 240 | 241 | 242 | 243 | 244 | 245 | ;; ---[ data structure documentation ]--- ;; 246 | 247 | (comment 248 | ;; this is an example of what city-edges looks like 249 | {1 [[3] [7] [12] [29] [30]], 2 [[17]], 3 [[9] [1]], 4 [[16]], 5 [[28]], 6 [[8] [16] [27]], 7 [[9] [18] [1]], 8 [[26] [28] [6]], 9 [[12 :COPS] [13] [18] [23] [30 :COPS] [3] [7]], 10 [[14 :COPS]], 11 [[22]], 12 [[25] [1] [9 :COPS]], 13 [[24] [27] [9]], 14 [[21] [24] [25] [10 :COPS]], 15 [[17] [24] [30]], 16 [[23 :COPS] [27] [30 :COPS] [4] [6]], 17 [[2] [15]], 18 [[28] [7] [9]], 19 [[22]], 20 [[30]], 21 [[25] [14]], 22 [[11] [19]], 23 [[9] [16 :COPS]], 24 [[28] [13] [14] [15]], 25 [[29] [30] [12] [14] [21]], 26 [[8]], 27 [[6] [13] [16]], 28 [[5] [8] [18] [24]], 29 [[1] [25]], 30 [[1] [9 :COPS] [15] [16 :COPS] [20] [25]]}) 250 | 251 | 252 | (comment 253 | ;; exmaple of city-nodes 254 | [[1] [2 :LIGHTS! :SIRENS!] [3 :SIRENS!] [4 :BLOOD! :SIRENS!] [5 :SIRENS!] [6 :WUMPUS :GLOW-WORM :SIRENS!] [7] [8] [9 :LIGHTS!] [10 :LIGHTS! :SIRENS!] [11 :SIRENS!] [12] [13 :BLOOD! :LIGHTS!] [14 :GLOW-WORM] [15] [16 :BLOOD! :LIGHTS!] [17 :BLOOD! :LIGHTS!] [18 :BLOOD!] [19 :SIRENS!] [20 :SIRENS!] [21] [22] [23 :SIRENS!] [24 :BLOOD! :GLOW-WORM] [25] [26 :BLOOD! :SIRENS!] [27 :BLOOD! :LIGHTS! :SIRENS!] [28] [29 :BLOOD! :LIGHTS! :SIRENS!] [30]] 255 | ) 256 | --------------------------------------------------------------------------------