- clean up code by binding director - use gen-actor more

--- src/app/cljs/one/sample/animation.cljs
+++ src/app/cljs/one/sample/animation.cljs
@@ -80,6 +80,16 @@

    (gen-move-behavior :from [0 0] :to [50 50] :time 120)
    (gen-move-behavior :from [50 50] :to [0 0] :time [120 120])"
+  ;; TODO: Currently, :to & :from are relative to (0,0) with respect
+  ;; to the container that target is in. This is counterintuitive and
+  ;; should be relative to the targets current position. Also I
+  ;; propose the following API change:
+  ;;
+  ;; (gen-move-behavior target :to [10 10]) ;; movement to absolute position within parent container
+  ;; (gen-move-behavior target :up 5 :left 3) ;; relative (to current position) movement
+  ;; (gen-move-behavior target :from [0 0] :up 5) ;; initial absolute position & relative movement upwards
+  ;; (gen-move-behavior target :to [[10 10] [10 20]]) ;; multiple absolute positions
+  ;; (gen-move-behavior target :to [[:quadric 10 10 5 5]] ;; support for non-linear paths
   [& {:keys [from to time auto-rotate?]
       :or {time 120 auto-rotate? false}}]
   (let [nr (fn [n] (or n 0))
@@ -154,7 +164,9 @@
 explicitly specified using a wait-spec)."
   ([target & specs]
      (let [container (doto (CAAT/ContainerBehavior.)
-                       (.setFrameTime (.time target) Number.MAX_VALUE))]
+                       (.setFrameTime (.time target) Number.MAX_VALUE))
+           ;; store the current director, so it can be bound inside callbacks
+           director *director*]
        (loop [[spec & more] specs
               t 0
               last-caat-behavior nil]
@@ -169,7 +181,8 @@
                       (let [callback-fn spec]
                         (fn [bh t a]
                           ;; (log/info logger (pr-str "Calling expiration fn" spec))
-                          (callback-fn t)))})))
+                          (binding [*director* director]
+                           (callback-fn t))))})))
                  (recur more t last-caat-behavior))
              (let [bh (gen-behavior spec)
                    dur (. bh (getDuration))
@@ -181,13 +194,32 @@
                       last-caat-behavior)))))
        container)))

+(defn gen-animation
+  [target & animations]
+  {:pre [(actor? target)]}
+  (apply animation-specs->behavior target animations))
+
 (defn animate
   "Animate a target. Besides the target, takes any number of behavior specs.
    For supported specs, take a look at the KW->BEHAVIOR-FN map.
   Example:
     (animate target [:move [:to {:up md :left 5} :time 200]])"
+  ;; TODO: Currently it is not possible to issue behaviors which are
+  ;; relative to their previous behavior, without doing the necessary
+  ;; calculations beforehand. This is because all Behaviors are being
+  ;; created at the same time and there is no access to values which
+  ;; would have been changed during behavior execution. I propose the
+  ;; following change to fix that:
+  ;;
+  ;; 1. animate -> animate!
+  ;;
+  ;; 2. instead of creating all behaviors directly, only create the
+  ;;    first behavior from the list of behavior specs. Then, upon
+  ;;    finishing of that behavior, create the next behavior in the
+  ;;    list and add it to the target.
+  ;; 3. Make sure to provide means to stop an animation.
   [target & animations]
-  (.addBehavior target (apply animation-specs->behavior target animations)))
+  (.addBehavior target (apply gen-animation target animations)))

 (defn basket-head-munch! [basket-head & {:keys [on-finish] :or {on-finish (fn [])}}]
   (let [md 10]
@@ -223,25 +255,27 @@
            [:rotate [:to -5 :time 80]]
            [:rotate [:from -5 :time 80]]))

+(defn ->director [v]
+  (cond (nil? v) (or *director* (throw "No director bound."))
+        (instance? CAAT.Director v) v))
+
+(def *director* nil)
+
 (defn gen-basket
   "Generate & return the interactive basket.
    The basket will have doOpen & doClose methods to open & close
   it. Also it will open & close when hovered."
-  [director & {:keys [x y] :or {x 490 y 320}}]
-  (let [scale-factor 1.02
-        basket-sprite (.initialize (CAAT/SpriteImage.) (.getImage director "basket") 1 2)
-        basket-head (.initialize (CAAT/SpriteImage.) (.getImage director "basket-head") 1 1)
+  [scene & {:keys [x y] :or {x 490 y 320}}]
+  (let [director (director-of scene)
+        scale-factor 1.02
+        basket-sprite (->sprite (->image "basket") :cols 2)
+        basket-head (->sprite (->image "basket-head"))
         basket-container (doto (CAAT/ActorContainer.)
                            (.setBackgroundImage basket-sprite)
                            (.setLocation x y)
                            (.setFillStyle "#ff3fff"))
-        basket-body (doto (CAAT/Actor.)
-                      (.setBackgroundImage basket-sprite)
-                      (.setSpriteIndex 1))
-        basket-head (doto (CAAT/Actor.)
-                      (.setBackgroundImage basket-head)
-                      (.setLocation 0 0)
-                      (.enableEvents false))]
+        basket-body (gen-actor scene :image basket-sprite :sprite-index 1)
+        basket-head (gen-actor scene :image basket-head :events? false)]
     (.addChild basket-container basket-body)
     (.addChild basket-container basket-head)
     (set! basket-container.isOpened false)
@@ -533,19 +567,17 @@
         (= (.nodeName img) "CANVAS") true
         (instance? CAAT.SpriteImage img) true))

-(defn ->sprite [img director & {:keys [rows cols] :or {rows 1 cols 1}}]
-  ;; (log/info logger "->sprite")
-  (assert (director? director) "Second arg must be a director instance.")
-  (cond (string? img) (->image img director)
+(defn ->sprite [img & {:keys [rows cols director] :or {rows 1 cols 1}}]
+  ;; (log/info logger "->sprite")
+  (cond (string? img) (->image img :director director)
         (= (.nodeName img) "IMG") (.initialize (CAAT/SpriteImage.) img rows cols)
         (= (.nodeName img) "CANVAS")  (.initialize (CAAT/SpriteImage.) img rows cols)
         (instance? CAAT.SpriteImage img) img))

-(defn ->image [value director & {:keys [thumbnail] :or {thumbnail nil}}]
-  ;; (log/info logger (str "->image " value))
-  (assert (director? director) "first arg must be a director.")
+(defn ->image [value & {:keys [thumbnail director] :or {thumbnail nil}}]
+  ;; (log/info logger (str "->image " value))
   (cond (string? value)
-        (let [image (.getImage director value)
+        (let [image (.getImage (->director director) value)
               _ (assert (not (nil? image)) "Could not find image.")
               image (if (vector? thumbnail)
                       (CAAT.modules.ImageUtil/createThumb image (first thumbnail) (second thumbnail) true)
@@ -604,23 +636,29 @@
      (assert (actor? target))
      (assert (keyword? event-name))
      (assert (fn? handler))
-     (cond (= event-name :mouse-enter)
-           (m/wrap target.mouseEnter [e oldf]
-                   (handler e oldf))
-           (= event-name :mouse-exit)
-           (m/wrap target.mouseExit [e oldf]
-                   (handler e oldf))
-           (= event-name :mouse-drag)
-           (m/wrap target.mouseDrag [e oldf]
-                   (handler e oldf))))
+     (let [;; store director, so the handler fn has access to it
+           director *director*]
+       (cond (= event-name :mouse-enter)
+             (m/wrap target.mouseEnter [e oldf]
+                     (binding [*director* director]
+                       (handler e oldf)))
+             (= event-name :mouse-exit)
+             (m/wrap target.mouseExit [e oldf]
+                     (binding [*director* director]
+                       (handler e oldf)))
+             (= event-name :mouse-drag)
+             (m/wrap target.mouseDrag [e oldf]
+                     (binding [*director* director]
+                       (handler e oldf))))))
   ([target e1 h1 e2 h2 & more]
      (listen target e1 h1)
      (listen target e2 h2)
      (when more
        (apply listen target more))))

-(defn gen-actor [scene & {:keys [image draggable? fill-style position size sprite-index]
-                          :or {draggable? false}}]
+(defn gen-actor
+  [scene & {:keys [image draggable? fill-style position size sprite-index events?]
+            :or {draggable? false}}]
   (assert (scene? scene) "First arg must be a scene.")
   (when (and image fill-style)
    (log/info logger (str "WARNING: both :image & :fill-style set. No image will be visible.")))
@@ -629,7 +667,7 @@
   (let [actor (if fill-style (CAAT/ShapeActor.) (CAAT/Actor.))]
     (when image
       ;; (log/info logger (pr-str "Image" "; tagName=" (.tagName image) "; nodeName=" (.nodeName image) "; image=" image "; ->image" (->image image (director-of scene))))
-      (.setBackgroundImage actor (->image image (director-of scene))))
+      (.setBackgroundImage actor (->image image)))
     (when size
       (.setSize actor (x-of size) (y-of size)))
     (when fill-style
@@ -638,6 +676,8 @@
       (.setLocation (x-of position) (y-of position)))
     (when (not (false? draggable?))
       (.enableDrag actor true))
+    (when events?
+      (.enableEvents actor events?))
     (when sprite-index
       (.setSpriteIndex actor sprite-index))
     actor))
@@ -647,7 +687,7 @@
                :or {image nil animation-indices [0] default-index 0 key-frames nil frame-time 150 draggable? false thumbnail nil}}]
   (assert (scene? scene) "First arg must be a scene instance.")
   (log/info logger (str "Creating actor"))
-  (let [image (->image image (director-of scene) :thumbnail thumbnail)
+  (let [image (->image image :thumbnail thumbnail)
         img (doto (CAAT/SpriteImage.)
               (.initialize image 1 (or key-frames (+ 1 (apply max animation-indices))))
               (.setAnimationImageIndex (clj->js [default-index]))
@@ -786,8 +826,8 @@
         song (.getAudio (. director (getAudioManager)) "song")
         song-supported? (and song (not (not (and song.canPlayType (.replace (.canPlayType song "audio/mpeg;") #"no" "")))))
         song-playing? (atom false)
-        play-icon (let [img (->image "play" director :thumbnail [35 35])
-                        img2 (->image "stop" director :thumbnail [35 35])
+        play-icon (let [img (->image "play" :thumbnail [35 35])
+                        img2 (->image "stop" :thumbnail [35 35])
                         actor (doto (CAAT/Actor.)
                                 (.setBackgroundImage img))
                         audio-loop (atom nil)]
@@ -869,8 +909,8 @@
                     ;; (.setFillStyle "green") ;; set this to see the area where a book can be placed
                     )
         img (-> "books"
-              (->image (director-of scene) :thumbnail [60 60])
-              (->sprite (director-of scene) :cols 3))
+              (->image :thumbnail [60 60])
+              (->sprite :cols 3))
         books (gen-actor scene :image img :sprite-index 0)]
     (set! container.inc-book-count
           (fn []
@@ -908,52 +948,53 @@
                {:id "football" :url "images/football-th.png"}
                ])
      (fn [director]
-       (log/info logger " Images loaded. Creating scene.")
-       (doto director
-         (.addAudio "chime" "sounds/22267__zeuss__the-chime.ogg" ;; "sounds/22267__zeuss__the-chime.mp3"
-                    )
-         (.addAudio "doppp" "sounds/8001__cfork__cf-fx-doppp-01.ogg" ;; "sounds/8001__cfork__cf-fx-doppp-01.wav"
-                    )
-         (.addAudio "flopp" "sounds/8006__cfork__cf-fx-flopp-03-dry.ogg" ;; "sounds/8006__cfork__cf-fx-flopp-03-dry.wav"
-                    )
-         (.addAudio "munching" "sounds/27877__inequation__munching.ogg" ;; "sounds/27877__inequation__munching.wav"
-                    )
-         (.addAudio "song" "sounds/448614_Happiness_Alone.ogg"))
-       (let [scene (. director (createScene))
-             background (doto (CAAT/Actor.)
-                          (.setBackgroundImage (.getImage director "room")))
-             basket (gen-basket director :x 440 :y 240)
-             bookshelf (gen-bookshelf scene)
-             counter (gen-count-actor 6 :on-total-reached (fn [e] (add! scene (gen-winning-screen scene))))
-             basket-objects (map
-                             #(make-draggable-into % basket scene
-                                                   (fn [] (throw-into-basket director scene basket % counter))
-                               :valid-fn (fn [] (and (not (.isOpened basket)) (not (.eating basket)))))
-                             [(gen-animated-actor scene :image "football" :animation-indices [0] :draggable? true :thumbnail [60 60])
-                              (gen-animated-actor scene :image "car" :animation-indices [0] :draggable? true :thumbnail [60 60])
-                              (gen-animated-actor scene :image "blocks" :animation-indices [0] :draggable? true)
-                              (gen-animated-actor scene :image "teddy" :animation-indices [0 1 0 2] :draggable? true)])
-             bookshelf-objects (map
-                                #(make-draggable-into % bookshelf scene
-                                  (fn []
-                                    (.setExpired % true)
-                                    (. bookshelf (inc-book-count))
-                                    (. counter (inc))))
-                                [(gen-animated-actor scene :image "book" :animation-indices [2] :default-index 2 :key-frames 3 :draggable? true)
-                                 (gen-animated-actor scene :image "book" :animation-indices [0] :default-index 0 :key-frames 3 :draggable? true)])
-             objects (concat basket-objects bookshelf-objects)]
-         (log/info logger " Displaying scene")
-         (add! scene background)
-         (add! scene basket)
-         (add! scene counter)
-         (add! scene bookshelf)
+       (binding [*director* director]
+        (log/info logger " Images loaded. Creating scene.")
+        (doto director
+          (.addAudio "chime" "sounds/22267__zeuss__the-chime.ogg" ;; "sounds/22267__zeuss__the-chime.mp3"
+                     )
+          (.addAudio "doppp" "sounds/8001__cfork__cf-fx-doppp-01.ogg" ;; "sounds/8001__cfork__cf-fx-doppp-01.wav"
+                     )
+          (.addAudio "flopp" "sounds/8006__cfork__cf-fx-flopp-03-dry.ogg" ;; "sounds/8006__cfork__cf-fx-flopp-03-dry.wav"
+                     )
+          (.addAudio "munching" "sounds/27877__inequation__munching.ogg" ;; "sounds/27877__inequation__munching.wav"
+                     )
+          (.addAudio "song" "sounds/448614_Happiness_Alone.ogg"))
+        (let [scene (. director (createScene))
+              background (doto (CAAT/Actor.)
+                           (.setBackgroundImage (.getImage director "room")))
+              basket (gen-basket scene :x 440 :y 240)
+              bookshelf (gen-bookshelf scene)
+              counter (gen-count-actor 6 :on-total-reached (fn [e] (add! scene (gen-winning-screen scene))))
+              basket-objects (map
+                              #(make-draggable-into % basket scene
+                                                    (fn [] (throw-into-basket director scene basket % counter))
+                                                    :valid-fn (fn [] (and (not (.isOpened basket)) (not (.eating basket)))))
+                              [(gen-animated-actor scene :image "football" :animation-indices [0] :draggable? true :thumbnail [60 60])
+                               (gen-animated-actor scene :image "car" :animation-indices [0] :draggable? true :thumbnail [60 60])
+                               (gen-animated-actor scene :image "blocks" :animation-indices [0] :draggable? true)
+                               (gen-animated-actor scene :image "teddy" :animation-indices [0 1 0 2] :draggable? true)])
+              bookshelf-objects (map
+                                 #(make-draggable-into % bookshelf scene
+                                                       (fn []
+                                                         (.setExpired % true)
+                                                         (. bookshelf (inc-book-count))
+                                                         (. counter (inc))))
+                                 [(gen-animated-actor scene :image "book" :animation-indices [2] :default-index 2 :key-frames 3 :draggable? true)
+                                  (gen-animated-actor scene :image "book" :animation-indices [0] :default-index 0 :key-frames 3 :draggable? true)])
+              objects (concat basket-objects bookshelf-objects)]
+          (log/info logger " Displaying scene")
+          (add! scene background)
+          (add! scene basket)
+          (add! scene counter)
+          (add! scene bookshelf)

-         (dotimes [index (count objects)]
-           (let [object (nth objects index)]
-             (add!
-              scene
-              object
-              :position [(+ (rand-int 30) (* (/ 600 (count objects)) index) 100)
-                         (+ (rand-int 50) 360)])))
-         ;; (add! scene (gen-winning-screen scene))
-         )))))
+          (dotimes [index (count objects)]
+            (let [object (nth objects index)]
+              (add!
+               scene
+               object
+               :position [(+ (rand-int 30) (* (/ 600 (count objects)) index) 100)
+                          (+ (rand-int 50) 360)])))
+          ;; (add! scene (gen-winning-screen scene))
+          ))))))


measue fps on interval

measue fps on interval

--- spinning/src/app/core.cljs
+++ spinning/src/app/core.cljs
@@ -128,7 +128,7 @@
   (swap! state assoc-in [:app :count-frames?] true)
   (poly/listen-animation-frame! on-env-animation-frame)
   (swap! state assoc-in [:app :measure-fps?] true)
-  (poly/listen-fps! on-env-frames-per-second)
+  (poly/listen-fps-interval! on-env-frames-per-second)
   (poly/take-back! (get-event-channel :env-keyboard-key) on-env-keyboard-key)
   (poly/take-back! (get-event-channel :env-mouse-move) on-env-mouse-move))


Safer promise check

Safer promise check

--- src/com/wsscode/common/async_cljs.cljs
+++ src/com/wsscode/common/async_cljs.cljs
@@ -8,7 +8,7 @@
   (satisfies? async.prot/ReadPort c))

 (defn promise? [x]
-  (fn? (gobj/get x "then")))
+  (and (object? x) (fn? (gobj/get x "then"))))

 (defn promise->chan [p]
   (let [c (async/promise-chan)]


Show eden support only when it is configured

--- src/discuss/components/navigation.cljs
+++ src/discuss/components/navigation.cljs
@@ -6,7 +6,8 @@
             [discuss.translations :refer [translate]]
             [discuss.utils.common :as lib]
             [discuss.utils.views :as vlib]
-            [discuss.communication.auth :as auth]))
+            [discuss.communication.auth :as auth]
+            [discuss.config :as config]))

 (defn- element
   "Create one element for the navigation."
@@ -36,7 +37,8 @@
 (defn- eden-overview
   "Open view to find statements inside of the discussion."
   []
-  (element "fa-puzzle-piece" [:nav :eden] #(lib/save-current-and-change-view! :eden/overview)))
+  (when config/search-host
+    (element "fa-puzzle-piece" [:nav :eden] #(lib/save-current-and-change-view! :eden/overview))))

 (defn- login
   "Login switch."


Revert "Cheat elevio support form validation"

This reverts commit 90691a02d5f27803c69d088aa733981aff61d0a0.

--- src-cljs/frontend/elevio.cljs
+++ src-cljs/frontend/elevio.cljs
@@ -16,10 +16,6 @@
 (defn enable! []
   (class-list/add js/document.body "circle-elevio")
   (aset js/window "_elev" (or (aget js/window "_elev") #js {}))
-  ;; Make sure there are non-whitespace characters in the last_name field to get around Elevio form validation
-  (let [last-name (aget js/elevSettings "last_name")]
-    (when-not (re-find #"\S+" last-name)
-      (aset js/elevSettings "last_name" "<nolastname>")))
   (let [set-elev! (partial aset (aget js/window "_elev"))]
     (set-elev! "account_id" account-id)
     (set-elev! "user" (aget js/window "elevSettings"))


Add unit-terrain-stats function

Add unit-terrain-stats function

--- src/cljs/zetawar/game.cljs
+++ src/cljs/zetawar/game.cljs
@@ -291,6 +291,19 @@

 (defn unit-ex [message unit]
   (ex-info message (select-keys unit [:unit/q :unit/r])))
+
+(defn unit-terrain-stats [db unit terrain]
+  (only (d/q '[:find ?mc ?at ?ar
+               :in $ ?u ?t
+               :where
+               [?u  :unit/type ?ut]
+               [?t  :terrain/type ?tt]
+               [?tt :terrain-type/effects ?e]
+               [?e  :terrain-effect/unit-type ?ut]
+               [?e  :terrain-effect/attack-bonus ?at]
+               [?e  :terrain-effect/armor-bonus ?ar]
+               [?e  :terrain-effect/movement-cost ?mc]]
+             db (e unit) (e terrain))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Unit States


Deleting liberator stuff

Deleting liberator stuff

--- src/banking/service/liberator/core.clj
+++ src/banking/service/liberator/core.clj
@@ -1 +0,0 @@
-(ns banking.service.liberator.core)


refer to result as 'result' not 'tag'

refer to result as 'result' not 'tag'

--- src/chat/client/views/new_message.cljs
+++ src/chat/client/views/new_message.cljs
@@ -104,8 +104,8 @@
                                      autocomplete-open?
                                      (do
                                        (.preventDefault e)
-                                       (when-let [tag (nth results highlighted-result-index nil)]
-                                         ((tag :action) (config :thread-id))
+                                       (when-let [result (nth results highlighted-result-index nil)]
+                                         ((result :action) (config :thread-id))
                                          (close-autocomplete!)))
                                      ; ENTER otherwise -> send message
                                      (not e.shiftKey)
@@ -133,14 +133,14 @@
                 (if (seq results)
                   (apply dom/div nil
                     (map-indexed
-                      (fn [i tag]
+                      (fn [i result]
                         (dom/div #js {:className (str "result" " "
                                                       (when (= i highlighted-result-index) "highlight"))
                                       :style #js {:cursor "pointer"}
                                       :onClick (fn []
-                                                 ((tag :action) (config :thread-id))
+                                                 ((result :action) (config :thread-id))
                                                  (close-autocomplete!))}
-                          (tag :html)))
+                          (result :html)))
                       results))
                   (dom/div #js {:className "result"}
                     "No Results")))))))))


Use vars so the fns reload

Use vars so the fns reload

--- src/circle/backend/build/inference.clj
+++ src/circle/backend/build/inference.clj
@@ -6,8 +6,8 @@
   (:require circle.backend.build.inference.rails
             circle.backend.build.inference.php))

-(def inference-fns {:rails circle.backend.build.inference.rails/spec
-                    :php circle.backend.build.inference.php/spec})
+(def inference-fns {:rails (var circle.backend.build.inference.rails/spec)
+                    :php (var circle.backend.build.inference.php/spec)})

 (defn set-inferred [actions]
   (map #(action/set-source % :inferred) actions))


Explode those rows

Explode those rows

--- src/clj_simple_chart/ncs/discovery.clj
+++ src/clj_simple_chart/ncs/discovery.clj
@@ -154,6 +154,23 @@
     :likely (cumulative-original-recoverable-by-status :likely year kind)
     :not-evaluated (cumulative-original-recoverable-by-status :not-evaluated year kind)))

+(def number-columns [:shut-down-produced :producing-produced
+                     :remaining-reserves :pdo-approved :clarification
+                     :likely :not-evaluated])
+
 (def flat-data
   (for [yr (range start-year (inc stop-year))]
     (produce-row-year yr :liquids)))
+
+(defn explode-row [row]
+  (reduce (fn [o k]
+            (conj o {:year (:year row)
+                     :c k
+                     :value (get row k)}))
+          [] number-columns))
+
+(def exploded-data
+  (->> flat-data
+       (mapcat explode-row)
+       (sort-by :year)
+       (vec)))


Implement rich text field #46

Implement rich text field #46

--- src/flatgui/samples/forms/richtext.clj
+++ src/flatgui/samples/forms/richtext.clj
@@ -13,17 +13,29 @@
             [flatgui.widgets.component :as component]
             [flatgui.widgets.window :as window]
             [flatgui.widgets.textrich :as textrich]
-            [flatgui.widgets.panel :as panel]))
+            [flatgui.widgets.panel :as panel]
+            [flatgui.widgets.button :as button])
+  (:import (flatgui.core IFGEvolveConsumer)))

 (def sample-text "If you can fill the unforgiving minute With sixty seconds’ worth of distance run, Yours is the Earth and everything that’s in it, And — which is more — you’ll be a Man, my son!")

 (def gap 0.125)

+(def tooppanel-h 0.5)
+
+(fg/defaccessorfn header-&-toolpanel-h [compoment]
+  (+ (get-property [] :header-h) tooppanel-h))
+
 (fg/defevolverfn text-clip-size :clip-size
   (let [s (get-property [] :clip-size)]
-    (m/defpoint (- (m/x s) gap gap) (- (m/y s) gap gap (get-property [] :header-h)))))
+    (m/defpoint (- (m/x s) gap gap) (- (m/y s) gap gap (header-&-toolpanel-h component)))))

-(fg/defevolverfn text-position-matrix :position-matrix (m/translation gap (+ (get-property [] :header-h) gap)))
+(fg/defevolverfn text-position-matrix :position-matrix (m/translation gap (+ (header-&-toolpanel-h component) gap)))
+
+(fg/defevolverfn :rendition
+  (if (and (= (get-reason) [:text->]) (get-property [:text->] :pressed))
+    (textrich/rendition-input-data-evolver component old-rendition {:type :string :data "TEST"})
+    (textrich/rendition-evolver component)))

 (def window
   (fg/defcomponent
@@ -33,12 +45,18 @@
      :position-matrix (m/translation 1 1)
      :text "Rich Text Example"}

+    (fg/defcomponent button/button :text->
+      {:position-matrix (m/translation 0.125 0.5)
+       :clip-size (m/defpoint 0.375 0.375)
+       :text "T"})
+
     (fg/defcomponent
       textrich/textrich
       :text
-      {:model (assoc textrich/empty-model :glyphs (map textrich/char-glyph sample-text))
+      {:rendition (assoc textrich/empty-rendition :glyphs (map textrich/char-glyph sample-text))
        :evolvers {:clip-size text-clip-size
-                  :position-matrix text-position-matrix}})))
+                  :position-matrix text-position-matrix
+                  :rendition rendition-evolver}})))

 (def root-panel
   (fg/defcomponent
@@ -48,4 +66,25 @@
      :background (awt/color 9 17 26)
      :font "bold 14px sans-serif"
      :evolvers {:clip-size component/clip-size-to-host}}
-    window))+    window))
+
+;;;
+;;; Tool button bindings: simulate input data
+;;;
+
+;(defn create-addtopic-consumer [jd-node]
+;  (reify IFGEvolveConsumer
+;    (getTargetPath [_this] [:mainframe :topiclist-tab :add-topic-button])
+;    (getTargetProperties [_this] [:pressed])
+;    (acceptEvolveResult [_this sessionId container _reason]
+;      (if (:pressed container)
+;        (let [topic-count (.getTopicCount jd-node)
+;              topic-name (str "topic-" topic-count) ]
+;          (do
+;            (println "[JD]" sessionId "Adding topic " topic-name)
+;            (.addTopic jd-node topic-name)))))))
+;
+;
+;(defn setup-bindings [container]
+;  (println "[JD] Initializing control binding consumers...")
+;  (.addEvolveConsumer container (addtopic/create-addtopic-consumer *jd-node*)))


Fix what i broke

Fix what i broke

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -55,7 +55,7 @@
   :profiles
   {:dev
    {:dependencies [[binaryage/devtools "0.9.4"]{{#10x?}}
-                   [day8.re-frame/re-frame-10x "0.2.0"]{/10x?}{{#cider?}}
+                   [day8.re-frame/re-frame-10x "0.2.0"]{{/10x?}}{{#cider?}}
                    [figwheel-sidecar "0.5.13"]
                    [com.cemerick/piggieback "0.2.2"]{{/cider?}}{{#re-frisk?}}
                    [re-frisk "0.5.3"]{{/re-frisk?}}]


Reverse keyword lookup invocation order in `mikron.runtime.core/unpack`

--- src/main/cljc/mikron/runtime/core.cljc
+++ src/main/cljc/mikron/runtime/core.cljc
@@ -117,7 +117,7 @@
     (let [buffer    (buffer/wrap binary)
           headers   (buffer/get-headers buffer)
           diffed?   (headers :diffed?)
-          processor ((if diffed? :unpack-diffed :unpack) (.-processors (resolve-schema schema)))]
+          processor ((.-processors (resolve-schema schema)) (if diffed? :unpack-diffed :unpack))]
       (cond-> (processor buffer)
         diffed? (DiffedValue.)))))


Remove unnecessary nil from reload

Remove unnecessary nil from reload

--- src/net/sekao/nightcode/controller.clj
+++ src/net/sekao/nightcode/controller.clj
@@ -285,7 +285,7 @@
 (defn reload! [^Scene scene]
   (when-let [webview (.lookup scene "#webview")]
     (let [text (.executeScript (.getEngine webview) "getTextContent()")
-          text (str "(do" \newline text \newline ")" \newline "nil")
+          text (str "(do" \newline text \newline ")")
           builder-webview (b/get-builder-webview @pref-state @runtime-state)
           builder-bridge (-> (.getEngine builder-webview) (.executeScript "window") (.getMember "java"))]
       (.onenter builder-bridge text))))


Improve perf of throughput metric.

Improve perf of throughput metric.

--- src/onyx/lifecycle/metrics/metrics.clj
+++ src/onyx/lifecycle/metrics/metrics.clj
@@ -36,7 +36,10 @@
       ;; TODO, for blockable lifecycles, keep adding latencies until advance?
       (.update timer latency-ns TimeUnit/NANOSECONDS)
       (when (task/advanced? state)
-        (m/mark! throughput (count (mapcat :leaves (:tree (:onyx.core/results (task/get-event state))))))))))
+        (m/mark! throughput (reduce (fn [c {:keys [leaves]}]
+                                      (+ c (count leaves)))
+                                    0
+                                    (:tree (:onyx.core/results (task/get-event state)))))))))

 (defn update-rv-epoch [cnt-replica-version cnt-epoch epoch-rate]
   (fn [state latency-ns]


simplify context keys

simplify context keys

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -91,24 +91,24 @@

 ;; RUM specific code ===========================================================

-(let [get-k     (str ::get)
-      release-k (str ::release)]
+(let [get-k     "org.martinklepsch.derivatives/get"
+      release-k "org.martinklepsch.derivatives/release"]

   (defn rum-derivatives
     "Given the passed spec add get!/release! derivative functions to
     the child context so they can be seen by components using the `deriv`
     mixin."
     [spec]
-    #?(:cljs
+    #?(:cljs
        {:class-properties {:childContextTypes {get-k     js/React.PropTypes.func
                                                release-k js/React.PropTypes.func}}
         :child-context    (fn [_] (let [{:keys [release! get!]} (derivatives-manager spec)]
-                                    {release-k release! get-k get!}))}))
+                                    {release-k release! get-k get!}))}))

   (defn rum-derivatives*
     "Like rum-derivatives but get the spec from the arguments passed to the components (`:rum/args`) using `get-spec-fn`"
     [get-spec-fn]
-    #?(:cljs
+    #?(:cljs
        {:class-properties {:childContextTypes {get-k     js/React.PropTypes.func
                                                release-k js/React.PropTypes.func}}
         :init             (fn [s _] (assoc s ::spec (get-spec-fn (:rum/args s))))


Make Eastwood happy. Thanks Eastwood!

Make Eastwood happy. Thanks Eastwood!

--- src/open_company/resources/section.clj
+++ src/open_company/resources/section.clj
@@ -161,11 +161,12 @@
         (common/create-resource conn table-name completed-section timestamp))
       false))))

-(defn patch-revision [conn company-slug section-name timestamp revision user]
+(defn patch-revision
   "
   Given the company slug, section name, timestamp and section property map, update an exising section revision,
   returning the property map for the resource or `false`.
   "
+  [conn company-slug section-name timestamp revision user]
   (let [original-company (company/get-company conn company-slug) ; company before the update
         author (common/author-for-user user)
         original-revision (get-section conn company-slug section-name timestamp) ; revision before the update


whitespace

whitespace

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -58,10 +58,10 @@

 (defn derivatives-manager
   "Given a derivatives spec return a map with `get!` and `free!` functions.
-
+
   - (get! derivative-id token) will retrieve a derivative for
-    `derivative-id` registering the usage with `token`
-  - (free! derivative-id token) will indicate the derivative `derivative-id`
+    `derivative-id` registering the usage with `token`
+  - (free! derivative-id token) will indicate the derivative `derivative-id`
     is no longer needed by `token`, if there are no more tokens needing
     the derivative it will be removed"
   [spec]


Midje is no longer used.

Midje is no longer used.

--- .midje.clj
+++ .midje.clj
@@ -1 +0,0 @@
-(change-defaults :print-level :print-facts)


Solve Where is the Marble? in clojure

Solve Where is the Marble? in clojure

--- solutions/uri/1025/1025.clj
+++ solutions/uri/1025/1025.clj
@@ -7,8 +7,7 @@
          end (-> (count items)
                  (dec))]
     (let [middle (-> (+ begin end)
-                     (quot 2))
-          items (vec items)]
+                     (quot 2))]
       (if  (> begin end)
         -1
         (cond
@@ -25,17 +24,16 @@
           :else
           (inc middle))))))

-(defn read-values [total]
-  (loop [reverse-index total
+(defn read-values [total-lines]
+  (loop [current-line total-lines
          vals []]
-    (if (== reverse-index 0)
+    (if (== current-line 0)
       vals
-      (recur (dec reverse-index)
-             (concat vals [(Integer/parseInt (read-line))])))))
+      (recur (dec current-line)
+             (cons (Integer/parseInt (read-line)) vals)))))

-
-(defn process-print [index marbles queries]
-  (printf "CASE# %d:%n" index)
+(defn process-print [test-case-index marbles queries]
+  (printf "CASE# %d:%n" test-case-index)
   (loop [queries queries]
     (let [query (first queries)
           position (binary-search query marbles)]
@@ -47,13 +45,16 @@

 (defn main []
   (loop [line (read-line)
-         index 1]
+         test-case-index 1]
     (let [[n q] (->> (str/split line #" ")
                      (map #(Integer/parseInt %)))
-          marbles (sort (read-values n))
-          queries (read-values q)]
+          marbles (-> (read-values n)
+                      (sort)
+                      (vec))
+          queries (-> (read-values q)
+                      (reverse))]
       (when (and (not= n 0) (not= q 0))
-        (process-print index marbles queries)
-        (recur (read-line) (inc index))))))
+        (process-print test-case-index marbles queries)
+        (recur (read-line) (inc test-case-index))))))

 (main)


fetch more entity ids

fetch more entity ids

really need to do server-side entity-id resolution!

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -311,11 +311,11 @@

 (defn setup-entity-id-fetcher [state]
   (let [api-ch (-> state deref :comms :api)]
-    (fetch-entity-ids api-ch 10)
+    (fetch-entity-ids api-ch 40)
     (add-watch state :entity-id-fetcher (fn [key ref old new]
-                                          (when (> 5 (-> new :entity-ids count))
+                                          (when (> 20 (-> new :entity-ids count))
                                             (println "fetching more entity ids")
-                                            (fetch-entity-ids api-ch 20))))))
+                                            (fetch-entity-ids api-ch 40))))))

 (defn ^:export setup! []
   (apply-app-id-hack)


use port 57710 when connecting to external servers as it's the standard scsynth port

--- src/overtone/sc/server.clj
+++ src/overtone/sc/server.clj
@@ -81,8 +81,8 @@

 (defn connect-external-server
   "Connect to an externally running SC audio server listening to port
-  on host.  Host defaults to localhost and port defaults to 57711."
-  ([] (connect-external-server 57711))
+  on host.  Host defaults to localhost and port defaults to 57710."
+  ([] (connect-external-server 57710))
   ([port] (connect-external-server "127.0.0.1" port))
   ([host port]
      (connect host port)


Message queue: housekeeping (incl. rename messages & recently-done keys)

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -3,16 +3,16 @@
   Simple implementation. Very simple API. Reliable. Fast.

   Redis keys:
-    * carmine:mq:<qname>:messages      -> hash, {mid mcontent}.
-    * carmine:mq:<qname>:locks         -> hash, {mid lock-expiry-time}.
-    * carmine:mq:<qname>:backoffs      -> hash, {mid backoff-expiry-time}.
-    * carmine:mq:<qname>:nretries      -> hash, {mid retry-count}.
-    * carmine:mq:<qname>:mid-circle    -> list, rotating list of mids.
-    * carmine:mq:<qname>:recently-done -> set, for efficient mid removal from circle.
-    * carmine:mq:<qname>:eoq-backoff?  -> ttl flag, used for queue-wide (every-worker)
-                                          polling backoff.
-    * carmine:mq:<qname>:ndry-runs     -> int, number of times worker(s) have burnt
-                                          through queue w/o work to do.
+    * carmine:mq:<qname>:msgs         -> hash, {mid mcontent}.
+    * carmine:mq:<qname>:locks        -> hash, {mid lock-expiry-time}.
+    * carmine:mq:<qname>:backoffs     -> hash, {mid backoff-expiry-time}.
+    * carmine:mq:<qname>:nretries     -> hash, {mid retry-count}.
+    * carmine:mq:<qname>:mid-circle   -> list, rotating list of mids.
+    * carmine:mq:<qname>:gc           -> set, for efficient mid removal from circle.
+    * carmine:mq:<qname>:eoq-backoff? -> ttl flag, used for queue-wide (every-worker)
+                                         polling backoff.
+    * carmine:mq:<qname>:ndry-runs    -> int, number of times worker(s) have burnt
+                                         through queue w/o work to do.

   Ref. http://antirez.com/post/250 for basic implementation details."
   {:author "Peter Taoussanis"}
@@ -45,15 +45,15 @@

 (defn queue-status [conn qname]
   (let [qk (partial qkey qname)]
-    (zipmap [:messages :locks :backoffs :nretries :mid-circle :recently-done
+    (zipmap [:msgs :locks :backoffs :nretries :mid-circle :gc
              :eoq-backoff? :ndry-runs]
      (wcar conn
-       (car/hgetall*      (qk :messages))
+       (car/hgetall*      (qk :msgs))
        (car/hgetall*      (qk :locks))
        (car/hgetall*      (qk :backoffs))
        (car/hgetall*      (qk :nretries))
        (car/lrange        (qk :mid-circle) 0 -1)
-       (->> (car/smembers (qk :recently-done)) (car/parse set))
+       (->> (car/smembers (qk :gc))            (car/parse set))
        (->> (car/get      (qk :eoq-backoff?))  (car/parse-bool))
        (->> (car/get      (qk :ndry-runs))     (car/parse-long))))))

@@ -65,7 +65,7 @@
     :locked            - Currently with handler.
     :retry-backoff     - Awaiting backoff for handler retry (rehandling).
     :done-with-backoff - Finished handling, awaiting dedupe timeout.
-    :recently-done     - Finished handling, no dedupe timeout, awaiting GC.
+    :done-awaiting-gc  - Finished handling, no dedupe timeout, awaiting GC.
     nil                - Already GC'd or invalid message id."
   [qname mid]
   (car/parse-keyword
@@ -75,23 +75,23 @@
     local lock_exp    = tonumber(redis.call('hget', _:qk-locks,    _:mid) or 0)
     local backoff_exp = tonumber(redis.call('hget', _:qk-backoffs, _:mid) or 0)

-    if redis.call('hexists', _:qk-messages, _:mid) ~= 1 then
+    if redis.call('hexists', _:qk-msgs, _:mid) ~= 1 then
       if (now < backoff_exp) then return 'done-with-backoff' end
       return nil
     else
-      if redis.call('sismember', _:qk-recently-done, _:mid) == 1 then
+      if redis.call('sismember', _:qk-gc, _:mid) == 1 then
         if (now < backoff_exp) then return 'done-with-backoff' end
-        return 'recently-done'
+        return 'done-awaiting-gc'
       else
         if     (now < lock_exp)    then return 'locked'
         elseif (now < backoff_exp) then return 'retry-backoff' end
         return 'queued'
       end
     end"
-    {:qk-messages      (qkey qname :messages)
-     :qk-locks         (qkey qname :locks)
-     :qk-backoffs      (qkey qname :backoffs)
-     :qk-recently-done (qkey qname :recently-done)}
+    {:qk-msgs     (qkey qname :msgs)
+     :qk-locks    (qkey qname :locks)
+     :qk-backoffs (qkey qname :backoffs)
+     :qk-gc       (qkey qname :gc)}
     {:now (System/currentTimeMillis)
      :mid mid})))

@@ -110,13 +110,13 @@
     local lock_exp    = tonumber(redis.call('hget', _:qk-locks,    _:mid) or 0)
     local backoff_exp = tonumber(redis.call('hget', _:qk-backoffs, _:mid) or 0)

-    if redis.call('hexists', _:qk-messages, _:mid) ~= 1 then
+    if redis.call('hexists', _:qk-msgs, _:mid) ~= 1 then
       if (now < backoff_exp) then return 'done-with-backoff' end
       -- return nil
     else
-      if redis.call('sismember', _:qk-recently-done, _:mid) == 1 then
+      if redis.call('sismember', _:qk-gc, _:mid) == 1 then
         if (now < backoff_exp) then return 'done-with-backoff' end
-        -- return 'recently-done'
+        -- return 'done-awaiting-gc'
       else
         if     (now < lock_exp)    then return 'locked'
         elseif (now < backoff_exp) then return 'retry-backoff' end
@@ -125,7 +125,7 @@
     end
     ---------------------------------------------------------------------------

-    redis.call('hset', _:qk-messages, _:mid, _:mcontent)
+    redis.call('hset', _:qk-msgs, _:mid, _:mcontent)

     -- lpushnx end-of-circle marker to ensure an initialized mid-circle
     if redis.call('exists', _:qk-mid-circle) == 0 then
@@ -135,11 +135,11 @@
     redis.call('lpush', _:qk-mid-circle, _:mid)
     return {_:mid} -- Wrap to distinguish from error replies
     "
-    {:qk-messages      (qkey qname :messages)
-     :qk-locks         (qkey qname :locks)
-     :qk-backoffs      (qkey qname :backoffs)
-     :qk-mid-circle    (qkey qname :mid-circle)
-     :qk-recently-done (qkey qname :recently-done)}
+    {:qk-msgs       (qkey qname :msgs)
+     :qk-locks      (qkey qname :locks)
+     :qk-backoffs   (qkey qname :backoffs)
+     :qk-mid-circle (qkey qname :mid-circle)
+     :qk-gc         (qkey qname :gc)}
     {:now           (System/currentTimeMillis)
      :mid           (or unique-message-id (str (java.util.UUID/randomUUID)))
      :mcontent      (car/freeze message)})
@@ -151,7 +151,7 @@
 (defn dequeue
   "IMPLEMENTATION DETAIL: Use `worker` instead.
   Rotates queue's mid-circle and processes next mid. Returns:
-    nil             - If msg locked, recently GC'd, or set to backoff.
+    nil             - If msg already GC'd, locked, or set to backoff.
     \"eoq-backoff\" - If circle uninitialized or end-of-circle marker reached.
     [<mid> <mcontent> <attempt-count>] - If message should be (re)handled now."
   [qname & [{:keys [lock-ms eoq-backoff-ms]
@@ -171,10 +171,10 @@
         return 'eoq-backoff'
       end

-      if redis.call('sismember', _:qk-recently-done, mid) == 1 then -- GC
+      if redis.call('sismember', _:qk-gc, mid) == 1 then -- GC
         redis.call('lrem', _:qk-mid-circle, 1, mid) -- Efficient here
-        redis.call('srem', _:qk-recently-done, mid)
-        redis.call('hdel', _:qk-messages,      mid)
+        redis.call('srem', _:qk-gc,            mid)
+        redis.call('hdel', _:qk-msgs,          mid)
         redis.call('hdel', _:qk-locks,         mid)
         redis.call('hdel', _:qk-nretries,      mid)
         -- NB do NOT prune :qk_backoffs now, will be used post-handler as a
@@ -205,21 +205,21 @@

       redis.call('set', _:qk-ndry-runs, 0) -- Did work on this run

-      local mcontent = redis.call('hget', _:qk-messages, mid)
+      local mcontent = redis.call('hget', _:qk-msgs, mid)
       local attempts = retries + 1
       return {mid, mcontent, attempts}
     end"
-   {:qk-messages      (qkey qname :messages)
-    :qk-locks         (qkey qname :locks)
-    :qk-backoffs      (qkey qname :backoffs)
-    :qk-nretries      (qkey qname :nretries)
-    :qk-mid-circle    (qkey qname :mid-circle)
-    :qk-recently-done (qkey qname :recently-done)
-    :qk-eoq-backoff   (qkey qname :eoq-backoff?)
-    :qk-ndry-runs     (qkey qname :ndry-runs)}
-   {:now              (System/currentTimeMillis)
-    :lock-ms          lock-ms
-    :eoq-backoff-ms   eoq-backoff-ms}))
+   {:qk-msgs        (qkey qname :msgs)
+    :qk-locks       (qkey qname :locks)
+    :qk-backoffs    (qkey qname :backoffs)
+    :qk-nretries    (qkey qname :nretries)
+    :qk-mid-circle  (qkey qname :mid-circle)
+    :qk-gc          (qkey qname :gc)
+    :qk-eoq-backoff (qkey qname :eoq-backoff?)
+    :qk-ndry-runs   (qkey qname :ndry-runs)}
+   {:now            (System/currentTimeMillis)
+    :lock-ms        lock-ms
+    :eoq-backoff-ms eoq-backoff-ms}))

 (comment
   (clear-queues {} "myq")
@@ -241,7 +241,7 @@

           done  (fn [mid & [backoff-ms]] (wcar conn
                                            (hset-backoff mid backoff-ms)
-                                           (car/sadd (qk :recently-done) mid)))
+                                           (car/sadd (qk :gc) mid)))

           retry (fn [mid & [backoff-ms]] (wcar conn
                                            (hset-backoff mid backoff-ms)
@@ -249,9 +249,9 @@

           error (fn [mid poll-reply & [throwable]]
                 (done mid)
-                (timbre/error
+                (timbre/errorf
                  (if throwable throwable (Exception. ":error handler response"))
-                 (str "Error handling queue message: " qname "\n" poll-reply)))
+                 "Error handling %s queue message:\n%s" qname poll-reply))

           {:keys [status throwable backoff-ms]}
           (let [result (try (handler {:message mcontent
@@ -264,7 +264,7 @@
         :retry   (retry mid backoff-ms)
         :error   (error mid poll-reply throwable)
         (do (done mid)
-            (timbre/warn (str "Invalid handler status:" status)))))))
+            (timbre/warnf "Invalid handler status: %s" status))))))

 ;;;; Workers

@@ -298,7 +298,7 @@
                   (when eoq-backoff-ms* (Thread/sleep eoq-backoff-ms*))
                   (handle1 conn qname handler poll-reply)))

-              (catch Throwable t (timbre/fatal t "Worker error!") (throw t)))
+              (catch Throwable t (timbre/fatalf t "Worker error!") (throw t)))
             (when throttle-ms (Thread/sleep throttle-ms)))))
       true)))

@@ -336,13 +336,14 @@
    :throttle-ms    - Thread sleep period between each poll."
   [conn qname & [{:keys [handler monitor lock-ms eoq-backoff-ms throttle-ms
                          auto-start?]
-                  :or   {handler (fn [{:keys [message attempt]}]
-                                   (timbre/info qname message attempt)
+                  :or   {handler (fn [{:keys [message attempt] :as handler-args}]
+                                   (timbre/infof "%s" handler-args)
                                    {:status :success})
                          monitor (monitor-fn qname 1000 (* 1000 60 60))
                          lock-ms        (* 1000 60 60)
                          throttle-ms    200
-                         eoq-backoff-ms (fn [ndruns] (exp-backoff ndruns {:max 10000}))
+                         eoq-backoff-ms (fn [ndruns] (exp-backoff ndruns
+                                                       {:max 10000}))
                          auto-start?    true}}]]
   (let [w (->Worker conn qname (atom false)
                     {:handler        handler


Disabled visual-vm jvm-opts.

Disabled visual-vm jvm-opts.

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -10,14 +10,15 @@
                   [jonase/eastwood "0.2.3"]
                   [lein-ancient "0.6.8"]
                   [lein-bikeshed "0.3.0"]
-                  [lein-kibit "0.1.2"]
                   [lein-ns-dep-graph "0.1.0-SNAPSHOT"]]}
  :repl {:dependencies [[acyclic/squiggly-clojure "0.1.6"]
                        [datomic-schema-grapher "0.0.1"]
-                       [org.clojure/tools.nrepl "0.2.12"]]}
+                       [org.clojure/tools.nrepl "0.2.12"]]
+        :plugins [[cider/cider-nrepl "0.15.0-SNAPSHOT"]]}
  :repl-options {:init (set! *print-length* 10)}
  ;; VisualVM profiling opts
- :jvm-opts ["-Dcom.sun.management.jmxremote"
-            "-Dcom.sun.management.jmxremote.ssl=false"
-            "-Dcom.sun.management.jmxremote.authenticate=false"
-            "-Dcom.sun.management.jmxremote.port=43210"]}
+ ;; :jvm-opts ["-Dcom.sun.management.jmxremote"
+ ;;            "-Dcom.sun.management.jmxremote.ssl=false"
+ ;;            "-Dcom.sun.management.jmxremote.authenticate=false"
+ ;;            "-Dcom.sun.management.jmxremote.port=43210"]}
+ }


Lies and slander :)

Lies and slander :)

--- src/aurora/examples/todomvc2.cljs
+++ src/aurora/examples/todomvc2.cljs
@@ -589,15 +589,11 @@
   (.-kind->name->fields->index todomvc)
   (index todomvc "todo-displayed")

-  ;;Try to run todomvc and it blows up with "Can't split anything"
   (perf-time
    (do (defaults todomvc)
      (init-std-lib todomvc)
      (fill-todos todomvc 10)
      (re-run todomvc)))
-
-  ;;Trying to get the thing to run CRAZINESS, queued events cause re-run to be called
-  ;;if I .quiesce the ui disappears, just calling .run is fine though

 (let [program (env)]
   (rules program


added functions for long- and short-term drop; and deseasonalization

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -1,57 +1,186 @@
 (ns forma.trends.analysis
   (:use [forma.matrix.utils :only (variance-matrix coll-avg)]
-        [clojure.math.numeric-tower :only (sqrt floor abs)]
+        [clojure.math.numeric-tower :only (sqrt floor abs expt)]
         [forma.trends.filter :only (deseasonalize make-reliable hp-filter)])
   (:require [forma.utils :as utils]
             [incanter.core :as i]
             [incanter.stats :as s]))

-;; The first few functions are more general, and could be pulled into,
-;; say, the matrix operation namespace.  For now, we will leave them
-;; here, until we can talk more about what goes into that namespace.
-
-(defn time-trend-cofactor
-  "construct a matrix of cofactors; first column is comprised of ones,
-  second column is a range from 1 to [num-months].  The result is a
-  [num-months]x2 incanter matrix."
-  [num-months]
-  (i/trans (i/bind-rows (repeat num-months 1)
-                        (range 1 (inc num-months)))))
+;; TODO (dan): move thest extra matrix functions somewhere else
+
+(defn is-square?
+  "returns true if input matrix is square, and false otherwise"
+  [mat]
+  (let [[row col] (i/dim mat)]
+    (= row col)))

 (defn singular?
-  "Check to see if the supplied matrix `X` is singular. note that `X`
-  has to be square, n x n, where n > 1."
-  [X]
-  (<= (i/det X) 0))
-
-(defn ols-coefficient
-  "extract OLS coefficient from a time-series."
-  [ts]
-  (let [ycol (i/trans [ts])
-        X (time-trend-cofactor (count ts))]
-    (i/sel (i/mmult (variance-matrix X)
-                    (i/trans X)
-                    ycol)
-           1 0)))
-
-(defn windowed-apply
-  "apply a function [f] to a window along a sequence [xs] of length [window]"
-  [f window xs]
-  (pmap f (partition window 1 xs)))
-
-(defn make-monotonic
-  "move through a collection `coll` picking up the min or max values, depending
-  on the value of `comparator` which can be either `min` or `max`.  This is very
-  similar, I think, to the `reduce` function, but with side effects that print
-  into a vector."
-  [comparator coll]
-  (reduce (fn [acc val]
-            (conj acc
-                  (if (empty? acc)
-                    val
-                    (comparator val (last acc)))))
-          []
-          coll))
+  "returns if square input matrix is singular, and false otherwise"
+  [mat]
+  {:pre [(is-square? mat)]}
+  (<= (i/det mat) 0))
+
+(defn idx
+  "return a list of indices starting with 1 equal to the length of
+  input"
+  [coll]
+  (range (count coll)))
+
+(defn average [lst] (/ (reduce + lst) (count lst)))
+
+(defn moving-average [window lst] (map average (partition window 1 lst)))
+
+(defn ols-trend
+  "returns the OLS trend coefficient from the input vector; an
+  intercept is implicitly assumed"
+  [v]
+  (let [time-step (idx v)]
+    (second (:coefs (s/simple-regression v time-step)))))
+
+(defn windowed-map
+  "maps an input function across a sequence of windows onto a vector
+  `v` of length `window-len` and offset by 1"
+  [f window-len v]
+  (pmap f (partition window-len 1 v)))
+
+(defn min-short-trend
+  "returns the minimum value of piecewise linear trends of length
+  `long-block` on a time series `ts`, after smoothing by moving
+  average of window length `short-block`"
+  [long-block short-block ts]
+  (->> (windowed-map ols-trend long-block ts)
+       (moving-average short-block)
+       (apply min)))
+
+(defn long-stats
+  "returns a list with both the value and t-statistic for the OLS
+  trend coefficient for a time series, conditioning on a variable
+  number of cofactors"
+  [ts & cofactors]
+  (let [time-step (idx ts)
+        X (if (empty? cofactors)
+            (i/matrix time-step)
+            (apply i/bind-columns time-step cofactors))]
+    (try
+      (map second (map (s/linear-model ts X) [:coefs :t-tests]))
+      (catch IllegalArgumentException e))))
+
+(defn expt-residuals
+  "returns a list of residuals from the linear regression of `y` on
+  `X`, raised to `power`"
+  [y X power]
+  (map #(expt % power) (:residuals (s/linear-model y X))))
+
+(defn first-order-conditions
+  "returns a matrix with residual weighted cofactors (incl. constant
+  vector) and deviations from mean; corresponds to first-order
+  conditions $f_t$ in the following reference: Hansen, B. (1992)
+  Testing for Parameter Instability in Linear Models, Journal for
+  Policy Modeling, 14(4), pp. 517-533"
+  [y & x]
+  (let [time-step (idx y)
+        X (if (empty? x)
+            (i/matrix time-step)
+            (apply i/bind-columns time-step x))
+        [resid sq-resid] (map (partial expt-residuals y X) [1 2])]
+    (vector (map * resid X)
+            (map * resid (repeat (count y) 1))
+            (map #(- % (average sq-resid)) sq-resid))))
+
+(defn transpose
+  "returns the transposition of a `coll` of vectors"
+  [coll]
+  (apply (partial map vector) coll))
+
+(defn outer-product
+  "returns a flattened vector of the outer product of a vector and its
+  transpose"
+  [coll]
+  (let [mat (i/matrix coll)]
+    (flatten (i/mmult mat (i/trans mat)))))
+
+(defn element-sum
+  "returns a vector of sums of each respective element in a vector of vectors,
+  i.e., a vector with the first element being the sum of the first
+  elements in each sub-vector."
+  [coll]
+  (apply (partial map +) coll))
+
+(defn hansen-mats
+  "returns the matrices of element-wise sums of (1) the first-order
+  conditions, and (2) the cumulative first-order conditions.  This is
+  only an intermediate step in the calculation of the Hansen (1992)
+  test for parameter instability in linear models.
+  TODO: remove redundancy, keep readability"
+  [y & x]
+  (let [foc (apply first-order-conditions y x)]
+    [(element-sum (map outer-product (transpose foc)))
+     (element-sum (map outer-product (transpose (map i/cumulative-sum foc))))]))
+
+(defn hansen-stat
+  "returns the Hansen (1992) test statistic; number of first-order
+  conditions `num-foc`accounts for the demeaned residuals, intercept,
+  and time-step introduced by `first-order-conditions`"
+  [y & x]
+  (let [num-foc (+ (count x) 3)
+        [foc cumul-foc] (apply hansen-mats y x)]
+    (i/trace
+     (i/mmult
+      (i/solve (i/matrix (map #(* (count y) %) foc) num-foc))
+      (i/matrix cumul-foc num-foc)))))
+
+(defn trend-stats
+  "return a structured map of the trend characteristics; input the
+  spectral time series (e.g., ndvi) and the length (in intervals) of
+  the long and short blocks for the short-term drop measurement, along
+  with the cofactors used in the long-trend calculations and the break
+  magnitude
+
+  NOTE: This is probably not necessary, but it shows what we're trying
+  to do."
+  [y long-block short-block & x]
+  (let [characteristics (create-struct :short :long :long-tstat :break)
+        [long-val long-tstat] (apply long-stats y x)]
+    (struct characteristics
+            (min-short-trend long-block short-block y)
+            long-val
+            long-tstat
+            (apply hansen-stat y x))))
+
+(defn scaled-vector
+  [scalar coll]
+  (map #(* scalar %) coll))
+
+(defn harmonic-series
+  "return two vectors "
+  [freq coll k]
+  (let [pds (count coll)
+        scalar (/ (* 2 (. Math PI) k) freq)]
+    (transpose (map (juxt i/cos i/sin)
+                    (scaled-vector scalar (idx coll))))))
+
+(defn k-harmonic-matrix
+  [freq k coll]
+  (let [degree-vector (vec (map inc (range k)))]
+    (apply i/bind-columns
+           (apply concat
+                  (map (partial harmonic-series freq coll)
+                       degree-vector)))))
+
+(defn harmonic-seasonal-decomposition
+  "returns a deseasonalized time-series; input frequency of
+  data (e.g., 23 for 16-day intervals), number of harmonic terms (use
+  3 to replicate procedure in the Verbesselt (2010)), and the
+  time-series.
+
+  Reference:
+  Verbesselt, J. et al. (2010) Phenological Change Detection while
+  Accounting for Abrupt and Gradual Trends in Satellite Image Time
+  Series, Remote Sensing of Environment, 114(12), 2970–298"
+  [freq k coll]
+  (let [S (:fitted (s/linear-model coll (k-harmonic-matrix freq k coll)))]
+    (map #(+ (average coll) %)
+         (apply (partial map -) [coll S]))))

 ;; ## WHOOPBANG :: Collect the short-term drop associated with a
 ;; ## time-series
@@ -72,17 +201,17 @@
 ;; deseasonalize the data, which is reflected below.  It would be a
 ;; good and feasible (easy) bonus to utilize the reliability data.

-(defn short-trend
-  "`short-trend` will find the greatest OLS drop over a timeseries `ts`
-  given sub-timeseries of length `long-block`.  The drops are smoothed
-  by a moving average window of length `window`."
-  ([long-block window ts]
-     (short-trend ts [] long-block window))
-  ([long-block window ts reli-ts]
-     (->> (deseasonalize ts)
-          (windowed-apply ols-coefficient long-block)
-          (windowed-apply coll-avg window)
-          (make-monotonic min))))
+;; (defn short-trend
+;;   "`short-trend` will find the greatest OLS drop over a timeseries `ts`
+;;   given sub-timeseries of length `long-block`.  The drops are smoothed
+;;   by a moving average window of length `window`."
+;;   ([long-block window ts]
+;;      (short-trend ts [] long-block window))
+;;   ([long-block window ts reli-ts]
+;;      (->> (deseasonalize ts)
+;;           (windowed-apply ols-coefficient long-block)
+;;           (windowed-apply coll-avg window)
+;;           (make-monotonic min))))

 (defn collect-short-trend
   "preps the short-term drop for the merge into the other data by separating
@@ -202,18 +331,18 @@
                product
                (vector product)))))

-(defn outer-product
-  " calculate the outer product of two vectors
-
-  Example:
-  (outer-product [1 2 3] [1 2 3])
-  => [1.0000 2.0000 3.0000
-      2.0000 4.0000 6.0000
-      3.0000 6.0000 9.0000]
-"
-  [v1 v2]
-  (i/matrix
-   (for [e v1] (vec (map (partial * e) v2)))))
+;; (defn outer-product
+;;   " calculate the outer product of two vectors
+
+;;   Example:
+;;   (outer-product [1 2 3] [1 2 3])
+;;   => [1.0000 2.0000 3.0000
+;;       2.0000 4.0000 6.0000
+;;       3.0000 6.0000 9.0000]
+;; "
+;;   [v1 v2]
+;;   (i/matrix
+;;    (for [e v1] (vec (map (partial * e) v2)))))

 (defn lengthening-mat


initialize abilities/events on ICE installed by Mutate

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -294,6 +294,7 @@
                        (swap! state assoc-in (cons :corp (:zone target)) newices)
                        (swap! state update-in [:corp :deck] (fn [coll] (remove-once #(not= (:cid %) (:cid newice)) coll)))
                        (trigger-event state side :corp-install newice)
+                       (card-init state side newice false)
                        (system-msg state side (str "uses Mutate to install and rez " (:title newice) " from R&D at no cost")))
                      (system-msg state side (str "does not find any ICE to install from R&D")))
                    (shuffle! state :corp :deck)))}


Updated Snatch and Grab's trace msg

Updated Snatch and Grab's trace msg

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -431,8 +431,7 @@
     :effect (req (doseq [t targets] (rez state side t {:no-cost true})))}

    "Snatch and Grab"
-   {:trace {:base 3 :choices {:req #(has? % :subtype "Connection")}
-            :msg (msg "attempt to trash " (:title target))
+   {:trace {:msg "trash a connection" :base 3 :choices {:req #(has? % :subtype "Connection")}
             :effect (req (let [c target]
                            (resolve-ability
                              state side


core.channel doesn't use core.buffer

core.channel doesn't use core.buffer

--- src/clj/momentum/core/channel.clj
+++ src/clj/momentum/core/channel.clj
@@ -1,6 +1,5 @@
 (ns momentum.core.channel
   (:use
-   momentum.core.buffer
    momentum.core.deferred)
   (:import
    [momentum.async


Cosmetic changes

Cosmetic changes

--- src/cljam/io/bam_index/writer.clj
+++ src/cljam/io/bam_index/writer.clj
@@ -138,7 +138,7 @@
                        indices)]
         (recur rest rid' idx-status' no-coordinate-alns' indices'))
       (assoc indices rid idx-status
-                     :no-coordinate-alns no-coordinate-alns))))
+             :no-coordinate-alns no-coordinate-alns))))

 ;; Merging indices
 ;; -------------
@@ -148,9 +148,9 @@
   (MetaData. (let [f1 (.first-offset meta1)
                    f2 (.first-offset meta2)]
                (cond
-                (= f1 -1) f2
-                (= f2 -1) f1
-                :else (min f1 f2)))
+                 (= f1 -1) f2
+                 (= f2 -1) f1
+                 :else (min f1 f2)))
              (max (.last-offset meta1) (.last-offset meta2))
              (+ (.aligned-alns meta1) (.aligned-alns meta2))
              (+ (.unaligned-alns meta1) (.unaligned-alns meta2))))


Fix string formatting

Fix string formatting

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -3,7 +3,7 @@
   (:require [om.core :as om :include-macros true]
             [sablono.core :as sab :include-macros true]
             [cljs.core.async :refer [chan put! <!] :as async]
-            [clojure.string :refer [capitalize]]
+            [clojure.string :refer [capitalize lower-case]]
             [netrunner.main :refer [app-state]]
             [netrunner.auth :refer [avatar] :as auth]
             [netrunner.cardbrowser :refer [image-url add-symbols] :as cb]
@@ -347,8 +347,8 @@
              [:img.card.bg {:src url :onError #(-> % .-target js/$ .hide)}]]))
         [:div.counters
          (when (pos? counter) (let [counter-type (or (card-counter-type @cursor) "")
-                                    norm-type (clojure.string/lower-case counter-type)
-                                    selector (clojure.string/format "div.darkbg.%s-counter.counter" norm-type)]
+                                    norm-type (lower-case counter-type)
+                                    selector (str "div.darkbg." norm-type "-counter.counter")]
                                 [(keyword selector) counter]))
          (when (pos? rec-counter) [:div.darkbg.recurring-counter.counter rec-counter])
          (when (pos? advance-counter) [:div.darkbg.advance-counter.counter advance-counter])]


Improvement to ability-costs UI.

Improvement to ability-costs UI.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -157,8 +157,12 @@

 (defn ability-costs [ab]
   (when-let [cost (:cost ab)]
-    (str (clojure.string/join "" (for [c (partition 2 cost)]
-                                   (str (second c) " [" (capitalize (name (first c))) "]"))) ": ")))
+    (str (clojure.string/join
+           ", " (for [c (partition 2 cost)]
+                  (str (case (first c)
+                         "credit" (str (second c) " [" (capitalize (name (first c))) "]")
+                         (clojure.string/join "" (repeat (second c) (str "[" (capitalize (name (first c))) "]")))
+                         )))) ": ")))

 (defn card-view [{:keys [zone code type abilities counter advance-counter advancementcost current-cost subtype
                          advanceable rezzed strength current-strength title remotes selected hosted rec-counter]


Add pause! and resume! for web-audio

Add pause! and resume! for web-audio

--- src/cljs_music/lib/web-audio.cljs
+++ src/cljs_music/lib/web-audio.cljs
@@ -47,3 +47,9 @@
          loop-delay-ms (* 1000 loop-delay)]
      (play-notes! notes at)
      (js/setTimeout #(loop! live-fn notes next-at) loop-delay-ms))))
+
+(defn pause! []
+  (.suspend audio-context))
+
+(defn resume! []
+  (.resume audio-context))


Update cursor position

Update cursor position

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -15,7 +15,7 @@
             [seesaw.color :as color]
             [seesaw.core :as s]
             [mistakes-were-made.core :as mwm])
-  (:import [java.awt.event KeyEvent KeyListener]
+  (:import [java.awt.event KeyEvent KeyListener MouseListener]
            [javax.swing.event DocumentListener HyperlinkEvent$EventType]
            [nightcode.ui JConsole]
            [org.fife.ui.rsyntaxtextarea FileLocation TextEditorPane Theme]
@@ -315,9 +315,9 @@
 (defn refresh-content!
   [^TextEditorPane text-area state]
   (let [old-text (.getText text-area)
-        {:keys [lines index]} state]
+        {:keys [lines cursor-position]} state]
     (.replaceRange text-area (join \newline lines) 0 (count old-text))
-    (.setCaretPosition text-area index)))
+    (.setCaretPosition text-area cursor-position)))

 (defn init-parinfer!
   [^TextEditorPane text-area extension edit-history]
@@ -333,18 +333,30 @@
       (.addKeyListener text-area
         (reify KeyListener
           (keyReleased [this e]
-            (when-not (or (contains? #{KeyEvent/VK_DOWN KeyEvent/VK_UP
-                                       KeyEvent/VK_RIGHT KeyEvent/VK_LEFT
-                                       KeyEvent/VK_SHIFT KeyEvent/VK_CONTROL
-                                       KeyEvent/VK_ALT KeyEvent/VK_META}
-                                     (.getKeyCode e))
-                          (.isControlDown e)
-                          (.isMetaDown e))
+            (cond
+              (contains? #{KeyEvent/VK_DOWN KeyEvent/VK_UP
+                           KeyEvent/VK_RIGHT KeyEvent/VK_LEFT}
+                         (.getKeyCode e))
+              (mwm/update-cursor-position! edit-history (.getCaretPosition text-area))
+
+              (not (or (contains? #{KeyEvent/VK_SHIFT KeyEvent/VK_CONTROL
+                                    KeyEvent/VK_ALT KeyEvent/VK_META}
+                                  (.getKeyCode e))
+                       (.isControlDown e)
+                       (.isMetaDown e)))
               (let [state (get-state text-area (= (.getKeyCode e) KeyEvent/VK_ENTER))]
                 (mwm/update-edit-history! edit-history state)
                 (refresh-content! text-area state))))
           (keyTyped [this e] nil)
-          (keyPressed [this e] nil))))
+          (keyPressed [this e] nil)))
+      (.addMouseListener text-area
+        (reify MouseListener
+          (mouseClicked [this e] nil)
+          (mouseEntered [this e] nil)
+          (mouseExited [this e] nil)
+          (mousePressed [this e] nil)
+          (mouseReleased [this e]
+            (mwm/update-cursor-position! edit-history (.getCaretPosition text-area))))))
     (reset! edit-history nil))
   text-area)


shop specs WIP

shop specs WIP

--- src/clojure/nossal/shop/spec.cljc
+++ src/clojure/nossal/shop/spec.cljc
@@ -4,8 +4,10 @@

 (def email-regex #"^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,63}$")
 (def phone-regex #"^(?:(?:\+|00)?(55)\s?)?(?:\(?([1-9][0-9])\)?\s?)?(?:((?:9\d|[2-9])\d{3})\-?(\d{4}))$")
+(def cep-regex #"^[0-9]{5}-[0-9]{3}$")

 (s/def ::category string?)
+(s/def ::categories (s/col-of ::category :distinct true :into []))

 (s/def ::id int?)
 (s/def ::quantity (s/and int? #(> % 0)))
@@ -41,15 +43,34 @@
 (s/def ::basket-itens (s/coll-of ::basket-item :kind vector? :distinct true :into []))
 (s/def ::basket (s/keys :req-un [::id ::basket-itens]))

+
+(s/def ::cep (s/def (s/and string? #(re-matches cep-regex %))))
+(s/def ::street-address (s/keys :req [::street ::number]
+                                :opt [::building ::apt]))
+
+(s/def ::country #{:brazil})
+(s/def ::address (s/keys :req [::cep
+                               ::country
+                               ::state
+                               ::city
+                               ::street-address]))
+
+(s/def ::shipping-tracker string?)
+
 (s/def ::order (s/keys :req-un [::id
                                 ::basket
                                 ::costumer
-                                ::time]))
-
+                                ::status
+                                ::payment
+                                ::shipping-tracker
+                                ::address
+                                ::creation-time]))
+(s/def ::name (s/keys :req [::first-name ::last-name]))
 (s/def ::costumer (s/keys :req [::id
                                 ::name
                                 ::email
                                 ::address]
-                          :opt [::phone]))
+                          :opt [::phone
+                                ::cpf]))

 (s/def ::db (s/keys :req-un [::products ::basket]))


Calc experimentation.

Calc experimentation.

--- src/clojush/experimental/calc.clj
+++ src/clojush/experimental/calc.clj
@@ -110,8 +110,9 @@
                                                  (run-push (second (closest-association the-tag push-state))
                                                            push-state))
                                                (rest buttons))))))]
-    (vec (cons (* 0.0000001 (reduce + (map second err-modcount-pairs)))
-               (map first err-modcount-pairs)))))
+    ;(vec (cons (* 0.0000001 (reduce + (map second err-modcount-pairs)))
+    ;           (map first err-modcount-pairs)))
+    (vec (map first err-modcount-pairs))))

 ;; a little test -- wire each key to just push the right digit
 ;(calc-errors '(tag_exec_2000 0.0 tag_exec_1600 1.0 tag_exec_1700 2.0
@@ -205,7 +206,7 @@
                           ;code_yankdup
                           environment_begin
                           environment_end
-                          ;environment_new
+                          environment_new
                           ;exec_do*count
                           ;exec_do*range
                           ;exec_do*times
@@ -218,16 +219,16 @@
                           ;exec_fromziprights
                           ;exec_fromziproot
                           exec_if
-                          ;;exec_k
+                          exec_k
                           exec_noop
-                          ;;exec_pop
+                          exec_pop
                           exec_rot
-                          ;;exec_s
+                          exec_s
                           ;exec_shove
                           ;exec_stackdepth
                           exec_swap
                           exec_when
-                          ;;exec_y
+                          exec_y
                           ;exec_yank
                           ;exec_yankdup
                           float_add
@@ -277,11 +278,11 @@
                           ;integer_swap
                           ;integer_yank
                           ;integer_yankdup
-                          ;return_boolean_pop
+                          return_boolean_pop
                           ;return_code_pop
                           return_exec_pop
                           return_float_pop
-                          ;return_fromboolean
+                          return_fromboolean
                           ;return_fromcode
                           return_fromexec
                           return_fromfloat
@@ -350,15 +351,16 @@
    ;:tournament-size 1
    :population-size 1000
    :max-generations 10001
-   :evalpush-limit 100
+   :evalpush-limit 1000
    :tag-limit 10000
    :max-points 1000
    :max-points-in-initial-program 25
    ;:parent-reversion-probability 0.9
-   :mutation-probability 0.0
-   :crossover-probability 0.0
-   :simplification-probability 0.0
-   :ultra-probability 1
+   :mutation-probability 0
+   :crossover-probability 0
+   :simplification-probability 0.1
+   :reproduction-simplifications 10
+   :ultra-probability 0.9
    :ultra-alternation-rate 0.01
    :ultra-alignment-deviation 10
    :ultra-mutation-rate 0.01


make help the default task

make help the default task

--- src/cake/tasks/defaults.clj
+++ src/cake/tasks/defaults.clj
@@ -14,7 +14,7 @@
   "Print tasks with documentation (use -a for all tasks)."
   (println "-------------------------------------------")
   (let [all?     (:a opts)
-        taskdocs (for [[sym task] @tasks :when (or all? (seq (:doc task)))]
+        taskdocs (for [[sym task] @tasks :when (and (not= 'default sym) (or all? (seq (:doc task))))]
                    [(name sym) (str (first (:doc task)))])
         taskdocs (into implicit-taskdocs taskdocs)
         width  (apply max (map #(count (first %)) taskdocs))


more restful clone

more restful clone

--- src/celestial/hosts_api.clj
+++ src/celestial/hosts_api.clj
@@ -98,7 +98,7 @@
            (p/with-quota (p/add-system spec) spec
              (success {:msg "new system saved" :id id}))))

-  (POST- "/system-clone/:id/:hostname" [^:int id ^:string hostname]
+  (POST- "/system/:id/:hostname" [^:int id ^:string hostname]
          {:nickname "cloneSystem" :summary "Clone an existing system "
           :notes "Clones a system replacing unique identifiers along the way,
                  the only user provided value is the dest hostname"


Debug false by default

Debug false by default

--- src/chessground/common.cljs
+++ src/chessground/common.cljs
@@ -5,7 +5,7 @@

 (enable-console-print!)

-(def debug true)
+(def debug false)

 (defn pp [& exprs]
   (when debug (doseq [expr exprs] (.log js/console (clj->js expr))))


Using new usage format.

Using new usage format.

--- src-cljs/frontend/models/plan.cljs
+++ src-cljs/frontend/models/plan.cljs
@@ -188,14 +188,27 @@
   [plan]
   (boolean (:admin plan)))

+(defn latest-billing-period [plan]
+  (->> plan
+       :billing_periods
+       (map (fn [periods]
+              (for [period periods]
+                (time-format/parse (time-format/formatters :date-time) period))))
+       (sort-by first time/after?)
+       (first)))
+
 (defn usage-key->date [usage-key]
-  (time-format/parse (time-format/formatter "yyyy_MM") (name usage-key)))
+  (time-format/parse (time-format/formatter "yyyy_MM_dd") (name usage-key)))

 (defn date->usage-key [date]
-  (keyword (time-format/unparse (time-format/formatter "yyyy_MM") date)))
+  (keyword (time-format/unparse (time-format/formatter "yyyy_MM_dd") date)))

 (defn current-months-osx-usage-ms [plan]
-  (get-in plan [:usage :os:osx (date->usage-key (time/now))]))
+  (let [[period-start period-end] (latest-billing-period plan)]
+    (when (and period-start period-end)
+      (if (time/within? (time/interval period-start period-end) (time/now))
+        (get-in plan [:usage :os:osx (date->usage-key period-start) :amount])
+        0))))

 (defn current-months-osx-usage-% [plan]
   (let [usage-ms (current-months-osx-usage-ms plan)


update testing instructions

update testing instructions

--- src/clj/cljs/source_map.clj
+++ src/clj/cljs/source_map.clj
@@ -82,15 +82,16 @@
 (comment
   ;; INSTRUCTIONS:

-  ;; switch into samples/repl
+  ;; switch into samples/hello
   ;; run repl to start clojure
   ;; build with
+
   (require '[cljs.closure :as cljsc])
-  (cljsc/build "src" {:optimizations :simple :output-to "repl_sample.js" :source-map "repl_sample_map.json"})
+  (cljsc/build "src" {:optimizations :simple :output-to "hello.js" :source-map "hello.js.map"})

   ;; load source map
   (def raw-source-map
-    (json/read-json (slurp (io/file "samples/repl/repl_sample_map.json"))))
+    (json/read-json (slurp (io/file "hello.js.map"))))

   ;; test it out
   (first (decode raw-source-map))


cleanup thread scrape

cleanup thread scrape

--- src/clj/scraper/threads.clj
+++ src/clj/scraper/threads.clj
@@ -72,6 +72,16 @@
         first
         (t/local-date-time bo-time-formatter)))

+(defn get-reply-user
+  [cols]
+  (let [user-url (utils/get-user-url   cols)
+        user-id  (utils/get-user-id    user-url)
+        username (utils/get-username   cols)]
+    (list
+      {:id   user-id
+       :name username
+       :url  user-url})))
+
 (defn get-thread-id
   [reply-url]
   (-> reply-url
@@ -91,58 +101,19 @@
       (Integer/parseInt)
       (/ 10)))

-(defn get-parent-id
-  [indent-level reply-levels]
-  (if (= indent-level 0)
-    nil
-    (get reply-levels (dec indent-level))))
-
-(defn rm-nil-bulb
-  [reply]
-  (if (nil? (:bulbs reply))
-    (dissoc reply :bulbs)
-    reply))
-
-(defn rm-nil-parent-id
-  [reply]
-  (if (nil? (:parent-id reply))
-    (dissoc reply :parent-id)
-    reply))
-
-(defn rm-nil-keys
-  [reply]
-  (-> reply
-      (rm-nil-bulb)
-      (rm-nil-parent-id)))
-
-;(defn combine-users
-;  [thread-data user bulb-users]
-;  (let [users (:users thread-data)]
-;    (-> users
-;        (union (into #{} (list user)))
-;        (union bulb-users))))
-;
-;(defn combine-replies
-;  [thread-data reply]
-;  (->> reply
-;       (rm-nil-keys)
-;       (list)
-;       (into (:replies thread-data))))
-;
-;(defn update-thread-data
-;  [thread-data replies users]
-;  (-> thread-data
-;      (assoc :replies replies)
-;      (assoc :users   users)))
-
-;(defn get-data-helper
-;  [row]
-;  (let [cols           (utils/get-cols       row)
-;        reply-url      (get-reply-url        cols)
-;        reply-id       (get-reply-id         reply-url)
-;        reply-title    (get-reply-title      cols)
-;        post-time      (get-reply-post-time  cols)
-;        reply          {:id         reply-id}]))
+(defn get-reply-data
+  [cols id bulbs]
+  (let [user  (get-reply-user cols)
+        reply {:id    id
+               :title (get-reply-title cols)
+               :time  (get-reply-post-time cols)
+               :user  (:id (first user))}
+        bulbs (dissoc bulbs :users)]
+    (if (empty? bulbs)
+      {:reply reply
+       :user  user}
+      {:reply (assoc reply :bulbs bulbs)
+       :user  user})))

 (defn get-thread-data
   [row]
@@ -151,83 +122,37 @@
         id        (get-reply-id reply-url)
         indent    (get-indent-level cols)
         bulbs     (bulbs/get-data reply-url)
-        reply     {:id      id
-                   :title   (get-reply-title cols)
-                   :bulbs   (dissoc bulbs :users) }
-        users     (get bulbs :users)
+        rdata     (get-reply-data cols id bulbs)
+        reply     (:reply rdata)
+        user      (:user rdata)
+        users     (into (get bulbs :users) user)
         parents   {indent id}]
     {:replies (vec (list reply))
      :users   (set users)
      :parents parents}))
-        ;
-        ;reply-id     (get-reply-id reply-url)
-        ;reply-title  (get-reply-title cols)
-        ;bulbs        (bulbs/get-data reply-url)
-        ;]

+(defn get-parent
+  [curr parents]
+  (let [indent   (ffirst (:parents curr))
+        parent   (get parents (dec indent))
+        replies  (assoc (first (:replies curr)) :parent parent)]
+    (assoc curr :replies (vec (list replies)))))

-;(defn get-data-helper
-;  [rows reply-parents thread-data]
-;  (when (first rows)
-;    (let [row            (first                rows)
-;          cols           (utils/get-cols       row)
-;          reply-url      (get-reply-url        cols)
-;          reply-id       (get-reply-id         reply-url)
-;          reply-title    (get-reply-title      cols)
-;          post-time      (get-reply-post-time  cols)
-;          bulbs          (bulbs/get-data       reply-url)
-;          user-url       (utils/get-user-url   cols)
-;          user-id        (utils/get-user-id    user-url)
-;          username       (utils/get-username   cols)
-;          indent-level   (get-indent-level     cols)
-;          reply-parents  (assoc reply-parents indent-level reply-id)
-;          parent-id      (get-parent-id indent-level reply-parents)
-;          user           {:id         user-id
-;                          :name       username
-;                          :url        user-url}
-;          bulb-users     (:users bulbs)
-;          bulbs          (dissoc bulbs :users)
-;          reply          {:id         reply-id
-;                          :parent-id  parent-id
-;                          :title      reply-title
-;                          :url        reply-url
-;                          :post-time  post-time
-;                          :user-id    user-id
-;                          :bulbs      bulbs}
-;          replies        (combine-replies thread-data reply)
-;          users          (combine-users thread-data user bulb-users)
-;          thread-data    (update-thread-data thread-data replies users)]
-;      (merge thread-data (get-data-helper (rest rows) reply-parents thread-data)))))
-
+(defn my-reducer
+  [new-map curr]
+  (let [parents (:parents new-map)
+        ncurr   (get-parent curr parents)]
+    (merge-with into new-map ncurr)))

 (defn get-data-by-url
   [url]
   ; {:browser :firefox :profile bo-ffprofile}

-  (let [table        (get-replies-table url)
-        rows         (utils/get-rows table)
-        thread-id    (get-thread-id url)
-        data         (map get-thread-data rows)
-        comb-data    (reduce #(merge-with into %1 %2) data)
-
-        ;users        (reduce union (map #(get-in % [:bulbs :users]) data))
-        ;replies      (map #(update-in % [:bulbs] dissoc :users) data)
-        ;thread       {:id thread-id
-        ;              :replies replies
-        ;              :users users}
-        ;LAST
-        ;thread-data  (get-data-helper rows [] {:replies [] :users #{}})
-        ;replies      (:replies thread-data)
-        ;users        (:users   thread-data)
-        ;data         {:thread {:id       thread-id
-        ;                       :replies  (map :id replies)}
-        ;              :replies replies
-        ;              :users   users}
-        ]
-
-    ;(web/close)
-
-    ;(assoc thread :users users)
+  (let [table     (get-replies-table url)
+        rows      (utils/get-rows table)
+        thread-id (get-thread-id url)
+        data      (map get-thread-data rows)
+        comb-data (reduce my-reducer {} data)]
     comb-data
     ; data
     ))
@@ -240,7 +165,8 @@
        (PhantomJSDriver.
          (doto (DesiredCapabilities.)
            (.setCapability "phantomjs.binary.path" phantomjs-path)
-           (.setCapability "phantomjs.page.settings.loadImages" false)))})))
+           (.setCapability "phantomjs.page.settings.loadImages" false)
+           (.setCapability "takesScreenshot" false)))})))

 (defn get-data
   ([url]


Expand url with host-name in response body

--- src/clj/todo_clj/server.clj
+++ src/clj/todo_clj/server.clj
@@ -8,7 +8,8 @@
             [environ.core :refer [env]]
             [ring.adapter.jetty :refer [run-jetty]]
             [ring.middleware.json :refer [wrap-json-response wrap-json-body]]
-            [todo-clj.models.todo :as todos])
+            [todo-clj.models.todo :as todos]
+            [clojure.walk :refer [prewalk prewalk-demo]])
   (:gen-class))

 (defn res-created [todo]
@@ -55,9 +56,26 @@
     (todos/delete id)
     (res-no-content)))

+(defn build-host-name [{name :server-name port :server-port}]
+  (str "http://" name ":" port))
+
+(defn expand-url-body [body host-name]
+  (prewalk #(if (map? %)
+              (assoc % :url (str host-name (:url %)))
+              %) body))
+
+(defn wrap-response-url-body [handler]
+  (fn [request]
+    (let [response (handler request)
+          host-name (build-host-name request)
+          body (:body response)
+          url (:url body)]
+      (assoc response :body (expand-url-body body host-name)))))
+
 (def http-handler
   (-> routes
       (wrap-defaults api-defaults)
+      wrap-response-url-body
       wrap-json-response
       (wrap-json-body {:keywords? true})
       wrap-with-logger


Added scales to this namespace

Added scales to this namespace

--- src/cljs/omnibar/notes.cljs
+++ src/cljs/omnibar/notes.cljs
@@ -1,19 +1,20 @@
-(ns omnibar.notes)
+(ns ^{:doc "functions for general music knowledge. Consider keeping Java/JavaScript neutral in the future."}
+    omnibar.notes)

 ;; Overtone has a more robust set of functions. We don't need it's level of functionality yet.
-;; https://github.com/overtone/overtone/blob/8b8353b27c755004dc0733857bcfee9ce15c6b73/src/overtone/music/pitch.clj
+;; https://github.com/overtone/overtone/blob/master/src/overtone/music/pitch.clj

 (def lowest-piano-midi 21)
 (def highest-piano-midi 108)

-(def piano-notes [                                        :A0 :A#0 :B0
-                  :C1 :C#1 :D1 :D#1 :E1 :F1 :F#1 :G1 :G#1 :A1 :A#1 :B1
-                  :C2 :C#2 :D2 :D#2 :E2 :F2 :F#2 :G2 :G#2 :A2 :A#2 :B2
-                  :C3 :C#3 :D3 :D#3 :E3 :F3 :F#3 :G3 :G#3 :A3 :A#3 :B3
-                  :C4 :C#4 :D4 :D#4 :E4 :F4 :F#4 :G4 :G#4 :A4 :A#4 :B4
-                  :C5 :C#5 :D5 :D#5 :E5 :F5 :F#5 :G5 :G#5 :A5 :A#5 :B5
-                  :C6 :C#6 :D6 :D#6 :E6 :F6 :F#6 :G6 :G#6 :A6 :A#6 :B6
-                  :C7 :C#7 :D7 :D#7 :E7 :F7 :F#7 :G7 :G#7 :A7 :A#7 :B7
+(def piano-notes [                                        :A0 :A#0 :B0
+                  :C1 :C#1 :D1 :D#1 :E1 :F1 :F#1 :G1 :G#1 :A1 :A#1 :B1
+                  :C2 :C#2 :D2 :D#2 :E2 :F2 :F#2 :G2 :G#2 :A2 :A#2 :B2
+                  :C3 :C#3 :D3 :D#3 :E3 :F3 :F#3 :G3 :G#3 :A3 :A#3 :B3
+                  :C4 :C#4 :D4 :D#4 :E4 :F4 :F#4 :G4 :G#4 :A4 :A#4 :B4
+                  :C5 :C#5 :D5 :D#5 :E5 :F5 :F#5 :G5 :G#5 :A5 :A#5 :B5
+                  :C6 :C#6 :D6 :D#6 :E6 :F6 :F#6 :G6 :G#6 :A6 :A#6 :B6
+                  :C7 :C#7 :D7 :D#7 :E7 :F7 :F#7 :G7 :G#7 :A7 :A#7 :B7
                   :C8])

 (def note-midi-map (zipmap piano-notes
@@ -21,6 +22,11 @@

 (defn note->midi [notename]
   (get note-midi-map (keyword notename)))
+
+(defn midi->note [midi-value]
+   (nth piano-notes (- midi-value lowest-piano-midi)))
+
+(pprint (midi->note 69))

 (defn midi->freq [note-num]
   (let [expt-numerator (- note-num 49)
@@ -34,3 +40,33 @@
   (-> notename
       note->midi
       midi->freq))
+
+;; -------------------------
+;; Scales
+
+
+(defn scale [intervals]
+  "Return a function to create a vector of a scale of midi notes"
+  (fn [midi]
+    (reductions + (into [midi] intervals))))
+
+(def major (scale [2 2 1 2 2 2 1]))
+(def minor (scale [2 1 2 2 1 2 2]))
+(def blues (scale [3 2 1 2 3 2]))
+(def pentatonic (scale [3 2 1 2 3 2]))
+(def blues (scale [3 2 1 2 3 2]))
+;; TODO need to define dominant-7th-chord diminished-7th-chord scales.
+(def diminished  (scale [1 2 1 2 1 2 1 2]))
+(def diminished2 (scale [2 1 2 1 2 1 2 1]))
+
+(defn scale->notes [midi-value scale-type]
+  (map #(midi->note %) (scale-type midi-value)))
+
+(def c-major-scale (scale->notes 60 major))
+(def d-major-scale (scale->notes 62 major))
+
+;; -------------------------
+;; TODO Arpeggios
+;; An arpeggio is a sequence of notes in a chord, play one after the other, rather simultaneously.
+;; Arpeggios allow monophonic instruments to play chords and harmony and help create rhythmic interest.
+


Ideas

Ideas

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -81,14 +81,14 @@
   (eduction
     (comp
       (map #(get-in board %))
-      (take-while is-cell-owned?)) ;; TODO - Use partition ?
+      (take-while is-cell-owned?)) ;; TODO - Use partition ? And bring take 2 here?
     (range-coord [x y] [dx dy])))

 (defn convertible-cells
   "Indicates the convertible cells for the provided player - when clicking at [x y]"
   [board [x y] [dx dy] player] ;; TODO - Instead, return the player that can do a thing here
   (let [cells (range-cells board [(+ x dx) (+ y dy)] [dx dy])
-        [head tail :as cell-groups] (partition-by identity cells)]
+        [head tail :as cell-groups] (take 2 (partition-by identity cells))]
     (cond
       (<= (count cell-groups) 1) []
       (= player (first tail)) (vec head)


Add the option to fetch a specific header when using last-response-headers

--- src/clojure/picard/test.clj
+++ src/clojure/picard/test.clj
@@ -178,8 +178,13 @@
        first))

 (defn last-response-status  [] (when-let [r (last-response)] (first r)))
-(defn last-response-headers [] (when-let [r (last-response)] (second r)))
 (defn last-response-body    [] (when-let [r (last-response)] (nth r 2)))
+
+(defn last-response-headers
+  ([] (when-let [r (last-response)] (second r)))
+  ([key]
+     (when-let [hdrs (last-response-headers)]
+       (hdrs key))))

 (defn last-body-chunks
   []


Add more functions to test query-installed-chaincodes

--- src/clojure_fabric/user.clj
+++ src/clojure_fabric/user.clj
@@ -227,21 +227,35 @@

 ;;;
 ;;; Not in spec, but in some SDKs
-;;;
+;;;
+
+(defn known-channel-peer?
+  [channel {target-name :name target-url :url target-pem :pem}]
+  (loop [[[_ {:keys [name url pem]}] & more-peer] (seq (:peers channel))]
+    (cond (nil? name) false
+          (and (= target-name name) (= target-url url) (= target-pem pem)) true
+          :else (recur more-peer))))
+
+(defn known-user-peer?
+  [user peer]
+  (loop [[[_ c] & more-c] (seq (:channels user))]
+    (cond (nil? c) false
+          (known-channel-peer? c peer) true
+          :else (recur more-c))))
+
 (defn query-installed-chaincodes
   ([peer]
    (query-installed-chaincodes core/*user* peer))
   ([user peer]
-   (let [peers (channel/get-peers user)]
-     (if (contains? peers peer)
-       (chaincode/send-chaincode-request :query-installed-chaincodes
-                                         peers
-                                         user)
-       #_
-       (chaincode/make-chaincode-signed-proposal :query-installed-chaincodes
-                                                 user-context
-                                                 crypto-suite)
-       (throw (Exception. "The target Peer does not know anything about the channel"))))))
+   (if (known-user-peer? user peer)
+     (chaincode/send-chaincode-request :query-installed-chaincodes
+                                       peer
+                                       user)
+     #_
+     (chaincode/make-chaincode-signed-proposal :query-installed-chaincodes
+                                               user-context
+                                               crypto-suite)
+     (throw (Exception. "The target Peer does not know anything about the channel")))))

 ;;; get_name
 (defn get-name


correct after-load callback

correct after-load callback

--- src/er_cassandra/model/select.clj
+++ src/er_cassandra/model/select.clj
@@ -32,12 +32,11 @@
    (let [strm (ms/-select-buffered session model key record-or-key-value opts)]
      (->> strm
           (s/map (fn [mi]
-                   (first
-                    (t/run-deferred-callbacks
-                     model
-                     :after-load
-                     [mi]
-                     opts))))))))
+                   (t/run-callbacks-single
+                    model
+                    :after-load
+                    mi
+                    opts)))))))

 (defn select-one
   "select a single record, using an index table if necessary"