CMR-2186: Order the hierarchical maps to be easier to read

--- search-app/src/cmr/search/services/query_execution/facets_v2_results_feature.clj
+++ search-app/src/cmr/search/services/query_execution/facets_v2_results_feature.clj
@@ -4,7 +4,8 @@
   (:require [cmr.common-app.services.search.query-execution :as query-execution]
             [cmr.common-app.services.kms-fetcher :as kms-fetcher]
             [cmr.search.services.query-execution.facets-results-feature :as frf]
-            [camel-snake-kebab.core :as csk]))
+            [camel-snake-kebab.core :as csk]
+            [cmr.common.util :as util]))

 (def UNLIMITED_TERMS_SIZE
@@ -69,16 +70,24 @@
    :processing-level-id "Processing levels"
    :science-keywords "Keywords"})

+(def sorted-facet-map
+  "A map that sorts the keys of the facet map so it is presented in a pleasing way to Users
+  of the API. The nested hierarchical maps API can be hard to understand if the maps are ordered
+  randomly."
+  (util/key-sorted-map [:title :type :applied :count :links :has_children :children]))
+
 (defn- parse-hierarchical-bucket-v2
   "Parses the elasticsearch aggregations response for hierarchical fields."
   [field-hierarchy bucket-map]
   (when-let [field (first field-hierarchy)]
-    (let [empty-response {:has_children false
-                          :type :group}
+    (let [empty-response (merge sorted-facet-map
+                                {:has_children false
+                                 :type :group})
           value-counts (for [bucket (get-in bucket-map [field :buckets])
                              :let [sub-facets (parse-hierarchical-bucket-v2 (rest field-hierarchy)
                                                                             bucket)]]
-                         (merge {:has_children false}
+                         (merge sorted-facet-map
+                                {:has_children false}
                                 (when-not (= sub-facets empty-response)
                                   sub-facets)
                                 {:title (:key bucket)
@@ -103,16 +112,13 @@
   names. Returns a facet map of those specific names with value count pairs"
   [bucket-map field-names]
   (for [field-name field-names
-        ; :let [value-counts (frf/buckets->value-count-pairs (get bucket-map field-name))]
         :let [value-counts (frf/buckets->value-count-pairs (field-name bucket-map))
               has-children (some? (seq value-counts))
-              ; base-node {:title (get fields->human-readable-label (keyword field-name))}
               base-node {:title (field-name fields->human-readable-label)
                          :type :group
                          ;; TODO with another ticket
                          ;  :applied ;; either true or false
                          :has_children has-children}]]
-    ; (println "The field name is ")
     (if has-children
       (assoc base-node :children (map (fn [[term count]]
                                         {:title term
@@ -126,11 +132,9 @@
                                       value-counts))
       base-node)))

-;; :value-counts [["Larc" 3] ["Dist" 1] ["GSFC" 1] ["Proc" 1]]
 (defn create-v2-facets
   "Create the facets v2 response. Takes an elastic aggregations result and returns the facets."
   [elastic-aggregations]
-  (println "Elastic aggregations response" elastic-aggregations)
   (let [flat-fields [:data-center :project :platform :instrument :processing-level-id]
         hierarchical-fields [:science-keywords]
         facets (concat (flat-bucket-map->facets-v2
@@ -142,17 +146,6 @@
                             hierarchical-fields))]
     (assoc v2-facets-root :children facets)))

-; (defn create-v2-facets-orig
-;   "Create the facets v2 response. Takes an elastic aggregations result and returns the facets."
-;   [elastic-aggregations]
-;   (println "Elastic aggregations response" elastic-aggregations)
-;   (concat (frf/bucket-map->facets (apply dissoc elastic-aggregations [:science-keywords])
-;                                   [:data-center :project :platform :instrument :processing-level-id])
-;           (map (fn [field]
-;                  (assoc (frf/hierarchical-bucket-map->facets field (field elastic-aggregations))
-;                         :field (csk/->snake_case_string field)))
-;                [:science-keywords])))
-
 (defmethod query-execution/pre-process-query-result-feature :facets-v2
   [context query feature]
   (assoc query :aggregations (facets-v2-aggregations DEFAULT_TERMS_SIZE)))


some renames

some renames

--- src/frontend/persistence_middleware.cljs
+++ src/frontend/persistence_middleware.cljs
@@ -5,8 +5,8 @@
   (:require [cljs.core.match :refer-macros [match]]))

 (defn -wrap-control
-  [control storage key blacklist]
-  (fn wrapped-control
+  [component-control storage key blacklist]
+  (fn control
     [model signal dispatch]
     (letfn [(save
               [result]
@@ -22,7 +22,7 @@
             (save-and-control
               [model signal]
               (save model)                                  ; persist current model in case no action is dispatched
-              (control model signal dispatch-and-save))]
+              (component-control model signal dispatch-and-save))]
       (if-not (= signal :on-connect)
         ; hand signal further to component
         (save-and-control model signal)
@@ -36,18 +36,18 @@
             ; else - update model and hand it with signal further to component
             (let [new-model (merge storage-model (select-keys model blacklist))]
               (dispatch [::-reset-from-storage new-model])
-              (control new-model signal dispatch-and-save))))))))
+              (component-control new-model signal dispatch-and-save))))))))

 (defn -wrap-reconcile
-  [reconcile]
-  (fn wrapped-reconcile
+  [component-reconcile]
+  (fn reconcile
     [model action]
     (match action
            [::-reset-from-storage data]
            data

            :else
-           (reconcile model action))))
+           (component-reconcile model action))))

 (defn wrap
   "On :on-connect signal middleware will load the model from storage and send the signal further with updated model to the component.


Added default method to c.c.algorithms.concepts/concepts

which is :next-closure (of course).

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/algorithms/concepts.clj
+++ src/conexp/contrib/algorithms/concepts.clj
@@ -7,22 +7,33 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.contrib.algorithms.concepts
-  (:use conexp.contrib.algorithms.bitwise)
+  (:use conexp.util
+	conexp.contrib.algorithms.bitwise)
   (:use [conexp.fca.contexts :only (objects attributes incidence)])
   (:import [java.util BitSet])
   (:import [java.util.concurrent SynchronousQueue]))

 ;(set! *warn-on-reflection* true)

-;;; Concept Calculation
+;;; Concept Calculation Multi-Method

 (defmulti concepts
-  "Computes concepts with various algorithms, given as first argument."
-  {:arglists '([algorithm context])}
-  (fn [& args] (first args)))
+  "Computes concepts with various algorithms, given as first
+  argument. Default is :next-closure."
+  {:arglists '([algorithm context] [context])}
+  (fn [& args]
+    (cond
+     (= 1 (count args)) ::default-concepts
+     (= 2 (count args)) (first args)
+     :else (illegal-argument "Wrong number of args passed to c.c.algorithms.concepts."))))
+
+(defmethod concepts ::default-concepts [context]
+  (concepts :next-closure context))

 ;; NextClosure (:next-closure)
+
+;; TODO: Sort attributes before starting (see naïve implementation of next closure)

 (defn- lectic-<_i
   ""
@@ -184,6 +195,8 @@

 ;; In-Close (:in-close)

+;; TODO: Check this, it's too slow.
+
 (defn- cannonical?
   "Implements the IsCannonical method of In-Close."
   [incidence-matrix, #^BitSet A-new, #^BitSet B, y]
@@ -237,6 +250,6 @@
 	 (persistent! Bs))))

-;; Close-by-One?, Nourine-Raynaud?, Bordat?, Lindig?, Berry? Some other fancy stuff?
+;;; Close-by-One?, Nourine-Raynaud?, Bordat?, Lindig?, Berry? Some other fancy stuff?

 nil


Add 0-ary version

Add 0-ary version

--- modules/reitit-ring/src/reitit/ring.cljc
+++ modules/reitit-ring/src/reitit/ring.cljc
@@ -120,25 +120,26 @@
   |         | :strip - redirects slashed to slash-less |
   |         | :both - works both ways (default) |
   "
-  [{:keys [method] :or {method :both}}]
-  (let [redirect-handler (fn redirect-handler [request]
-                           (let [uri (:uri request)
-                                 status (if (= (:request-method request) :get) 301 308)
-                                 maybe-redirect (fn maybe-redirect [path]
-                                                  (if (r/match-by-path (::r/router request) path)
-                                                    {:status status
-                                                     :headers {"Location" path}
-                                                     :body ""}))]
-                             (if (str/ends-with? uri "/")
-                               (if (not= method :add)
-                                 (maybe-redirect (subs uri 0 (-> uri count dec))))
-                               (if (not= method :strip)
-                                 (maybe-redirect (str uri "/"))))))]
-    (fn
-      ([request]
-       (redirect-handler request))
-      ([request respond _]
-       (respond (redirect-handler request))))))
+  ([] (redirect-trailing-slash-handler {:method :both}))
+  ([{:keys [method]}]
+   (let [redirect-handler (fn redirect-handler [request]
+                            (let [uri (:uri request)
+                                  status (if (= (:request-method request) :get) 301 308)
+                                  maybe-redirect (fn maybe-redirect [path]
+                                                   (if (r/match-by-path (::r/router request) path)
+                                                     {:status status
+                                                      :headers {"Location" path}
+                                                      :body ""}))]
+                              (if (str/ends-with? uri "/")
+                                (if (not= method :add)
+                                  (maybe-redirect (subs uri 0 (-> uri count dec))))
+                                (if (not= method :strip)
+                                  (maybe-redirect (str uri "/"))))))]
+     (fn
+       ([request]
+        (redirect-handler request))
+       ([request respond _]
+        (respond (redirect-handler request)))))))

 (defn create-default-handler
   "A default ring handler that can handle the following cases,


[scamp] Add 'handle-add-upstream and 'notify-add-upstream.

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -44,7 +44,8 @@
    :messages-seen {MessageEnvelopeIdSchema s/Int}})

 (def MessageTypeSchema
-  (s/enum :forwarded-subscription))
+  (s/enum :forwarded-subscription
+          :add-upstream))

 (def SubscriptionSchema
   NodeContactAddressSchema)
@@ -236,11 +237,30 @@
       subscription
       envelope-id]]))

-(defn handle-add-upstream
-  "Take a node (?) and a new upstream 'id, and add the upstream node to this node's :upstream."
-  ;; TODO message envelope? how to get the node here?
-  []
-  (throw (ex-info "handle-add-upstream not yet implemented" {})))
+(s/defn handle-add-upstream :- CommUpdateSchema
+  "Take a node and a new 'upstream-node-contact-address, and return a
+  vector matching CommUpdateSchema."
+  [logging-config
+   node :- NetworkedNodeSchema
+   upstream-node-contact-address :- NodeContactAddressSchema]
+  (timbre/log* logging-config :trace
+               :handle-add-upstream
+               :node node
+               :upstream-node-contact-address upstream-node-contact-address)
+  [(update node :upstream conj upstream-node-contact-address)
+   []])
+
+(s/defn notify-add-upstream :- MessageEnvelopeSchema
+  "Take a new 'upstream-node-contact-address and a 'node, and return
+  an :add-upstream message envelope for
+  'upstream-node-contact-address."
+  [node :- NetworkedNodeSchema
+   upstream-node-contact-address :- NodeContactAddressSchema]
+  [:message-envelope
+   upstream-node-contact-address
+   :add-upstream
+   (get-in node [:self :id])
+   (*get-envelope-id*)])

 (s/defn handle-forwarded-subscription :- CommUpdateSchema
   "Take a node and a new subscription, and either accept the


Removed obsolete sleep and did some more cleanup.

--- ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreationOperation.clj
+++ ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreationOperation.clj
@@ -44,12 +44,14 @@
   (:gen-class
    :implements [org.eclipse.jface.operation.IRunnableWithProgress]
    :constructors {[ccw.support.labrepl.wizards.LabreplCreateProjectPage org.eclipse.ui.dialogs.IOverwriteQuery] []}
-   :init myinit
+   :init init
    :state state))

 (def *port* 8080)
-
-(defn- -myinit
+(def *timeout* 30000)
+(def *step* 100)
+
+(defn- -init
   [pages overwrite-query]
   [[] (ref {:page pages :overwrite-query overwrite-query})])

@@ -134,7 +136,7 @@
 (defn- open-browser
 "Open a browser for the running labrepl web page"
 []
-	(if (wait-for-resource check-server 30000 100)
+	(if (wait-for-resource check-server *timeout* *step*)
    (let
 	  [browser-support (.getBrowserSupport (PlatformUI/getWorkbench))
 	   browser
@@ -190,12 +192,10 @@
                 (proxy [UIJob] ["Start Labrepl Session and Browser"]
 			            (runInUIThread [monitor]
 			              (.launch (ClojureLaunchShortcut.) startup-file-selection ILaunchManager/RUN_MODE)
-										(let [console (wait-for-resource #(ClojureClient/findActiveReplConsole) 30000 100)]
+										(let [console (wait-for-resource #(ClojureClient/findActiveReplConsole) *timeout* *step*)]
                       (if console
                         (do
 	                        (EvaluateTextAction/evaluateText console "(labrepl/-main)")
-                          ; (wait-for-server)
-                          (Thread/sleep 10000)
 										      (open-browser)
                           Status/OK_STATUS)
                         Status/CANCEL_STATUS))))]


Add different notation

Add different notation

Still works

--- src/chrome_extensions/background.cljs
+++ src/chrome_extensions/background.cljs
@@ -3,4 +3,4 @@

 (enable-console-print!)

-(.addListener (.. js/chrome -commands -onCommand) command-selector)
+(.addListener js/chrome.commands.onCommand command-selector)


ensure we don't pass nil as babel-preset-config

--- src/main/shadow/cljs/npm/babel_worker.cljs
+++ src/main/shadow/cljs/npm/babel_worker.cljs
@@ -18,11 +18,12 @@
                                              (.identifier t "global.shadow.js.babel")
                                              (.identifier t name))))}))

-(defn babel-transform [{:keys [code file preset-config] :or {preset-config {}} :as req}]
+(defn babel-transform [{:keys [code file preset-config] :as req}]
   (let [presets
         (array
-          (array
-            babel-preset-env (clj->js preset-config)))
+          (if-not preset-config
+            babel-preset-env
+            (array babel-preset-env (clj->js preset-config))))

         plugins
         #js []


rearrangements

rearrangements

--- src/clj/morpheus/models/edge/core.clj
+++ src/clj/morpheus/models/edge/core.clj
@@ -71,7 +71,6 @@
                                   (update :types regular-types)
                                   (update :directions regular-directions)))
                       params))
-        direction-fields (->> params (mapcat :directions) (set))
         expand-params (flatten (map (fn [{:keys [directions types]}]
                                         (map
                                           (fn [d]
@@ -81,6 +80,7 @@
                                           directions))
                                       params))
         params-grouped (group-by :d expand-params)
+        direction-fields (->> params-grouped (keys) (set))
         direction-types (map-on-vals
                           (fn [ps]
                             (let [t (set (map :t ps))]


Add completed attribute

Add completed attribute

--- src/clj/todo_clj/models/migration.clj
+++ src/clj/todo_clj/models/migration.clj
@@ -15,7 +15,8 @@
                         (sql/create-table-ddl
                          :todos
                          [[:id :serial "PRIMARY KEY"]
-                          [:title :text]])))
+                          [:title :text]
+                          [:completed :boolean :default :false]])))
   (println " done"))

 (defn drop-db []


fix error finding grant

fix error finding grant

--- src/clj_money/models/auth_helpers.clj
+++ src/clj_money/models/auth_helpers.clj
@@ -65,14 +65,14 @@
     (= (:user-id entity) (:id user))))

 (defn find-grant
- [user resource {storage-spec :storage-spec :as context}]
+  [user resource {storage-spec :storage-spec :as context}]
   (let [resource-type (authorization/get-resource-tag resource)
-        entity-id (lookup-entity-id context resource)
-        grant (-> (grants/search storage-spec
-                                 {:user-id (:id user)
-                                  :entity-id entity-id}
-                                 {:limit 1})
-                  first)]))
+        entity-id (lookup-entity-id context resource)]
+    (-> (grants/search storage-spec
+                       {:user-id (:id user)
+                        :entity-id entity-id}
+                       {:limit 1})
+        first)))

 (defn user-granted-access?
   [user resource action {storage-spec :storage-spec :as context}]


remove dead code

remove dead code

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -782,25 +782,7 @@

               ; update the transaction record itself
               updated (update-transaction storage validated)]
-          (reload storage validated)))
-
-        #_(let [dereferenced-base-items (process-removals
-                                        storage
-                                        validated)
-              upserted-items (->> (:items validated)
-                                  (calculate-balances-and-indexes ; TODO: This appears to be redunant with update-affected-balances, which also does the calculation
-                                    storage)
-                                  ; new items need the transaction-id added
-                                  (map #(assoc % :transaction-id (:id validated)))
-                                  (process-item-upserts storage))]
-          (->> validated
-               before-save
-               (update-transaction storage))
-          (update-affected-balances storage
-                                    (concat upserted-items
-                                            dereferenced-base-items)
-                                    (:transaction-date validated))
-          (reload storage validated)))))
+          (reload storage validated))))))

 (defn- get-preceding-items
   "Returns the items that precede each item in the


first draft of dereferenced account processing

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -1,6 +1,7 @@
 (ns clj-money.models.transactions
   (:refer-clojure :exclude [update])
   (:require [clojure.pprint :refer [pprint]]
+            [clojure.set :refer [difference]]
             [clj-time.coerce :as tc]
             [schema.core :as schema]
             [clj-money.validation :as validation]
@@ -306,6 +307,23 @@
        (map before-save-item)
        (mapv #(update-item storage %))))

+(defn- process-dereferenced-accounts
+  "Finds any accounts that used to be referenced by the transaction
+  but no longer are and recalculates balances and indexes for those
+  accounts"
+  [storage-spec transaction]
+  (let [old-trans (find-by-id storage-spec (:id transaction))
+        old-accounts (->> (:items old-trans)
+                          (map :account-id)
+                          (into #{}))
+        current-accounts (->> (:items transaction)
+                              (map :account-id)
+                              (into #{}))]
+    (->> (difference old-accounts current-accounts)
+         (map #(hash-map :account-id % :id -1)) ; fake out an item because that's what get-previous-item expects
+         (map #(get-previous-item storage-spec % (:transaction-date transaction)))
+         (update-affected-balances storage-spec))))
+
 (defn update
   "Updates the specified transaction"
   [storage-spec transaction]
@@ -315,9 +333,13 @@
       validated
       (let [items-with-balances (calculate-balances-and-indexes storage
                                                                 (:transaction-date validated)
-                                                                (:items validated))]
-        (update-affected-balances storage-spec items-with-balances (:transaction-date validated))
-        (assoc validated [:items] (process-item-updates storage items-with-balances))))))
+                                                                (:items validated))
+            _ (process-dereferenced-accounts storage validated) ; this relies on old values still being in the database
+            _ (update-affected-balances storage
+                                        items-with-balances
+                                        (:transaction-date validated))
+            processed-items (process-item-updates storage items-with-balances)]
+        (assoc validated [:items] processed-items)))))

 (defn- get-preceding-items
   "Returns the items that precede each item in the


url encode so that the param makes it to the back end un-molested

--- src/cljs/cljspazzer/client/pages.cljs
+++ src/cljs/cljspazzer/client/pages.cljs
@@ -6,10 +6,10 @@
 (def nav-seq (concat (map str "#abcdefghijklmnopqrstuvwxyz") ["all"]))

 (defn nav-item [x]
-  [:li [:a {:href (utils/format "#/nav/%s" x)} x]])
+  [:li [:a {:href (utils/format "#/nav/%s" (utils/encode x))} x]])

 (defn artist-item [x]
-  [:li [:a {:href (utils/format "#/artists/%s" x)} x]])
+  [:li [:a {:href (utils/format "#/artists/%s" (utils/encode x))} x]])

 (defn album-item [x]
   [:li (utils/format "%s - (%s)" (x "album_canonical") (x "year"))])


Repeatedly call the same query a number of times and save all plans

--- src/ambig_index_finder/core.clj
+++ src/ambig_index_finder/core.clj
@@ -7,19 +7,37 @@
                 (slurp
                   (environ/env :db-config-file))))

-(defn- compare-query [db-spec id sample-sizes]
+(defn- repeat-query [db-spec id repetitions sample-size]
+  (do
+    (log/debug "Query" id "will be repeated" repetitions "times")
+    (repeatedly
+      repetitions
+      #(queries/sample-and-query db-spec id sample-size))))
+
+(defn- compare-query [db-spec id repetitions sample-sizes]
   (let [sample-size (first sample-sizes)
         r (rest sample-sizes)
-        result (queries/sample-and-query db-spec id sample-size)]
+        results (repeat-query db-spec id repetitions sample-size)
+        key-val [(keyword (str "sample-" sample-size)) results]]
     (do
-      (log/info "Sampling with" sample-size "for query with id" id)
-      (log/info result)
+      (log/debug "Sampling with" sample-size "for query with id" id)
+      (log/debug results)
       (if (empty? r)
-        [result]
-        (cons result
-              (compare-query db-spec id r))))))
+        (seq [key-val])
+        (cons
+          key-val
+          (compare-query db-spec id repetitions r))))))
+
+(defn evaluate-query [db-name query-id repetitions sample-sizes]
+  (do
+    (log/info "Evaluating query" query-id "for db" db-name "repeating" repetitions "times, with sample sizes" sample-sizes)
+    (into {} (compare-query (db-name db-specs)
+                            query-id
+                            repetitions
+                            sample-sizes))))

 (defn -main []
-  (compare-query (:postgresql db-specs) "1a" [1 10 100]))
+  (let [result (evaluate-query :postgresql "1a" 2 [1 2])]
+    (log/debug result)))

 ; postmaster -D /usr/local/var/postgres


get-lines function

get-lines function

--- saas-dsl/src/saas_dsl/parse.clj
+++ saas-dsl/src/saas_dsl/parse.clj
@@ -1,3 +1,9 @@
 (ns sass-dsl.parse
   (:require [clojure.zip :as zip]
             [clojure.string :refer [split] :as str]))
+
+(defn get-lines
+  "Tokenise the input into lines."
+  [input-str]
+  (:pre [(= (class input-str) java.lang.String)])
+  (split input-str #"\n+"))


start working on markdown editor

start working on markdown editor


Ok, now I should really try to do something instead of barely staring... so go and try to do something with Clojure or simply move on

--- src/fpinscala/purely_functional_state.clj
+++ src/fpinscala/purely_functional_state.clj
@@ -120,10 +120,10 @@
   "Generates list of random integers - fpins variant 2 - TAIL RECURSIVE - outcome is reversed though but apparently it does not matter"
   [n rng]
   (letfn [(go [cnt r xs]
-              (if (zero? cnt)
-                [xs r]
-                (from-rng (r) :let [x r2]
-                          (go (dec cnt) r2 (cons x xs)))))]
+            (if (zero? cnt)
+              [xs r]
+              (from-rng (r) :let [x r2]
+                        (go (dec cnt) r2 (cons x xs)))))]
     (go n rng '())))
 ;-----------------------------------------------------------------------

@@ -185,9 +185,9 @@
   [fs]
   (reduce                                                   ;check out comment below to see why I've used reduce instead of fold-right
     #(map2-rng % %2 (fn [a b]
-                       (if (vector? a)
-                         (conj a b)
-                         [a b])))
+                      (if (vector? a)
+                        (conj a b)
+                        [a b])))
     (first fs)
     (rest fs)))
 ;I am using reduce because my fold-right from strictness-and-laziness is not proper scala translation
@@ -201,7 +201,7 @@
   [fs]
   (fpinscala.strictness-and-laziness/fold-right             ;Notice that this variant is using fold-right
     (unit '())                                              ;Check out that "unit-produced" function is used as z value (now - it wouldn't be really
-    #(map2-rng % %2 (fn [a b] (cons a b)))                 ;correct to say it is "initial" but rather neutral (or terminating?) element
+    #(map2-rng % %2 (fn [a b] (cons a b)))                  ;correct to say it is "initial" but rather neutral (or terminating?) element
     fs))
 ;THIS WORKS!!! - THUS IN TERMS OF FPINS (AS FAR AS I UNDERSTOOD) Z IS UNIT/NEUTRAL ELEMENT

@@ -218,7 +218,7 @@
   "flatMap for exercise 6.8 from FPINS"
   [f g]
   #(from-rng (f %) :let [n rng2]
-            ((g n) rng2)))
+             ((g n) rng2)))

 ;nonNegativeLessThan via flatMap
 (defn non-negative-less-than
@@ -305,7 +305,7 @@
   "flatMap for exercise 6.8 from FPINS but generalized to state for exercise 6.10"
   [f g]
   #(from-state (f %) :let [v s]
-             ((g v) s)))
+               ((g v) s)))

 (defn unit-state
   "Generalized Unit function from section 6.5 of fpins"
@@ -325,10 +325,10 @@
   "sequence function for exercise 6.7 FPINS variant"
   [fs]
   (fpinscala.strictness-and-laziness/fold-right             ;Notice that this variant is using fold-right
-    (unit-state '())                                              ;Check out that "unit-produced" function is used as z value (now - it wouldn't be really
-    #(map2-via-flat-map-s % %2 (fn [a b] (cons a b)))                 ;correct to say it is "initial" but rather neutral (or terminating?) element
+    (unit-state '())                                        ;Check out that "unit-produced" function is used as z value (now - it wouldn't be really
+    #(map2-via-flat-map-s % %2 (fn [a b] (cons a b)))       ;correct to say it is "initial" but rather neutral (or terminating?) element
     fs))                                                    ;UPDATE (25.11.2015) Check out wikipedia about monad, it is actually "return" also
-                                                            ;called "unit" operation of a monad
+;called "unit" operation of a monad

 (declare simple-rng-s)

@@ -353,9 +353,9 @@
   "FPINS variant of non-negative-int function, adapted to 'state' variant - haha - and I was thinking: Adding one is way too simple :)"
   [rng]
   (from-state (rng) :let [n nxt-rng]
-            (if (< n 0)
-              (make-state (- (inc n)) nxt-rng)
-              (make-state n nxt-rng))))
+              (if (< n 0)
+                (make-state (- (inc n)) nxt-rng)
+                (make-state n nxt-rng))))

 ;usage example
 ((state-sequence-fpins (repeat 5 non-negative-int-fpins-s)) (make-simple-rng-s 42))
@@ -374,14 +374,16 @@
 ;here - I try to mimic get, set and modify of FPINS/6.6
 (def get-state (fn [s] (make-state s s)))
 (def set-state (fn [s] (make-state nil s)))
-;(def modify-state (fn [s f]
-;                    (for [])))
+(def modify-state (fn [s f]
+                    (for [v (get-state s)
+                          ns (set-state (f v))]
+                      ns)))

 ;here is step-machine function from Runar Bjarnasson's explanation of 6.1 on fpins google group
 ;it is using core.match as writing with if, cond etc would make it ridiculously complex

 (defn machine [locked candies coins]
-         {:locked locked :candies candies :coins coins})
+  {:locked locked :candies candies :coins coins})

 (defn step-machine
   "inputs is sequence of either coins or turns, s is 'machine' in focus"
@@ -395,3 +397,5 @@
          [:turn {:locked false :candies candies :coins coins}]
          (machine true (dec candies) coins)))

+
+


Implement hash

Implement hash


Added genome_gene_replace instruction.

Added genome_gene_replace instruction.

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -54,6 +54,29 @@
       state)))

 (define-registered
+  genome_gene_replace
+  ^{:stack-types [:genome :integer]}
+  (fn [state]
+    (if (and (not (empty? (rest (:integer state))))
+             (not (empty? (:genome state)))
+             (not (empty? (stack-ref :genome 0 state))))
+      (let [genome (stack-ref :genome 0 state)
+            index (mod (stack-ref :integer 0 state) (count genome))
+            atom-gen (mod (stack-ref :integer 1 state) (count @global-atom-generators))]
+        (->> (pop-item :integer state)
+             (pop-item :integer)
+             (pop-item :genome)
+             (push-item (assoc genome
+                          index
+                          (random-plush-instruction-map
+                                    [(nth @global-atom-generators atom-gen)]
+                                    {:epigenetic-markers @global-epigenetic-markers
+                                     :close-parens-probabilities @global-close-parens-probabilities
+                                     :silent-instruction-probability @global-silent-instruction-probability}))
+                        :genome)))
+      state)))
+
+(define-registered
   genome_gene_delete
   ^{:stack-types [:genome :integer]}
   (fn [state]


add comment

add comment

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -182,7 +182,7 @@
                              {:rule "intensifier-phrase"
                               :synsem head-synsem}))

-                   ;; nbar where noun is first ('h' in h11)
+                   ;; nbar where head (noun) is first ('h' in h11)
                    (unifyc h11-comp-subcat-1
                            (let [is-propernoun? (atom :top)
                                  head-synsem {:cat :noun
@@ -197,7 +197,7 @@
                               :rule "nbar1"
                               :synsem head-synsem}))

-                   ;; nbar where adjective is first ('c' in c11)
+                   ;; nbar where complement (adjective) is first ('c' in c11)
                    (unifyc c11-comp-subcat-1
                            (let [is-propernoun? (atom :top)
                                  head-synsem {:cat :noun
@@ -207,7 +207,7 @@
                                      :synsem {:cat :adjective
                                               :mod head-synsem}}
                               :head {:phrasal false
-                                     :synsem {:modified false ;; TODO: document what purpose :modified serves (if any: if none, remove).
+                                     :synsem {:modified false ;; rathole prevention: as above, try to remove if possible
                                               :propernoun is-propernoun?}}
                               :rule "nbar2"
                               :synsem head-synsem}))


s/tokenization/tokens/

s/tokenization/tokens/

--- src/babel/italiano/workbook.clj
+++ src/babel/italiano/workbook.clj
@@ -74,7 +74,7 @@
   ([input model]
    (cond (string? input)
          (map (fn [tokenization]
-                {:tokenization tokenization
+                {:tokens tokenization
                  :parses (parse tokenization model)})
               (analyze-tokens input))


CMR-2383: Updated test.

CMR-2383: Updated test.

--- system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -527,7 +527,7 @@
       ;; Once we implemented organizations in umm-spec-lib and switched indexer to use it,
       ;; Some of the tests may need to be updated.
       (d/ingest "PROV1"
-                (dc/collection-dif10
+                (dc/collection-dif
                   {:short-name "S-DIF9"
                    :organizations [distribution-org distribution-org-1]})
                 {:format :dif})


Try to read all records from the realtime cache first

Try to read all records from the realtime cache first

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -659,6 +659,15 @@

+(defn get-record-from-server-cache-for-table  [db-table   id]
+  (let [table-atom     (get @server-side-cached-records  db-table)
+        record-atom    (if table-atom (get @table-atom  id))
+        ]
+    (do
+      (if record-atom  @record-atom nil))))
+
+
+

@@ -671,29 +680,50 @@
   )

-(defn get-record [db-table id fields realtime]
-  (if realtime
-    (do
-      (create-record-cache-for-table  db-table)
-    ))
-
-  (sql-1
-   (str
-    "select "
-    (fields-to-str fields) " "
-    "from "
-    db-table " "
-    "where id = ? "
-    (cond
-     (= *database-type* "postgres" )
-     " limit 1"
-
-     (= *database-type* "oracle" )
-     ""
-     )
-
-
-    ) [id]))
+
+
+
+
+(defn get-record
+  ([db-table id fields]
+   (sql-1
+    (str
+     "select "
+     (fields-to-str fields) " "
+     "from "
+     db-table " "
+     "where id = ? "
+     (cond
+      (= *database-type* "postgres" )
+      " limit 1"
+
+      (= *database-type* "oracle" )
+      ""
+      )
+
+
+     ) [id]))
+
+
+
+  ([db-table id fields realtime]
+   (if realtime
+     (do
+       (create-record-cache-for-table  db-table)
+       (let [cached-record (get-record-from-server-cache-for-table  db-table   id)]
+         (if (not cached-record)
+           (let [record (get-record    db-table id fields)]
+             nil
+             )
+           )
+         )))
+
+   (get-record    db-table id fields))
+  )
+
+
+
+


fix zero executors

fix zero executors

--- src/clj/backtype/storm/util.clj
+++ src/clj/backtype/storm/util.clj
@@ -705,7 +705,7 @@

 (defn partition-fixed [max-num-chunks aseq]
   (if (zero? max-num-chunks)
-    (throw (IllegalArgumentException. "Cannot partition into zero chunks"))
+    []
     (let [chunks (->> (integer-divided (count aseq) max-num-chunks)
                       (#(dissoc % 0))
                       (sort-by (comp - first))


server.clj - redirect / to index.html

server.clj - redirect / to index.html

So we do not have to type the additional /index.html

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

--- src/clj/cljs_nusmods/server.clj
+++ src/clj/cljs_nusmods/server.clj
@@ -1,10 +1,11 @@
 (ns cljs-nusmods.server
   (:use compojure.core)
   (:require [compojure.handler :as handler]
-            [compojure.route :as route]))
+            [compojure.route :as route]
+            [ring.util.response :as resp]))

 (defroutes app-routes
-  (GET "/" [] "
Hello World
")
+  (GET "/" [] (resp/redirect "index.html"))
   (route/resources "/"))

 (def app


Make refresh! thread-safe, add remaining ATerminal fns

--- src/clj/robinson/glterminal.clj
+++ src/clj/robinson/glterminal.clj
@@ -11,17 +11,15 @@
   (:import
     (java.lang.reflect Field)
     (java.awt Color
-              BorderLayout
               Canvas
               Color
               Font
               FontMetrics
               Graphics
-              RenderingHints Toolkit)
-    (java.awt.event InputEvent
-                    KeyListener
-                    KeyEvent)
-    (org.lwjgl BufferUtils)
+              Image
+              RenderingHints)
+    (java.awt.event KeyEvent)
+    (org.lwjgl BufferUtils LWJGLUtil)
     (java.nio FloatBuffer ByteBuffer)
     (org.lwjgl.opengl Display ContextAttribs
                       PixelFormat DisplayMode
@@ -30,10 +28,9 @@
     (org.lwjgl.util.vector Matrix4f Vector3f)
     (java.io File)
     (java.awt.image BufferedImage DataBufferByte)
-    (robinson.aterminal ATerminal)))
-
-(def char-width 9)
-(def char-height 16)
+    (javax.imageio ImageIO)
+    (robinson.aterminal ATerminal))
+  (:gen-class))

 (set! *warn-on-reflection* true)
 (set! *unchecked-math* true)
@@ -160,13 +157,14 @@
           character-idxs))

 (defn make-glyph-image
-  [normal-font]
+  [char-width char-height normal-font]
   ;; Adjust canvas to fit character atlas size
   (let [cwidth  (next-pow-2 (* char-width (int (inc (Math/sqrt (count characters))))))
         cheight (next-pow-2 (* char-height (int (inc (Math/sqrt (count characters))))))
         width   (max cwidth cheight)
         height  (max cwidth cheight)
-        antialias true]
+        antialias true
+        font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) @normal-font)]
     (log/info "glyph image width" width "height" height)
     (let [texture-image    (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
           texture-graphics ^Graphics (.getGraphics texture-image)
@@ -184,14 +182,14 @@
       (doseq [[[s underline?] col row]  character-idxs]
         (let [x ^int (* col char-width)
               y ^int (* (inc row) char-height)
-              #_#_cx (+ 0 x)
-              #_#_cy (+ 12 y)]
+              cx (+ 1 x)
+              cy (- y (.getDescent font-metrics))]
           ;(log/info s x y)
         (when (not= s " ")
           ;(println "drawing" s "@" x y "underline?" underline?)
           (doto texture-graphics
             (.setColor white)
-            (.drawString (str s) x y)))
+            (.drawString (str s) cx cy)))
         (when underline?
           (let [y (dec y)]
             (doto texture-graphics
@@ -207,30 +205,36 @@
        :font-texture-height height
        :font-texture-image texture-image})))

+
+(defn- buffered-image-byte-buffer [buffered-image]
+  (let [width          (.getWidth buffered-image)
+        height         (.getHeight buffered-image)
+        texture-buffer (BufferUtils/createByteBuffer (* width height 4))
+        data (-> buffered-image
+                 (.getRaster)
+                 (.getDataBuffer)
+                 (as-> db (cast DataBufferByte db))
+                 (.getData))]
+    (.put texture-buffer data 0 (alength data))
+    (.flip texture-buffer)
+    texture-buffer))
+
 (defn- texture-id
   ([buffered-image]
   (let [width (.getWidth buffered-image)
-        height (.getHeight buffered-image)
-        texture-buffer (BufferUtils/createByteBuffer (* width height 4))
-        data (-> buffered-image
-               (.getRaster)
-               (.getDataBuffer)
-               (as-> db (cast DataBufferByte db))
-               (.getData))]
-    (.put texture-buffer data 0 (alength data))
-    (.flip texture-buffer)
-    (texture-id width height texture-buffer)))
+        height (.getHeight buffered-image)]
+    (texture-id width height (buffered-image-byte-buffer buffered-image))))
   ([width height]
    (texture-id width height (BufferUtils/createByteBuffer (* width height 4))))
   ([^long width ^long height ^ByteBuffer texture-buffer]
    (let [texture-id (GL11/glGenTextures)]
-      ;;(.order texture-buffer (ByteOrder/nativeOrder))
-      (GL11/glBindTexture GL11/GL_TEXTURE_2D texture-id)
-      (GL11/glPixelStorei GL11/GL_UNPACK_ALIGNMENT 1)
-      (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MIN_FILTER GL11/GL_NEAREST)
-      (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MAG_FILTER GL11/GL_NEAREST)
-      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA width height 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE texture-buffer)
-      texture-id)))
+     ;;(.order texture-buffer (ByteOrder/nativeOrder))
+     (GL11/glBindTexture GL11/GL_TEXTURE_2D texture-id)
+     (GL11/glPixelStorei GL11/GL_UNPACK_ALIGNMENT 1)
+     (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MIN_FILTER GL11/GL_NEAREST)
+     (GL11/glTexParameteri GL11/GL_TEXTURE_2D GL11/GL_TEXTURE_MAG_FILTER GL11/GL_NEAREST)
+     (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA width height 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE texture-buffer)
+     texture-id)))

 (defn- get-fields [#^Class static-class]
   (. static-class getFields))
@@ -251,6 +255,33 @@
                           (gl-enum-name error) ": " msg)]
     (if (not (zero? error))
       (throw (Exception. error-string)))))
+
+(defn scale-image [buffered-image width height]
+  (let [toolkit-image (.getScaledInstance buffered-image width height Image/SCALE_SMOOTH)
+        width         (.getWidth toolkit-image nil)
+        height        (.getHeight toolkit-image nil)
+        scaled-image  (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
+        g             (.getGraphics scaled-image)]
+    (.drawImage g toolkit-image 0, 0, nil)
+    (.dispose g)
+    scaled-image))
+
+(defn- init-display [title screen-width screen-height]
+  (let [pixel-format       (PixelFormat.)
+        context-attributes (ContextAttribs. 2 1)
+        icon-image         (ImageIO/read (File. "images/icon.png"))
+        icon-image-16      (scale-image icon-image 16,  -1)
+        icon-image-32      (scale-image icon-image 32,  -1)
+        icon-image-128     (scale-image icon-image 128, -1)
+        icon-array         (make-array ByteBuffer 3)]
+     (aset icon-array 0 (buffered-image-byte-buffer icon-image-16))
+     (aset icon-array 1 (buffered-image-byte-buffer icon-image-32))
+     (aset icon-array 2 (buffered-image-byte-buffer icon-image-128))
+     (Display/setDisplayMode (DisplayMode. screen-width screen-height))
+     (Display/setTitle title)
+     (Display/create pixel-format context-attributes)
+     (Display/setIcon icon-array)
+     (GL11/glViewport 0 0 screen-width screen-height)))

 (defn- load-shader
   [^String shader-str ^Integer shader-type]
@@ -360,17 +391,24 @@
 ;; Normally this would be a record, but until http://dev.clojure.org/jira/browse/CLJ-1224 is fixed
 ;; it is not performant to memoize records because hashCode values are not cached and are recalculated
 ;; each time.
+
+(defrecord GLCharacter [character fg-color bg-color style fx-character fx-fg-color fg-bg-color])
 (defn make-terminal-character
-  [character fg-color bg-color style]
-  {:character character
+  ([character fg-color bg-color style]
+   (make-terminal-character character fg-color bg-color style nil nil nil))
+  ([character fg-color bg-color style fx-character fx-fg-color fg-bg-color]
+   (GLCharacter. character fg-color bg-color style fx-character fx-fg-color fg-bg-color)))
+  #_{:character character
    :fg-color  fg-color
    :bg-color  bg-color
-   :style     style})
+   :style     style}

 (defrecord OpenGlTerminal [^int columns
                            ^int rows
                            ^int texture-columns
                            ^int texture-rows
+                           normal-font
+                           antialias
                            character-map-cleared
                            character-map
                            cursor-xy
@@ -382,7 +420,7 @@
   ;; characters is a list of {:c \character :x col :y row :fg [r g b] :bg [r g b]}
   (put-chars! [_ characters]
     #_(log/info "characters" (str characters))
-    (swap! character-map
+    (alter character-map
            (fn [cm]
              (reduce (fn [cm [row row-characters]]
                        (if (< -1 row rows)
@@ -405,157 +443,190 @@
                      cm
                      (group-by :y characters))))
     #_(log/info "character-map" (str @character-map)))
+  (set-fg! [_ x y fg]
+    (let [fg-color  (Color. (long (fg 0)) (long (fg 1)) (long (fg 2)))]
+      (alter character-map
+             (fn [cm] (assoc-in cm [y x :fg-color] fg-color)))))
+  (set-bg! [_ x y bg]
+    (let [bg-color  (Color. (long (bg 0)) (long (bg 1)) (long (bg 2)))]
+      (alter character-map
+             (fn [cm] (assoc-in cm [y x :bg-color] bg-color)))))
   (get-key-chan [_]
     key-chan)
+  (apply-font! [_ windows-font else-font size smooth]
+    (reset! normal-font
+            (if (= (LWJGLUtil/getPlatform) LWJGLUtil/PLATFORM_WINDOWS)
+              (make-font windows-font Font/PLAIN size)
+              (make-font else-font Font/PLAIN size)))
+    (reset! antialias smooth))
   (set-cursor! [_ xy]
     (reset! cursor-xy xy))
-  (refresh! [_]
-    (GL11/glClearColor 0.0 0.0 1.0 1.0)
-    (let [{{:keys [vao-id vertices-vbo-id vertices-count texture-coords-vbo-id]} :buffers
-           {:keys [font-texture glyph-texture fg-texture bg-texture]} :textures
-           program-id :program-id
-           {:keys [u-MVMatrix u-PMatrix u-font u-glyphs u-fg u-bg font-size term-dim font-tex-dim
-            font-texture-width font-texture-height glyph-tex-dim glyph-texture-width glyph-texture-height ]} :uniforms
-           {:keys [^ByteBuffer glyph-image-data
-                   ^ByteBuffer fg-image-data
-                   ^ByteBuffer bg-image-data]} :data
-           :keys [p-matrix-buffer mv-matrix-buffer]} gl
-          glyph-image-data glyph-image-data
-          fg-image-data fg-image-data
-          bg-image-data bg-image-data]
-
-      (GL20/glUseProgram program-id)
-      (GL20/glUniformMatrix4 u-PMatrix false p-matrix-buffer)
-      (GL20/glUniformMatrix4 u-MVMatrix false mv-matrix-buffer)
-      ; Setup vertex buffer
-      (GL15/glBindBuffer GL15/GL_ARRAY_BUFFER, vertices-vbo-id)
-      (except-gl-errors (str "vbo bind - glBindBuffer" vertices-vbo-id))
-      (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute)
-      (except-gl-errors "vbo bind - glEnableVertexAttribArray")
-      (GL20/glVertexAttribPointer 0 3 GL11/GL_FLOAT false 0 0)
-      (except-gl-errors "vbo bind - glVertexAttribPointer")
-      ; Setup uv buffer
-      (GL15/glBindBuffer GL15/GL_ARRAY_BUFFER, texture-coords-vbo-id)
-      (GL20/glEnableVertexAttribArray 1);texture-coords-vertex-attribute)
-      (GL20/glVertexAttribPointer 1 2 GL11/GL_FLOAT false 0 0)
-      (except-gl-errors "texture coords bind")
-      ; Setup font texture
-      (GL13/glActiveTexture GL13/GL_TEXTURE0)
-      (GL11/glBindTexture GL11/GL_TEXTURE_2D font-texture)
-      (GL20/glUniform1i u-font, 0)
-      (except-gl-errors "font texture bind")
-      ; Setup uniforms for glyph, fg, bg, textures
-      (GL20/glUniform1i u-glyphs 1)
-      (GL20/glUniform1i u-fg 2)
-      (GL20/glUniform1i u-bg 3)
-      (except-gl-errors "uniformli bind")
-      (GL20/glUniform2f font-size, char-width char-height)
-      (GL20/glUniform2f term-dim columns rows)
-      (GL20/glUniform2f font-tex-dim font-texture-width font-texture-height)
-      (GL20/glUniform2f glyph-tex-dim glyph-texture-width glyph-texture-height)
-      (except-gl-errors "uniform2f bind")
-      (GL11/glDisable GL13/GL_SAMPLE_COVERAGE)
-      (GL11/glDisable GL11/GL_BLEND)
-      (GL11/glDisable GL11/GL_CULL_FACE)
-      (GL11/glDisable GL11/GL_STENCIL_TEST)
-      (GL11/glEnable GL11/GL_DITHER)
-      (GL11/glDisable GL11/GL_SCISSOR_TEST)
-      (GL11/glDisable GL11/GL_DEPTH_TEST)
-      (GL11/glDisable GL11/GL_POLYGON_OFFSET_FILL)
-      (GL11/glDisable GL13/GL_SAMPLE_ALPHA_TO_COVERAGE)
-      (except-gl-errors "gl(en/dis)able")
-      #_#_glyph-data       (.-data glyph-image-data)
-      #_#_fg-data          (.-data fg-image-data)
-      #_#_bg-data          (.-data bg-image-data)
-      ;; Update glyph texture in memory
-      (.clear glyph-image-data)
-      (.clear fg-image-data)
-      (.clear bg-image-data)
-      (doseq [row (range rows)
-              col (range columns)]
-        (let [c         (get-in @character-map [row col])
-              chr       (get c :character)
-              highlight (= @cursor-xy [col row])
-              [fg-r fg-g fg-b] (if highlight
-                                 (get c :bg-color)
-                                 (get c :fg-color))
-              [bg-r bg-g bg-b] (if highlight
-                                 (get c :fg-color)
-                                 (get c :bg-color))
-              ;s         (str (get c :character))
-              style     (get c :style)
-              i         (* 4 (+ (* texture-columns row) col))
-              [x y]     (get character->col-row [chr (contains? style :underline)])]
-          ;(log/info "Drawing at col row" col row "character from atlas col row" x y c "(index=" i ")")
-          (when (zero? col)
-            (.position glyph-image-data i)
-            (.position fg-image-data i)
-            (.position bg-image-data i))
-          (.put glyph-image-data (unchecked-byte x))
-          (.put glyph-image-data (unchecked-byte y))
-          (.put glyph-image-data (unchecked-byte 0))
-          (.put glyph-image-data (unchecked-byte 0))
-          (.put fg-image-data    (unchecked-byte fg-r))
-          (.put fg-image-data    (unchecked-byte fg-g))
-          (.put fg-image-data    (unchecked-byte fg-b))
-          (.put fg-image-data    (unchecked-byte 0))
-          (.put bg-image-data    (unchecked-byte bg-r))
-          (.put bg-image-data    (unchecked-byte bg-g))
-          (.put bg-image-data    (unchecked-byte bg-b))
-          (.put bg-image-data    (unchecked-byte 0))))
-      (.position glyph-image-data (.limit glyph-image-data))
-      (.position fg-image-data (.limit fg-image-data))
-      (.position bg-image-data (.limit bg-image-data))
-      (.flip glyph-image-data)
-      (.flip fg-image-data)
-      (.flip bg-image-data)
-      ; Send updated glyph texture to gl
-      (GL13/glActiveTexture GL13/GL_TEXTURE1)
-      (GL11/glBindTexture GL11/GL_TEXTURE_2D glyph-texture)
-      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE glyph-image-data)
-      (except-gl-errors "glyph texture data")
-      ; Send updated fg texture to gl
-      (GL13/glActiveTexture GL13/GL_TEXTURE2)
-      (GL11/glBindTexture GL11/GL_TEXTURE_2D fg-texture)
-      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE fg-image-data)
-      (except-gl-errors "fg color texture data")
-      ; Send updated bg texture to gl
-      (GL13/glActiveTexture GL13/GL_TEXTURE3)
-      (GL11/glBindTexture GL11/GL_TEXTURE_2D bg-texture)
-      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bg-image-data)
-      (GL11/glDrawArrays GL11/GL_TRIANGLE_STRIP 0 vertices-count)
-      (except-gl-errors "bg color texture data")
-      (except-gl-errors "end of refresh")
-      ;(Display/sync 60)
-      (Display/update)))
+  (refresh! [this]
+    (locking this
+      (Display/makeCurrent)
+      (GL11/glClearColor 0.0 0.0 1.0 1.0)
+      (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
+      (let [{{:keys [vertices-vbo-id vertices-count texture-coords-vbo-id]} :buffers
+             {:keys [font-texture glyph-texture fg-texture bg-texture]} :textures
+             program-id :program-id
+             {:keys [u-MVMatrix u-PMatrix u-font u-glyphs u-fg u-bg font-size term-dim font-tex-dim
+              font-texture-width font-texture-height glyph-tex-dim glyph-texture-width glyph-texture-height]} :uniforms
+             {:keys [^ByteBuffer glyph-image-data
+                     ^ByteBuffer fg-image-data
+                     ^ByteBuffer bg-image-data]} :data
+             :keys [p-matrix-buffer mv-matrix-buffer char-width char-height]} gl
+            glyph-image-data glyph-image-data
+            fg-image-data fg-image-data
+            bg-image-data bg-image-data]
+
+        (GL20/glUseProgram program-id)
+        (GL20/glUniformMatrix4 u-PMatrix false p-matrix-buffer)
+        (GL20/glUniformMatrix4 u-MVMatrix false mv-matrix-buffer)
+        ; Setup vertex buffer
+        (GL15/glBindBuffer GL15/GL_ARRAY_BUFFER, vertices-vbo-id)
+        (except-gl-errors (str "vbo bind - glBindBuffer" vertices-vbo-id))
+        (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute)
+        (except-gl-errors "vbo bind - glEnableVertexAttribArray")
+        (GL20/glVertexAttribPointer 0 3 GL11/GL_FLOAT false 0 0)
+        (except-gl-errors "vbo bind - glVertexAttribPointer")
+        ; Setup uv buffer
+        (GL15/glBindBuffer GL15/GL_ARRAY_BUFFER, texture-coords-vbo-id)
+        (GL20/glEnableVertexAttribArray 1);texture-coords-vertex-attribute)
+        (GL20/glVertexAttribPointer 1 2 GL11/GL_FLOAT false 0 0)
+        (except-gl-errors "texture coords bind")
+        ; Setup font texture
+        (GL13/glActiveTexture GL13/GL_TEXTURE0)
+        (GL11/glBindTexture GL11/GL_TEXTURE_2D font-texture)
+        (GL20/glUniform1i u-font, 0)
+        (except-gl-errors "font texture bind")
+        ; Setup uniforms for glyph, fg, bg, textures
+        (GL20/glUniform1i u-glyphs 1)
+        (GL20/glUniform1i u-fg 2)
+        (GL20/glUniform1i u-bg 3)
+        (except-gl-errors "uniformli bind")
+        (GL20/glUniform2f font-size, char-width char-height)
+        (GL20/glUniform2f term-dim columns rows)
+        (GL20/glUniform2f font-tex-dim font-texture-width font-texture-height)
+        (GL20/glUniform2f glyph-tex-dim glyph-texture-width glyph-texture-height)
+        (except-gl-errors "uniform2f bind")
+        (except-gl-errors "gl(en/dis)able")
+        #_#_glyph-data       (.-data glyph-image-data)
+        #_#_fg-data          (.-data fg-image-data)
+        #_#_bg-data          (.-data bg-image-data)
+        ;; Update glyph texture in memory
+        (.clear glyph-image-data)
+        (.clear fg-image-data)
+        (.clear bg-image-data)
+        (doseq [[row line] (map-indexed vector @character-map)
+                [col c] (map-indexed vector line)]
+          (let [;c         (get-in @character-map [row col])
+                chr       (get c :character)
+                highlight (= @cursor-xy [col row])
+                [fg-r fg-g fg-b] (if highlight
+                                   (get c :bg-color)
+                                   (get c :fg-color))
+                [bg-r bg-g bg-b] (if highlight
+                                   (get c :fg-color)
+                                   (get c :bg-color))
+                ;s         (str (get c :character))
+                style     (get c :style)
+                i         (* 4 (+ (* texture-columns row) col))
+                [x y]     (get character->col-row [chr (contains? style :underline)])]
+            ;(log/info "Drawing at col row" col row "character from atlas col row" x y c "(index=" i ")")
+            (when (zero? col)
+              (.position glyph-image-data i)
+              (.position fg-image-data i)
+              (.position bg-image-data i))
+            (.put glyph-image-data (unchecked-byte x))
+            (.put glyph-image-data (unchecked-byte y))
+            (.put glyph-image-data (unchecked-byte 0))
+            (.put glyph-image-data (unchecked-byte 0))
+            (.put fg-image-data    (unchecked-byte fg-r))
+            (.put fg-image-data    (unchecked-byte fg-g))
+            (.put fg-image-data    (unchecked-byte fg-b))
+            (.put fg-image-data    (unchecked-byte 0))
+            (.put bg-image-data    (unchecked-byte bg-r))
+            (.put bg-image-data    (unchecked-byte bg-g))
+            (.put bg-image-data    (unchecked-byte bg-b))
+            (.put bg-image-data    (unchecked-byte 0))))
+        (.position glyph-image-data (.limit glyph-image-data))
+        (.position fg-image-data (.limit fg-image-data))
+        (.position bg-image-data (.limit bg-image-data))
+        (.flip glyph-image-data)
+        (.flip fg-image-data)
+        (.flip bg-image-data)
+        ; Send updated glyph texture to gl
+        (GL13/glActiveTexture GL13/GL_TEXTURE1)
+        (GL11/glBindTexture GL11/GL_TEXTURE_2D glyph-texture)
+        (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE glyph-image-data)
+        (except-gl-errors "glyph texture data")
+        ; Send updated fg texture to gl
+        (GL13/glActiveTexture GL13/GL_TEXTURE2)
+        (GL11/glBindTexture GL11/GL_TEXTURE_2D fg-texture)
+        (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE fg-image-data)
+        (except-gl-errors "fg color texture data")
+        ; Send updated bg texture to gl
+        (GL13/glActiveTexture GL13/GL_TEXTURE3)
+        (GL11/glBindTexture GL11/GL_TEXTURE_2D bg-texture)
+        (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGBA texture-columns texture-rows 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bg-image-data)
+        (GL11/glDrawArrays GL11/GL_TRIANGLE_STRIP 0 vertices-count)
+        (except-gl-errors "bg color texture data")
+        (except-gl-errors "end of refresh")
+        ;(Display/sync 60)
+        (Display/update)
+        (Display/releaseContext))))
   (clear! [_]
-    (reset! character-map character-map-cleared)))
+    (ref-set character-map character-map-cleared))
+  (set-fx-fg! [_ x y fg]
+    (let [fg-color  (when fg (Color. (long (fg 0)) (long (fg 1)) (long (fg 2))))]
+      (alter character-map
+             (fn [cm] (assoc-in cm [y x :fx-fg-color] fg-color)))))
+  (set-fx-bg! [_ x y bg]
+    (let [bg-color  (when bg (Color. (long (bg 0)) (long (bg 1)) (long (bg 2))))]
+      (alter character-map
+             (fn [cm] (assoc-in cm [y x :fx-bg-color] bg-color)))))
+  (set-fx-char! [_ x y c]
+    (alter character-map
+           (fn [cm] (assoc-in cm [y x :fx-character] c))))
+  (clear-fx! [_]
+    (alter character-map
+           (fn [cm]
+             (mapv (fn [line]
+                     (mapv (fn [c]
+                             (assoc c :fx-fg-color nil
+                                      :fx-bg-color nil
+                                      :fx-character nil))
+                           line))
+                   cm)))))

 (defn make-terminal
   ([]
-    (make-terminal 80 24))
-  ([columns rows]
-   (make-terminal columns rows nil))
-  ([columns rows  on-key-fn]
-    (make-terminal columns rows on-key-fn "Courier New" "Monospaced" 14))
-  ([columns rows on-key-fn windows-font else-font font-size]
-    (let [title            "Robinson"
-          is-windows       (>= (.. System (getProperty "os.name" "") (toLowerCase) (indexOf "win")) 0)
+    (make-terminal "" 80 24))
+  ([title columns rows]
+   (make-terminal title columns rows [255 255 255] [0 0 0]))
+  ([title columns rows default-fg-color default-bg-color]
+   (make-terminal title columns rows default-fg-color default-bg-color nil))
+  ([title columns rows default-fg-color default-bg-color on-key-fn]
+    (make-terminal title columns rows default-fg-color default-bg-color on-key-fn "Courier New" "Monospaced" 16 true))
+  ([title columns rows default-fg-color  default-bg-color on-key-fn windows-font else-font font-size antialias]
+    (let [is-windows       (>= (.. System (getProperty "os.name" "") (toLowerCase) (indexOf "win")) 0)
           normal-font      (atom (if is-windows
                                    (make-font windows-font Font/PLAIN font-size)
                                    (make-font else-font Font/PLAIN font-size)))
           _                    (log/info "Using font" normal-font)
+
+          antialias        (atom antialias)
           default-bg-color     [(long 0) (long 0) (long 0)]
           ;; create texture atlas
-          character-map-cleared (vec (repeat rows (vec (repeat columns (make-terminal-character \space default-bg-color default-bg-color #{})))))
-          character-map         (atom character-map-cleared)
+          character-map-cleared (vec (repeat rows (vec (repeat columns (make-terminal-character \space default-fg-color default-bg-color #{})))))
+          character-map         (ref character-map-cleared)
           cursor-xy             (atom nil)

           key-chan         (async/chan)
-          on-key-fn        (or on-key-fn
+          #_#_on-key-fn        (or on-key-fn
                                (fn default-on-key-fn [k]
                                  (async/put! key-chan k)))
-          keyListener      (reify KeyListener
+          #_#_keyListener      (reify KeyListener
                              (keyPressed [_ e]
                                ;(println "keyPressed keyCode" (.getKeyCode e) "escape" KeyEvent/VK_ESCAPE "escape?" (= (.getKeyCode e) KeyEvent/VK_ESCAPE))
                                (convert-key-code e on-key-fn))
@@ -572,51 +643,18 @@
                                    (if ctrlDown
                                      (on-key-fn (char (+ (int \a) -1 (int character))))
                                      (on-key-fn character))))))
-          icon            (.getImage (Toolkit/getDefaultToolkit) "images/icon.png")
-
-          terminal-renderer (proxy [Canvas] []
-                              (addNotify []
-                                (proxy-super addNotify)
-                                #_(Display/setParent this)
-                                #_(Display/create (PixelFormat.)))
-                              (removeNotify []
-                                (Display/destroy)
-                                (proxy-super removeNotify)))
-          font-metrics  ^FontMetrics (.getFontMetrics terminal-renderer @normal-font)
-          screen-width               (* columns (.charWidth font-metrics \M))
-          screen-height              (* rows (.getHeight font-metrics))
+          font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) @normal-font)
+          char-width                 (.charWidth font-metrics \M)
+          char-height                (.getHeight font-metrics)
+          screen-width               (* columns char-width)
+          screen-height              (* rows char-height)
           _                  (log/info "screen size" screen-width "x" screen-height)
-          _                  (doto terminal-renderer
-                               (.setSize screen-width screen-height)
-                               (.setVisible true)
-                               (.setIgnoreRepaint true))
-          pixel-format       (PixelFormat.)
-          context-attributes (ContextAttribs. 2 1)
-          _                  (Display/setDisplayMode (DisplayMode. screen-width screen-height))
-          _                  (Display/setTitle title)
-          _                  (Display/create pixel-format context-attributes)
-          _                  (GL11/glViewport 0 0 screen-width screen-height)
-
-          #_#__                (doto (JFrame. title)
-                             (.. (getContentPane) (setLayout (BorderLayout.)))
-                             (.addKeyListener keyListener)
-                             (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
-                             (.setLocationByPlatform true)
-                             (.setLocationRelativeTo nil)
-                             (.setAlwaysOnTop true)
-                             (.setAlwaysOnTop false)
-                             (.setVisible true)
-                             (.setIconImage icon)
-                             (.setFocusTraversalKeysEnabled false)
-                             (.setResizable false)
-                             (.setSize screen-width screen-height)
-                             (.. (getContentPane) (add terminal-renderer BorderLayout/CENTER))
-                             (.pack))
+          _                  (init-display title screen-width screen-height)

           ;; create texture atlas as gl texture
           {:keys [font-texture-width
                   font-texture-height
-                  font-texture-image]} (make-glyph-image normal-font)
+                  font-texture-image]} (make-glyph-image char-width char-height normal-font)
           font-texture          (texture-id font-texture-image)
                                                       ;:image character-canvas-dom
                                                       ;:parameters {texture-parameter-name/texture-mag-filter texture-filter/nearest
@@ -641,14 +679,12 @@
           texture-coords-vertex-attribute (GL20/glGetAttribLocation pgm-id "aTextureCoord")

           ;; We just need one vertex buffer, a texture-mapped quad will suffice for drawing the terminal.
-          vx                  (* columns char-width)
-          vy                  (* rows char-height)

           {:keys [vao-id
                   vertices-vbo-id
                   vertices-count
                   texture-coords-vbo-id]}
-                           (init-buffers vx vy)
+                           (init-buffers screen-width screen-height)
           u-MVMatrix                (GL20/glGetUniformLocation pgm-id "uMVMatrix")
           u-PMatrix                 (GL20/glGetUniformLocation pgm-id "uPMatrix")
           u-font                    (GL20/glGetUniformLocation pgm-id "uFont")
@@ -675,16 +711,22 @@
                   (when (Keyboard/getEventKeyState)
                     (async/>! key-chan (Keyboard/getEventCharacter))))
                 (recur)))
+      ;; Access to terminal will be multi threaded. Release context so that other threads can access it
+      (Display/releaseContext)
       ;; Create and return terminal
       (OpenGlTerminal. columns
                        rows
                        next-pow-2-columns
                        next-pow-2-rows
+                       normal-font
+                       antialias
                        character-map-cleared
                        character-map
                        cursor-xy
                        {:p-matrix-buffer (ortho-matrix-buffer screen-width screen-height)
                         :mv-matrix-buffer (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0])
+                        :char-width char-width
+                        :char-height char-height
                         :buffers {:vao-id vao-id
                                   :vertices-vbo-id vertices-vbo-id
                                   :vertices-count vertices-count
@@ -721,7 +763,7 @@
   ([^ATerminal screen x y string fg bg]
    (put-string screen (int (rmath/ceil x)) (int (rmath/ceil y)) string fg bg #{}))
   ([^ATerminal screen x y string fg bg styles]
-   (put-string screen (int (rmath/ceil x)) (int (rmath/ceil y)) string fg bg #{} {}))
+   (put-string screen (int (rmath/ceil x)) (int (rmath/ceil y)) string fg bg styles {}))
   ([^ATerminal screen x y string fg bg styles mask-opts]
    {:pre [(clojure.set/superset? #{:underline :bold} styles)]}
    (let [characters (map-indexed (fn [i c] {:c  (str c)
@@ -729,19 +771,19 @@
                                             :bg bg
                                             :x  (+ x i)
                                             :y  y
-                                            :opts {}})
+                                            :opts mask-opts})
                                  string)]
      (rat/put-chars! screen characters))))

-(defn -main
+(defn single-thread-main
   "Show a terminal and echo input."
-  [& args]
+  [& _]
   #_(loop [i 30]
     (log/info "Starting in " i)
     (Thread/sleep 1000)
     (when (pos? i)
       (recur (dec i))))
-  (let [terminal (make-terminal 80 24)
+  (let [terminal (make-terminal "glterminal.main" 80 24)
         last-key (atom nil)]
     (future (go-loop []
               (reset! last-key (async/<! (rat/get-key-chan terminal)))
@@ -752,15 +794,50 @@
       (when (not (Display/isCloseRequested))
         (let [key-in (or @last-key \?)]
         ;(let [key-in (rat/wait-for-key terminal)]
-          (rat/clear! terminal)
-          (put-string terminal 0 0 "Hello world 0 0")
-          (put-string terminal 0 1 "abcdefghijklmno")
-          (put-string terminal 60 0 "Hello world 60 0")
-          (put-string terminal 0 19 "Hello world 60 19")
-          (put-string terminal 60 19 "Hello world 0 19")
-          (put-string terminal 5 10 (str key-in))
-          (rat/refresh! terminal)
+          (dosync
+            (rat/clear! terminal)
+            (put-string terminal 0 0 "Hello world 0 0")
+            (put-string terminal 0 1 "abcdefghijklmno")
+            (put-string terminal 60 0 "Hello world 60 0" [128 0 0] [0 0 128])
+            (put-string terminal 0 19 "Hello world 60 19" [0 128 0] [128 0 0])
+            (put-string terminal 60 19 "Hello world 0 19" [0 0 128] [0 128 0])
+            (put-string terminal 5 10 (str key-in))
+            (rat/refresh! terminal))
           (recur)))))
   (Display/destroy)
   (System/exit 0))

+;; multi-thread main
+(defn -main
+  "Show a terminal and echo input."
+  [& _]
+  ;; render in background thread
+  (let [terminal (make-terminal (format "Robinson - %s@%s" "demo" "glterminal")
+                                80 24 [255 255 255] [5 5 8] nil
+                                "Courier New" "fonts/Boxy/Boxy.ttf" 16 true)
+        last-key (atom nil)]
+    (future (go-loop []
+              (let [key-in (or @last-key \?)]
+                (dosync
+                  (rat/clear! terminal)
+                  (put-string terminal 0 0 "Hello world 0 0")
+                  (put-string terminal 0 1 "abcdefghijklmno")
+                  (doseq [[i c] (take 23 (map-indexed (fn [i c] [i (char c)]) (range (int \a) (int \z))))]
+                    (put-string terminal 0 i (str c) [128 (+ i 100) 0] [0 0 50]))
+                  (put-string terminal 60 0 "Hello world 60 0" [128 0 0] [0 0 128])
+                  (put-string terminal 0 19 "Hello world 60 19" [0 128 0] [128 0 0])
+                  (put-string terminal 60 19 "Hello world 0 19" [0 0 128] [0 128 0])
+                  (put-string terminal 5 10 (str key-in))
+                  (rat/refresh! terminal)))
+              (recur)))
+    (future (go-loop []
+              (reset! last-key (async/<!! (rat/get-key-chan terminal)))
+              (log/info "got key" @last-key)
+              (recur)))
+    ;; get key presses in fg thread
+    (loop []
+      (when (not (Display/isCloseRequested))
+        (Thread/sleep 10)
+        (recur))))
+  (Display/destroy)
+  (System/exit 0))


Tests for Sneakdoor Beta interactions with Security Testing and Ash on HQ.

--- src/clj/test/cards-programs.clj
+++ src/clj/test/cards-programs.clj
@@ -312,6 +312,28 @@
       (run-successful state)
       (is (= 2 (:counter (refresh nerve)))))))

+(deftest sneakdoor-ash
+  "Sneakdoor Beta - Gabriel Santiago, Ash on HQ should prevent Sneakdoor HQ access but still give Gabe credits.
+  Issue #1138."
+  (do-game
+    (new-game (default-corp [(qty "Ash 2X3ZB9CY" 1)])
+              (make-deck "Gabriel Santiago: Consummate Professional" [(qty "Sneakdoor Beta" 1)]))
+    (play-from-hand state :corp "Ash 2X3ZB9CY" "HQ")
+    (take-credits state :corp)
+    (play-from-hand state :runner "Sneakdoor Beta")
+    (is (= 1 (:credit (get-runner))) "Sneakdoor cost 4 credits")
+    (let [sb (get-in @state [:runner :rig :program 0])
+          ash (get-content state :hq 0)]
+      (core/rez state :corp ash)
+      (card-ability state :runner sb 0)
+      (card-ability state :corp ash 0)
+      (prompt-choice :corp 0)
+      (prompt-choice :runner 0)
+      (run-successful state)
+      (is (= 3 (:credit (get-runner))) "Gained 2 credits from Gabe's ability")
+      (is (= (:cid ash) (-> (get-runner) :prompt first :card :cid)) "Ash interrupted HQ access after Sneakdoor run")
+      (is (= :hq (-> (get-runner) :register :successful-run first)) "Successful Run on HQ recorded"))))
+
 (deftest sneakdoor-crisium
   "Sneakdoor Beta - do not switch to HQ if Archives has Crisium Grid. Issue #1229."
   (do-game
@@ -327,6 +349,24 @@
       (card-ability state :runner sb 0)
       (run-successful state)
       (is (= :archives (get-in @state [:run :server 0])) "Crisium Grid stopped Sneakdoor Beta from switching to HQ"))))
+
+(deftest sneakdoor-sectest
+  "Sneakdoor Beta - Grant Security Testing credits on HQ."
+  (do-game
+    (new-game (default-corp)
+              (default-runner [(qty "Security Testing" 1) (qty "Sneakdoor Beta" 1)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Sneakdoor Beta")
+    (play-from-hand state :runner "Security Testing")
+    (take-credits state :runner)
+    (is (= 3 (:credit (get-runner))))
+    (take-credits state :corp)
+    (let [sb (get-in @state [:runner :rig :program 0])]
+      (prompt-choice :runner "HQ")
+      (card-ability state :runner sb 0)
+      (run-successful state)
+      (is (not (:run @state)) "Switched to HQ and ended the run from Security Testing")
+      (is (= 5 (:credit (get-runner))) "Sneakdoor switched to HQ and earned Security Testing credits"))))

 (deftest surfer
   "Surfer - Swap position with ice before or after when encountering a barrier ice"


reremoving contacts.cljs?

reremoving contacts.cljs?

--- src/cljs/chestnut/contacts.cljs
+++ src/cljs/chestnut/contacts.cljs
@@ -1,53 +0,0 @@
-(ns chestnut.contacts
-  (:require [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true]
-            [sablono.core :as h :refer-macros [html]]
-            [cljs.core.async :refer [<! chan put! sliding-buffer sub pub timeout]]))
-
-(defn add-contact [data owner]
-  (let [new-contact (-> (om/get-node owner "new-contact")
-                        .-value
-                        parse-contact)]
-    (when new-contact
-      (om/transact! data :contacts #(conj % new-contact))
-      (om/set-state! owner :text ""))))
-
-(defn parse-contact [contact-str]
-  (let [[first middle last :as parts] (string/split contact-str #"\s+")
-        [first last middle] (if (nil? last) [first middle] [first last middle])
-        middle (when middle (string/replace middle "." ""))
-        c (if middle (count middle) 0)]
-    (when (>= (count parts) 2)
-      (cond-> {:first first :last last}
-        (== c 1) (assoc :middle-initial middle)
-        (>= c 2) (assoc :middle middle)))))
-
-(defn handle-change [e owner {:keys [text]}]
-  (om/set-state! owner :text (.. e -target -value)))
-
-(defn contacts-view [data owner]
-  (reify
-    om/IInitState
-    (init-state [_]
-      {:delete (chan)
-       :text ""})
-    om/IWillMount
-    (will-mount [_]
-      (let [delete (om/get-state owner :delete)]
-        (go (loop []
-              (let [contact (<! delete)]
-                (om/transact! data :contacts
-                  (fn [xs] (vec (remove #(= contact %) xs))))
-                (recur))))))
-    om/IRenderState
-    (render-state [this state]
-      (dom/div nil
-        (dom/h2 nil "Contact list")
-        (apply dom/ul nil
-          (om/build-all contact-view (:contacts data)
-            {:init-state state}))
-        (dom/div nil
-          (dom/input
-            #js {:type "text" :ref "new-contact" :value (:text state)
-                 :onChange #(handle-change % owner state)})
-          (dom/button #js {:onClick #(add-contact data owner)} "Add contact"))))))


select2-query-fn : minimize side effects

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

--- src/cljs/cljs_nusmods/main.cljs
+++ src/cljs/cljs_nusmods/main.cljs
@@ -147,7 +147,6 @@
   [options]
   (let [; Get global `ModulesMap` variable
         ModulesMap     (aget js/window "ModulesMap")
-        result         (js-obj "results" (array))
         resultsPerPage 20]
     (if (nil? (aget options "context"))
         (let [nrModules    (count ModulesMap)
@@ -172,18 +171,17 @@
           (aset options "context"
                 (js-obj "searchResults" sortedSearchResults))))

-    (let [ctx           (aget options "context")
-          searchResults (aget ctx "searchResults")]
-      (if (not (empty? searchResults))
-          (let [resultsForCurrentPage (take resultsPerPage searchResults)
-                remSearchResults      (drop resultsPerPage searchResults)]
-            (aset result "more" true)
-            (aset (aget options "context") "searchResults" remSearchResults)
-            (doseq [r resultsForCurrentPage]
-              (.push (aget result "results")
-                     (js-obj "id" (:id r), "text" (:text r)))))))
-    (aset result "context" (aget options "context"))
-    ((aget options "callback") result)))
+    ((aget options "callback")
+     (let [ctx           (aget options "context")
+           searchResults (aget ctx "searchResults")]
+       (if (not (empty? searchResults))
+           (let [resultsForCurrentPage (take resultsPerPage searchResults)
+                 remSearchResults      (drop resultsPerPage searchResults)]
+             (aset ctx "searchResults" remSearchResults)
+             (clj->js {"more" true, "context" ctx,
+                       "results" resultsForCurrentPage}))
+           ; no more results
+           (js-obj "more" false, "context" ctx, "results" (array)))))))

 (defn- init-select2-input-box
   "Initialize the Select2 `Select Modules for Timetable` input. This function


remove duplication in actions, remove coords key from returned map

--- src/cljs/dodgeball/actions.cljs
+++ src/cljs/dodgeball/actions.cljs
@@ -8,19 +8,14 @@

 (defn switch-turns []
   (if (= (:turn @state/game) :red)
-    (do
-      (swap! state/game assoc :turn :blue)
-      (swap! state/game assoc :actions 0))
-    (do
-      (swap! state/game assoc :turn :red)
-      (swap! state/game assoc :actions 0))))
+      (swap! state/game assoc :turn :blue :actions 0)
+      (swap! state/game assoc :turn :red :actions 0)))

 (defn handle-event [ch]
   (go
      (loop []
        (let [event (<! ch)
-             x (:x (:coords event))
-             y (:y (:coords event))]
+             {:keys [x y]} event]
          (println event)
           (case (:type event)
             :select-unit   (unit/select-unit (:id event))
@@ -28,18 +23,16 @@
             :move-unit     (do
                              (unit/move-unit x y)
                              (swap! state/game update-in [:actions] inc)
-                             (unit/deselect-unit)
-                             (if (= (:actions @state/game) 2) (switch-turns)))
+                             (unit/deselect-unit))
             :pickup-ball   (do
                              (unit/pickup-ball x y)
                              (swap! state/game update-in [:actions] inc)
-                             (unit/deselect-unit)
-                             (if (= (:actions @state/game) 2) (switch-turns)))
+                             (unit/deselect-unit))
             :attack        (do
                              (combat/attack x y)
                              (swap! state/game update-in [:actions] inc)
-                             (unit/deselect-unit)
-                             (if (= (:actions @state/game) 2) (switch-turns))))
+                             (unit/deselect-unit)))
+         (if (= (:actions @state/game) 2) (switch-turns))
          (recur)))))

 (defn determine-action [x y]
@@ -52,36 +45,41 @@
       (boolean unit))
      {:type   :select-unit
       :id     (:id unit)
-      :coords {:x x :y y}}
+      :x      x
+      :y      y}

      (and
        (boolean (state/selected-unit))
        (boolean (unit/find-one-unit-by x y (state/defense))))
      {:type :attack
-      :id (:id unit)
-      :coords {:x x :y y}}
+      :id   (:id unit)
+      :x    x
+      :y    y}
      (or
        (boolean unit)
        (not (unit/in-movement-range? x y (state/selected-unit)))
        (and
          (= nil (state/selected-unit))
          (boolean (unit/find-one-unit-by x y (state/defense)))))
-     {:type   :deselect-unit
-      :id     (:id unit)
-      :coords {:x x :y y}}
+     {:type :deselect-unit
+      :id   (:id unit)
+      :x    x
+      :y    y}

      (and
        (boolean (unit/find-one-unit-by x y :ball))
        (boolean (state/selected-unit)))
-     {:type   :pickup-ball
-      :id     (:id (unit/find-one-unit-by x y :ball))
-      :coords {:x x :y y}}
+     {:type :pickup-ball
+      :id   (:id (unit/find-one-unit-by x y :ball))
+      :x    x
+      :y    y}

      (unit/in-movement-range? x y (state/selected-unit))
      {:type :move-unit
-      :id (:id (state/selected-unit))
-      :coords {:x x :y y}}
+      :id   (:id (state/selected-unit))
+      :x    x
+      :y    y}

      :else
        (println x y (:turn @state/game)))))


handle PrintWriter's write call with offset and len parameter

fixes https://github.com/boot-clj/boot/issues/298

--- boot/pod/src/boot/util.clj
+++ boot/pod/src/boot/util.clj
@@ -174,9 +174,13 @@
   (let [strip? #(and (not @*colorize?*) (string? %))
         strip  #(fn [s] (if (strip? s) (ansi/strip-ansi s) s))]
     (proxy [java.io.PrintWriter] [writer]
-      (write [s]
-        (.write writer ((strip) s))
-        (.flush writer)))))
+      (write
+        ([s]
+         (.write writer ((strip) s))
+         (.flush writer))
+        ([s ^Integer off ^Integer len]
+         (.write writer s off len)
+         (.flush writer))))))

 (defn extract-ids
   [sym]


Прокрутка диалога на начало после закрытия

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -22,7 +22,7 @@
 (defn modal-show [app]
   (om/transact!
    app :show
-   (fn [i] (if i (inc i) 0))))
+   (fn [i] (if i (inc i) 1))))

 (defn modal-hide [app]
   (om/transact!
@@ -31,7 +31,7 @@

 (defonce modals-ids (atom 0))
-(defn get-modal-id [] (swap! modals-ids inc))
+(defn get-modal-id [] (str "modal-" (swap! modals-ids inc)))

 (defonce modals-status (atom #{}))
 (add-watch
@@ -42,7 +42,12 @@
      (let[tag-body (aget (query "body") 0)]
        (if (empty? new)
          (goog.dom.classes/remove tag-body "modal-open")
-         (goog.dom.classes/add    tag-body "modal-open"))))))
+         (goog.dom.classes/add    tag-body "modal-open")))
+
+     (let [d (clojure.set/difference new old)]
+       (when (not (empty? d))
+         (let [new-dialog-id (first d)]
+           (println "Открылся " new-dialog-id)))))))

 (defn modal [app owner {:keys [label
                                header
@@ -66,12 +71,30 @@
     om/IWillUnmount
     (will-unmount [_]
       (swap! modals-status disj (om/get-state owner :id)))
+    ;; om/IDidUpdate
+    ;; (did-update [_ next-props _]
+    ;;   (println "IDidUpdate" (om/get-state owner :id) (:show next-props) "->" (:show app))
+    ;;   (when (< 1 (count @modals-status))
+    ;;     (let [id (om/get-state owner :id)
+    ;;           e (.getElementById js/document id)
+    ;;           scrollTop (.-scrollTop e)
+    ;;           itop (.-innerWidth js/top)
+    ;;           ]
+    ;;       ;;(.setAttribute e "style" (str "margin-top:"  (.-scrollTop e) "px"))
+    ;;       ))
+    ;;   )
+    om/IWillUpdate
+    (will-update [_ next-props _]
+      ;;(println "IWillUpdate" (:show next-props) "->" (:show app))
+      (when (not (:show next-props))
+        (set! (.-scrollTop (.getElementById js/document (om/get-state owner :id))) 0)))
     om/IRenderState
     (render-state [this {id :id}]
       (println "modal id:" id)
       (let [show? (:show app)]
         (swap! modals-status (if show? conj disj) id)
-        (dom/div #js {:aria-hidden "true"
+        (dom/div #js {:id id
+                      :aria-hidden "true"
                       :aria-labelledby label
                       :style (if show?
                                #js {:display "block" :paddingLeft 0}
@@ -330,7 +353,8 @@

 (defn search-view [app owner
                    {:keys [data-update-fn
-                           data-rendering-fn]
+                           data-rendering-fn
+                           add-button-fn]
                     :or {data-update-fn (fn [app]
                                           (println "Неопределена функция запроса обновления данных (data-update-fn [app] ...)")
                                           (println "параметр на входе: " (str app)))
@@ -388,13 +412,23 @@
                                           }})

                         (dom/span #js {:className "input-group-btn"}
-                                  (dom/button #js {:className "btn btn-default" :type "button"
+                                  (dom/button #js {:className "btn btn-success" :type "button"
                                                    :onClick (fn [_]
                                                               (om/update! app :page 1)
                                                               (put! chan-update 1)
                                                               1)}
                                               (dom/span #js {:className "glyphicon glyphicon-search"
-                                                             :aria-hidden "true"})))
+                                                             :aria-hidden "true"}))
+
+                                  (when add-button-fn
+                                    (dom/button #js {:className "btn btn-danger" :type "button"
+                                                     :onClick (fn [_]
+                                                                (add-button-fn)
+                                                                1)}
+                                                (dom/span #js {:className "glyphicon glyphicon-plus"
+                                                               :aria-hidden "true"})))
+
+                                  )

                         )
                (dom/br nil)


STORM-461: exit-process! does not always exit the process, but throws an exception instead

--- storm-core/src/clj/backtype/storm/util.clj
+++ storm-core/src/clj/backtype/storm/util.clj
@@ -316,7 +316,7 @@

 (defn exit-process!
   [val & msg]
-  (log-error (RuntimeException. msg) "Halting process: " msg)
+  (log-error (RuntimeException. (str msg)) "Halting process: " msg)
   (.exit (Runtime/getRuntime) val))

 (defn sum


Update some libs

Update some libs

--- src/leiningen/new/cljskel/project.clj
+++ src/leiningen/new/cljskel/project.clj
@@ -4,19 +4,19 @@

   :dependencies [[ch.qos.logback/logback-classic "1.1.2"]
                  [cheshire "5.3.1"]
-                 [clj-http "0.7.9"]
+                 [clj-http "0.7.8"]
                  [clj-time "0.7.0"]
                  [com.ovi.common.logging/logback-appender "0.0.45"]
-                 [com.ovi.common.metrics/metrics-graphite "2.1.23"]
+                 [com.ovi.common.metrics/metrics-graphite "2.1.25"]
                  [com.yammer.metrics/metrics-logback "2.2.0"]
-                 [compojure "1.1.6" :exclusions [javax.servlet/servlet-api]]
+                 [compojure "1.1.8" :exclusions [javax.servlet/servlet-api]]
                  [environ "0.5.0"]
                  [metrics-clojure "1.0.1"]
                  [metrics-clojure-ring "1.0.1"]
                  [nokia/instrumented-ring-jetty-adapter "0.1.8"]
-                 [nokia/ring-utils "1.2.1"]
+                 [nokia/ring-utils "1.2.4"]
                  [org.clojure/clojure "1.5.1"]
-                 [org.clojure/data.json "0.2.4"]
+                 [org.clojure/data.json "0.2.5"]
                  [org.clojure/data.xml "0.0.7"]
                  [org.clojure/data.zip "0.1.1"]
                  [org.clojure/tools.logging "0.2.6"]


missing assoc-in

missing assoc-in

--- src/main/clojure/cljs/core/macros.clj
+++ src/main/clojure/cljs/core/macros.clj
@@ -36,5 +36,6 @@
          (doall (map source-fn vars)))))

 (defmacro alias [[_ ns] [_ alias]]
-  (swap! env/*compiler* [::namespaces (.getName *ns*) :requires] assoc alias ns)
+  (swap! env/*compiler* assoc-in [::namespaces (.getName *ns*) :requires]
+    alias ns)
   nil)


JMP offsets are actually doubled

JMP offsets are actually doubled

--- src/emm_ess_pee/instruction_set.clj
+++ src/emm_ess_pee/instruction_set.clj
@@ -233,7 +233,7 @@
       ;; Matches jmp instruction
       (if-let [[_ condition offset] (re-matches #"001([01]{3})([01]{10})$" wrd)]
         (let [cnd (get condition-codes condition)
-              offset (binstr->int offset)]
+              offset (* 2 (binstr->int offset))]

           (print-jmp cnd offset)
           (perform-jmp cnd computer offset))


Hooks for :checked-arrays

Hooks for :checked-arrays

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -238,6 +238,7 @@
                                         :verbose    verbose
                                         :cache-path cache-path
                                         :opts       opts}
+                                  {:checked-arrays nil}
                                   (when static-fns
                                     {:static-fns true})
                                   (when fn-invoke-direct
@@ -327,7 +328,7 @@
     {:ns         @current-ns
      :context    :expr
      :source-map true}
-    (select-keys @app-env [:verbose :static-fns :fn-invoke-direct])))
+    (select-keys @app-env [:verbose :checked-arrays :static-fns :fn-invoke-direct])))

 (defn- process-in-ns
   [argument]
@@ -626,7 +627,7 @@
   (let [m (merge
             (when-not *assert*
               {:elide-asserts true})
-            (select-keys @app-env [:static-fns :fn-invoke-direct]))]
+            (select-keys @app-env [:checked-arrays :static-fns :fn-invoke-direct]))]
     (if (empty? m)
       nil
       m)))
@@ -1645,7 +1646,7 @@
             (or source-path "File"))
           (merge
             {:ns initial-ns}
-            (select-keys @app-env [:verbose :static-fns :fn-invoke-direct])
+            (select-keys @app-env [:verbose :checked-arrays :static-fns :fn-invoke-direct])
             (if expression?
               (merge {:context       :expr
                       :def-emits-var true}


bugfix: fileupload single file

bugfix: fileupload single file

--- src/ez_form/field/fileuploader.cljs
+++ src/ez_form/field/fileuploader.cljs
@@ -107,8 +107,10 @@
                    :on-drop (file-select-handler c one-file?)}
         [:span (*t* *locale* ::drop-file-here)]
         (if one-file?
-          (map #(show-file field form-options c %) [@c])
-          (map #(show-file field form-options c %) @c))]]
+          (map #(show-file field form-options c %) (->> [@c]
+                                                        (remove nil?)))
+          (map #(show-file field form-options c %) (->> @c
+                                                        (remove nil?))))]]
       [:div.fileuploader
        [:input (merge {:id id
                        :type :file


Add test functions for experiments.

Add test functions for experiments.

--- src/dsbdp/experiment_helper.clj
+++ src/dsbdp/experiment_helper.clj
@@ -132,3 +132,54 @@
    (fn [_ out] (chunker out))
    (fn [_ out] (phrases out))])

+(def synthetic-low-throughput-self-adaptivity-processing-fns
+  [(fn [_ _] (dsbdp.ExperimentHelper/busySleep 200000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 100000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 100000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  50000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  50000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  50000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  50000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  20500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  25000))])
+
+(def synthetic-average-throughput-self-adaptivity-processing-fns
+  [(fn [_ _] (dsbdp.ExperimentHelper/busySleep 20000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 10000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 10000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  5000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  5000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  5000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  5000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  2500))])
+
+(def synthetic-high-throughput-self-adaptivity-processing-fns
+  [(fn [_ _] (dsbdp.ExperimentHelper/busySleep 5000))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 2500))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 1250))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 1250))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 1250))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep 1250))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))
+   (fn [_ _] (dsbdp.ExperimentHelper/busySleep  625))])
+


Update project.clj

Update project.clj

--- src/jarkeeper/views/project.clj
+++ src/jarkeeper/views/project.clj
@@ -4,7 +4,6 @@
             [hiccup.core :refer [html]]
             [hiccup.page :refer [html5 include-css include-js]]
             [hiccup.util :refer [escape-html]]))
-

 (defn- render-deps [deps]