fixed utils tests so that they all pass

fixed utils tests so that they all pass

--- test/forma/utils_test.clj
+++ test/forma/utils_test.clj
@@ -1,30 +1,30 @@
 (ns forma.utils-test
-  (:use forma.utils
-        [forma.trends.analysis]
+  ""
+  (:use forma.utils :reload)
+  (:use forma.trends.analysis
         midje.sweet)
   (:require [forma.testing :as t])
   (:import  [java.io InputStream]
             [java.util.zip GZIPInputStream]))

 (facts "string conversion tests."
-  "Floats!"
+  ;; Floats
   (strings->floats "192") => [192.0]
   (strings->floats "192" "12") => [192.0 12.0]

-  "Type checking."
+  ;; Type checking
   (strings->floats "192") => (just [float?])
   (strings->floats "192" "12") => (just [float? float?]))

 (facts "between? tests."
-  (between? -2 2 1) => truthy
+  (between? -2 2 1)  => truthy
   (between? -2 2 -2) => truthy
   (between? -2 2 -3) => falsey)

-(facts "thrush testing!
-
-Here are some examples of how to thread a value through a series of
-functions. This has some advantage over threading with `->`, as thrush
-is a function, not a macro, and can evaluate its arguments."
+(facts "thrush testing examples of how to thread a value through a
+  series of functions. This has some advantage over threading with
+  `->`, as thrush is a function, not a macro, and can evaluate its
+  arguments."
   (thrush 2 #(* % 5) (partial + 2)) => 12
   (apply thrush 1 (for [num (range 4)]
                     (fn [x] (+ x num)))) => 7)
@@ -47,10 +47,10 @@
   (weighted-mean 8 3 1 1) => 6.25
   (weighted-mean 8 0 1 1) => 1.0

-  "Negative weights aren't acceptable."
-  (weighted-mean 8 -1 1 1) => (throws IllegalArgumentException)
+  ;; Negative weights aren't acceptable.
+  (weighted-mean 8 -1 1 1) => (throws AssertionError)

-  "Values and weights must come in pairs."
+  ;; Values and weights must come in pairs.
   (weighted-mean 8 1 1) => (throws AssertionError))

 (fact "trim-seq tests."
@@ -76,8 +76,8 @@
       bytes-filled => 10
       (every? (complement zero?) arr) => truthy)))

-(fact "partition-stream test. These are sort of crappy tests, but they
-do show that we have a sequence of byte arrays being generated."
+(fact "Partition-stream test. These are sort of crappy tests, but they
+  do show that we have a sequence of byte arrays being generated."
   (with-open [txt (input-stream test-txt)]
     (let [result (partition-stream 10 txt)]
       (count (first result)) => 10
@@ -97,8 +97,8 @@
 (fact float-bytes => 4)

 (fact
-  "Check average of vector.
-   Casting as float to generalize for another vector as necessary. Otherwise average will return fractions."
+  "Check average of vector. Casting as float to generalize for another
+  vector as necessary. Otherwise average will return fractions."
   (float (average [1 2 3.])) => 2.0)

 (fact
@@ -114,6 +114,5 @@
  2 [1 2 3] [2 4 6]
  1.5 [1 2 3] [1.5 3.0 4.5])

-(fact
-  "Check windowed-map"
-  (windowed-map ols-trend 2 [1 2 50]) => (contains (map roughly [1.0 48.0])))
+(fact "Check windowed-map"
+  (windowed-map average 2 [1 2 50]) => [3/2 26])


add get-post-data test

add get-post-data test

--- test/misaki/test/core.clj
+++ test/misaki/test/core.clj
@@ -1,7 +1,8 @@
 (ns misaki.test.core
   (:use [misaki core template config server]
         misaki.test.common
-        [hiccup.core :only [html]])
+        [hiccup.core :only [html]]
+        [clj-time.core :only [date-time]])
   (:use [clojure.test])
   (:require [clojure.java.io :as io]))

@@ -11,6 +12,17 @@
     (are [x y] (= x y)
       "
baz
" (generate-post-content file1)
       "
foo
" (generate-post-content file2))))
+
+(deftest* get-post-data-test
+  (let [file (io/file (str *post-dir* "2000.01.01-foo.html.clj"))
+        data (get-post-data file)]
+    (are [x y] (= x y)
+      "baz"   (:title data)
+      "world" (:hello data)
+      file    (:file data)
+      "/2000-01/foo.html"  (:url data)
+      (date-time 2000 1 1) (:date data)
+      "<p>baz</p>" (force (:lazy-content data)))))

 ; ---------------


remove obsolete import (#73, #103)

remove obsolete import (#73, #103)

--- test/clj/lambdacd/runners_test.clj
+++ test/clj/lambdacd/runners_test.clj
@@ -1,7 +1,7 @@
 (ns lambdacd.runners-test
   (:require [clojure.test :refer :all]
             [lambdacd.runners :refer :all]
-            [lambdacd.testsupport.test-util :refer [call-with-timeout start-waiting-for get-or-timeout wait-for]]
+            [lambdacd.testsupport.test-util :refer [start-waiting-for get-or-timeout wait-for]]
             [lambdacd.testsupport.data :refer [some-ctx]]
             [lambdacd.event-bus :as event-bus]))


pool test indentation

pool test indentation

--- test/open_company/unit/db/pool.clj
+++ test/open_company/unit/db/pool.clj
@@ -3,83 +3,83 @@
             [open-company.db.pool :as p]))

 (facts "about claiming & releasing pool inventory"
-         (let [x (atom 0)
-               pool (p/fixed-pool #(swap! x inc) {:size 2 :block-start true})
-               ; Claim both elements
-               a  (p/claim pool)
-               b  (p/claim pool)
-               ; Pool is empty; should throw
-               c  (try (p/claim pool 2/1000)
-                       (catch Exception e
-                         (.getMessage e)))
-               a' (p/release pool a)
-               ; Should re-acquire a
-               d  (p/claim pool)
-               ; Empty
-               e  (try (p/claim pool)
-                       (catch Exception _ :timeout))
-               b' (p/release pool b)
-               ; Re-acquire b
-               f  (p/claim pool)]
-           #{a b} => #{1 2}
-           c => "Couldn't claim a resource from the pool within 2 ms"
-           a => d
-           e => :timeout
-           b => f
-           ; Shouldn't have (open)'d more than twice.
-           @x => 2))
+  (let [x (atom 0)
+        pool (p/fixed-pool #(swap! x inc) {:size 2 :block-start true})
+        ;; Claim both elements
+        a  (p/claim pool)
+        b  (p/claim pool)
+        ;; Pool is empty; should throw
+        c  (try (p/claim pool 2/1000)
+                (catch Exception e
+                  (.getMessage e)))
+        a' (p/release pool a)
+        ;; Should re-acquire a
+        d  (p/claim pool)
+        ;; Empty
+        e  (try (p/claim pool)
+                (catch Exception _ :timeout))
+        b' (p/release pool b)
+        ;; Re-acquire b
+        f  (p/claim pool)]
+    #{a b} => #{1 2}
+    c => "Couldn't claim a resource from the pool within 2 ms"
+    a => d
+    e => :timeout
+    b => f
+    ;; Shouldn't have (open)'d more than twice.
+    @x => 2))

 (facts "about claiming and invalidating"
-         (let [x (atom 0)
-               pool (p/fixed-pool #(swap! x inc) {:size 2 :block-start true})
-               a  (p/claim pool)
-               a' (p/invalidate pool a)
-               b  (p/claim pool)
+  (let [x (atom 0)
+        pool (p/fixed-pool #(swap! x inc) {:size 2 :block-start true})
+        a  (p/claim pool)
+        a' (p/invalidate pool a)
+        b  (p/claim pool)

-               b' (p/invalidate pool b)
-               c  (p/claim pool 1)
-               d  (p/claim pool 1)
-               e  (try (p/claim pool 1) (catch Exception e nil))
-               c' (p/invalidate pool c)
-               d' (p/invalidate pool d)
-               ; Invalidate nil should be a noop
-               e' (p/invalidate pool e)]
-           ; Wait for futures.
-           a' => truthy
-           b' => truthy
-           c' => truthy
-           d' => truthy
-           e' => nil
+        b' (p/invalidate pool b)
+        c  (p/claim pool 1)
+        d  (p/claim pool 1)
+        e  (try (p/claim pool 1) (catch Exception e nil))
+        c' (p/invalidate pool c)
+        d' (p/invalidate pool d)
+        ;; Invalidate nil should be a noop
+        e' (p/invalidate pool e)]
+    ;; Wait for futures.
+    a' => truthy
+    b' => truthy
+    c' => truthy
+    d' => truthy
+    e' => nil

-           (dorun (map deref [a' b' c' d']))
+    (dorun (map deref [a' b' c' d']))

-           a => 1
-           b => 2
-           #{a b c d} #{1 2 3 4}
-           e => nil
-           ; Should have opened twice to start and 4 times after invalidations.
-           @x => 6))
+    a => 1
+    b => 2
+    #{a b c d} #{1 2 3 4}
+    e => nil
+    ;; Should have opened twice to start and 4 times after invalidations.
+    @x => 6))

 (facts "about with-pool macro"
-         (let [x (atom 0)
-               pool (p/fixed-pool #(swap! x inc) {:size 1 :block-start true})]
+  (let [x (atom 0)
+        pool (p/fixed-pool #(swap! x inc) {:size 1 :block-start true})]

-           ; Regular claim
-           (let [a (p/with-pool [a pool] a)]
-             a => 1
-             @x => 1)
+    ;; Regular claim
+    (let [a (p/with-pool [a pool] a)]
+      a => 1
+      @x => 1)

-           ; With-pool should have released.
-           (let [a (p/claim pool)]
-             a => 1
-             (p/release pool a))
+    ;; With-pool should have released.
+    (let [a (p/claim pool)]
+      a => 1
+      (p/release pool a))

-           ; Throwing errors
-           (p/with-pool [b pool]
-             b => 1
-             (throw (RuntimeException. "whoops")))
-           => (throws RuntimeException)
+    ;; Throwing errors
+    (p/with-pool [b pool]
+      b => 1
+      (throw (RuntimeException. "whoops")))
+    => (throws RuntimeException)

-           ; Pool should have regenerated.
-           (Thread/sleep 250)
-           @x => 2))+    ;; Pool should have regenerated.
+    (Thread/sleep 250)
+    @x => 2))


test shuppet customization

test shuppet customization

--- test/shuppet/unit/core_shuppet.clj
+++ test/shuppet/unit/core_shuppet.clj
@@ -2,3 +2,26 @@
   (:require  [slingshot.slingshot :refer [try+ throw+]])
   (:use [shuppet.core-shuppet]
         [midje.sweet]))
+
+(deftype TestAppNames []
+  ApplicationNames
+  (list-names
+    [_]
+    ["test-app"]))
+
+(deftype TestConfig []
+  Configuration
+  (as-string
+    [_ environment name]
+    "this is a test config"))
+
+(def configuration @#'shuppet.core-shuppet/configuration)
+
+(fact-group :unit
+            (fact "app list can be customized"
+                  (binding [*application-names*  (TestAppNames.)]
+                    (app-names) => ["test-app"]))
+
+            (fact "configuration source can be customized"
+                  (binding [*configuration*  (TestConfig.)]
+                    (configuration ..env.. ..name..) => "this is a test config")))


no need for loader channel

no need for loader channel

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -62,19 +62,6 @@
 (defonce scroll-text
   (font/make-text "100 24px Indie Flower"
                   "Old School Demo on a New School platform??! Crispin, here, paying homage to the 8-bit and 16-bit wonderboxes of our childhood. Commodore lives! A big shout out to Team Farnarkle and to the Inversion crew. Best wishes to everyone out there and enjoy the games!\n"))
-
-;;
-;; font preloader channel
-;;
-(defonce render! (go
-                   ;(<! (events/wait-time 100))
-                   ;(sprite/set-pos! dummy-text -100000 -10000)
-                   (sprite/set-pos! test-text 0 0)
-                   ;(.addChild (-> canvas :layer :ui) dummy-text)
-                   ;(<! (events/next-frame))
-                   ;(.removeChild (-> canvas :layer :ui) dummy-text)
-                   (<! (events/next-frame))))
-

 ;;
 ;; experimental shaders


clear board

clear board


Login on arrival

Login on arrival

--- src/trak/routes.cljs
+++ src/trak/routes.cljs
@@ -64,5 +64,6 @@

 (defmethod handler :index [path route-params]
   (utils/info ["Handled path " path route-params])
+  (pubsub/publish :actions {:action :login-on-arrival})
   ;(pubsub/publish :actions {:action :find-albums})
   )


Minor optimization to threads view

Minor optimization to threads view

--- src/braid/core/client/ui/views/threads.cljs
+++ src/braid/core/client/ui/views/threads.cljs
@@ -80,7 +80,7 @@

        :component-did-mount
        (fn [this]
-         (update-threads! (props :threads))
+         (reset-threads! (props :threads))
          (reset! this-elt (r-dom/dom-node this)))

        :component-did-update


add comments to slide actions

add comments to slide actions

--- src/solar_system_of_js/core.cljs
+++ src/solar_system_of_js/core.cljs
@@ -415,11 +415,16 @@
 (def slide-actions
   "Actions to take for each slide."
   (vec (flatten
-    [nil ;; no action for first slide
+    [;; no action for first slide
+     nil
+
+     ;; slide in the JS logo
      #(go
         (<! (multi-animate!
               {:a :_ :b 0 :duration 1} [:js-face :x]
               {:a :_ :b 0 :duration 0.4} [:title :alpha])))
+
+     ;; peel back JS logo to see its layers
      #(go
         (<! (multi-animate!
               {:a :_ :b 400 :duration 2} [:cam :x]
@@ -429,8 +434,10 @@
               {:a :_ :b 0 :duration 2} [:js-face :alpha]
               {:a :_ :b 1 :duration 1} [:js-core :alpha]
               {:a :_ :b 2 :duration 2} [:cam :zoom])))
-     (let [t 0.01
-           low 0]
+
+     ;; highlight individual JS versions
+     (let [t 0.01 ;; time between each transition
+           low 0] ;; visited version alpha (faded out)
        [
         #(go
            (<! (animate!
@@ -452,6 +459,8 @@
                  {:a :_ :b low :duration t} [:es-captions :es7 :alpha]
                  {:a :_ :b 1 :duration t} [:es-captions :es8 :alpha])))
         ])
+
+     ;; flash all layers and show transpiler
      #(go
         (swap! state assoc-in [:transpiler :highlight] true)
         (let [chans [(multi-animate!
@@ -469,6 +478,8 @@
                          (<! (timeout 70))))]]
           (doseq [c chans]
             (<! c))))
+
+     ;; show linter
      #(go
         (swap! state assoc-in [:transpiler :highlight] false)
         (swap! state assoc-in [:linter :highlight] true)
@@ -476,6 +487,8 @@
               {:a :_ :b 1 :duration 1} [:linter :alpha]
               {:a :_ :b 1 :duration 1} [:linter :font-alpha]
               {:a :_ :b 450 :duration 1} [:linter :x])))
+
+     ;; show module sys
      #(go
         (swap! state assoc-in [:linter :highlight] false)
         (swap! state assoc-in [:modulesys :highlight] true)
@@ -483,6 +496,8 @@
               {:a :_ :b 1 :duration 1} [:modulesys :alpha]
               {:a :_ :b 1 :duration 1} [:modulesys :font-alpha]
               {:a :_ :b 450 :duration 1} [:modulesys :x])))
+
+     ;; put JS back together, showing it required tools
      #(go
         (swap! state assoc-in [:modulesys :highlight] false)
         (let [t 2]
@@ -501,6 +516,7 @@
                 {:a :_ :b 0 :duration t} [:cam :x]
                 {:a :_ :b 0 :duration t} [:cam :y]
                 ))))
+
      ])))

 (def num-slides


Clean up `add-report!` function

Clean up `add-report!` function

This commit just does some destructuring in the argument list
to make the function a little easier on the eyes.

--- src/com/puppetlabs/puppetdb/scf/storage.clj
+++ src/com/puppetlabs/puppetdb/scf/storage.clj
@@ -674,23 +674,27 @@

 (defn add-report!
   "Add a report and all of the associated events to the database."
-  [report report-id timestamp]
+  [{:keys [puppet-version certname report-format configuration-version
+           start-time end-time resource-events]
+    :as report}
+   report-id
+   timestamp]
   {:pre [(map? report)
          (string? report-id)
          (utils/datetime? timestamp)]}
   (let [resource-event-rows
           (map #(report/resource-event-to-jdbc
                   (assoc % :report-id report-id))
-               (:resource-events report))]
+               resource-events)]
     (time! (:store-report metrics)
       (sql/transaction
         (sql/insert-record :reports
-          { :id report-id
-            :puppet_version (:puppet-version report)
-            :certname (:certname report)
-            :report_format (:report-format report)
-            :configuration_version (:configuration-version report)
-            :start_time (to-timestamp (:start-time report))
-            :end_time (to-timestamp (:end-time report))
-            :receive_time (to-timestamp timestamp)})
+          { :id                     report-id
+            :puppet_version         puppet-version
+            :certname               certname
+            :report_format          report-format
+            :configuration_version  configuration-version
+            :start_time             (to-timestamp start-time)
+            :end_time               (to-timestamp end-time)
+            :receive_time           (to-timestamp timestamp)})
         (apply sql/insert-records :resource_events resource-event-rows)))))


CRM-3048: Reverted version of AWS java sdk

--- message-queue-lib/project.clj
+++ message-queue-lib/project.clj
@@ -7,7 +7,7 @@
                  [nasa-cmr/cmr-transmit-lib "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-acl-lib "0.1.0-SNAPSHOT"]
                  [com.novemberain/langohr "3.4.0"]
-                 [com.amazonaws/aws-java-sdk "1.11.92"]]
+                 [com.amazonaws/aws-java-sdk "1.10.60"]]

   :plugins [[test2junit "1.2.1"]]
   :jvm-opts ^:replace ["-server"


[scamp] rename WorldConfigSchema to ClusterConfigSchema

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -84,14 +84,14 @@
 (def SubscriptionSchema
   NodeContactAddressSchema)

-(def WorldConfigSchema
+(def ClusterConfigSchema
   {:connection-redundancy s/Int
    :message-dup-drop-after s/Int
    :logging {s/Keyword s/Any}})

 (def WorldSchema
   {:message-envelopes [MessageEnvelopeSchema]
-   :config WorldConfigSchema
+   :config ClusterConfigSchema
    :network {NodeContactAddressSchema NetworkedNodeSchema}})

 (def CommUpdateSchema
@@ -111,7 +111,7 @@
 ;; Defaults and samples
 (def default-config
   (s/validate
-   WorldConfigSchema
+   ClusterConfigSchema
    {;; :c :connection-redundancy
     :connection-redundancy 2 ;; Emperically determined by [1]
     :message-dup-drop-after 10 ;; Empirically determined by [1]


[scamp] allow nil destination addrs in CommUpdateSchema

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -77,7 +77,7 @@
    :network {NodeContactAddressSchema NetworkedNodeSchema}})

 (def CommUpdateSchema
-  [(s/one NetworkedNodeSchema "networked node (recipient of processed message)")
+  [(s/one (s/maybe NetworkedNodeSchema) "networked node (recipient of processed message)")
    ;; zereo or more new messages
    [MessageEnvelopeSchema]])


use babel.directory to get grammar rather than creating anew

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -2,7 +2,7 @@
   (:refer-clojure :exclude [assoc-in get-in])
   (:require [babel.directory :refer [models]]
             [babel.english :refer [analyze fo-ps lookup generate
-                                   medium morph parse sentences]]
+                                   morph parse sentences]]
             [babel.english.grammar :as grammar :refer [head-first head-last]]
             [babel.english.morphology :refer [get-string]]

@@ -23,6 +23,8 @@
             #?(:clj [clojure.tools.logging :as log])
             #?(:cljs [babel.logjs :as log])
             [dag_unify.core :refer [assoc-in dissoc-paths fail? fail-path-between get-in strip-refs unify]]))
+
+(def model @((get models :en)))

 (defn display-expression [expr]
   {:en (morph expr)
@@ -322,10 +324,9 @@
            "the chair is in front of itself"))))

 (deftest infinitive-vp
-  (let [medium (medium)
-        vp-infinitive (:vp-infinitive (:grammar-map medium))
+  (let [vp-infinitive (:vp-infinitive (:grammar-map model))
         expr (-> vp-infinitive
-                 (overh (get (:lexicon medium) "speak"))
+                 (overh (get (:lexicon model) "speak"))
                  (overc (generate {:synsem {:sem {:pred :word
                                                   :mod '()
                                                   :spec {:def :def
@@ -386,7 +387,7 @@
 ;; less susceptible to the problems for which it was
 ;; added.
 (deftest rathole-check-2
-  (let [med (medium)
+  (let [med model
         spec {:synsem {:cat :verb
                        :sem {:pred :read
                              :subj {:pred :woman}}
@@ -562,7 +563,7 @@
     (is (= "I am eating (right now)" (morph (generate progressive))))))

 (deftest benchmark-test []
-  (let [med (medium)
+  (let [med model
         to-run #(time (println (morph (generate
                                        {:synsem {:cat :verb, :sem {:pred :read
                                                                    :subj {:pred :woman}}
@@ -655,8 +656,6 @@
          (= "the woman that she sees"
             (morph result))))))

-(def model (medium))
-
 (def spec
   {:synsem {:cat :verb
             :sem {:pred :sleep


break out (and (is ...) (is ...) ) into individual tests

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -412,34 +412,34 @@
          "dopo ventotto anni ostana ha un cittadino neonato")))

 (deftest parse-long-sentence
-  (let [result (parse "dopo ventotto anni ostana ha un cittadino neonato")]
-    (is (not (empty? (mapcat :parses result))))
-    (is (not (nil?
-              (some
-               #(and (= :have (get-in % [:pred]))
-                     (= :newborn (get-in % [:obj :pred]))
-                     (= :ostana (get-in % [:subj :pred]))
-                     (= :after (get-in % [:mod :pred]))
-                     (= :year (get-in % [:mod :obj :pred]))
-                     (= :twentyeight (get-in % [:mod :obj :spec :def])))
-               (map (fn [parse]
-                      (get-in parse [:synsem :sem]))
-                    (mapcat :parses result))))))))
+  (let [result (parse "dopo ventotto anni ostana ha un cittadino neonato")
+        parses (mapcat :parses result)
+        semantics
+        (map (fn [parse]
+               (get-in parse [:synsem :sem]))
+             parses)]
+    (is (not (empty? parses)))
+    (is (not (nil? (some #(= :have (get-in % [:pred])) semantics))))
+    (is (not (nil? (some #(= :newborn (get-in % [:obj :pred])) semantics))))
+    (is (not (nil? (some #(= :ostana (get-in % [:subj :pred])) semantics))))
+    (is (not (nil? (some #(= :after (get-in % [:mod :pred])) semantics))))
+    (is (not (nil? (some #(= :year (get-in % [:mod :obj :pred])) semantics))))
+    (is (not (nil? (some #(= :twentyeight (get-in % [:mod :obj :spec :def])) semantics))))))

 (deftest parse-long-sentence-with-punctuation
-  (let [result (parse "Dopo ventotto anni, Ostana ha un cittadino neonato.")]
-    (is (not (empty? (mapcat :parses result))))
-    (is (not (nil?
-              (some
-               #(and (= :have (get-in % [:pred]))
-                     (= :newborn (get-in % [:obj :pred]))
-                     (= :ostana (get-in % [:subj :pred]))
-                     (= :after (get-in % [:mod :pred]))
-                     (= :year (get-in % [:mod :obj :pred]))
-                     (= :twentyeight (get-in % [:mod :obj :spec :def])))
-               (map (fn [parse]
-                      (get-in parse [:synsem :sem]))
-                    (mapcat :parses result))))))))
+  (let [result (parse "Dopo ventotto anni, Ostana ha un cittadino neonato.")
+        parses (mapcat :parses result)
+        semantics
+        (map (fn [parse]
+               (get-in parse [:synsem :sem]))
+             parses)]
+    (is (not (empty? parses)))
+    (is (not (nil? (some #(= :have (get-in % [:pred])) semantics))))
+    (is (not (nil? (some #(= :newborn (get-in % [:obj :pred])) semantics))))
+    (is (not (nil? (some #(= :ostana (get-in % [:subj :pred])) semantics))))
+    (is (not (nil? (some #(= :after (get-in % [:mod :pred])) semantics))))
+    (is (not (nil? (some #(= :year (get-in % [:mod :obj :pred])) semantics))))
+    (is (not (nil? (some #(= :twentyeight (get-in % [:mod :obj :spec :def])) semantics))))))

 (deftest davanti-il-tavolo
   (let [parse-result (mapcat :parses (parse "davanti il tavolo"))


convert longs to doubles, transit-js passes all tests now

--- test/transit/verify.clj
+++ test/transit/verify.clj
@@ -129,7 +129,9 @@

 (defn equalize [data]
   (walk/prewalk (fn [node]
-                  (cond (instance? java.math.BigDecimal node)
+                  (cond (instance? java.lang.Long node)
+                        (.doubleValue node)
+                        (instance? java.math.BigDecimal node)
                         (.stripTrailingZeros node)
                         (instance? java.util.Map$Entry node)
                         node


Changed to use collection checkers.

Changed to use collection checkers.

--- examples/adder-webapp/test/adder/core_test.clj
+++ examples/adder-webapp/test/adder/core_test.clj
@@ -10,32 +10,23 @@
   "view-output"
   (view-output 1 2 3) => (contains #"two numbers added"))

-;; Approximately one zillion facts will need to check both the
-;; response code and the content of the resulting body, so I make
-;; a custom checker. For other kinds of custom checkers, see
-;; examples/compound-checkers.
-
-(defmacro successful-page-containing [regexp]
-  `(fn [response#]
-     (and
-      (expect (:status response#) => 200)
-      (expect (:body response#) => (contains ~regexp)))
-     true))
-
 (facts "about the main page"
   "Bare request produces prompt"
   (handler {:uri "/" :request-method :get})
-  => (successful-page-containing #"add two numbers")
+  => (contains {:status 200
+                :body #"add two numbers"})

   "Valid numbers produce sum"
   (handler {:uri "/" :request-method :post :params {"a" "1" "b" "2"}})
-  => (successful-page-containing #"1 \+ 2 = 3")
+  => (contains {:status 200
+                :body #"1 \+ 2 = 3"})

   "Non-numbers produce error message"
   (handler {:uri "/" :request-method :post :params {"a" "2" "b" "f"}})
-  => (successful-page-containing #"those are not both numbers"))
+  => (contains {:status 200
+                :body #"those are not both numbers"}))

 (fact "Other pages produce redirect"
-  (let [response (handler {:uri "/anything" :request-method :get})]
-    (:status response) => 302
-    (get-in response [:headers "Location"]) => "/"))
+  (handler {:uri "/anything" :request-method :get})
+  => (contains {:status 302,
+                :headers (contains {"Location" "/"})}))


better

better

--- exercism/clojure/robot-name/src/robot_name.clj
+++ exercism/clojure/robot-name/src/robot_name.clj
@@ -1,13 +1,14 @@
-(ns robot-name)
+(ns robot-name
+  (:require [clojure.string :refer [join]]))

 (defn- rand-char []
-  (rand-nth "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+  (char (+ (rand-int 26) (int \A))))

 (defn- rand-digit []
   (str (rand-int 10)))

 (defn- new-name []
-  (str (rand-char) (rand-char) (rand-digit) (rand-digit) (rand-digit)))
+  (join (concat (repeatedly 2 rand-char) (repeatedly 3 rand-digit))))

 (defn robot []
   (atom (new-name)))


eastwood

eastwood

--- src/open_company/api/companies.clj
+++ src/open_company/api/companies.clj
@@ -1,6 +1,5 @@
 (ns open-company.api.companies
-  (:require [defun :refer (defun)]
-            [compojure.core :refer (defroutes ANY OPTIONS GET POST)]
+  (:require [compojure.core :refer (defroutes ANY OPTIONS GET POST)]
             [liberator.core :refer (defresource by-method)]
             [clojure.set :as cset]
             [schema.core :as s]


Small correction to run 0033 with "lein run"

--- src/project_euler/problem_0033.clj
+++ src/project_euler/problem_0033.clj
@@ -1,4 +1,4 @@
-(ns project-euler.problem-0033)
+(ns project-euler.problem_0033)

 ;; The fraction 49/98 is a curious fraction, as an inexperienced mathematician
 ;; in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which is correct,


Add dismissable conditional

Add dismissable conditional

--- src-cljs/frontend/components/dashboard.cljs
+++ src-cljs/frontend/components/dashboard.cljs
@@ -93,7 +93,7 @@
                 (when (and (feature/enabled? :build-diagnostics)
                            project)
                   (om/build build-diagnostics {:data data :project project}))
-                (when (and plan (project-common/show-trial-notice? project plan))
+                (when (and plan (project-common/show-trial-notice? project plan) (not (get-in data state/dismissed-trial-update-banner) ))
                   [:div.container-fluid
                    [:div.row
                     [:div.col-xs-12


fix nudging paths

fix nudging paths

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -225,6 +225,10 @@
           :ry (+ ry move-y)})
        points))

+(defn parse-points-from-path [path]
+  (let [points (map js/parseInt (str/split (subs path 1) #" "))]
+    (map (fn [[rx ry]] {:rx rx :ry ry}) (partition 2 points))))
+
 (defn nudge-layer [layer {:keys [x y]}]
   (-> layer
     (select-keys [:db/id
@@ -236,7 +240,7 @@
     (update-in [:layer/start-y] + y)
     (update-in [:layer/end-y] + y)
     (cond-> (= :layer.type/path (:layer/type layer))
-      (assoc :layer/path (svg/points->path (nudge-points (:points layer) x y))))))
+      (assoc :layer/path (svg/points->path (nudge-points (parse-points-from-path (:layer/path layer)) x y))))))

 (defn nudge-shapes [state direction]
   (let [db (:db state)
@@ -341,10 +345,6 @@
     (do
       (utils/mlog "Called update-mouse without x and y coordinates")
       state)))
-
-(defn parse-points-from-path [path]
-  (let [points (map js/parseInt (str/split (subs path 1) #" "))]
-    (map (fn [[rx ry]] {:rx rx :ry ry}) (partition 2 points))))

 (defn handle-drawing-started [state x y]
   (let [[rx ry] (cameras/screen->point (:camera state) x y)


fix z drive problem

fix z drive problem

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -1,706 +1,708 @@
-; FILE:         acq_engine.clj
-; PROJECT:      Micro-Manager
-; SUBSYSTEM:    mmstudio acquisition engine
-; ----------------------------------------------------------------------------
-; AUTHOR:       Arthur Edelstein, arthuredelstein@gmail.com, Dec 14, 2010
-;               Adapted from the acq eng by Nenad Amodaj and Nico Stuurman
-; COPYRIGHT:    University of California, San Francisco, 2006-2011
-; LICENSE:      This file is distributed under the BSD license.
-;               License text is included with the source distribution.
-;               This file is distributed in the hope that it will be useful,
-;               but WITHOUT ANY WARRANTY; without even the implied warranty
-;               of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-;               IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-;               CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-;               INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES.
-
-(ns org.micromanager.acq-engine
-  (:use [org.micromanager.mm :only [when-lets map-config get-config get-positions load-mm
-                                    get-default-devices core log log-cmd mmc gui with-core-setting
-                                    do-when if-args get-system-config-cached select-values-match?
-                                    get-property get-camera-roi parse-core-metadata]]
-        [org.micromanager.sequence-generator :only [generate-acq-sequence]])
-  (:import [org.micromanager AcqControlDlg]
-           [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
-           [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcqDisplay TaggedImageQueue
-                                         ProcessorStack SequenceSettings MMImageCache
-                                         TaggedImageStorageRam VirtualAcquisitionDisplay]
-           [org.micromanager.navigation MultiStagePosition StagePosition]
-           [mmcorej TaggedImage Configuration Metadata]
-           [java.util.prefs Preferences]
-           [java.net InetAddress]
-           [java.util.concurrent TimeUnit CountDownLatch]
-           [org.micromanager.utils ChannelSpec GentleLinkedBlockingQueue MDUtils
-                                   ReportingUtils]
-           [org.json JSONObject JSONArray]
-           [java.util Date UUID]
-           [java.text SimpleDateFormat]
-           [javax.swing SwingUtilities]
-           [ij ImagePlus])
-   (:gen-class
-     :name org.micromanager.AcqEngine
-     :implements [org.micromanager.api.Pipeline]
-     :init init
-     :state state))
-
-;; constants
-
-(def run-devices-parallel false)
-
-;; general utils
-
-(defn data-object-to-map [obj]
-  (into {}
-    (for [f (.getFields (type obj))
-          :when (zero? (bit-and
-                         (.getModifiers f) java.lang.reflect.Modifier/STATIC))]
-      [(keyword (.getName f)) (.get f obj)])))
-
-(defmacro apply* [& args]
-  `(~@(butlast args) ~@(eval (last args))))
-
-(defn rekey
-  ([m kold knew]
-    (-> m (dissoc kold) (assoc knew (get m kold))))
-  ([m kold knew & ks]
-    (reduce #(apply rekey %1 %2)
-      m (partition 2 (conj ks knew kold)))))
-
-(defn select-and-rekey [m & ks]
-    (apply rekey (select-keys m (apply concat (partition 1 2 ks))) ks))
-
-(defn clock-ms []
-  (quot (System/nanoTime) 1000000))
-
-;; mm utils
-
-(def iso8601modified (SimpleDateFormat. "yyyy-MM-dd HH:mm:ss Z"))
-
-(defn get-current-time-str []
-  (. iso8601modified format (Date.)))
-
-(defn get-pixel-type []
-  (str ({1 "GRAY", 4 "RGB"} (int (core getNumberOfComponents))) (* 8 (core getBytesPerPixel))))
-
-(defn ChannelSpec-to-map [^ChannelSpec chan]
-  (-> chan
-    (data-object-to-map)
-    (select-and-rekey
-      :config_                 :name
-      :exposure_               :exposure
-      :zOffset_                :z-offset
-      :doZStack_               :use-z-stack
-      :skipFactorFrame_        :skip-frames
-      :useChannel_             :use-channel
-      :color_                  :color
-    )
-    (assoc :properties (get-config (core getChannelGroup) (.config_ chan)))))
-
-(defn MultiStagePosition-to-map [^MultiStagePosition msp]
-  (if msp
-    {:label (.getLabel msp)
-     :axes
-        (into {}
-          (for [i (range (.size msp))]
-            (let [stage-pos (.get msp i)]
-              [(.stageName stage-pos)
-                (condp = (.numAxes stage-pos)
-                  1 [(.x stage-pos)]
-                  2 [(.x stage-pos) (.y stage-pos)])])))}))
-
-(defn get-msp [idx]
-  (when idx
-    (let [p-list (. gui getPositionList)]
-      (if (pos? (. p-list getNumberOfPositions))
-        (. p-list (getPosition idx))))))
-
-(defn get-z-position [idx z-stage]
-  (if-let [msp (get-msp idx)]
-    (if-let [stage-pos (. msp get z-stage)]
-      (. stage-pos x))))
-
-(defn set-z-position [idx z-stage z]
-  (if-let [msp (get-msp idx)]
-    (if-let [stage-pos (. msp (get z-stage))]
-      (set! (. stage-pos x) z))))
-
-;; globals
-
-(def state (atom {:running false :stop false}))
-
-(defn state-assoc! [& args]
-  (apply swap! state assoc args))
-
-(def attached-runnables (atom (vec nil)))
-
-;; metadata
-
-(defn json-to-data [json]
-  (condp #(isa? (type %2) %1) json
-    JSONObject
-      (let [keys (iterator-seq (.keys json))]
-        (into {}
-          (for [key keys]
-            (let [val (if (.isNull json key) nil (.get json key))]
-              [key (json-to-data val)]))))
-    JSONArray
-      (vec
-        (for [i (range (.length json))]
-          (json-to-data (.get json i))))
-    json))
-
-(defn compute-time-from-core [tags]
-  ; (log "core tags: " tags)
-  (when (@state :burst-init-time)
-    (when-let [t (tags "ElapsedTime-ms")]
-      (+ (Double/parseDouble t)
-         (@state :burst-init-time)))))
-
-(defn elapsed-time [state]
-  (if (state :start-time) (- (clock-ms) (state :start-time)) 0))
-
-(defn annotate-image [img event state]
-  ;(println event)
-  {:pix (:pix img)
-   :tags (merge
-      (map-config (core getSystemStateCache))
-      {
-       "AxisPositions" (when-let [axes (get-in event [:position :axes])] (JSONObject. axes))
-       "Binning" (state :binning)
-       "BitDepth" (state :bit-depth)
-       "Channel" (get-in event [:channel :name])
-       "ChannelIndex" (:channel-index event)
-       "ElapsedTime-ms" (elapsed-time state)
-       "Exposure-ms" (:exposure event)
-       "Frame" (:frame-index event)
-       "Height" (state :init-height)
-       "NextFrame" (:next-frame-index event)
-       "PixelSizeUm" (state :pixel-size-um)
-       "PixelType" (state :pixel-type)
-       "PositionIndex" (:position-index event)
-       "PositionName" (if-let [pos (:position event)] (if-args #(.getLabel %) (get-msp pos)))
-       "Slice" (:slice-index event)
-       "SlicePosition" (:slice event)
-       "Source" (state :source)
-       "Time" (get-current-time-str)
-       "UUID" (UUID/randomUUID)
-       "Width"  (state :init-width)
-       "ZPositionUm" (state :last-z-position)
-      }
-       (:tags img))})
-
-(defn make-TaggedImage [annotated-img]
-  (TaggedImage. (:pix annotated-img) (JSONObject. (:tags annotated-img))))
-
-;; acq-engine
-
-(defn await-resume []
-  (while (and (:pause @state) (not (:stop @state))) (Thread/sleep 5)))
-
-(defn interruptible-sleep [time-ms]
-  (let [sleepy (CountDownLatch. 1)]
-    (state-assoc! :sleepy sleepy :next-wake-time (+ (clock-ms) time-ms))
-    (.await sleepy time-ms TimeUnit/MILLISECONDS)))
-
-(defn acq-sleep [interval-ms]
-  (when (and (@state :init-continuous-focus)
-             (not (core isContinuousFocusEnabled)))
-    (core enableContinuousFocus true))
-  (let [target-time (+ (@state :last-wake-time) interval-ms)
-        delta (- target-time (clock-ms))]
-    (when (pos? delta)
-      (interruptible-sleep delta))
-    (await-resume)
-    (let [now (clock-ms)
-          wake-time (if (> now (+ target-time 10)) now target-time)]
-      (state-assoc! :last-wake-time wake-time))))
-
-(declare device-agents)
-
-(defn wait-for-device [dev]
-  (when (and dev (pos? (.length dev)))
-    (core waitForDevice dev)))
-
-(defn create-device-agents []
-  (def device-agents
-    (let [devs (seq (core getLoadedDevices))]
-      (zipmap devs (repeatedly (count devs) #(agent nil))))))
-
-(defn get-z-stage-position [stage]
-  (when-not (empty? stage) (core getPosition stage) 0))
-
-(defn set-z-stage-position [stage pos]
-  (when (core isContinuousFocusEnabled)
-    (core enableContinuousFocus false))
-  (when-not (empty? stage) (core setPosition stage pos)))
-
-(defn set-stage-position
-  ([stage-dev z]
-    (when (not= z (:last-z-position @state))
-      (set-z-stage-position stage-dev z)
-      (state-assoc! :last-z-position z)))
-  ([stage-dev x y]
-    (when (and x y
-               (not= [x y] (:last-xy-position @state)))
-      (core setXYPosition stage-dev x y)
-      (state-assoc! :last-xy-position [x y]))))
-
-(defn set-property
-  ([prop] (core setProperty (prop 0) (prop 1) (prop 2))))
-
-(defn send-device-action [dev action]
-  (send-off (device-agents dev) (fn [_] (action))))
-
-(defn create-presnap-actions [event]
-  (concat
-    (for [[axis pos] (:axes (MultiStagePosition-to-map (get-msp (:position event)))) :when pos]
-      [axis #(apply set-stage-position axis pos)])
-    (for [prop (get-in event [:channel :properties])]
-      [(prop 0) #(core setProperty (prop 0) (prop 1) (prop 2))])
-    (when-let [exposure (:exposure event)]
-      (list [(core getCameraDevice) #(core setExposure exposure)]))))
-
-(defn run-actions [action-map]
-  (if run-devices-parallel
-    (do
-      (doseq [[dev action] action-map]
-        (send-device-action dev action))
-      (doseq [dev (keys action-map)]
-        (send-device-action dev #(core waitForDevice dev)))
-      (doall (map (partial await-for 10000) (vals device-agents))))
-    (do
-      (doseq [[dev action] action-map]
-        (action) (wait-for-device dev)))))
-
-(defn run-autofocus []
-  (.. gui getAutofocusManager getDevice fullFocus)
-  (log "running autofocus " (.. gui getAutofocusManager getDevice getDeviceName))
-  (state-assoc! :reference-z-position (core getPosition (core getFocusDevice))))
-
-(defn snap-image [open-before close-after]
-  (with-core-setting [getAutoShutter setAutoShutter false]
-    (if open-before
-      (core setShutterOpen true)
-      (wait-for-device (core getShutterDevice)))
-    (core snapImage)
-    (if close-after
-      (core setShutterOpen false))
-      (wait-for-device (core getShutterDevice))))
-
-(defn init-burst [length]
-  (core setAutoShutter (@state :init-auto-shutter))
-  (swap! state assoc :burst-init-time (elapsed-time @state))
-  (core startSequenceAcquisition length 0 true))
-
-(defn expose [event]
-  (do (condp = (:task event)
-    :snap (snap-image true (:close-shutter event))
-    :init-burst (init-burst (:burst-length event))
-    nil)))
-
-(defn collect-burst-image []
-  (while (and (core isSequenceRunning) (zero? (core getRemainingImageCount)))
-    (Thread/sleep 5))
-  (let [md (Metadata.)
-        pix (core popNextImageMD md)
-        tags (parse-core-metadata md)
-        t (compute-time-from-core tags)
-        tags (if (and t (pos? t))
-               (assoc tags "ElapsedTime-ms" t)
-               (dissoc tags "ElapsedTime-ms"))]
-   ; (println "cam-t: " t ", collect-t: " (elapsed-time @state)
-   ;      ", remaining-images: " (core getRemainingImageCount))
-    {:pix pix :tags (dissoc tags "StartTime-ms")}))
-
-(defn collect-snap-image []
-  {:pix (core getImage) :tags nil})
-
-(defn collect-image [event out-queue]
-  (let [image (condp = (:task event)
-                :snap (collect-snap-image)
-                :init-burst (collect-burst-image)
-                :collect-burst (collect-burst-image))]
-    (if (. mmc isBufferOverflowed)
-      (do (swap! state assoc :stop true)
-          (ReportingUtils/showError "Circular buffer overflowed."))
-      (do (log "collect-image: "
-               (select-keys event [:position-index :frame-index
-                                   :slice-index :channel-index]))
-          (.put out-queue
-                (make-TaggedImage (annotate-image image event @state)))))))
-
-(defn compute-z-position [event]
-  (if-let [z-drive (:z-drive event)]
-    (+ (or (get-in event [:channel :z-offset]) 0)
-       (or (:slice event) 0)
-       (if (and (:slice event) (not (:relative-z event)))
-         0
-         (or (get-z-position (:position event) z-drive)
-             (@state :reference-z-position))))))
-
-(defn make-event-fns [event out-queue]
-  (let [task (:task event)]
-    (cond
-      (= task :collect-burst)
-        (list #(collect-image event out-queue))
-      (or (= task :snap) (= task :init-burst))
-        (list
-          #(log event)
-          (fn [] (doall (map #(.run %) (event :runnables))))
-          #(when-let [wait-time-ms (event :wait-time-ms)]
-            (acq-sleep wait-time-ms))
-          #(run-actions (create-presnap-actions event))
-          #(await-for 10000 (device-agents (core getCameraDevice)))
-          #(when (:autofocus event)
-            (set-z-position (:position event) (:z-drive event) (run-autofocus)))
-          #(when-let [z-drive (:z-drive event)]
-            (let [z (compute-z-position event)]
-              (when (not= z (@state :last-z-position))
-                (do (set-stage-position z-drive z)
-                    (wait-for-device z-drive)))))
-          #(do (expose event)
-               (collect-image event out-queue))))))
-
-(defn execute [event-fns]
-  (doseq [event-fn event-fns :while (not (:stop @state))]
-    (try (event-fn) (catch Throwable e (ReportingUtils/logError e)))
-    (await-resume)))
-
-(defn return-config []
-  (dorun (map set-property
-    (clojure.set/difference
-      (set (@state :init-system-state))
-      (set (get-system-config-cached))))))
-
-(defn cleanup []
-  (log "cleanup")
-  (do-when #(.update %) (:display @state))
-  (state-assoc! :finished true, :running false, :display nil)
-  (when (core isSequenceRunning)
-    (core stopSequenceAcquisition))
-  (core setAutoShutter (@state :init-auto-shutter))
-  (core setExposure (@state :init-exposure))
-  (when (not= (@state :last-z-position) (@state :init-z-position))
-    (set-z-stage-position (core getFocusDevice) (@state :init-z-position)))
-  (when (and (@state :init-continuous-focus)
-             (not (core isContinuousFocusEnabled)))
-    (core enableContinuousFocus true))
-  (return-config))
-
-(defn prepare-state [this]
-  (let [z (get-z-stage-position (core getFocusDevice))]
-    (swap! (.state this) assoc
-      :pause false
-      :stop false
-      :running true
-      :finished false
-      :last-wake-time (clock-ms)
-      :last-z-position z
-      :last-xy-position nil
-      :reference-z-position z
-      :start-time (clock-ms)
-      :init-auto-shutter (core getAutoShutter)
-      :init-exposure (core getExposure)
-      :init-z-position z
-      :init-system-state (get-system-config-cached)
-      :init-continuous-focus (core isContinuousFocusEnabled)
-      :init-width (core getImageWidth)
-      :init-height (core getImageHeight)
-      :binning (core getProperty (core getCameraDevice) "Binning")
-      :bit-depth (core getImageBitDepth)
-      :pixel-size-um (core getPixelSizeUm)
-      :source (core getCameraDevice)
-      :pixel-type (get-pixel-type)
-      )))
-
-(defn run-acquisition [this settings out-queue]
-  (def acq-settings settings)
-  (prepare-state this)
-  (binding [state (.state this)]
-    (def last-state state)
-    (let [acq-seq (generate-acq-sequence settings @attached-runnables)]
-       (def acq-sequence acq-seq)
-       (execute (mapcat #(make-event-fns % out-queue) acq-seq))
-       (.put out-queue TaggedImageQueue/POISON)
-       (cleanup))))
-
-(defn convert-settings [^SequenceSettings settings]
-  (-> settings
-    (data-object-to-map)
-    (rekey
-      :slicesFirst             :slices-first
-      :timeFirst               :time-first
-      :keepShutterOpenSlices   :keep-shutter-open-slices
-      :keepShutterOpenChannels :keep-shutter-open-channels
-      :useAutofocus            :use-autofocus
-      :skipAutofocusCount      :autofocus-skip
-      :relativeZSlice          :relative-slices
-      :intervalMs              :interval-ms
-      :slices                  :slices
-    )
-    (assoc :frames (range (.numFrames settings))
-           :channels (filter :use-channel (map ChannelSpec-to-map (.channels settings)))
-           :positions (range (.. settings positions size))
-           :default-exposure (core getExposure))))
-
-
-(defn get-IJ-type [depth]
-  (get {1 ImagePlus/GRAY8 2 ImagePlus/GRAY16 4 ImagePlus/COLOR_RGB 8 64} depth))
-
-(defn get-z-step-um [slices]
-  (if (and slices (< 1 (count slices)))
-    (- (second slices) (first slices))
-    0))
-
-(defn get-channel-components [channel]
-  (let [default-cam (get-property "Core" "Camera")
-        chan-cam
-          (or
-            (first
-              (filter #(= (take 2 %) '("Core" "Camera"))
-                (:properties channel)))
-            default-cam)]
-    (set-property chan-cam)
-    (let [n (int (core getNumberOfComponents))]
-      (set-property default-cam)
-      (get {1 1 , 4 3} n))))
-
-(defn make-summary-metadata [settings]
-  (let [depth (int (core getBytesPerPixel))
-        channels (settings :channels)]
-     (JSONObject. {
-      "BitDepth" (core getImageBitDepth)
-      "Channels" (count (settings :channels))
-      "ChNames" (JSONArray. (map :name channels))
-      "ChColors" (JSONArray. (map #(.getRGB (:color %)) channels))
-      "ChContrastMax" (JSONArray. (repeat (count channels) Integer/MIN_VALUE))
-      "ChContrastMin" (JSONArray. (repeat (count channels) Integer/MAX_VALUE))
-      "Comment" (settings :comment)
-      "ComputerName" (.. InetAddress getLocalHost getHostName)
-      "Depth" (core getBytesPerPixel)
-      "Directory" (if (settings :save) (settings :root) "")
-      "Frames" (count (settings :frames))
-      "GridColumn" 0
-      "GridRow" 0
-      "Height" (core getImageHeight)
-      "Interval_ms" (settings :interval-ms)
-      "IJType" (get-IJ-type depth)
-      "KeepShutterOpenChannels" (settings :keep-shutter-open-channels)
-      "KeepShutterOpenSlices" (settings :keep-shutter-open-slices)
-      "MicroManagerVersion" (.getVersion gui)
-      "MetadataVersion" 10
-      "PixelAspect" 1.0
-      "PixelSize_um" (core getPixelSizeUm)
-      "PixelType" (get-pixel-type)
-      "Positions" (count (settings :positions))
-      "Prefix" (if (settings :save) (settings :prefix) "")
-      "ROI" (JSONArray. (get-camera-roi))
-      "Slices" (count (settings :slices))
-      "SlicesFirst" (settings :slices-first)
-      "Source" "Micro-Manager"
-      "TimeFirst" (settings :time-first)
-      "UserName" (System/getProperty "user.name")
-      "UUID" (UUID/randomUUID)
-      "Width" (core getImageWidth)
-      "z-step_um" (get-z-step-um (settings :slices))
-     })))
-
-;; acquire button
-
-(def current-album (atom nil))
-
-(def snap-window (atom nil))
-
-(defn compatible-image? [display annotated-image]
-  (select-values-match?
-    (json-to-data (.. display getImageCache getSummaryMetadata))
-    (:tags annotated-image)
-    ["Width" "Height" "PixelType"]))
-
-(defn create-image-window [first-image]
-  (let [summary {:interval-ms 0.0, :use-autofocus false, :autofocus-skip 0,
-                 :relative-slices true, :keep-shutter-open-slices false, :comment "",
-                 :prefix "Untitled", :root "",
-                 :time-first false, :positions (), :channels (), :slices-first true,
-                 :slices nil, :numFrames 0, :keep-shutter-open-channels false,
-                 :zReference 0.0, :frames (), :save false}
-		summary-metadata (make-summary-metadata summary)
-		cache (doto (MMImageCache. (TaggedImageStorageRam. summary-metadata))
-						(.setSummaryMetadata summary-metadata))]
-		(doto (VirtualAcquisitionDisplay. cache nil))))
-
-(defn create-basic-event []
-  {:position-index 0, :position nil,
-   :frame-index 0, :slice 0.0, :channel-index 0, :slice-index 0, :frame 0
-   :channel {:name (core getCurrentConfig (core getChannelGroup))},
-   :exposure (core getExposure), :relative-z true,
-   :z-drive (core getFocusDevice), :wait-time-ms 0})
-
-(defn create-basic-state []
-  {:init-width (core getImageWidth)
-   :init-height (core getImageHeight)
-   :pixel-type (get-pixel-type)
-   :binning (core getProperty (core getCameraDevice) "Binning")})
-
-(defn acquire-tagged-image []
-  (core snapImage)
-    (annotate-image (collect-snap-image) (create-basic-event) (create-basic-state)))
-
-(defn show-image [display tagged-img]
-  (let [myTaggedImage (make-TaggedImage tagged-img)
-        cache (.getImageCache display)]
-    (.putImage cache myTaggedImage)
-     (.showImage display myTaggedImage)
-     (when-not false ;; (.isVisible display)
-       (.show display))))
-
-(defn add-to-album []
-  (let [tagged-image (acquire-tagged-image)]
-    (when-not (and @current-album
-                   (compatible-image? @current-album tagged-image)
-	           (not (.windowClosed @current-album)))
-      (reset! current-album (create-image-window tagged-image)))
-    (let [count (.getNumPositions @current-album)
-	  my-tagged-image
-	    (update-in tagged-image [:tags] merge
-	      {"PositionIndex" count "PositionName" (str "Snap" count)})]
-      (show-image @current-album my-tagged-image))))
-
-(defn reset-snap-window [tagged-image]
-  (when-not (and @snap-window
-                   (compatible-image? @snap-window tagged-image)
-                   (not (.windowClosed @snap-window)))
-    (when @snap-window (.close @snap-window))
-    (reset! snap-window (create-image-window tagged-image))))
-
-(defn do-snap []
-  (let [tagged-image (acquire-tagged-image)]
-    (reset-snap-window tagged-image)
-    (show-image @snap-window tagged-image)))
-
-(def live-mode-running (ref false))
-
-
-(defn enable-live-mode [^Boolean on]
-      (if on
-        (let [event (create-basic-event)
-              state (create-basic-state)]
-          (dosync (ref-set live-mode-running true))
-          (core startContinuousSequenceAcquisition 0)
-          (.start (Thread.
-                    #(do (while @live-mode-running
-                           (let [img (annotate-image (core getLastImage) event state)]
-                              (reset-snap-window img)
-                              (show-image @snap-window img)))
-                         (core stopSequenceAcquisition)))))
-        (dosync (ref-set live-mode-running false))))
-
-;; java interop
-
-(defn -init []
-  [[] (atom {:running false :stop false})])
-
-(defn -run [this acq-settings acq-eng]
-  (def last-acq this)
-  (def eng acq-eng)
-  (load-mm)
-  (create-device-agents)
-  (swap! (.state this) assoc :stop false :pause false :finished false)
-  (let [out-queue (GentleLinkedBlockingQueue.)
-        settings (convert-settings acq-settings)
-        acq-thread (Thread. #(run-acquisition this settings out-queue))
-        processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
-        out-queue-2 (.begin processors)
-        display (LiveAcqDisplay. mmc out-queue-2 (make-summary-metadata settings)
-                  (:save settings) acq-eng)]
-    (def outq out-queue)
-    ;(.addImageProcessor acq-eng
-      ;(proxy [TaggedImageAnalyzer] []
-        ;(analyze [img] (log "pretending to analyze"))))
-    (when-not (:stop @(.state this))
-      (if (. gui getLiveMode)
-        (. gui enableLiveMode false))
-      (.start acq-thread)
-      (swap! (.state this) assoc :display display)
-      (.start display))))
-
-(defn -acquireSingle [this]
-  (load-mm)
-  (add-to-album))
-
-(defn -doSnap [this]
-  (load-mm)
-  (do-snap))
-
-(defn -isLiveRunning [this]
-  @live-mode-running)
-
-(defn -enableLiveMode [this ^Boolean on]
-  (load-mm)
-  (enable-live-mode on))
-
-(defn -pause [this]
-  (log "pause requested!")
-  (swap! (.state this) assoc :pause true))
-
-(defn -resume [this]
-  (log "resume requested!")
-  (swap! (.state this) assoc :pause false))
-
-(defn -stop [this]
-  (log "stop requested!")
-  (let [state (.state this)]
-    (swap! state assoc :stop true)
-    (do-when #(.countDown %) (:sleepy @state))
-    (log @state)))
-
-(defn -isRunning [this]
-  (:running @(.state this)))
-
-(defn -isFinished [this]
-  (or (get @(.state this) :finished) false))
-
-(defn -isPaused [this]
-  (:pause @(.state this)))
-
-(defn -stopHasBeenRequested [this]
-  (:stop @(.state this)))
-
-(defn -nextWakeTime [this]
-  (or (:next-wake-time @(.state this)) -1))
-
-;; attaching runnables
-
-(defn -attachRunnable [this f p c s runnable]
-  (let [template (into {}
-          (for [[k v]
-                {:frame-index f :position-index p
-                 :channel-index c :slice-index s}
-                 :when (not (neg? v))]
-            [k v]))]
-    (swap! attached-runnables conj [template runnable])))
-
-(defn -clearRunnables [this]
-  (reset! attached-runnables (vec nil)))
-
-;; testing
-
-(defn create-acq-eng []
-  (doto
-    (proxy [AcquisitionWrapperEngine] []
-      (runPipeline [^SequenceSettings settings]
-        ;(def orig-settings settings)
-        (println "ss positions: " (.size (.positions settings)))
-        (println "position-count: " (.getNumberOfPositions (.getPositionList gui)))
-        (-run settings this)
-    (.setCore mmc (.getAutofocusManager gui))
-    (.setParentGUI gui)
-    (.setPositionList (.getPositionList gui))))))
-
-(defn test-dialog [eng]
-  (.show (AcqControlDlg. eng (Preferences/userNodeForPackage (.getClass gui)) gui)))
-
-(defn run-test []
-  (test-dialog (create-acq-eng)))
-
-
+; FILE:         acq_engine.clj
+; PROJECT:      Micro-Manager
+; SUBSYSTEM:    mmstudio acquisition engine
+; ----------------------------------------------------------------------------
+; AUTHOR:       Arthur Edelstein, arthuredelstein@gmail.com, Dec 14, 2010
+;               Adapted from the acq eng by Nenad Amodaj and Nico Stuurman
+; COPYRIGHT:    University of California, San Francisco, 2006-2011
+; LICENSE:      This file is distributed under the BSD license.
+;               License text is included with the source distribution.
+;               This file is distributed in the hope that it will be useful,
+;               but WITHOUT ANY WARRANTY; without even the implied warranty
+;               of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+;               IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+;               CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+;               INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES.
+
+(ns org.micromanager.acq-engine
+  (:use [org.micromanager.mm :only [when-lets map-config get-config get-positions load-mm
+                                    get-default-devices core log log-cmd mmc gui with-core-setting
+                                    do-when if-args get-system-config-cached select-values-match?
+                                    get-property get-camera-roi parse-core-metadata]]
+        [org.micromanager.sequence-generator :only [generate-acq-sequence]])
+  (:import [org.micromanager AcqControlDlg]
+           [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
+           [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcqDisplay TaggedImageQueue
+                                         ProcessorStack SequenceSettings MMImageCache
+                                         TaggedImageStorageRam VirtualAcquisitionDisplay]
+           [org.micromanager.navigation MultiStagePosition StagePosition]
+           [mmcorej TaggedImage Configuration Metadata]
+           [java.util.prefs Preferences]
+           [java.net InetAddress]
+           [java.util.concurrent TimeUnit CountDownLatch]
+           [org.micromanager.utils ChannelSpec GentleLinkedBlockingQueue MDUtils
+                                   ReportingUtils]
+           [org.json JSONObject JSONArray]
+           [java.util Date UUID]
+           [java.text SimpleDateFormat]
+           [javax.swing SwingUtilities]
+           [ij ImagePlus])
+   (:gen-class
+     :name org.micromanager.AcqEngine
+     :implements [org.micromanager.api.Pipeline]
+     :init init
+     :state state))
+
+;; constants
+
+(def run-devices-parallel false)
+
+;; general utils
+
+(defn data-object-to-map [obj]
+  (into {}
+    (for [f (.getFields (type obj))
+          :when (zero? (bit-and
+                         (.getModifiers f) java.lang.reflect.Modifier/STATIC))]
+      [(keyword (.getName f)) (.get f obj)])))
+
+(defmacro apply* [& args]
+  `(~@(butlast args) ~@(eval (last args))))
+
+(defn rekey
+  ([m kold knew]
+    (-> m (dissoc kold) (assoc knew (get m kold))))
+  ([m kold knew & ks]
+    (reduce #(apply rekey %1 %2)
+      m (partition 2 (conj ks knew kold)))))
+
+(defn select-and-rekey [m & ks]
+    (apply rekey (select-keys m (apply concat (partition 1 2 ks))) ks))
+
+(defn clock-ms []
+  (quot (System/nanoTime) 1000000))
+
+;; mm utils
+
+(def iso8601modified (SimpleDateFormat. "yyyy-MM-dd HH:mm:ss Z"))
+
+(defn get-current-time-str []
+  (. iso8601modified format (Date.)))
+
+(defn get-pixel-type []
+  (str ({1 "GRAY", 4 "RGB"} (int (core getNumberOfComponents))) (* 8 (core getBytesPerPixel))))
+
+(defn ChannelSpec-to-map [^ChannelSpec chan]
+  (-> chan
+    (data-object-to-map)
+    (select-and-rekey
+      :config_                 :name
+      :exposure_               :exposure
+      :zOffset_                :z-offset
+      :doZStack_               :use-z-stack
+      :skipFactorFrame_        :skip-frames
+      :useChannel_             :use-channel
+      :color_                  :color
+    )
+    (assoc :properties (get-config (core getChannelGroup) (.config_ chan)))))
+
+(defn MultiStagePosition-to-map [^MultiStagePosition msp]
+  (if msp
+    {:label (.getLabel msp)
+     :axes
+        (into {}
+          (for [i (range (.size msp))]
+            (let [stage-pos (.get msp i)]
+              [(.stageName stage-pos)
+                (condp = (.numAxes stage-pos)
+                  1 [(.x stage-pos)]
+                  2 [(.x stage-pos) (.y stage-pos)])])))}))
+
+(defn get-msp [idx]
+  (when idx
+    (let [p-list (. gui getPositionList)]
+      (if (pos? (. p-list getNumberOfPositions))
+        (. p-list (getPosition idx))))))
+
+(defn get-z-position [idx z-stage]
+  (if-let [msp (get-msp idx)]
+    (if-let [stage-pos (. msp get z-stage)]
+      (. stage-pos x))))
+
+(defn set-z-position [idx z-stage z]
+  (if-let [msp (get-msp idx)]
+    (if-let [stage-pos (. msp (get z-stage))]
+      (set! (. stage-pos x) z))))
+
+;; globals
+
+(def state (atom {:running false :stop false}))
+
+(defn state-assoc! [& args]
+  (apply swap! state assoc args))
+
+(def attached-runnables (atom (vec nil)))
+
+;; metadata
+
+(defn json-to-data [json]
+  (condp #(isa? (type %2) %1) json
+    JSONObject
+      (let [keys (iterator-seq (.keys json))]
+        (into {}
+          (for [key keys]
+            (let [val (if (.isNull json key) nil (.get json key))]
+              [key (json-to-data val)]))))
+    JSONArray
+      (vec
+        (for [i (range (.length json))]
+          (json-to-data (.get json i))))
+    json))
+
+(defn compute-time-from-core [tags]
+  ; (log "core tags: " tags)
+  (when (@state :burst-init-time)
+    (when-let [t (tags "ElapsedTime-ms")]
+      (+ (Double/parseDouble t)
+         (@state :burst-init-time)))))
+
+(defn elapsed-time [state]
+  (if (state :start-time) (- (clock-ms) (state :start-time)) 0))
+
+(defn annotate-image [img event state]
+  ;(println event)
+  {:pix (:pix img)
+   :tags (merge
+      (map-config (core getSystemStateCache))
+      {
+       "AxisPositions" (when-let [axes (get-in event [:position :axes])] (JSONObject. axes))
+       "Binning" (state :binning)
+       "BitDepth" (state :bit-depth)
+       "Channel" (get-in event [:channel :name])
+       "ChannelIndex" (:channel-index event)
+       "ElapsedTime-ms" (elapsed-time state)
+       "Exposure-ms" (:exposure event)
+       "Frame" (:frame-index event)
+       "Height" (state :init-height)
+       "NextFrame" (:next-frame-index event)
+       "PixelSizeUm" (state :pixel-size-um)
+       "PixelType" (state :pixel-type)
+       "PositionIndex" (:position-index event)
+       "PositionName" (if-let [pos (:position event)] (if-args #(.getLabel %) (get-msp pos)))
+       "Slice" (:slice-index event)
+       "SlicePosition" (:slice event)
+       "Source" (state :source)
+       "Time" (get-current-time-str)
+       "UUID" (UUID/randomUUID)
+       "Width"  (state :init-width)
+       "ZPositionUm" (state :last-z-position)
+      }
+       (:tags img))})
+
+(defn make-TaggedImage [annotated-img]
+  (TaggedImage. (:pix annotated-img) (JSONObject. (:tags annotated-img))))
+
+;; acq-engine
+
+(defn await-resume []
+  (while (and (:pause @state) (not (:stop @state))) (Thread/sleep 5)))
+
+(defn interruptible-sleep [time-ms]
+  (let [sleepy (CountDownLatch. 1)]
+    (state-assoc! :sleepy sleepy :next-wake-time (+ (clock-ms) time-ms))
+    (.await sleepy time-ms TimeUnit/MILLISECONDS)))
+
+(defn acq-sleep [interval-ms]
+  (when (and (@state :init-continuous-focus)
+             (not (core isContinuousFocusEnabled)))
+    (core enableContinuousFocus true))
+  (let [target-time (+ (@state :last-wake-time) interval-ms)
+        delta (- target-time (clock-ms))]
+    (when (pos? delta)
+      (interruptible-sleep delta))
+    (await-resume)
+    (let [now (clock-ms)
+          wake-time (if (> now (+ target-time 10)) now target-time)]
+      (state-assoc! :last-wake-time wake-time))))
+
+(declare device-agents)
+
+(defn wait-for-device [dev]
+  (when (and dev (pos? (.length dev)))
+    (core waitForDevice dev)))
+
+(defn create-device-agents []
+  (def device-agents
+    (let [devs (seq (core getLoadedDevices))]
+      (zipmap devs (repeatedly (count devs) #(agent nil))))))
+
+(defn get-z-stage-position [stage]
+  (when-not (empty? stage) (core getPosition stage) 0))
+
+(defn set-z-stage-position [stage pos]
+  (when (core isContinuousFocusEnabled)
+    (core enableContinuousFocus false))
+  (when-not (empty? stage) (core setPosition stage pos)))
+
+(defn set-stage-position
+  ([stage-dev z]
+    (when (not= z (:last-z-position @state))
+      (set-z-stage-position stage-dev z)
+      (state-assoc! :last-z-position z)))
+  ([stage-dev x y]
+    (when (and x y
+               (not= [x y] (:last-xy-position @state)))
+      (core setXYPosition stage-dev x y)
+      (state-assoc! :last-xy-position [x y]))))
+
+(defn set-property
+  ([prop] (core setProperty (prop 0) (prop 1) (prop 2))))
+
+(defn send-device-action [dev action]
+  (send-off (device-agents dev) (fn [_] (action))))
+
+(defn create-presnap-actions [event]
+  (concat
+    (for [[axis pos] (:axes (MultiStagePosition-to-map (get-msp (:position event)))) :when pos]
+      [axis #(apply set-stage-position axis pos)])
+    (for [prop (get-in event [:channel :properties])]
+      [(prop 0) #(core setProperty (prop 0) (prop 1) (prop 2))])
+    (when-let [exposure (:exposure event)]
+      (list [(core getCameraDevice) #(core setExposure exposure)]))))
+
+(defn run-actions [action-map]
+  (if run-devices-parallel
+    (do
+      (doseq [[dev action] action-map]
+        (send-device-action dev action))
+      (doseq [dev (keys action-map)]
+        (send-device-action dev #(core waitForDevice dev)))
+      (doall (map (partial await-for 10000) (vals device-agents))))
+    (do
+      (doseq [[dev action] action-map]
+        (action) (wait-for-device dev)))))
+
+(defn run-autofocus []
+  (.. gui getAutofocusManager getDevice fullFocus)
+  (log "running autofocus " (.. gui getAutofocusManager getDevice getDeviceName))
+  (state-assoc! :reference-z-position (core getPosition (core getFocusDevice))))
+
+(defn snap-image [open-before close-after]
+  (with-core-setting [getAutoShutter setAutoShutter false]
+    (if open-before
+      (core setShutterOpen true)
+      (wait-for-device (core getShutterDevice)))
+    (core snapImage)
+    (if close-after
+      (core setShutterOpen false))
+      (wait-for-device (core getShutterDevice))))
+
+(defn init-burst [length]
+  (core setAutoShutter (@state :init-auto-shutter))
+  (swap! state assoc :burst-init-time (elapsed-time @state))
+  (core startSequenceAcquisition length 0 true))
+
+(defn expose [event]
+  (do (condp = (:task event)
+    :snap (snap-image true (:close-shutter event))
+    :init-burst (init-burst (:burst-length event))
+    nil)))
+
+(defn collect-burst-image []
+  (while (and (core isSequenceRunning) (zero? (core getRemainingImageCount)))
+    (Thread/sleep 5))
+  (let [md (Metadata.)
+        pix (core popNextImageMD md)
+        tags (parse-core-metadata md)
+        t (compute-time-from-core tags)
+        tags (if (and t (pos? t))
+               (assoc tags "ElapsedTime-ms" t)
+               (dissoc tags "ElapsedTime-ms"))]
+   ; (println "cam-t: " t ", collect-t: " (elapsed-time @state)
+   ;      ", remaining-images: " (core getRemainingImageCount))
+    {:pix pix :tags (dissoc tags "StartTime-ms")}))
+
+(defn collect-snap-image []
+  {:pix (core getImage) :tags nil})
+
+(defn collect-image [event out-queue]
+  (let [image (condp = (:task event)
+                :snap (collect-snap-image)
+                :init-burst (collect-burst-image)
+                :collect-burst (collect-burst-image))]
+    (if (. mmc isBufferOverflowed)
+      (do (swap! state assoc :stop true)
+          (ReportingUtils/showError "Circular buffer overflowed."))
+      (do (log "collect-image: "
+               (select-keys event [:position-index :frame-index
+                                   :slice-index :channel-index]))
+          (.put out-queue
+                (make-TaggedImage (annotate-image image event @state)))))))
+
+(defn compute-z-position [event]
+  (if-let [z-drive (@state :default-z-drive)]
+    (+ (or (get-in event [:channel :z-offset]) 0)
+       (or (:slice event) 0)
+       (if (and (:slice event) (not (:relative-z event)))
+         0
+         (or (get-z-position (:position event) z-drive)
+             (@state :reference-z-position))))))
+
+(defn make-event-fns [event out-queue]
+  (let [task (:task event)]
+    (cond
+      (= task :collect-burst)
+        (list #(collect-image event out-queue))
+      (or (= task :snap) (= task :init-burst))
+        (list
+          #(log event)
+          (fn [] (doall (map #(.run %) (event :runnables))))
+          #(when-let [wait-time-ms (event :wait-time-ms)]
+            (acq-sleep wait-time-ms))
+          #(run-actions (create-presnap-actions event))
+          #(await-for 10000 (device-agents (core getCameraDevice)))
+          #(when (:autofocus event)
+            (set-z-position (:position event) (@state :default-z-drive) (run-autofocus)))
+          #(when-let [z-drive (@state :default-z-drive)]
+            (let [z (compute-z-position event)]
+              (when (not= z (@state :last-z-position))
+                (do (set-stage-position z-drive z)
+                    (wait-for-device z-drive)))))
+          #(do (expose event)
+               (collect-image event out-queue))))))
+
+(defn execute [event-fns]
+  (doseq [event-fn event-fns :while (not (:stop @state))]
+    (try (event-fn) (catch Throwable e (ReportingUtils/logError e)))
+    (await-resume)))
+
+(defn return-config []
+  (dorun (map set-property
+    (clojure.set/difference
+      (set (@state :init-system-state))
+      (set (get-system-config-cached))))))
+
+(defn cleanup []
+  (log "cleanup")
+  (do-when #(.update %) (:display @state))
+  (state-assoc! :finished true, :running false, :display nil)
+  (when (core isSequenceRunning)
+    (core stopSequenceAcquisition))
+  (core setAutoShutter (@state :init-auto-shutter))
+  (core setExposure (@state :init-exposure))
+  (when (not= (@state :last-z-position) (@state :init-z-position))
+    (set-z-stage-position (core getFocusDevice) (@state :init-z-position)))
+  (when (and (@state :init-continuous-focus)
+             (not (core isContinuousFocusEnabled)))
+    (core enableContinuousFocus true))
+  (return-config))
+
+(defn prepare-state [this]
+  (let [z (get-z-stage-position (core getFocusDevice))]
+    (swap! (.state this) assoc
+      :pause false
+      :stop false
+      :running true
+      :finished false
+      :last-wake-time (clock-ms)
+      :last-z-position z
+      :last-xy-position nil
+      :reference-z-position z
+      :start-time (clock-ms)
+      :init-auto-shutter (core getAutoShutter)
+      :init-exposure (core getExposure)
+      :default-z-drive (core getFocusDevice)
+      :init-z-position z
+      :init-system-state (get-system-config-cached)
+      :init-continuous-focus (core isContinuousFocusEnabled)
+      :init-width (core getImageWidth)
+      :init-height (core getImageHeight)
+      :binning (core getProperty (core getCameraDevice) "Binning")
+      :bit-depth (core getImageBitDepth)
+      :pixel-size-um (core getPixelSizeUm)
+      :source (core getCameraDevice)
+      :pixel-type (get-pixel-type)
+      )))
+
+(defn run-acquisition [this settings out-queue]
+  (def acq-settings settings)
+  (prepare-state this)
+  (binding [state (.state this)]
+    (def last-state state)
+    (let [acq-seq (generate-acq-sequence settings @attached-runnables)]
+       (def acq-sequence acq-seq)
+       (time (count acq-seq))
+       (execute (mapcat #(make-event-fns % out-queue) acq-seq))
+       (.put out-queue TaggedImageQueue/POISON)
+       (cleanup))))
+
+(defn convert-settings [^SequenceSettings settings]
+  (-> settings
+    (data-object-to-map)
+    (rekey
+      :slicesFirst             :slices-first
+      :timeFirst               :time-first
+      :keepShutterOpenSlices   :keep-shutter-open-slices
+      :keepShutterOpenChannels :keep-shutter-open-channels
+      :useAutofocus            :use-autofocus
+      :skipAutofocusCount      :autofocus-skip
+      :relativeZSlice          :relative-slices
+      :intervalMs              :interval-ms
+      :slices                  :slices
+    )
+    (assoc :frames (range (.numFrames settings))
+           :channels (filter :use-channel (map ChannelSpec-to-map (.channels settings)))
+           :positions (range (.. settings positions size))
+           :default-exposure (core getExposure))))
+
+
+(defn get-IJ-type [depth]
+  (get {1 ImagePlus/GRAY8 2 ImagePlus/GRAY16 4 ImagePlus/COLOR_RGB 8 64} depth))
+
+(defn get-z-step-um [slices]
+  (if (and slices (< 1 (count slices)))
+    (- (second slices) (first slices))
+    0))
+
+(defn get-channel-components [channel]
+  (let [default-cam (get-property "Core" "Camera")
+        chan-cam
+          (or
+            (first
+              (filter #(= (take 2 %) '("Core" "Camera"))
+                (:properties channel)))
+            default-cam)]
+    (set-property chan-cam)
+    (let [n (int (core getNumberOfComponents))]
+      (set-property default-cam)
+      (get {1 1 , 4 3} n))))
+
+(defn make-summary-metadata [settings]
+  (let [depth (int (core getBytesPerPixel))
+        channels (settings :channels)]
+     (JSONObject. {
+      "BitDepth" (core getImageBitDepth)
+      "Channels" (count (settings :channels))
+      "ChNames" (JSONArray. (map :name channels))
+      "ChColors" (JSONArray. (map #(.getRGB (:color %)) channels))
+      "ChContrastMax" (JSONArray. (repeat (count channels) Integer/MIN_VALUE))
+      "ChContrastMin" (JSONArray. (repeat (count channels) Integer/MAX_VALUE))
+      "Comment" (settings :comment)
+      "ComputerName" (.. InetAddress getLocalHost getHostName)
+      "Depth" (core getBytesPerPixel)
+      "Directory" (if (settings :save) (settings :root) "")
+      "Frames" (count (settings :frames))
+      "GridColumn" 0
+      "GridRow" 0
+      "Height" (core getImageHeight)
+      "Interval_ms" (settings :interval-ms)
+      "IJType" (get-IJ-type depth)
+      "KeepShutterOpenChannels" (settings :keep-shutter-open-channels)
+      "KeepShutterOpenSlices" (settings :keep-shutter-open-slices)
+      "MicroManagerVersion" (.getVersion gui)
+      "MetadataVersion" 10
+      "PixelAspect" 1.0
+      "PixelSize_um" (core getPixelSizeUm)
+      "PixelType" (get-pixel-type)
+      "Positions" (count (settings :positions))
+      "Prefix" (if (settings :save) (settings :prefix) "")
+      "ROI" (JSONArray. (get-camera-roi))
+      "Slices" (count (settings :slices))
+      "SlicesFirst" (settings :slices-first)
+      "Source" "Micro-Manager"
+      "TimeFirst" (settings :time-first)
+      "UserName" (System/getProperty "user.name")
+      "UUID" (UUID/randomUUID)
+      "Width" (core getImageWidth)
+      "z-step_um" (get-z-step-um (settings :slices))
+     })))
+
+;; acquire button
+
+(def current-album (atom nil))
+
+(def snap-window (atom nil))
+
+(defn compatible-image? [display annotated-image]
+  (select-values-match?
+    (json-to-data (.. display getImageCache getSummaryMetadata))
+    (:tags annotated-image)
+    ["Width" "Height" "PixelType"]))
+
+(defn create-image-window [first-image]
+  (let [summary {:interval-ms 0.0, :use-autofocus false, :autofocus-skip 0,
+                 :relative-slices true, :keep-shutter-open-slices false, :comment "",
+                 :prefix "Untitled", :root "",
+                 :time-first false, :positions (), :channels (), :slices-first true,
+                 :slices nil, :numFrames 0, :keep-shutter-open-channels false,
+                 :zReference 0.0, :frames (), :save false}
+		summary-metadata (make-summary-metadata summary)
+		cache (doto (MMImageCache. (TaggedImageStorageRam. summary-metadata))
+						(.setSummaryMetadata summary-metadata))]
+		(doto (VirtualAcquisitionDisplay. cache nil))))
+
+(defn create-basic-event []
+  {:position-index 0, :position nil,
+   :frame-index 0, :slice 0.0, :channel-index 0, :slice-index 0, :frame 0
+   :channel {:name (core getCurrentConfig (core getChannelGroup))},
+   :exposure (core getExposure), :relative-z true,
+   :wait-time-ms 0})
+
+(defn create-basic-state []
+  {:init-width (core getImageWidth)
+   :init-height (core getImageHeight)
+   :pixel-type (get-pixel-type)
+   :binning (core getProperty (core getCameraDevice) "Binning")})
+
+(defn acquire-tagged-image []
+  (core snapImage)
+    (annotate-image (collect-snap-image) (create-basic-event) (create-basic-state)))
+
+(defn show-image [display tagged-img]
+  (let [myTaggedImage (make-TaggedImage tagged-img)
+        cache (.getImageCache display)]
+    (.putImage cache myTaggedImage)
+     (.showImage display myTaggedImage)
+     (when-not false ;; (.isVisible display)
+       (.show display))))
+
+(defn add-to-album []
+  (let [tagged-image (acquire-tagged-image)]
+    (when-not (and @current-album
+                   (compatible-image? @current-album tagged-image)
+	           (not (.windowClosed @current-album)))
+      (reset! current-album (create-image-window tagged-image)))
+    (let [count (.getNumPositions @current-album)
+	  my-tagged-image
+	    (update-in tagged-image [:tags] merge
+	      {"PositionIndex" count "PositionName" (str "Snap" count)})]
+      (show-image @current-album my-tagged-image))))
+
+(defn reset-snap-window [tagged-image]
+  (when-not (and @snap-window
+                   (compatible-image? @snap-window tagged-image)
+                   (not (.windowClosed @snap-window)))
+    (when @snap-window (.close @snap-window))
+    (reset! snap-window (create-image-window tagged-image))))
+
+(defn do-snap []
+  (let [tagged-image (acquire-tagged-image)]
+    (reset-snap-window tagged-image)
+    (show-image @snap-window tagged-image)))
+
+(def live-mode-running (ref false))
+
+
+(defn enable-live-mode [^Boolean on]
+      (if on
+        (let [event (create-basic-event)
+              state (create-basic-state)]
+          (dosync (ref-set live-mode-running true))
+          (core startContinuousSequenceAcquisition 0)
+          (.start (Thread.
+                    #(do (while @live-mode-running
+                           (let [img (annotate-image (core getLastImage) event state)]
+                              (reset-snap-window img)
+                              (show-image @snap-window img)))
+                         (core stopSequenceAcquisition)))))
+        (dosync (ref-set live-mode-running false))))
+
+;; java interop
+
+(defn -init []
+  [[] (atom {:running false :stop false})])
+
+(defn -run [this acq-settings acq-eng]
+  (def last-acq this)
+  (def eng acq-eng)
+  (load-mm)
+  (create-device-agents)
+  (swap! (.state this) assoc :stop false :pause false :finished false)
+  (let [out-queue (GentleLinkedBlockingQueue.)
+        settings (convert-settings acq-settings)
+        acq-thread (Thread. #(run-acquisition this settings out-queue))
+        processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
+        out-queue-2 (.begin processors)
+        display (LiveAcqDisplay. mmc out-queue-2 (make-summary-metadata settings)
+                  (:save settings) acq-eng)]
+    (def outq out-queue)
+    ;(.addImageProcessor acq-eng
+      ;(proxy [TaggedImageAnalyzer] []
+        ;(analyze [img] (log "pretending to analyze"))))
+    (when-not (:stop @(.state this))
+      (if (. gui getLiveMode)
+        (. gui enableLiveMode false))
+      (.start acq-thread)
+      (swap! (.state this) assoc :display display)
+      (.start display))))
+
+(defn -acquireSingle [this]
+  (load-mm)
+  (add-to-album))
+
+(defn -doSnap [this]
+  (load-mm)
+  (do-snap))
+
+(defn -isLiveRunning [this]
+  @live-mode-running)
+
+(defn -enableLiveMode [this ^Boolean on]
+  (load-mm)
+  (enable-live-mode on))
+
+(defn -pause [this]
+  (log "pause requested!")
+  (swap! (.state this) assoc :pause true))
+
+(defn -resume [this]
+  (log "resume requested!")
+  (swap! (.state this) assoc :pause false))
+
+(defn -stop [this]
+  (log "stop requested!")
+  (let [state (.state this)]
+    (swap! state assoc :stop true)
+    (do-when #(.countDown %) (:sleepy @state))
+    (log @state)))
+
+(defn -isRunning [this]
+  (:running @(.state this)))
+
+(defn -isFinished [this]
+  (or (get @(.state this) :finished) false))
+
+(defn -isPaused [this]
+  (:pause @(.state this)))
+
+(defn -stopHasBeenRequested [this]
+  (:stop @(.state this)))
+
+(defn -nextWakeTime [this]
+  (or (:next-wake-time @(.state this)) -1))
+
+;; attaching runnables
+
+(defn -attachRunnable [this f p c s runnable]
+  (let [template (into {}
+          (for [[k v]
+                {:frame-index f :position-index p
+                 :channel-index c :slice-index s}
+                 :when (not (neg? v))]
+            [k v]))]
+    (swap! attached-runnables conj [template runnable])))
+
+(defn -clearRunnables [this]
+  (reset! attached-runnables (vec nil)))
+
+;; testing
+
+(defn create-acq-eng []
+  (doto
+    (proxy [AcquisitionWrapperEngine] []
+      (runPipeline [^SequenceSettings settings]
+        ;(def orig-settings settings)
+        (println "ss positions: " (.size (.positions settings)))
+        (println "position-count: " (.getNumberOfPositions (.getPositionList gui)))
+        (-run settings this)
+    (.setCore mmc (.getAutofocusManager gui))
+    (.setParentGUI gui)
+    (.setPositionList (.getPositionList gui))))))
+
+(defn test-dialog [eng]
+  (.show (AcqControlDlg. eng (Preferences/userNodeForPackage (.getClass gui)) gui)))
+
+(defn run-test []
+  (test-dialog (create-acq-eng)))
+
+


Flush ws frames more often.

Flush ws frames more often.

--- src/via/netty/http2/handlers/websocket.clj
+++ src/via/netty/http2/handlers/websocket.clj
@@ -102,14 +102,19 @@
                                                                          (mapv n/acquire)
                                                                          vec)]
                                                          (n/release byte-buf)
-                                                         (dotimes [i (count frames)]
-                                                           (let [^ByteBuf frame (nth frames i)
-                                                                 final-fragment? (= i (dec (count frames)))
-                                                                 msg (if (zero? i)
-                                                                       (TextWebSocketFrame. final-fragment? 0 frame)
-                                                                       (ContinuationWebSocketFrame. final-fragment? 0 frame))]
-                                                             (.write ctx msg)))
-                                                         (.flush ctx))))]]
+                                                         (let [byte-counter (volatile! 0)]
+                                                           (dotimes [i (count frames)]
+                                                             (let [^ByteBuf frame (nth frames i)
+                                                                   final-fragment? (= i (dec (count frames)))
+                                                                   msg (if (zero? i)
+                                                                         (TextWebSocketFrame. final-fragment? 0 frame)
+                                                                         (ContinuationWebSocketFrame. final-fragment? 0 frame))]
+                                                               (.write ctx msg)
+                                                               (vswap! byte-counter + (.capacity frame))
+                                                               (when (> @byte-counter 1E5)
+                                                                 (vreset! byte-counter 0)
+                                                                 (.flush ctx))))
+                                                           (.flush ctx)))))]]
                       (filter second)
                       (mapv (fn [[handler-name handler]]
                               [(str handler-name "-" stream-id) handler])))


Copy Updates Aug 2018

Copy Updates Aug 2018

Signed-off-by: Eric Dvorsak <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@dvorsak.fr>

--- src/status_im/translations/en.cljs
+++ src/status_im/translations/en.cljs
@@ -71,7 +71,7 @@

    ;;home
    :home                                 "Home"
-   :no-recent-chats                      "There are no recent Chats or DApps here yet. Tap the “Plus” button to see the list of Dapps or discover people to chat with."
+   :no-recent-chats                      "Your Home screen will house your recent chats and DApp history. Tap the plus (+) button to get started."
    :welcome-to-status                    "Welcome to Status"
    :welcome-to-status-description        "Tap the plus (+) button to get started"

@@ -190,7 +190,7 @@
    :wallet-onboarding-description        "Send, receive, and store your cryptocurrency with the Status Wallet"
    :wallet-onboarding-set-up             "Let’s get set up"
    :wallet-set-up-title                  "Set up your wallet"
-   :wallet-set-up-signing-phrase         "This is your personal transaction phrase that you’ll use everytime you make a transaction. Make sure to write it down on a piece of paper, store it somewhere, and only confirm transactions when you see these three words."
+   :wallet-set-up-signing-phrase         "To increase security, we'll show you this phrase each time you initiate a transaction. When you see then you'll know it's safe to proceed. \n\nMemorize or store these words in a secure location. Only confirm transactions if you see them first."
    :wallet-set-up-confirm-title          "Wrote it down?"
    :wallet-set-up-confirm-description    "You won’t be able to see your 3-word transaction phrase again after this."
    :wallet-backup-recovery-title         "Backup your recovery phrase"
@@ -257,10 +257,10 @@
    :edit-chats                           "Edit chats"
    :search-chats                         "Search chats"
    :empty-topic                          "Empty topic"
-   :topic-format                         "Wrong format [a-z0-9\\-]+"
-   :topic-name-error                     "A topic name can contain only following characters: a-z -"
+   :topic-format                         "Topic names use only lowercase letters (a to z) & dashes (-)"
+   :topic-name-error                     "Topic names use only lowercase letters (a to z) & dashes (-)"
    :public-group-topic                   "Topic"
-   :set-a-topic                          "Set a topic"
+   :set-a-topic                          "Create a topic"
    :empty-chat-description               "There are no messages \nin this chat yet"
    :empty-chat-description-console       "Look under the hood! Console is a javascript runtime environment that exposes the whole web3 API. Type \"web3.\" to get started."
    :empty-chat-description-one-to-one    "Any messages you send here are encrypted and can only be read by you and "
@@ -442,7 +442,7 @@
    :cost-fee                             "Cost/Fee"
    :nonce                                "Nonce"
    :confirmations                        "Confirmations"
-   :confirmations-helper-text            "Consider transactions complete after 12 confirmations"
+   :confirmations-helper-text            "When the transaction has 12 confirmations you can consider it settled."
    :copy-transaction-hash                "Copy transaction ID"
    :open-on-etherscan                    "Open on Etherscan.io"
    :incoming                             "Incoming"
@@ -476,11 +476,11 @@
    :wallet-settings                      "Wallet settings"
    :wallet-manage-assets                 "Manage Assets"
    :sign-message                         "Sign Message"
-   :signing-message-phrase-description   "Sign the message by entering your password. Make sure that the words above match your secret signing phrase"
-   :signing-phrase-description           "Sign the transaction by entering your password. Make sure that the words above match your secret signing phrase"
+   :signing-message-phrase-description   "If you recognize these words, enter your login password to sign the message"
+   :signing-phrase-description           "If you recognize these words, enter your login password to sign the transaction"
    :wallet-insufficient-funds            "Insufficient funds"
    :wallet-insufficient-gas              "Not enough ETH for gas"
-   :error-unable-to-get-prices           "Currency conversion error. Try to refresh to update later"
+   :error-unable-to-get-prices           "Currency conversion error. Refresh your screen to try again."
    :error-unable-to-get-balance          "Unable to get balance"
    :error-unable-to-get-token-balance    "Unable to get token balance"
    :error-unable-to-get-transactions     "Unable to get transaction history"
@@ -606,7 +606,7 @@
    :transactions-filter-type             "Type"
    :transactions-filter-select-all       "Select all"
    :view-transaction-details             "View transaction details"
-   :transaction-description              "Please wait for at least 12 confirmations to make sure your transaction is processed securely"
+   :transaction-description              "Transactions with 12 confirmations can be considered irreversible"
    :transaction-sent                     "Transaction sent"
    :transaction-moved-text               "The transaction will remain in the 'Unsigned' list for the next 5 mins"
    :transaction-moved-title              "Transaction moved"
@@ -702,7 +702,7 @@
    :delete-bootnode                      "Delete bootnode"

    :mainnet-is-default-alert-title       "Hello"
-   :mainnet-is-default-alert-text        "Thanks for choosing Status! We are now in Beta, which means new installs are automatically connected to the Mainnet. If you upgraded, you may still need to switch networks, which you can do easily by navigating to your Profile -> Advanced Mode -> Switch Developer Mode on -> Choose your network. Now just have fun! Browse DApps, exchange assets, start your own #chats, and message your friends, all from the world's first decentralised, mobile client for Ethereum.\n\nPlease note that this is a beta release and we advise you that using this app should be done for testing purposes only and you assume the full responsibility for all risks concerning your data and funds."
+   :mainnet-is-default-alert-text        "Thanks for choosing Status! We are now in Beta, which means new installs are automatically connected to the Mainnet. If you upgraded, you may still need to switch networks, which you can do easily by navigating to your Profile -> Advanced Mode -> Switch Developer Mode on -> Choose your network. Now just have fun! Browse DApps, exchange assets, start your own #chats, and message your friends, all from the world's first decentralized, mobile client for Ethereum.\n\nPlease note that this is a beta release and we advise you that using this app should be done for testing purposes only and you assume the full responsibility for all risks concerning your data and funds."

    :main-networks                        "Main networks"
    :test-networks                        "Test networks"


updated tests for forma.matrix.utils

updated tests for forma.matrix.utils

--- test/forma/matrix/utils_test.clj
+++ test/forma/matrix/utils_test.clj
@@ -2,6 +2,23 @@
   (:use forma.matrix.utils
         midje.sweet)
   (:require [incanter.core :as i]))
+
+(facts "singular? tests."
+  (singular? (i/matrix [[1 0] [1 0]])) => true
+  (singular? (i/matrix [[1 0] [0 1]])) => false)
+
+(facts "test that the transpose of the transpose is the original
+matrix; test also that the transpose swaps the dimensions."
+  (let [coll-mat [[1 2 3] [4 5 6]]]
+    (transpose coll-mat) => '([1 4] [2 5] [3 6])
+    (transpose (transpose coll-mat)) => coll-mat
+    (count (transpose coll-mat)) => (count (first coll-mat))))
+
+(facts "check the values and dimension of the output."
+  (let [coll [1 2 3]
+        outer (outer-product coll)]
+    outer => '(1.0 2.0 3.0 2.0 4.0 6.0 3.0 6.0 9.0)
+    (count outer) => (i/sq (count coll))))

 (fact "insert-at tests."
   (insert-at 1 [2 1] [4 5 6]) => [4 2 1 5 6]
@@ -22,8 +39,8 @@
   container."
   (insert-into-val 0 8 10 [1 2 3]) => (throws AssertionError))

-(facts "pred-replace."
-  (pred-replace #{:cake} 3 [1 2 :cake 4]))
+(facts "test pred-replace."
+  (pred-replace #{:cake} 3 [1 2 :cake 4]) => '(1 2 3 4))

 (facts "logical-replace."
   (logical-replace > 3 2 [1 2 5 6]) => [1 2 2 2])
@@ -79,37 +96,26 @@

 (facts "idx and rowcol conversion, out of bounds."
   "Upper bounds for squares..."
-  (idx->rowcol 10 100) => (throws AssertionError)
-  (rowcol->idx 10 10 10) => (throws AssertionError)
+  (idx->rowcol 10 100) => nil
+  (rowcol->idx 10 10 10) => nil

   "And rectangles."
-  (idx->rowcol 3 4 12) => (throws AssertionError)
-  (rowcol->idx 3 4 3 2) => (throws AssertionError)
+  (idx->rowcol 3 4 12) => nil
+  (rowcol->idx 3 4 3 2) => nil

   "Below zero for squares..."
   (idx->rowcol 10 -1) => (throws AssertionError)
   (rowcol->idx 10 -1 0) => (throws AssertionError)

   "And for rectangles."
-  (idx->rowcol 10 8 81) => (throws AssertionError)
+  (idx->rowcol 10 8 81) => nil
   (rowcol->idx 10 10 -1 0) => (throws AssertionError))

-(tabular
- (fact "Variance Matrix tests. TODODAN: Please expand this with some
- more test cases, including assertion errors."
-   (= (variance-matrix ?input) (i/matrix ?output)) => truthy)
- ?input        ?output
- [[1 2] [3 4]] [[5 -3.5] [-3.5 2.5]])
-
-(tabular
- (fact "Column matrix tests."
-   (column-matrix ?val ?cols) => ?result)
- ?val ?cols ?result
- 2    5     [2.0 2.0 2.0 2.0 2.0]
- -1   2     [-1.0 -1.0]
- -1   0     []
- [-1] 2     (throws AssertionError)
- 2    -1    (throws AssertionError))
+(facts "Column matrix tests."
+  (column-matrix 4 3)  => [4.0 4.0 4.0]
+  (column-matrix 3 4)  => [3.0 3.0 3.0 3.0]
+  (column-matrix -1 3) => [-1.0 -1.0 -1.0]
+  (column-matrix 3 -1) => (throws AssertionError))

 (fact "Test of the ones column partial function."
   (ones-column 4) => [1.0 1.0 1.0 1.0])
@@ -117,23 +123,3 @@
 (facts "matrix-of test."
   (matrix-of 2 1 4) => [2 2 2 2]
   (matrix-of 0 2 2) => [[0 0] [0 0]])
-
-(fact
- "Checking outer product calculation against Numpy function np.outer() for mat and mat.T, where mat is [1 2 3]"
- (outer-product [1 2 3]) => [1.0 2.0 3.0 2.0 4.0 6.0 3.0 6.0 9.0])
-
-(fact
-  "Does transpose work as planned? Sure looks like it!"
-  (transpose [[1 2 3] [4 5 6]] ) => [[1 4] [2 5] [3 6]])
-
-
-(tabular
- (fact?- "Tabular generates lots of facts, one for each set of
-         substitutions in the table below."
-         (wc-query :path) => (produces ?results)
-         (provided
-           (hfs-textline :path) => [[?sentence]]))
- ?sentence       ?results
- "mock it out!"  [["mock" 1] ["it" 1] ["out!" 1]]
- "two two two"   [["two" 3]]
- "nathan M.M"    [["M.M" 1] ["nathan" 1]]) ;; 3 true facts