canvas caching

canvas caching

--- src/cljs/infinitelives/pixi/canvas.cljs
+++ src/cljs/infinitelives/pixi/canvas.cljs
@@ -10,7 +10,28 @@
   (:require-macros [cljs.core.async.macros :refer [go]])
 )

-(def ^:dynamic *canvas* nil)
+(def canvas-store (atom {}))
+
+(defn add!
+  ([key canvas]
+   (swap! canvas-store assoc key canvas))
+  ([canvas]
+   (add! :default canvas)))
+
+(defn set-default-once!
+  [canvas]
+  (when-not (:default @canvas-store)
+    (add! canvas)))
+
+(defn remove!
+  ([key]
+   (swap! canvas-store dissoc key)))
+
+(defn get
+  ([key]
+   (key @canvas-store))
+  ([]
+   (:default @canvas-store)))

 (defn make
   "make a new pixi canvas, or initialise pixi with an existing canvas.
@@ -165,14 +186,16 @@

           resizer-loop
           (when (:expand opts) (let [c (events/new-resize-chan)]
-                           (go (while true
-                                 (let [[width height] (<! c)]
-                                   (resize-fn width height)
-                                   (render-fn))))))]
-
-      (into
-       world
-       {
-        :render-fn render-fn
-        :resize-fn resize-fn
-        :expand-fn expand-fn}))))
+                                 (go (while true
+                                       (let [[width height] (<! c)]
+                                         (resize-fn width height)
+                                         (render-fn))))))]
+
+      (let [canvas (into
+                    world
+                    {
+                     :render-fn render-fn
+                     :resize-fn resize-fn
+                     :expand-fn expand-fn})]
+        (set-default-once! canvas)
+        canvas))))


performance comments

performance comments

--- src/cljs/triboard/logic/transition.cljs
+++ src/cljs/triboard/logic/transition.cljs
@@ -121,7 +121,9 @@
   []
   (let [b (board/new-board)
         t (all-transitions b)]
-    (time (dotimes [i 100] (all-transitions b))) ;; TODO - 12300 turns in loop (55 ms for a transduce)
+    (time (dotimes [i 100] (all-transitions b)))
+    ;; TODO - 12300 turns in loop (55 ms for a transduce) => need better algo
+    ;; The add-destination removal makes us gain around 50 ms
     (time (dotimes [i 100]
             (doall
               (map


Add more control buttons

Add more control buttons

--- src/devcards/discuss/devcards/core.cljs
+++ src/devcards/discuss/devcards/core.cljs
@@ -3,6 +3,7 @@
             [cljs.test :refer-macros [testing is are]]
             [om.dom :as dom]
             [discuss.core :as core]
+            [discuss.debug :as debug]
             [discuss.extensions]
             [discuss.integration :as integration]
             [discuss.lib :as lib]
@@ -19,9 +20,11 @@

 (defcard control-buttons
          ""
-         (dom/button #js {:className "btn btn-info"
-                          :onClick   core/main}
-                     (dom/i #js {:className "fa fa-fort-awesome"})))
+         (dom/div nil
+                  (dom/button #js {:className "btn btn-info"
+                                   :onClick   core/main}
+                              (dom/i #js {:className "fa fa-fort-awesome"}))
+                  (debug/control-buttons lib/app-state)))

 #_(defcard debug
          (dc/om-root debug/debug-view)


Add docstring.

Add docstring.

--- src/klangmeister/sound/instruments.cljs
+++ src/klangmeister/sound/instruments.cljs
@@ -16,7 +16,9 @@
                          [1.0 0.6 0.4 0.3 0.2])      ; Higher harmonics are weaker.
            (apply add))))

-(defn high-hat [decay]
+(defn high-hat
+  "An imitation high-hat, made with white noise."
+  [decay]
   (fn [_]
     (connect->
       white-noise


disable babelrc behaviour for node_modules

--- src/main/shadow/cljs/npm/transform.cljs
+++ src/main/shadow/cljs/npm/transform.cljs
@@ -22,7 +22,8 @@
         opts
         #js {:presets presets
              :plugins plugins
-             :babelrc true
+             ;; only allow babelrc processing for project files
+             :babelrc (not (str/includes? resource-name "node_modules"))
              :filename resource-name
              :highlightCode false
              :sourceMaps true}


Fix current-mode docstring.

Fix current-mode docstring.

--- src/org/playasophy/wonderdome/state.clj
+++ src/org/playasophy/wonderdome/state.clj
@@ -6,7 +6,7 @@

 (defn current-mode
-  "Determines the current mode from the system state map."
+  "Returns the current mode record from the state map."
   [state]
   (get (:modes state) (:current-mode state)))


Another rationale and typo fix

Another rationale and typo fix

--- src/themis/core.clj
+++ src/themis/core.clj
@@ -14,11 +14,13 @@
 ;;    and seq'ing the results together
 ;; 4. Validation is often domain specific, and the library should be open
 ;;    for modification to adapt easily to different requirements
+;; 5. Validation results should not be conj'd/merge'd onto the original data
+;;    (unless the user specifically did that)
 ;;
 ;; ### Assumptions and expectations
 ;;
 ;; Themis attempts to make no assumptions about the data structure you're
-;; validation, the results your validator functions return, or how
+;; validating, the results your validator functions return, or how
 ;; you want to package up the results of a full `validation`.
 ;;
 ;; When assumptions are made, there is always an escape hatch allowing


Add some pretty print configuration for lein

--- clojure/profiles.clj
+++ clojure/profiles.clj
@@ -1,8 +1,13 @@
 {:user {:ultra {:color-scheme :solarized_dark
-                :stacktraces  true}
+                :stacktraces  true
+                :repl true
+                :java true
+                :tests true}
         :plugins [[lein-try "0.4.3"]
                   [lein-ancient "0.6.10-SNAPSHOT"]
                   [lein-kibit "0.1.2"]
                   [jonase/eastwood "0.2.3"]
-                  ;[venantius/ultra "0.5.0"]
-                 ]}}
+                  ;[venantius/ultra "0.5.1"]
+                 ]
+        :repl-options {:init (set! *print-length* 42)}
+	}}


clojure profiles formatting

clojure profiles formatting

--- clojure/profiles.clj
+++ clojure/profiles.clj
@@ -5,8 +5,7 @@
                        ]
         :injections [(use '[clojure.pprint :only [pp pprint]])
                      (use 'alex-and-georges.debug-repl)]
-        :plugins [
-                  [lein-ancient "0.6.7"]
+        :plugins [[lein-ancient "0.6.7"]
                   [lein-cljfmt "0.3.0"]
                   [lein-kibit "0.1.2"]
                   [lein-pprint "1.1.1"]


indentation

indentation

--- test/celestial/integration/proxmox.clj
+++ test/celestial/integration/proxmox.clj
@@ -31,7 +31,7 @@
     (.delete ct*)))

 (with-defaults
- (with-state-changes [(before :facts (do (clear-range :proxmox) (initialize-networking)))]
+   (with-state-changes [(before :facts (do (clear-range :proxmox) (initialize-networking)))]
     (fact "non generated ip" :integration :proxmox :generators
        (running-seq (vconstruct d/redis-prox-spec)))

@@ -42,13 +42,9 @@
      (fact "bridged address" :integration :proxmox :bridge
        (running-seq (vconstruct d/redis-bridged-prox)))

-     (fact "cluster" :integration :proxmox :bridge :cluster
+     (fact "clustered proxmox" :integration :proxmox :bridge :cluster
        (with-conf d/clustered-prox
          (running-seq (vconstruct (assoc-in d/redis-bridged-prox [:proxmox :node] "proxmox-b")))))
-
-     (fact "proxmox 3" :integration :proxmox-3
-       (with-conf d/proxmox-3
-         (running-seq (vconstruct (assoc-in d/redis-bridged-prox [:proxmox :node] "proxmox-3")))))

      (fact "centos bridge" :integration :proxmox :bridge :centos
        (with-conf d/clustered-prox


Minor fixups: - Fix problem 1st time problem when store/latest doesn't exist. - Copy logfile on jsch error.

--- src/jepsen/voltdb/runner.clj
+++ src/jepsen/voltdb/runner.clj
@@ -132,8 +132,9 @@
   "Moves jepsen.log to store/latest/"
   []
   (let [f  (io/file "jepsen.log")
-        f2 (io/file "store/latest/jepsen.log")]
-    (when (and (.exists f) (not (.exists f2)))
+        f2 (io/file "store/latest/jepsen.log")
+	d1 (io/file "store/latest")]
+    (when (and (.exists f) (.exists d1) (not (.exists f2)))
       ; Can't just rename because log4j retains the filehandle
       (io/copy f f2)
       (spit f "" :append false))))
@@ -182,5 +183,6 @@
       (move-logfile!)
       (System/exit 0))
     (catch Throwable t
+      (move-logfile!)
       (fatal t "Oh jeez, I'm sorry, Jepsen broke. Here's why:")
       (System/exit 255))))


(PDB-3745) Increase autovacuum vacuum scale factor

Prior to this commit, the factsets, catalogs, and certnames tables
were autovacuumed far too frequently.

This commit changes the percentage change before the table
is considered for autovacuuming.  The way these tables are
inserted and updated apparently moves the counter for changes
forward when the rows can't be reclaimed.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1495,6 +1495,12 @@
    "alter table fact_paths add constraint fact_paths_path_type_unique unique(path, value_type_id)")

   {::vacuum-analyze #{"factsets"}})
+
+(defn autovacuum-vacuum-scale-factor-factsets-catalogs-certnames []
+  (jdbc/do-commands
+    "ALTER TABLE factsets  SET ( autovacuum_vacuum_scale_factor=0.80 );"
+    "ALTER TABLE catalogs  SET ( autovacuum_vacuum_scale_factor=0.75 );"
+    "ALTER TABLE certnames SET ( autovacuum_vacuum_scale_factor=0.75 );"))

 (def migrations
   "The available migrations, as a map from migration version to migration function."
@@ -1539,7 +1545,8 @@
    63 add-job-id
    64 rededuplicate-facts
    65 varchar-columns-to-text
-   66 jsonb-facts})
+   66 jsonb-facts
+   67 autovacuum-vacuum-scale-factor-factsets-catalogs-certnames})

 (def desired-schema-version (apply max (keys migrations)))


fix create-topics called from inside startup-resources

--- kafka-clj/test/kafka_clj/test_utils.clj
+++ kafka-clj/test/kafka_clj/test_utils.clj
@@ -68,7 +68,7 @@
         res {:kafka kafka
              :redis (startup-redis)}]
     (when (not-empty topics)
-      (create-topics kafka topics 1 1))
+      (create-topics res topics 1 1))
     res))

 (defn shutdown-resources


layer initialiser

layer initialiser

--- src/cljs/infinitelives/pixi/canvas.cljs
+++ src/cljs/infinitelives/pixi/canvas.cljs
@@ -78,3 +78,93 @@
      :renderer rend
      :canvas (or canvas actual-canvas)
      }))
+
+(defn make-stage
+  "Layout the stage structure"
+  [& {:keys [background layers]
+      :or {background 0x000000
+           layers [:backdrop :below :world :above :ui :effect]}}]
+
+  ;(.log js/console (str layers))
+  (let [stage (PIXI/Stage. background)
+        containers (map #(PIXI/DisplayObjectContainer.) layers)
+        ]
+    {
+     :stage stage
+     :layer
+     (into {}
+           (for [[k v] (partition 2 (interleave layers containers))]
+             [k v]))}))
+
+
+(defn- center-container! [canvas layer]
+  (let [canvas-width (.-width canvas)
+        canvas-height (.-height canvas)
+        middle-x (Math/round (/ canvas-width 2))
+        middle-y (Math/round (/ canvas-height 2))]
+
+    (log (str "w:" canvas-width " h:" canvas-height))
+
+    ;; start with world centered
+    (set! (.-position.x layer) middle-x)
+    (set! (.-position.y layer) middle-y)))
+
+
+(defn init
+  "Initialise the canvas element. Pass in optional keys
+
+  :background    background colour (default 0x000000)
+  :expand        if true makes the canvas take the entire window
+  :engine        can be :webgl :canvas or :auto (default :auto)
+  :layers        A list of keywords to refer to layers, from bottom to top
+
+  and either:
+
+  :canvas        a DOM element to use as the canvas
+
+  or:
+
+  :x             x position for the new canvas
+  :y             y position for the new canvas
+  :width         width of new canvas
+  :height        height of new canvas
+  "
+  [& opts]
+  (let [{:keys [stage renderer canvas layer]
+         :as world} (into (apply make-pixi-canvas opts)
+                          (apply make-stage opts ))]
+    ;; add the stages to the canvas
+    (doall
+     (map
+      (fn [[name layer-obj]]
+        (log "adding to:" (str stage) " layer:" (str layer-obj))
+        (.addChild stage layer-obj)
+        (center-container! canvas layer-obj)
+        )
+      layer))
+
+    ;; do the first render
+    (.render renderer stage)
+
+    (let [
+          render (fn [] (.render renderer stage))
+          resize (fn [width height]
+                   (.resize renderer width height)
+                   (doall (map (partial center-container! canvas)
+                               (map second layer))))
+          expand (fn [] (resize (.-innerWidth js/window)
+                                (.-innerHeight js/window)))
+
+          resizer-loop
+          (when (:expand opts) (let [c (events/new-resize-chan)]
+                                 (go (while true
+                                       (let [[width height] (<! c)]
+                                         (resize width height)
+                                         (render))))))]
+
+      (into
+       world
+       {
+        :render-fn render
+        :resize-fn resize
+        :expand-fn expand}))))


Send an X-App-ID: FireCloud http header with every* ajax request (#1387)

add X-App-ID=FireCloud for ajax calls to orch, leo, sam, bond, martha

--- src/cljs/main/broadfcui/utils/ajax.cljs
+++ src/cljs/main/broadfcui/utils/ajax.cljs
@@ -11,6 +11,8 @@

 ;; TODO - make this unnecessary
 (def content-type=json {"Content-Type" "application/json"})
+
+(def app-id {"X-App-ID" "FireCloud"})

 (defonce ^:private recent-ajax-calls (atom #{}))
 (def ^:private double-call-threshold 2000)
@@ -97,6 +99,7 @@
       (call (assoc arg-map
               :url (str url-root service-prefix path)
               :headers (merge (@get-bearer-token-header)
+                              app-id
                               (:headers arg-map))
               :on-done (fn [{:keys [status-code status-text] :as m}]
                          (update-health status-code status-text)
@@ -115,6 +118,7 @@
   (let [on-done (:on-done arg-map)]
     (call (assoc arg-map
             :url (config/martha-url)
+            :headers (merge app-id (:headers arg-map))
             :method "POST"
             :data data
             :on-done (fn [{:keys [status-code status-text] :as m}]
@@ -126,6 +130,7 @@
     (call (assoc arg-map
             :url (str (config/bond-url) service-prefix path)
             :headers (merge (@get-bearer-token-header)
+                            app-id
                             (:headers arg-map))
             :on-done (fn [{:keys [status-code status-text] :as m}]
                        (update-health status-code status-text)


Use database function for timestamps

Use database function for timestamps

This ensures that our timestamps properly have time zones, and have the
same time zone as the database.

--- src/com/puppetlabs/cmdb/scf/storage.clj
+++ src/com/puppetlabs/cmdb/scf/storage.clj
@@ -187,17 +187,16 @@

 (defn deactivate-node!
   "Deactivate the given host, recording the current time. If the node is
-  currently inactivate, no change is made."
+  currently inactive, no change is made."
   [certname]
   {:pre [(string? certname)]}
-  (let [timestamp (java.sql.Timestamp. (.getTime (java.util.Date.)))]
-    (sql/update-values :certnames
-      ["name=? AND deactivated IS NULL" certname]
-      {:deactivated timestamp})))
+  (sql/do-prepared "UPDATE certnames SET deactivated = current_timestamp
+                    WHERE name=? AND deactivated IS NULL"
+                   [certname]))

 (defn node-deactivated-time
-  "Returns the time the node specified by `certname` is inactive, or nil if
-  it's activate."
+  "Returns the time the node specified by `certname` was deactivated, or nil if
+  the node is currently active."
   [certname]
   {:pre [(string? certname)]}
   (sql/with-query-results result-set
@@ -220,8 +219,8 @@
          (instance? java.util.Date time)]}
   (let [timestamp (java.sql.Timestamp. (.getTime time))
         replaced  (sql/update-values :certnames
-                    ["name=? AND (deactivated<? OR deactivated IS NULL)" certname timestamp]
-                    {:deactivated nil})]
+                                     ["name=? AND (deactivated<? OR deactivated IS NULL)" certname timestamp]
+                                     {:deactivated nil})]
     (> (first replaced) 0)))

 (defn add-catalog-metadata!


Allow the aleph server to be fully configurable

--- modules/aleph/src/modular/aleph.clj
+++ modules/aleph/src/modular/aleph.clj
@@ -7,13 +7,13 @@
    [modular.ring :refer (request-handler WebRequestHandler)]
    [aleph.http :as http]))

-(defrecord Webserver [port]
+(defrecord Webserver []
   Lifecycle
   (start [component]
     (if-let [provider (first (filter #(satisfies? WebRequestHandler %) (vals component)))]
       (let [h (request-handler provider)]
         (assert h)
-        (let [server (http/start-server h {:port port})]
+        (let [server (http/start-server h component)]
           (assoc component :server server)))
       (throw (ex-info (format "aleph http server requires the existence of a component that satisfies %s" WebRequestHandler)
                       {:component component})))
@@ -24,10 +24,11 @@
       (.close server)
       (dissoc component :server))))

-(def new-webserver-schema {:port s/Int})
+(def new-webserver-schema {:port s/Int
+                           s/Keyword s/Any})

 (defn new-webserver [& {:as opts}]
   (->> opts
-    (merge {:port 8080})
+    (merge {:port 0})
     (s/validate new-webserver-schema)
     map->Webserver))


stop only when you have to

stop only when you have to

--- src/vc/provider.clj
+++ src/vc/provider.clj
@@ -50,7 +50,9 @@
         (power-on hostname)
         (wait-for-guest hostname [10 :minute])))

-  (stop [this] (power-off hostname))
+  (stop [this]
+        (when-not (= (.status this) "stopped")
+          (power-off hostname)))

   (status [this]
      (try+ (status hostname)


Remove before/after usage from describe1 examples

--- src/test/clojure/examples/describe1.clj
+++ src/test/clojure/examples/describe1.clj
@@ -1,6 +1,7 @@
 (ns examples.describe1
   (:use lazytest.describe
-	[lazytest.context.stateful :only (stateful)]))
+	[lazytest.context :only (fn-context)]
+	[lazytest.context.stateful :only (stateful-fn-context)]))

 (describe +
   (it "computes the sum of 3 and 4"
@@ -36,16 +37,16 @@
 	   (> root 1))))

 (describe "Addition with a context"
-  (with [(before (println "This happens before each test example"))
-	 (after (println "This happens after each test example"))]
+  (with [(fn-context #(println "This happens before each test example")
+		     #(println "This happens after each test example"))]
     (it "adds small numbers"
       (= 7 (+ 3 4)))
     (it "adds large numbers"
       (= 7000 (+ 3000 4000)))))

 (describe "Addition with a context"
-  (with [(before (println "This happens before all tests"))
-	 (after (println "This happens after all tests"))]
+  (with [(fn-context #(println "This happens before all tests")
+		     #(println "This happens after all tests"))]
     (testing "with a nested group"
       (it "adds small numbers"
 	(= 7 (+ 3 4)))
@@ -53,8 +54,11 @@
 	(= 7000 (+ 3000 4000))))))

 (describe "Square root of two with state"
-  (using [root (stateful (before (Math/sqrt 2)))]
+  (using [root (stateful-fn-context
+		  (fn [] (Math/sqrt 2))
+		  (fn [x] (println "All done with" x)))]
     (it "is less than 2"
       (> 2 @root))
     (it "is more than 1"
       (< 1 @root))))
+