Extract producer from producer code

Extract producer from producer code

and add more documentation to the fields

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -11,25 +11,34 @@
   {:record-id [:controlfield (attr= :tag "001")]
    :title [:datafield (attr= :tag "245") :subfield (attr= :code "a")]
    :subtitle [:datafield (attr= :tag "245") :subfield (attr= :code "b")]
-   :creator [:datafield (attr= :tag "100") :subfield]
-   :source [:datafield (attr= :tag "020") :subfield]
-   :description [:datafield (attr= :tag "520") :subfield]
-   :library_signature [:datafield (attr= :tag "091") :subfield (attr= :code "a")]
-   :source_publisher [:datafield (attr= :tag "534") :subfield (attr= :code "c")]
-   :source_date [:datafield (attr= :tag "534") :subfield (attr= :code "d")]
-   :language [:datafield (attr= :tag "041") :subfield (attr= :code "a")]
+   :creator [:datafield (attr= :tag "100") :subfield] ; autor
+   :source [:datafield (attr= :tag "020") :subfield] ; isbn
+   :description [:datafield (attr= :tag "520") :subfield] ; abstract
+   :volume [:datafield (attr= :tag "520") :fixme] ; Bandangabe
+   :source_publisher [:datafield (attr= :tag "534") :subfield (attr= :code "c")] ; Verlag
+   :source_date [:datafield (attr= :tag "534") :subfield (attr= :code "d")] ; Erscheinungsjahr
+   :language [:datafield (attr= :tag "041") :subfield (attr= :code "a")] ; Sprache
    :general-note [:datafield (attr= :tag "500") :subfield (attr= :code "a")]
-   :personel-name [:datafield (attr= :tag "700") :subfield (attr= :code "a")]
+   :personel-name [:datafield (attr= :tag "700") :subfield (attr= :code "a")] ; Regie oder Darsteller
    :personel-relator-term [:datafield (attr= :tag "700") :subfield (attr= :code "e")]
-   :narrator [:datafield (attr= :tag "709") :subfield (attr= :code "a")]
-   :duration [:datafield (attr= :tag "391") :subfield (attr= :code "a")]
-   :producer [:datafield (attr= :tag "260") :subfield (attr= :code "b")]
-   :producer_place [:datafield (attr= :tag "260") :subfield (attr= :code "a")]
+   :narrator [:datafield (attr= :tag "709") :subfield (attr= :code "a")] ; Sprecher
+   :duration [:datafield (attr= :tag "391") :subfield (attr= :code "a")] ; Spieldauer
+   :producer [:datafield (attr= :tag "260") :subfield (attr= :code "b")] ; Produzent
+   :producer-raw [:datafield (attr= :tag "260") :subfield (attr= :code "9")] ; a number that determines Produzent Kürzel und Stadt
+   :producer_place [:datafield (attr= :tag "260") :subfield (attr= :code "a")] ; Produzent Stadt
    :produced_date [:datafield (attr= :tag "260") :subfield (attr= :code "c")]
-   :produced_commercially [:datafield (attr= :tag "260") :subfield (attr= :code "d")]
+   :produced_commercially [:datafield (attr= :tag "260") :subfield (attr= :code "d")] ; kommerziell?
+   :rucksackbuch [:datafield (attr= :tag "260") :subfield (attr= :code "d")] ; rucksackbuch?
    :format-raw [:datafield (attr= :tag "091") :subfield (attr= :code "c")]
    :genre-raw [:datafield (attr= :tag "099") :subfield (attr= :code "b")]
-   :price [:datafield (attr= :tag "024") :subfield (attr= :code "c")]})
+   :library_signature [:datafield (attr= :tag "091") :subfield (attr= :code "a")] ; Signaturen
+   :price [:datafield (attr= :tag "024") :subfield (attr= :code "c")] ; Preis
+   :contraction [:datafield (attr= :tag "024") :fixme] ; Schriftart
+   :movie_country [:datafield (attr= :tag "024") :fixme] ; Film Land
+   :movie_category [:datafield (attr= :tag "024") :fixme] ; Filmkategorie
+   :game_category [:datafield (attr= :tag "024") :fixme] ; Spiel-Systematikgruppe
+   :game_materials [:datafield (attr= :tag "024") :fixme] ; Spiel-Materialdetails
+   })

 (def iso-639-2-to-iso-639-1
   "Mapping between three letter codes of [ISO
@@ -84,6 +93,23 @@
    "LU" :ludo
    "MN" :musiknoten})

+(def producer-raw-to-producer
+  "Mapping between producer-raw and producer"
+  {1 "DBh, Marburg"
+   101 "DBh, Marburg"
+   2 "BHB, Berlin"
+   6 "WBH, Münster"
+   8 "SBH, Stuttgart"
+   11 "DKBB, Bonn"
+   13 "SBS, Zürich"
+   100 "SBS, Zürich"
+   24 "DZB, Leipzig"
+   102 "DZB, Leipzig"
+   25 "CAB, Landschlacht"
+   40 "BIT, München"
+   50 "BSVÖ, Wien"
+   103 "Paderborn"})
+
 (defn get-subfield
   "Get the subfield text for the given `path` in the given `record`.
   Returns nil if there is no such subfield"
@@ -93,14 +119,16 @@
 (defn clean-raw-item
   "Return a proper production based on a raw item, i.e.
   translate the language tag into proper ISO 639-1 codes"
-  [{:keys [genre-raw language format-raw] :as item :or {genre-raw "x01"}}]
+  [{:keys [genre-raw language format-raw producer-raw] :as item :or {genre-raw "x01"}}]
   (-> item
       (assoc-some
        :language (iso-639-2-to-iso-639-1 language)
        :genre (genre-raw-to-genre (subs genre-raw 0 1))
        :sub-genre (genre-raw-to-subgenre (subs genre-raw 0 3))
-       :format (format-raw-to-format format-raw))
-      (dissoc :genre-raw :format-raw)))
+       :format (format-raw-to-format format-raw)
+       :producer_brief (producer-raw-to-producer (Integer/parseInt producer-raw)
+                                                 (format "FIXME: %s" producer-raw)))
+      (dissoc :genre-raw :format-raw producer-raw)))

 (defn order-and-group [items]
   (->>


delaying client config def

delaying client config def

--- src/chazel/chazel.clj
+++ src/chazel/chazel.clj
@@ -25,16 +25,17 @@
     (Hazelcast/getOrCreateHazelcastInstance conf)))

 (def client-config
-  (let [config (ClientConfig.)]
-    (doto config
-      (.getNetworkConfig)
-      (.addAddress (into-array (conf :hz-client :addresses)))
-      (.setConnectionAttemptPeriod (conf :hz-client :time-between-connection-retries-ms))
-      (.setConnectionAttemptLimit (conf :hz-client :retry-max)))
-    config))
+  (delay
+    (let [config (ClientConfig.)]
+      (doto config
+        (.getNetworkConfig)
+        (.addAddress (into-array (conf :hz-client :addresses)))
+        (.setConnectionAttemptPeriod (conf :hz-client :time-between-connection-retries-ms))
+        (.setConnectionAttemptLimit (conf :hz-client :retry-max)))
+      config)))

 (def c-instance
-  (delay (atom (HazelcastClient/newHazelcastClient client-config))))
+  (delay (atom (HazelcastClient/newHazelcastClient @client-config))))

 (defn instance-active? [instance]
   (-> instance
@@ -47,7 +48,7 @@
       ci
       (try
         (reset! @c-instance
-                (HazelcastClient/newHazelcastClient client-config))
+                (HazelcastClient/newHazelcastClient @client-config))
         (catch Throwable t
                (warn "could not create hazelcast a client instance: " (.getMessage t)))))))


change `cljs.util/get-name` to to split URLs on forward slash and  return last component

--- src/clj/cljs/util.clj
+++ src/clj/cljs/util.clj
@@ -109,7 +109,7 @@
   {:pre [(or (file? x) (url? x))]}
   (if (file? x)
     (filename x)
-    (last (path-seq (path x)))))
+    (last (string/split (path x) #"\/"))))

 (defn debug-prn
   [& args]


Documentation and restructuring pass.

Documentation and restructuring pass.

--- src/clj/forma/hdf.clj
+++ src/clj/forma/hdf.clj
@@ -123,19 +123,11 @@
   ([tdir]
      (delete-file-recursively tdir)))

-;; ## Dataset Chunking
+;; ## Chunking Functions

 ;; TODO -- This needs some more documentation, but these are the
-;; functions that deal with opened datasets.
-
-(defmapop
-  #^{:doc "Generates metadata values for a given unpacked MODIS
-Dataset and a seq of keys."}
-  [meta-values [meta-keys]] [modis]
-  (let [^Hashtable metadict (metadata modis)]
-    (map #(.get metadict %) meta-keys)))
-
-;; ## Works in Progress, for now.
+;; functions that open datasets, and chunk the resulting integer
+;; arrays.

 (defn raster-array
   "Unpacks the data inside of a MODIS band into a 1xN integer array."
@@ -155,6 +147,15 @@
         sample (+ line index)]
     (vector line sample)))

+;; ## Metadata Parsing
+
+(defmapop
+  #^{:doc "Generates metadata values for a given unpacked MODIS
+Dataset and a seq of keys."}
+  [meta-values [meta-keys]] [modis]
+  (let [^Hashtable metadict (metadata modis)]
+    (map #(.get metadict %) meta-keys)))
+
 ;; TODO -- add some good documentation here about what the next
 ;; section is accomplishing. I want to check marginalia to see the
 ;; best way to do this stuff.
@@ -198,7 +199,7 @@
    ((juxt tileid->res
           tileid->xy) tileid)))

-;; TODO -- show Dan and Robin, and remove these demonstration functions.
+;; ## Fun Examples!

 ;; Guys, are a few ways to accomplish the task solved by tileid->xy,
 ;; shown above. I'm not sure I'm happy with the final version, so I've
@@ -230,7 +231,7 @@
   (parse-ints
    ((juxt #(subs % 2 5) #(subs % 5 8)) tileid)))

-;; This is the same as the final; it actually compiles to the same
+;; This is the same as the next one; it actually compiles to the same
 ;; byte code, I'm just not using the threading macro here. I don't
 ;; know if the threading macro makes the code more clear, in this
 ;; case, but it's a good example of little tweaks for readability,
@@ -238,4 +239,16 @@
 (fn [tileid]
   (parse-ints
    (map (partial apply str)
-        (partition 3 (s/drop 2 tileid)))))+        (partition 3 (s/drop 2 tileid)))))
+
+;; The referenced one, with the threading macro. (This is the one I
+;; ended up going with.) As you can see, it takes each thing, evaluates
+;; it, and inserts it as the last thing in the next entry. So, here we
+;; have tileid inserted, making (s/drop 2 tileid). The whole thing
+;; expands to the code above.
+(fn [tileid]
+  (parse-ints
+   (map (partial apply str)
+        (->> tileid
+             (s/drop 2)
+             (partition 3)))))


score function support for Clot

score function support for Clot

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -865,7 +865,8 @@

 (defn score [state side args]
   (let [card (or (:card args) args)]
-    (when (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card)))
+    (when (and (empty? (filter #(= (:cid card) (:cid %)) (get-in @state [:corp :register :cannot-score])))
+               (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card))))
       (let [moved-card (move state :corp card :scored)
             c (card-init state :corp moved-card)]
         (system-msg state :corp (str "scores " (:title c) " and gains " (:agendapoints c)


Revert fix that is not ready to merge.

Revert fix that is not ready to merge.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -776,9 +776,9 @@
 (defn continue [state side args]
   (when (get-in @state [:run :no-action])
     (when-let [pos (get-in @state [:run :position])]
-      (let [ice (when (and pos (> pos 0)) (get-card state (nth (get-in @state [:run :ices]) (dec pos))))]
+      (when-let [ice (when (and pos (> pos 0)) (get-card state (nth (get-in @state [:run :ices]) (dec pos))))]
         (trigger-event state side :pass-ice ice)
-        (when ice (update-ice-in-server state side (card->server state ice)))))
+        (update-ice-in-server state side (card->server state ice))))
     (swap! state update-in [:run :position] dec)
     (swap! state assoc-in [:run :no-action] false)
     (swap! state assoc-in [:runner :rig :program]


Db credentials TODO

Db credentials TODO

--- src/clj/virt/core.clj
+++ src/clj/virt/core.clj
@@ -106,6 +106,7 @@

 (defn -main [& args]
+  ; TODO: put db credentials in local config
   (korma.db/defdb db (db/postgres {:db "virt"
                                    :user "postgres"
                                    :password "postgres"}))


more anal clean up of -main. make error messages less messy

Signed-off-by: Eric Baur <a1c9c5f8609c68027db0779b39e5f932d4cb0053@robeybaur.org>

--- src/cljparse/core.clj
+++ src/cljparse/core.clj
@@ -1,6 +1,7 @@
 (ns cljparse.core
   (:require [instaparse.core :as insta]
             [clojure.java.io :as io]
+            [clojure.string :as string]
             [clojure.tools.cli :refer [parse-opts]]
             [cljparse.config.parser :as config])
   (:gen-class))
@@ -9,28 +10,29 @@

 (def cli-options
   ;; An option with a required argument
-  [["-p" "--path PATH" "path to project to build" :default "./"]
+  [["-p" "--path PATH" "path to project to build" :default "testdata"]
    ["-h" "--help"]])

 (defn exit [status msg & rest]
   (do
-    (println msg rest)
+    (apply println msg rest)
     status))

 (defn -main [& args]
   (let [ {:keys [options arguments errors summary]} (parse-opts args cli-options) ]
-         (cond (:help options)
-               (exit 0 summary)
+    (cond (:help options)
+          (exit 0 summary)

-               (not= errors nil)
-               (exit -1 "Error: " errors)
+          (not= errors nil)
+          (exit -1 "Error: " (string/join errors))

-               :else (let [ path (:path options)
-                           file (io/file path configname) ]
-                      (do
-                        (cond (not (.isFile file))
-                            (exit -1 "Configuration not found at " path)
-                            :else
-                            (do
-                              (println "Starting cljparse on:" (.getAbsolutePath file) "and errors:" errors)
-                              (config/parser file))))))))
+          :else
+          (let [ path (:path options)
+                 file (io/file path configname) ]
+            (do
+              (cond (not (.isFile file))
+                    (exit -1 "Configuration not found at " path)
+                    :else
+                    (do
+                      (println "Starting cljparse on:" (.getAbsolutePath file))
+                      (config/parser file))))))))


Execute unify mapping on first datum during construction of unify object. This is purely a convenience for folks who want atoms derefed in the mapping fn to be picked up by c2.util#bind!

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -9,4 +9,9 @@
             [reflex.core :as reflex]))

 (def node-data singult/node-data)
-(def unify singult/unify)
+
+(defn unify [data mapping & args]
+  ;;Execute the mapping on the first datum so that atoms within the mapping fn will be derefed.
+  ;;This should eliminate confusion wherin c2.util#bind! doesn't pick up on dependencies within the unify mapping fn (because the mapping fn isn't executed until rendering, which happens after computed-observable dependencies are calculated).
+  (mapping (first data))
+  (apply singult/unify data mapping args))


It's tricky to rock a rhyme that's right on time

--- web/src/immutant/web.clj
+++ web/src/immutant/web.clj
@@ -76,9 +76,10 @@
                          (resolve handler))
                      `(var ~handler)
                      handler)]
-       `(do
-          (run ~env (wrap-dev-middleware ~handler))
-          (browse-url (format "http://%s:%s%s"
-                        (:host         ~env (.defaultValue Web$CreateOption/HOST))
-                        (:port         ~env (.defaultValue Web$CreateOption/PORT))
-                        (:context-path ~env default-context)))))))
+       `((fn [& _#]
+           (let [result# (run ~env (wrap-dev-middleware ~handler))]
+             (browse-url (format "http://%s:%s%s"
+                           (:host         ~env (.defaultValue Web$CreateOption/HOST))
+                           (:port         ~env (.defaultValue Web$CreateOption/PORT))
+                           (:context-path ~env default-context)))
+             result#))))))


Added ordering for the observations by the id column

--- src/env_logger/db.clj
+++ src/env_logger/db.clj
@@ -50,7 +50,8 @@
   [ & time-format]
   (let [formatter (if time-format (nth time-format 0) :mysql)]
     (for [row (kc/select observations
-            (kc/fields :brightness :temperature :recorded))]
+            (kc/fields :brightness :temperature :recorded)
+            (kc/order :id :ASC))]
       (merge row
         ; Reformat date
         {:recorded (format-date (:recorded row) formatter)}))))
@@ -62,7 +63,8 @@
     (for [row (kc/select observations
             (kc/fields :brightness :temperature :recorded)
             (kc/where {:recorded [>= (tc/to-sql-date (tco/minus (tco/now)
-                          (tco/days n)))]}))]
+                          (tco/days n)))]})
+            (kc/order :id :ASC))]
       (merge row
         ; Reformat date
         {:recorded (format-date (:recorded row) formatter)}))))


Commented out obsolete painting code that becomes incompatible with soon to be added new features

--- src/flatgui/paint.clj
+++ src/flatgui/paint.clj
@@ -140,32 +140,19 @@
   "Paints component, does not pait children"
   (if (:visible cmpnt)
     (let [ look-vec (:look-vec cmpnt)]
-      (flatten-vector [ (if look-vec look-vec) (if (:has-trouble cmpnt) (trouble-look cmpnt dirty-rects)) ]))
-    ))
-
-(defn paint-component-only2 [cmpnt dirty-rects]
-  "Paints component, does not pait children"
-  (if (and (:visible cmpnt) (:look cmpnt))
-    (flatten-vector ((:look cmpnt) cmpnt dirty-rects))
-    ))
+      (flatten-vector [ (if look-vec look-vec) (if (:has-trouble cmpnt) (trouble-look cmpnt dirty-rects))]))))

 (defn paint-component-with-children [component dirty-rects]
   "Paints component and its children"
   (try
-    (let [ clip-w (m/x (:clip-size component))
-           clip-h (m/y (:clip-size component))
-           position-matrix (:position-matrix component)
-           viewport-matrix (:viewport-matrix component)
-
-          ;transform-matrix (m/mx* position-matrix viewport-matrix)
-          ;awt-transform-matrix (affinetransform transform-matrix)
-          ;awt-transform-matrix-inverse (invert awt-transform-matrix)
-
+    (let [clip-w (m/x (:clip-size component))
+          clip-h (m/y (:clip-size component))
+          position-matrix (:position-matrix component)
+          viewport-matrix (:viewport-matrix component)
           awt-position-matrix (awt/affinetransform position-matrix)
           awt-viewport-matrix (awt/affinetransform viewport-matrix)
           awt-viewport-matrix-inverse (awt/invert awt-viewport-matrix)
-          awt-position-matrix-inverse (awt/invert awt-position-matrix)
-          ]
+          awt-position-matrix-inverse (awt/invert awt-position-matrix)]
         (flatten-vector
           ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
           [(if (not= (:widget-type component) "tablecell")  (awt/pushCurrentClip))
@@ -173,16 +160,10 @@
            (if (not= (:widget-type component) "tablecell") (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
            (awt/transform awt-viewport-matrix)
            (paint-component-only component dirty-rects)
-           ;(vec (for [[k v] (:children component)] (paint-component-with-children v dirty-rects)))
            (mapv #(paint-component-with-children % dirty-rects) (sort-by :z-position (for [[_ v] (:children component)] v)))
-
            (awt/transform awt-viewport-matrix-inverse)
            (awt/transform awt-position-matrix-inverse)
-           ;(transform awt-transform-matrix-inverse)
-
-           (if (not= (:widget-type component) "tablecell") (awt/popCurrentClip))
-           ]
-        ))
+           (if (not= (:widget-type component) "tablecell") (awt/popCurrentClip))]))
     (catch Exception e (do
                          (fg/log-debug "Exception " (.getMessage e)
                            " when painting component id = " (:id component)
@@ -191,17 +172,84 @@
                          (.printStackTrace e)))))

 (defn paint-all [container clipx clipy clipw cliph]
-  (let [ t (System/currentTimeMillis)
-         result (paint-component-with-children container nil)]
-      (do
-        ;(println "  -----Painted container in " (- (System/currentTimeMillis) t) " millis ")
-        result)))
-
-(defn get-dirty-rect-from-container [container]
-  (let [ r (:dirty-rect container)]
-    (if r
-      [(double (:x r)) (double (:y r)) (double (:w r)) (double (:h r))])))
-
+  (paint-component-with-children container nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; New painting approach optimized for web
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmulti extract-value (fn [property _ _] (class property)))
+
+(defmethod extract-value Keyword [property f container]
+  (f (property container)))
+
+(defmethod extract-value Collection [property f container]
+  ;; This reduce accumulates bit flags
+  (reduce #(+ (* 2 %1) %2) 0 (for [p property] (f (p container)))))
+
+(defn- get-component-id-path-to-property-value [id-path container property f]
+  (let [this-id-path (fgc/conjv id-path (:id container))]
+    (apply
+      merge
+      {this-id-path (extract-value property f container)}
+      (for [[_ v] (:children container)] (get-component-id-path-to-property-value this-id-path v property f)))))
+
+(defn get-component-id-path-to-position-matrix [container]
+  (get-component-id-path-to-property-value [] container :position-matrix awt/affinetransform))
+
+(defn get-component-id-path-to-viewport-matrix [container]
+  (get-component-id-path-to-property-value [] container :viewport-matrix awt/affinetransform))
+
+(defn get-component-id-path-to-clip-size [container]
+  (get-component-id-path-to-property-value [] container :clip-size (fn [c] [(m/x c) (m/y c)])))
+
+(defn get-component-id-path-to-look-vector [container]
+  (get-component-id-path-to-property-value [] container :look-vec identity))
+
+(defn get-component-id-path-to-child-count [container]
+  (get-component-id-path-to-property-value [] container :children count))
+
+(defn get-component-id-path-to-flags [container]
+  (get-component-id-path-to-property-value [] container [:rollover-notify-disabled :popup :visible] (fn [v] (if v 1 0))))
+
+(defn get-component-id-path-to-image-url [container]
+      (get-component-id-path-to-property-value [] container :image-url identity))
+
+(defn- ready-for-paint? [container]
+  (and
+    (:position-matrix container)
+    (:viewport-matrix container)
+    (:clip-size container)
+    (:look-vec container)))
+
+;;;
+;;; TODO sort by z-order here?
+;;;
+(defn get-paint-all-sequence
+  ([id-path container]
+    (if (ready-for-paint? container)
+      (apply concat
+             [(conj id-path (:id container))]
+             (for [[_ v] (:children container)] (get-paint-all-sequence (conj id-path (:id container)) v)))
+     []))
+  ([container] (get-paint-all-sequence [] container)))
+
+
+
+;;;;;;;;;;;;;;
+;;;;;;;;;;;;;; Old experimental approaches
+;;;;;;;;;;;;;;
+
+;(defn paint-component-only2 [cmpnt dirty-rects]
+;  "Paints component, does not pait children"
+;  (if (and (:visible cmpnt) (:look cmpnt))
+;    (flatten-vector ((:look cmpnt) cmpnt dirty-rects))
+;    ))
+
+;(defn get-dirty-rect-from-container [container]
+;  (let [ r (:dirty-rect container)]
+;    (if r
+;      [(double (:x r)) (double (:y r)) (double (:w r)) (double (:h r))])))

 ;;@todo with such approach clip rect should be passed to evolve
 ;;
@@ -249,153 +297,91 @@
 ;         involved-components (get-all-components-for-dirty-rects container all-rects-to-paint)]
 ;    (paint-components (sort-components-by-id involved-components) all-rects-to-paint)))

-;(defn- clip? [component] (not= (:widget-type component) "tablecell"))
-; TODO
-(defn- clip? [component] (#{"tablecontentpane" "window" "toolbar" "component" "tableheader"} (:widget-type component)))
-
-(defn paint-dirty-impl [component dirty-rects force-paint]
-  "Paints component and its children"
-  (try
-    (let [ clip-w (m/x (:clip-size component))
-          clip-h (m/y (:clip-size component))
-          position-matrix (:position-matrix component)
-          viewport-matrix (:viewport-matrix component)
-
-          ; TODO this is optimization for web: to transmit less commands
-          transform-matrix (m/mx* position-matrix viewport-matrix)
-          awt-transform-matrix (awt/affinetransform transform-matrix)
-          awt-transform-matrix-inverse (awt/invert awt-transform-matrix)
-
-          awt-position-matrix (awt/affinetransform position-matrix)
-          awt-viewport-matrix (awt/affinetransform viewport-matrix)
-          ;awt-viewport-matrix-inverse (invert awt-viewport-matrix)
-          ;awt-position-matrix-inverse (invert awt-position-matrix)
-
-          paint-this (or force-paint
-                         (   ;or (nil? dirty-rects)
-                           and dirty-rects
-                               (r/intersect?
-                                 dirty-rects
-                                 {:x (m/mx-x (:abs-position-matrix component))
-                                  :y (m/mx-y (:abs-position-matrix component))
-                                  :w (m/x (:clip-size component))
-                                  :h (m/y (:clip-size component))})))
-          ;_ (if (= :main (:id component)) (println "Painting " (:id component) " paint=" paint-this " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
-          ;_ (if (and dirty-rects paint-this) (println "Painting " (:id component) " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
-          children (:children component)]
-      (if paint-this
-        (flatten-vector
-          ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
-          [(if (clip? component)  (awt/pushCurrentClip))
-           (awt/transform awt-position-matrix)
-
-           (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
-           (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
-
-           (paint-component-only2 component dirty-rects)
-           ;(println "Painting component " (:id component) " :needs-repaint = " (:needs-repaint component))
-
-           (mapv #(paint-dirty-impl % dirty-rects (and paint-this (not= :main (:id component)))) (sort-by :z-position (for [[_ v] (:children component)] v)))
-
-           ;(transform awt-viewport-matrix-inverse)
-           ;(transform awt-position-matrix-inverse)
-           (awt/transform awt-transform-matrix-inverse)
-
-           (if (clip? component) (awt/popCurrentClip))
-           ])
-        (if (seq children)
-          (let [ children-look (mapv #(paint-dirty-impl % dirty-rects false) (sort-by :z-position (for [[_ v] children] v)))]
-            (if (seq children-look)
-              (flatten-vector
-                [                                               ;(transform awt-transform-matrix)
-                 (if (clip? component)  (awt/pushCurrentClip))
-                 (awt/transform awt-position-matrix)
-                 (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
-                 (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
-
-                 children-look
-
-                 (awt/transform awt-transform-matrix-inverse)
-                 (if (clip? component) (awt/popCurrentClip))
-                 ;(transform awt-transform-matrix-inverse)
-                 ])
-              (do
-                ;(println "Chidren look skipped")
-                nil)))
-          )))
-    (catch Exception e (do
-                         (fg/log-debug "Exception " (.getMessage e)
-                                    " when painting component id = " (:id component)
-                                    ;" component: " (container-to-str component)
-                                    )
-                         (.printStackTrace e)))))
-
-(defn paint-dirty [component _ _]
-  (if (:dirty-rect component)
-    (do
-      ;(println "Dirty rect is " (:dirty-rect component) " painting...")
-      (paint-dirty-impl component (:dirty-rect component) nil))
-    (do
-      ;(println " Dirty rect is null, skipped painting")
-      [])))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;; New painting approach optimized for web
-;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmulti extract-value (fn [property _ _] (class property)))
-
-(defmethod extract-value Keyword [property f container]
-  (f (property container)))
-
-(defmethod extract-value Collection [property f container]
-  ;; This reduce accumulates bit flags
-  (reduce #(+ (* 2 %1) %2) 0 (for [p property] (f (p container)))))
-
-(defn- get-component-id-path-to-property-value [id-path container property f]
-  (let [this-id-path (fgc/conjv id-path (:id container))]
-    (apply
-      merge
-      {this-id-path (extract-value property f container)}
-      (for [[_ v] (:children container)] (get-component-id-path-to-property-value this-id-path v property f)))))
-
-(defn get-component-id-path-to-position-matrix [container]
-  (get-component-id-path-to-property-value [] container :position-matrix awt/affinetransform))
-
-(defn get-component-id-path-to-viewport-matrix [container]
-  (get-component-id-path-to-property-value [] container :viewport-matrix awt/affinetransform))
-
-(defn get-component-id-path-to-clip-size [container]
-  (get-component-id-path-to-property-value [] container :clip-size (fn [c] [(m/x c) (m/y c)])))
-
-(defn get-component-id-path-to-look-vector [container]
-  (get-component-id-path-to-property-value [] container :look-vec identity))
-
-(defn get-component-id-path-to-child-count [container]
-  (get-component-id-path-to-property-value [] container :children count))
-
-(defn get-component-id-path-to-flags [container]
-  (get-component-id-path-to-property-value [] container [:rollover-notify-disabled :popup :visible] (fn [v] (if v 1 0))))
-
-(defn get-component-id-path-to-image-url [container]
-      (get-component-id-path-to-property-value [] container :image-url identity))
-
-(defn- ready-for-paint? [container]
-  (and
-    (:position-matrix container)
-    (:viewport-matrix container)
-    (:clip-size container)
-    (:look-vec container)))
-
-;;;
-;;; TODO sort by z-order here?
-;;;
-(defn get-paint-all-sequence
-  ([id-path container]
-    (if (ready-for-paint? container)
-      (apply concat
-             [(conj id-path (:id container))]
-             (for [[_ v] (:children container)] (get-paint-all-sequence (conj id-path (:id container)) v)))
-     []))
-  ([container] (get-paint-all-sequence [] container)))+;; TODO
+;(defn- clip? [component] (#{"tablecontentpane" "window" "toolbar" "component" "tableheader"} (:widget-type component)))
+
+;(defn paint-dirty-impl [component dirty-rects force-paint]
+;  "Paints component and its children"
+;  (try
+;    (let [ clip-w (m/x (:clip-size component))
+;          clip-h (m/y (:clip-size component))
+;          position-matrix (:position-matrix component)
+;          viewport-matrix (:viewport-matrix component)
+;
+;          ; TODO this is optimization for web: to transmit less commands
+;          transform-matrix (m/mx* position-matrix viewport-matrix)
+;          awt-transform-matrix (awt/affinetransform transform-matrix)
+;          awt-transform-matrix-inverse (awt/invert awt-transform-matrix)
+;
+;          awt-position-matrix (awt/affinetransform position-matrix)
+;          awt-viewport-matrix (awt/affinetransform viewport-matrix)
+;          ;awt-viewport-matrix-inverse (invert awt-viewport-matrix)
+;          ;awt-position-matrix-inverse (invert awt-position-matrix)
+;
+;          paint-this (or force-paint
+;                         (   ;or (nil? dirty-rects)
+;                           and dirty-rects
+;                               (r/intersect?
+;                                 dirty-rects
+;                                 {:x (m/mx-x (:abs-position-matrix component))
+;                                  :y (m/mx-y (:abs-position-matrix component))
+;                                  :w (m/x (:clip-size component))
+;                                  :h (m/y (:clip-size component))})))
+;          ;_ (if (= :main (:id component)) (println "Painting " (:id component) " paint=" paint-this " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
+;          ;_ (if (and dirty-rects paint-this) (println "Painting " (:id component) " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
+;          children (:children component)]
+;      (if paint-this
+;        (flatten-vector
+;          ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
+;          [(if (clip? component)  (awt/pushCurrentClip))
+;           (awt/transform awt-position-matrix)
+;
+;           (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
+;           (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
+;
+;           (paint-component-only2 component dirty-rects)
+;           ;(println "Painting component " (:id component) " :needs-repaint = " (:needs-repaint component))
+;
+;           (mapv #(paint-dirty-impl % dirty-rects (and paint-this (not= :main (:id component)))) (sort-by :z-position (for [[_ v] (:children component)] v)))
+;
+;           ;(transform awt-viewport-matrix-inverse)
+;           ;(transform awt-position-matrix-inverse)
+;           (awt/transform awt-transform-matrix-inverse)
+;
+;           (if (clip? component) (awt/popCurrentClip))
+;           ])
+;        (if (seq children)
+;          (let [ children-look (mapv #(paint-dirty-impl % dirty-rects false) (sort-by :z-position (for [[_ v] children] v)))]
+;            (if (seq children-look)
+;              (flatten-vector
+;                [                                               ;(transform awt-transform-matrix)
+;                 (if (clip? component)  (awt/pushCurrentClip))
+;                 (awt/transform awt-position-matrix)
+;                 (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
+;                 (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
+;
+;                 children-look
+;
+;                 (awt/transform awt-transform-matrix-inverse)
+;                 (if (clip? component) (awt/popCurrentClip))
+;                 ;(transform awt-transform-matrix-inverse)
+;                 ])
+;              (do
+;                ;(println "Chidren look skipped")
+;                nil)))
+;          )))
+;    (catch Exception e (do
+;                         (fg/log-debug "Exception " (.getMessage e)
+;                                    " when painting component id = " (:id component)
+;                                    ;" component: " (container-to-str component)
+;                                    )
+;                         (.printStackTrace e)))))
+;
+;(defn paint-dirty [component _ _]
+;  (if (:dirty-rect component)
+;    (do
+;      ;(println "Dirty rect is " (:dirty-rect component) " painting...")
+;      (paint-dirty-impl component (:dirty-rect component) nil))
+;    (do
+;      ;(println " Dirty rect is null, skipped painting")
+;      [])))


teach mod_fm mod wave forms plus further general phase offset futzing

--- etc/synthdefs/synth-designs.clj
+++ etc/synthdefs/synth-designs.clj
@@ -443,31 +443,42 @@
                               mod_phase_slide 0
                               mod_range 5
                               mod_range_slide 0
-                              mod_width 0.5
-                              mod_width_slide 0
-                              mod_phase_offset 0.5
+                              mod_pulse_width 0.5
+                              mod_pulse_width_slide 0
+                              mod_phase_offset 0
+                              mod_wave 1
+                              mod_invert_wave 0
                               divisor 2.0
                               divisor_slide 0
                               depth 1.0
                               depth_slide 0
                               out_bus 0]
-     (let [note           (lag note note_slide)
-           amp            (lag amp amp_slide)
-           pan            (lag pan pan_slide)
-           mod_phase      (lag mod_phase mod_phase_slide)
-           mod_rate       (/ 1 mod_phase)
-           mod_range      (lag mod_range mod_range_slide)
-           mod_width      (lag mod_width mod_width_slide)
-           freq           (midicps note)
-           mod_range_freq (- (midicps (+ mod_range note))
-                             freq)
-           freq-mod       (* mod_range_freq (lf-pulse mod_rate mod_phase_offset mod_width))
-           freq           (+ freq freq-mod)
-           divisor        (lag divisor divisor_slide)
-           depth          (lag depth depth_slide)
-           carrier        freq
-           modulator      (/ carrier divisor)
-           env            (env-gen (env-adsr-ng attack decay sustain release attack_level sustain_level) :action FREE)]
+     (let [note                    (lag note note_slide)
+           amp                     (lag amp amp_slide)
+           pan                     (lag pan pan_slide)
+           mod_phase               (lag mod_phase mod_phase_slide)
+           mod_rate                (/ 1 mod_phase)
+           mod_range               (lag mod_range mod_range_slide)
+           mod_pulse_width         (lag mod_pulse_width mod_pulse_width_slide)
+
+           min_note                note
+           max_note                (+ mod_range note)
+
+           mod_double_phase_offset (* 2 mod_phase_offset)
+           ctl-wave                (select:kr mod_wave [(lf-saw:kr mod_rate (+ mod_double_phase_offset 1))
+                                                        (- (* 2 (lf-pulse:kr mod_rate (+ 0.5 mod_phase_offset) mod_pulse_width)) 1)
+                                                        (lf-tri:kr mod_rate (- mod_double_phase_offset 1))
+                                                        (sin-osc:kr mod_rate (* (- mod_phase_offset 0.25) (* Math/PI 2)))])
+
+           ctl-wave-mul            (* -1 (- (* 2 (> mod_invert_wave 0)) 1))
+           ctl-wave                (* ctl-wave ctl-wave-mul)
+           note                    (lin-lin ctl-wave -1 1 min_note max_note)
+           freq                    (midicps note)
+           divisor                 (lag divisor divisor_slide)
+           depth                   (lag depth depth_slide)
+           carrier                 freq
+           modulator               (/ carrier divisor)
+           env                     (env-gen (env-adsr-ng attack decay sustain release attack_level sustain_level) :action FREE)]
        (out out_bus (pan2 (* env
                              (sin-osc (+ carrier
                                          (* env  (* carrier depth) (sin-osc modulator)))))
@@ -1573,10 +1584,9 @@
                                                (- (* 2 (lf-pulse:kr rate (+ 0.5 phase_offset) pulse_width)) 1)
                                                (lf-tri:kr rate (- double_phase_offset 1))
                                                (sin-osc:kr rate (* (- phase_offset 0.25) (* Math/PI 2)))])
-          amp-mul             (- (* 2 (> invert_wave 0)) 1)
+          amp-mul             (* -1 (- (* 2 (> invert_wave 0)) 1))
           slice-amp           (* ctl-wave amp-mul)
-          slice-amp           (/ (+ 1 slice-amp) 2)
-          slice-amp           (lin-lin slice-amp 0 1 amp_min amp_max)
+          slice-amp           (lin-lin slice-amp -1 1 amp_min amp_max)
           [in-l in-r]         (in in_bus 2)
           [new-l new-r]       (* slice-amp [in-l in-r])
           fin-l               (x-fade2 in-l new-l (- (* mix 2) 1) amp)
@@ -1613,10 +1623,9 @@
                                                (- (* 2 (lf-pulse:kr rate (+ 0.5 phase_offset) pulse_width)) 1)
                                                (lf-tri:kr rate (- double_phase_offset 1))
                                                (sin-osc:kr rate (* (- phase_offset 0.25) (* Math/PI 2)))])
-          amp-mul             (- (* 2 (> invert_wave 0)) 1)
+          amp-mul             (* -1 (- (* 2 (> invert_wave 0)) 1))
           slice-amp           (* ctl-wave amp-mul)
-          slice-amp           (/ (+ 1 slice-amp) 2)
-          slice-amp           (lin-lin slice-amp 0 1 amp_min amp_max)
+          slice-amp           (lin-lin slice-amp -1 1 amp_min amp_max)
           [in-l in-r]         (in out_bus 2)
           [new-l new-r]       (* slice-amp [in-l in-r])
           fin-l               (x-fade2 in-l new-l (- (* mix 2) 1) amp)
@@ -1660,7 +1669,7 @@
                                                (- (* 2 (lf-pulse:kr rate (+ 0.5 phase_offset) pulse_width)) 1)
                                                (lf-tri:kr rate (- double_phase_offset 1))
                                                (sin-osc:kr rate (* (- phase_offset 0.25) (* Math/PI 2)))])
-          ctl-wave-mul        (- (* 2 (> invert_wave 0)) 1)
+          ctl-wave-mul        (* -1 (- (* 2 (> invert_wave 0)) 1))

           cutoff-freq         (lin-exp:kr (* ctl-wave-mul ctl-wave) -1 1 cutoff_min cutoff_max)

@@ -1710,7 +1719,7 @@
                                                (- (* 2 (lf-pulse:kr rate (+ 0.5 phase_offset) pulse_width)) 1)
                                                (lf-tri:kr rate (- double_phase_offset 1))
                                                (sin-osc:kr rate (* (- phase_offset 0.25) (* Math/PI 2)))])
-          ctl-wave-mul        (- (* 2 (> invert_wave 0)) 1)
+          ctl-wave-mul        (* -1 (- (* 2 (> invert_wave 0)) 1))

           cutoff-freq         (lin-exp:kr (* ctl-wave-mul ctl-wave) -1 1 cutoff_min cutoff_max)


make admin header work for narrow screens

--- frontend/components/header.cljs
+++ frontend/components/header.cljs
@@ -76,27 +76,26 @@
                               :on-click #(put! controls-ch [:show-admin-panel-toggled])}
             (name (env/env))]

-           (om/build instrumentation/summary (:instrumentation app))
-
            [:div.options
-            [:a {:href "/admin"} "admin"]
-            [:a {:href "/admin/users"} "users"]
-            [:a {:href "/admin/recent-builds"} "recent"]
-            [:a {:href "/admin/projects"} "projects"]
+            [:a {:href "/admin"} "admin "]
+            [:a {:href "/admin/users"} "users "]
+            [:a {:href "/admin/recent-builds"} "builds "]
+            [:a {:href "/admin/projects"} "projects "]
             (let [use-local-assets (get user-session-settings :use_local_assets)]
               [:a {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-local-assets
                                                                             :value (not use-local-assets)}])}
-               "local assets " (if use-local-assets "off" "on")])
+               "local assets " (if use-local-assets "off " "on ")])
             [:a {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-om
                                                                           :value false}])}
-             "use ko"]
+             "om off "]
             (let [current-build-id (get user-session-settings :om_build_id "dev")]
               (for [build-id (remove (partial = current-build-id) ["dev" "whitespace" "production"])]
                 [:a.menu-item
                  {:on-click #(put! controls-ch [:set-user-session-setting {:setting :om-build-id
                                                                            :value build-id}])}
-                 [:span (str build-id " compiler")]]))
-            [:a {:on-click #(put! controls-ch [:clear-instrumentation-data-clicked])} "clear stats"]]]
+                 [:span (str "om " build-id " ")]]))
+            [:a {:on-click #(put! controls-ch [:clear-instrumentation-data-clicked])} "clear stats"]]
+           (om/build instrumentation/summary (:instrumentation app))]
           (when (and open? expanded?)
             (om/build instrumentation/line-items (:instrumentation app)))])))))


Fixed up the content disposition when serving out job output files.

--- src/marcgrep/core.clj
+++ src/marcgrep/core.clj
@@ -301,9 +301,12 @@

 (defn serve-file [id]
-  {:headers {"Content-disposition:" (format "attachment; filename=%s.txt"
-                                            id)}
-   :body (:file @(get-job id))})
+ {:headers {"Content-disposition" (format "attachment; filename=%s.txt"
+                                          id)}
+   :body ((ns-resolve (:marc-destination @config)
+                                           'get-output-for)
+                               config
+                               (get-job id))})

 (defroutes main-routes
@@ -311,10 +314,7 @@
   (POST "/delete_job" request (delete-job (:id (:params request))))
   (POST "/run_jobs" request (do (send-off job-runner #'schedule-job-run)
                                 "OK"))
-  (GET "/job_output/:id" [id] ((ns-resolve (:marc-destination @config)
-                                           'get-output-for)
-                               config
-                               (get-job id)))
+  (GET "/job_output/:id" [id] (serve-file id))
   (GET "/job_list" [] (render-job-list))
   (route/files "/" [:root "public"])
   (route/not-found "Page not found"))


fix to pass test with clojure 1.2.1

fix to pass test with clojure 1.2.1

--- src/misaki/config.clj
+++ src/misaki/config.clj
@@ -12,34 +12,34 @@
 ;; ## Declarations

 ;; Blog base directory
-(def ^:dynamic *base-dir* "./")
+(def ^{:dynamic true} *base-dir* "./")
 ;; Config filename
-(def ^:dynamic *config-file* "_config.clj")
+(def ^{:dynamic true} *config-file* "_config.clj")

 ;; Public directory path. Compiled html is placed here.
-(declare ^:dynamic *public-dir*)
+(declare ^{:dynamic true} *public-dir*)
 ;; Template directory path.
-(declare ^:dynamic *template-dir*)
+(declare ^{:dynamic true} *template-dir*)
 ;; Posts placed directory name.
-(declare ^:dynamic *post*)
+(declare ^{:dynamic true} *post*)
 ;; Layouts placed directory path.
-(declare ^:dynamic *layout-dir*)
+(declare ^{:dynamic true} *layout-dir*)
 ;; Posts placed directory path.
-(declare ^:dynamic *post-dir*)
+(declare ^{:dynamic true} *post-dir*)
 ;; Tag index placed directory path.
-(declare ^:dynamic *tag-out-dir*)
+(declare ^{:dynamic true} *tag-out-dir*)
 ;; Tag layout name.
-(declare ^:dynamic *tag-layout*)
+(declare ^{:dynamic true} *tag-layout*)
 ;; Default site data.
-(declare ^:dynamic *site*)
+(declare ^{:dynamic true} *site*)
 ;; Template names which compiled with post templates.
-(declare ^:dynamic *compile-with-post*)
+(declare ^{:dynamic true} *compile-with-post*)
 ;; Site language.
-(declare ^:dynamic *lang*)
+(declare ^{:dynamic true} *lang*)
 ;; Regexp for parse post filename.
-(declare ^:dynamic *post-filename-regexp*)
+(declare ^{:dynamic true} *post-filename-regexp*)
 ;; Format rule for post filename.
-(declare ^:dynamic *post-filename-format*)
+(declare ^{:dynamic true} *post-filename-format*)

 ;; ## Config Data Wrapper


Minor compatibility fix.

Minor compatibility fix.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -323,7 +323,8 @@
   time is reached."
   ([t] (delay t nil))
   ([t v]
-   #?(:cljs (.delay js/Promise v t)
+   #?(:cljs (.then (js/Promise.delay t)
+                   (constantly v))
       :clj (let [p (CompletableFuture.)]
              (schedule t #(.complete p v))
              p))))


Various comment and docstring updates.

Various comment and docstring updates.

--- src/puget/printer.clj
+++ src/puget/printer.clj
@@ -9,12 +9,7 @@
       [order :as order])))

-;; CONTROL VARS
-
-; TODO: the dynamism here is probably overkill and makes var resolution much
-; more expensive. The control functions below use alter-var-root anyway, so
-; it's probably better to make these normal vars. Potentially, overrides can
-; be supported better through an 'opts' map passed to the printer functions.
+;;;;; CONTROL VARS ;;;;;

 (def ^:dynamic *options*
   "Printer control options.
@@ -88,7 +83,7 @@
 (defn set-color-scheme!
   "Sets the color scheme for syntax elements. Pass either a map to merge into
   the current color scheme, or a single element/colors pair. Colors should be
-  vector of color keywords."
+  vector of ANSI style keywords."
   ([colors]
    (alter-var-root #'*options* update-in [:color-scheme] merge colors))
   ([element colors & more]
@@ -102,11 +97,11 @@

-;; COLORING FUNCTIONS
+;;;;; COLORING FUNCTIONS ;;;;;

 (defn- color-doc
-  "Constructs a text doc, which may be colored if *colored-output* is true.
-  Element must be a key from the color-scheme map."
+  "Constructs a text doc, which may be colored if :print-color is true. Element
+  should be a key from the color-scheme map."
   [element text]
   (let [codes (-> *options* :color-scheme (get element) seq)]
     (if (and (:print-color *options*) codes)
@@ -118,7 +113,7 @@
   "Produces text colored according to the active color scheme. This is mostly
   useful to clients which want to produce output which matches data printed by
   Puget, but which is not directly printed by the library. Note that this
-  function still obeys the *colored-output* var."
+  function still obeys the :print-color option."
   [element text]
   (let [codes (-> *options* :color-scheme (get element) seq)]
     (if (and (:print-color *options*) codes)
@@ -127,7 +122,7 @@

-;; DISPATCH MULTIMETHOD
+;;;;; CANONIZE MULTIMETHOD ;;;;;

 (defn- canonize-dispatch
   [value]
@@ -160,6 +155,9 @@
 (canonize-element clojure.lang.Keyword :keyword)
 (canonize-element clojure.lang.Symbol  :symbol)

+
+
+;;;;; COLLECTION TYPES ;;;;;

 (defmethod canonize clojure.lang.ISeq
   [s]
@@ -227,6 +225,15 @@
 (prefer-method canonize clojure.lang.IRecord clojure.lang.IPersistentMap)

+
+;;;;; CLOJURE TYPES ;;;;;
+
+; TODO: vars, regexes, atoms
+
+
+
+;;;;; OTHER TYPES ;;;;;
+
 (defmethod canonize :tagged-value
   [tv]
   (let [tag   (data/edn-tag tv)
@@ -248,7 +255,7 @@

-;; PRINT FUNCTIONS
+;;;;; PRINT FUNCTIONS ;;;;;

 (defn pprint
   ([value]


Work with advanced compilation, JS prop interop

--- src/re_view/core.cljs
+++ src/re_view/core.cljs
@@ -10,6 +10,12 @@
 (def ^:dynamic *use-prior* false)
 (def ^:dynamic *use-prior-props* false)

+(def js-get gobj/get)
+
+(defn js-call [target fname & args]
+  (let [f (aget target fname)]
+    (.apply f target (clj->js args))))
+
 (def db (d/create {:view-id {:db/index true}}))

 (defn by-id [id]
@@ -20,13 +26,13 @@
 ;; convenience access methods

 (defn mounted? [c]
-  (.isMounted c))
+  (and c (.isMounted c)))

 (defn force-update! [this]
   (when (mounted? this)
     (try (.forceUpdate this)
          (catch js/Error e
-           (if-let [on-error (.-onError this)]
+           (if-let [on-error (aget this "onError")]
              (on-error e)
              (do (.debug js/console "No :on-error method in component" this)
                  (.error js/console e)))))))
@@ -35,9 +41,11 @@
 (defn render-loop
   []
   (let [components @to-render]
+
     (when-not (empty? components)
       (reset! to-render #{})
-      (doseq [c components] (force-update! c))))
+      (doseq [c components]
+        (force-update! c))))
   (js/requestAnimationFrame render-loop))

 (defonce _ (render-loop))
@@ -49,7 +57,7 @@
 (defn react-ref
   "Returns the component associated with a component's React ref."
   [component name]
-  (some-> (.-refs component) (gobj/get name)))
+  (some-> (js-get component "refs") (js-get name)))

@@ -63,6 +71,9 @@
                     :prev-props :props)))

 (defn children [this]
+  (d/get @db this :children))
+
+(defn prev-children [this]
   (d/get @db this :children))

 (defn state [this]
@@ -79,11 +90,11 @@
   (d/transact! db [{:id         this
                     :prev-state (d/get @db this :state)
                     :state      new-state}])
-  (when-let [will-receive-state (.-componentWillReceiveState this)]
+  (when-let [will-receive-state (js-get this "componentWillReceiveState")]
     (.call will-receive-state this))
   (when (and *trigger-state-render*
              (mounted? this)
-             (.call (.-shouldComponentUpdate this) this (.-props this) nil))
+             (.call (js-get this "shouldComponentUpdate") this (d/get @db this :props) nil))
     (force-update this)))

 (defn update-state! [this f & args]
@@ -95,12 +106,12 @@
   ([this props] (render-component this props nil))
   ([this props & children]
     ;; manually invoke componentWillReceiveProps
-   (when-let [will-receive-props (.-componentWillReceiveProps this)]
+   (when-let [will-receive-props (js-get this "componentWillReceiveProps")]
      (.call will-receive-props this #js {:cljs$props    props
                                          :cljs$children children}))

     ;; only render if shouldComponentUpdate returns true (emulate ordinary React lifecycle)
-   (when (.call (.-shouldComponentUpdate this) this props (state this))
+   (when (.call (js-get this "shouldComponentUpdate") this props (state this))
      (force-update this))))

 ;; TODO - include render loop
@@ -108,8 +119,8 @@
 ;; Lifecycle method handling

 (defn expand-props [this props]
-  (cond-> props
-          (.-expandProps this) ((.-expandProps this) props)))
+  (cond->> props
+           (js-get this "expandProps") (js-call this "expandProps")))

 (defn initial-subscription-data
   "If component has specified subscriptions, initialize them"
@@ -120,7 +131,7 @@
                          sub (assoc-in [:subscriptions k] sub)
                          default (assoc k (default)))))
              {}
-             (.-subscriptions this)))
+             (js-get this "subscriptions")))

 (defn begin-subscriptions [this next-props]
   (doseq [{:keys [subscribe]} (vals (:subscriptions (state this)))]
@@ -128,7 +139,7 @@

 (defn end-subscriptions [this prev-props]
   (doseq [{:keys [unsubscribe]} (vals (:subscriptions (state this)))]
-    (unsubscribe prev-props)))
+    (when unsubscribe (unsubscribe prev-props))))

 (defn update-subscriptions [this prev-props next-props]
   (when (seq (keep identity (filter (fn [{:keys [should-update]}] (and should-update (should-update prev-props next-props))) (vals (:subscriptions (state this))))))
@@ -141,13 +152,13 @@
    (fn [get-initial-state-fn]
      (fn []
        (this-as this
-         (let [initial-props (expand-props this (.. this -props -cljs$props))
+         (let [initial-props (expand-props this (aget this "props" "cljs$props"))
                initial-state (merge (when get-initial-state-fn (get-initial-state-fn this initial-props))
                                     (initial-subscription-data this initial-props))]
            (d/transact! db [{:id         this
                              :props      initial-props
                              :view-id    (or (:view-id initial-props) (:id initial-props))
-                             :children   (.. this -props -cljs$children)
+                             :children   (aget this "props" "cljs$children")
                              :state      initial-state
                              :prev-state initial-state}])))))

@@ -173,16 +184,18 @@
    (fn [f]
      (fn []
        (this-as this
-         (end-subscriptions this (props this))
-         (when f (f this))
-         (d/transact! db [[:db/retract-entity this]]))))
+         (binding [*trigger-state-render* false]
+           (end-subscriptions this (props this))
+           (when f (f this))
+           (d/transact! db [[:db/retract-entity this]])))))

    "componentWillReceiveState"
    (fn [f]
      (fn []
        (this-as this
          (let [props (d/get @db this :props)]
-           (update-subscriptions this props props)
+           (binding [*trigger-state-render* false]
+             (update-subscriptions this props props))
            (when f
              (f this
                 props
@@ -194,15 +207,16 @@
      (fn [props]

        (this-as this
-         (let [prev-props (d/get @db this :props)
-               next-props (expand-props this (.-cljs$props props))
-               next-children (.-cljs$children props)]
-
-           (d/transact! db [{:id         this
-                             :prev-props prev-props
-                             :props      next-props
-                             :view-id    (or (:view-id next-props) (:id next-props))
-                             :children   next-children}])
+         (let [{prev-props :props prev-children :children} (d/entity @db this)
+               next-props (expand-props this (js-get props "cljs$props"))
+               next-children (js-get props "cljs$children")]
+
+           (d/transact! db [{:id            this
+                             :prev-props    prev-props
+                             :props         next-props
+                             :view-id       (or (:view-id next-props) (:id next-props))
+                             :prev-children prev-children
+                             :children      next-children}])

            (binding [*trigger-state-render* false
                      *use-prior-props* true]
@@ -301,13 +315,14 @@
 (defn factory
   [class]
   (fn [props & children]
-    (let [props? (or (nil? props) (map? props))
+    (let [props (js->clj props)
+          props? (or (nil? props) (map? props))
           children (if props? children (cons props children))
           {:keys [ref key] :as props} (when props? props)
           element (js/React.createElement
                     class
                     #js {:key           (or key
-                                            (if-let [keyfn (.. class -prototype -reactKey)]
+                                            (if-let [keyfn (aget class "prototype" "reactKey")]
                                               (if (string? keyfn) keyfn (keyfn props)) key)
                                             (.-displayName class))
                          :ref           ref
@@ -342,11 +357,12 @@
    unless it is already a valid React element.
    "
   ([& methods]
-   (let [methods (if (= 1 (count methods)) (cons :render methods) methods)
-         methods (apply hash-map methods)]
-     (-> methods
-         react-class
-         factory))))
+   (let [methods (if (= 1 (count methods)) (cons :render methods) methods)]
+     (->> methods
+          (map #(if (vector? %) (fn [] %) %))
+          (apply hash-map)
+          react-class
+          factory))))

 (comment


Removed all new-lines and weird unicode three-dots(...)

--- src/scrapper/core.clj
+++ src/scrapper/core.clj
@@ -9,11 +9,13 @@
   (html/html-resource (URL. url)))

 (def html-doc (fetch-url base-url))
+(defn shine []
+  (+ 2 3))

 (defn get-lyric []
   (map html/text (html/select html-doc [:div.content-post])))
 (def lyric (first (get-lyric)))
-(str/split lyric #"\n")
+(str/replace (str/trim-newline (str/trim lyric)) #"\…|\n|\." "")

 (defn -main
   "I don't do a whole lot ... yet."


Commented out system code for now.

Commented out system code for now.

--- dev-resources/src/hxgm30/language/repl.clj
+++ dev-resources/src/hxgm30/language/repl.clj
@@ -7,41 +7,42 @@
     [clojusc.system-manager.core :refer :all]
     [clojusc.twig :as logger]
     [com.stuartsierra.component :as component]
-    [hxgm30.language.components.config :as config]
-    [hxgm30.language.components.core]
+    ; [hxgm30.language.components.config :as config]
+    ; [hxgm30.language.components.core]
+    [hxgm30.language.syntagmata.util :as util]
     [trifl.java :refer [show-methods]]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Initial Setup & Utility Functions   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def setup-options {
-  :init 'hxgm30.language.components.core/init
-  :after-refresh 'hxgm30.language.repl/init-and-startup
-  :throw-errors false})
+; (def setup-options {
+;   :init 'hxgm30.language.components.core/init
+;   :after-refresh 'hxgm30.language.repl/init-and-startup
+;   :throw-errors false})

-(defn init
-  "This is used to set the options and any other global data.
+; (defn init
+;   "This is used to set the options and any other global data.

-  This is defined in a function for re-use. For instance, when a REPL is
-  reloaded, the options will be lost and need to be re-applied."
-  []
-  (logger/set-level! '[hxgm30] :debug)
-  (setup-manager setup-options))
+;   This is defined in a function for re-use. For instance, when a REPL is
+;   reloaded, the options will be lost and need to be re-applied."
+;   []
+;   (logger/set-level! '[hxgm30] :debug)
+;   (setup-manager setup-options))

-(defn init-and-startup
-  "This is used as the 'after-refresh' function by the REPL tools library.
-  Not only do the options (and other global operations) need to be re-applied,
-  the system also needs to be started up, once these options have be set up."
-  []
-  (init)
-  (startup))
+; (defn init-and-startup
+;   "This is used as the 'after-refresh' function by the REPL tools library.
+;   Not only do the options (and other global operations) need to be re-applied,
+;   the system also needs to be started up, once these options have be set up."
+;   []
+;   (init)
+;   (startup))

 ;; It is not always desired that a system be started up upon REPL loading.
 ;; Thus, we set the options and perform any global operations with init,
 ;; and let the user determine when then want to bring up (a potentially
 ;; computationally intensive) system.
-(init)
+;;(init)

 (defn banner
   []


video-gui is gone

video-gui is gone

--- src/sormilla/main.clj
+++ src/sormilla/main.clj
@@ -5,8 +5,7 @@
             [sormilla.drone-comm :as comm]
             [sormilla.video :as video]
             [sormilla.swing :as swing]
-            [sormilla.gui :as gui]
-            [sormilla.video-gui :as video-gui]))
+            [sormilla.gui :as gui]))

 (defn -main [& args]
   (println "starting...")


tentative de background

tentative de background

--- desktop/src-common/con_world/core.clj
+++ desktop/src-common/con_world/core.clj
@@ -43,7 +43,8 @@
    (key-code :dpad-right) :right})

 (defn coliding-entities [screen entities]
-  (let [coliding-entities [(first-entity screen entities) (second-entity screen entities)]]
+  (let [entities (filter #(contains? % :body) entities)
+        coliding-entities [(first-entity screen entities) (second-entity screen entities)]]
     {:enemy       (cell/find-enemy coliding-entities)
      :player      (cell/find-cell coliding-entities)
      :plante-zone (cell/find-plante-zone coliding-entities)
@@ -88,16 +89,20 @@
            :on-show
            (fn [screen _]

-             (let [screen (-> (init-graphic-settings screen)
+             (let [background (u/memo-texture "main-screen-background-1.png")
+                   screen (-> (init-graphic-settings screen)
                               (update!
                                 :world (box-2d 0 0)
                                 :music (u/memo-sound "sound/fond.mp3")
+                                :bg-width (u/pixels->world (texture! background :get-region-width))
+                                :bg-height (u/pixels->world (texture! background :get-region-height))
                                 :last-spawn 0))]

                (add-timer! screen :ambiant-sound 3 3)
                (sound! (:music screen) :loop)

-               [(create-wall-entity screen)
+               [ background
+                (create-wall-entity screen)
                 (cell/create-plante-zone! screen)
                 (create-player-entity screen)]))

@@ -130,7 +135,7 @@

            :on-resize
            (fn [screen _]
-             (size! screen u/w-width u/w-height))
+             (size! screen (:bg-width screen) (:bg-height screen)))

            :on-end-contact
            (fn [screen entities]
@@ -153,25 +158,20 @@

            :on-timer
            (fn [screen entities]
-             (println "timer")
              (when (= :ambiant-sound (:id screen))
-               (when (= 0 (mod (rand-int 2) 2))
+               (when (even? (rand-int 2))
                  (cell/ambiant-sound (cell/find-cell entities)))
                entities)))

 (defscreen main-bg-screen
            :on-show
            (fn [screen _]
-             (let [camera (orthographic)]
-               (update! screen
-                        :camera camera
-                        :renderer (stage-fit-vp camera))
-               (u/memo-texture "main-screen-background-1.png")))
-
-           :on-render
-           (fn [screen entities]
-             #_(println entities)
-             (clear! 0 1 0 1)
+             (init-graphic-settings screen)
+             (u/memo-texture "main-screen-background-1.png"))
+
+           :on-render
+           (fn [screen entities]
+             #!(clear! 0 1 0 1)
              (render! screen entities))

            :on-resize
@@ -222,11 +222,8 @@
            :on-show
            (fn [screen _]
              (let [background (intro-screen-background)
-                   music (u/memo-sound "intro-screen-music.mp3")
-                   camera (orthographic)]
-               (update! screen
-                        :renderer (stage-fit-vp camera)
-                        :camera camera
+                   music (u/memo-sound "intro-screen-music.mp3")]
+               (update! (init-graphic-settings screen)
                         :bg-width (texture! background :get-region-width)
                         :bg-height (texture! background :get-region-height)
                         :music music)
@@ -262,10 +259,8 @@
 (defscreen game-over-screen
            :on-show
            (fn [screen _]
-             (let [camera (orthographic)]
-               (update! screen
-                        :camera camera
-                        :renderer (stage-fit-vp camera)))
+             (init-graphic-settings screen)
+             ; FIX son de Ben
              #_(sound! (u/memo-sound "sound/gameover.wav") :play)
              (label "Game over" (color :red)))


log exceptions correctly -- print out a stacktrace instead of just the exception object

--- src/subrosa/netty.clj
+++ src/subrosa/netty.clj
@@ -68,7 +68,7 @@
                        #{java.io.IOException
                          java.nio.channels.ClosedChannelException
                          javax.net.ssl.SSLException}))
-        (log/error (root-cause evt)))))
+        (log/error (root-cause evt) "Unhandled Exception"))))
   evt)

 (defn connect-handler [channel-group pipeline evt]


optimize expressions

optimize expressions

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -622,10 +622,33 @@
     (vector? node) (apply (first node) (rest node))
     :else node))

+(defn resolve-operators
+  [tree]
+  (tree-catamorph [tree node]
+    (symbol? node) (resolve node)
+    :else node))
+
+(defn optimize-op
+  [[op & args :as expr]] ;; TODO - def-log does not work here
+  (let [variables (filter (complement number?) args)
+        constants (filter number? args)
+        reduced (reduce op constants)]
+    (println reduced)
+    (if-not (empty? constants)
+      (into [op reduced] variables)
+      expr)))
+
+(defn optimize-expr
+  "Optimize the shape of an expression"
+  [tree]
+  (tree-catamorph [tree node]
+    (vector? node) (optimize-op node)
+    :else node))
+
 ;; Phase 2:
 ;; Optimizing and creating types for commonly used expressions.
 ;; - We can compile the expression
-;; - TODO: we can optimize it first
+;; - We can optimize it first
 ;; Explain the link with expression templates

 (defn compile-eval-expr
@@ -640,20 +663,21 @@
   (eval-expr [this] "Evaluate the expression")
   (expr->data [this] "The form used to create it"))

-(defmacro def-data-flow
+(defmacro def-expr
   [name tree]
   (let [deps (sort (map keyword->symbol (collect-dependencies tree)))
+        fast (optimize-expr (resolve-operators tree))
         this (gensym "this")]
     `(defrecord ~name ~(vec deps)
        IEvalExpr
        ;; (eval-expr [~this] (eval-expr-in-env ~tree ~this))
-       (eval-expr [~this] ~(compile-eval-expr tree this))
+       (eval-expr [~this] ~(compile-eval-expr fast this))
        (expr->data [_] (quote ~tree))
        )))

-(def-data-flow Expr [+ :a [* :b :c]])
-
-(defn test-data-flow
+(def-expr Expr [+ [* 2 3 :a] [* 2 :b :c]])
+
+(defn test-def-expr
   []
   (let [e (map->Expr {:a 1 :b 2 :c 3})]
     (println (eval-expr e))


Use uncontrolled text inputs for simple and cqp

This prevents the cursor from jumping to the end whenever we type something into a non-final position in the text box. Of course the text inputs need to be updated with a new value if we switch back to the view after having changed the query in another view. However, this is currently not a problem since only one view is visible at the time, meaning that the text input will be mounted, and hence the value set, each time we switch to it.

--- src/cljs/cglossa/search_views/cwb/core.cljs
+++ src/cljs/cglossa/search_views/cwb/core.cljs
@@ -140,7 +140,7 @@
                 :class-name       "col-md-12"
                 :group-class-name "table-cell"
                 :type             "text"
-                :value            displayed-query
+                :default-value    displayed-query
                 :on-change        #(on-text-changed % wrapped-query phonetic?)
                 :on-key-down      #(on-key-down % a m)}]]
      (when show-checkboxes?


added (shutdown-agents) call in case we used futures

--- euler-clj/src/euler_clj/core.clj
+++ euler-clj/src/euler_clj/core.clj
@@ -149,4 +149,5 @@
   (time (println "Problem 5: " (problem-5 1 20)))
   (time (println "Problem 6: " (problem-6-smart 100)))
   (time (println "Problem 7: " (problem-7 10001)))
-  (time (println "Problem 8: " (problem-8 5 problem-8-number))))
+  (time (println "Problem 8: " (problem-8 5 problem-8-number)))
+  (shutdown-agents))


Fix CORS headers

Fix CORS headers

--- src/b3api/core.clj
+++ src/b3api/core.clj
@@ -6,7 +6,9 @@
             [me.raynes.fs :as fs]
             [clojure.java.io :as io]
             [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
-            [compojure.core :refer [defroutes GET POST]]
+            [compojure.route :refer [files not-found]]
+            [compojure.handler :refer [site]] ; form, query params decode; cookie; session, etc
+            [compojure.core :refer [defroutes GET POST DELETE ANY context]]
             [taoensso.encore :as enc :refer [if-lets update-in* reset-in!]]
             [cheshire.core :refer [generate-string parse-string]])
   (:gen-class))
@@ -44,6 +46,13 @@
 (timbre/merge-config! {:output-fn (partial timbre/default-output-fn
                                            {:stacktrace-fonts {}})
                        :timestamp-opts {:pattern "yyyy-MM-dd HH:mm:ss"}})
+
+
+(def req-headers
+  { "Access-Control-Allow-Origin" "*"
+    "Access-Control-Allow-Headers" "Content-Type"
+    "Access-Control-Allow-Methods" "GET,POST,OPTIONS"
+    "Content-Type" "application/json; charset=utf-8" })

 (defn deep-merge*
@@ -133,21 +142,25 @@
           (info "New websocket client. #connected:" (count @channel-list))
           (send! channel big-json false))
         ;; If HTTP just send down the json
-        (send! channel {:status  200
-                        :headers {"Content-Type" "application/json"}
-                        :body    big-json}))
+        (do
+          (info "GET from" (:remote-addr ring-request))
+          (send! channel {:status  200
+                          :headers req-headers
+                          :body    big-json} )))
       (on-receive channel update-status)
       ;; On channel close just remove it from the subscribed channels
-      (on-close channel
-                (fn [status]
-                  (reset! channel-list (remove #(= % channel)
-                                               @channel-list))
-                  (info "Client disconnected. #connected:" (count @channel-list)))))))
+      (on-close
+       channel
+       (fn [status]
+         (when (websocket? channel)
+           (reset! channel-list (remove #(= % channel) @channel-list))
+           (info "Client disconnected. #connected:" (count @channel-list))))))))

 (defroutes all-routes
   (GET  "/" [] root-handler)     ;; Websocket + GET
-  (POST "/" [] update-handler))  ;; POST for one-time updates or fallback
+  (POST "/" [] update-handler)   ;; POST for one-time updates or fallback
+  (not-found   root-handler))    ;; Because fallback.
 ;; TODO: /hist


Spell hyphenated correctly.

Spell hyphenated correctly.

--- src/clojars/db.clj
+++ src/clojars/db.clj
@@ -175,8 +175,8 @@
        :authors    (str/join ", " (map #(.replace % "," "")
                                        (:authors jarmap)))}))))

-(defn quote-hyphanated
-  "Wraps hyphated-words in double quotes."
+(defn quote-hyphenated
+  "Wraps hyphenated-words in double quotes."
   [s]
   (str/replace s #"\w+(-\w+)+" "\"$0\""))

@@ -188,7 +188,7 @@
             "content match ?"
             "limit 50 "
             "offset ?")
-       (quote-hyphanated query)
+       (quote-hyphenated query)
        (or offset 0)]
     ;; TODO: do something less stupidly slow
     (vec (map #(find-jar (:group_name %) (:jar_name %)) rs))))


Use k as unit.

Use k as unit.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -25,7 +25,7 @@
         delta-cntr (delta-counter)
         stats-fn (fn []
                    (println
-                     "in:" (delta-cntr :in (.value in-cntr))))
+                     "in:" (long (/ (delta-cntr :in (.value in-cntr)) 1000)) "k;"))
         in-loop (ProcessingLoop. (fn [] (.inc in-cntr)))]
     (.start in-loop)
     (run-repeat (executor) stats-fn 1000)))


Add Flower type to story world.

Add Flower type to story world.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -14,6 +14,7 @@
 (defrecord Monster [name summary])

 (defrecord Player [name summary room])
+(defrecord Flower [name summary])

 (defprotocol QueryableRoom
   (connected-rooms [this story]))
@@ -121,4 +122,5 @@
    "monster" (fn [] (new isla.story.Monster "" ""))
    "room" (fn [] (new isla.story.Room "" "" [] :undefined))
    "_player" (fn [] (new isla.story.Player "" "" :undefined))
+   "flower" (fn [] (new isla.story.Flower "" ""))
    })


Add better type hierarchy.

Add better type hierarchy.

--- src/uxbox/shapes.cljs
+++ src/uxbox/shapes.cljs
@@ -9,12 +9,13 @@

 (def ^:static +hierarchy+
   (as-> (make-hierarchy) $
-    (derive $ :builtin/icon ::shape)
-    (derive $ :builtin/rect ::shape)
+    (derive $ ::rect ::shape)
+    (derive $ :builtin/icon ::rect)
+    (derive $ :builtin/rect ::rect)
     (derive $ :builtin/line ::shape)
     (derive $ :builtin/circle ::shape)
     (derive $ :builtin/text ::shape)
-    (derive $ :builtin/group ::shape)))
+    (derive $ :builtin/group ::rect)))

 (defn shape?
   [type]
@@ -107,35 +108,23 @@
   [shape _]
   (throw (ex-info "Not implemented" (select-keys shape [:type]))))

-(defmethod -resize' :builtin/icon
+(defmethod -resize' ::rect
   [shape [width height]]
   (merge shape
          (when width {:width width})
          (when height {:height height})))

-(defmethod -resize' :builtin/group
-  [shape [width height]]
-  (merge shape
-         (when width {:width width})
-         (when height {:height height})))
-
 (defmethod -resize' :default
   [shape _]
   (throw (ex-info "Not implemented" (select-keys shape [:type]))))

 ;; Move

-(defmethod -move ::shape
+(defmethod -move ::rect
   [shape {:keys [dx dy] :as opts}]
   (assoc shape
          :x (+ (:x shape) dx)
          :y (+ (:y shape) dy)))
-
-(defmethod -move :builtin/group
-  [shape {:keys [dx dy] :as opts}]
-  (assoc shape
-         :dx (+ (:dx shape 0) dx)
-         :dy (+ (:dy shape 0) dy)))

 (defmethod -move :builtin/line
   [shape {:keys [dx dy] :as opts}]
@@ -144,6 +133,10 @@
          :y1 (+ (:y1 shape) dy)
          :x2 (+ (:x2 shape) dx)
          :y2 (+ (:y2 shape) dy)))
+
+(defmethod -move :default
+  [shape _]
+  (throw (ex-info "Not implemented" (select-keys shape [:type]))))

 (defmethod -rotate ::shape
   [shape rotation]
@@ -183,6 +176,10 @@
     (as-> shape $
       (merge $ {:width width :height height :x x :y y})
       (container-rect $))))
+
+(defmethod -outer-rect :default
+  [shape _]
+  (throw (ex-info "Not implemented" (select-keys shape [:type]))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Helpers


improve how models are constructed

improve how models are constructed

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -730,55 +730,58 @@
         ;; indices from paths to subsets of the lexicon
         debug (log/info "  indices..")
         indices (create-indices lexicon-for-generation index-lexicon-on-paths)
-        debug (log/info "  finalizing..")
-        stage-1
-        {:index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
-         :default-fn default-fn
-         :name "model"
-         :generate {:lexicon lexicon-for-generation}
-         :grammar grammar
-         :language "it"
-         :language-keyword :italiano
-         :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
-         :lexicon lexicon
-         :lookup (fn [arg] (analyze arg lexicon))
-         :morph (fn [expression & {:keys [from-language show-notes]}] (fo expression))
-         :morph-ps fo-ps
-         :rules rules
-         :rule-map (zipmap rules grammar)
-         :tenses tenses}
-        stage-2
-        (merge stage-1
-               {:generate-fn (fn [spec] (generate/generate spec stage-1))})]
-
-    (merge
-     stage-2
-     {:bolts
-      (merge
-       (let [depth 2
-             spec
-             {:synsem {:subcat []
-                       :cat :verb
-                       :sem {:tense :present
-                             :reflexive :top
-                             :aspect :perfect}}}]
-         {(merge {:depth depth}
-                 spec)
-          (lightning-bolts stage-2
-                           spec
-                           0 depth)})
-       (let [depth 3
-             spec
-             {:synsem {:subcat []
-                       :cat :verb
-                       :sem {:tense :present
-                             :reflexive :top
-                             :aspect :perfect}}}]
-         {(merge {:depth depth}
-                 spec)
-          (lightning-bolts stage-2
-                           spec
-                           0 depth)}))})))
+        debug (log/info "  finalizing..")]
+
+    (->
+
+     {:index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
+      :default-fn default-fn
+      :name "model"
+      :generate {:lexicon lexicon-for-generation}
+      :grammar grammar
+      :language "it"
+      :language-keyword :italiano
+      :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
+      :lexicon lexicon
+      :lookup (fn [arg] (analyze arg lexicon))
+      :morph (fn [expression & {:keys [from-language show-notes]}] (fo expression))
+      :morph-ps fo-ps
+      :rules rules
+      :rule-map (zipmap rules grammar)
+      :tenses tenses}
+
+     ((fn [model]
+        (merge model
+               {:bolts
+                (merge
+                 (let [depth 2
+                       spec
+                       {:synsem {:subcat []
+                                 :cat :verb
+                                 :sem {:tense :present
+                                       :reflexive :top
+                                       :aspect :perfect}}}]
+                   {(merge {:depth depth}
+                           spec)
+                    (lightning-bolts model
+                                     spec
+                                     0 depth)})
+                 (let [depth 3
+                       spec
+                       {:synsem {:subcat []
+                                 :cat :verb
+                                 :sem {:tense :present
+                                       :reflexive :top
+                                       :aspect :perfect}}}]
+                   {(merge {:depth depth}
+                           spec)
+                    (lightning-bolts model
+                                     spec
+                                     0 depth)}))})))
+
+     ((fn [model]
+        (merge model
+               {:generate-fn (fn [spec] (generate/generate spec model))}))))))

 (defn model-with-vocab-items [vocab-items filter-lexicon-fn model]
   (let [input-lexicon (map vocab-entry-to-lexeme vocab-items)


fix exclusion of "chiamarsi" to reflect that other reflexive verbs will now (thanks to latest change to italiano/lexicon.cljc) have subcat :3 = '()

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -602,7 +602,7 @@

                                            (and
                                             (= (get-in % [:synsem :sem :reflexive] false) true)  ;; ..but allow reflexive verbs,
-                                            (= :none (get-in % [:synsem :subcat :3] :none)) ;; but not reflexive verbs with
+                                            (= '() (get-in % [:synsem :subcat :3] '())) ;; but not reflexive verbs with
                                             ;; 3 args (e.g. "chiamarsi", because the small grammar can't generate for it.
                                             ))
                                        )


second argument of a verb should be {subcat []}

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -259,7 +259,8 @@
                  :cat :verb
                  :essere false
                  :sem {:reflexive false}
-                 :subcat {:2 {:reflexive false}}}})
+                 :subcat {:2 {:reflexive false
+                              :subcat []}}}})

       (default ;; a verb defaults to intransitive.
        {:synsem {:cat :verb


simplify noun definitions: no need to unify with common-noun,etc - instead do this with (constrain-vals-if) in lexical post-processing

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -98,12 +98,11 @@
                             :sem {:pred :accompany}}}

    "acqua"
-   (unify (:agreement noun)
-          (:drinkable noun)
-          (:feminine noun)
-          {:synsem {:sem {:artifact false
-                          :animate false
-                          :pred :acqua}}})
+   {:synsem {:agr {:gender :fem}
+             :cat :noun
+             :sem {:artifact false
+                   :animate false
+                   :pred :acqua}}}

    "addormentarsi" (let [subject-semantics (atom {:animate true})
                          subject-agr (atom :top)]
@@ -207,14 +206,19 @@
                     :activity false
                     :discrete false
                     :subj {:human true}}}}
+   "amica"
+   {:synsem {:agr {:gender :fem}
+             :cat :noun
+             :sem {:pred :amico
+                   :human true
+                   :child false}}}
    "amico"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:synsem {:sem {:pred :amico
-                          :human true
-                          :child false}}})
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :amico
+                   :human true
+                   :child false}}}
+
    "ammirare" {:synsem {:cat :verb
                         :sem {:pred :admire}}}
    "andare"
@@ -269,8 +273,8 @@
 ;                                    :cat :prep}}}
 ;              :note "andare-pp"}))))

-
-   "anno" {:synsem {:cat :noun
+   "anno" {:synsem {:agr {:gender :noun}
+                    :cat :noun
                     :sem {:pred :year
                           :time true}}}

@@ -305,8 +309,8 @@
                                       :sem subject-semantics}}}})

    "arrivare" {:synsem {:essere true
-                            :cat :verb
-                            :sem {:pred :arrive}}}
+                        :cat :verb
+                        :sem {:pred :arrive}}}

    "ascoltare"  {:synsem {:cat :verb
                           :sem {:pred :listen-to}}}
@@ -463,24 +467,23 @@
                       :fem {:plur "bianche"}
                       :cat :adjective}})
    "birra"
-   (unify agreement-noun
-           drinkable-noun
-           feminine-noun
-           {:synsem {:sem {:pred :birra
-                           :artifact true}}})
+   {:synsem {:agr {:gender :fem}
+             :cat :noun
+             :sem {:pred :birra
+                   :artifact true
+                   :drinkable true}}}
    "braccio"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:synsem {:sem {:pred :braccio
-                          :part-of-human-body true}}
-           ;; adding "bracci" as irregular because
-           ;; current morphology.clj would otherwise return
-           ;; "braccii".
-           ;; TODO: might not be an exception so much
-           ;; as a ortho-pholological rule "io" -plur-> "ia"
-           :italiano {:plur "bracci"}})
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :braccio
+                   :part-of-human-body true}}
+
+    ;; adding "bracci" as irregular because
+    ;; current morphology.clj would otherwise return
+    ;; "braccii".
+    ;; TODO: might not be an exception so much
+    ;; as a ortho-pholological rule "io" -plur-> "ia"
+    :italiano {:plur "bracci"}}

    "brutto"
    ;; non-comparative
@@ -507,17 +510,11 @@

    "calzoni"
    ;; inherently plural
-   (unify agreement-noun
-           common-noun
-           countable-noun
-           masculine-noun
-           {:synsem {:agr {:number :plur}
-                     :sem {:pred :calzoni
-                           :artifact true
-                           :speakable false
-                           :legible false
-                           :consumable false
-                           :clothing true}}})
+   {:synsem {:cat :noun
+             :agr {:gender :masc
+                   :number :plur}
+             :sem {:pred :calzoni
+                   :clothing true}}}

    "cambiare" {:synsem {:cat :verb
                         :sem {:pred :change}}}
@@ -543,33 +540,23 @@
    "cantare" {:synsem {:cat :verb
                        :sem {:pred :sing
                              :subj {:human true}}}}
-   "camicia"
-    (unify agreement-noun
-           common-noun
-           countable-noun
-           feminine-noun
-           {:synsem {:sem {:pred :camicia
-                           :artifact true
-                           :speakable false
-                           ;; (although an exception would be tshirts with writing on them):
-                           :legible false
-                           :consumable false
-                           :clothing true}}})
-
+  "camicia"
+  {:synsem {:agr {:gender :fem}
+            :cat :noun
+            :sem {:pred :camicia
+                  ;; (although an exception would be tshirts with writing on them):
+                  :legible false
+                  :clothing true}}}
+
     "camminare"
     {:synsem {:sem {:pred :walk}
               :cat :verb}}

    "cane"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:synsem {:sem {:animal true
-                          :human false
-                          :pet true
-                          :pred :cane}}})
-
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pet true
+                   :pred :cane}}}

    "capire" {:italiano {:boot-stem1 "capisc"}
              :synsem {:cat :verb
@@ -579,26 +566,19 @@
                :synsem {:cat :verb
                         :sem {:pred :caricare}}}
    "casa"
-   [(unify agreement-noun
-           common-noun
-           countable-noun
-           feminine-noun
-           {:synsem {:sem {:pred :casa
-                           :city false
-                           :activity false ;; should not need this probably: should be inferrable from  :place==true or perhaps :artifact==true.
-                           :buyable true
-                           :artifact true
-                           :place true}}})
-
+   [{:synsem {:agr {:gender :fem}
+              :cat :noun
+              :sem {:pred :casa
+                    :city false
+                    :place true}}}
+
     ;; in the sense of "a casa": no article needed.
     {:synsem {:case :acc
               :cat :noun
               :propernoun false
               :sem {:city false
                     :spec {:def :none} ;; "a casa", not "a mia casa", etc
-                    :place true
-                    :animate false
-                    :pred :house}
+                    :place true}
               :subcat '()}}
     ]

@@ -612,19 +592,16 @@
              :italiano {:cat :adjective}})

       ;; working on: "mi sono comprato un nuovo cellulare"
-     "cellulare"
-     (unify agreement-noun
-             masculine-noun
-             common-noun
-             countable-noun
-             {:synsem {:cat :noun
-                       :sem {:pred :cellulare
-                             :artifact true
-                             :consumable false
-                             :writable false
-                             :place false
-                             :speakable false}}})
-
+   "cellulare"
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :cellulare
+                   :artifact true
+                   :consumable false
+                   :writable false
+                   :place false
+                   :speakable false}}}
+
      "cenare" {:synsem {:cat :verb
                       :essere false
                       :sem {:subj {:human true}
@@ -696,14 +673,13 @@
                   :cat :noun
                   :case pronoun-acc}}

-      "cipolla"
-      (unify agreement-noun
-             common-noun
-             feminine-noun
-             {:synsem {:sem {:pred :cipolla
-                             :edible true
-                             :animate false
-                             :artifact false}}})
+  "cipolla"
+  {:synsem {:agr {:gender :fem}
+            :cat :noun
+            :sem {:pred :cipolla
+                  :edible true
+                  :animate false
+                  :artifact false}}}

       "cercare" {:synsem {:cat :verb
                           :essere false
@@ -711,20 +687,17 @@
                                 :discrete false
                                 :pred :cercare
                                 :subj {:animate true}}}}
-   "città"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          feminine-noun
-          {:synsem {:sem {:artifact true
-                          :buyable false  ;; can't buy a city (unless you're a billionaire like Mike Bloomberg)
-                          :city true
-                          :place true
-                          :pred :città
-                          }
-                    :subcat {:1 {:cat :det
-                                 :def :def}}}})
-
+  "città"
+  {:synsem {:agr {:gender :fem}
+            :cat :noun
+            :sem {:artifact true
+                  :buyable false  ;; can't buy a city (unless you're a billionaire like Mike Bloomberg)
+                  :city true
+                  :place true
+                  :pred :città}
+            :subcat {:1 {:cat :det
+                         :def :def}}}} ;; TODO: why must :def be specifically :def here?
+
    "cittadino" {:synsem {:cat :adjective
                          :sem {:pred :local}}}

@@ -749,16 +722,14 @@
                     :pred :start
                     :subj {:animate true}}}}]

-      "compito"
-      (unify agreement-noun
-             common-noun
-             countable-noun
-             masculine-noun
-             {:synsem {:sem {:pred :compito
-                             :legible true
-                             :speakable false
-                             :buyable false
-                             :artifact true}}})
+   "compito"
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :compito
+                   :legible true
+                   :speakable false
+                   :buyable false
+                   :artifact true}}}

       "commentare"  {:synsem {:cat :verb
                               :sem {:pred :comment}}}
@@ -997,15 +968,13 @@
                                     :subcat '()}}}
               :italiano "domani"})

-      "donna"
-      (unify agreement-noun
-              common-noun
-              countable-noun
-              feminine-noun
-              {:synsem {:sem {:human true
-                              :pred :donna
-                              :child false}}})
-   "dopo"
+   "donna"
+   {:synsem {:agr {:gender :fem}
+             :cat :noun
+             :sem {:human true
+                   :pred :donna
+                   :child false}}}
+  "dopo"
    (let [time (atom {:time true})]
      {:synsem {:cat :prep
                :sem {:pred :after
@@ -1259,15 +1228,11 @@
                              :sem {:pred :work-nonhuman
                                    :subj {:human false}}}}

-      "gatto"
-      (unify agreement-noun
-             common-noun
-             countable-noun
-             masculine-noun
-             {:synsem {:sem {:animate true
-                             :human false
-                             :pred :gatto
-                             :pet true}}})
+   "gatto"
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :gatto
+                   :pet true}}}

       "gestire" {:italiano {:boot-stem1 "gestisc"
                             :boot-stem2 "gest"}
@@ -1494,17 +1459,13 @@
                    :subj {:human true}
                    :obj {:legible true}}}}
    "libro"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:synsem {:sem {:pred :libro
-                          :legible true
-                          :speakable false
-                          :mass false
-                          :buyable true
-                          :consumable false
-                          :artifact true}}})
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:artifact true
+                   :pred :libro
+                   :legible true
+                   :speakable false
+                   :consumable false}}}

    ;; as with "la", do we need both of these "lo" entries? try to get by with just one.
    "lo"
@@ -1610,13 +1571,11 @@
    "macchiare" {:synsem {:cat :verb
                          :sem {:pred :stain}}}
    "madre"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          feminine-noun
-          {:synsem {:sem {:human true
-                          :pred :madre
-                          :child false}}})
+   {:synsem {:agr {:gender :fem}
+             :cat :noun
+             :sem {:human true
+                   :pred :madre
+                   :child false}}}

     "male" {:synsem {:cat :adverb
                      :sem {:pred :bad}}}
@@ -1677,15 +1636,11 @@
              :italiano {:passato "nato"}}

    "neonato"
-   (unify ;agreement-noun
-          ;common-noun
-          ;countable-noun
-          ;masculine-noun
-          {:synsem {:cat :noun
-                    :agr {:gender :masc}
-                    :sem {:pred :newborn
-                          :human true
-                          :adult false}}})
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :newborn
+                   :human true
+                   :adult false}}}

    ;; non-comparative
    ;; TODO: add comparative
@@ -1735,15 +1690,14 @@
                          :future-stem "otterr"}}
    "pane"
    ;; inherently singular.
-   (unify agreement-noun
-          common-noun
-          masculine-noun
-          {:synsem {:sem {:pred :pane
-                          :edible true
-                          :artifact true}
-                    :subcat {:1 {:cat :det
-                                 :number :sing
-                                 :def :def}}}})
+   {:synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:pred :pane
+                   :edible true
+                   :artifact true}
+             :subcat {:1 {:cat :det
+                          :number :sing
+                          :def :def}}}}
    "parlare"
    (let [common1
          {:synsem {:essere false
@@ -1831,14 +1785,10 @@
    "recuperare" {:synsem {:cat :verb
                           :sem {:pred :recover}}}
    "ragazza"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          feminine-noun
-          {:synsem {:cat :noun
-                    :agr {:gender :fem}
-                    :sem {:pred :girl
-                          :human true}}})
+   {:synsem {:cat :noun
+             :agr {:gender :fem}
+             :sem {:pred :girl
+                   :human true}}}

    "restare" {:synsem {:essere true
                             :cat :verb
@@ -2065,7 +2015,6 @@
              :sem {:pred :transfer}}
     :italiano {:boot-stem1 "trasferisc"
                :boot-stem2 "trasfer"}}
-

    "tu"
    [{:synsem {:cat :noun
@@ -2105,14 +2054,12 @@
               :agr {:gender :fem
                     :number :sing}}}
    "uomo"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:italiano {:plur "uomini"}}
-          {:synsem {:sem {:human true
-                          :pred :man
-                          :child false}}})
+   {:italiano {:plur "uomini"}
+    :synsem {:agr {:gender :masc}
+             :cat :noun
+             :sem {:human true
+                   :pred :man
+                   :child false}}}

    "usare"  {:synsem {:cat :verb
                       :sem {:pred :usare}}}
@@ -2276,6 +2223,20 @@
                                        :case case}
                               :italiano {:cat cat
                                          :case case}}))))
+                 (constrain-vals-if
+                  (fn [val]
+                    (and (= (get-in val [:synsem :cat]) :noun)
+                         (or (= (get-in val [:synsem :agr :gender]) :masc)
+                             (= (get-in val [:synsem :agr :gender]) :fem))
+                         (= false (get-in val [:synsem :propernoun] false))
+                         (= false (get-in val [:synsem :pronoun] false))
+                         (not (= '() (get-in val [:synsem :subcat] :top))))) ;; some
+                  ;; some nouns e.g. "casa" may have a sense that requires no determiner (subcat = '())
+                  ;; in such cases, don't apply agreement-noun.
+
+                  (fn [val]
+                    (unify val agreement-noun)))
+
                  (constrain-vals-if
                   (fn [val]
                     (= (get-in val [:synsem :cat])