refactor

refactor

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -54,7 +54,7 @@
   (glog/log logger goog.debug.Logger.Level.FINEST msg))

 ;; TODO dev
-(.setLevel logger goog.debug.Logger.Level.FINE #_ST )
+(.setLevel logger goog.debug.Logger.Level.FINEST )

 ;; --------------------------------------------------------------
 ;; Bootstrap goog require reloading
@@ -292,7 +292,7 @@
   (glog/info logger (str "Session ID: "   (session-id)))
   (glog/info logger (str "Session Name: " (session-name))))

-(defmethod message "ping" [msg] (respond-to msg true))
+(defmethod message "ping" [msg] (respond-to msg {:pong true}))

 (def ^:dynamic *eval-js* js/eval)

@@ -619,6 +619,30 @@
 ;; ------------------------------------------------------------------
 ;; http async polling - long polling
 ;; ------------------------------------------------------------------
+;; long polling is a bit complex - but this currently appears to work as well
+;; as websockets, it is heavier overall and much harder to determine when it is closed
+
+(defn ping [conn] (send-for-response [conn] {:op :ping}))
+
+;; could make no-response behavior configurable
+(defn ping-thread [connections fwsid {:keys [interval
+                                             ping-timeout]
+                                      :or {interval 15000
+                                           ping-timeout 2000}}]
+  (doto (Thread.
+         (fn []
+           (loop []
+             (Thread/sleep interval)
+             (when-let [conn (get @connections fwsid)]
+               (if-not (try
+                         ;; TODO consider re-trying a couple times on failure
+                         (deref (ping conn) ping-timeout false)
+                         (catch Throwable e
+                           false))
+                 (swap! connections dissoc fwsid)
+                 (recur))))))
+    (.setDaemon true)
+    (.start)))

 ;; agents would be easier but heavier and agent clean up is harder
 (defn long-poll-send [comm-atom msg]
@@ -644,17 +668,31 @@
                        (assoc comm :respond respond)))
     (when @has-messages (long-poll-send comm-atom nil))))

-;; TODO this is an abstract part of sending a message and getting a
-;; response
-(defn ping [conn]
-  (let [prom (promise)
-        uuid (str (java.util.UUID/randomUUID))
-        listener (fn listen [msg]
-                   (when (= uuid (:uuid msg))
-                     (deliver prom true)
-                     (remove-listener listen)))]
-    (add-listener listener)
-    ((:send-fn conn) conn (json/write-str {:uuid uuid :op :ping}))
+;; may turn this into a multi method
+(defn connection-send [{:keys [send-fn] :as conn} data]
+  (send-fn conn data))
+
+(defn send-for-response [connections msg]
+  ;; TODO remove all listeners after single response?
+  ;; or have one listener and one uuid
+  (let [prom (promise)]
+    (doseq [conn connections]
+      (let [uuid (str (java.util.UUID/randomUUID))
+            listener (fn listen [msg]
+                       (when (= uuid (:uuid msg))
+                         (when-let [result (:response msg)]
+                           (deliver prom
+                                    (if (instance? clojure.lang.IMeta result)
+                                      (vary-meta result assoc ::message msg)
+                                      result)))
+                         (remove-listener listen)))]
+        (add-listener listener)
+        (connection-send
+         conn
+         (json/write-str
+          (-> (select-keys conn [:session-id :session-name])
+              (merge msg)
+              (assoc :uuid uuid))))))
     prom))

 (defn http-long-polling-connect [ring-request respond raise]
@@ -671,34 +709,23 @@
                    :send-fn (fn [conn msg]
                               (long-poll-send (::comm-atom conn) msg))})]
         (respond (json-response (naming-response conn)))
-        ;; keep alive
-        ;; TODO this behavior should be configurable
-        ;; this might not be needed at all
-        ;; TODO abstract this to a fn
-        (doto (Thread.
-               (let [connections *connections*]
-                 (fn []
-                   (let [msg (json/write-str {:op :ping :alive-check true})]
-                     (loop []
-                       (Thread/sleep 15000)
-                       (when-let [conn (get @connections fwsid)]
-                         (if-not (try
-                                   ;; TODO this short timeout could be a problem if an
-                                   ;; env has a long running eval
-                                   ;; this could reuse the eval timeout
-                                   (deref (ping conn) 2000 false)
-                                   (catch Throwable e
-                                     false))
-                           (swap! connections dissoc fwsid)
-                           (recur))))))))
-          (.setDaemon true)
-          (.start)))
+
+        ;; keep alive with ping thread
+        ;; This behavior is much more subtle that it appears, it is far better
+        ;; than webserver triggered async timeout because it doesn't
+        ;; leave behind an orphaned respond-fn
+        ;; also it helps us remove lost connections, as I haven't found
+        ;; a way to discover if an HTTPChannel is closed on the remote endpoint
+
+        ;; TODO a short ping-timeout could be a problem if an
+        ;; env has a long running eval
+        ;; this could reuse the eval timeout
+        (ping-thread *connections* fwsid {:interval 15000 :ping-timeout 2000}))
       (let [conn (get @*connections* fwsid)]
         (if fwinit
           (do
-            ;; TODO place this after the response?
-            (swap! *connections* assoc-in [fwsid :created-at] (System/currentTimeMillis))
-            (respond (json-response (naming-response conn))))
+            (respond (json-response (naming-response conn)))
+            (swap! *connections* assoc-in [fwsid :created-at] (System/currentTimeMillis)))
           (do
             (long-poll-capture-respond (::comm-atom conn) respond)
             (swap! *connections* assoc-in [fwsid ::alive-at] (System/currentTimeMillis))))))))
@@ -744,30 +771,8 @@
       (Thread/sleep 500)
       (recur))))

-;; may turn this into a multi method
-(defn connection-send [{:keys [send-fn] :as conn} data]
-  (send-fn conn data))
-
 (defn send-for-eval [connections js]
-  (let [prom (promise)]
-    (doseq [conn connections]
-      (let [uuid (str (java.util.UUID/randomUUID))
-            listener (fn listen [msg]
-                       (when (= uuid (:uuid msg))
-                         (when-let [result (:response msg)]
-                           (deliver prom (vary-meta
-                                          result
-                                          assoc ::message msg)))
-                         (remove-listener listen)))]
-        (add-listener listener)
-        (connection-send
-         conn
-         (json/write-str
-          (assoc (select-keys conn [:session-id :session-name])
-                 :uuid uuid
-                 :op :eval
-                 :code js)))))
-    prom))
+  (send-for-response connections {:op :eval :code js}))

 (defn eval-connections [{:keys [focus-session-name
                                 broadcast] :as repl-env}]
@@ -785,16 +790,37 @@
                         connections))]
     (if broadcast connections (take 1 connections))))

+(defn trim-last-newline [args]
+  (if-let [args (not-empty (filter string? args))]
+    (conj (vec (butlast args))
+          (string/trim-newline (last args)))
+    args))
+
+(defn print-to-stream [stream args]
+  (condp = stream
+    :out (apply println args)
+    :err (binding [*out* *err*]
+           (apply println args))))
+
+(defn repl-env-print [repl-env stream args]
+  (when-let [args (not-empty (filter string? args))]
+    (when (and (:out-print-fn repl-env) (= :out stream))
+      (apply (:out-print-fn repl-env) args))
+    (when (and (:err-print-fn repl-env) (= :err stream))
+      (apply (:err-print-fn repl-env) args))
+    (let [args (trim-last-newline args)]
+      (when (:print-to-output-streams repl-env)
+        (if-let [bprinter @(:bound-printer repl-env)]
+          (bprinter stream args)
+          (print-to-stream stream args))))))
+
 (let [timeout-val (Object.)]
   (defn evaluate [{:keys [focus-session-name ;; just here for consideration
                           repl-timeout
                           broadcast] :as repl-env} js]
     (reset! (:bound-printer repl-env)
             (bound-fn [stream args]
-              (condp = stream
-                :out (apply println args)
-                :err (binding [*out* *err*]
-                       (apply println args)))))
+              (print-to-stream stream args)))
     (wait-for-connection repl-env)
     (let [ev-connections (eval-connections repl-env)
           result (let [v (deref (send-for-eval ev-connections js)
@@ -807,7 +833,7 @@
                      v))]
       (when-let [out (:out result)]
         (when (not (string/blank? out))
-          (println (string/trim-newline out))))
+          (repl-env-print repl-env :out [(string/trim-newline out)])))
       result)))

 (defn run-default-server [options connections]
@@ -852,18 +878,7 @@
                     (let [args (if-not (= 1 (count session-ids))
                                  (cons (str "[Session:-----:" session-name "]\n") args)
                                  args)]
-                      ;; first handle out-print-fn
-                      (when (and (:out-print-fn repl-env) (= :out stream))
-                        (apply (:out-print-fn repl-env) args))
-                      (when (and (:err-print-fn repl-env) (= :err stream))
-                        (apply (:err-print-fn repl-env) args))
-                      (when (:print-to-output-streams repl-env)
-                        (if-let [bprinter @(:bound-printer repl-env)]
-                          (bprinter stream args)
-                          (condp = stream
-                            :out (apply println args)
-                            :err (binding [*out* *err*]
-                                   (apply println args))))))))))))]
+                      (repl-env-print repl-env stream args))))))))]
     (reset! (:printing-listener repl-env) print-listener)
     (add-listener print-listener))
   ;; not sure about this yet
@@ -903,6 +918,7 @@
                        port 9500
                        host "localhost"} :as opts}]
   (merge (FigwheelReplEnv.)
+         ;; TODO move to one atom
          {:server-kill (atom nil)
           :printing-listener (atom nil)
           :bound-printer (atom nil)
@@ -916,6 +932,8 @@
           ;; :last-eval-session-ids (atom nil)
           :focus-session-name (atom nil)
           :broadcast false
+          :ring-handler nil
+          :ring-stack nil
           :port port
           :host host}
          opts))
@@ -977,7 +995,7 @@
   (cljs.repl/-tear-down re)

   (connections-available re)
-
+  (open-connections)
   (evaluate re "33")

   (evaluate re "setTimeout(function() {cljs.core.prn(\"hey hey\")}, 1000);")
@@ -994,11 +1012,12 @@

   (.isReady channel)

-  (ping (first (vals @*connections*))
+  (ping ( (vals @*connections*))

         )
-
-  (swap! scratch dissoc :print-msg?)
+  (swap! *connections* dissoc "99785176-1793-4814-938a-93bf071acd2f")
+
+  (swap! scratch dissoc :print-msg)
   scratch
   *connections*
   (deref


Construct a singleton AudioContext.

Construct a singleton AudioContext.

--- src/mash_commander/core.cljs
+++ src/mash_commander/core.cljs
@@ -29,15 +29,17 @@
                             (close! ch))))
     ch))

+(def audio-context
+  (let [AudioContext (or (.-AudioContext js/window)
+                         (.-webkitAudioContext js/window))]
+    (AudioContext.)))
+
 (defn play-audio [buffer]
   (go
-    (let [AudioContext (or (.-AudioContext js/window)
-                           (.-webkitAudioContext js/window))
-          context (AudioContext.)
-          decoded-buffer (<! (decode-audio-data context buffer))
-          source (doto (.createBufferSource context)
+    (let [decoded-buffer (<! (decode-audio-data audio-context buffer))
+          source (doto (.createBufferSource audio-context)
                    (aset "buffer" decoded-buffer))]
-      (.connect source (.-destination context))
+      (.connect source (.-destination audio-context))
       (.start source 0))))

 (def polly-say (chan))


renamed mastersign.wordcloud/setup mastersign.wordcloud/setup-graphics-context

--- src/mastersign/wordcloud.clj
+++ src/mastersign/wordcloud.clj
@@ -73,7 +73,7 @@
     (.dispose graphics)
     word-infos))

-(defn- setup
+(defn- setup-graphics-context
   [g]
   (doto g
     (.setRenderingHint RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)
@@ -248,7 +248,7 @@
   (let [c (point (/ w 2.0) (/ h 2.0))
         bg (translate-area test-area c)]
     (doto g
-      setup
+      setup-graphics-context
       (fill-rect (rectangle 0 0 w h) :color (:background-color args)))
     (when (:debug args)
       (doto g
@@ -272,3 +272,4 @@
         target-file (:target-file args)]
     (when target-file (save-image img target-file))
     (assoc cloud-info :image img)))
+


Workaround incomplete RSyntaxTextArea OS X key bindings.

--- src/sqls/ui/worksheet.clj
+++ src/sqls/ui/worksheet.clj
@@ -1,6 +1,5 @@

 (ns sqls.ui.worksheet
-  (:import (java.awt Point))
   (:use [clojure.string :only (join split-lines trim)])
   (:require [clojure.tools.logging :refer [spy spyf]])
   (:require seesaw.chooser
@@ -10,10 +9,32 @@
             seesaw.table)
   (:require [sqls.ui.dev-util :as ui-dev]
             [sqls.util :refer [str-or-nil?]])
-  [:import [java.awt Dimension Rectangle]
+  [:import [java.awt Dimension Point Rectangle Toolkit]
+           [java.awt.event InputEvent KeyEvent]
            [java.io File]
-           [javax.swing JFrame JPanel JScrollPane JTable JViewport KeyStroke]
-           [javax.swing.table TableColumn]])
+           [javax.swing InputMap JComponent JFrame JPanel JScrollPane JTable JViewport JTextArea KeyStroke]
+           [javax.swing.table TableColumn]
+           [javax.swing.text DefaultEditorKit]
+           [org.fife.ui.rsyntaxtextarea RSyntaxTextAreaDefaultInputMap]])
+
+
+(defn fix-textarea-bindings
+  ^JTextArea
+  [^JTextArea t]
+  (let [is-osx (-> (System/getProperty "os.name") (.toLowerCase) (.startsWith "mac os x"))]
+    (when is-osx
+      (let [fix-map (fn [^InputMap m]
+                      (let [default-modifier (-> (Toolkit/getDefaultToolkit) (.getMenuShortcutKeyMask))
+                            shift InputEvent/SHIFT_MASK]
+                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_LEFT (bit-or default-modifier shift)) DefaultEditorKit/selectionBeginLineAction)
+                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_RIGHT (bit-or default-modifier shift)) DefaultEditorKit/selectionEndLineAction)
+                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_HOME shift) DefaultEditorKit/selectionBeginAction)
+                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_END shift) DefaultEditorKit/selectionEndAction)
+                        m))
+            base-map (RSyntaxTextAreaDefaultInputMap.)
+            new-map (fix-map base-map)]
+        (.setInputMap t JComponent/WHEN_FOCUSED new-map)))
+    t))

 (defn create-worksheet-frame
@@ -52,10 +73,10 @@
         ;            (let [[_ _ w h] dimensions]
         ;              [h :by w]))
         ;_ (println (format "pref size: %s" pref-size))
-        query-text-area (seesaw.rsyntax/text-area :id :sql
-                                                  :syntax :sql
-                                                  :columns 80
-                                                  :rows 25)
+        query-text-area (fix-textarea-bindings (seesaw.rsyntax/text-area :id :sql
+                                                                         :syntax :sql
+                                                                         :columns 80
+                                                                         :rows 25))
         query-text-area-scrollable (seesaw.core/scrollable query-text-area)
         results-panel (seesaw.core/vertical-panel :id :results-panel
                                                   :preferred-size [800 :by 400])
@@ -139,6 +160,7 @@
   (assert (not= frame nil))
   (let [ctrl-enter-keystroke (seesaw.keystroke/keystroke "control ENTER")
         sql-text-area (seesaw.core/select frame [:#sql])]
+    (assert (not (nil? sql-text-area)))
     (seesaw.core/listen sql-text-area :key-pressed (partial on-key-press handler ctrl-enter-keystroke))))


Fix :offset formater for datetime.

Fix :offset formater for datetime.

--- src/uxbox/util/datetime.cljs
+++ src/uxbox/util/datetime.cljs
@@ -75,7 +75,7 @@
    (let [vm (js/moment v)]
      (case fmt
        :unix (.unix vm)
-       :offset (.valueOf v)
+       :offset (.valueOf vm)
        :iso (.toISOString vm)
        (.format vm fmt)))))


Fixed encoding of source videos smaller than target size

--- src/video_server/process.clj
+++ src/video_server/process.clj
@@ -103,6 +103,12 @@
        (map (comp #(Integer/parseInt %) name video-size :width))
        sort first str keyword))

+(defn- largest-size
+  [video]
+  (->> (:containers video)
+       (map (comp #(Integer/parseInt %) name video-size :width))
+       sort last str keyword))
+
 (defn- next-encode-size
   "Returns the next size for the default encoding."
   [video fmt size]
@@ -138,6 +144,12 @@
   (and (not-any? #(= (:mimetype %) "text/vtt") (:subtitles video))
        (some #(not= (:mimetype %) "text/vtt") (:subtitles video))))

+(defn largest-encode-size
+  "Returns the largest encoding size determined by the minimum of the
+  video size and requested encoding size."
+  [video size]
+  (keyword (str (min (->> size name (Integer/valueOf)) (->> (largest-size video) name (Integer/valueOf))))))
+
 (defn- encode
   "Creates an encoding spec and queues it for processing."
   [folder video fmt size minimize?]
@@ -150,7 +162,8 @@
   (log/debug "processing video" (str video))
   (when (should-encode-subtitles? video)
     (encode-subtitles folder video))
-  (let [[fmt size minimize?] (next-encoding video fmt size apple? download min-download?)]
+  (let [size (largest-encode-size video size)
+        [fmt size minimize?] (next-encoding video fmt size apple? download min-download?)]
     (if (and size fmt)
       (encode folder video fmt (encode-size video size) minimize?)
       (when-not *fake-encode*


:sparkles: Properly memoize higher order components.

--- frontend/src/uxbox/main/exports.cljs
+++ frontend/src/uxbox/main/exports.cljs
@@ -41,51 +41,62 @@

 (declare shape-wrapper)

-(defn frame-wrapper [objects]
+(defn frame-wrapper
+  [objects]
   (mf/fnc frame-wrapper
     [{:keys [shape] :as props}]
-    (let [childs (mapv #(get objects %) (:shapes shape))
-          shape-wrapper (shape-wrapper objects)
-          frame-shape (frame/frame-shape shape-wrapper)
+    (let [childs (mapv #(get objects %)
+                       (:shapes shape))
+          shape-wrapper (mf/use-memo (mf/deps objects)
+                                     #(shape-wrapper objects))
+          frame-shape   (mf/use-memo (mf/deps objects)
+                                     #(frame/frame-shape shape-wrapper))
           shape (geom/transform-shape shape)]
       [:& frame-shape {:shape shape :childs childs}])))

-(defn group-wrapper [objects]
+(defn group-wrapper
+  [objects]
   (mf/fnc group-wrapper
     [{:keys [shape frame] :as props}]
-    (let [children (mapv #(get objects %) (:shapes shape))
-          shape-wrapper (shape-wrapper objects)
-          group-shape (group/group-shape shape-wrapper)]
+    (let [children (mapv #(get objects %)
+                         (:shapes shape))
+          shape-wrapper (mf/use-memo (mf/deps objects)
+                                     #(shape-wrapper objects))
+          group-shape   (mf/use-memo (mf/deps objects)
+                                     #(group/group-shape shape-wrapper))]
       [:& group-shape {:frame frame
                        :shape shape
                        :children children}])))

-(defn shape-wrapper [objects]
+(defn shape-wrapper
+  [objects]
   (mf/fnc shape-wrapper
     [{:keys [frame shape] :as props}]
-    (when (and shape (not (:hidden shape)))
-      (let [shape (geom/transform-shape frame shape)
-            opts #js {:shape shape :frame frame}]
-        (case (:type shape)
-          :curve [:> path/path-shape opts]
-          :text [:> text/text-shape opts]
-          :icon [:> icon/icon-shape opts]
-          :rect [:> rect/rect-shape opts]
-          :path [:> path/path-shape opts]
-          :image [:> image/image-shape opts]
-          :circle [:> circle/circle-shape opts]
-          :group [:> (group-wrapper objects) opts]
-          nil)))))
+    (let [group-wrapper (mf/use-memo (mf/deps objects) #(group-wrapper objects))]
+      (when (and shape (not (:hidden shape)))
+        (let [shape (geom/transform-shape frame shape)
+              opts #js {:shape shape :frame frame}]
+          (case (:type shape)
+            :curve [:> path/path-shape opts]
+            :text [:> text/text-shape opts]
+            :icon [:> icon/icon-shape opts]
+            :rect [:> rect/rect-shape opts]
+            :path [:> path/path-shape opts]
+            :image [:> image/image-shape opts]
+            :circle [:> circle/circle-shape opts]
+            :group [:> group-wrapper opts]
+            nil))))))

 (mf/defc page-svg
+  {::mf/wrap [mf/memo]}
   [{:keys [data] :as props}]
   (let [objects (:objects data)
         root    (get objects uuid/zero)
         shapes  (->> (:shapes root)
                      (map #(get objects %)))
         dim (calculate-dimensions data)
-        frame-wrapper (frame-wrapper objects)
-        shape-wrapper (shape-wrapper objects)]
+        frame-wrapper (mf/use-memo (mf/deps objects) #(frame-wrapper objects))
+        shape-wrapper (mf/use-memo (mf/deps objects) #(shape-wrapper objects))]
     [:svg {:view-box (str "0 0 " (:width dim 0) " " (:height dim 0))
            :version "1.1"
            :xmlnsXlink "http://www.w3.org/1999/xlink"


ignore keep alive messages

ignore keep alive messages

--- src/wombats/sockets/game.clj
+++ src/wombats/sockets/game.clj
@@ -13,7 +13,7 @@
 (def ^:private game-rooms (atom {}))
 (def ^:private connections (atom {}))

-(defn- remove-chan-form-room
+(defn- remove-chan-from-room
   [game-id chan-id]
   (swap! game-rooms update-in [game-id :players] dissoc chan-id))

@@ -26,7 +26,7 @@
         (map (fn [game-id {players :players}]
                (let [contains-connection? (chan-id players)]
                  (when contains-connection?
-                   (remove-chan-form-room game-id chan-id))))
+                   (remove-chan-from-room game-id chan-id))))
              @game-rooms)
         ;; Remove channel from connections
         (swap! connections dissoc chan-id)))))
@@ -167,7 +167,7 @@
   [_]
   (fn [{:keys [chan-id] :as socket-user}
       {:keys [game-id]}]
-    (remove-chan-form-room game-id chan-id)))
+    (remove-chan-from-room game-id chan-id)))

 (defn- broadcast-game-message
   [game-id formatted-message]
@@ -220,10 +220,11 @@
           msg-payload (get msg :payload {})
           msg-fn (msg-type handler-map)]

-      ;; Log in dev mode
-      (println "\n---------- Start Client Message ----------")
-      (clojure.pprint/pprint msg)
-      (println "------------ End Client Message ----------\n\n")
+      (when-not (= msg-type :keep-alive)
+        ;; Log in dev mode
+        (println "\n---------- Start Client Message ----------")
+        (clojure.pprint/pprint msg)
+        (println "------------ End Client Message ----------\n\n"))

       (msg-fn socket-user msg-payload))))


Fixes FIXMEs.

Fixes FIXMEs.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -562,10 +562,8 @@
                `[]])
             (let [[mode body] body
                   mflat?      (flat? mode)
-                  path        (mapv make-key (if mflat? body (:path body)))
-                  ;; FIXME: clean up
-                  path-map    (assoc-in {} path ())]
-              [`~path-map
+                  path        (mapv make-key (if mflat? body (:path body)))]
+              [`{~path ~'_}
                `[]]))

           :path-exists-with-binding
@@ -769,8 +767,7 @@

     (path-exists-without-binding-clause? clause)
     (let [path    (path-exists-without-binding-clause-path clause)]
-      ;; FIXME: does this make sense?
-      `{})
+      (assoc-in {} (map convert-path-element path) '_))

     (key-matches-with-binding-clause? clause)
     (let [key         (key-matches-with-binding-clause-key clause)


read/play midi file, install custom tuning

--- src/temperaments/core.clj
+++ src/temperaments/core.clj
@@ -6,6 +6,8 @@
         seesaw.chooser
         clojure.math.numeric-tower)
   (:require [overtone.core :as o]
+            [temperaments.midifile :as mf]
+            [temperaments.midiplayer :as mp]
             [clojure.string :as s]
             [eu.algoholic.smart_sort :as ss])
   (:gen-class))
@@ -13,8 +15,6 @@
 (native!)

 (def tonic (atom :a3))
-
-(def tuning (atom :equalTemperament))

 (def tempo (atom 120))

@@ -28,25 +28,25 @@
 (def twelfth2 (* twelfth1 twelfth1))
 (def twelfth7 (* twelfth3 twelfth4))

-(def tuning-map
-  (atom {:equalTemperament (map #(Math/pow 2 (/ % 12)) (range 0 12)),
-         :pythagorean '(1 256/243 9/8 32/27 81/64 4/3 729/512 3/2 128/81 27/16 16/9 243/128),
-         :justIntonation '(1 16/15 9/8 6/5 5/4 4/3 45/32 3/2 8/5 5/3 9/5 15/8)
-         :odonnel (list 1,(* 8/9 twelfth3),
+(def equal-temperament (map #(Math/pow 2 (/ % 12)) (range 0 12)))
+(def pythagorean '(1 256/243 9/8 32/27 81/64 4/3 729/512 3/2 128/81 27/16 16/9 243/128))
+(def just-intonation '(1 16/15 9/8 6/5 5/4 4/3 45/32 3/2 8/5 5/3 9/5 15/8))
+(def odonnel (list 1,(* 8/9 twelfth3),
                         (* 8/9 twelfth4),(* 8/9 twelfth5),
                         (* 8/9 twelfth6),
                         4/3,(* 8/9 twelfth4 twelfth4),
                         (* 4/3 twelfth2),(* 8/9 twelfth6 twelfth4),
                         (* 32/27 twelfth6),(* twelfth6 twelfth4),
-                        (* 32/27 twelfth4 twelfth4))
-         :neidhardt (list 1,(* 8/9 twelfth3),
+                        (* 32/27 twelfth4 twelfth4)))
+(def neidhardt (list 1,(* 8/9 twelfth3),
                         (* 8/9 twelfth4),(* 8/9 twelfth5),
                         (* 8/9 twelfth6),
                         4/3,(* 8/9 twelfth4 twelfth4),
                         (* 4/3 twelfth2),(* 8/9 twelfth6 twelfth4),
                         (* 32/27 twelfth6),(* 9/8 twelfth4 twelfth4),
-                        (* 32/27 twelfth4 twelfth4))
-         }))
+                        (* 32/27 twelfth4 twelfth4)))
+
+(def tuning (atom equal-temperament))

 (def counter (atom 0))

@@ -60,7 +60,7 @@
                  (dec (quot (inc diff) 12))
                  (quot diff 12))
         interval (mod diff 12)]
-    (* tonic-freq (Math/pow 2 octave) (nth (get @tuning-map @tuning) interval))))
+    (* tonic-freq (Math/pow 2 octave) (nth @tuning interval))))

 ;; (if (not (o/server-connected?))
 ;;   ;(o/boot-external-server 57110)
@@ -71,7 +71,10 @@
                        :value 57110)
         port (read-string portstr)]
     (o/connect-external-server port)
-  ))
+    ))
+
+;; (load "midifile")
+;; (load "midi_player")

 (require '[overtone.inst.synth :as syn])

@@ -93,7 +96,8 @@
         mod2 (o/lin-lin:kr (o/lf-noise2:kr 1) -1 1 0.2 1)
         mod3 (o/lin-lin:kr (o/sin-osc:kr (o/ranged-rand 4 6)) -1 1 0.5 1)
         sig (o/distort (* env (o/sin-osc freq)))
-        sig (* amp sig mod2 mod3)]
+        sig (* amp sig ;mod2 mod3
+               )]
     sig))

@@ -260,11 +264,12 @@
 (defn tuning-chooser [e]
   (let [val (value (.getSource e))]
     (case val
-      "Equal"       (reset! tuning :equalTemperament)
-      "Pythagorean" (reset! tuning :pythagorean)
-      "Just"        (reset! tuning :justIntonation)
-      "O'Donnel"        (reset! tuning :odonnel)
-      "Neidhardt"        (reset! tuning :neidhardt)))
+      "Equal"       (reset! tuning equal-temperament)
+      "Pythagorean" (reset! tuning pythagorean)
+      "Just"        (reset! tuning just-intonation)
+      "O'Donnel"    (reset! tuning odonnel)
+      "Neidhardt"   (reset! tuning neidhardt)
+      "Custom"      nil ))
   ;;(println (midi->freq 60))
   )

@@ -298,6 +303,7 @@
     '()))

 (def melody (atom [(cons "Default" (note-to-midi major))]))
+(def midi-file (atom false))

 (defn melody-chooser [e]
   (let [val (value (.getSource e))]
@@ -306,6 +312,11 @@
       "Major Scale"   (reset! melody [(cons "Default" (note-to-midi major))])
       "Minor Scale"   (reset! melody [(cons "Default" (note-to-midi minor))])
       "Patterns"      (reset! melody false)
+      "Midi File"     (reset! melody (let [loadfile (choose-file :type :open)]
+                                       (if loadfile
+                                         (let [path (.getPath loadfile)]
+                                           (mf/song-from-file path))
+                                         @melody)))
       )))

 ;Playing a Melody
@@ -515,14 +526,16 @@
        (play metro (str->instr instr) part {:midi midiq})))))

 (defn play-melody [e]
-  (let [[score len] (if @melody
-                      [@melody 20]
-                      (make-score))
-        metro (o/metronome @tempo)]
-    (doseq [[instr & part] score]
-      (play metro (str->instr instr) part {:midi true}))
-    (o/apply-at (metro len) #(if @repetition (play-melody nil)))
-    ))
+  (if (= (type @melody) temperaments.midifile.Song)
+    (mp/play-song @melody)
+    (let [[score len] (if @melody
+                        [@melody 20]
+                        (make-score))
+          metro (o/metronome @tempo)]
+      (doseq [[instr & part] score]
+        (play metro (str->instr instr) part {:midi true}))
+      (o/apply-at (metro len) #(if @repetition (play-melody nil)))
+      )))

 (defn play-solo [id e]
   (let [[mel rhy _ instr] (make-part id)
@@ -785,51 +798,52 @@
       f)))

-(defn make-mono-panel [id]
-  (let [prefix (s/join ["monochord-" (str id) "-"])
-        tonic-kw (keyword (s/join [prefix "tonic"]))
-        tonic-label (label "Tonic: ")
-        tonic-box (combobox :model keyboard)
-        tonic-bar (horizontal-panel :items [tonic-label tonic-box])
-        note-label (label "Ratio: ")
-        note-ratio (text :text "" :editable? true)
-        note-bar (horizontal-panel :items [note-label note-ratio])
-        mode-button (button :text "Seq."
-                            :listen [:action (fn [e]
-                                               (let [src (.getSource e)
-                                                     curval (config src :text)]
-                                                 (if (= curval "Seq.")
-                                                   (config! src :text "Chord")
-                                                   (config! src :text "Seq."))))])
-        play-button (button :text "Play"
-                            :listen [:action
-                                     (fn [e]
-                                       (let [ton (str->midi (value tonic-box))
-                                             tonfreq (midi->freq ton)
-                                             ratiostr (value note-ratio)
-                                             ratio (read-string ratiostr)
-                                             notefreq (* tonfreq ratio)
-                                             tonvec [tonfreq 1]
-                                             notevec [notefreq 1]
-                                             simul (= "Chord"
-                                                      (config mode-button :text))
-                                             score (if simul
-                                                     [["Default" tonvec]
-                                                      ["Default" notevec]]
-                                                     [["Default" tonvec
-                                                       notevec]])
-                                             metro (o/metronome @tempo)]
-                                         (play-score score false)))])
-        pan (vertical-panel :id :monochord
-                            :size [160 :by 105]
-                            :items [tonic-bar note-bar mode-button play-button])
-        f (frame :title (s/join ["Monochord " (str id)])
-                 :id (s/join ["mono-" (str id)])
-                 :content pan)]
-    (-> f pack! show!)))
+;; (defn make-mono-panel [id]
+;;   (let [prefix (s/join ["monochord-" (str id) "-"])
+;;         tonic-kw (keyword (s/join [prefix "tonic"]))
+;;         tonic-label (label "Tonic: ")
+;;         tonic-box (combobox :model keyboard)
+;;         tonic-bar (horizontal-panel :items [tonic-label tonic-box])
+;;         note-label (label "Ratio: ")
+;;         note-ratio (text :text "" :editable? true)
+;;         note-bar (horizontal-panel :items [note-label note-ratio])
+;;         mode-button (button :text "Seq."
+;;                             :listen [:action (fn [e]
+;;                                                (let [src (.getSource e)
+;;                                                      curval (config src :text)]
+;;                                                  (if (= curval "Seq.")
+;;                                                    (config! src :text "Chord")
+;;                                                    (config! src :text "Seq."))))])
+;;         play-button (button :text "Play"
+;;                             :listen [:action
+;;                                      (fn [e]
+;;                                        (let [ton (str->midi (value tonic-box))
+;;                                              tonfreq (midi->freq ton)
+;;                                              ratiostr (value note-ratio)
+;;                                              ratio (read-string ratiostr)
+;;                                              notefreq (* tonfreq ratio)
+;;                                              tonvec [tonfreq 1]
+;;                                              notevec [notefreq 1]
+;;                                              simul (= "Chord"
+;;                                                       (config mode-button :text))
+;;                                              score (if simul
+;;                                                      [["Default" tonvec]
+;;                                                       ["Default" notevec]]
+;;                                                      [["Default" tonvec
+;;                                                        notevec]])
+;;                                              metro (o/metronome @tempo)]
+;;                                          (play-score score false)))])
+;;         pan (vertical-panel :id :monochord
+;;                             :size [160 :by 105]
+;;                             :items [tonic-bar note-bar mode-button play-button])
+;;         f (frame :title (s/join ["Monochord " (str id)])
+;;                  :id (s/join ["mono-" (str id)])
+;;                  :content pan)]
+;;     (-> f pack! show!)))

 (def save-polychord)
 (def load-polychord)
+(def install-tuning)

 (defn make-poly-panel [id]
   (let [prefix (s/join ["polychord-" (str id) "-"])
@@ -864,14 +878,16 @@
         saver (button :text "Save"
                       :listen [:action save-polychord])
         loader (button :text "Load"
-                      :listen [:action load-polychord])
+                       :listen [:action load-polychord])
+        installer (button :text "Install"
+                          :listen [:action install-tuning])
         fields (make-ratio-circle id 2)
         pan (xyz-panel :id :ratios
                        :size polychord-panel-size
                        :items fields)
         vertpan (vertical-panel :id :polychord
                                 :items [pan mode-button play-button tonic-bar
-                                        sizer-bar saver loader])
+                                        sizer-bar saver loader installer])
         f (frame :title (s/join ["Polychord " (str id)])
                  :id (s/join ["poly-" (str id)])
                  :content vertpan)]
@@ -988,6 +1004,12 @@
           (value! t r))
         (config! panel :items fields)))))

+(defn install-tuning [e]
+  (let [ratios (get-ratios e)
+        tuning-button (select control-frame [:#tuningChooser])]
+    (when (= (count ratios) 12)
+      (reset! tuning ratios)
+      (value! tuning-button "Custom"))))

 ;; handler for tempo-slider
 (listen tempo-slider
@@ -1050,12 +1072,14 @@
                                      :listen [:action tonic-chooser])
                            (label "Tuning:")
                            (combobox :model ["Equal" "Pythagorean" "Just"
-                                             "O'Donnel" "Neidhardt"]
+                                             "O'Donnel" "Neidhardt"
+                                             "Custom"]
                                      :id :tuningChooser
                                      :listen [:action tuning-chooser])
                            (label "Melody:")
                            (combobox :model ["Major Scale" "Minor Scale"
-                                             "Art of Fugue" "Patterns"]
+                                             "Art of Fugue" "Patterns"
+                                             "Midi File"]
                                      :id :melodyChooser
                                      :listen [:action melody-chooser])
                            ])))


use relative path for image

use relative path for image

--- cljs-server/cljs_cheatsheet_server/core.cljs
+++ cljs-server/cljs_cheatsheet_server/core.cljs
@@ -979,7 +979,7 @@
 (hiccups/defhtml header []
   [:header
     [:h1
-      [:img {:src "/img/cljs-ring.svg" :alt "ClojureScript Logo"}]
+      [:img {:src "img/cljs-ring.svg" :alt "ClojureScript Logo"}]
       "ClojureScript Cheatsheet"]
     [:input#searchInput {:type "text" :placeholder "Search"}]])


Add snippets for Shape - Vertex. Issue #87.

--- test/snippets/shape/vertex.clj
+++ test/snippets/shape/vertex.clj
@@ -17,18 +17,20 @@

 (defsnippet begin-shape-end-shape-s {:renderer :p2d}
   (stroke 255 0 0)
-  (doseq [[ind mode] [[0 nil]
-                      [1 :points]
-                      [2 :lines]
-                      [3 :triangles]
-                      [4 :triangle-fan]
-                      [5 :triangle-strip]
-                      [6 :quads]
-                      [7 :quad-strip]]
+  (doseq [[ind begin-mode close-mode]
+          [[0 nil nil]
+           [1 nil :close]
+           [2 :points]
+           [3 :lines]
+           [4 :triangles]
+           [5 :triangle-fan]
+           [6 :triangle-strip]
+           [7 :quads]
+           [8 :quad-strip]]
           :let [base-x (* 150 (mod ind 3))
                 base-y (* 150 (quot ind 3))]]
-    (if mode
-      (begin-shape mode)
+    (if begin-mode
+      (begin-shape begin-mode)
       (begin-shape))
     (vertex (+ base-x 50) (+ base-y 10))
     (vertex (+ base-x 80) (+ base-y 30))
@@ -36,7 +38,9 @@
     (vertex (+ base-x 50) (+ base-y 90))
     (vertex (+ base-x 20) (+ base-y 70))
     (vertex (+ base-x 20) (+ base-y 30))
-    (end-shape :close)))
+    (if close-mode
+      (end-shape close-mode)
+      (end-shape))))

 (defsnippet bezier-vertex-s {:renderer :p3d}
   (camera -400 250 -100 500 250 0 0 0 1)
@@ -53,7 +57,6 @@
   (end-shape :close))

 (defsnippet curve-vertex-s {:renderer :p3d}
-
   (camera 50 200 50 50 0 0 0 0 1)
   (begin-shape)
   (curve-vertex 0 0)


Fix indented-str-block to correctly count length of lines and also to special case first lines and deal with the situation where they may be too long.

--- src/overtone/helpers/doc.clj
+++ src/overtone/helpers/doc.clj
@@ -47,8 +47,22 @@
           (indented-str-block* (str s "\n" (gen-padding indent) (first ls) (gen-padding indent)) (rest ls) 0 max-len indent)
           (indented-str-block* (str s (first ls) (gen-padding indent)) (rest ls) 0 max-len indent))
         (if (> (+ cur-len f-len) max-len)
-          (indented-str-block* (str s "\n" (gen-padding indent)) ls 0 max-len indent)
-          (indented-str-block* (str s (first ls) " ") (rest ls) (+ cur-len f-len) max-len indent))))))
+          (if (> f-len max-len)
+            (do
+              (indented-str-block* (str s "\n" (gen-padding indent) (first ls)) (rest ls) f-len max-len indent))
+            (indented-str-block* (str s "\n" (gen-padding indent)) ls 0 max-len indent))
+          (indented-str-block* (str s (first ls) " ") (rest ls) (+ cur-len f-len 1) max-len indent))))))
+
+(defn- indent-first-line
+  "Ensure the first line isn't overly indented if it also happens to be
+  too long"
+  [s split-text max-len init-indent]
+  (let [f (first split-text)
+        s (str (gen-padding init-indent) f " ")]
+    (cond
+     (.endsWith s "\n")    [(str s (gen-padding init-indent)) 0]
+     (> (count s) max-len) [(str s "\n" (gen-padding init-indent)) 0]
+     :else                 [s (count s)])))

 (defn indented-str-block
   "Appends a list ls of strings to string s in a formatted block with a
@@ -61,15 +75,16 @@
   require them to exist on one large line."
   ([txt max-len wrap-indent] (indented-str-block txt max-len wrap-indent 0))
   ([txt max-len wrap-indent init-indent]
-     (let [id         (str (java.util.UUID/randomUUID))
-           txt        (str/replace txt #"[\n]{2}" id)
-           txt        (str/replace txt "\n" " ")
-           txt        (str/replace txt id "\n\n ")
-           txt        (str/replace txt #"\A +" "")
-           split-text (str/split txt #" +")
-           split-text (cons (str (gen-padding init-indent) (first split-text))
-                            (rest split-text))]
-       (indented-str-block* "" split-text 0 max-len wrap-indent))))
+     (let [id                   (str (java.util.UUID/randomUUID))
+           txt                  (str/trim txt)
+           txt                  (str/replace txt #"[\n]{2}" id)
+           txt                  (str/replace txt "\n" " ")
+           txt                  (str/replace txt id "\n\n ")
+           txt                  (str/replace txt #" +" " ")
+           txt                  (str/replace txt #"\A +" "")
+           split-text           (str/split txt #" +")
+           [first-line cur-len] (indent-first-line "" split-text max-len init-indent)]
+       (indented-str-block* first-line (rest split-text) cur-len (- max-len wrap-indent) wrap-indent))))

 (defn fs
   "Format string(s). Synonym for indented-str-block but with a default


Work on MIDI handling:

Work on MIDI handling:

* Incoming sysex messages are now fed into the event system
* Drop to non-updatable device lists, as this is the common denominator
* Handle quirks of the mmj lib on OS X (which supports sysex messages)
* Add :use-mmj config option to enable mmj lib support
* midi-connected-devices is now connected-midi-devices
* added connected-midi-receivers
* Keep connected-midi-devices and connected-midi-receivers as fns to support the possibility of hot-plugging devices in a future release.

Details
==========

The JVM default MIDI library is currently pretty broken on OS X:

* no support for detecting devices plugged in after the initial device list has been created
* broken sysex messaging

The mmj library (http://www.humatic.de/htools/mmj.htm) fixes the sysex issue but introduces new problems:

* multiple identical devices (same make and model) attached all resolve to the same device object (therefore making only one of the devices usable)
* even worse support for hot-plugging as each call to fetch the device list returns newly created objects (therefore meaning that the object hash is no longer usable to define device uniqueness).
* the returned device list contains duplicates and also contains the default JVM objects, and so must be filtered to either include the

This commit tries its best to patch everything it can. It supports the presence of the mmj library by filtering out all mmj objects by default. If you wish to use the mmj objects in preference to the default JVM objects, them you can add `:use-mmj true` to your `~/.overtone/config.clj`. Also, if you use the `:use-mmj` config option, but haven't actually included the mmj library, then it will just default back to the JVM default objects.

Of course, non of this mmj nonsense happens if you're not running OS X.

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -3,36 +3,30 @@
         [overtone.midi]
         [overtone.at-at :only (mk-pool every)]
         [overtone.libs event counters]
-        [overtone.sc.defaults :only [INTERNAL-POOL]])
+        [overtone.sc.defaults :only [INTERNAL-POOL]]
+        [overtone.helpers.system :only [mac-os?]]
+        [overtone.config.store :only [config-get]])
   (:require [overtone.config.log :as log]))

-(defonce midi-devices* (atom {}))
 (defonce midi-control-agents* (atom {}))
 (defonce poly-players* (atom {}))

-(def EXCLUDED-DEVICES #{"Real Time Sequencer" "Java Sound Synthesizer"})
+(declare connected-midi-devices)
+(declare connected-midi-receivers)

 (defn midi-mk-full-device-key
   "Returns a unique key for the specific device. In the case of multiple
    identical devices, the final integer of the key, dev-num, will be
    different to ensure key uniqueness.

-   Is able to handle either a MIDI device stored in this namespace via
-   detect-midi-devices or a raw MIDI device map from overtone.midi. "
+   Is able to handle either a connected MIDI device stored in this
+   namespace via or a raw MIDI device map from overtone.midi. "
   [dev]
   (or (::full-device-key dev)
       (let [dev-num (or (::dev-num dev)
-                        (::dev-num (get @midi-devices* (:device dev)))
+                        (::dev-num (get (connected-midi-devices) (:device dev)))
                         -1)]
         [:midi-device (dev :vendor) (dev :name) (dev :description) dev-num])))
-
-
-
-(defn midi-connected-devices
-  "Return a list of maps representing all of the connected MIDI
-   devices. Prefer using this fn to midi-devices from overtone.midi"
-  []
-  (vals @midi-devices*))

 (defn midi-find-connected-devices
   "Returns a list of connected MIDI devices where the full device key
@@ -44,7 +38,7 @@
                         (if (= java.util.regex.Pattern (type search))
                           (re-find search key-as-str)
                           (.contains key-as-str search))))]
-    (filter filter-pred (midi-connected-devices))))
+    (filter filter-pred (connected-midi-devices))))

 (defn midi-find-connected-device
   "Returns the first connected MIDI device found where the full device
@@ -65,54 +59,6 @@
   devices rather than just general control events."
   [dev command control-id]
   (concat (midi-mk-full-device-event-key dev command) [control-id]))
-
-(defn midi-event
-  "Place incoming midi-event onto the global event stream."
-  [dev msg & [ts]]
-  (let [command       (:command msg)
-        data2-f       (float (/ (:data2 msg) 127))
-        msg           (assoc msg :data2-f data2-f :velocity-f data2-f)
-        dev-key       (midi-mk-full-device-key dev)
-        dev-event-key (midi-mk-full-device-event-key dev command)]
-    (event [:midi command] msg)
-    (event (midi-mk-full-device-key dev) msg)
-    (event (midi-mk-full-control-event-key dev command (:data1 msg)) msg)
-    (event dev-event-key msg)))
-
-(defn- detect-midi-devices
-  "Designed to run periodically and update the midi-devices* atom with
-  the latest list of midi sources and add event handlers to new devices."
-  []
-  (try
-    (let [old-devs     (set (keys @midi-devices*))
-          devs         (midi-sources)
-          devs         (filter #(not (old-devs (:device %))) devs)
-          devs         (map #(assoc % ::dev-num (next-id (str (:vendor %) (:name %) (:description %)))) devs)
-          devs         (map #(assoc % ::full-device-key (midi-mk-full-device-key %)) devs)
-          receivers    (doall (filter
-                               (fn [dev]
-                                 (try
-                                   (midi-handle-events (midi-in dev) #(midi-event dev %1))
-                                   true
-                                   (catch Exception e
-                                     (log/warn "Can't listen to midi device: " dev "\n" e)
-                                     false)))
-                               devs))
-          device-names (map :name devs)
-          n-devs       (count device-names)
-          dev-map      (apply hash-map (interleave (map :device devs) receivers))]
-      (swap! midi-devices* merge dev-map)
-      (when (pos? n-devs)
-        (log/info "Connected " n-devs " midi devices: " device-names)))
-    (catch Exception ex
-      (println "Got exception in detect-midi-devices!" (.printStackTrace ex)))))
-
-;; The rate at which we poll for new midi devices
-(def MIDI-POLL-RATE 2000)
-
-(defonce __DEVICE-POLLER__
-  (detect-midi-devices))
-;;  (every MIDI-POLL-RATE #'detect-midi-devices INTERNAL-POOL :desc "Check for new midi devices"))

 (defn midi-poly-player
   "Sets up the event handlers and manages synth instances to easily play
@@ -166,7 +112,7 @@
 (defn midi-device-keys
   "Return a list of device event keys for the available MIDI devices"
   []
-  (map midi-mk-full-device-key (vals @midi-devices*)))
+  (map midi-mk-full-device-key (vals (connected-midi-devices))))

 (defn- midi-control-handler
   [state-atom handler mapping msg]
@@ -287,3 +233,150 @@
                                                    (mk-control-key-keyword-for-agent control-key))
                                     (assoc prev control-key new-control-agent)))))]
     (get control-agents control-key)))
+
+(defn- handle-incoming-midi-event
+  "Place incoming midi-event onto the global event stream."
+  [dev msg & [ts]]
+  (let [command       (:command msg)
+        data2-f       (float (/ (:data2 msg) 127))
+        msg           (assoc msg :data2-f data2-f :velocity-f data2-f)
+        dev-key       (midi-mk-full-device-key dev)
+        dev-event-key (midi-mk-full-device-event-key dev command)
+        msg           (assoc msg :dev-key dev-key)]
+    (event [:midi command] msg)
+    (event (midi-mk-full-device-key dev) msg)
+    (event (midi-mk-full-control-event-key dev command (:data1 msg)) msg)
+    (event dev-event-key msg)))
+
+(defn- handle-incoming-midi-sysex
+  "Place incoming midi sysex message onto the global event stream."
+  [dev msg & [ts]]
+  (let [dev-key (midi-mk-full-device-key dev)
+        msg     (assoc msg :dev-key dev-key)]
+    (event (midi-mk-full-device-key dev) :sysex msg)))
+
+(defn- mmj-dev?
+  "Returns true if obj is one of the object from the humatic mmj
+  library. i.e. is in the package de.humatic.mmj"
+  [o]
+  (.contains (str (class (:device o))) "de.humatic.mmj"))
+
+(defn- select-mmj-devices-if-available-on-osx
+  "If the config option :use-mmj is set to true, then if any mmj devices
+   happen to be available, then only use them and remove all other
+   devices. Otherwise, remove all mmj devices and use the default JVM
+   implementations.
+
+   This will only affect OS X systems that have the external mmj lib
+   installed as an extension (http://www.humatic.de/htools/mmj.htm).
+   The mmj lib provides duplicate MIDI objects in addition to
+   the default JVM objects for each device.
+
+   The mmj library is useful as it supports sysex messages which the
+   current JVM implementation doesn't (on OS X). However, it doesn't
+   support multiple identical devices which makes it unsuitable for some
+   usecases.
+
+   Unfortunately the mmj lib is EOL, so on OS X, until the JVM
+   implementations are fixed, we can either have sysex message support
+   or support for multiple similar devices (i.e. two nanoKONTROLs) but
+   not both.
+
+   If we're not running os x, then returns devs unchanged."
+  [devs]
+  (if-not (mac-os?)
+    devs
+    (if (config-get :use-mmj)
+      (if-let [mmjs (seq (filter mmj-dev? devs))]
+        mmjs
+        devs)
+      (remove mmj-dev? devs))))
+
+(defn- remove-duplicate-devices
+  "Removes all duplicate devices, where a duplicate is defined as a
+   device map with the same :device value. (The mmj library appears to
+   return duplicate devices)."
+  [devs]
+  (vals (into {} (map (fn [dev] [(:device dev) dev]) devs))))
+
+(defn- detect-midi-devices
+  "Returns a set of MIDI device maps filtered to remove unwanted devices
+   such as the Java Real Time Sequencer, and de.humatic.mmj
+   duplicates (if on os x)"
+  []
+  (let [devs   (midi-sources)
+        devs   (select-mmj-devices-if-available-on-osx devs)
+        devs   (remove-duplicate-devices devs)
+        devs   (map #(assoc % ::dev-num (next-id
+                                         (str "overtone.studio.midi - device - "
+                                              (:vendor %)
+                                              (:name %)
+                                              (:description %))))
+                    devs)
+        devs   (map #(assoc % ::full-device-key (midi-mk-full-device-key %)) devs)]
+    devs))
+
+(defn- detect-midi-receivers
+  []
+  (let [rcvs   (midi-sinks)
+        rcvs   (select-mmj-devices-if-available-on-osx rcvs)
+        rcvs   (remove-duplicate-devices rcvs)
+        rcvs   (map #(assoc % ::dev-num (next-id
+                                         (str "overtone.studio.midi - receiver - "
+                                              (:vendor %)
+                                              (:name %)
+                                              (:description %))))
+                    rcvs)
+
+        rcvs   (map #(assoc % ::full-device-key (midi-mk-full-device-key %)) rcvs)]
+    rcvs))
+
+(defn- add-listener-handles!
+  "Adds listener handles to send incoming messages to Overtone's event
+   stream. Devices that a handler can't be added to are dropped. Returns
+   a filtered and modified sequence of device maps"
+  [devs]
+  (doall (filter
+          (fn [dev]
+            (try
+              (midi-handle-events (midi-in dev)
+                                  #(handle-incoming-midi-event dev %1)
+                                  #(handle-incoming-midi-sysex dev %1))
+              true
+              (catch Exception e
+                (log/warn "Can't listen to midi device: " dev "\n" e)
+                false)))
+          devs)))
+
+(defonce ^:private connected-midi-devices*
+  (-> (detect-midi-devices) add-listener-handles!))
+
+(defonce ^:private connected-midi-receivers*
+  (detect-midi-receivers))
+
+(defn connected-midi-devices
+  "Returns a sequence of device maps for all 'connected' MIDI
+   devices. By device, we mean a MIDI unit that is capable of sending
+   messages (such as a MIDI piano). By connected, we mean that Overtone
+   is aware of the device and has added event handlers to emit incoming
+   messages from the device as unique events.
+
+   This currently returns a list which was created and cached at boot
+   time. Therefore, devices connected after boot will not be
+   available. We are considering work-arounds to this issue for a future
+   release."
+  []
+  connected-midi-devices*)
+
+(defn connected-midi-receivers
+  "Returns a sequence of device maps for all 'connected' MIDI
+   receivers. By receiver, we mean a MIDI unit that is capable of
+   receiving messages. By connected, we mean that Overtone is aware of
+   the device.
+
+   This currently returns a list which was created and cached at boot
+   time. Therefore, devices connected after boot will not be
+   available. We are considering work-arounds to this issue for a future
+   release."
+  []
+  connected-midi-receivers*)


Prepare for player physics

Prepare for player physics

--- src/try_lwjgl/physics.clj
+++ src/try_lwjgl/physics.clj
@@ -1,7 +1,7 @@
 (ns try-lwjgl.physics
   (:import [com.bulletphysics.collision.broadphase BroadphaseInterface DbvtBroadphase]
            [com.bulletphysics.collision.dispatch CollisionConfiguration CollisionDispatcher CollisionObject DefaultCollisionConfiguration]
-           [com.bulletphysics.collision.shapes CollisionShape SphereShape StaticPlaneShape]
+           [com.bulletphysics.collision.shapes CollisionShape SphereShape CapsuleShape StaticPlaneShape]
            [com.bulletphysics.dynamics DiscreteDynamicsWorld DynamicsWorld RigidBody RigidBodyConstructionInfo]
            [com.bulletphysics.dynamics.constraintsolver ConstraintSolver SequentialImpulseConstraintSolver]
            [com.bulletphysics.linearmath DefaultMotionState MotionState Transform]
@@ -47,6 +47,22 @@
         _ (.setActivationState ball CollisionObject/DISABLE_DEACTIVATION)]
     ball))

+(defn build-player []
+  (let [shape (CapsuleShape. 0.25 2.0)
+        default-transform (Transform. (Matrix4f. (Quat4f. 0 0 0 1)
+                                                 ;; Starting position
+                                                 (Vector3f. 0 5 10)
+                                                 1.0))
+        motion-state (DefaultMotionState. default-transform)
+        inertia (Vector3f. 0 0 0)
+        _ (.calculateLocalInertia shape 2.5 inertia)
+        construction-info (RigidBodyConstructionInfo. 2.5 motion-state shape inertia)
+        _ (set! (.restitution construction-info) 0.25)
+        _ (set! (.angularDamping construction-info) 0.95)
+        body (RigidBody. construction-info)
+        _ (.setActivationState body CollisionObject/DISABLE_DEACTIVATION)]
+    body))
+
 (defn build-world-with-objects []
   (let [world (build-world)
         ground (build-ground)


Fixed get-zid-from-zinvite for microscope recompute

--- src/polismath/microscope.clj
+++ src/polismath/microscope.clj
@@ -8,6 +8,7 @@
             [korma.core :as ko]
             [korma.db :as kdb]
             [environ.core :as env]
+            [clojure.tools.trace :as tr]
             [clojure.tools.logging :as log]
             [clojure.newtools.cli :refer [parse-opts]]))

@@ -28,11 +29,13 @@

 (defn get-zid-from-zinvite
   [zinvite]
-  (:zid
+  (->
     (kdb/with-db (db/db-spec)
       (ko/select "zinvites"
-        (ko/fields [:zid :zinvite])
-        (ko/where {:zinvite zinvite})))))
+        (ko/fields :zid :zinvite)
+        (ko/where {:zinvite zinvite})))
+    first
+    :zid))

 (defn -main


improve comments and narrow wideness of source code

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -32,8 +32,9 @@
                   (:morph  small-plus-plus-np)))

 (defn translate [source-language-short-name & [root]]
-  "generate English translations of all available expressions in source language. Optionally takes a root form of a verb in the source language."
-  ;; example usage: (translate "es" "abrazar")
+  "Generate translations from source language (e.g. 'it' for Italian) into English.
+   Optionally takes a root form of a verb in the source language."
+  ;; Example usage: (translate \"es\" \"abrazar\"
   (rewrite-lexicon)
   (let [spec :top
         ;; {:synsem {:sem {:pred :arrive}}}
@@ -50,50 +51,63 @@
         use-map-fn map
         source-expressions (read-all spec
                                      source-language-short-name)]
-    (count (use-map-fn (fn [source-expression]
-                         (do (log/debug (str source-language-short-name ": " (:surface source-expression)))
-                             (log/debug (str source-language-short-name ": " (get-in (:structure source-expression) [:synsem :sem])))
-                             (let [spec {:synsem {:sem (strip-refs (get-in (:structure source-expression) [:synsem :sem]))}}]
-                               (let [existing-english-expression (read-one spec "en")]
-                                 (if existing-english-expression
-                                   ;; found existing expression: return that.
-                                   (do
-                                     (log/info (str (:surface source-expression) " -> " (:surface existing-english-expression)))
-                                     existing-english-expression)
-                                   ;; else, no existing expression: generate a new one.
-                                   (do
-                                     (log/debug (str "generating from spec: " spec))
-                                     (log/info (str "generating using source expression: '"
-                                                    (:surface source-expression) "'"))
-                                     (try
-                                       (let [result
-                                             (process [{:fill-one-language
-                                                        {:count 1
-                                                         :spec spec
-                                                         :model small-plus-plus-np
-                                                         }}]
-                                                      source-language-short-name)]
-                                         ;; TODO: 'result' is currently returning nil: should return something more indicative
-                                         ;; of what the (process) command did.
-                                         (log/debug (str "process result:" result)))
-                                       (catch Exception e
-                                         (let [catch-and-log-error false]
-                                           (log/error (str "Could not translate source expression: "
-                                                           "'" (get source-expression :surface) "'"
-                                                           " from language: '" source-language-short-name
-                                                           "' with predicate: '"
-                                                           (strip-refs (get-in source-expression [:structure :synsem :sem :pred]))
-                                                           "' into English; subj:"
-                                                           "'" (get-in source-expression [:structure :synsem :sem :subj :pred])
-                                                           "'; source semantics:'"
-                                                           (strip-refs (get-in source-expression [:structure :synsem :sem]))
-                                                           "'" " ; exception: " e))
-                                           (cond
-                                             catch-and-log-error
-                                             (log/info (str "ignoring above error and continuing."))
-                                             true
-                                             (throw e)))))))))))
-                       source-expressions))))
+    (count
+     (use-map-fn
+      (fn [source-expression]
+        (do (log/debug
+             (str source-language-short-name ": "
+                  (:surface source-expression)))
+            (log/debug (str source-language-short-name ": "
+                            (get-in (:structure source-expression) [:synsem :sem])))
+            (let [spec {:synsem {:sem
+                                 (strip-refs (get-in
+                                              (:structure source-expression)
+                                              [:synsem :sem]))}}]
+              (let [existing-english-expression (read-one spec "en")]
+                (if existing-english-expression
+                  ;; found existing expression: return that.
+                  (do
+                    (log/info (str (:surface source-expression)
+                                   " -> " (:surface existing-english-expression)))
+                    existing-english-expression)
+                  ;; else, no existing expression: generate a new one.
+                  (do
+                    (log/debug (str "generating from spec: " spec))
+                    (log/info (str "generating using source expression: '"
+                                   (:surface source-expression) "'"))
+                    (try
+                      (let [result
+                            (process [{:fill-one-language
+                                       {:count 1
+                                        :spec spec
+                                        :model small-plus-plus-np
+                                        }}]
+                                     source-language-short-name)]
+                        ;; TODO: 'result' is currently
+                        ;; returning nil: should return something more indicative
+                        ;; of what the (process) command did.
+                        (log/debug (str "process result:" result)))
+                      (catch Exception e
+                        (let [catch-and-log-error false]
+                          (log/error (str "Could not translate source expression: "
+                                          "'" (get source-expression :surface) "'"
+                                          " from language: '" source-language-short-name
+                                          "' with predicate: '"
+                                          (strip-refs (get-in source-expression
+                                                              [:structure :synsem :sem :pred]))
+                                          "' into English; subj:"
+                                          "'" (get-in source-expression
+                                                      [:structure :synsem :sem :subj :pred])
+                                          "'; source semantics:'"
+                                          (strip-refs (get-in source-expression
+                                                              [:structure :synsem :sem]))
+                                          "'" " ; exception: " e))
+                          (cond
+                            catch-and-log-error
+                            (log/info (str "ignoring above error and continuing."))
+                            true
+                            (throw e)))))))))))
+      source-expressions))))

 (defn all [ & [count]]
   (let [count (if count (Integer. count) 10)
@@ -105,7 +119,8 @@
          (map (fn [lexeme-set]
                 (filter (fn [lexeme]
                           (and
-                           (or true (= (get-in lexeme [:synsem :sem :pred]) :talk)) ;; for development, restrict :pred to a single value.
+                           ;; for development, restrict :pred to a single value.
+                           (or true (= (get-in lexeme [:synsem :sem :pred]) :talk))
                            (= (get-in lexeme [:synsem :cat]) :verb)
                            (= (get-in lexeme [:synsem :infl]) :top)
                            (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
@@ -115,6 +130,7 @@
     (write-lexicon "en" lexicon)
     (log/info (str "done writing lexicon."))
     (log/info (str "generating with this many verbs: " (.size (reduce concat (vals root-verbs)))))
+    ;; TODO: rewrite with threading macro (->)
     (.size (pmap (fn [verb]
                    (let [root-form (get-in verb [:english :english])]
                      (log/debug (str "generating from root-form:" root-form))


don't use futures (s/@//) for lexicons

don't use futures (s/@//) for lexicons

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -31,8 +31,8 @@

 (defn todos [ & [count lexeme]]
   (let [count (if count (Integer. count) 10)
-        lexemes (if lexeme (list (get @lexicon lexeme))
-                    (vals @lexicon))
+        lexemes (if lexeme (list (get lexicon lexeme))
+                    (vals lexicon))
         root-verbs
         (zipmap
          (keys lexicon)


add request execution

add request execution

--- src/ca_recipe/tnywb/core.clj
+++ src/ca_recipe/tnywb/core.clj
@@ -6,3 +6,23 @@
   (try
     (view model)
     (catch Exception e (throw (RenderingException. e)))))
+
+(defn- execute-request [http-request handler]
+  (let [controller (handler :controller) view (handler :view)]
+    (try
+      {:status-code 200
+       :body
+       (render
+        view
+        (controller http-request))}
+      (catch ControllerException e {:status-code (.getStatusCode e) :body ""}) (catch RenderingException e {:status-code 500
+                                                                                :body "Exception while rendering"})
+      (catch Exception e (.printStackTrace e) {:status-code 500 :body ""}))))
+(defn- apply-filters [filters http-request]
+  (let [composed-filter (reduce comp (reverse filters))]
+    (composed-filter http-request))) (defn tinyweb [request-handlers filters]
+(fn [http-request]
+(let [filtered-request (apply-filters filters http-request)
+      path (http-request :path)
+      handler (request-handlers path)]
+  (execute-request filtered-request handler))))


Fixed submit button again...

Fixed submit button again...

--- src-frontend/cljs/cljs_webrepl/core.cljs
+++ src-frontend/cljs/cljs_webrepl/core.cljs
@@ -306,7 +306,7 @@
      [mdl/upgrade
       [:button.mdl-button.mdl-js-button.mdl-button--fab.mdl-js-ripple-effect.mdl-button--colored
        {:disabled disabled?
-        :on-click on-submit}
+        :on-click #(on-submit (:input @state))}
        [:i.material-icons "send"]]]]))

 (defn repl-input [{:keys [state] :as props}]


fixed configure & test

fixed configure & test

--- integration/dda/pallet/dda_managed_vm/app/instantiate_existing.clj
+++ integration/dda/pallet/dda_managed_vm/app/instantiate_existing.clj
@@ -45,20 +45,18 @@
      (provisioning-spec target-config domain-config)
      :summarize-session true)))

-(defn apply-configure
-  [& options]
-  (let [{:keys [summarize-session]}
-        :or {summarize-session true} options]
+(defn apply-configure []
+  (let [target-config (existing/load-targets "targets.edn")
+        domain-config (app/load-domain "vm.edn")]
     (operation/do-apply-configure
-     (provider)
-     (provisioning-spec)
-     :summarize-session summarize-session)))
+     (provider target-config)
+     (provisioning-spec target-config domain-config)
+     :summarize-session true)))

-(defn test "executes the tests on the server"
-  [& options]
-  (let [{:keys [summarize-session]}
-        :or {summarize-session true} options]
+(defn test []
+  (let [target-config (existing/load-targets "targets.edn")
+        domain-config (app/load-domain "vm.edn")]
     (operation/do-server-test
-     (provider)
-     (provisioning-spec)
-     :summarize-session summarize-session)))
+     (provider target-config)
+     (provisioning-spec target-config domain-config)
+     :summarize-session true)))


badge pdf export fix

badge pdf export fix

--- src/clj/salava/badge/pdf.clj
+++ src/clj/salava/badge/pdf.clj
@@ -7,7 +7,8 @@
             [salava.core.util :as u :refer [get-db plugin-fun get-plugins md->html str->qr-base64]]
             [clj-pdf.core :as pdf]
             [clj-pdf-markdown.core :refer [markdown->clj-pdf]]
-            [clojure.string :refer [ends-with?]]
+            [clojure.string :refer [ends-with? blank?]]
+            [salava.user.db :as ud]
             [clojure.java.io :as io]))

 (defqueries "sql/badge/main.sql")
@@ -24,13 +25,13 @@
                            (assoc :qr_code (str->qr-base64 (badge-url ctx (:id %1)))
                                   :endorsements (vec (select-badge-endorsements {:id (:badge_id %1)} (u/get-db ctx)))
                                   :content %2)) badge-with-content temp)]
-    #_(dump badges)
     badges))

 (defn generatePDF [ctx user-id input lang]
     (let [data-dir (get-in ctx [:config :core :data-dir])
           site-url (get-in ctx [:config :core :site-url])
           badges (pdf-generator-helper ctx user-id input)
+          ul (:language (ud/user-information ctx user-id))
           font-path  (first (mapcat #(get-in ctx [:config % :font] []) (get-plugins ctx)))
           font  {:ttf-name (str site-url font-path)}
           stylesheet {:heading-name {:color [127 113 121]
@@ -56,85 +57,89 @@

                                                    [:heading.heading-name (:name %)]
                                                    [:paragraph {:indent 20 :align :center}#_[:line] [:spacer]]
-                                                   [:paragraph.generic {:align :left} (:description %)][:spacer]
+                                                   [:paragraph.generic {:align :left} (or (:description %) "-")][:spacer]
                                                    [:paragraph.generic
-                                                    [:chunk.chunk (str (t :badge/Recipient)": ")] (str $first_name  " " $last_name ) "\n"
-                                                    [:chunk.chunk (str (t :badge/Issuedby)": ")] (:issuer_content_name %)"\n"
-                                                    (when-not (empty? (:creator_name %))
+                                                    [:chunk.chunk (str (t :badge/Recipient ul)": ")] (str $first_name  " " $last_name ) "\n"
+                                                    [:chunk.chunk (str (t :badge/Issuedby ul)": ")] (or (:issuer_content_name %) "-")"\n"
+                                                    (when-not (blank? (:creator_name %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/Createdby)": ")] (:creator_name %)])
-                                                    [:chunk.chunk (str (t :badge/Issuedon)": ")] (date-from-unix-time (long (* 1000 $issued_on)) "date") "\n"
-                                                    (when $expires_on
+                                                        [:chunk.chunk (str (t :badge/Createdby ul)": ")] (:creator_name %)])
+                                                    (when-not (blank? (str $issued_on))
+                                                    [:chunk.chunk (str (t :badge/Issuedon ul)": ")] (date-from-unix-time (long (* 1000 $issued_on)) "date") "\n")
+                                                    (when-not (blank? (str $expires_on))
                                                      [:paragraph
-                                                      [:chunk.chunk (str (t :badge/Expireson)": ")] (date-from-unix-time (long (* 1000 $expires_on)) "date")])
+                                                      [:chunk.chunk (str (t :badge/Expireson ul)": ")] (date-from-unix-time (long (* 1000 $expires_on)) "date")])

                                                     (when-not (empty? $tags)
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/Tags)": ")] (into [:phrase ] (for [t $tags] (str t " ")))])
+                                                        [:chunk.chunk (str (t :badge/Tags ul)": ")] (into [:phrase ] (for [t $tags] (str t " ")))])
                                                     (when-not (empty? $alignments)
                                                       [:paragraph.generic
                                                        [:spacer 0]
-                                                       [:phrase {:size 12 :style :bold} (t :badge/Alignments)]
+                                                       [:phrase {:size 12 :style :bold} (t :badge/Alignments ul)]
                                                        [into [:paragraph ] (for [a $alignments]
                                                                              [:paragraph
                                                                               [:chunk.chunk "Name: "] (:name a) "\n"
                                                                               [:chunk.chunk "Description: "] (:description a) "\n"
                                                                               [:chunk.chunk "Url: "] (:url a) [:spacer 0]]) ]])
                                                     [:paragraph
-                                                      [:chunk.chunk (str (t :badge/CriteriaUrl)": ")] [:anchor {:target (:criteria_url %) :style{:family :times-roman :color [66 100 162]}} (:criteria_url %)]]
+                                                      [:chunk.chunk (str (t :badge/Criteria ul)": ")] [:anchor {:target (:criteria_url %) :style{:family :times-roman :color [66 100 162]}} (or (:criteria_url %) "-")]]
                                                     [:spacer 0]
+                                                    (when-not (blank? (:criteria_content %))
                                                     [:phrase.generic
-                                                     [:chunk.chunk  (t :badge/Criteria)] ]"\n"
-                                                     (markdown->clj-pdf {:spacer {:extra-starting-value 1 :allow-extra-line-breaks? true :single-value 2} :wrap {:global-wrapper :paragraph}} (:criteria_content %))]
+                                                     [:chunk.chunk  (t :badge/Criteria ul)] ]"\n"
+                                                     (markdown->clj-pdf {:spacer {:extra-starting-value 1 :allow-extra-line-breaks? true :single-value 2} :wrap {:global-wrapper :paragraph}} (:criteria_content %)))]

                                                   (when-not (empty? $endorsements)
                                                     [:paragraph.generic
                                                      [:spacer 0]
-                                                     [:phrase {:size 12 :style :bold} (t :badge/BadgeEndorsedBy)]
+                                                     [:phrase {:size 12 :style :bold} (t :badge/BadgeEndorsedBy ul)]
                                                        [:spacer 0]
                                                        (into [:paragraph {:indent 0} ] (for [e $endorsements]
                                                            [:paragraph
-                                                            #_[:chunk.chunk "Endorser: " ] (:issuer_name e) "\n"
-                                                            #_[:chunk.chunk "Issuer url: "] [:anchor {:target (:issuer_url e) :style{:family :times-roman :color [66 100 162]}} (:issuer_url e)] "\n"
+                                                            #_[:chunk.chunk "Endorser: " ] (or (:issuer_name e) "-") "\n"
+                                                            #_[:chunk.chunk "Issuer url: "] [:anchor {:target (:issuer_url e) :style{:family :times-roman :color [66 100 162]}} (or (:issuer_url e) "-")] "\n"
                                                             #_[:chunk.chunk "Issued on: "][:chunk (date-from-unix-time (long (* 1000 (:issued_on e))))] "\n"
-                                                            (markdown->clj-pdf (:content e))]))])
+                                                            (when-not (blank? (:content e))
+                                                            (markdown->clj-pdf (:content e)))]))])

                                                     [:line {:dotted true}]
                                                     [:spacer 0]
-                                                    [:heading.heading-name (t :badge/IssuerInfo)]
+                                                    [:heading.heading-name (t :badge/IssuerInfo ul)]
                                                     [:spacer 0]
-                                                    (when-not (empty? (:issuer_description %))
+                                                    (when-not (blank? (:issuer_description %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/IssuerDescription)": ")] (:issuer_description %)])
+                                                        [:chunk.chunk (str (t :badge/IssuerDescription ul)": ")] (or (:issuer_description %) "-")])
                                                    [:spacer 1]
                                                      [:paragraph.generic
-                                                      [:chunk.chunk (str (t :badge/IssuerWebsite)": ")]
-                                                      [:anchor {:target (:issuer_content_url %) :style{:family :times-roman :color [66 100 162]}} (:issuer_content_url %)]]
-                                                    (when-not (empty? (:issuer_contact %))
+                                                      [:chunk.chunk (str (t :badge/IssuerWebsite ul)": ")]
+                                                      [:anchor {:target (:issuer_content_url %) :style{:family :times-roman :color [66 100 162]}} (or (:issuer_content_url %) "-")]]
+                                                    (when-not (blank? (:issuer_contact %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/IssuerContact)": ")] (:issuer_contact %)])
-                                                    (when-not (empty? (:creator_description %))
+                                                        [:chunk.chunk (str (t :badge/IssuerContact ul)": ")] (:issuer_contact %)])
+                                                    (when-not (blank? (:creator_description %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/CreatorDescription)": ")] (:creator_description %)])
-                                                    (when-not (empty? (:creator_url %))
+                                                        [:chunk.chunk (str (t :badge/CreatorDescription ul)": ")] (:creator_description %)])
+                                                    (when-not (blank? (:creator_url %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/CreatorWebsite)": ")] [:anchor {:target (:creator_url %) :style{:family :times-roman :color [66 100 162]}} (:creator_url %)] "\n"])
-                                                    (when-not (empty? (:creator_contact %))
+                                                        [:chunk.chunk (str (t :badge/CreatorWebsite ul)": ")] [:anchor {:target (:creator_url %) :style{:family :times-roman :color [66 100 162]}} (:creator_url %)] "\n"])
+                                                    (when-not (blank? (:creator_contact %))
                                                       [:paragraph.generic
-                                                        [:chunk.chunk (str (t :badge/CreatorContact)": ")] (:creator_contact %)])
+                                                        [:chunk.chunk (str (t :badge/CreatorContact ul)": ")] (:creator_contact %)])
                                                     (let [issuer-endorsement (select-issuer-endorsements {:id (:issuer_content_id %)} (u/get-db ctx))]
                                                       (when-not (empty? issuer-endorsement)
                                                           [:paragraph.generic
                                                            [:spacer]
-                                                           [:phrase {:size 12 :style :bold} (t :badge/IssuerEndorsedBy)]
+                                                           [:phrase {:size 12 :style :bold} (t :badge/IssuerEndorsedBy ul)]
                                                             [:spacer 0]
                                                             (into [:paragraph {:indent 0} ]
                                                               (for [e issuer-endorsement]
                                                                [:paragraph {:indent 0}
-                                                                #_[:chunk.chunk "Endorser: " ] (:issuer_name e) "\n"
-                                                                #_[:chunk.chunk "Issuer url: "] [:anchor {:target (:issuer_url e) :style{:family :times-roman :color [66 100 162]}} (:issuer_url e)] "\n"
+                                                                #_[:chunk.chunk "Endorser: " ] (or (:issuer_name e) "-") "\n"
+                                                                #_[:chunk.chunk "Issuer url: "] [:anchor {:target (:issuer_url e) :style{:family :times-roman :color [66 100 162]}} (or (:issuer_url e) "-")] "\n"
                                                                 #_[:chunk.chunk "Issued on: "][:chunk.link (date-from-unix-time (long (* 1000 (:issued_on e))))] "\n"
-                                                                (markdown->clj-pdf {:wrap {:global-wrapper :paragraph}} (:content e))]))]))
+                                                                (when-not (blank? (:content e))
+                                                                (markdown->clj-pdf {:wrap {:global-wrapper :paragraph}} (:content e)))]))]))

                                                     [:pdf-table {:align :right :width-percent 100 :cell-border false}
                                                      nil


remove redundant advert function

remove redundant advert function

--- src/clj/salava/core/util.clj
+++ src/clj/salava/core/util.clj
@@ -228,6 +228,3 @@
   ;TODO VALIDATE DATA
   (publish ctx :event {:subject subject :verb verb :object object :type type}))

-(defn advert [ctx subject verb object type country]
-  (publish ctx :advert {:subject subject :verb verb :object object :type type :country country}))
-


save badge showcase initial

save badge showcase initial

--- src/clj/salava/page/main.clj
+++ src/clj/salava/page/main.clj
@@ -17,6 +17,7 @@
             [clj-pdf-markdown.core :refer [markdown->clj-pdf]]
             [clojure.zip :as zip]
             [net.cgrand.enlive-html :as enlive]
+            [clojure.data.json :as json]
             ))

@@ -261,6 +262,11 @@
                               :allow-styling)]
       (html-sanitize policy content))))

+(defn save-badge-showcase! [ctx id block]
+  (let [badges (:badges block)
+        badges->json (-> badges (json/write-str))]
+    (dump badges->json)))
+

 (defn save-page-content! [ctx page-id page-content user-id]

@@ -304,7 +310,11 @@
                        (create-files-block! ctx block)))
             "tag" (if id
                     (update-tag-block! block (get-db ctx))
-                    (insert-tag-block! block (get-db ctx))))))
+                    (insert-tag-block! block (get-db ctx)))
+            "showcase" (save-badge-showcase! ctx id block) #_(if id
+                         (update-badge-showcase ctx block)
+                         (insert-badge-showcase block )
+                         ))))
       (doseq [old-block page-blocks]
         (if-not (some #(and (= (:type old-block) (:type %)) (= (:id old-block) (:id %))) blocks)
           (delete-block! ctx old-block)))


Fix trap timeout

Fix trap timeout

--- src/cljc/robinson/traps.cljc
+++ src/cljc/robinson/traps.cljc
@@ -120,7 +120,8 @@
           trap-locations (make-trap-xy-sequence min-x min-y max-x max-y trap-direction)]
       (-> state
         ;; reveal trap cell
-        (rw/assoc-cell x y :trap-found true)
+        (rw/assoc-cell x y :trap-found     true
+                           :last-triggered (rw/get-time state))
         (rc/append-log "You find a trap")
         ;; add trap obj to place
         (conj-trap-in-current-place (assoc (Trap. ; type


Changed chat channels

Changed chat channels

--- src/cljs/netrunner/chat.cljs
+++ src/cljs/netrunner/chat.cljs
@@ -6,7 +6,8 @@
             [netrunner.auth :refer [avatar authenticated] :as auth]
             [netrunner.ajax :refer [GET]]))

-(def app-state (atom {:channels {:general [] :belgium [] :france []}}))
+(def app-state
+  (atom {:channels {:general [] :francais [] :deutsch [] :espanol [] :america [] :europe [] :asia []}}))

 (def chat-channel (chan))
 (def chat-socket (.connect js/io (str js/iourl "/chat")))


Modified A4 size (mm).

Modified A4 size (mm).

--- src/tames/generators/pdf.clj
+++ src/tames/generators/pdf.clj
@@ -15,7 +15,7 @@
   "application/pdf")

 (def directions { "h" BaseFont/IDENTITY_H
-                  "v"   BaseFont/IDENTITY_V })
+                  "v" BaseFont/IDENTITY_V })

 (def default-fonts (ref {:hmv  (BaseFont/createFont "HeiseiMin-W3" "UniJIS-UCS2-V" BaseFont/EMBEDDED)
                          :hmh  (BaseFont/createFont "HeiseiMin-W3" "UniJIS-UCS2-H" BaseFont/EMBEDDED)
@@ -98,12 +98,14 @@

 (defn draw-line!
   [parent pdf-object]
-  (let [graphics-2d (parent :graphics-2d)]
-    (. graphics-2d drawLine (pdf-object "x1") (pdf-object "y1") (pdf-object "x2") (pdf-object "y2"))))
+  (let [document     (parent :object)
+        context-byte (parent :context-byte)
+        graphics-2d  (PdfGraphics2D. context-byte (. document getWidth) (. document getHeight))]
+    (. graphics-2d drawLine (pdf-object "x1") (pdf-object "y1") (pdf-object "x2") (pdf-object "y2"))
+    (. graphics-2d dispose)))

 (defn add-phrase!
   [parent pdf-object]
-  ;(pprint/pprint pdf-object)
   (let [parent-object (parent :object)
         base-font     (let [font-path (fonts/get-font-file-path (pdf-object "font"))]
                         (if (or (nil? font-path) (= font-path ""))
@@ -164,12 +166,19 @@
   [parent pdf-object]
   (println "Called draw-custom-layout!"))

+(defn insert-new-page!
+  [parent pdf-object]
+  (let [document (parent :object)
+        cb       (parent :context-byte)]
+    (. document newPage)))
+
 (def add-fns {"TextDraw"   draw-text!
               "Phrase"     add-phrase!
               "Paragraph"  add-paragraph!
               "Line"       draw-line!
               "Table"      add-table!
-              "Custom"     draw-custom-layout!})
+              "Custom"     draw-custom-layout!
+              "NewPage"    insert-new-page!})

 (defn print-font-families
   []
@@ -189,14 +198,13 @@
 (defn generate
   "Generate a PDF file"
   [file data]
-  (log/info "A4 width=%f, height=%f" (.. PageSize A4 getWidth) (.. PageSize A4 getHeight))
   (let [page         (if (nil? (data "page"))
-                         { "size" { "width" 210 "height" 295 }}
+                         { "size" { "width" 210 "height" 297 }}
                          (data "page"))
         page-rect    (let [size (page "size")]
                        (if (nil? size)
-                         (. PageSize A4)
-                         (Rectangle. (* 2.83 (size "width")) (* 2.83 (size "height")))))
+                           (. PageSize A4)
+                           (Rectangle. (* 2.83 (size "width")) (* 2.83 (size "height")))))
         page-margins (let [margins (page "margins")]
                        (if (nil? margins)
                            { "left" 20 "right" 20 "top" 20 "bottom" 20 }
@@ -206,14 +214,11 @@
         ]
     (. document open)
     (let [context-byte (.. writer getDirectContent)
-          graphics-2d  (PdfGraphics2D. context-byte (. page-rect getWidth) (. page-rect getHeight))
           parent       {:object       document
                         :context-byte context-byte
-                        :graphics-2d  graphics-2d
                         :font         (@default-fonts :hkgh)
                         :font-size    (float 10.0)}]
-      (add-objects parent (data "pdf_objects"))
-      (. graphics-2d dispose))
+      (add-objects parent (data "pdf_objects")))
     (. document close)
     (. writer close)))


🤠 REPL helpers for adding users to congregations

--- src/territory_bro/routes.clj
+++ src/territory_bro/routes.clj
@@ -164,3 +164,19 @@
   (GET "/api/congregations" request (list-congregations request))
   (GET "/api/congregation/:congregation" request (get-congregation request))
   (GET "/api/congregation/:congregation/qgis-project" request (download-qgis-project request)))
+
+(comment
+  (db/with-db [conn {}]
+    (->> (user/get-users conn)
+         (filter #(= "" (:name (:user/attributes %))))))
+
+  (db/with-db [conn {}]
+    (->> (congregation/get-unrestricted-congregations conn)
+         (filter #(= "" (:congregation/name %)))))
+
+  (db/with-db [conn {}]
+    (let [user-id (UUID/fromString "")
+          cong-id (UUID/fromString "")]
+      (binding [events/*current-system* "admin"]
+        (congregation/grant-access! conn cong-id user-id)
+        (gis-user/create-gis-user! conn cong-id user-id)))))


specs.types: Add :workflo/id spec and make ::id more specific

--- src/main/workflo/macros/specs/types.cljc
+++ src/main/workflo/macros/specs/types.cljc
@@ -1,6 +1,8 @@
 (ns workflo.macros.specs.types
   (:refer-clojure :exclude [bigdec? bytes? double? float? uri?])
   (:require [clojure.spec.alpha :as s :refer [Spec]]
+            [clojure.spec.gen.alpha :as gen]
+            [clojure.string :as str]
             [workflo.macros.util.misc :refer [val-after]]))

 ;;;; Helpers
@@ -66,7 +68,15 @@

 ;;;; Entity IDs

-(s/def ::id any?)
+(s/def ::id
+  (s/with-gen
+    (s/and string? #(= (count %) 32))
+    #(gen/fmap (fn [uuid]
+                 (str/replace (str uuid) "-" ""))
+               (gen/uuid))))
+
+(s/def :workflo/id
+  (s/and ::id ::unique-identity))

 ;;;; Simple reference types


Remove debugging.

Remove debugging.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -111,7 +111,6 @@
   for use in an API response.
   "
   [entry entry-uuid board-slug org-slug comment-count reactions access-level user-id]
-  (println entry)
   (let [topic-slug (name (:topic-slug entry))
         org-uuid (:org-uuid entry)
         board-uuid (:board-uuid entry)


Do not wait for signal ready to create publications/subscriptions

--- src/onyx/messaging/messenger_replica.clj
+++ src/onyx/messaging/messenger_replica.clj
@@ -64,7 +64,10 @@
    {:keys [workflow catalog task serialized-task job-id id] :as event}]
   (let [task-map (planning/find-task catalog task)
         {:keys [egress-ids ingress-ids]} serialized-task
-        receivable-peers (common/job-receivable-peers peer-state allocations job-id)
+        ;; messenger is currently buggy when only using receivable peers
+        ;; if job isn't covered by signaled ready peers
+        ;receivable-peers (job-receivable-peers peer-state allocations job-id)
+        receivable-peers (fn [task-id] (get-in allocations [job-id task-id] []))
         egress-pubs (->> (vals egress-ids)
                          (mapcat (fn [task-id]
                                    (let [peers (receivable-peers task-id)]


Never use a macro when a function will do

--- modules/messaging/src/test/clojure/test/immutant/messaging/codecs.clj
+++ modules/messaging/src/test/clojure/test/immutant/messaging/codecs.clj
@@ -13,16 +13,20 @@
           (getStringProperty [k]
             (.get properties k)))))))

-(defmacro test-for [name message encoding]
-  (list 'deftest name
-        `(let [~'message ~message
-               ~'encoded (encode (session-mock) ~'message {:encoding ~encoding})]
-           (is (= (decode ~'encoded) ~'message)))))
+(defn test-codec [message encoding]
+  (is (= (decode (encode (session-mock) message {:encoding encoding})))))

-(test-for simple-json     "a random text message"       :json)
-(test-for simple-clojure  "a simple text message"       :clojure)
-(test-for complex-json    {:a "b" :c [1 2 3 {:foo 42}]} :json)
-(test-for complex-clojure {:a "b" :c [1 2 3 {:foo 42}]} :clojure)
+(deftest simple-json
+  (test-codec "a random text message" :json))
+
+(deftest simple-clojure
+  (test-codec "a simple text message" :clojure))
+
+(deftest complex-json
+  (test-codec {:a "b" :c [1 2 3 {:foo 42}]} :json))
+
+(deftest complex-clojure
+  (test-codec {:a "b" :c [1 2 3 {:foo 42}]} :clojure))

 (deftest complex-json-encoding
   (let [message {:a "b" :c [1 2 3 {:foo 42}]}


Stop spying

Stop spying

--- test/caesium/binding_test.clj
+++ test/caesium/binding_test.clj
@@ -63,9 +63,9 @@

 (declare check-method check-const-method)

-  (doseq [method (spy (.getMethods Sodium))]
     (info method)
 (deftest interface-test
+  (doseq [method (.getMethods Sodium)]
     (if-let [params (seq (.getParameters ^Method method))]
       (check-method method params)
       (check-const-method method))))


Fix video api metadata

Fix video api metadata

--- src/video_server/library.clj
+++ src/video_server/library.clj
@@ -212,10 +212,10 @@
   (if-let [title (@titles (:title (video-key video)))]
     (let [info (:info title)]
       (merge video
-             {:title (:title title)
+             {:title (or (:title info) (:title title))
               :sorting (:sorting title)
-              :poster (or (:poster video) (:poster info))
-              :thumb (or (:thumb video) (:thumb info))}
+              :poster (:poster title)
+              :thumb (:thumb title)}
              (when-let [st (season-title title (:season video))]
                {:season-title st})
              (when-let [et (episode-title title video)]