Cleanup

Cleanup

--- src/whisper2cyanite/core.clj
+++ src/whisper2cyanite/core.clj
@@ -215,11 +215,6 @@
   (let [processed (:processed data-stats)
         data-errors (count (:error-files data-stats))
         store-errors (count (:error-files store-stats))]
-    ;; (log/info (format "%s: %s, errors: %s%s" title processed errors
-    ;;                   (if (> (+ data-errors store-errors) 0)
-    ;;                     (str ", erroneous paths:\n"
-    ;;                          (str/join "\n" error-files))
-    ;;                     "")))
     (log/info (format "%s: processed %s, store errors: %s, data errors: %s"
                       title processed store-errors data-errors))
     (newline)


delaney.clj: generalised (canonical?)

delaney.clj: generalised (canonical?)

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -529,8 +529,11 @@
     (let [ds (dsymbol ds)]
       (from-protocol (dim ds) (size ds) (invariant ds D)))))

-(defn canonical? [ds]
-  (= (dsymbol ds) (canonical ds)))
+(defn canonical?
+  ([ds]
+    (= (dsymbol ds) (canonical ds)))
+  ([ds D]
+    (= (dsymbol ds) (canonical ds D))))

 (defn isomorphic? [ds1 ds2]
   (= (invariant ds1) (invariant ds2)))


delaney.clj: completed (spin) and added (unspin); changed order of some code

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -1,6 +1,6 @@
 (ns org.gavrog.clojure.delaney
   (:use (clojure [test])
-        (org.gavrog.clojure [util :only [empty-queue pop-while]]))
+        (org.gavrog.clojure [util :only [empty-queue pop-while unique]]))
   (:import (org.gavrog.joss.dsyms.basic DelaneySymbol)
            (java.io Writer)))

@@ -29,6 +29,9 @@
   (s [ds i D] (when (.definesOp ds i D) (.op ds i D)))
   (v [ds i j D] (when (.definesV ds i j D) (.v ds i j D))))

+
+;; === Private functions for IDSymbol instances
+
 (defn- ops [ds]
   (into {} (for [i (indices ds)]
              [i (into {} (for [D (elements ds)
@@ -41,6 +44,101 @@
              [i (into {} (for [D (elements ds)
                                :when (v ds i (inc i) D)]
                            [D (v ds i (inc i) D)]))])))
+
+
+;; === Exportable functions for IDSymbol instances
+
+(defn size [ds] (count (elements ds)))
+
+(defn dim [ds] (dec (count (indices ds))))
+
+(defn pretty-traversal [ds indices seeds]
+  (let [stacks (map #(vector % ()) (take 2 indices))
+        queues (map #(vector % empty-queue) (drop 2 indices))
+        as-root #(vector % :root)
+        unseen (fn [i seen bag] (pop-while #(seen [% i]) bag))
+        pop-seen #(for [[i ys] %1] (vector i (unseen i %2 ys)))
+        push-neighbors #(for [[i ys] %1] (vector i (conj ys %2)))]
+    ((fn collect [seeds-left todo seen]
+       (let [seeds-left (drop-while (comp seen as-root) seeds-left)
+             todo (pop-seen todo seen)
+             [i todo-for-i] (->> todo (filter (comp seq second)) first)]
+         (cond
+           (seq todo-for-i)
+           (let [D (first todo-for-i)
+                 Di (s ds i D)
+                 todo (if Di (doall (push-neighbors todo Di)) todo)
+                 seen (conj seen (as-root Di) [D i] [Di i])]
+             (lazy-seq (cons [D i Di] (collect seeds-left todo seen))))
+           (seq seeds-left)
+           (let [D (first seeds-left)
+                 todo (doall (push-neighbors todo D))
+                 seen (conj seen (as-root D))]
+             (lazy-seq
+               (cons (as-root D) (collect (rest seeds-left) todo seen))))
+           :else
+           ())))
+      (seq seeds) (doall (concat stacks queues)) #{})))
+
+(defn orbit-reps
+  ([ds indices seeds]
+    (for [[D i] (pretty-traversal ds indices seeds) :when (= :root i)] D))
+  ([ds indices]
+    (orbit-reps ds indices (elements ds))))
+
+(defn orbit [ds indices seed]
+  (unique (for [[D i] (pretty-traversal ds indices [seed])] D)))
+
+(defn walk [ds D & idxs]
+  "Returns the result of applying the D-symbol operators on ds with the
+   given indices in order, starting with the element D. If the result of
+   any step is undefined, nil is returned."
+  (reduce #(s ds %2 %1) D idxs))
+
+(defn r [ds i j D]
+  (loop [n 1, E D]
+    (when-let [F (walk ds E i j)]
+      (if (= F D)
+        n
+        (recur (inc n) F)))))
+
+(defn m [ds i j D]
+  (let [v (v ds i j D)
+        r (r ds i j D)]
+    (when (and v r) (* v r))))
+
+(defn chain-end [ds D i j]
+  "Returns the result of alternately applying operators indexed i and j,
+   starting with the element D, until the end of the chain is reached.
+   In case of a cycle, nil is returned."
+  (loop [E (walk ds D i)]
+    (let [E* (walk ds E j)]
+      (cond
+        (nil? E*) E
+        (= E E*) E
+        (= D E*) nil
+        :else (recur (walk ds E j i))))))
+
+(defn orbit-loopless? [ds indices D]
+  (empty? (for [[D i] (pretty-traversal ds indices [D])
+                :when (and (not= i :root) (or (nil? D) (= D (walk ds D i))))]
+            D)))
+
+(defn curvature
+  ([ds default-v]
+    (reduce +
+            (- (size ds))
+            (for [[i j] [[0 1] [0 2] [1 2]]
+                  :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
+                        v #(or (v ds i j %) default-v)]
+                  D (orbit-reps ds [i j])]
+              (/ (s D) (v D)))))
+  ([ds]
+    (curvature ds 0)))
+
+
+;; === Persistent Clojure implementation of IDSymbol with some common
+;;     restrictions.

 (deftype DSymbol [dim size s# v#]
   IDSymbol
@@ -92,9 +190,22 @@
               ds))
   (spin [ds i j D v]
         (when (and (integer? i) (not (neg? i))
-                   (integer? j) (not (neg? j))
-                   (integer? D) (pos? D))))
-
+                   (= j (inc i))
+                   (integer? D) (pos? D)
+                   (integer? v) (pos? v))
+          (DSymbol. (max dim i j)
+                    (max size D)
+                    s#
+                    (assoc v# i (reduce #(assoc %1 %2 v)
+                                        (v# i)
+                                        (orbit ds [i j] D))))))
+  (unspin [ds i j D]
+          (if (and (index? ds i) (index? ds j) (element? ds D) (= j (inc i)))
+            (DSymbol. dim
+                      size
+                      s#
+                      (assoc v# i (reduce dissoc (v# i) (orbit ds [i j] D))))
+            ds))
   Object
   (equals [self other]
           (and (satisfies? IDSymbol other)
@@ -103,13 +214,6 @@
                (= (ops self) (ops other))
                (= (vs self) (vs other)))))

-
-;; === Functions for IDSymbol instances
-
-(defn size [ds] (count (elements ds)))
-
-(defn dim [ds] (dec (count (indices ds))))
-
 (defmethod print-method DSymbol [ds ^Writer w]
   (print-method (list (symbol "DSymbol.")
                       (dim ds)
@@ -118,102 +222,39 @@
                       (vs ds))
                 w))

-(defn walk [ds D & idxs]
-  "Returns the result of applying the D-symbol operators on ds with the
-   given indices in order, starting with the element D. If the result of
-   any step is undefined, nil is returned."
-  (reduce #(s ds %2 %1) D idxs))
-
-(defn r [ds i j D]
-  (loop [n 1, E D]
-    (when-let [F (walk ds E i j)]
-      (if (= F D)
-        n
-        (recur (inc n) F)))))
-
-(defn m [ds i j D]
-  (let [v (v ds i j D)
-        r (r ds i j D)]
-    (when (and v r) (* v r))))
-
-(defn chain-end [ds D i j]
-  "Returns the result of alternately applying operators indexed i and j,
-   starting with the element D, until the end of the chain is reached.
-   In case of a cycle, nil is returned."
-  (loop [E (walk ds D i)]
-    (let [E* (walk ds E j)]
-      (cond
-        (nil? E*) E
-        (= E E*) E
-        (= D E*) nil
-        :else (recur (walk ds E j i))))))
-
-(defn pretty-traversal [ds indices seeds]
-  (let [stacks (map #(vector % ()) (take 2 indices))
-        queues (map #(vector % empty-queue) (drop 2 indices))
-        as-root #(vector % :root)
-        unseen (fn [i seen bag] (pop-while #(seen [% i]) bag))
-        pop-seen #(for [[i ys] %1] (vector i (unseen i %2 ys)))
-        push-neighbors #(for [[i ys] %1] (vector i (conj ys %2)))]
-    ((fn collect [seeds-left todo seen]
-       (let [seeds-left (drop-while (comp seen as-root) seeds-left)
-             todo (pop-seen todo seen)
-             [i todo-for-i] (->> todo (filter (comp seq second)) first)]
-         (cond
-           (seq todo-for-i)
-           (let [D (first todo-for-i)
-                 Di (walk ds D i)
-                 todo (if Di (doall (push-neighbors todo Di)) todo)
-                 seen (conj seen (as-root Di) [D i] [Di i])]
-             (lazy-seq (cons [D i Di] (collect seeds-left todo seen))))
-           (seq seeds-left)
-           (let [D (first seeds-left)
-                 todo (doall (push-neighbors todo D))
-                 seen (conj seen (as-root D))]
-             (lazy-seq
-               (cons (as-root D) (collect (rest seeds-left) todo seen))))
-           :else
-           ())))
-      (seq seeds) (doall (concat stacks queues)) #{})))
-
-(defn orbit-reps
-  ([ds indices seeds]
-    (for [[D i] (pretty-traversal ds indices seeds) :when (= :root i)] D))
-  ([ds indices]
-    (orbit-reps ds indices (elements ds))))
-
-(defn orbit [ds indices seed]
-  (for [[D i] (pretty-traversal ds indices [seed])] D))
-
-(defn orbit-loopless? [ds indices D]
-  (empty? (for [[D i] (pretty-traversal ds indices [D])
-                :when (and (not= i :root) (or (nil? D) (= D (walk ds D i))))]
-            D)))
-
-(defn curvature
-  ([ds default-v]
-    (reduce +
-            (- (size ds))
-            (for [[i j] [[0 1] [0 2] [1 2]]
-                  :let [s #(if (orbit-loopless? ds [i j] %) 2 1)
-                        v #(or (v ds i j %) default-v)]
-                  D (orbit-reps ds [i j])]
-              (/ (s D) (v D)))))
-  ([ds]
-    (curvature ds 0)))

 ;; === Tests

-(deftest add-elements
-  (is (= (dsconj (DSymbol. 0 0 {} {}) 2)
+(deftest adding-elements
+  (is (= (dsconj (DSymbol. 0 0 {} {})
+                 2)
          (DSymbol. 0 2 {} {}))))

 (deftest removing-elements
   (is (= (dsdisj (DSymbol. 2 2
                            {0 {1 1, 2 2} 1 {1 2, 2 1} 2 {1 2, 2 1}}
-                           {0 {1 4, 2 4} 1 {1 4, 2 4}}) 2)
+                           {0 {1 4, 2 4} 1 {1 4, 2 4}})
+                 2)
          (DSymbol. 2 1 {0 {1 1} 1 {} 2 {}} {0 {1 4} 1 {1 4}}))))

 (deftest gluing
-  (is (= (glue (DSymbol. 0 0 {} {}) 2 1 2)
+  (is (= (glue (DSymbol. 0 0 {} {})
+               2 1 2)
          (DSymbol. 2 2 {2 {1 2 2 1}} {}))))
+
+(deftest spinning
+  (is (= (spin (DSymbol. 2 2
+                         {0 {1 1, 2 2} 1 {1 2, 2 1} 2 {1 2, 2 1}}
+                         {})
+               0 1 1 3)
+         (DSymbol. 2 2
+                   {0 {1 1, 2 2} 1 {1 2, 2 1} 2 {1 2, 2 1}}
+                   {0 {1 3, 2 3}})))
+  (is (= (unspin (DSymbol. 2 2
+                           {0 {1 1, 2 2} 1 {1 2, 2 1} 2 {1 2, 2 1}}
+                           {0 {1 4, 2 4} 1 {1 4, 2 4}})
+                 0 1 2)
+         (DSymbol. 2 2
+                   {0 {1 1, 2 2} 1 {1 2, 2 1} 2 {1 2, 2 1}}
+                   {1 {1 4, 2 4}})))
+  )


Minor code cleanup

Minor code cleanup

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -581,7 +581,7 @@
       (tp-get-title [this]
         "Checking paths")
       (tp-get-paths [this]
-        (get-paths pstore tenant paths (:exclude-paths options) false
+        (get-paths pstore tenant paths nil false
                    (partial add-path-to-tree tree-impl)))
       (tp-process-path [this path]
         ;; Leaf?


if -> when

if -> when

--- modules/reitit-core/src/reitit/core.cljc
+++ modules/reitit-core/src/reitit/core.cljc
@@ -39,7 +39,7 @@
      (walk-one [pacc macc routes]
        (if (vector? (first routes))
          (walk-many pacc macc routes)
-         (if (string? (first routes))
+         (when (string? (first routes))
            (let [[path & [maybe-arg :as args]] routes
                  [data childs] (if (or (vector? maybe-arg) (nil? maybe-arg))
                                  [{} args]


Fix the order of youth books

Fix the order of youth books

--- src/catalog/layout/common.clj
+++ src/catalog/layout/common.clj
@@ -14,8 +14,9 @@
                 :biografien :freizeit-haus-garten :geschichte-und-gegenwart
                 :kunst-kultur-medien :lebensgestaltung-gesundheit-erziehung
                 :philosophie-religion-esoterik :reisen-natur-tiere :sprache
-                :wissenschaft-technik :jugendbücher :kinder-und-jugendsachbücher
-                :kinderbücher-ab-10 :kinderbücher-ab-6])
+                :wissenschaft-technik
+                :kinderbücher-ab-6 :kinderbücher-ab-10 :jugendbücher :kinder-und-jugendsachbücher])
+
 (def ^:dynamic translations {:hörbuch "Neue Hörbücher"
                              :braille "Neue Braillebücher"
                              :grossdruck "Neue Grossdruckbücher"


Print all tags, but limit size to 400 characters

This prevents the system from completely blowing up if large events are
dispatched.

--- src/day8/re_frame/trace.cljs
+++ src/day8/re_frame/trace.cljs
@@ -179,9 +179,11 @@
                 (.toFixed duration 1) " ms"]]
               (when show-row?
                 [:tr {:key (str id "-details")}
-                 [:td {:col-span 3} (with-out-str (pprint/pprint (if-let [params (:event tags)]
-                                                                   params
-                                                                   (dissoc tags :query-v :duration))))]]))))))
+                 [:td {:col-span 3} (let [tag-str (with-out-str (pprint/pprint tags))
+                                          string-size-limit 400]
+                                      (if (< string-size-limit (count tag-str))
+                                        (str (subs tag-str 0 string-size-limit) " ...")
+                                        tag-str))]]))))))

 (defn render-trace-panel []
   (let [filter-input               (r/atom "")


Load project and show dependencies

Load project and show dependencies

--- src-cljs/lein_ui/app.cljs
+++ src-cljs/lein_ui/app.cljs
@@ -10,12 +10,8 @@

 (enable-console-print!)

-(defonce app-state (atom {:current-project {}
-                          :projects []}))
-
-(go
-  (let [result (<! (http/get "http://localhost:8000/api/projects"))]
-    (swap! app-state assoc :projects (-> result :body str edn/read-string :projects))))
+(defonce app-state (atom {:projects {:active nil
+                                     :map {}}}))

 (defn fetch-project [result-chan name key url]
@@ -23,61 +19,100 @@
     (let [result (<! (http/get url))]
       (put! result-chan [name key (-> result :body str edn/read-string)]))))

-(defn app-list [data owner]
+(defn active-project [projects]
+  (when-let [active-key (projects :active)]
+    (get-in projects [:map active-key])))
+
+(defn app-list [projects owner]
   (reify
     om/IRenderState
-    (render-state [this {:keys [set-project active-project]}]
+    (render-state [this {:keys [set-project]}]
       (html
        [:div {:class "project-list"}
-        [:button {:onMouseDown (fn [_]
-                                 (println (pr-str @app-state)))}
-         "Print State"]
         [:h3 "Projects"]
-        (for [project data]
-          [:a {:key (project :name)
+        (for [[name project] (projects :map)]
+          [:a {:key name
                :href "#"
-               :class (if (= (:name project) active-project)
+               :class (if (= (projects :active)
+                             name)
                         "active-project-link"
                         "")
                :onClick (fn [_]
-                               (put! set-project project))}
+                          (put! set-project project))}
            (project :name)])]))))

 (defn app-view [project owner]
   (reify
+    om/IRender
+    (render [_]
+      (html [:div {:class "active-project-view"}
+             [:div (:name project)]
+             [:div (get-in project [:raw-map :description])]
+             [:ol
+              (for [[name version] (get-in project [:raw-map :dependencies])]
+                [:li (str name " " version)])]]))))

-    om/IRenderState
-    (render-state [_ {:keys [project-data]}]
-      (html [:div {:class "active-project-view"}
-             (project :name)]))))
-
+(def set-project (chan))
 (defn app [data owner]
   (reify
-
-    om/IInitState
-    (init-state [_]
-      {:set-project (chan)})
-
-    om/IWillMount
-    (will-mount [_]
-      (let [set-project (om/get-state owner :set-project)]
-        (go (loop []
-              (let [project (<! set-project)]
-                (om/transact! data :current-project project))
-              (recur)))))
-
-    om/IRenderState
-    (render-state [this state]
+    om/IRender
+    (render [this]
       (html
        [:div {:id "app-container"}
-        (om/build app-list (:projects data) {:init-state {:set-project (:set-project state)}
-                                             :state {:active-project (get-in data [:current-project :name])}})
-        (om/build app-view (:current-project data))]))))
+        [:div {:style #js {"background-color" "grey"
+                           "padding" "5px"
+                           "margin" "5px"
+                           "width" "100%"}}
+         [:button {:onMouseDown (fn [_]
+                                  (println (pr-str @app-state)))}
+          "Print State"]]
+
+        (om/build app-list (:projects data) {:init-state {:set-project set-project}})
+        (om/build app-view (active-project (:projects data)))]))))

 (om/root
  app
  app-state
  {:target (. js/document (getElementById "my-app"))})
+
+(defn ensure-project-controller-process [project]
+  (if-let [controller (@project :controller)]
+    controller
+    (let [in (chan)]
+      {:in in
+       :process (go
+                  (fetch-project in "" :summary (@project :url))
+                  (let [[_ _ summary] (<! in)]
+                    (om/transact! project #(merge % summary)))
+
+                  (fetch-project in "" :raw-map (@project :raw-map-url))
+                  (let [[_ _ raw-map] (<! in)]
+                    (om/transact! project #(assoc % :raw-map raw-map))))})))
+
+(defn set-project-process []
+  (go
+    (loop []
+      (let [project (<! set-project)]
+        (swap! app-state (fn [state]
+                           (-> state
+                               (assoc-in [:projects :active] (@project :name))
+                               (assoc-in [:projects :map (:name @project) :controller] (ensure-project-controller-process project))))))
+      (recur))))
+
+
+(defonce run-processes
+  (do
+    (set-project-process)
+    nil))
+
+(defonce load-initial-state
+  (go
+    (let [result (<! (http/get "http://localhost:8000/api/projects"))]
+      (swap! app-state assoc-in [:projects :map]
+             (reduce (fn [m p]
+                       (assoc m (p :name) p))
+                     {}
+                     (-> result :body str edn/read-string :projects))))))

  ;; optional callback

@@ -88,7 +123,3 @@
    :jsload-callback (fn [] (print "reloaded"))) ;; optional callback
   )
 (connect)
-
-
-
-


Re-add missing default value for :kafka/commit-interval

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -31,6 +31,7 @@

 (def defaults
   {:kafka/receive-buffer-bytes 65536
+   :kafka/commit-interval 2000
    :kafka/wrap-with-metadata? false})

 (defn get-offset-reset [task-map x]


Add decode edn body middleware

Add decode edn body middleware

--- src/clj/clojuredocs/entry.clj
+++ src/clj/clojuredocs/entry.clj
@@ -27,7 +27,8 @@
             [clojuredocs.site.styleguide :as styleguide]
             [clojure.pprint :refer (pprint)]
             [clojuredocs.api :as api]
-            [somnium.congomongo :as mon]))
+            [somnium.congomongo :as mon]
+            [clojure.edn :as edn]))

 (defn hiccup->html-string [body]
   (if-not (vector? body)
@@ -139,9 +140,20 @@
         (update-in res [:headers] merge {"Cache-Control" "public, max-age=31536000"})
         res))))

+(defn decode-edn-body [h]
+  (fn [r]
+    (if (= "application/edn" (get-in r [:headers "content-type"]))
+      (try
+        (h (assoc r :edn-body (-> r util/response-body edn/read-string)))
+        (catch Exception e
+          {:status 400
+           :body "Malformed edn"}))
+      (h r))))
+
 (def routes
   (-> _routes
       promote-session-user
+      decode-edn-body
       wrap-keyword-params
       wrap-nested-params
       wrap-params


6 coffees in a day? Unpossible!

6 coffees in a day? Unpossible!

--- src/clj/mokkameister/brew.clj
+++ src/clj/mokkameister/brew.clj
@@ -14,7 +14,8 @@
    2 "No er det snart kaffi igjen, "
    3 "Kaffi no igjen? "
    4 "Eg gir meg ende øve, fjerde kaffien i dag? "
-   5 "Femte gong? "})
+   5 "Femte gong? "
+   6 "clj.mokkameister.Exception: Coffee Overflow (brew.clj:18) "})

 (def ^:private mokkameister-link
   "<https://revolverhuset.no/kaffi/|revolverhuset.no/kaffi>")


cleanup

cleanup

--- src/clj_beautify/beautify.clj
+++ src/clj_beautify/beautify.clj
@@ -26,9 +26,7 @@
   "Takes valid clojure as input and transforms it to a clojure literal for
   formating."
   [string format-type]
-  (let [test (read-all (rt/string-push-back-reader string))]
-    (println test)
-    test))
+  (read-all (rt/string-push-back-reader string)))

 ;; TODO: not sure of the performance reprocussions of regex string replacement
 (defn- unwrap-comments


Use multi-method for cell rendering

Use multi-method for cell rendering

--- src/cljc/robinson/render.cljc
+++ src/cljc/robinson/render.cljc
@@ -1319,13 +1319,13 @@
           :human           [\@ (class->rgb (get npc :class)) :black]
           [\@])) d) targeted?))

-(defn draw-npcs [rstate state current-time vx vy d]
+(defn draw-npcs [rstate state player-pos current-time vx vy d]
   {:pre [(not (nil? rstate))]
    :post [(comp nil? not)]}
   ;; draw npcs
   (let [place-npcs (npcs-in-viewport state)
         ;_ (log/debug "place-npcs" place-npcs)
-        pos (-> state :world :player :pos)
+        ;pos (-> state :world :player :pos)
         get-cell (memoize (fn [x y] (get-cell state x y)))
         place-id (rw/current-place-id state)]
     (put-chars rstate :features
@@ -1341,7 +1341,7 @@
                                     (= target-pos (get npc :pos))))
                       ;t       (rw/get-time state)
                       visible (and (not (farther-than?
-                                          pos
+                                          player-pos
                                           {:x x :y y}
                                           8))
                                    (= (get (rw/get-cell state x y) :discovered) current-time))]
@@ -1463,6 +1463,161 @@
                                           :white :black)
         rstate)))))

+(defmulti cell->ch-fg-bg (fn [{:keys [type]}  _] type))
+(defmethod cell->ch-fg-bg :floor [cell _] [\·])
+(defmethod cell->ch-fg-bg :open-door [cell _] [\-  :brown  :black #{:bold}])
+(defmethod cell->ch-fg-bg :close-door [cell _] [\+  :brown  :black #{:bold}])
+(defmethod cell->ch-fg-bg :corridor [cell _] [\#] )
+(defmethod cell->ch-fg-bg :down-stairs [cell _] [\>] )
+(defmethod cell->ch-fg-bg :up-stairs [cell _] [\<] )
+(defmethod cell->ch-fg-bg :fire [cell current-time]
+  [\u2240 (if (= (cell :discovered) current-time)
+            :fire
+            :red) :black]) ;; ≀
+(defmethod cell->ch-fg-bg :water [cell current-time]
+  [\u2248 (if (= (cell :discovered) current-time)
+            :water
+            :blue) :black]) ;; ≈
+(defmethod cell->ch-fg-bg :surf [cell current-time]
+  [\~ (if (= (cell :discovered) current-time)
+        :surf
+        :light-blue) :black])
+(defmethod cell->ch-fg-bg :shallow-water [cell current-time]
+  [\~ (if (= (cell :discovered) current-time)
+        :shallow-water
+        :light-blue) :black])
+(defmethod cell->ch-fg-bg :swamp [cell current-time]
+  [\~ (if (= (cell :discovered) current-time)
+        :swamp
+        :light-blue) :black])
+(defmethod cell->ch-fg-bg :lava [cell current-time]
+  [\~ (if (= (cell :discovered) current-time)
+       :lava
+       :light-blue) :black])
+(defmethod cell->ch-fg-bg :mountain [cell _] [\u2206 :gray :black]) ;; ∆
+(defmethod cell->ch-fg-bg :sand [cell _] [\·  :beige      :black])
+(defmethod cell->ch-fg-bg :dirt [cell _] [\·  :brown      :black])
+(defmethod cell->ch-fg-bg :dune [cell _] [\u1d16  :light-brown :black]) ;; ᴖ
+(defmethod cell->ch-fg-bg :rocky-shore [cell _] [\u1d16  :dark-gray  :black]) ;; ᴖ
+(defmethod cell->ch-fg-bg :gravel [cell _] [\·  :gray       :black])
+(defmethod cell->ch-fg-bg :short-grass [cell _] [\·  :green      :black])
+(defmethod cell->ch-fg-bg :tall-grass [cell _] [\" :dark-green :black])
+(defmethod cell->ch-fg-bg :tree [cell _] [\T  :dark-green :black])
+(defmethod cell->ch-fg-bg :bamboo [cell _] [\u01c1 :light-green :black]) ;; ∥
+(defmethod cell->ch-fg-bg :palisade [cell _] [\# :brown :black])
+(defmethod cell->ch-fg-bg :ramada [cell _] [\# :beige :black])
+(defmethod cell->ch-fg-bg :tarp-shelter [cell _] [\# :blue  :black])
+(defmethod cell->ch-fg-bg :lean-to [cell _] [\# :light-green :black])
+(defmethod cell->ch-fg-bg :campfire [cell _] [\^ :brown :black])
+(defmethod cell->ch-fg-bg :bamboo-water-collector [cell _]
+                 (if (< 10 (get cell :water 0))
+                   [\O :bamboo-water-collector :black]
+                   [\O]))
+(defmethod cell->ch-fg-bg :solar-still [cell _]
+                 (if (< 10 (get cell :water 0))
+                   [\O :solar-still :black]
+                   [\O]))
+(defmethod cell->ch-fg-bg :palm-tree [cell _] [\7  :dark-green :black])
+(defmethod cell->ch-fg-bg :fruit-tree [cell _] [\u2648  :light-green :black]) ;; ♈
+(defmethod cell->ch-fg-bg :freshwater-hole [cell _] (if (< 10 (get cell :water 0))
+                   [\~ :freshwater-hole :black]
+                   [\O]))
+(defmethod cell->ch-fg-bg :saltwater-hole [cell _] (if (< 10 (get cell :water 0))
+                   [\~ :saltwater-hole :black]
+                   [\O]))
+(defmethod cell->ch-fg-bg :dry-hole [cell _] [\O])
+;; pirate ship cell types
+(defmethod cell->ch-fg-bg :bulkhead [cell _] [\◘ :brown :black])
+(defmethod cell->ch-fg-bg :wheel [cell _] [\○ :dark-brown :black])
+(defmethod cell->ch-fg-bg :bulkhead2 [cell _] [\◘ :brown :black])
+(defmethod cell->ch-fg-bg :wooden-wall [cell _] [\# :ship-brown :black])
+(defmethod cell->ch-fg-bg :railing [cell _] [\# :ship-brown :black])
+(defmethod cell->ch-fg-bg :hammock-v [cell _] [\) :brown :black])
+(defmethod cell->ch-fg-bg :hammock-h [cell _] [\- :brown :black])
+(defmethod cell->ch-fg-bg :deck [cell _] [\· :dark-brown :black])
+(defmethod cell->ch-fg-bg :canon-breach [cell _] [\║ :gray :dark-brown])
+(defmethod cell->ch-fg-bg :tackle [cell _] [\º :brown :black])
+(defmethod cell->ch-fg-bg :canon [cell _] [\║ :gray :black])
+(defmethod cell->ch-fg-bg :grate [cell _] [\╬ :dark-beige :black])
+(defmethod cell->ch-fg-bg :table [cell _] [\╤ :ship-light-brown :black])
+(defmethod cell->ch-fg-bg :chair [cell _] [\╥ :ship-light-brown :black])
+(defmethod cell->ch-fg-bg :mast [cell _] [\╨ :ship-light-brown :black])
+(defmethod cell->ch-fg-bg :beam [cell _] [\═ :brown :black])
+(defmethod cell->ch-fg-bg :canon-truck-1 [cell _] [\▄ :dark-brown :black])
+(defmethod cell->ch-fg-bg :locker [cell _] [\▌ :brown :black])
+(defmethod cell->ch-fg-bg :locker2 [cell _] [\▐ :brown :black])
+(defmethod cell->ch-fg-bg :canon-truck-2 [cell _] [\▀ :dark-brown :black])
+(defmethod cell->ch-fg-bg :ships-wheel [cell _] [\Φ :brown :black])
+(defmethod cell->ch-fg-bg :ladder [cell _] [\≡ :dark-beige :black])
+(defmethod cell->ch-fg-bg :porthole [cell _] [\° :brown :black])
+(defmethod cell->ch-fg-bg :chest [cell _] [\■ :ship-dark-brown :black])
+(defmethod cell->ch-fg-bg :artifact-chest [cell _] [\■ :dark-beige :black])
+;; ruined temple cell types
+(defmethod cell->ch-fg-bg :vertical-wall [cell _] [\║ :temple-beige :black])
+(defmethod cell->ch-fg-bg :horizontal-wall [cell _] [\═ :temple-beige :black])
+(defmethod cell->ch-fg-bg :vertical-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :horizontal-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :upper-left-1 [cell _] [\╔ :temple-beige :black])
+(defmethod cell->ch-fg-bg :upper-right-1 [cell _] [\╗ :temple-beige :black])
+(defmethod cell->ch-fg-bg :bottom-left-1 [cell _] [\╚ :temple-beige :black])
+(defmethod cell->ch-fg-bg :bottom-right-1 [cell _] [\╝ :temple-beige :black])
+(defmethod cell->ch-fg-bg :upper-left-2 [cell _] [\◙ :temple-beige :black])
+(defmethod cell->ch-fg-bg :upper-right-2 [cell _] [\◙ :temple-beige :black])
+(defmethod cell->ch-fg-bg :bottom-left-2 [cell _] [\◙ :temple-beige :black])
+(defmethod cell->ch-fg-bg :bottom-right-2 [cell _] [\◙ :temple-beige :black])
+(defmethod cell->ch-fg-bg :altar [cell _] [\┬ :white :black])
+(defmethod cell->ch-fg-bg :vine [cell _] [\⌠ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-corridor [cell _] [\# :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-vertical-wall [cell _] [\║ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-horizontal-wall [cell _] [\═ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-vertical-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :moss-horizontal-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :moss-upper-left-1 [cell _] [\╔ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-upper-right-1 [cell _] [\╗ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-bottom-left-1 [cell _] [\╚ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-bottom-right-1 [cell _] [\╝ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-upper-left-2 [cell _] [\◙ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-upper-right-2 [cell _] [\◙ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-bottom-left-2 [cell _] [\◙ :moss-green :black])
+(defmethod cell->ch-fg-bg :moss-bottom-right-2 [cell _] [\◙ :moss-green :black])
+(defmethod cell->ch-fg-bg :white-corridor [cell _] [\# :white :black])
+(defmethod cell->ch-fg-bg :white-vertical-wall [cell _] [\║ :white :black])
+(defmethod cell->ch-fg-bg :white-horizontal-wall [cell _] [\═ :white :black])
+(defmethod cell->ch-fg-bg :white-vertical-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :white-horizontal-wall-alt [cell _] [\° :white :black])
+(defmethod cell->ch-fg-bg :white-upper-left-1 [cell _] [\╔ :white :black])
+(defmethod cell->ch-fg-bg :white-upper-right-1 [cell _] [\╗ :white :black])
+(defmethod cell->ch-fg-bg :white-bottom-left-1 [cell _] [\╚ :white :black])
+(defmethod cell->ch-fg-bg :white-bottom-right-1 [cell _] [\╝ :white :black])
+(defmethod cell->ch-fg-bg :white-upper-left-2 [cell _] [\◙ :white :black])
+(defmethod cell->ch-fg-bg :white-upper-right-2 [cell _] [\◙ :white :black])
+(defmethod cell->ch-fg-bg :white-bottom-left-2 [cell _] [\◙ :white :black])
+(defmethod cell->ch-fg-bg :white-bottom-right-2 [cell _] [\◙ :white :black])
+(defmethod cell->ch-fg-bg :empty [cell _] [\space :black :black])
+(defmethod cell->ch-fg-bg :crushing-wall-trigger [cell _]
+                  (if (get cell :trap-found)
+                    [\^]
+                    [\·]))
+(defmethod cell->ch-fg-bg :wall-darts-trigger [cell _]
+                  (if (get cell :trap-found)
+                    [\^]
+                    [\·]))
+(defmethod cell->ch-fg-bg :poisonous-gas-trigger [cell _]
+                  (if (get cell :trap-found)
+                    [\^]
+                    [\·]))
+(defmethod cell->ch-fg-bg :spike-pit [cell _]
+                  (if (get cell :trap-found)
+                    [\^]
+                    [\·]))
+(defmethod cell->ch-fg-bg :snakes-trigger [cell _]
+                  (if (get cell :trap-found)
+                    [\^]
+                    [\·]))
+(defmethod cell->ch-fg-bg :default [cell _]
+  (log/info (format "unknown type: %s %s" (str (get cell :type)) (str cell)))
+  [\?])
+
 (defn draw-ranged-attack-line [rstate state player player-x player-y]
   ;; draw ranged-attack line
   (if (contains? #{:select-ranged-target :select-throw-target} (current-state state))
@@ -1490,14 +1645,17 @@
    This renders everything - the map, the menus, the log,
    the status bar. Everything."
   [rstate state]
-  (let [{:keys [columns rows]}                      (get state :screen)
-        current-time                                (get-in state [:world :time])
-        {{player-x :x player-y :y} :pos :as player} (rp/get-player state)
-        [vx vy]                                     (rv/viewport-xy state)
-        d                                           (rlos/sight-distance state)
-        cells                                       (rv/cellsxy-in-viewport state)
-        lantern-on                                  (when-let [lantern (rp/inventory-id->item state :lantern)]
-                                                      (get lantern state :off))
+  (let [{:keys [columns rows]}  (get state :screen)
+        current-time            (get-in state [:world :time])
+        {{player-x :x
+          player-y :y
+          :as player-pos} :pos
+         :as player}            (rp/get-player state)
+        [vx vy]                 (rv/viewport-xy state)
+        d                       (rlos/sight-distance state)
+        cells                   (rv/cellsxy-in-viewport state)
+        lantern-on              (when-let [lantern (rp/inventory-id->item state :lantern)]
+                                  (get lantern state :off))
         ;_ (println cells)
         ;_ (log/info "cells" (str cells))
         characters     (persistent!
@@ -1525,154 +1683,7 @@
                                                             [(rutil/item->char (first cell-items))
                                                              (rutil/item->fg   (first cell-items))
                                                              :black])
-                                                          (case (cell :type)
-                                                           :floor           [\·]
-                                                           :open-door       [\-  :brown  :black #{:bold}]
-                                                           :close-door      [\+  :brown  :black #{:bold}]
-                                                           :corridor        [\#]
-                                                           :down-stairs     [\>]
-                                                           :up-stairs       [\<]
-                                                           :fire            [\u2240 (if (= (cell :discovered) current-time)
-                                                                                :fire
-                                                                                :red) :black] ;; ≀
-                                                           :water           [\u2248 (if (= (cell :discovered) current-time)
-                                                                                :water
-                                                                                :blue) :black] ;; ≈
-                                                           :surf            [\~ (if (= (cell :discovered) current-time)
-                                                                                :surf
-                                                                                :light-blue) :black]
-                                                           :shallow-water   [\~ (if (= (cell :discovered) current-time)
-                                                                                :shallow-water
-                                                                                :light-blue) :black]
-                                                           :swamp           [\~ (if (= (cell :discovered) current-time)
-                                                                                :swamp
-                                                                                :light-blue) :black]
-                                                           :lava            [\~ (if (= (cell :discovered) current-time)
-                                                                                :lava
-                                                                                :light-blue) :black]
-                                                           :mountain        [\u2206 :gray :black] ;; ∆
-                                                           :sand            [\·  :beige      :black]
-                                                           :dirt            [\·  :brown      :black]
-                                                           :dune            [\u1d16  :light-brown :black] ;; ᴖ
-                                                           :rocky-shore     [\u1d16  :dark-gray  :black] ;; ᴖ
-                                                           :gravel          [\·  :gray       :black]
-                                                           :short-grass     [\·  :green      :black]
-                                                           :tall-grass      [\" :dark-green :black]
-                                                           :tree            [\T  :dark-green :black]
-                                                           :bamboo          [\u01c1 :light-green :black] ;; ∥
-                                                           :palisade        [\# :brown :black]
-                                                           :ramada          [\# :beige :black]
-                                                           :tarp-shelter    [\# :blue  :black]
-                                                           :lean-to         [\# :light-green :black]
-                                                           :campfire        [\^ :brown :black]
-                                                           :bamboo-water-collector
-                                                                            (if (< 10 (get cell :water 0))
-                                                                              [\O :bamboo-water-collector :black]
-                                                                              [\O])
-                                                           :solar-still
-                                                                            (if (< 10 (get cell :water 0))
-                                                                              [\O :solar-still :black]
-                                                                              [\O])
-                                                           :palm-tree       [\7  :dark-green :black]
-                                                           :fruit-tree      [\u2648  :light-green :black] ;; ♈
-                                                           :freshwater-hole (if (< 10 (get cell :water 0))
-                                                                              [\~ :freshwater-hole :black]
-                                                                              [\O])
-                                                           :saltwater-hole  (if (< 10 (get cell :water 0))
-                                                                              [\~ :saltwater-hole :black]
-                                                                              [\O])
-                                                           :dry-hole        [\O]
-                                                           ;; pirate ship cell types
-                                                           :bulkhead        [\◘ :brown :black]
-                                                           :wheel           [\○ :dark-brown :black]
-                                                           :bulkhead2       [\◘ :brown :black]
-                                                           :wooden-wall     [\# :ship-brown :black]
-                                                           :railing         [\# :ship-brown :black]
-                                                           :hammock-v       [\) :brown :black]
-                                                           :hammock-h       [\- :brown :black]
-                                                           :deck            [\· :dark-brown :black]
-                                                           :canon-breach    [\║ :gray :dark-brown]
-                                                           :tackle          [\º :brown :black]
-                                                           :canon           [\║ :gray :black]
-                                                           :grate           [\╬ :dark-beige :black]
-                                                           :table           [\╤ :ship-light-brown :black]
-                                                           :chair           [\╥ :ship-light-brown :black]
-                                                           :mast            [\╨ :ship-light-brown :black]
-                                                           :beam            [\═ :brown :black]
-                                                           :canon-truck-1   [\▄ :dark-brown :black]
-                                                           :locker          [\▌ :brown :black]
-                                                           :locker2         [\▐ :brown :black]
-                                                           :canon-truck-2   [\▀ :dark-brown :black]
-                                                           :ships-wheel     [\Φ :brown :black]
-                                                           :ladder          [\≡ :dark-beige :black]
-                                                           :porthole        [\° :brown :black]
-                                                           :chest           [\■ :ship-dark-brown :black]
-                                                           :artifact-chest  [\■ :dark-beige :black]
-                                                           ;; ruined temple cell types
-                                                           :vertical-wall   [\║ :temple-beige :black]
-                                                           :horizontal-wall [\═ :temple-beige :black]
-                                                           :vertical-wall-alt [\° :white :black]
-                                                           :horizontal-wall-alt [\° :white :black]
-                                                           :upper-left-1    [\╔ :temple-beige :black]
-                                                           :upper-right-1   [\╗ :temple-beige :black]
-                                                           :bottom-left-1   [\╚ :temple-beige :black]
-                                                           :bottom-right-1  [\╝ :temple-beige :black]
-                                                           :upper-left-2    [\◙ :temple-beige :black]
-                                                           :upper-right-2   [\◙ :temple-beige :black]
-                                                           :bottom-left-2   [\◙ :temple-beige :black]
-                                                           :bottom-right-2  [\◙ :temple-beige :black]
-                                                           :altar           [\┬ :white :black]
-                                                           :vine            [\⌠ :moss-green :black]
-                                                           :moss-corridor   [\# :moss-green :black]
-                                                           :moss-vertical-wall  [\║ :moss-green :black]
-                                                           :moss-horizontal-wall [\═ :moss-green :black]
-                                                           :moss-vertical-wall-alt [\° :white :black]
-                                                           :moss-horizontal-wall-alt [\° :white :black]
-                                                           :moss-upper-left-1 [\╔ :moss-green :black]
-                                                           :moss-upper-right-1 [\╗ :moss-green :black]
-                                                           :moss-bottom-left-1 [\╚ :moss-green :black]
-                                                           :moss-bottom-right-1 [\╝ :moss-green :black]
-                                                           :moss-upper-left-2 [\◙ :moss-green :black]
-                                                           :moss-upper-right-2 [\◙ :moss-green :black]
-                                                           :moss-bottom-left-2 [\◙ :moss-green :black]
-                                                           :moss-bottom-right-2 [\◙ :moss-green :black]
-                                                           :white-corridor  [\# :white :black]
-                                                           :white-vertical-wall   [\║ :white :black]
-                                                           :white-horizontal-wall [\═ :white :black]
-                                                           :white-vertical-wall-alt [\° :white :black]
-                                                           :white-horizontal-wall-alt [\° :white :black]
-                                                           :white-upper-left-1 [\╔ :white :black]
-                                                           :white-upper-right-1 [\╗ :white :black]
-                                                           :white-bottom-left-1 [\╚ :white :black]
-                                                           :white-bottom-right-1 [\╝ :white :black]
-                                                           :white-upper-left-2 [\◙ :white :black]
-                                                           :white-upper-right-2 [\◙ :white :black]
-                                                           :white-bottom-left-2 [\◙ :white :black]
-                                                           :white-bottom-right-2 [\◙ :white :black]
-                                                           :empty                [\space :black :black]
-                                                           :crushing-wall-trigger
-                                                                             (if (get cell :trap-found)
-                                                                               [\^]
-                                                                               [\·])
-                                                           :wall-darts-trigger
-                                                                             (if (get cell :trap-found)
-                                                                               [\^]
-                                                                               [\·])
-                                                           :poisonous-gas-trigger
-                                                                             (if (get cell :trap-found)
-                                                                               [\^]
-                                                                               [\·])
-                                                           :spike-pit
-                                                                             (if (get cell :trap-found)
-                                                                               [\^]
-                                                                               [\·])
-                                                           :snakes-trigger
-                                                                             (if (get cell :trap-found)
-                                                                               [\^]
-                                                                               [\·])
-
-                                                           (do (log/info (format "unknown type: %s %s" (str (get cell :type)) (str cell)))
-                                                           [\?])))))
+                                                          (cell->ch-fg-bg cell current-time))))
                                            ;; shade character based on visibility, harvestableness, raft
                                            shaded-out-char (cond
                                                              (not= (cell :discovered) current-time)
@@ -1728,7 +1739,7 @@
       (log-render state "debug" "1-draw-player.xp")
       (draw-ranged-attack-line state player player-x player-y)
       (log-render state "debug" "2-draw-ranged-attack-line.xp")
-      (draw-npcs state current-time vx vy d)
+      (draw-npcs state player-pos current-time vx vy d)
       (log-render state "debug" "3-draw-npcs.xp")
       (render-hud state)
       (log-render state "debug" "4-render-hud.xp")


Make defaction a function

Make defaction a function

--- src/cljs/retrobard/macros.clj
+++ src/cljs/retrobard/macros.clj
@@ -1,9 +1,9 @@
 (ns retroboard.macros)

-(defmacro defaction [mult-name [name action-args & body]]
+(defn defaction [mult-name [name action-args & body]]
   (let [args (drop-last action-args)
         state (last action-args)]
-    `(do (defn ~name [connection# ~@args]
+    `((defn ~name [connection# ~@args]
            (cljs.core.async/put!
             (:to-send connection#)
             {:cmd :action
@@ -17,4 +17,4 @@

 (defmacro defactions [name & actions]
   `(do (defmulti ~name first)
-       ~@(map (fn [action#] `(defaction ~name ~action#)) actions)))
+       ~@(apply concat (map (fn [action#] (defaction name action#)) actions))))


Fix bug

Fix bug

--- src/clojournal/models/tag.clj
+++ src/clojournal/models/tag.clj
@@ -23,8 +23,9 @@
                 (mq/find {})
                 (mq/sort {:_id 1})
                 (mq/limit num))
-         refs (map :refs tags)
-         min (double (apply min refs))
-         max (double (apply max refs))
-         f (fn [n] (/ (- n min) (- max min)))]
-     (map #(assoc % :group (f (:refs %))) tags))))
+         refs (map :refs tags)]
+     (when (seq refs)
+       (let [min (double (apply min refs))
+             max (double (apply max refs))
+             f (fn [n] (/ (- n min) (- max min)))]
+         (map #(assoc % :group (f (:refs %))) tags))))))


Fix FAILURE /n_free Node not found error after stopping a currently running demo. Also add run - like demo but without the auto out ugen behaviour. It seems that adding an out ugen to some synth designs causes the server to crash. If you're not wanting to audition an audible synth use #'run.

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -7,6 +7,7 @@
   overtone.sc.synth
   (:use [overtone.util lib old-contrib]
         [overtone.libs event]
+        [overtone.music time]
         [overtone.sc.machinery.ugen fn-gen defaults common specs sc-ugen]
         [overtone.sc.machinery synthdef]
         [overtone.sc server node buffer])
@@ -531,14 +532,31 @@

 (def ^{:dynamic true} *demo-time* 2000)

+(defmacro run
+  "Run an anonymous synth definition.  Useful for experimentation. Does NOT add
+  an out ugen.
+  You can specify a timeout in seconds as the first argument otherwise it
+  defaults to *demo-time* ms.
+
+  (run (send-reply (impulse 1) \"/foo\" [1] 43)) ;=> send OSC messages out
+"
+  [& body]
+  (let [[demo-time body] (if (number? (first body))
+                           [(* 1000 (first body)) (second body)]
+                           [*demo-time* (first body)])]
+    `(let [s# (synth "audition-synth" ~body)
+           note# (s#)]
+       (after-delay ~demo-time #(node-free note#))
+       note#)))
+
 (defmacro demo
   "Try out an anonymous synth definition.  Useful for experimentation.  If the
   root node is not an out ugen, then it will add one automatically.
   You can specify a timeout in seconds as the first argument otherwise it
   defaults to *demo-time* ms.

-  (demo (sin-osc 440))      ;=> plays a sine wave for *demo-time* ms
-  (demo 0.5 (sin-osc 440))  ;=> plays a sine wave for half a second"
+  (play (sin-osc 440))      ;=> plays a sine wave for *demo-time* ms
+  (play 0.5 (sin-osc 440))  ;=> plays a sine wave for half a second"
   [& body]
   (let [[demo-time body] (if (number? (first body))
                            [(* 1000 (first body)) (second body)]
@@ -548,7 +566,7 @@
              (list 'out 0 body))]
     `(let [s# (synth "audition-synth" ~b2)
            note# (s#)]
-       (at-at/at (+ (at-at/now) ~demo-time) #(node-free note#))
+       (after-delay ~demo-time #(node-free note#))
        note#)))

 (defn active-synths


Remove unused require

Remove unused require

--- src/clojure/nightmod/game.clj
+++ src/clojure/nightmod/game.clj
@@ -1,7 +1,6 @@
 (ns nightmod.game
   (:require [clojail.core :as jail]
             [clojure.java.io :as io]
-            [nightmod.manager :as manager]
             [nightmod.screens :as screens]
             [nightmod.utils :as u]
             [play-clj.core :refer :all]))


Changed printing of error vector key from "error" to "errors".

--- src/clojush/pushgp/report.clj
+++ src/clojush/pushgp/report.clj
@@ -78,7 +78,7 @@
    for the json logs."
   [log-fitnesses-for-all-cases json-log-program-strings generation individual]
   (let [part1-ind (-> (if log-fitnesses-for-all-cases
-                        {:error (:errors individual)}
+                        {:errors (:errors individual)}
                         {})
                       (assoc :total-error (:total-error individual))
                       (assoc :generation generation)


fix reference z when using multi-stage positions

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7325 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -385,8 +385,9 @@
 (defn create-presnap-actions [event]
   (concat
     (for [[axis pos] (:axes (MultiStagePosition-to-map (get-msp (:position event)))) :when pos]
-      [axis #(do (when (= axis (core getFocusDrive))
-                   (state-assoc! :reference-z-position pos))
+      [axis #(do ;(when (= axis (core getFocusDevice))
+                 ;  (println "setting reference z position from msp")
+                 ;  (state-assoc! :reference-z-position pos))
                  (apply set-stage-position axis pos))])
     (for [prop (get-in event [:channel :properties])]
       [(prop 0) #(core setProperty (prop 0) (prop 1) (prop 2))])


Replaced dummy dialog with file chooser.

--- src/fm/simrunner/gui/app.clj
+++ src/fm/simrunner/gui/app.clj
@@ -17,10 +17,7 @@

 (defmethod on-action :open-config [_ model & args]
   (println (format "open-config{model: %s args: %s}" model args))
-  (JOptionPane/showMessageDialog (-> args first :widget)
-                                 "Open SimRunner config file."
-                                 "Open Config"
-                                 JOptionPane/INFORMATION_MESSAGE))
+  (gui/choose-file (-> args first :widget) :title "Open Config"))

 (defmethod on-action :default [action model & args]
   (println (format "on-action{action: %s model: %s args: %s}"


Problem added - "Rearranged Code: ->"

Problem added - "Rearranged Code: ->"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -735,9 +735,17 @@
            :tests ["(= (__  \"Have a nice day.\")\n   [\"a\" \"day\" \"Have\" \"nice\"])"
                    "(= (__  \"Clojure is a fun language!\")\n   [\"a\" \"Clojure\" \"fun\" \"is\" \"language\"])"
                    "(= (__  \"Fools fall for foolish follies.\")\n   [\"fall\" \"follies\" \"foolish\" \"Fools\" \"for\"])"]})
+
+      (insert! :problems
+          {:_id 71
+           :title "-> Rearranging Code"
+           :times-solved 0
+           :description "The -> macro threads an expression x through a variable number of forms. First, x is inserted as the second item in the first form, making a list of it if it is not a list already.  Then the first form is inserted as the second item in the second form, making a list of that form if necessary.  This process continues for all the forms.  Using -> can sometimes make your code more readable."
+           :tags ["elementary"]
+           :tests ["(= (last (sort (rest (reverse [2 5 4 1 3 6]))))\n   (-> [2 5 4 1 3 6] reverse __ sort last)\n   5)"]})

       (insert! :problems
-           {:_id 71
+           {:_id 72
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."


Problem added - "Perfect Numbers"

Problem added - "Perfect Numbers"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -902,9 +902,22 @@
             :tags ["hard"]
             :tests ["(= (__ [   [1]\n          [2 4]\n         [5 1 4]\n        [2 3 4 5]])\n   (+ 1 2 1 3)\n   7)"
 		    "(= (__ [     [3]\n            [2 4]\n           [1 9 3]\n          [9 9 2 4]\n         [4 6 6 7 8]\n        [5 7 3 5 1 4]])\n   (+ 3 4 3 2 7 1)\n   20)"]})
+
+      (insert! :problems
+           {:_id 80
+            :title "Perfect Numbers"
+            :times-solved 0
+            :description "A number is \"perfect\" if the sum of its divisors equal the number itself.  6 is a perfect number because 1+2+3=6.  Write a function which returns true for perfect numbers and false otherwise."
+            :approved true
+            :tags ["medium"]
+            :tests ["(= (__ 6) true)"
+		    "(= (__ 7) false)"
+		    "(= (__ 496) true)"
+		    "(= (__ 500) false)"
+		    "(= (__ 8128) true)"]})

       (insert! :problems
-          {:_id 80
+          {:_id 81
            :title "Create an Equation"
            :times-solved 0
            :description "Write a function which takes three or more integers.  Using these integers, your function should generate clojure code representing an equation.  The following rules for the equation must be satisfied:\n\n    1. All integers must be used once and only once.\n    2. The order of the integers must be maintained when reading the equation left-to-right.\n    3. The only functions you may use are +, *, or =.\n    4. The equation must use the minimum number of parentheses.\n    5. If no satisfying equation exists, return nil."
@@ -923,7 +936,7 @@

       (insert! :problems
-           {:_id 81
+           {:_id 82
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."


Basic functionality working for failing code

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -76,14 +76,16 @@
         (flash-error "Empty input is not allowed"
                      (str "/problem/" id)))
       (try
-        (loop [[test & more] tests]
+        (loop [[test & more] tests
+               i 0]
           (if-not test
             (mark-completed id code)
             (let [testcase (s/replace test "__" (str code))]
               (if (sb sb-tester (safe-read testcase))
-                (recur more)
+                (recur more (inc i))
                 (do
                   (session/flash-put! :code code)
+                  (session/flash-put! :failing-test i)
                   (flash-error "You failed the unit tests."
                                (str "/problem/" id)))))))
         (catch Exception e
@@ -107,7 +109,10 @@
          (for [i (range (count tests))]
            [:tr
             [:td
-             [:img {:src "/images/bluelight.png" :class "teststatus"}]]
+             (let [f (session/flash-get :failing-test)]
+               (cond (or (nil? f) (> i f)) [:img {:src "/images/bluelight.png"}]
+                     (= i f) [:img {:src "/images/redlight.png"}]
+                     :else [:img {:src "/images/greenlight.png"}]))]
             [:td
              [:pre {:class "brush: clojure;gutter: false;toolbar: false;light: true"}
               (nth tests i)]]]))]


Allow import

Allow import

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -54,7 +54,7 @@
     (flash-msg (str message " " gist-link) "/problems")))

 (defn get-tester [restricted]
-  (into secure-tester (concat [:use :require :import] (map symbol restricted))))
+  (into secure-tester (concat [:use :require] (map symbol restricted))))

 (def sb (sandbox*))


one more buhug

one more buhug

--- src/friendui/routes/user.clj
+++ src/friendui/routes/user.clj
@@ -58,7 +58,6 @@

 (defn profile []
   (layout/render "user/profile.html"
-                 (println (db/username-kw (friend/current-authentication)))
                  {:fields (user/get-profile-data (:username (friend/current-authentication)))}))

 (defn handle-profile [params]


very basic update

very basic update

--- src/granger/models/books.clj
+++ src/granger/models/books.clj
@@ -14,8 +14,9 @@

 (defn update-book!
   "Update existing book review"
-  [id data]
-  "An update action.")
+  [old updates]
+  (mongo/with-mongo conn
+    (mongo/update! :test old (merge old updates))))

 (defn find-book
   "Returns book review for a given ISBN"


Simplification

Simplification

--- src/aeolian/abc/notes.clj
+++ src/aeolian/abc/notes.clj
@@ -10,22 +10,21 @@
 (def or-root "\"Am\"")

 (defn pick-chord-for-method-length [method-length]
-	(if (nil? method-length)
-		"C"
-		(cond
-		   (<= 1 method-length 5) "C"
-		   (<= 6 method-length 10) "D"
-		   (<= 11 method-length 15) "E"
-		   (<= 16 method-length 20) "F"
-		   (<= 21 method-length 29) "G"
-		   (<= 30 method-length 39) "A"
-		   (<= 40 method-length) "B"
-		   :else "C")))
+	(cond
+		(nil? method-length) "C"
+	   	(<= 1 method-length 5) "C"
+	   	(<= 6 method-length 10) "D"
+	   	(<= 11 method-length 15) "E"
+	   	(<= 16 method-length 20) "F"
+	   	(<= 21 method-length 29) "G"
+	   	(<= 30 method-length 39) "A"
+	   	(<= 40 method-length) "B"
+	   	:else "C"))

 (defn pick-octave-for-line-length [line-length]
 	(cond
-	   (<= 10 line-length 39) octave-1
-	   (<= 40 line-length 79) octave-2
-	   (<= 80 line-length 99) octave-3
-	   (<= 100 line-length 119) octave-4
-	   (<= 120 line-length) octave-5))+	   	(<= 10 line-length 39) octave-1
+	   	(<= 40 line-length 79) octave-2
+	   	(<= 80 line-length 99) octave-3
+	   	(<= 100 line-length 119) octave-4
+	   	(<= 120 line-length) octave-5))


remove this, since it breaks the control code. it works in the UI for now.

--- src/hivewing_core/worker.clj
+++ src/hivewing_core/worker.clj
@@ -67,7 +67,7 @@
     (let [res (first (jdbc/insert! sql-db :workers clean-params))
           uuid (:uuid res)]
       (logger/info "Setting initial worker configuration...")
-      (worker-config-set uuid {".tasks" ["workera" "workerb"]} :allow-system-keys true)
+      ;;(worker-config-set uuid {".tasks" ["workera" "workerb"]} :allow-system-keys true)
       (hin/hive-images-notification-send-worker-update-message uuid)
       res)))


tcp-slurp always connects to localhost

tcp-slurp always connects to localhost

--- test/merlion/core_test.clj
+++ test/merlion/core_test.clj
@@ -72,8 +72,8 @@
   (let [c ["/usr/bin/env" "etcdctl" "rm" "--recursive" (str prefix "/" name) ]]
     (shell/stream-to-string (apply shell/proc c) :out)))

-(defn tcp-slurp [host port]
-  (let [s (Socket. host port)]
+(defn tcp-slurp [port]
+  (let [s (Socket. (InetAddress/getLoopbackAddress) port)]
     (.setSoTimeout s 1000)
     (slurp (io/reader (.getInputStream s)))))

@@ -88,7 +88,7 @@
                  (.toString (java.time.Instant/now)))
         (Thread/sleep 500)
         (is (= (slurp "test/fixtures/excerpt.txt")
-               (tcp-slurp (InetAddress/getLoopbackAddress) port)))))))
+               (tcp-slurp port)))))))

 (deftest slow-download
@@ -101,7 +101,7 @@
                  (.toString (java.time.Instant/now)))
         (Thread/sleep 500)
         (is (= (slurp "test/fixtures/excerpt.txt")
-               (tcp-slurp (InetAddress/getLoopbackAddress) port)))
+               (tcp-slurp port)))
         ))))

@@ -115,7 +115,7 @@
               (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
                        (.toString (java.time.Instant/now)))
               (Thread/sleep 500)
-              (let [f (future (tcp-slurp (InetAddress/getLoopbackAddress) port))]
+              (let [f (future (tcp-slurp port))]
                 (Thread/sleep 4000)
                 f))]
         (async/put! @server :quit)
@@ -131,7 +131,7 @@
         (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
                  (.toString (java.time.Instant/now)))
         (Thread/sleep 500)
-        (let [f (future (tcp-slurp (InetAddress/getLoopbackAddress) port))]
+        (let [f (future (tcp-slurp port))]
           (Thread/sleep 4000)
           (etcd-rm (str "service/" domain-name "/aaa"))
           (is (= (slurp "test/fixtures/excerpt.txt") @f)))))))
@@ -143,7 +143,7 @@
         (Thread/sleep 500)
         (is (thrown?
              java.net.SocketTimeoutException
-             (tcp-slurp (InetAddress/getLoopbackAddress) port)))))))
+             (tcp-slurp port)))))))

 (deftest delete-backend
@@ -159,5 +159,5 @@
         (Thread/sleep 500)
         (is (thrown?
              java.net.SocketTimeoutException
-             (tcp-slurp (InetAddress/getLoopbackAddress) port)))
+             (tcp-slurp port)))
         ))))


Removed sidenote about awkwardness of comment filter

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -127,12 +127,6 @@
 ;;      {:this "2", :that "3", :more "other yeah"})
 ;;
 ;; Much better :-)
-;;
-;; [**Sidenote**: it feels awkward to me that this operates _after_ the initial parsing step has already taken
-;; place.
-;; However, it's not clear how you would do this safely;
-;; It seems you have to make assumptions about how things are going into the parsing function, which I'd
-;; rather avoid.]

 ;; <br/>


modifiable constants!

modifiable constants!

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/aurora/editor/ui.cljs
+++ src/aurora/editor/ui.cljs
@@ -30,11 +30,12 @@
 (defmulti step-description :type)
 (defmulti item-ui :type)

-(defmethod item-ui :default [step]
+(defmethod item-ui :default [step path]
   (dom
    (if-not (:type step)
-     (item-ui {:type :constant
-               :data step})
+     (item-ui {:type :non-node-constant
+               :data step}
+              path)
      [:span (pr-str step)])))

 (defmethod step-list-item :default [step]
@@ -227,7 +228,14 @@
   (let [value (:data x)
         name (datatype-name value)]
       (if-let [rep (get-in @aurora-state [:cache :representations name])]
-        (rep value (assoc path :sub-path :data))
+        (rep value (assoc path :sub-path [:data]))
+        (pr-str x))))
+
+(defmethod item-ui :non-node-constant [x path]
+  (let [value (:data x)
+        name (datatype-name value)]
+      (if-let [rep (get-in @aurora-state [:cache :representations name])]
+        (rep value path)
         (pr-str x))))

 (defmethod step-list-item :constant [step path]
@@ -247,7 +255,7 @@
                             (.stopPropagation e))}
       [:p {:className "desc"} "Add a " [:span {:className "value"} name]
        (when-let [rep (get-in @aurora-state [:cache :representations name])]
-         (rep value))]
+         (rep value (assoc (last path) :sub-path [:data])))]

       ])))

@@ -255,7 +263,11 @@
   (let [value (:data step)
         name (datatype-name value)]
     (dom
-      [:p {:className "desc"} "Add a " [:span {:className "value"} name]])))
+     [:p {:className "desc"} "Add a " [:span {:className "value"} name]]
+     [:div {:className "result"}
+      (item-ui {:type :constant
+                :data (path->result path)} (last path))
+      ])))

 ;;*********************************************************
 ;; editor
@@ -320,11 +332,7 @@
        (new-step-helper))
      (when step
        (step-description step path)
-       [:div {:className "result"}
-        (item-ui
-         (path->result path)
-         (last path))
-        ])
+       )
      ])

 ;;*********************************************************
@@ -466,22 +474,22 @@
 ;; Representations
 ;;*********************************************************

-(defdom table-ui [ks vs]
+(defdom table-ui [ks vs path]
   [:table {:className "table"}
    [:thead
     [:tr
      (each [k ks]
-           [:th (item-ui k)])]]
+           [:th (item-ui k (assoc path :sub-path (conj (:sub-path path []) ::key k)))])]]
    [:tbody
     [:tr
      (each [v vs]
-           [:td (item-ui v)])]]])
-
-
-(defdom list-ui [vs]
+           [:td (item-ui v (assoc path :sub-path (conj (:sub-path path []) (nth ks index))))])]]])
+
+
+(defdom list-ui [vs path]
   [:ul {:className "list"}
    (each [v vs]
-         [:li (item-ui v)])])
+         [:li (item-ui v (assoc path :sub-path (conj (:sub-path path []) index)))])])

 (defdom math-ui [x]
   (cond
@@ -507,10 +515,11 @@
              "number" (fn [x path]
                         (dom
                          (if (input? path)
-                           [:input {:type "text" :defaultValue (:desc notebook)
+                           [:input {:type "text" :defaultValue x
                                     :onKeyPress (fn [e]
                                                   (when (= 13 (.-charCode e))
-                                                    (update-index! (:step-var path) [] assoc (:sub-path path) (.-target.value e))
+                                                    (assoc-index! (:step-var path) (:sub-path path) (reader/read-string (.-target.value e)))
+                                                    (remove-input! path)
                                                     ))}]
                            [:span {:className "value"
                                    :onClick (fn []
@@ -520,15 +529,28 @@
              "keyword" (fn [x]
                         (dom [:span {:className "value"}
                               (str x)]))
-             "string" (fn [x]
-                        (dom [:span {:className "value"}
-                              (str x)]))
-             "list" (fn [x]
-                      (list-ui x))
-             "table" (fn [x]
+             "string" (fn [x path]
+                        (dom
+                         (if (input? path)
+                           [:input {:type "text" :defaultValue x
+                                    :onKeyPress (fn [e]
+                                                  (when (= 13 (.-charCode e))
+                                                    (assoc-index! (:step-var path) (:sub-path path) (.-target.value e))
+                                                    (remove-input! path)
+                                                    ))}]
+                           [:span {:className "value"
+                                   :onClick (fn []
+                                              (add-input! path true)
+                                              )}
+                            (str x)])
+                          ))
+             "list" (fn [x path]
+                      (list-ui x path))
+             "table" (fn [x path]
                        (table-ui
                         (-> x keys)
-                        (-> x vals)))}))
+                        (-> x vals)
+                        path))}))

 ;;*********************************************************
 ;; Aurora state
@@ -605,15 +627,36 @@
   (swap! aurora-state update-in [:cache :inputs] dissoc id))

 (defn update-index! [thing path & args]
-  (apply swap! aurora-state update-in
-         (concat [:index (if (map? thing)
-                           (:id thing)
-                           thing)]
-                 path)
-         args))
+  (if-not thing
+    (throw (js/Error. "Trying to update index with nil"))
+    (apply swap! aurora-state update-in
+           (concat [:index (if (map? thing)
+                             (:id thing)
+                             thing)]
+                   path)
+           args)))

 (defn add-index! [thing]
   (swap! aurora-state assoc-in [:index (:id thing)] thing))
+
+(defn assoc-index-key! [thing path old-key neue-key]
+  (let [final-path (concat [:index (->id thing)] path)
+        cur (get-in @aurora-state (concat [:index (->id thing)] path))
+        cur-value (get cur old-key)]
+    (swap! aurora-state assoc-in final-path (-> cur
+                                                (dissoc old-key)
+                                                (assoc neue-key cur-value)))))
+
+(defn assoc-index! [thing path v]
+  (let [rev-path (reverse path)]
+    (if (= ::key (second rev-path))
+      (assoc-index-key! thing
+                        (->> rev-path
+                             (drop 2)
+                             (reverse))
+                        (first rev-path)
+                        v)
+      (swap! aurora-state assoc-in (concat [:index (->id thing)] path) v))))

 (defn remove-index! [thing]
   (swap! aurora-state update-in [:index] dissoc (:id thing)))


don't start scheduler in local env

don't start scheduler in local env

--- src/shuppet/scheduler.clj
+++ src/shuppet/scheduler.clj
@@ -52,7 +52,7 @@

 (defn start
   []
-  (when-not (contains? environments "local") ;dont want the auto scheduler for our test envs
+  (when-not (= (env :environment-name) "local") ;dont want the auto scheduler for our test envs
     (doseq [environment environments]
       (at-at/after (* (or (env (keyword (str "service-scheduler-delay-" environment))) 10) 60 1000)
                    #(schedule environment)


Add landscape and topology definitions to the count-words example

They're just being validated right now, no code works on them yet.

--- clstreams/src/clstreams/examples/count_words/pipelines.clj
+++ clstreams/src/clstreams/examples/count_words/pipelines.clj
@@ -2,7 +2,10 @@
   (:require [clojure.string :as str]
             [clstreams.kafka.component :refer [new-topology]]
             [clstreams.kstreams :as ks]
-            [clstreams.kstreams.helpers :refer [default-topology-config]])
+            [clstreams.kstreams.helpers :refer [default-topology-config]]
+            [clstreams.processor :as prc]
+            [clstreams.landscape :as lsc]
+            [clojure.spec.alpha :as s])
   (:import org.apache.kafka.common.serialization.Serdes
            [org.apache.kafka.streams KeyValue StreamsConfig]
            org.apache.kafka.streams.kstream.KStreamBuilder))
@@ -23,3 +26,51 @@

 (defn count-words []
   (new-topology count-words-props (build-count-words)))
+
+
+(s/check-asserts true)
+
+(def count-words-landscape
+  {::lsc/streams
+   {::text-input {::lsc/topic-name "file-input"
+                  ::lsc/type ::lsc/stream
+                  ::lsc/values {::lsc/serde (Serdes/String)}}
+    ::word-counts {::lsc/topic-name "wordcount-output"
+                   ::lsc/type ::lsc/table
+                   ::lsc/keys {::lsc/serde (Serdes/String)}
+                   ::lsc/values {::lsc/serde (Serdes/Long)}}}})
+
+(s/assert ::lsc/landscape count-words-landscape)
+
+;; (def count-words-processor
+;;   [{::st/op ::st/from
+;;     ::st/topic :file-input}
+;;    {::st/op ::st/flat-map-values
+;;     ::st/fn #(-> % str/lower-case (str/split #" +"))}
+;;    {::st/op ::st/map
+;;     ::st/fn #(KeyValue. %2 %2)}
+;;    {::st/op ::st/group-by-key}
+;;    {::st/op ::st/count
+;;     ::st/store "Counts"}
+;;    {::st/op ::st/to
+;;     ::st/topic :word-counts}])
+
+(def count-words-topology
+  {:op01 {::prc/op ::prc/from
+          ::prc/topic :file-input}
+   :op02 {::prc/op ::prc/flat-map-values
+          ::prc/src :op01
+          ::prc/fn #(-> % str/lower-case (str/split #" +"))}
+   :op03 {::prc/op ::prc/map
+          ::prc/src :op02
+          ::prc/fn #(KeyValue. %2 %2)}
+   :op04 {::prc/op ::prc/group-by-key
+          ::prc/src :op03}
+   :op05 {::prc/op ::prc/count
+          ::prc/src :op04
+          ::prc/store "Counts"}
+   :op06 {::prc/op ::prc/to
+          ::prc/src :op05
+          ::prc/topic :word-counts}})
+
+(s/assert ::prc/topology count-words-topology)


minor change

minor change

--- dada-core/src/test/clojure/org/dada/core/test_clojure.clj
+++ dada-core/src/test/clojure/org/dada/core/test_clojure.clj
@@ -79,10 +79,10 @@

 ;; (deftest assoc-vs-conj
 ;;   (is (let [n 1000000 i (range n)]
-;;         (faster
-;;          1
-;;          (reduce (fn [r i] (assoc r i i)) {} i)
-;;          (reduce (fn [r i] (conj r [i i])) {} i)))))
+;; 	(faster
+;; 	 1
+;; 	 (reduce (fn [r i] (conj r [i i])) {} i)
+;; 	 (reduce (fn [r i] (assoc r i i)) {} i)))))

 ;; There does not seem to be much difference between record attribute
 ;; access via dot notation and array access via index. Perhaps rows
@@ -212,9 +212,10 @@

 (deftest records
   ;; is it better to modify a record multiple times or to reconstruct it from scratch ?
+  ;; it looks like it can be faster to recreate it (but uses more memory?)
   (let [^Rec rec (Rec. 1 2 3)]
     (is (faster
          1000000
          (Rec. (.c rec) (.b rec) (.a rec))
-         (assoc (assoc rec :a (.c rec)) :c (.a rec))
+         (assoc rec :a (.c rec) :c (.a rec))
          ))))


few notes

few notes

--- src/block_chain/miner.clj
+++ src/block_chain/miner.clj
@@ -27,11 +27,16 @@

 (defn latest-block-hash
   "Look up the hash of the latest block in the chain.
-   Useful for getting parent hash for new blocks."
+   Useful for getting parent hash for new blocks. Eventually
+   this will need to grab the latest one off the chain but for now
+   we'll just zero it out."
   []
   (hex-string 0))

 (defn next-target
+  "Calculate the appropriate next target based on the time frequency
+   of recent blocks. Currently just setting a static (easy) target
+   until we have more blocks in place to pull frequency data from."
   []
   (hex-string (math/expt 2 238)))


Make some public encryption function as public.

Should fix #12 issue.

--- src/buddy/core/crypto.clj
+++ src/buddy/core/crypto.clj
@@ -291,7 +291,12 @@
 (def ^:private keylength? #(= (count %1) %2))
 (def ^:private ivlength? #(= (count %1) %2))

-(defn- encrypt-cbc
+(defn encrypt-cbc
+  "Encrypt arbitrary length input using the provided
+  engine, key and iv using cbc encryption mode and
+  the pkcs7 padding acording to the aead-aes-cbc-hmac
+  encryption scheme."
+  {:internal true :no-doc true}
   [cipher input key iv]
   (let [blocksize (get-block-size cipher)
         blocks (split-by-blocksize input blocksize true)
@@ -311,7 +316,12 @@
                    (padding/pad! block remaining :pkcs7)
                    (conj processed (process-block! cipher block)))))))))

-(defn- decrypt-cbc
+(defn decrypt-cbc
+  "Dencrypt arbitrary length input using the provided
+  engine, key and iv using cbc encryption mode and
+  the pkcs7 padding acording to the aead-aes-cbc-hmac
+  encryption scheme."
+  {:internal true :no-doc true}
   [cipher input key iv]
   (let [blocksize (get-block-size cipher)
         blocks (split-by-blocksize input blocksize false)]
@@ -327,7 +337,12 @@
                  (let [result (padding/unpad block :pkcs7)]
                    (conj processed result))))))))

-(defn- encrypt-gcm
+(defn encrypt-gcm
+  "Encrypt arbitrary length input using the provided
+  engine, key and iv using cbc encryption mode and
+  the pkcs7 padding acording to the aead-aes-gcm
+  encryption scheme."
+  {:internal true :no-doc true}
   [cipher input key iv aad]
   (initialize! cipher {:iv iv :key key :tagsize 128 :op :encrypt :aad aad})
   (let [outputlength (get-output-size cipher (count input))
@@ -341,7 +356,12 @@
           (throw (ex-info message {:type :encryption :cause :authtag})))))
     output))

-(defn- decrypt-gcm
+(defn decrypt-gcm
+  "Dencrypt arbitrary length input using the provided
+  engine, key and iv using cbc encryption mode and
+  the pkcs7 padding acording to the aead-aes-gcm
+  encryption scheme."
+  {:internal true :no-doc true}
   [cipher ciphertext key iv aad]
   (initialize! cipher {:iv iv :key key :tagsize 128 :op :decrypt :aad aad})
   (let [input (bytes/copy ciphertext)


Added functions for manaing the server in the REPL.

--- dev-resources/src/clojang/blog/dev.clj
+++ dev-resources/src/clojang/blog/dev.clj
@@ -5,6 +5,9 @@
   Clojang blog application."
   (:require [clojang.blog.cli :as cli]
             [clojang.blog.main :as main]
+            [clojang.blog.routes :as routes]
+            [clojang.blog.web.content.data :as page-data]
+            [clojang.blog.web.content.page :as page]
             [clojure.edn :as edn]
             [clojure.java.io :as io]
             [clojure.pprint :refer [pprint print-table]]
@@ -15,6 +18,7 @@
             [clojusc.twig :as logger]
             [dragon.blog :as blog]
             [dragon.blog.post :as blog-post]
+            [dragon.config :as config]
             [dragon.content.rfc5322 :as rfc5322]
             [dragon.generator :as generator]
             [dragon.util :as util]
@@ -26,9 +30,35 @@
             [trifl.fs :as fs]
             [trifl.java :as java]))

-(logger/set-level! ['clojang.blog] :debug)
+(logger/set-level! '[clojang dragon] :trace)
+
+(defonce server (atom nil))

 (def show-methods #'java/show-methods)
+
+(defn gen
+  []
+  (-> (config/posts-path)
+      (routes/routes)
+      (generator/run)))
+
+(defn run
+  []
+  (-> (config/posts-path)
+      (routes/routes)
+      (web/run (config/port))))
+
+(defn start
+  []
+  (reset! server (run))
+  :started)
+
+(defn stop
+  []
+  (when-not (nil? @server)
+    (@server :timeout 100)
+    (reset! server nil)
+    :stopped))

 ;;; Aliases


refactor get-games logic to be consistent with other game query endpoints

--- src/wombats/daos/game.clj
+++ src/wombats/daos/game.clj
@@ -30,10 +30,16 @@
 ;; ↓   ↑
 ;; 2 → ↑

-(defn get-all-games
-  [conn]
-  (fn []
-    (get-entities-by-prop conn :game/id)))
+(defn get-games-by-eids
+  [conn]
+  (fn [game-eids]
+    (d/pull-many
+     (d/db conn) '[*
+                   {:game/arena [:db/id *]}
+                   {:game/players [:db/id :player/color
+                                   {:player/user [:db/id :user/github-username]}
+                                   {:player/wombat [:db/id :wombat/name]}]}]
+     game-eids)))

 (defn get-game-eids-by-status
   [conn]
@@ -66,16 +72,20 @@
                                 user-ids))]
       game-eids)))

-(defn get-games-by-eids
-  [conn]
-  (fn [game-eids]
-    (d/pull-many
-     (d/db conn) '[*
-                   {:game/arena [:db/id *]}
-                   {:game/players [:db/id :player/color
-                                   {:player/user [:db/id :user/github-username]}
-                                   {:player/wombat [:db/id :wombat/name]}]}]
-     game-eids)))
+(defn get-all-game-eids
+  [conn]
+  (fn []
+    (apply concat
+           (d/q '[:find ?games
+                  :in $
+                  :where [?games :game/id]]
+                (d/db conn)))))
+
+(defn get-all-games
+  [conn]
+  (fn []
+    ((get-games-by-eids conn)
+     ((get-all-game-eids conn)))))

 (defn get-game-by-id
   [conn]


Adjusted the power-limit function to be more Clojure idiomatic

--- src/life/matrix.clj
+++ src/life/matrix.clj
@@ -72,9 +72,8 @@
    until the result from the function is the same as the argument that led to it.
    e.g. (power-limit #(min (inc %) 10) 1) => 10"
   [f a]
-  (loop [a a]
-    (let [r (f a)]
-      (if (= r a)
-        r
-        (recur r)))))
+  (let [s (iterate f a)]
+    (ffirst
+      (drop-while (fn [[x y]] (not= x y))
+                  (map vector s (rest s))))))


Add additional type hints to remove reflection warnings for faster startup times

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -13,6 +13,7 @@
               Font
               FontMetrics
               Graphics
+              Graphics2D
               RenderingHints)
     (org.lwjgl BufferUtils LWJGLUtil)
     (java.nio FloatBuffer ByteBuffer)
@@ -92,7 +93,7 @@
     (log/info "key" key)
     (on-key-fn key)))

-(defn font-key [font] [(.getName font) (.getSize font)])
+(defn font-key [^Font font] [(.getName font) (.getSize font)])

 (defn make-font
   [name-or-path style size]
@@ -120,7 +121,7 @@

 ;; A sequence of [character underline?]
-(defn displayable-characters [font]
+(defn displayable-characters [^Font font]
   (let [chars (map char (filter (fn [c] (and (.canDisplay font (char c))
                                              (not (contains? cjk-blocks c))))
                                 (range 0x0000 0xFFFF)))]
@@ -169,7 +170,7 @@
     ;(log/info "characters" (vec characters))
     ;(log/info "character-idxs" (vec (character-idxs characters)))
     (let [texture-image    (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
-          texture-graphics ^Graphics (.getGraphics texture-image)
+          texture-graphics ^Graphics2D (.getGraphics texture-image)
           white            (Color. 255 255 255 255)]
       ;; Create and clear graphics
       (doto texture-graphics
@@ -209,15 +210,16 @@
        :font-texture-image texture-image})))

-(defn- buffered-image-byte-buffer [buffered-image]
+(defn- buffered-image-byte-buffer [^BufferedImage buffered-image]
   (let [width          (.getWidth buffered-image)
         height         (.getHeight buffered-image)
         texture-buffer (BufferUtils/createByteBuffer (* width height 4))
-        data (-> buffered-image
+        data ^bytes (-> buffered-image
                  (.getRaster)
                  (.getDataBuffer)
-                 (as-> db (cast DataBufferByte db))
-                 (.getData))]
+                 (as-> db
+                   (let [dbb ^DataBufferByte db]
+                     (.getData dbb))))]
     (.put texture-buffer data 0 (alength data))
     (.flip texture-buffer)
     texture-buffer))
@@ -267,7 +269,7 @@
       (throw (Exception. error-string)))))

 (defn- texture-id
-  ([buffered-image]
+  ([^BufferedImage buffered-image]
   (let [width (.getWidth buffered-image)
         height (.getHeight buffered-image)]
     (texture-id width height (buffered-image-byte-buffer buffered-image))))
@@ -295,18 +297,20 @@
     texture-id))

-(defn- fbo-texture [width height]
+(defn- fbo-texture [^long width ^long height]
   (let [id (GL30/glGenFramebuffers)]
     (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER id)
     (let [texture-id (GL11/glGenTextures)
-          draw-buffer (BufferUtils/createIntBuffer 1)]
+          draw-buffer (BufferUtils/createIntBuffer 1)
+          ;; type nil as ByteBuffer to avoid reflection on glTexImage2D
+          ^ByteBuffer bbnil nil]
       (.put draw-buffer GL30/GL_COLOR_ATTACHMENT0)
       (.flip draw-buffer)
       ;;(.order texture-buffer (ByteOrder/nativeOrder))
       (GL11/glBindTexture GL11/GL_TEXTURE_2D texture-id)
       (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MIN_FILTER GL11/GL_LINEAR)
       (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MAG_FILTER GL11/GL_LINEAR)
-      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB width height 0 GL11/GL_RGB GL11/GL_UNSIGNED_BYTE nil)
+      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB width height 0 GL11/GL_RGB GL11/GL_UNSIGNED_BYTE bbnil)
       (GL32/glFramebufferTexture GL30/GL_FRAMEBUFFER GL30/GL_COLOR_ATTACHMENT0 texture-id 0)
       (GL20/glDrawBuffers draw-buffer)
       (GL11/glBindTexture GL11/GL_TEXTURE_2D 0)
@@ -351,15 +355,19 @@
                              (.withProfileCore true))
         icon-array         (when icon-paths
                              (condp = (LWJGLUtil/getPlatform)
-                               LWJGLUtil/PLATFORM_LINUX (let [icon-array (make-array ByteBuffer 1)]
-                                                          (aset icon-array 0 (png-bytes (get icon-paths 1)))
+                               LWJGLUtil/PLATFORM_LINUX (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 1)
+                                                              data ^bytes (png-bytes (get icon-paths 1))]
+                                                          (aset icon-array 0 data)
                                                           icon-array)
-                               LWJGLUtil/PLATFORM_MACOSX  (let [icon-array (make-array ByteBuffer 1)]
-                                                            (aset icon-array 0 (png-bytes (get icon-paths 2))
-                                                            icon-array))
-                               LWJGLUtil/PLATFORM_WINDOWS (let [icon-array (make-array ByteBuffer 2)]
-                                                            (aset icon-array 0 (png-bytes (get icon-paths 0)))
-                                                            (aset icon-array 1 (png-bytes (get icon-paths 1)))
+                               LWJGLUtil/PLATFORM_MACOSX  (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 1)
+                                                                data ^bytes (png-bytes (get icon-paths 2))]
+                                                            (aset icon-array 0 data)
+                                                            icon-array)
+                               LWJGLUtil/PLATFORM_WINDOWS (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 2)
+                                                                data0 ^bytes (png-bytes (get icon-paths 0))
+                                                                data1 ^bytes (png-bytes (get icon-paths 1))]
+                                                            (aset icon-array 0 data0)
+                                                            (aset icon-array 1 data1)
                                                             icon-array)))
         latch              (java.util.concurrent.CountDownLatch. 1)]
      ;; init-natives must be called before the Display is created


Removing Source from JSON Schema validation error message.

--- common-lib/src/cmr/common/validations/json_schema.clj
+++ common-lib/src/cmr/common/validations/json_schema.clj
@@ -41,6 +41,8 @@
       (conj (parse-nested-error-report (:reports json-error-report))
             (parse-error-report json-error-report)))))

+
+
 (defn- json-string->JsonNode
   "Takes JSON as a string or as EDN and returns a com.fasterxml.jackson.databind.JsonNode. Throws
   an exception if the provided JSON is not valid JSON."
@@ -48,8 +50,9 @@
   (try
     (JsonLoader/fromString json-string)
     (catch JsonParseException e
-      (warn "Invalid JSON when trying to validate" json-string e)
-      (errors/throw-service-error :bad-request (str "Invalid JSON: " (.getMessage e))))))
+      ;; Removes the source from the message which is just going to say StringReader@XXXXX
+      (let [message (str/replace (.getMessage e) #"\[Source[^;]+;" "")]
+        (errors/throw-service-error :bad-request (str "Invalid JSON: " message))))))

 (defn parse-json-schema
   "Convert a JSON string into a com.github.fge.jsonschema.main.JsonSchema object."


Add the response schema to the ResponseObject

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -10,11 +10,10 @@
             [medley.core :as medley]
             [io.aviso.toolchest.macros :refer [cond-let]]
             [io.aviso.toolchest.collections :refer [pretty-print]]
-            [io.aviso.tracker :as t]
-            [clojure.tools.logging :as l]
-            [io.aviso.rook.utils :as utils])
+            [io.aviso.tracker :as t])
   (:import [schema.core EnumSchema Maybe]
-           [io.aviso.rook.schema IsInstance]))
+           [io.aviso.rook.schema IsInstance]
+           [clojure.lang APersistentVector]))

 (defn- remove-nil-vals
   [m]
@@ -140,10 +139,12 @@

 (defn to-schema-reference
   "Converts a schema to a schema reference; the schema must be named.  Returns a tuple
-  of the possibly updated swagger object and a string reference to the schema within the swagger object
-  (as a path string)."
+  of the possibly updated swagger object and a Swagger schema definition (or a \"$ref\" map)."
   [swagger-options swagger-object schema]
   (cond-let
+    (or (nil? schema) (= s/Any schema))
+    [swagger-object nil]
+
     (instance? APersistentVector schema)
     (let [[object' item-reference] (to-schema-reference swagger-options swagger-object (first schema))]
       [object' {:type  :array
@@ -199,8 +200,12 @@
                     (let [schema-meta (meta schema)
                           description (or (:description schema-meta)
                                           (:doc schema-meta)
-                                          "Documentation not provided.")]
-                      (assoc-in so (concat paths-key [:responses (str status-code)]) {:description description}))))]
+                                          ;; description is required in the Response Object, so we need some default here.
+                                          "Documentation not provided.")
+                          [so' schema-reference] (to-schema-reference swagger-options so schema)
+                          response (assoc schema-reference
+                                     :description description)]
+                      (assoc-in so' (concat paths-key [:responses status-code]) response))))]
     (reduce reducer swagger-object responses)))

 (defn default-path-item-object-injector


Remove println.

Remove println.

--- src/lein_xjc/internal/xjc.clj
+++ src/lein_xjc/internal/xjc.clj
@@ -15,5 +15,4 @@
 (defn call-xjc
   [project-root target-dir xjc-calls]
   (doseq [argv (mk-xjc-argvs project-root target-dir xjc-calls)]
-    (println argv)
     (xjc-main argv)))


Add clj extension

Add clj extension

--- src/leiningen/new/cljskel.clj
+++ src/leiningen/new/cljskel.clj
@@ -20,7 +20,7 @@
              ["src/{{sanitized}}/web.clj" (render "web.clj" data)]

              ["test/{{sanitized}}/unit.clj" (render "unit.clj" data)]
-             ["test/{{sanitized}}/acceptance.clj" (render "acceptance" data)]
+             ["test/{{sanitized}}/acceptance.clj" (render "acceptance.clj" data)]

              ["configuration/ComponentManifest.xml" (render "ComponentManifest.xml" data)]
              ["configuration/configuration.xml" (render "configuration.xml" data)]


Fixed exception occurring for dev server when :init or :destroy not set

--- src/leiningen/ring/server.clj
+++ src/leiningen/ring/server.clj
@@ -2,23 +2,27 @@
   (:use [leiningen.compile :only (eval-in-project)]))

 (defn- sym-and-ns [project key]
-  (let [sym (get-in project [:ring key])]
+  (if-let [sym (get-in project [:ring key])]
     [sym (symbol (namespace sym))]))
+
+(defn- require-sym [sym]
+  (if sym
+    (list `(require '~sym))))

 (defn server-task
   "Shared logic for server and server-headless tasks."
   [project port launch-browser]
   (let [reload-dirs [(:source-path project)]
         [handler-sym handler-ns] (sym-and-ns project :handler)
-        [init-sym init-ns] (sym-and-ns project :init)
+        [init-sym init-ns]       (sym-and-ns project :init)
         [destroy-sym destroy-ns] (sym-and-ns project :destroy)]
        (eval-in-project project
          `(do (require 'leiningen.ring.run-server
                        'ring.middleware.stacktrace
                        'ring.middleware.reload-modified
-                       '~handler-ns
-                       '~init-ns
-                       '~destroy-ns)
+                       '~handler-ns)
+              ~@(require-sym init-ns)
+              ~@(require-sym destroy-ns)
               (leiningen.ring.run-server/run-server
                 (-> (var ~handler-sym)
                     (ring.middleware.stacktrace/wrap-stacktrace)


test fix

test fix

--- test/clojure2d/core_test.clj
+++ test/clojure2d/core_test.clj
@@ -2,7 +2,8 @@
   (:require [clojure.test :refer :all]
             [fastmath.vector :as v]
             [clojure2d.core :refer :all]
-            [clojure2d.color :as c]))
+            [clojure2d.color :as c]
+            [clojure2d.pixels :as p]))

 ;; global variables
 (def ^:const window-name "Testing clojure.core")
@@ -86,8 +87,8 @@
   (is (= 100 (width (get-image @window)))))

 (deftest get-pixel-test
-  (is (= (c/to-color :maroon) (get-pixel canvas2 50 50)))
-  (is (= (c/to-color :black) (get-pixel canvas2 0 0))))
+  (is (= (c/to-color :maroon) (p/get-color canvas2 50 50)))
+  (is (= (c/to-color :black) (p/get-color canvas2 0 0))))

 ;; rendering hints available
 (deftest rendering-hints-test


Allow for the possibility of more than one test

--- test/demo/messaging_test.clj
+++ test/demo/messaging_test.clj
@@ -2,14 +2,14 @@
   (:use clojure.test
         immutant.messaging))

-(if (immutant.util/in-immutant?)
+(when (immutant.util/in-immutant?)
   (deftest ^:integration listening
     (start "test.topic")
     (let [expected (promise)
           handler (listen "test.topic" #(deliver expected %))]
       (try
         (publish "test.topic" :success)
-        (is (= :success (deref expected 500 :fail)))
+        (is (= :success (deref expected 1000 :fail)))
         (finally
           @(unlisten handler)
           (stop "test.topic"))))))


slow tests

slow tests


RDC - Add some translation tests using some neat destructuring.

--- test/icfp2015/board_test.clj
+++ test/icfp2015/board_test.clj
@@ -7,12 +7,34 @@
     (is (= 1 1))))

 (deftest translation-test
-  (testing "move west"
+  (let [{:keys [west east southwest southeast]} translations]
+  (testing "translate west"
     (let [unit { :members #{ [0 0] [1 1] } :pivot [0 1] }
-          f    (translate -1 0)
+          f    (apply translate west)
           actual-unit (f unit)
           expected-unit { :members #{ [-1 0] [0 1] } :pivot [-1 1] }]
-      (is (= expected-unit actual-unit)))))
+      (is (= expected-unit actual-unit))))
+
+  (testing "translate east"
+    (let [unit { :members #{ [0 0] [1 1] } :pivot [0 1] }
+          f    (translate 1 0)
+          actual-unit (f unit)
+          expected-unit { :members #{ [1 0] [2 1] } :pivot [1 1] }]
+      (is (= expected-unit actual-unit))))
+
+  (testing "translate southwest"
+    (let [unit { :members #{ [0 0] [1 1] } :pivot [0 1] }
+          f    (translate 0 1)
+          actual-unit (f unit)
+          expected-unit { :members #{ [0 1] [1 2] } :pivot [0 2] }]
+      (is (= expected-unit actual-unit))))
+
+  (testing "translate southeast"
+    (let [unit { :members #{ [0 0] [1 1] } :pivot [0 1] }
+          f    (translate 1 1)
+          actual-unit (f unit)
+          expected-unit { :members #{ [1 1] [2 2] } :pivot [1 2] }]
+      (is (= expected-unit actual-unit))))))

 (deftest collistion-test
   (testing "does not have collision"


bump test delay so that it passes due to promise completing before pred

--- test/promesa/core_tests.cljc
+++ test/promesa/core_tests.cljc
@@ -77,7 +77,7 @@
                       (done)))))
      :clj
      (let [p1 (p/promise (fn [resolve reject]
-                           (p/schedule 50 #(resolve 1))))]
+                           (p/schedule 500 #(resolve 1))))]
        (t/is (p/pending? p1))
        (t/is (= @p1 1)))))