Replace when you get a new translation

Replace when you get a new translation

--- src-cljs/tranjlator/master_view.cljs
+++ src-cljs/tranjlator/master_view.cljs
@@ -42,6 +42,11 @@
                       :content-sha sha)))
     (clear-text owner)))

+(defn replacer [col key val new-val]
+  (loop [src col acc []]
+    (cond (empty? src) (conj acc new-val)
+          (= (key (first src)) val) (concat acc [new-val] (rest src))
+          :default (recur (rest src) (conj acc (first src))))))

 (defn users-view [app owner]
   (reify
@@ -113,7 +118,7 @@
                    (= :original topic) (om/transact! app :original (fn [col] (conj col msg)))
                    (= :user-join topic) (om/transact! app :users (fn [col] (conj col (:user-name msg []))))
                    (= :user-part topic) (om/transact! app :users (fn [col] (remove (fn [x] (= x (:user-name msg))) col)))
-                   (= (keyword lang) topic) (om/transact! app :translated (fn [col] (conj col msg)))
+                   (= (keyword lang) topic) (om/transact! app :translated (fn [col] (replacer col :original-sha (:original-sha msg) msg)))
                    (= :ping topic) (when (= (:target msg) (:user-name @app)) (ping))
                    (= :error topic) (do (let [name (:user-name @app)]
                                           (put! socket-ctrl "Doh")


Wrap text... again

Wrap text... again

--- src-cljs/frontend/components/pieces/button.cljs
+++ src-cljs/frontend/components/pieces/button.cljs
@@ -88,7 +88,8 @@

 (dc/do
   (defcard buttons
-    "These are our buttons in their normal, `:full` size (the default) and in `:medium` size to be used in table rows and anywhere vertical space is at a premium."
+    "These are our buttons in their normal, `:full` size (the default) and in
+    `:medium` size to be used in table rows and anywhere vertical space is at a premium."

     (html
      [:div {:style {:display "flex"}}
@@ -154,11 +155,21 @@
                 "Flat Medium")]]]))

   (defcard link-buttons
-    "These are our link buttons, when you need to style a link as a button. There are `:medium` size link buttons to be used in table rows and anywhere vertical space is at a premium.
-
-    A link-button's label, like an ordinary button's, should be an action—that is, an imperative verb. Like a normal button, clicking it initiates that action. Clicking a link-button in particular \"initiates\" the action by navigating to a place in the app where the user can continue the action. For instance, \"Add Projects\" is a link, because it navigates to the Add Projects page, but it is a link-button in particular because it takes the user there to perform the \"Add Projects\" action.
-
-    Viewing more information is not an action. \"Build #5\" would not be an appropriate label for a link-button; neither would \"View Build #5\". Instead, \"Build #5\" should be a normal link."
+    "These are our link buttons, when you need to style a link as a button.
+    There are `:medium` size link buttons to be used in table rows and anywhere
+    vertical space is at a premium.
+
+    A link-button's label, like an ordinary button's, should be an action—that
+    is, an imperative verb. Like a normal button, clicking it initiates that
+    action. Clicking a link-button in particular \"initiates\" the action by
+    navigating to a place in the app where the user can continue the action.
+    For instance, \"Add Projects\" is a link, because it navigates to the Add
+    Projects page, but it is a link-button in particular because it takes the
+    user there to perform the \"Add Projects\" action.
+
+    Viewing more information is not an action. \"Build #5\" would not be an
+    appropriate label for a link-button; neither would \"View Build #5\".
+    Instead, \"Build #5\" should be a normal link."

     (html
      [:div {:style {:display "flex"}}


Open stream link in new tab.

Open stream link in new tab.

--- src/airhead_frontend/components.cljs
+++ src/airhead_frontend/components.cljs
@@ -30,12 +30,11 @@
     (fn []
       (when-let [url (get-in @app-state [:info :stream_url])]
         [:section#player
-
           [:audio {:ref #(reset! audio-ref %)}
                   [:source {:src url}]]

-          [:div#player-controls.pure-button-group {:role "group"}
-
+          [:div#player-controls.pure-button-group
+            {:role "group"}
             (when-let [audio @audio-ref]
               (if (.-paused audio)
                 [:button.pure-button.pure-button-primary
@@ -45,7 +44,7 @@
                   {:on-click #(.pause audio)}
                   [:i.fa.fa-pause] "Pause"]))

-            [:a.pure-button {:href url}
+            [:a.pure-button {:href url :target "_blank"}
                             [:i.fa.fa-external-link]
                             "Open stream"]]


Bugfix: Nodes were sometimes created in the incorrect place

--- src/alder/ui/components/palette.cljs
+++ src/alder/ui/components/palette.cljs
@@ -36,7 +36,9 @@
                title]
               (om/build-all prototype-node-component
                             node-types
-                            {:opts {:on-mouse-down (partial prototype-node-start-drag data)}
+                            {:opts {:on-mouse-down #(prototype-node-start-drag
+                                                     (om/get-props owner)
+                                                     %1 %2)}
                              :key 0})]))]
     (reify
       om/IDisplayName


Fix missing net-info in Desktop js dependencies

Signed-off-by: Pedro Pombeiro <f8c34e1c5d363d76a4b9e8313641f62c1029c3e7@users.noreply.github.com>

--- react-native/src/desktop/status_im/react_native/js_dependencies.cljs
+++ react-native/src/desktop/status_im/react_native/js_dependencies.cljs
@@ -36,4 +36,5 @@
 (def react-navigation       (js/require "react-navigation"))
 (def react-native-navigation-twopane  (js/require "react-native-navigation-twopane"))
 (def react-native-shake     #js {})
+(def net-info               #js {:default #js {}})
 (def react-native-mail      #js {:mail (fn [])})


Refactor sith-lords init!

Refactor sith-lords init!

--- src/cljs/flux_challenge_reagent/sith_lords.cljs
+++ src/cljs/flux_challenge_reagent/sith_lords.cljs
@@ -3,16 +3,8 @@
               [ajax.core :as ajax]
               [flux-challenge-reagent.util :as util]))

-;; -------------------------
-;; Constant parameters
-(def darth-sidious-id 3616)
+(defonce coll (r/atom (vec (repeat 5 nil))))

-;; -------------------------
-;; State
-(defonce coll (r/atom nil))
-
-;; -------------------------
-;; Sith Lords list
 (defn sith-lord-url [id]
   (str "http://localhost:3000/dark-jedis/" id))

@@ -67,4 +59,5 @@
                 (reduce #(scroll-once! %1 direction) coll (range n)))))

 (defn init! []
-  (reset! coll (request-sith-lord! (vec (repeat 5 nil)) 0 darth-sidious-id)))
+  (let [darth-sidious-id 3616]
+    (swap! coll #(request-sith-lord! % 0 darth-sidious-id))))


Avoid re-calculating sources-paths

Avoid re-calculating sources-paths

--- src/afrey/boot_asset_fingerprint.clj
+++ src/afrey/boot_asset_fingerprint.clj
@@ -29,10 +29,11 @@
   (let [prev       (atom nil)
         output-dir (core/tmp-dir!)]
     (core/with-pre-wrap fileset
-      (let [sources (->> fileset
-                      (core/fileset-diff @prev)
-                      (core/input-files)
-                      (core/by-ext (or extensions default-source-extensions)))]
+      (let [sources       (->> fileset
+                            (core/fileset-diff @prev)
+                            (core/input-files)
+                            (core/by-ext (or extensions default-source-extensions)))
+            sources-paths (into #{} (map :path) sources)]
         (reset! prev fileset)

         (when (seq sources)
@@ -74,8 +75,7 @@
                       :let [out-file (->> file
                                        (:path)
                                        (get file-rename-hash)
-                                       (io/file output-dir))]
-                      :when (not (contains? (set (map :path sources)) (:path file)))]
+                      :when (not (contains? sources-paths (:path file)))]
                 (do
                   (io/make-parents out-file)
                   (io/copy (core/tmp-file file) out-file))))))


Don't log in once for each game

Don't log in once for each game

--- src/backloggery/data/backloggery.clj
+++ src/backloggery/data/backloggery.clj
@@ -88,10 +88,8 @@
     "null" "5"}
    desc))

-(defn- add-game [game]
+(defn- add-game [cookies game]
   (let [user (:bl-name *opts*)
-        pass (:bl-pass *opts*)
-        cookies (bl-login user pass)
         defaults {"comp" "" "orig_console" "" "region" "0" "own" "1"
                   "achieve1" "" "achieve2" "" "online" "" "note" ""
                   "rating" "8" "submit2" "Stealth Add" "wishlist" "0"}
@@ -118,4 +116,7 @@
            (printf " %s\n")))))

 (defmethod write-games "backloggery" [_ games]
-  (dorun (map add-game games)))
+  (let [user (:bl-name *opts*)
+        pass (:bl-pass *opts*)
+        cookies (bl-login user pass)]
+    (dorun (map #(add-game cookies %) games))))


add-module-lesson-groups-from-url-hash: Refactor

This refactor serves to reduce the number of function calls to
get-module-code-from-match-array and friends. Instead of using the
match arrays from JavaScript `RegExp.exec` , it constructs Clojure Maps
containing the required information (module code, lesson type, etc).
The previously used function calls are replaced by map lookups, making
the code slightly cleaner.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -346,10 +346,10 @@

    NOTE: This function should only be called once."
   [urlHash]
-  (let [ModulesMap      (aget js/window "ModulesMap")
-        moduleInfoArray (.split urlHash "&")
-
-        modInfoRegex
+  (let [ModulesMap         (aget js/window "ModulesMap")
+        moduleUrlHashArray (.split urlHash "&")
+
+        modUrlHashRegex
         #"^([A-Z]+\d{4}[A-Z]*)_(DL|L|LAB|PL|PT|R|SEM|ST|T|T2|T3)=([A-Z0-9]+)$"

         get-module-code-from-match-array
@@ -361,49 +361,46 @@
         get-lesson-group-from-match-array
         (fn [matchArray] (nth matchArray 3))

-        moduleInfoMaps
-        (map (fn [modInfo]
-               {:modInfo    modInfo
-                :matchArray (.exec modInfoRegex modInfo)})
-             moduleInfoArray)
-
-        moduleInfoMapsExistent
+        ; Sequence of non-nil match arrays
+        matchArraySeq
+        (filter (fn [matchArray] (not (nil? matchArray)))
+          (map (fn [modUrlHash] (.exec modUrlHashRegex modUrlHash))
+               moduleUrlHashArray))
+
+        ; Sequence of existing lesson groups
+        moduleInfoExistent
         (filter
-          (fn [modInfoMap]
-            (let [matchArray (:matchArray modInfoMap)]
-              (and (not (nil? matchArray))
-                   (let [moduleCode       (get-module-code-from-match-array
-                                            matchArray)
-                         lessonTypeShort  (get-lesson-type-from-match-array
-                                            matchArray)
-                         lessonType       (lesson-type-short-to-long-form
-                                            lessonTypeShort)
-                         lessonGroup      (get-lesson-group-from-match-array
-                                            matchArray)]
-                     (not (nil? (get-in
-                                  ModulesMap
-                                  [moduleCode "lessons" lessonType
-                                   lessonGroup])))))))
-          moduleInfoMaps)
-
+          (fn [modInfo]
+            (not (nil? (get-in ModulesMap
+                               [(:moduleCode modInfo) "lessons"
+                                (:lessonType modInfo)
+                                (:lessonGroup modInfo)]))))
+          ; convert matchArrays to maps
+          (map (fn [matchArray]
+                 {:moduleCode  (get-module-code-from-match-array
+                                 matchArray)
+                  :lessonType  (lesson-type-short-to-long-form
+                                 (get-lesson-type-from-match-array matchArray))
+                  :lessonGroup (get-lesson-group-from-match-array
+                                 matchArray)})
+               matchArraySeq))
+
+        ; Module code to CSS class for lesson div background color
         moduleToColorsMap
-        (reduce (fn [m2cMap moduleCode]
-                  (assoc m2cMap
-                         moduleCode
-                         (get-next-lesson-bg-color-css-class)))
-                {}
-                (distinct (map (fn [modInfoMap]
-                                 (get-module-code-from-match-array
-                                   (:matchArray modInfoMap)))
-                               moduleInfoMapsExistent)))]
-    (doseq [modInfo moduleInfoMapsExistent]
-      (let [matchArray (:matchArray modInfo)
-            moduleCode      (get-module-code-from-match-array matchArray)
-            lessonTypeShort (get-lesson-type-from-match-array matchArray)
-            lessonType      (lesson-type-short-to-long-form lessonTypeShort)
-            lessonGroup     (get-lesson-group-from-match-array matchArray)
+        (reduce
+          (fn [m2cMap moduleCode]
+            (assoc m2cMap moduleCode (get-next-lesson-bg-color-css-class)))
+          {}
+          (distinct (map (fn [modInfo] (:moduleCode modInfo))
+                         moduleInfoExistent)))]
+
+    ; Add the module lesson groups
+    (doseq [modInfo moduleInfoExistent]
+      (let [moduleCode      (:moduleCode modInfo)
             bgColorCssClass (get moduleToColorsMap moduleCode)]
-        (add-module-lesson-group moduleCode lessonType lessonGroup
+        (add-module-lesson-group moduleCode
+                                 (:lessonType modInfo)
+                                 (:lessonGroup modInfo)
                                  bgColorCssClass)))))

 (defn remove-module


4clojure:: 2nd draft of word-chains(hard) problem

--- src/clojure_learning/word_chains.clj
+++ src/clojure_learning/word_chains.clj
@@ -13,67 +13,12 @@
 (ns clojure-learning.word-chains
   (use (clojure [repl] test)))

-;; #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"}
-
-;; thinking: take each element and reduce with rest to find if there's a matching word
-;; the matching func should take two words -> and return truthy if the words seem to match
-(defn words-chain? [source-str target-str]
-  (let [intersected (clojure.set/intersection (set source-str) (set target-str))
-        identify-by #(apply % [(count %2) (count %3)])
-        smallest (identify-by min source-str target-str)
-        greatest (identify-by max source-str target-str)]
-     (and (<= (- greatest smallest) 1)
-         (or (= intersected (set source-str))
-             (= intersected (set target-str))))))
-
-(words-chain? "tackli" "tackl") ;; true
-(words-chain? "clau" "claud")   ;; true
-(words-chain? "clau" "clua")    ;; true
-(words-chain? "cos" "cosar")    ;; false
-
-(defn all-words-chain?
-  ([xset]
-   (all-words-chain? (vec xset) (rest (vec xset)) []))
-  ([[head-inner sec-inner & tail-inner] [head-rest & tail-rest]  matches-vec]
-   (if (nil? head-rest) matches-vec
-    (if (nil? sec-inner)
-     (recur tail-rest tail-rest matches-vec)
-     (if (words-chain? head-inner sec-inner)
-       (recur (cons sec-inner tail-inner) (cons head-rest tail-rest) (conj matches-vec :link))
-       (recur (cons sec-inner tail-inner) (cons head-rest tail-rest) matches-vec))))))
-
-(all-words-chain? #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"}) ;; true
-(all-words-chain? #{"cot" "hot" "bat" "fat"})                 ;; false
-(all-words-chain? #{"to" "top" "stop" "tops" "toss"})         ;; false
-(all-words-chain? #{"spout" "do" "pot" "pout" "spot" "dot"})  ;; true
-(all-words-chain? #{"share" "hares" "shares" "hare" "are"})   ;; true
-(all-words-chain? #{"share" "hares" "hare" "are"})            ;; false
-
-(defn words-chain? [source-str target-str]
-  (let [intersected (clojure.set/intersection (set source-str) (set target-str))
-        identify-by #(apply % [(count %2) (count %3)])
-        smallest (identify-by min source-str target-str)
-        greatest (identify-by max source-str target-str)]
-     (when (and (<= (- greatest smallest) 1)
-                (or (= intersected (set source-str))
-                    (= intersected (set target-str))))
-       source-str)))
-;; unfortunatelly this function is not helping too much as it's using sets as values and not words stricly comparisons
-
-(words-chain? "share" "hares") ;; -> fix this func and the algorithm is ok!
-(words-chain? "tops" "toss")
-
 ;; if count a - count b = 1 -> then leading-padding & trailing padding of-smaller with 0
-(interleave "tops" "toss")
-(interleave "toss" "to")
 (map (fn [[a b]] (= a b)) (partition 2 (interleave "0hare" "hares"))) ;; (false false false false false)
 (map (fn [[a b]] (= a b)) (partition 2 (interleave "hare0" "hares"))) ;; (true true true true false)

 (map (fn [[a b]] (= a b)) (partition 2 (interleave "0top" "stop")))   ;; (false true true true)
 (map (fn [[a b]] (= a b)) (partition 2 (interleave "top0" "stop")))   ;; (false false false false)
-
-(map (fn [[a b]] (= a b)) (partition 2 (interleave "0pout" "spout"))) ;; (false true true true true)
-(map (fn [[a b]] (= a b)) (partition 2 (interleave "pout0" "spout"))) ;; (false false false false false)

 ;; check for false in both vec-results -> if a vec contains only one false -> words-chaining-match!
 (defn words-chain? [source-str target-str]
@@ -105,4 +50,79 @@
 (words-chain? "top" "tops")

 (assoc {} :left-padded (map (fn [[a b]] (= a b)) (partition 2 (interleave (apply str (cons "$" "thi")) "cthi"))))
-(conj "$" (vec "this"))
+;; {:left-padded (false true true true)}
+
+;; refactor this func to work with tuples as domain-arguments and not with fixed-args <- because find-all-unique-tuples
+;; outputs a set of set-tuples -> set of sets for discarding duplicates! by value semantics
+(defn words-chain? [[source-str target-str]]
+    (letfn [(difference [& words]
+              (let [[smallest greatest] (sort-by count words)]
+                (- (count greatest) (count smallest))))
+            (pair-compared-chars [& words]
+              (let [[smallest greatest] (sort-by count words)]
+                (if (not= (count smallest) (count greatest))
+                  (assoc
+                    (assoc {} :left-padded-vals (map (fn [[a b]] (= a b)) (partition 2 (interleave (apply str (cons "$" smallest)) greatest))))
+                      :right-padded-vals (map (fn [[a b]] (= a b)) (partition 2 (interleave (apply str (conj (vec smallest) "$")) greatest))))
+                  (assoc {} :same-width (map (fn [[a b]] (= a b)) (partition 2 (interleave smallest greatest))))
+                 )))]
+      (if (<= (difference source-str target-str) 1)
+        (if-let [{:keys [left-padded-vals right-padded-vals same-width]} (pair-compared-chars source-str target-str)]
+          (when (or (= 1 (count (filter false? left-padded-vals)))
+                  (= 1 (count (filter false? right-padded-vals)))
+                  (= 1 (count (filter false? same-width))))
+            {:linked [source-str target-str]})))))
+
+(defn all-words-chain? [xset]
+  (letfn [(find-all-unique-words-tuples [words-set]
+
+                 (for [x words-set
+                       y words-set
+                       :when (not= x y)]
+                          [x y]) )
+          (find-linked-words [xset]
+            (reduce (fn [links words-tuple]
+                      (if-let [linked-map ((comp words-chain? vec) words-tuple)]
+                        (conj links linked-map)
+                        links))
+                    [] (find-all-unique-words-tuples xset)))
+          (filter-dups-of-word-refs [linked-maps]
+            (reduce (fn [uniques-m each-m]
+                      (if (some (fn [searched-m]
+                                  (= (first (:linked searched-m)) (first (:linked each-m)))) uniques-m)
+                        uniques-m
+                        (conj uniques-m each-m)))
+                [(first linked-maps)] (rest linked-maps)))
+          ]
+    (->> xset
+         find-linked-words
+         (map (fn [{:keys [linked]}] linked))
+         ;; filter-dups-of-word-refs
+         ;; count
+         ;; (= (dec (count xset)))
+      )))
+
+(some #{:linked}  (keys {:linked "linked" :not-linked "not-linked"}))  ;; :linked
+
+(= {:linked "l"} {:linked "l"}) ;; true
+(let [{:keys [linked]} {:linked ["some" "none"]}]
+  (val linked))
+
+;; currently the above implementation outputs a results as:
+(all-words-chain? #{"cot" "hot" "bat" "fat"})
+;; [{:linked ["bat" "fat"]} {:linked ["cot" "hot"]}] (should be false)
+
+(all-words-chain? #{"to" "top" "stop" "tops" "toss"})
+;; [{:linked ["top" "tops]} {:linked ["stop" "top"]} {:linked ["top" "to"]} {:linked ["tops" "toss"]}]
+
+;; how i think?
+;; start with the smallest word -> and build the transitive-clojure to the next word, accumulating the
+;; the results into a flat-vec -> if one word does not have any transitive-clojure && rest words is not null?
+;; then the chain breaks and predicate yields false, else continue till rest is null in which case the
+;; sequence is a words-chain
+(all-words-chain? #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"})  ;; true
+(all-words-chain? #{"spout" "do" "pot" "pout" "spot" "dot"})  ;; true
+(all-words-chain? #{"share" "hares" "shares" "hare" "are"})   ;; true
+(all-words-chain? #{"share" "hares" "hare" "are"})            ;; false
+
+(words-chain? ["hares" "share"])


Shouldn't need CORS middleware anymore

Shouldn't need CORS middleware anymore

--- src/braid/core/server/middleware.clj
+++ src/braid/core/server/middleware.clj
@@ -1,7 +1,6 @@
 (ns braid.core.server.middleware
   (:require
    [braid.base.conf :refer [config]]
-   [ring.middleware.cors :refer [wrap-cors]]
    [ring.middleware.session :refer [wrap-session]]
    [clojure.stacktrace]
    [taoensso.timbre :as timbre]))
@@ -64,14 +63,6 @@
   "Wrap the handler with middleware that is universally applicable across the site."
   [handler {:keys [session]}]
   (-> handler
-      (wrap-cors :access-control-allow-origin
-                 (->>
-                  [(when-let [site (config :site-url)]
-                     (re-pattern (java.util.regex.Pattern/quote site)))
-                   #"http://localhost:\d+"]
-                  (remove nil?))
-                 :access-control-allow-credentials true
-                 :access-control-allow-methods [:get :put :post :delete])
       (wrap-session (or session @session-config))
       wrap-log-requests
       wrap-failsafe))


Updated test error message

Updated test error message

--- system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
@@ -459,7 +459,7 @@
     (let [concept (dc/collection-concept {:version-id nil} :iso19115)
           response (ingest/ingest-concept concept)]
       (is (= {:status 422
-              :errors ["Version cannot be nil."]}
+              :errors ["Version is required."]}
              response)))))

 (comment


refactor delete-node in zk code

refactor delete-node in zk code

--- src/clj/backtype/storm/zookeeper.clj
+++ src/clj/backtype/storm/zookeeper.clj
@@ -76,8 +76,11 @@
        (.. zk (checkExists) (watched) (forPath (normalize-path path)))
        (.. zk (checkExists) (forPath (normalize-path path))))))

-(defn delete-node [^CuratorFramework zk ^String path]
-  (.. zk (delete) (forPath (normalize-path path))))
+(defnk delete-node [^CuratorFramework zk ^String path :force false]
+  (try-cause  (.. zk (delete) (forPath (normalize-path path)))
+    (catch KeeperException$NoNodeException e
+      (when-not force (throw e))
+      )))

 (defn mkdirs [^CuratorFramework zk ^String path]
   (let [path (normalize-path path)]
@@ -121,10 +124,7 @@
                                   ))]
         (doseq [c children]
           (delete-recursive zk (full-path path c)))
-        (try-cause (delete-node zk path)
-                   (catch KeeperException$NoNodeException e
-                                  nil
-                                  ))
+        (delete-node zk path :force true)
         ))))

 (defnk mk-inprocess-zookeeper [localdir :port nil]


`add-module-lesson-groups-from-url-hash!` - adjust indentation

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -949,19 +949,14 @@

    NOTE: This function should only be called once."
   [urlHash]
-  (let [moduleUrlHashArray (.split urlHash "&")
+  (let [moduleUrlHashArray                (.split urlHash "&")

         modUrlHashRegex
         #"^([A-Z]+\d{4}[A-Z]*)_(DL|L|LAB|PL|PT|R|SEM|ST|T|T2|T3)=([A-Z0-9]+)$"

-        get-module-code-from-match-array
-        (fn [matchArray] (nth matchArray 1))
-
-        get-lesson-type-from-match-array
-        (fn [matchArray] (nth matchArray 2))
-
-        get-lesson-group-from-match-array
-        (fn [matchArray] (nth matchArray 3))
+        get-module-code-from-match-array  (fn [matchArray] (nth matchArray 1))
+        get-lesson-type-from-match-array  (fn [matchArray] (nth matchArray 2))
+        get-lesson-group-from-match-array (fn [matchArray] (nth matchArray 3))

         ; Sequence of non-nil match arrays
         matchArraySeq


Handle the transient path root slightly more defensively.

--- src/clojure/parkour/io/transient.clj
+++ src/clojure/parkour/io/transient.clj
@@ -1,7 +1,8 @@
 (ns parkour.io.transient
   (:require [pjstadig.scopes :as s]
             [parkour (conf :as conf) (fs :as fs)]
-            [parkour.util :as util :refer [ignore-errors doto-let]]))
+            [parkour.util :as util :refer [ignore-errors doto-let]])
+  (:import [org.apache.hadoop.fs Path]))

 (defonce
   ^{:private true
@@ -11,10 +12,12 @@

 (defn ^:private transient-root
   "Transient path root directory, as specified by `conf` if provided."
+  {:tag `Path}
   ([] (transient-root (conf/ig)))
   ([conf]
-     (or (conf/get conf "parkour.transient.dir")
-         (fs/path (fs/temp-root conf) run-id))))
+     (-> (or (conf/get conf "parkour.transient.dir")
+             (fs/path (fs/temp-root conf) run-id))
+         (fs/path))))

 (defn transient-path
   "Return new unique transient path, which will be deleted on process exit or


Fix unnecessary reflection.

Fix unnecessary reflection.

--- src/clojure/parkour/remote/basic.clj
+++ src/clojure/parkour/remote/basic.clj
@@ -4,12 +4,12 @@
             [clojure.edn :as edn]
             [clojure.tools.logging :as log]
             [parkour (conf :as conf) (mapreduce :as mr) (wrapper :as w)])
-  (:import [clojure.lang IFn$OOLL]
+  (:import [clojure.lang IFn$OOLL Var]
            [org.apache.hadoop.mapreduce MapContext]))

 (defn require-readers
   "Require the namespaces of all `*data-readers*` vars."
-  [] (doseq [[_ v] *data-readers*] (-> v .-ns ns-name require)))
+  [] (doseq [[_ ^Var v] *data-readers*] (-> v .-ns ns-name require)))

 (defn step-v-args
   ([conf key]


Move the async loop exit log message

Move the async loop exit log message

It needs to happen after the actual loop ends, but still inside the go
block. Otherwise it claims to exit long before it actually does.

--- src/com/frereth/common/async_zmq.clj
+++ src/com/frereth/common/async_zmq.clj
@@ -210,31 +210,31 @@
   [{:keys [async->sock in-chan _name stopper]} :- EventPair]
   (let [internal-> async->sock]
     (async/go
-     (comment) (log/debug "Entering "
-                          _name
-                          " Async event thread, based on:"
-                          in-chan)
-     (loop [val (async/<! in-chan)]
-       (try
-         (if (-> val nil? not)
-           (do
-             (log/debug _name " Incoming async message:\n"
-                        (util/pretty val) "a" (class val)
-                        "\nFrom internal. Forwarding to 0mq")
-             ;; Have to serialize it here: can't
-             ;; send arbitrary data across 0mq sockets
-             (mq/send! internal-> (serialize val))
-             (log/debug _name ": Message forwarded"))
-           (log/info _name ": in-chan closed -- this will end loop"))
-         (catch RuntimeException ex
-           (log/error ex "Unexpected error in async loop"))
-         (catch Exception ex
-           (log/error ex "Unexpected bad error in async loop"))
-         (catch Throwable ex
-           (log/error ex "Things have gotten really bad in the async loop")))
-       (when (and val (not= val stopper))
-         (recur (<? in-chan)))))
-    (log/debug "We either received the stop signal or the internal channel closed")
+      (log/debug "Entering "
+                 _name
+                 " Async event thread, based on:"
+                 in-chan)
+      (loop [val (async/<! in-chan)]
+        (try
+          (if (-> val nil? not)
+            (do
+              (log/debug _name " Incoming async message:\n"
+                         (util/pretty val) "a" (class val)
+                         "\nFrom internal. Forwarding to 0mq")
+              ;; Have to serialize it here: can't
+              ;; send arbitrary data across 0mq sockets
+              (mq/send! internal-> (serialize val))
+              (log/debug _name ": Message forwarded"))
+            (log/info _name ": in-chan closed -- this will end loop"))
+          (catch RuntimeException ex
+            (log/error ex "Unexpected error in async loop"))
+          (catch Exception ex
+            (log/error ex "Unexpected bad error in async loop"))
+          (catch Throwable ex
+            (log/error ex "Things have gotten really bad in the async loop")))
+        (when (and val (not= val stopper))
+          (recur (<? in-chan))))
+      (log/debug "We either received the stop signal or the internal channel closed"))
     :exited-successfully))

 (s/defn possibly-recv-internal!


fix leiningen

fix leiningen

--- singleModule/leiningen/project.clj
+++ singleModule/leiningen/project.clj
@@ -9,16 +9,17 @@
   :repositories [["java.net" "http://download.java.net/maven/2"]]
   :update :never
   :checksum :fail
-  :source-paths ["src" "src/main/clojure"]
-  ;; not sure how to
-  :java-source-paths ["src/main/java" "src/test/java"]  ; Java source is stored separately.
-  :test-paths ["test" "src/test/clojure"]
+  :source-paths ["src/main/clojure"]
+  :java-source-paths ["src/main/java"]  ; Java source is stored separately.
+  :test-paths ["src/test/clojure"]
   :junit ["src/test/java"]
-  :resource-paths ["src/main/resource"] ; Non-code files included in classpath/jar.
+  ;; regex magic to include all *Test.java, but no *AbstractTest.java
+  :junit-test-file-pattern #"^((?!Abstract).)*Test.java$"
+  :resource-paths ["src/test/resources" "src/main/resources"] ; Non-code files included in classpath/jar.
   :target-path "target/%s/"
   :clean-targets [:target-path :compile-path "out"]
   ;;; Jar Output
   ;; Name of the jar file produced. Will be placed inside :target-path.
   ;; Including %s will splice the project version into the filename.
   :jar-name "example.jar"
-  :auto-clean false)
+  :auto-clean false)


Remove unused require

Remove unused require

--- src/braid/core/server/middleware.clj
+++ src/braid/core/server/middleware.clj
@@ -1,7 +1,6 @@
 (ns braid.core.server.middleware
   (:require
    [braid.base.conf :refer [config]]
-   [mount.core :as mount :refer [defstate]]
    [ring.middleware.cors :refer [wrap-cors]]
    [ring.middleware.session :refer [wrap-session]]
    [taoensso.timbre :as timbre]))


Add an impl for secretbox-pfx

Add an impl for secretbox-pfx

--- src/caesium/magicnonce/secretbox.clj
+++ src/caesium/magicnonce/secretbox.clj
@@ -11,7 +11,9 @@
   interesting function in this namespace is [[secretbox-nmr]]. If you
   just want a random nonce and do not care about nonce-misuse
   resistance, use [[secretbox-rnd]]. The other functions are fairly
-  limited use.")
+  limited use."
+  (:require [caesium.crypto.secretbox :as s])
+  (:import [java.nio ByteBuffer]))

 (defn secretbox-pfx
   "secretbox, with the given nonce embedded in the ciphertext as a prefix.
@@ -31,7 +33,16 @@

   To decrypt, use [[decrypt]] or [[open]], depending on which argument order
   you prefer."
-  [msg nonce key])
+  [msg nonce key]
+  (let [msglen (alength ^bytes msg)
+        ctextlen (+ msglen s/macbytes)
+        outlen (+ s/noncebytes ctextlen)
+        out (byte-array outlen)
+        ctextbuf (ByteBuffer/wrap out s/noncebytes ctextlen)]
+    (System/arraycopy nonce 0 out 0 s/noncebytes)
+    (s/secretbox-easy-to-byte-buf! ctextbuf msg nonce key)
+    out))
+
 (defn ^:private random-nonce!
   "Creates a random nonce suitable for use in secretbox.


figwheel.repl: fire event when connection has been established

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -416,6 +416,14 @@
                  :args (mapv #(if (string? %) % (gjson/serialize %)) args)}))
   (setup-printing!))

+(defn connection-established! [url]
+  (when (= host-env :html)
+    (let [target (.. goog.global -document -body)]
+          (.dispatchEvent
+           target
+           (doto (js/Event. "figwheel.repl.connected" target)
+             (gobj/add "data" {:url url}))))))
+
 (defn get-websocket-class []
   (or
    (gobj/get goog.global "WebSocket")
@@ -460,6 +468,7 @@
                                      (glog/error logger e))))))
           (.addEventListener goog.net.WebSocket.EventType.OPENED
                              (fn [e]
+                               (connection-established! url)
                                (swap! state assoc :connection {:websocket websocket})
                                (hook-repl-printing-output! {:websocket websocket})))
           (.open url))))))
@@ -532,6 +541,7 @@
              (let [typ (gobj/get msg "connection-type")]
                (glog/info logger (str "Connected: " typ))
                (msg-fn msg)
+               (connection-established! url)
                ;; after connecting setup printing redirects
                (swap! state assoc :connection {:http-url surl})
                (hook-repl-printing-output! {:http-url surl})


Send JOB_ID instead of EXECUTION_ID env var

--- src/cider_ci/dispatcher/dispatch.clj
+++ src/cider_ci/dispatcher/dispatch.clj
@@ -73,7 +73,7 @@
         repository-id (:repository_id branch-and-commit)
         trial-id (:id trial)
         environment-variables (conj (or (:environment_variables task-spec) {})
-                                    {:CIDER_CI_EXECUTION_ID job-id
+                                    {:CIDER_CI_JOB_ID job-id
                                      :CIDER_CI_TASK_ID (:task_id trial)
                                      :CIDER_CI_TRIAL_ID trial-id
                                      :CIDER_CI_TREE_ID (:tree_id branch-and-commit)})


fix okta-config.xml config | sg/fs | #35

--- src/clj/conference_rating/server.clj
+++ src/clj/conference_rating/server.clj
@@ -11,9 +11,11 @@
   (:gen-class))

 (defn do-wrap-okta [handler okta-active]
-  (if okta-active
-    (wrap-okta handler {:okta-home "https://dev-133267-admin.oktapreview.com/" :okta-config-location (io/resource "okta-ci-config.xml")})
-    handler))
+  (let [config-res (io/resource "okta-ci-config.xml")]
+    (println "initialize okta?" okta-active " config location: " config-res)
+    (if okta-active
+      (wrap-okta handler {:okta-home "https://dev-133267-admin.oktapreview.com/" :okta-config config-res})
+      handler)))

  (defn -main [& args]
    (let [port (Integer/parseInt (or (env :port) "3000"))


fix issues with merge - all working

fix issues with merge - all working

--- src/cljs/phonecat_re_frame/core.cljs
+++ src/cljs/phonecat_re_frame/core.cljs
@@ -69,14 +69,7 @@
   (fn []
     [:input {:on-change #(re-frame/dispatch [:search-input-entered (-> % .-target .-value)])}]))

-(defn phones-component
-  []
-  (let [phones (re-frame/subscribe [:phones])]
-    (fn []
-      [:ul (doall  (map (fn [phone] ^{:key phone} [phone-component (:name phone) (:snippet phone)]) @phones))])))
-
 (defn home-page []
-  [phones-component])
   [:div {:class "container-fluid"}
    [:div {:class "row"}
     [:div {:class "col-md-2"}
@@ -89,7 +82,7 @@
      [phones-component]]]])

 (defn current-page []
-  [:div [(session/get :current-page)]])
+  (session/get :current-page))

 ;; -------------------------
 ;; Routes


Delete unused debug viewer.

Delete unused debug viewer.

--- src/cljs/sptcg/components/debug.cljs
+++ src/cljs/sptcg/components/debug.cljs
@@ -1,20 +0,0 @@
-(ns sptcg.components.debug
-  (:require [ankha.core :as ankha]
-            [om.core :as om :include-macros true]
-            [sablono.core :as html :refer-macros [html]]))
-
-(defn debug [data owner]
-  (reify
-    om/IDisplayName (display-name [_] "Debug")
-    om/IInitState
-    (init-state [_]
-      {:visible? false})
-    om/IRenderState
-    (render-state [_ {:keys [visible?]}]
-      (html
-       [:div
-        [:button
-         {:onClick #(om/update-state! owner :visible? not)}
-         (if visible? "Hide" "Show State")]
-        (when visible?
-          (om/build ankha/inspector data))]))))


Add comments

Add comments

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -99,6 +99,8 @@
       (java.io.ByteArrayInputStream.)
       (slurp :encoding encoding)))

+;; TODO: Read and understand the date algo presented in RFC7232 2.2.1
+
 (defn round-seconds-up
   "Round up to the nearest second. The rationale here is that
   last-modified times from resources have a resolution of a millisecond,
@@ -110,7 +112,11 @@
   update. However, the point is that user agents using dates don't
   generally care about having the very latest if they're using
   If-Modified-Since, otherwise they'd omit the header completely. In the
-  spec. this is allowable semantics under the rules of weak validators."
+  spec. this is allowable semantics under the rules of weak validators.
+
+  TODO: This violates this part of the spec. Need an alternative implementation
+  \"An origin server with a clock MUST NOT send a Last-Modified date that
+   is later than the server's time of message origination (Date).\" — RFC7232 2.2.1 "
   [d]
   (when d
     (let [n (.getTime d)


Cookie handling and user name processing

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -12,14 +12,37 @@
     (.write *out* (str (clojure.string/join " " more) "\n"))
     (flush))

+(defn get-user-name
+    [new-user-name old-user-name]
+    (or new-user-name old-user-name))
+
+(defn finish-processing
+    [request search-results]
+    (let [params        (:params request)
+          cookies       (:cookies request)
+          word          (get params "word")
+          new-user-name (get params "user-name")
+          old-user-name (get (get cookies "user-name") :value)
+          user-name     (get-user-name new-user-name old-user-name)]
+        (println-and-flush "Incoming cookies: " cookies)
+        (println "old" old-user-name)
+        (println "new" new-user-name)
+        (println "-> " user-name)
+        (println word)
+        (println search-results)
+        (if user-name
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results))
+                (http-response/set-cookie :user-name user-name {:max-age 36000000})
+                (http-response/content-type "text/html"))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results))
+                (http-response/content-type "text/html")))))
+
 (defn process-front-page
     [request]
-    (let [word (-> (:params request) (get "word"))
+    (let [params         (:params request)
+          word           (get params "word")
           search-results (if (not (empty? word)) (db-interface/read-words-for-pattern word))]
-        (println word)
-        (println search-results)
-        (-> (http-response/response (html-renderer/render-front-page word search-results))
-            (http-response/content-type "text/html"))))
+        (finish-processing request search-results)))

 (defn store-words
     [words]
@@ -33,8 +56,7 @@
           words (if input (clojure.string/split input #"[\s,]"))]
           (if words
               (store-words words))
-        (-> (http-response/response (html-renderer/render-front-page nil nil))
-            (http-response/content-type "text/html"))))
+        (finish-processing request nil)))

 (defn perform-operation
     [request]
@@ -51,25 +73,19 @@
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-all-words)]
-        (println search-results)
-        (-> (http-response/response (html-renderer/render-front-page nil search-results))
-            (http-response/content-type "text/html"))))
+        (finish-processing request search-results)))

 (defn process-deleted-words
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-deleted-words)]
-        (println search-results)
-        (-> (http-response/response (html-renderer/render-front-page nil search-results))
-            (http-response/content-type "text/html"))))
+        (finish-processing request search-results)))

 (defn process-active-words
     [request]
     (perform-operation request)
     (let [search-results (db-interface/read-active-words)]
-        (println search-results)
-        (-> (http-response/response (html-renderer/render-front-page nil search-results))
-            (http-response/content-type "text/html"))))
+        (finish-processing request search-results)))

 ;defn process-delete-word
 ;   [request]


A cat can spend five or more hours a day grooming himself.

--- src/clj/quiz_site/routes/quiz.clj
+++ src/clj/quiz_site/routes/quiz.clj
@@ -10,7 +10,7 @@
             [compojure.core :refer :all]))

 (def fburl "https://quiz-site-fdc3a.firebaseio.com")
-(def root (m/connect "https://quiz-site-fdc3a.firebaseio.com"))
+(def root (m/connect fburl))

 (m/auth-anon root)


Adds pop-up choice menu for derez action.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -104,7 +104,8 @@
   (let [actions (action-list card)
         c (+ (count actions) (count abilities))]
     (when (not (and (= side "Runner") facedown))
-      (cond (> c 1) (-> (om/get-node owner "abilities") js/$ .toggle)
+      (cond (or (> c 1)
+                (= (first actions) "derez")) (-> (om/get-node owner "abilities") js/$ .toggle)
             (= c 1) (if (= (count abilities) 1)
                           (send-command "ability" {:card card :ability 0})
                           (send-command (first actions) {:card card}))))))
@@ -314,7 +315,8 @@
                      label])
                   servers)]))
         (let [actions (action-list cursor)]
-          (when (> (+ (count actions) (count abilities)) 1)
+          (when (or (> (+ (count actions) (count abilities)) 1)
+                    (= (first actions) "derez"))
             [:div.blue-shade.panel.abilities {:ref "abilities"}
              (map (fn [action]
                     [:div {:on-click #(do (send-command action {:card @cursor}))} (capitalize action)])


Also fixes rendering play-area for spectators.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -654,7 +654,8 @@
                [:div
                 (om/build rfg-view {:cards (:rfg opponent) :name "Removed from the game"})
                 (om/build rfg-view {:cards (:rfg me) :name "Removed from the game"})
-                (om/build rfg-view {:cards (:play-area me)})
+                (when (#{(get-in @game-state [:corp :user]) (get-in @game-state [:runner :user])} (:user @app-state))
+                  (om/build rfg-view {:cards (:play-area me)}))
                 (om/build rfg-view {:cards (:current opponent) :name "Current"})
                 (om/build rfg-view {:cards (:current me) :name "Current"})]
                (when-not (= side :spectator)


removed gen-class

removed gen-class

--- src/clojure/sparkling/ml/core.clj
+++ src/clojure/sparkling/ml/core.clj
@@ -2,8 +2,7 @@
   "This is the entry point to the machine learning functionality in Spark"
   (:import [org.apache.spark.api.java JavaSparkContext]
     [org.apache.spark.ml Pipeline PipelineModel PipelineStage]
-    [org.apache.spark.sql DataFrame SQLContext ])
- (:gen-class))
+    [org.apache.spark.sql DataFrame SQLContext ]))

 (defn sql-context
   "Returns an SQL context by wrapping a JavaSparkContext object "


add specifying host

add specifying host

--- src/clojure/tcp_driver/driver.clj
+++ src/clojure/tcp_driver/driver.clj
@@ -53,52 +53,58 @@

 (defn select-send!
       "ctx - DriverRetSchema
+       host-address if specified this host is used, otherwise the routing policy is asked for a host
        io-f - function that takes a connection and on error throws an exception
        timeout-ms - connection timeout"
-      [ctx io-f timeout-ms]
-      {:pre [ctx io-f timeout-ms]}
-      (loop [i 0]
-            (if-let [host (routing/-select-host (:routing-policy ctx))]
+      ([ctx io-f timeout-ms]
+        (select-send! ctx nil io-f timeout-ms))
+      ([ctx host-address io-f timeout-ms]
+        {:pre [ctx io-f timeout-ms]}
+        (loop [i 0]
+              (if-let [host (if host-address host-address (routing/-select-host (:routing-policy ctx)))]

-                    (let [pool (:pool ctx)]
+                      (let [pool (:pool ctx)]

-                         ;;;try the io-f, if an exception then only if we haven't tried (count hosts) already
-                         ;;;loop and retry, its expected that the routing policy blacklist or remove the host on error
+                           ;;;try the io-f, if an exception then only if we haven't tried (count hosts) already
+                           ;;;loop and retry, its expected that the routing policy blacklist or remove the host on error

-                         (let [res (try
+                           (let [res (try

-                                     (if-let [conn (tcp-pool/borrow pool host timeout-ms)]
+                                       (if-let [conn (tcp-pool/borrow pool host timeout-ms)]

-                                             (try
-                                               (io-f conn)
-                                               (catch IOException e
-                                                 ;;any io exception will cause invalidation of the connection.
-                                                 (tcp-pool/invalidate pool host conn)
-                                                 (throw e))
-                                               (finally
-                                                 (tcp-pool/return pool host conn)))
+                                               (try
+                                                 (io-f conn)
+                                                 (catch IOException e
+                                                   ;;any io exception will cause invalidation of the connection.
+                                                   (tcp-pool/invalidate pool host conn)
+                                                   (throw e))
+                                                 (finally
+                                                   (tcp-pool/return pool host conn)))

-                                             (throw-no-connection!))
+                                               (throw-no-connection!))

-                                     (catch Exception t
-                                       (routing/-on-error! (:routing-policy ctx) host t)
-                                       (ex-info (str "Error while connecting to " host) {:throwable t :host host :retries i :hosts (routing/-hosts (:routing-policy ctx))})))]
+                                       (catch Exception t
+                                         (routing/-on-error! (:routing-policy ctx) host t)
+                                         (ex-info (str "Error while connecting to " host) {:throwable t :host host :retries i :hosts (routing/-hosts (:routing-policy ctx))})))]

-                              (if (instance? Throwable res)
-                                (do
-                                  (error res)
-                                  (if (< i (count (routing/-hosts (:routing-policy ctx))))
-                                    (recur (inc i))
-                                    (throw res)))
-                                res)))
+                                (if (instance? Throwable res)
+                                  (do
+                                    (error res)
+                                    (if (< i (count (routing/-hosts (:routing-policy ctx))))
+                                      (recur (inc i))
+                                      (throw res)))
+                                  res)))

-                    (throw-no-connection!))))
+                      (throw-no-connection!)))))

 (defn retry-select-send!
       "Send with the retry-policy, select-send! will be retried depending on the retry policy"
-      [{:keys [retry-policy] :as ctx} io-f timeout-ms]
-      {:pre [retry-policy]}
-      (retry/with-retry retry-policy #(select-send! ctx io-f timeout-ms)))
+      ([{:keys [retry-policy] :as ctx} host-address io-f timeout-ms]
+        {:pre [retry-policy]}
+        (retry/with-retry retry-policy #(select-send! ctx host-address io-f timeout-ms)))
+      ([{:keys [retry-policy] :as ctx} io-f timeout-ms]
+        {:pre [retry-policy]}
+        (retry/with-retry retry-policy #(select-send! ctx io-f timeout-ms))))

 ;; routing-policy is a function to which we pass the routing-env atom, which contains {:hosts (set [tcp-conn/HostAddressSchema]) } by default
@@ -120,8 +126,10 @@
        ctx - returned from create
        io-f - function that should accept the tcp-driver.io.conn/ITCPConn
        timeout-ms - the timeout for connection borrow"
-      [ctx io-f timeout-ms]
-      (retry-select-send! ctx io-f timeout-ms))
+      ([ctx host-address io-f timeout-ms]
+        (retry-select-send! ctx host-address io-f timeout-ms))
+      ([ctx io-f timeout-ms]
+        (retry-select-send! ctx io-f timeout-ms)))

 (defn create-default


Reindent docstrings in protocols.clj

Reindent docstrings in protocols.clj

This fixes the indentation in (doc) calls.

--- cortex/src/cortex/nn/protocols.cljc
+++ cortex/src/cortex/nn/protocols.cljc
@@ -10,7 +10,7 @@
   "Protocol for a generic module. All cortex.nn modules must implement this."
   (calc [m input]
     "Performs module calculation, returning an updated module that includes the output and
-     any intermediate states computed.")
+  any intermediate states computed.")
   (output [m]
     "Returns the calculated output of a module"))

@@ -34,8 +34,8 @@

 (defprotocol PGradient
   "Protocol for a module that supports accumulated gradients for optimisation. This vector should be exactly the
-   same length as the parameter vector.
-   The default implementation returns an empty gradient vector."
+  same length as the parameter vector.
+  The default implementation returns an empty gradient vector."
   (gradient [m]
     "Gets the accumulated gradient for this module, as a vector."))

@@ -43,19 +43,19 @@
   "Protocol to return a function that computes the gradient of the loss function for a module."
   (loss-gradient-fn [m]
     "Gets a fn [output traget] that computes the loss gradient for a module. May return nil to
-     indicate that no loss function is specified."))
+  indicate that no loss function is specified."))

 (defprotocol PNeuralTraining
   "Protocol for modules that can be trained with forward / back propagation."
   (forward [this input]
     "Run a forward computation pass and return the updated module. output will be
-    available for later retrieval. Input and intermediate states will be stored for
-    futuere backward pass usage.")
+  available for later retrieval. Input and intermediate states will be stored for
+  futuere backward pass usage.")

   (backward [this input output-gradient]
     "Back propagate errors through the module with respect to the input.  Returns the
-    module with input-gradient set (gradient at the inputs). Input must be the same
-    as used in the forward pass.")
+  module with input-gradient set (gradient at the inputs). Input must be the same
+  as used in the forward pass.")

   (input-gradient [this]
     "Gets the computed input gradients for a module. Assumes the backward pass has been run."))
@@ -63,8 +63,8 @@

 (defprotocol PNeuralTrainingOptional
   "Some layers will want to do things before the forward pass like update random number buffers.
-This allows things like dropout to play well with gradient checking in that prepare-forward can
-be called once but forward can be called multiple times (normally 1 + 2 * n-params)."
+  This allows things like dropout to play well with gradient checking in that prepare-forward can
+  be called once but forward can be called multiple times (normally 1 + 2 * n-params)."
   (prepare-forward [this]))

@@ -79,29 +79,29 @@
   "Protocol for modules that can be trained input / output pairs."
   (train [this input output]
     "Trains the module to produce the given input / output. Accumulates gradients as necessary.
-     Intended for use with update-parameters after completion of a (mini-)batch."))
+  Intended for use with update-parameters after completion of a (mini-)batch."))

 (defprotocol PGradientOptimiser
   "A gradient optimiser is an abstraction for objects that update parameters based on gradient observations.
-   Gradient optimisers typically contain relating to previous observations, momentum etc."
+  Gradient optimisers typically contain relating to previous observations, momentum etc."
   (compute-parameters
     [optimiser gradient parameters]
-     "Computes updated parameters using the given average gradient. Returns the updated gradient optimiser.
-      Users can then call `parameters` on this object to get the updated parameters"))
+    "Computes updated parameters using the given average gradient. Returns the updated gradient optimiser.
+  Users can then call `parameters` on this object to get the updated parameters"))

 (defprotocol PLossFunction
   "A function that calculates loss of a vector output vs. a target value"
   (loss [this v target]
-        "Computes the loss for a value v against a target")
+    "Computes the loss for a value v against a target")
   (loss-gradient [this v target]
-        "Computes the gradient of the loss with respect to v"))
+    "Computes the gradient of the loss with respect to v"))

 (defprotocol PSerialize
   "Default implementation simply calls into {} and adds type.  An override
-is necessary if your class has complex object members instead of simple keys.
-The map must have a key named :record-type that is the fully namespaced
-qualified record class name (.getName (type item)).  The system will look
-for a function map->TypeName in order to create an empty object."
+  is necessary if your class has complex object members instead of simple keys.
+  The map must have a key named :record-type that is the fully namespaced
+  qualified record class name (.getName (type item)).  The system will look
+  for a function map->TypeName in order to create an empty object."
   (->map [this])
   (map-> [this map-data]))


Simplify reverse sort

Simplify reverse sort

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -19,7 +19,7 @@
             :progress-running? false
             :player            {}
             :evolution-number  0
-            :sort-asc              true}))
+            :sort-asc          true}))

 (declare get-pokemon-by-id)
 (declare evolution-sum)
@@ -67,12 +67,10 @@

 (defmethod mutate 'sort/pokemon
   [{:keys [state]} _ {:keys [key]}]
-  {:action (fn [] (swap! state update-in [:pokemon] (fn [] (cond-> (sort-by (juxt key :individual_percentage :cp) (:pokemon @state))
-                                                                  (:sort-asc @state) reverse))))})
-
-(defmethod mutate 'sort/toggle-asc
-  [{:keys [state]} _ {:keys []}]
-  {:action (fn [] (swap! state update-in [:sort-asc] not))})
+  {:action (fn []
+             (swap! state update-in [:pokemon] (fn [] (cond-> (sort-by (juxt key :individual_percentage :cp) (:pokemon @state))
+                                                              (:sort-asc @state) reverse)))
+             (swap! state update-in [:sort-asc] not))})

 (defmethod mutate 'change/view
   [{:keys [state]} _ {:keys [view]}]
@@ -243,8 +241,7 @@
 (defn sort-pokemon!
   "Sort complete list of pokemon by given key."
   [key]
-  (om/transact! reconciler `[(sort/pokemon {:key ~key})])
-  (om/transact! reconciler `[(sort/toggle-asc)]))
+  (om/transact! reconciler `[(sort/pokemon {:key ~key})]))

 (defn update-player!
   "Update the playerdata."


Revert "CMR-3260: Updated migration to insert the initial humanizer concept."

This reverts commit dd2d72b62daf4de3d679300af0f70ee870b67d19.

--- metadata-db-app/src/migrations/044_setup_humanizers_table.clj
+++ metadata-db-app/src/migrations/044_setup_humanizers_table.clj
@@ -1,11 +1,7 @@
 (ns migrations.044-setup-humanizers-table
   (:require [clojure.java.jdbc :as j]
             [config.migrate-config :as config]
-            [config.mdb-migrate-helper :as h]
-            [cmr.metadata-db.data.oracle.concepts]
-            [cmr.metadata-db.data.concepts :as c]
-            [cheshire.core :as json]
-            [cmr.common-app.test.sample-humanizer :as sh]))
+            [config.mdb-migrate-helper :as h]))

 (def ^:private humanizers-column-sql
   "id NUMBER,
@@ -42,37 +38,17 @@
   []
   (h/sql "CREATE SEQUENCE cmr_humanizers_seq"))

-(defn- insert-humanizer
-  []
-  (let [provider {:provider-id "CMR"
-                  :short-name "CMR"
-                  :system-level? true
-                  :cmr-only true
-                  :small false}
-        concept {:concept-type :humanizer
-                 :native-id "humanizer"
-                 :metadata (json/generate-string sh/sample-humanizers)
-                 :user-id "migration"
-                 :format "application/json"
-                 :provider-id "CMR"
-                 :concept-id "H12345-CMR"
-                 :revision-id 1
-                 :deleted false}]
-    (c/save-concept (config/db) provider concept)))
-
 (defn up
   "Migrates the database up to version 44."
   []
   (println "migrations.044-setup-humanizers-table up...")
   (create-humanizers-table)
   (create-humanizers-indices)
-  (create-humanizers-sequence)
-  (insert-humanizer))
+  (create-humanizers-sequence))

 (defn down
   "Migrates the database down from version 44."
   []
   (println "migrations.044-setup-humanizers-table down...")
-  (h/sql "DELETE cmr_humanizers")
   (h/sql "DROP SEQUENCE METADATA_DB.cmr_humanizers_seq")
   (h/sql "DROP TABLE METADATA_DB.cmr_humanizers"))


bug fixes: init val transpose, invert ops, midi->freq

--- src/temperaments/core.clj
+++ src/temperaments/core.clj
@@ -8,6 +8,8 @@
   (:require [overtone.core :as o]
             [clojure.string :as s])
   (:gen-class))
+
+(load-file "src/temperaments/smart_sort.clj")

 (native!)

@@ -55,8 +57,9 @@
   (let [tonic-note (o/note @tonic)
         tonic-freq (o/midi->hz tonic-note)
         diff (- n tonic-note)
-        octave (quot diff 12)
-        octave (if (< diff 0) (- octave 1) octave)
+        octave (if (< diff 0)
+                 (dec (quot (inc diff) 12))
+                 (quot diff 12))
         interval (mod diff 12)]
     (* tonic-freq (Math/pow 2 octave) (nth (get @tuning-map @tuning) interval))))

@@ -359,7 +362,7 @@
                  :editable? true)]
     cb))

-(def panel-size [240 :by 500])
+(def panel-size [300 :by 620])
 (defn get-panel-size []
   [(first panel-size) (last panel-size)])

@@ -368,8 +371,8 @@
   (let [[w h] (get-panel-size)
         mel-hours (get (get @melody-map id) :pitches)
         mel-angle (/ (* 2 (Math/PI)) mel-hours)
-        radius (* w 0.3)
-        [xc yc] [(/ w 2) (* h 0.2)]
+        radius (* w 0.4)
+        [xc yc] [(/ w 2) (* h 0.25)]
         [wb hb] [50 20]]
     (map (fn [n]
            (let [angle (+ (/ Math/PI -2) (* n mel-angle))
@@ -387,8 +390,8 @@
   (let [[w h] (get-panel-size)
         rhy-hours (get (get @melody-map id) :beats)
         rhy-angle (/ (* 2 (Math/PI)) rhy-hours)
-        radius (* w 0.3)
-        [xc yc] [(/ w 2) (* h 0.6)]
+        radius (* w 0.4)
+        [xc yc] [(/ w 2) (* h 0.75)]
         [wb hb] [50 20]]
     (map (fn [n]
            (let [angle (+ (/ Math/PI -2) (* n rhy-angle))
@@ -403,13 +406,13 @@
              cb))
          (range rhy-hours))))

-(def polychord-panel-size [240 :by 240])
+(def polychord-panel-size [300 :by 300])

 ;; make chord keyboard for xyz-panel
 (defn make-ratio-circle [id hours]
   (let [[w & {h :by}] polychord-panel-size
         angle (/ (* 2 (Math/PI)) hours)
-        radius (* w 0.3)
+        radius (* w 0.4)
         [xc yc] [(/ w 2) (/ h 2)]
         [wb hb] [70 20]]
     (map (fn [n]
@@ -565,7 +568,7 @@
          root (get-in @melody-map [id :root])
          panel (select root [:#kb])
          circhash (atom {})]
-                                        ;(println idlist)
+     ;(println idlist)
      (doseq [k idlist]
        (let [w (select panel [k])]
          (swap! circhash assoc k (value w))
@@ -681,11 +684,12 @@
      (map midi->str newnotes))))

 (defn transform-dict [dict trans]
-  (let [kws (keys dict)
-        oldvals (vals dict)
+  (let [sorted (sort-by key compare-keywords dict)
+        kws (keys sorted)
+        oldvals (vals sorted)
         newvals (trans oldvals)
         pairs (map #(vector %1 %2) kws newvals)]
-    (into {} pairs)))
+    (into {} pairs)))

 (defn transform-necklace [trans id typekw]
   (let [panel (id->panel id)
@@ -716,28 +720,32 @@
   (let [reflect-button (button :text "Invert!"
                                :listen [:action
                                         (fn [e]
+                                          (let [center (+ (o/note @tonic) 3.5)
+                                                center (if (> center 66)
+                                                         (- center 12)
+                                                         center)]
                                           (transform-necklace
-                                           (invert-names (+ (o/note @tonic) 3.5))
-                                           id :pitches))])
+                                           (invert-names center)
+                                           id :pitches)))])
         translabel (label "Transpose: ")
         transbox (combobox :model (range -6 7)
-                           :id (keyword (s/join ["kb-" id "-mel-transpose"]))
-                           :listen [:action (fn [e]
-                                           (transform-necklace
-                                                   (transpose-names (get-e-val e))
-                                                   id :pitches))])]
-    (value! reflect-button 0)
+                           :id (keyword (s/join ["kb-" id "-mel-transpose"])))]
+    (.setSelectedItem transbox 0)
+    (config! transbox :listen [:action (fn [e]
+                                         (transform-necklace
+                                          (transpose-names (get-e-val e))
+                                          id :pitches))])
     (horizontal-panel :items [reflect-button translabel transbox])))

 ;;;;;;;;;;;;;; transforms end

 (defn make-panel-controls [id]
-  (let [cbp (combobox :model (range 1 10)
+  (let [cbp (combobox :model (range 1 13)
                       :id (keyword (s/join ["kb-" (str id) "-numpitch"]))
                       :listen [:action
                                (fn [e]
                                  (change-circle-mel id (value (.getSource e))))])
-        cbb (combobox :model (range 1 10)
+        cbb (combobox :model (range 1 13)
                       :id (keyword (s/join ["kb-" (str id) "-numbeats"]))
                       :listen [:action
                                (fn [e]
@@ -847,7 +855,7 @@
                                                    (config! src :text "Off")
                                                    (config! src :text "On"))))])
         tonic-bar (horizontal-panel :items [tonic-label tonic-button])
-        circle-sizer (combobox :model (range 1 10)
+        circle-sizer (combobox :model (range 1 13)
                                :listen [:action
                                         (fn [e]
                                           (let [butt (.getSource e)
@@ -1053,9 +1061,8 @@
                                      :listen [:action melody-chooser])
                            ])))

-(config! control-frame :on-close :exit)
+;(config! control-frame :on-close :exit)

 (defn -main [& args]
   (-> control-frame pack! show!)
-  ;;(make-melody-canvas "test-canvas")
   )


Functions to record error and/or exception

--- src/emender_service/db_interface.clj
+++ src/emender_service/db_interface.clj
@@ -54,6 +54,14 @@
         (catch Exception e
             (println e))))

+(defn record-error
+    [datetime message stacktrace]
+    (try
+        (jdbc/insert! db-spec/emender-service-db
+                      :errors {:datetime datetime :message message :stacktrace stacktrace})
+        (catch Exception e
+            (println e))))
+
 (defn log-request-information
     [request]
     (let [uri       (:uri request)
@@ -76,3 +84,7 @@
     (record-job-event job-name (format-current-date) "results")
     (record-job-results job-name (format-current-date) results))

+(defn log-error
+    [message stacktrace]
+    (record-error (format-current-date message stacktrace)))
+


Ensuring that we don't start two parallel import process

--- src/tropefest/handler.clj
+++ src/tropefest/handler.clj
@@ -21,24 +21,32 @@
            (route/not-found "Not Found"))

+
+
 ;
 ; Tasks
 ;

+(def state (atom {:isRunning false}))
+
 (defn crawl-handler [t opts]
-  (timbre/info (str "Remaining " (count (db/query-nodes-to-crawl (db/get-connection) 9999999)) " updating " (:total opts) "... "))
-  (try
-    (p/crawl-and-update! (db/get-connection) (Integer. (:total opts)))
-    (catch Throwable t (timbre/error (str "Exception while crawling: " t)))
-    )
-  (timbre/info "Done crawling."))
+  (if (false? (:isRunning @state))
+    (do
+      (swap! state assoc :isRunning true)
+      (try
+        (do
+          (timbre/info (str "Remaining " (count (db/query-nodes-to-crawl (db/get-connection) 9999999)) " updating " (:total opts) "... "))
+          (p/crawl-and-update! (db/get-connection) (Integer. (:total opts))))
+        (catch Throwable t (timbre/error (str "Exception while crawling: " t))))
+      (timbre/info "Done crawling.")
+      (swap! state assoc :isRunning false))
+    (timbre/info "Not crawling because of on-going import process.")))

 (defn update-handler [t opts]
   (timbre/info "Updating link totals")
   (try
     (db/update-link-count! (db/get-connection))
-    (catch Throwable t (timbre/error (str "Exception while updating: " t)))
-    )
+    (catch Throwable t (timbre/error (str "Exception while updating: " t))))
   (timbre/info "Done updating."))

@@ -81,6 +89,8 @@
    an app server such as Tomcat
    put any initialization code here"
   []
+
+  (timbre/info "Initializing...")

   (timbre/set-config!
     [:appenders :rotor]


Refactoring

Refactoring

--- src/clj/algorithms_clj/huffman.clj
+++ src/clj/algorithms_clj/huffman.clj
@@ -1,6 +1,7 @@
 (ns algorithms-clj.huffman
   (:require
-    [clojure.data.priority-map :as prio :refer [priority-map]]
+    [clojure.data.priority-map :as prio]
+    [clojure.set :as set]
     ))

@@ -16,17 +17,23 @@
 (defn- make-node
   "Build an intermediary node from two sub-trees"
   [[c1 w1] [c2 w2]]
-  (let [vals (into (:values c1) (:values c2))]
-    [{:values vals :lhs c1 :rhs c2} (+ w1 w2)]
+  [{:values (set/union (:values c1) (:values c2))
+    :lhs c1
+    :rhs c2}
+   (+ w1 w2)])
+
+(defn- pop-two
+  "Pop two elements from the priority queue"
+  [heap]
+  (let [rest (pop heap)]
+    [(peek heap) (peek rest) (pop rest)]
     ))

 (defn- merge-lowest
   "Merge the two lowest priority elements"
   [heap]
-  (let [rest (pop heap)]
-    (conj (pop rest)
-      (make-node (peek heap) (peek rest))
-      )))
+  (let [[a b rest] (pop-two heap)]
+    (conj rest (make-node a b))))

 (defn- merge-lowest-recursively
   "Build the huffman tree from the priority map"
@@ -40,9 +47,10 @@
   [value-frequency-pairs]
   (->>
     value-frequency-pairs
-    (into (priority-map) (map make-leaf))
+    (into (prio/priority-map) (map make-leaf))
     merge-lowest-recursively
-    first))
+    first ;; First element of the leaf
+    ))

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


Add support for icon-raw to layers sidebar.

--- src/uxbox/main/ui/workspace/sidebar/layers.cljs
+++ src/uxbox/main/ui/workspace/sidebar/layers.cljs
@@ -79,6 +79,7 @@
   [item]
   (case (:type item)
     :icon (icon/icon-svg item)
+    :icon-raw (icon/icon-raw-svg item)
     :line i/line
     :circle i/circle
     :path i/curve


Add cp437 font support

Add cp437 font support

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -5,7 +5,8 @@
             [taoensso.timbre :as log]
             [clojure.core.async :as async :refer [go go-loop]]
             [clojure-watch.core :as cwc]
-            [clojure.core.async :as async])
+            [clojure.core.async :as async]
+            [clojure.java.io :as jio])
   (:import
     (java.lang.reflect Field)
     (java.awt Canvas
@@ -113,7 +114,7 @@
     (log/info "key" key)
     (on-key-fn key)))

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

 (defn make-font
   [name-or-path style size]
@@ -129,7 +130,7 @@
         (Font. name-or-path style size)))))

 (defn next-pow-2 [v]
-  (int (Math/pow 2 (inc (Math/floor (/ (Math/log v) (Math/log 2)))))))
+  (int (Math/pow 2 (Math/ceil (/ (Math/log v) (Math/log 2))))))

 (def cjk-blocks
@@ -145,56 +146,135 @@
   (let [chars (map char (filter (fn [c] (and (.canDisplay font (char c))
                                              (not (contains? cjk-blocks c))))
                                 (range 0x0000 0xFFFF)))]
-    (concat (map vector chars (repeat false))
-            (map vector chars (repeat true)))))
+    chars))

 (defn characters-per-line [char-width num-characters]
   (int (Math/floor (/ (Math/pow 2 11) char-width))))

-;; A sequence of [[\character underline?] x y] where [x y] is the column,row in the character atlas.
+;; A sequence of [\character col row] where [col row] is the column,row in the character atlas.
 (defn character-idxs
   [char-width characters]
-  ;(let [character-matrix (partition-all (int (inc (Math/sqrt (count characters)))) characters)]
-  (let [character-matrix    (partition-all (characters-per-line char-width (count characters)) characters)]
+  (let [character-matrix (partition-all (characters-per-line char-width (count characters)) characters)]
     (log/info "arranging character with" characters-per-line "per line")
     (mapcat concat
     (map-indexed (fn [row line]
-                   (map-indexed (fn [col c-underline?]
-                                  [c-underline? col row])
+                   (map-indexed (fn [col c]
+                                  [c col row])
                                 line))
                  character-matrix))))

-;; Map [\character underline?] to [col row]
-(defn-memoized character->col-row
+;; Map \character to [col row]
+(defn character->col-row
   [character-idxs]
-  (reduce (fn [m [c-underline? x y]]
-            (assoc m c-underline? [x y]))
+  (reduce (fn [m [c x y]]
+            (assoc m c [x y]))
           {}
           character-idxs))

-(defn make-glyph-image
-  [char-width char-height font]
+(def cp437-unicode
+  (mapv char
+    (concat
+      [0x0000 0x263A 0x263B 0x2665 0x2666 0x2663 0x2660 0x2022 0x25D8 0x25CB 0x25D9 0x2642 0x2640 0x266A 0x266B 0x263C]
+      [0x25BA 0x25C4 0x2195 0x203C 0x00B6 0x00A7 0x25AC 0x21A8 0x2191 0x2193 0x2192 0x2190 0x221F 0x2194 0x25B2 0x25BC]
+      (range (int \space) (int \~)) [0x2302]
+      [0x00C7 0x00FC 0x00E9 0x00E2 0x00E4 0x00E0 0x00E5 0x00E7 0x00EA 0x00EB 0x00E8 0x00EF 0x00EE 0x00EC 0x00C4 0x00C5]
+      [0x00C9 0x00E6 0x00C6 0x00F4 0x00F6 0x00F2 0x00FB 0x00F9 0x00FF 0x00D6 0x00DC 0x00A2 0x00A3 0x00A5 0x20A7 0x0192]
+      [0x00E1 0x00ED 0x00F3 0x00FA 0x00F1 0x00D1 0x00AA 0x00BA 0x00BF 0x2310 0x00AC 0x00BD 0x00BC 0x00A1 0x00AB 0x00BB]
+      [0x2591 0x2592 0x2593 0x2502 0x2524 0x2561 0x2562 0x2556 0x2555 0x2563 0x2551 0x2557 0x255D 0x255C 0x255B 0x2510]
+      [0x2514 0x2534 0x252C 0x251C 0x2500 0x253C 0x255E 0x255F 0x255A 0x2554 0x2569 0x2566 0x2560 0x2550 0x256C 0x2567]
+      [0x2568 0x2564 0x2565 0x2559 0x2558 0x2552 0x2553 0x256B 0x256A 0x2518 0x250C 0x2588 0x2584 0x258C 0x2590 0x2580]
+      [0x03B1 0x00DF 0x0393 0x03C0 0x03A3 0x03C3 0x00B5 0x03C4 0x03A6 0x0398 0x03A9 0x03B4 0x221E 0x03C6 0x03B5 0x2229]
+      [0x2261 0x00B1 0x2265 0x2264 0x2320 0x2321 0x00F7 0x2248 0x00B0 0x2219 0x00B7 0x221A 0x207F 0x00B2 0x25A0 0x00A0])))
+
+(defn copy-channel [v channel]
+  (let [channel-shift (case channel
+                       :alpha 24
+                       :blue  16
+                       :green  8
+                       :red    0)
+        c (->
+            (bit-shift-left 0xFF channel-shift)
+            (bit-and v)
+            (unsigned-bit-shift-right channel-shift))]
+    (reduce (fn [a n] (bit-or a (bit-shift-left c n))) 0 [24 16 8 0])))
+
+(defn ^BufferedImage copy-channels! [^BufferedImage buffered-image channel]
+  (doseq [x (range (.getWidth buffered-image))
+          y (range (.getHeight buffered-image))]
+      (.setRGB buffered-image  x y (copy-channel (.getRGB buffered-image x y) channel)))
+  buffered-image)
+
+(defn ^BufferedImage scale-image [^BufferedImage buffered-image scale]
+  (let [scaled-image    (BufferedImage. (* scale (.getWidth buffered-image))
+                                        (* scale (.getHeight buffered-image))
+                                        (.getType buffered-image))
+        scaled-graphics (.createGraphics scaled-image)]
+    (doto scaled-graphics
+      (.scale scale scale)
+      (.drawImage buffered-image 0 0 nil)
+      (.dispose))
+    scaled-image))
+
+(defrecord CP437Font [path-or-url alpha scale])
+
+(defrecord TTFFont [name-or-path size])
+
+(defmulti glyph-graphics class)
+(defmethod glyph-graphics CP437Font [font]
+  (let [characters    (map char cp437-unicode)
+        font-image    (copy-channels! (scale-image (ImageIO/read (jio/input-stream (get font :path-or-url))) (get font :scale)) (get font :alpha))
+        ;font-image    (ImageIO/read (jio/input-stream (get font :path-or-url)))
+        width         (next-pow-2 (.getWidth font-image))
+        height        (next-pow-2 (.getHeight font-image))
+        cwidth        (/ (.getWidth font-image) 16)
+        cheight       (/ (.getHeight font-image) 16)
+        texture-image (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
+        texture-graphics (.createGraphics texture-image)]
+    (doto texture-graphics
+      (.setColor (Color. 0 0 0 0))
+      (.fillRect 0 0 width height)
+      (.drawImage font-image 0 0 nil)
+      (.dispose))
+    (ImageIO/write font-image "png", (File. "font-texture.png"))
+    {:font-texture-width width
+     :font-texture-height height
+     :font-texture-image texture-image
+     :character-width cwidth
+     :character-height cheight
+     :character->col-row (zipmap
+                           characters
+                           (for [row (range 16)
+                                 col (range 16)]
+                             [col row]))}))
+
+(defmethod glyph-graphics TTFFont [font]
   ;; Adjust canvas to fit character atlas size
-  (let [characters (displayable-characters font)
+  (let [j-font                     (make-font (get font :name-or-path) Font/PLAIN (get font :size))
+        characters                 (displayable-characters j-font)
+        font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) j-font)
+        char-width                 (.charWidth font-metrics \M)
+        char-height                (.getHeight font-metrics)
         _ (log/info "characters per line" (characters-per-line char-width (count characters)))
+        ;screen-width               (* columns char-width)
+        ;screen-height              (* rows char-height)
         cwidth     2048
         cheight    (next-pow-2 (* char-height (int (Math/ceil (/ (count characters)
                                                                  (characters-per-line char-width (count characters)))))))
         width      cwidth ;(max cwidth cheight)
         height     cheight ;(max cwidth cheight)
         antialias  true
-        font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) font)]
+        char-idxs   (character-idxs char-width characters)]
     (log/info "characters" (count characters) "cwidth" cwidth "cheight" cheight)
     (log/info "glyph image width" width "height" height)
     ;(log/info "characters" (vec characters))
     ;(log/info "character-idxs" (vec (character-idxs characters)))
     (let [texture-image    (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
-          texture-graphics ^Graphics2D (.getGraphics texture-image)
+          texture-graphics (.createGraphics texture-image)
           white            (Color. 255 255 255 255)]
       ;; Create and clear graphics
       (doto texture-graphics
-        (.setFont font)
+        (.setFont j-font)
         (.setRenderingHint RenderingHints/KEY_TEXT_ANTIALIASING (if antialias
                                                                   RenderingHints/VALUE_TEXT_ANTIALIAS_GASP
                                                                   RenderingHints/VALUE_TEXT_ANTIALIAS_OFF))
@@ -202,32 +282,27 @@
         (.setColor (Color. 0 0 0 0))
         (.fillRect 0 0 width height))
       ;; Loop through each character, drawing it
-      (doseq [[[s underline?] col row]  (character-idxs char-width characters)]
+      (doseq [[c col row]  char-idxs]
         (let [x ^int (* col char-width)
               y ^int (* (inc row) char-height)
               cx (+ 0 x)
               cy (- y (.getDescent font-metrics))]
           ;(log/info s x y)
-        (when (not= s " ")
+        (when (not= c \space)
           ;(println "drawing" s "@" x y "underline?" underline?)
           (doto texture-graphics
             (.setColor white)
             (.setClip cx (+ (- cy char-height) (.getDescent font-metrics)) char-width char-height)
-            (.drawString (str s) cx cy)))
-        (when underline?
-          (let [y (dec y)]
-            (doto texture-graphics
-              (.setColor white)
-              (.drawLine x
-                         y
-                         (+ x char-width)
-                         y))))))
+            (.drawString (str c) cx cy)))))
       ;; cleanup texture resource
-      ;(ImageIO/write texture-image "jpg", (File. "glyph-texture.jpg"))
+      (ImageIO/write texture-image "png", (File. "glyph-texture.png"))
       (.dispose texture-graphics)
       {:font-texture-width width
        :font-texture-height height
-       :font-texture-image texture-image})))
+       :font-texture-image texture-image
+       :character-width char-width
+       :character-height char-height
+       :character->col-row (character->col-row char-idxs)})))

 (defn- buffered-image-byte-buffer [^BufferedImage buffered-image]
@@ -347,7 +422,7 @@

 (defn- init-display [title screen-width screen-height icon-paths gl-lock destroyed]
   (let [pixel-format       (PixelFormat.)
-        context-attributes (doto (ContextAttribs. 3 2)
+        context-attributes (doto (ContextAttribs. 4 4)
                              (.withForwardCompatible true)
                              (.withProfileCore true))
         icon-array         (when icon-paths
@@ -663,7 +738,7 @@
              {:keys [^ByteBuffer glyph-image-data
                      ^ByteBuffer fg-image-data
                      ^ByteBuffer bg-image-data]} :data
-             :keys [p-matrix-buffer mv-matrix-buffer character-width character-height character->col-row]} gl
+             :keys [p-matrix-buffer mv-matrix-buffer]} gl
             glyph-image-data glyph-image-data
             fg-image-data fg-image-data
             bg-image-data bg-image-data
@@ -671,6 +746,7 @@
                     screen-height
                     character-width
                     character-height
+                    character->col-row
                     font-texture-width
                     font-texture-height
                     font-texture]} (get @font-textures (font-key @normal-font))
@@ -703,7 +779,7 @@
                   ;s         (str (get c :character))
                   style     (get c :style)
                   i         (* 4 (+ (* texture-columns row) col))
-                  [x y]     (get character->col-row [chr (contains? style :underline)])]
+                  [x y]     (get character->col-row chr)]
               ;(log/info "Drawing at col row" col row "character from atlas col row" x y c "(index=" i ")")
               (when (zero? col)
                 (.position glyph-image-data i)
@@ -921,28 +997,30 @@
                              :font-watcher
                              (fn [_ _ _ new-font]
                                (log/info "Using font" new-font)
-                               (let [font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) new-font)
-                                     char-width                 (.charWidth font-metrics \M)
-                                     char-height                (.getHeight font-metrics)
-                                     screen-width               (* columns char-width)
-                                     screen-height              (* rows char-height)
-                                     ;; create texture atlas as Buffered texture
+                               (let [;; create texture atlas as Buffered texture
                                      {:keys [font-texture-width
                                              font-texture-height
-                                             font-texture-image]} (make-glyph-image char-width char-height new-font)]
-                                 (log/info "Created font texture. screen-width" screen-width "screen-height" screen-height)
+                                             font-texture-image
+                                             character-width
+                                             character-height
+                                             character->col-row]
+                                      :as font-parameters} (glyph-graphics new-font)
+                                     screen-width (* character-width columns)
+                                     screen-height (* character-height rows)]
+                                 (log/info "Created font texture " (dissoc font-parameters :character->col-row) " screen-width" screen-width "screen-height" screen-height)
                                  (swap! font-textures assoc
                                                      (font-key new-font)
                                                      {:screen-width screen-width
                                                       :screen-height screen-height
-                                                      :character-width char-width
-                                                      :character-height char-height
+                                                      :character-width character-width
+                                                      :character-height character-height
+                                                      :character->col-row character->col-row
                                                       :font-texture-width font-texture-width
                                                       :font-texture-height font-texture-height
                                                       :font-texture-image font-texture-image}))))
           _                  (reset! normal-font (if is-windows
-                                                   (make-font windows-font Font/PLAIN font-size)
-                                                   (make-font else-font Font/PLAIN font-size)))
+                                                   windows-font
+                                                   else-font))
           ;; false if Display is destoyed
           destroyed          (atom false)
           gl-lock            (atom true)
@@ -1058,9 +1136,6 @@
                            {:p-matrix-buffer (ortho-matrix-buffer screen-width screen-height)
                             :mv-matrix-buffer (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0]
                                                                       [screen-width screen-height 1.0])
-                            :character-width character-width
-                            :character-height character-height
-                            :character->col-row (character->col-row (character-idxs character-width (displayable-characters @normal-font)))
                             :buffers {:vertices-vbo-id vertices-vbo-id
                                       :vertices-count vertices-count
                                       :texture-coords-vbo-id texture-coords-vbo-id
@@ -1138,16 +1213,33 @@
   "Show a terminal and echo input."
   [& _]
   ;; render in background thread
-  (let [terminal   (make-terminal [:text]
+  (let [colorShift    (atom 0.0001)
+        brightness    (atom 0.68)
+        contrast      (atom 2.46)
+        scanlineDepth (atom 0.94)
+        time          (atom 0.0)
+        noise         (atom 0.0016)
+        terminal   (make-terminal [:text :rainbow]
                                   {:title "Zaffre demo"
                                    :columns 80 :rows 24
                                    :default-fg-color [250 250 250]
                                    :default-bg-color [5 5 8]
-                                   :font-size 18
+                                   :windows-font "Consolas"
+                                   ;:else-font "/home/santos/Downloads/cour.ttf"
+                                   ;:else-font (TTFFont. "/home/santos/Downloads/cour.ttf" 12)
+                                   ;:else-font (CP437Font. "http://dwarffortresswiki.org/images/2/29/Potash_8x8.png" :green)
+                                   :else-font (CP437Font. "/home/santos/Pictures/LN_EGA8x8.png" :green 1)
                                    :antialias true
                                    :icon-paths ["images/icon-16x16.png"
                                                 "images/icon-32x32.png"
-                                                "images/icon-128x128.png"]})
+                                                "images/icon-128x128.png"]
+                                   :fx-shader {:name     "retro.fs"
+                                               :uniforms [["time" @time]
+                                                          ["noise" @noise]
+                                                          ["colorShift" @colorShift]
+                                                          ["scanlineDepth" @scanlineDepth]
+                                                          ["brightness" @brightness]
+                                                          ["contrast" @contrast]]}})
         last-key   (atom nil)
         input-chan (go-loop []
           (reset! last-key (async/<!! (zat/get-key-chan terminal)))
@@ -1193,8 +1285,12 @@
                                     :default-fg-color [250 250 250]
                                     :default-bg-color [5 5 8]
                                     :windows-font "Consolas"
-                                    :else-font "/home/santos/Downloads/cour.ttf"
-                                    :font-size 18
+                                    ;:else-font "/home/santos/Downloads/cour.ttf"
+                                    ;:else-font (TTFFont. "/home/santos/Downloads/cour.ttf" 12)
+                                    ;:else-font (TTFFont. "Monospaced" 12)
+                                    ;:else-font (TTFFont. "/home/santos/src/robinson/fonts/Boxy/Boxy.ttf" 12)
+                                    ;:else-font (CP437Font. "http://dwarffortresswiki.org/images/2/29/Potash_8x8.png" :green)
+                                    :else-font (CP437Font. "/home/santos/Pictures/LN_EGA8x8.png" :green 2)
                                     :antialias true
                                     :icon-paths ["images/icon-16x16.png"
                                                  "images/icon-32x32.png"


Simplify updating state for adding a new user

--- src/braid/client/core/events.cljs
+++ src/braid/client/core/events.cljs
@@ -617,7 +617,7 @@
 (reg-event-db
   :add-user
   (fn [state [_ user]]
-    (update-in state [:users] assoc (:id user) user)))
+    (assoc-in state [:users (:id user)] user)))

 (reg-event-db
   :remove-user-from-group


added btn class to button

added btn class to button

--- src/cat_camp/views/home_page.cljs
+++ src/cat_camp/views/home_page.cljs
@@ -37,7 +37,7 @@
    [player-input :p2 "Blue"]
    [player-input :p3 "White"]
    [player-input :p4 "Orange"]
-   [:input.player-input
+   [:input.player-input.btn
     (if (#(<= 3 (named-players)))
       (dissoc (next-page-button) :disabled)
       (assoc (next-page-button) :disabled true))]])


Replace random color generation with more generic algorithm

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -17,26 +17,11 @@
         idx (.indexOf s suffix)]
     (and (not= -1 idx) (= idx pos))))

-(defn decimal->color [decimal]
- (str "hsl(" (int (* 360 (mod decimal 1))) ",71%,35%)") )
-
-(defn string->color [string]
-  (-> string
-      char-array
-      (->> (map int)
-           (apply +))
-      (/ 213)
-      decimal->color))
+(defn ->color [input]
+  (str "hsl(" (mod (Math/abs (hash input)) 360) ",71%,35%)"))

 (defn id->color [uuid]
-  (-> uuid
-      str
-      (.substring 33 36)
-      (js/parseInt 16)
-      (/ 4096)
-      ; at this point, we have a decimal between 0 and 1
-      ; approximately evenly distributed
-      decimal->color))
+  (->color uuid))

 (defn format-date
   "Turn a Date object into a nicely formatted string"


dox fix

dox fix

--- src/metabase/api/common/internal.clj
+++ src/metabase/api/common/internal.clj
@@ -103,7 +103,7 @@
             ((partial vector arg-symbol)))))                         ; [id (Integer/parseInt id)]

 (defmacro auto-parse
-  "Create a `let` form that applies corresponding parse-fn for any symbols in ARGS that are present in `auto-*parse-types*`."
+  "Create a `let` form that applies corresponding parse-fn for any symbols in ARGS that are present in `*auto-parse-types*`."
   [args & body]
   (let [let-forms (->> args
                        (mapcat let-form-for-arg)


No need for "if"

No need for "if"

--- src/cljs/asciinema_player/vt.cljs
+++ src/cljs/asciinema_player/vt.cljs
@@ -793,16 +793,15 @@
 (def parse (memoize (fn [current-state input]
   (let [current-state-cfg (get states current-state)
         transition (or (get-transition anywhere-state input)
-                       (get-transition current-state-cfg (if (>= input 0xa0) 0x41 input)))]
-    (if transition
-      (let [transition-action (:action transition)]
-        (if-let [new-state (:transition transition)]
-          (let [new-state-cfg (get states new-state)
-                exit-action (:on-exit current-state-cfg)
-                entry-action (:on-enter new-state-cfg)
-                actions (remove nil? [exit-action transition-action entry-action])]
-            [new-state actions])
-          [current-state (if transition-action [transition-action] [])])))))))
+                       (get-transition current-state-cfg (if (>= input 0xa0) 0x41 input)))
+        transition-action (:action transition)]
+    (if-let [new-state (:transition transition)]
+      (let [new-state-cfg (get states new-state)
+            exit-action (:on-exit current-state-cfg)
+            entry-action (:on-enter new-state-cfg)
+            actions (remove nil? [exit-action transition-action entry-action])]
+        [new-state actions])
+      [current-state (if transition-action [transition-action] [])])))))

 (defn execute-actions [vt actions input]
   (reduce (fn [vt f] (f vt input)) vt actions))


Make vt/parse 2x faster by memoizing it

Make vt/parse 2x faster by memoizing it

--- src/cljs/asciinema_player/vt.cljs
+++ src/cljs/asciinema_player/vt.cljs
@@ -788,7 +788,7 @@
 (defn- get-transition [rules input]
   (some (fn [[pred cfg]] (when (pred input) cfg)) rules))

-(defn parse [current-state input]
+(def parse (memoize (fn [current-state input]
   (let [current-state-cfg (get states current-state)
         transition (or (get-transition anywhere-state input)
                        (get-transition current-state-cfg (if (>= input 0xa0) 0x41 input)))]
@@ -800,7 +800,7 @@
                 entry-action (:on-enter new-state-cfg)
                 actions (remove nil? [exit-action transition-action entry-action])]
             [new-state actions])
-          [current-state (if transition-action [transition-action] [])])))))
+          [current-state (if transition-action [transition-action] [])])))))))

 (defn execute-actions [vt actions input]
   (reduce (fn [vt f] (f vt input)) vt actions))


#16 allow to write a link in a markdown

#16 allow to write a link in a markdown

--- src/kalar_plugins/templates/page.clj
+++ src/kalar_plugins/templates/page.clj
@@ -28,7 +28,12 @@
         date     (extract-date-from-filename (.getName (io/file file)))
         metadata (md/md-to-html input output :parse-meta? true :heading-anchors true)
         html     (.toString output)
-        url (string/replace (string/replace file (re-pattern (str "^" (kfile/find-resources-dir))) "") #"\..*$" ".html")
+        url (if (nil? (-> metadata :link first))
+              (string/replace
+                (string/replace file (re-pattern (str "^" (kfile/find-resources-dir))) "")
+                #"\..*$"
+                ".html")
+              (-> metadata :link first))
         dest-file (io/file (kfile/find-dest) (string/replace url #"^/" ""))]
     (merge metadata {:body html :url url :dest-file dest-file :date date})))

@@ -45,7 +50,7 @@
 (defn- compile-md [file]
   (let [file-path (.getAbsolutePath file)
         md (load-markdown file-path)
-        dst (get-dst-path file-path)
+        dst (:dest-file md)
         fnc (-> md :template first)]
     (kfile/touch dst)
     (require (symbol (str/replace fnc  #"/.*"  "")))


Fix missing last month in GET.

Fix missing last month in GET.

--- src/kixi/hecuba/api/measurements.clj
+++ src/kixi/hecuba/api/measurements.clj
@@ -38,8 +38,10 @@
   "Return a lazy sequence of DateTime's from start to end, incremented
   by 'step' units of time."
   [start end step]
-  (let [inf-range (tp/periodic-seq start step)
-        below-end? (fn [t] (t/within? (t/interval start end)
+  (let [start-date (t/first-day-of-the-month start)
+        end-date   (t/last-day-of-the-month end)
+        inf-range  (tp/periodic-seq start step)
+        below-end? (fn [t] (t/within? (t/interval start end-date)
                                          t))]
     (take-while below-end? inf-range)))


Update scrabble word oxyphenbutazone

Update scrabble word oxyphenbutazone

--- exercises/scrabble-score/test/scrabble_score_test.clj
+++ exercises/scrabble-score/test/scrabble_score_test.clj
@@ -18,4 +18,4 @@
   (is (= 22 (scrabble-score/score-word "quirky"))))

 (deftest all-upper-case-word
-  (is (= 20 (scrabble-score/score-word "MULTIBILLIONAIRE"))))
+  (is (= 41 (scrabble-score/score-word "OXYPHENBUTAZONE"))))


Bug correction (count the values)

Bug correction (count the values)

--- src/clj/algorithms_clj/huffman.clj
+++ src/clj/algorithms_clj/huffman.clj
@@ -50,9 +50,9 @@

 (defn ^:private get-bits
   [huffman-tree val]
-  (defn get-bits-impl [{:keys [lhs rhs] :as huffman-tree} dirs]
+  (defn get-bits-impl [{:keys [values lhs rhs]} dirs]
     (cond
-      (= 1 (count huffman-tree)) dirs
+      (= 1 (count values)) dirs
       (-> lhs :values val) (recur lhs (conj dirs 0))
       (-> rhs :values val) (recur rhs (conj dirs 1))
       ))
@@ -81,6 +81,12 @@
 ;; Decoding
 ;; -----------------------------------------------------------

+#_(defn decode-bits
+   [huffman-tree bits]
+   (cond
+     (= 1 (count huffman-tree)) []
+     )
+   )

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