(ns minimal-3d-physics.core
  (:require [play-clj.core :refer :all]
            [play-clj.g3d :refer :all]
            [play-clj.g3d-physics :refer :all]
            [play-clj.math :refer :all]
            [play-clj.ui :refer :all]))

(def ^:const mass 10)

(defn get-material
  []
  (let [c (color (+ 0.5 (* 0.5 (rand)))
                 (+ 0.5 (* 0.5 (rand)))
                 (+ 0.5 (* 0.5 (rand)))
                 1)]
    (material :set (attribute! :color :create-specular 1 1 1 1)
              :set (attribute! :float :create-shininess 8)
              :set (attribute! :color :create-diffuse c))))

(defn get-attrs
  []
  (bit-or (usage :position) (usage :normal)))

(defn create-sphere-body!
  [screen]
  (let [shape (sphere-shape 2)
        local-inertia (vector-3 0 0 0)]
    (sphere-shape! shape :calculate-local-inertia mass local-inertia)
    (->> (rigid-body-info mass nil shape local-inertia)
         rigid-body
         (add-body! screen))))

(defn create-sphere!
  [screen mat attrs]
  (-> (model-builder)
      (model-builder! :create-sphere 4 4 4 24 24 mat attrs)
      model
      (assoc :body (create-sphere-body! screen))))

(defn create-box-body!
  [screen]
  (let [shape (box-shape (vector-3 2 2 1))
        local-inertia (vector-3 0 0 0)]
    (box-shape! shape :calculate-local-inertia mass local-inertia)
    (->> (rigid-body-info mass nil shape local-inertia)
         rigid-body
         (add-body! screen))))

(defn create-box!
  [screen mat attrs]
  (-> (model-builder)
      (model-builder! :create-box 4 4 2 mat attrs)
      model
      (assoc :body (create-box-body! screen))))

(defscreen main-screen
  :on-show
  (fn [screen entities]
    (let [env (let [attr-type (attribute-type :color :ambient-light)
                    attr (attribute :color attr-type 0.3 0.3 0.3 1)]
                (environment :set attr))
          cam (doto (perspective 67 (game :width) (game :height))
                (position! 10 10 10)
                (direction! 0 0 0))
          screen (update! screen
                          :renderer (model-batch)
                          :world (bullet-3d :discrete-dynamics
                                            :set-gravity (vector-3 0 -10 0))
                          :attributes env
                          :camera cam)]
      [(doto (create-sphere! screen (get-material) (get-attrs))
         (body-position! 0 5 5))
       (doto (create-box! screen (get-material) (get-attrs))
         (body-position! 0 5 0))]))
  :on-render
  (fn [screen entities]
    (clear!)
    (->> entities
         (step! screen)
         (render! screen)))
  :on-resize
  (fn [{:keys [width height] :as screen} entities]
    (size! screen width height))
  :on-touch-down
  (fn [{:keys [x y] :as screen} entities]
    (conj entities (create-box! screen (get-material) (get-attrs)))))

(defscreen text-screen
  :on-show
  (fn [screen entities]
    (update! screen :camera (orthographic) :renderer (stage))
    (assoc (label "0" (color :white))
           :id :fps
           :x 5))
  :on-render
  (fn [screen entities]
    (->> (for [entity entities]
           (case (:id entity)
             :fps (doto entity (label! :set-text (str (game :fps))))
             entity))
         (render! screen)))
  :on-resize
  (fn [screen entities]
    (height! screen 300)))

(defgame minimal-3d-physics
  :on-create
  (fn [this]
    (set-screen! this main-screen text-screen)))

(ns minimal-3d-physics.core
  (:require [play-clj.core :refer :all]
            [play-clj.g3d :refer :all]
            [play-clj.g3d-physics :refer :all]
            [play-clj.math :refer :all]
            [play-clj.ui :refer :all]))

(def ^:const mass 10)

(defn get-material
  []
  (let [c (color (+ 0.5 (* 0.5 (rand)))
                 (+ 0.5 (* 0.5 (rand)))
                 (+ 0.5 (* 0.5 (rand)))
                 1)]
    (material :set (attribute! :color :create-specular 1 1 1 1)
              :set (attribute! :float :create-shininess 8)
              :set (attribute! :color :create-diffuse c))))

(defn get-attrs
  []
  (bit-or (usage :position) (usage :normal)))

(defn create-sphere-body!
  [screen]
  (let [shape (sphere-shape 2)
        local-inertia (vector-3 0 0 0)]
    (sphere-shape! shape :calculate-local-inertia mass local-inertia)
    (->> (rigid-body-info mass nil shape local-inertia)
         rigid-body
         (add-body! screen))))

(defn create-sphere!
  [screen mat attrs]
  (-> (model-builder)
      (model-builder! :create-sphere 4 4 4 24 24 mat attrs)
      model
      (assoc :body (create-sphere-body! screen))))

(defn create-box-body!
  [screen]
  (let [shape (box-shape (vector-3 2 2 1))
        local-inertia (vector-3 0 0 0)]
    (box-shape! shape :calculate-local-inertia mass local-inertia)
    (->> (rigid-body-info mass nil shape local-inertia)
         rigid-body
         (add-body! screen))))

(defn create-box!
  [screen mat attrs]
  (-> (model-builder)
      (model-builder! :create-box 4 4 2 mat attrs)
      model
      (assoc :body (create-box-body! screen))))

(defscreen main-screen
  :on-show
  (fn [screen entities]
    (let [env (let [attr-type (attribute-type :color :ambient-light)
                    attr (attribute :color attr-type 0.3 0.3 0.3 1)]
                (environment :set attr))
          cam (doto (perspective 67 (game :width) (game :height))
                (position! 10 10 10)
                (direction! 0 0 0))
          screen (update! screen
                          :renderer (model-batch)
                          :world (bullet-3d :discrete-dynamics
                                            :set-gravity (vector-3 0 -10 0))
                          :attributes env
                          :camera cam)]
      [(doto (create-sphere! screen (get-material) (get-attrs))
         (body-position! 0 5 5))
       (doto (create-box! screen (get-material) (get-attrs))
         (body-position! 0 5 0))]))
  :on-render
  (fn [screen entities]
    (clear!)
    (->> entities
         (render! screen)
         (step! screen)))
  :on-resize
  (fn [{:keys [width height] :as screen} entities]
    (size! screen width height))
  :on-touch-down
  (fn [{:keys [x y] :as screen} entities]
    (conj entities (create-box! screen (get-material) (get-attrs)))))

(defscreen text-screen
  :on-show
  (fn [screen entities]
    (update! screen :camera (orthographic) :renderer (stage))
    (assoc (label "0" (color :white))
           :id :fps
           :x 5))
  :on-render
  (fn [screen entities]
    (->> (for [entity entities]
           (case (:id entity)
             :fps (doto entity (label! :set-text (str (game :fps))))
             entity))
         (render! screen)))
  :on-resize
  (fn [screen entities]
    (height! screen 300)))

(defgame minimal-3d-physics
  :on-create
  (fn [this]
    (set-screen! this main-screen text-screen)))

Move step! function for consistency

Move step! function for consistency


(ns mars-ogler.main
  (:use [mars-ogler.routes :only [ogler-handler]]
        [mars-ogler.scrape :only [scrape-loop! setup-state!]]
        [ring.adapter.jetty :only [run-jetty]])
  (:gen-class))

(defn -main
  [& _]
  (setup-state!)
  (run-jetty ogler-handler {:join? false, :port 3000})
  (Thread/sleep (* 60 1000))
  (scrape-loop!))

(ns mars-ogler.main
  (:use [mars-ogler.routes :only [ogler-handler]]
        [mars-ogler.scrape :only [scrape-loop! setup-state!]]
        [ring.adapter.jetty :only [run-jetty]])
  (:gen-class))

(defn -main
  [& _]
  (setup-state!)
  (run-jetty ogler-handler {:join? false, :port 2001})
  (scrape-loop!))

Change port, don't wait to scrape in main


(ns client.mc
	(:require-macros [hiccups.core :as hiccups])
  (:require
    [cljs.reader :refer [read-string]]
    [client.socket :refer [socket]]
		hiccups.runtime))

(def $ js/$)

(defn- by-id [id]
  (.getElementById js/document id))

;;------------------------------------------------------------
;; Stop Game page
;;------------------------------------------------------------

(hiccups/defhtml stop-html []
  [:div#inner-container
    [:div.login-5983e
      [:label#time-left.timeleft-69be1]
      [:button#stopBtn.red-btn-2c9ab "STOP"]]])

(declare init-start-page!)

(defn on-time-left
  "Called when receiving time left from server."
  [i]
  (.html ($ "#time-left") (str "Stopping in " i)))

(defn on-countdown
  "Called when receiving countdown till start from server."
  [i]
  (.html ($ "#time-left") (str "Starting in " i)))

(defn cleanup-stop-page!
  "Remove socket listeners specific to the stop page."
  []
  (.removeListener @socket "time-left" on-time-left)
  (.removeListener @socket "countdown" on-countdown)
  )

(defn init-stop-page!
  "Initialize the start game page."
  []
  (.html ($ "#main-container") (stop-html))

  (.on @socket "time-left" on-time-left)
  (.on @socket "countdown" on-countdown)

  (.click ($ "#stopBtn")
          #(do (.emit @socket "stop-game")
               (cleanup-stop-page!)
               (init-start-page!))))

;;------------------------------------------------------------
;; Start Game page
;;------------------------------------------------------------

(hiccups/defhtml start-html []
  [:div#inner-container
    [:div.login-5983e
      [:button#startBtn.green-btn-f67eb "START"]]])

(defn init-start-page!
  "Initialize the start game page."
  []
  (.html ($ "#main-container") (start-html))

  (.click ($ "#startBtn")
          #(do (.emit @socket "start-time")
               (init-stop-page!))))

;;------------------------------------------------------------
;; Password page
;;------------------------------------------------------------

(hiccups/defhtml password-html []
  [:div#inner-container
    [:div.login-5983e
      [:form
        [:div.input-4a3e3
          [:label.label-66a3b "MC password:"]
          [:input#password.input-48f1f {:type "password"}]]
        [:button#submitPasswordBtn.red-btn-2c9ab "OK"]]]])

(defn- click-login-as-mc [e]
  (.preventDefault e)
  (.emit @socket "request-mc" (.val ($ "#password"))))

(defn on-grant-mc
  "Callback for handling the MC access grant."
  [str-data]
  (if-let [game-running (read-string str-data)]
     (init-stop-page!)
     (init-start-page!)))

(defn init-password-page!
  "Initialize the password page."
  []
  (.html ($ "#main-container") (password-html))

  ; Request access as MC when user submits password.
  (.click ($ "#submitPasswordBtn") click-login-as-mc)

  ; Render either the stop page or the start page
  ; when access as MC is granted.
  (.on @socket "grant-mc" on-grant-mc)

  ; Put focus on the password field.
  (.focus (by-id "password")))

;;------------------------------------------------------------
;; Main page intializer.
;;------------------------------------------------------------

(defn init
  []
  (client.core/set-bw-background!)

  (init-password-page!)
  )

(defn cleanup
  []

  ; Leave the MC role.
  (.emit @socket "leave-mc")

  ; Destroy socket listeners.
  (.removeListener @socket "grant-mc" on-grant-mc)

  (cleanup-stop-page!)

  )

convert tabs to spaces

convert tabs to spaces


(ns buddy.test_buddy_auth
  (:require [clojure.test :refer :all]
            [ring.util.response :refer [response? response]]
            [buddy.crypto.core :refer :all]
            [buddy.auth :refer [throw-notauthorized]]
            [buddy.auth.backends.httpbasic :refer [http-basic-backend]]
            [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]))

(defn make-request
  [username, password]
  (if (and username password)
    {:headers {"authorization" (format "Basic %s" (str->base64 (format "%s:%s" username password)))}}
    {:headers {}}))

(defn auth-fn
  [request parsed-data]
  (let [username (:username parsed-data)]
    (cond
      (= username "foo") :foo)))

(deftest authentication-middleware-test
  (testing "Auth middleware with http-basic backend 01"
    (let [backend (http-basic-backend :realm "Foo")
          handler (fn [req] req)
          handler (wrap-authentication handler backend)
          req     (make-request "user" "pass")
          resp    (handler req)]
        (is (nil? (:identity resp)))))

  (testing "Auth middleware with http-basic backend 02"
    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
          handler (fn [req] req)
          handler (wrap-authentication handler backend)]
      (let [req   (make-request "user" "pass")
            resp  (handler req)]
        (is (nil? (:identity resp))))
      (let [req   (make-request "foo" "pass")
            resp  (handler req)]
        (is (= (:identity resp) :foo))))))

(deftest authorization-middleware-test
  (testing "Auth middleware with http-basic backend 01"
    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
          handler (fn [req] (if (nil? (:identity req))
                              (throw-notauthorized {:msg "FooMsg"})
                              req))
          handler (wrap-authentication handler backend)
          handler (wrap-authorization handler backend)
          req     (make-request "user" "pass")
          resp    (handler req)]
      (is (= (:status resp) 401)))
    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
          handler (fn [req] (if (nil? (:identity req))
                              (throw-notauthorized {:msg "FooMsg"})
                              req))
          handler (wrap-authentication handler backend)
          handler (wrap-authorization handler backend)
          req     (make-request "foo" "pass")
          resp    (handler req)]
      (is (= (:identity resp) :foo)))))

(ns buddy.test_buddy_auth
  (:require [clojure.test :refer :all]
            [ring.util.response :refer [response? response]]
            [buddy.crypto.core :refer :all]
            [buddy.crypto.signing :as signing]
            [buddy.auth :refer [throw-notauthorized]]
            [buddy.auth.backends.httpbasic :refer [http-basic-backend parse-httpbasic-header]]
            [buddy.auth.backends.stateless-token :as stoken]
            [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]))

(defn make-httpbasic-request
  [username, password]
  (if (and username password)
    {:headers {"authorization" (format "Basic %s" (str->base64 (format "%s:%s" username password)))}}
    {:headers {}}))

(defn httpbasic-auth-fn
  [request parsed-data]
  (let [username (:username parsed-data)]
    (cond
      (= username "foo") :foo)))

(def secret-key "test-secret-key")

(deftest http-basic-parse-test
  (testing "Parse httpbasic header from request"
    (let [header  (format "Basic %s" (str->base64 "foo:bar"))
          request {:headers {"authorization" header}}
          parsed  (parse-httpbasic-header request)]
      (is (not (nil? parsed)))
      (is (= (:password parsed) "bar"))
      (is (= (:username parsed) "foo")))))

(deftest stateless-token-test
  (testing "Parse authorization header"
    (let [signed-data     (signing/dumps {:userid 1} secret-key)
          header-content  (format "Bearer %s" signed-data)
          request         {:headers {"authorization" header-content}}
          parsed          (stoken/parse-authorization-header request)]
      (is (= parsed signed-data))))

  (testing "Simple backend authentication 01"
    (let [signed-data     (signing/dumps {:userid 1} secret-key)
          header-content  (format "Bearer %s" signed-data)
          request         {:headers {"authorization" header-content}}
          backend         (stoken/stateless-token-backend secret-key)
          handler         (fn [req] req)
          handler         (wrap-authentication handler backend)
          resp            (handler request)]
      (is (= (:identity resp) {:userid 1}))))
  (testing "Simple backend authentication 02"
    (let [signed-data     (signing/dumps {:userid 1} "wrong-key")
          header-content  (format "Bearer %s" signed-data)
          request         {:headers {"authorization" header-content}}
          backend         (stoken/stateless-token-backend secret-key)
          handler         (fn [req] req)
          handler         (wrap-authentication handler backend)
          resp            (handler request)]
      (is (nil? (:identity resp))))))

(deftest authentication-middleware-test-with-httpbasic
  (testing "Auth middleware with http-basic backend 01"
    (let [backend (http-basic-backend :realm "Foo")
          handler (fn [req] req)
          handler (wrap-authentication handler backend)
          req     (make-httpbasic-request "user" "pass")
          resp    (handler req)]
        (is (nil? (:identity resp)))))

  (testing "Auth middleware with http-basic backend 02"
    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
          handler (fn [req] req)
          handler (wrap-authentication handler backend)]
      (let [req   (make-httpbasic-request "user" "pass")
            resp  (handler req)]
        (is (nil? (:identity resp))))
      (let [req   (make-httpbasic-request "foo" "pass")
            resp  (handler req)]
        (is (= (:identity resp) :foo))))))

(deftest authorization-middleware-test-with-httpbasic
  (testing "Auth middleware with http-basic backend 01"
    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
          handler (fn [req] (if (nil? (:identity req))
                              (throw-notauthorized {:msg "FooMsg"})
                              req))
          handler (wrap-authentication handler backend)
          handler (wrap-authorization handler backend)
          req     (make-httpbasic-request "user" "pass")
          resp    (handler req)]
      (is (= (:status resp) 401)))
    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
          handler (fn [req] (if (nil? (:identity req))
                              (throw-notauthorized {:msg "FooMsg"})
                              req))
          handler (wrap-authentication handler backend)
          handler (wrap-authorization handler backend)
          req     (make-httpbasic-request "foo" "pass")
          resp    (handler req)]
      (is (= (:identity resp) :foo)))))

Add more tests and fix some others.

Add more tests and fix some others.


; Licensed to the Apache Software Foundation (ASF) under one
; or more contributor license agreements. See the NOTICE file
; distributed with this work for additional information
; regarding copyright ownership. The ASF licenses this file
; to you under the Apache License, Version 2.0 (the
; "License"); you may not use this file except in compliance
; with the License. You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.

(ns dda.pallet.dda-managed-ide.infra.vscode
  (:require
    [clojure.tools.logging :as logging]
    [schema.core :as s]
    [pallet.actions :as actions]
    [dda.config.commons.user-home :as user-env]))

(def Vscode {(s/optional-key :plugins) [{:plugin-name s/Str :plugin-config s/Any}]})

; curl -Lo vscode.deb https://go.microsoft.com/fwlink/?LinkID=760868
; sudo apt install ./vscode.deb

; curl https://packages.microsoft.com/keys/microsoft.asc | gpg --dearmor > microsoft.gpg
; sudo install -o root -g root -m 644 microsoft.gpg /etc/apt/trusted.gpg.d/
; sudo sh -c 'echo "deb [arch=amd64] https://packages.microsoft.com/repos/vscode stable main" > /etc/apt/sources.list.d/vscode.list'
; sudo apt-get install apt-transport-https
; sudo apt-get update
; sudo apt-get install code # or code-insiders
; curl -Lo joker-0.12.2-linux-amd64.zip https://github.com/candid82/joker/releases/download/v0.12.2/joker-0.12.2-linux-amd64.zip
; unzip joker-0.12.2-linux-amd64.zip
; mv joker /usr/local/bin/
; code --install-extension cospaia.clojure4vscode martinklepsch.clojure-joker-linter DavidAnson.vscode-markdownlint

; # Settings can be found at $HOME/.config/Code/User/settings.json

update vscode setup

update vscode setup


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Main class for launching experiments"}
  dsbdp.main
  (:require
    (clj-assorted-utils [util :refer :all])
    (clojure.tools [cli :refer :all])
    (dsbdp
      [data-processing-dsl :refer :all]
      [byte-array-conversion :refer :all]
      [experiment-helper :refer :all]
      [local-data-processing-pipeline :refer :all]
      [processing-fn-utils :as utils]))
  (:import
    (dsbdp Counter ExperimentHelper ProcessingLoop)
    (java.lang.management ManagementFactory ThreadInfo ThreadMXBean)
    (java.util HashMap Map))
  (:gen-class))

(defn create-thread-info-fn
  []
  (let [^ThreadMXBean tmxb (ManagementFactory/getThreadMXBean)
        cpu-time-supported (.isThreadCpuTimeSupported tmxb)
        delta-cntr (delta-counter)]
    (.setThreadContentionMonitoringEnabled tmxb true)
    (if cpu-time-supported
      (.setThreadCpuTimeEnabled tmxb true))
    (fn []
      (let [t-ids (sort (vec (.getAllThreadIds tmxb)))]
        (doseq [t-id t-ids]
          (let [^ThreadInfo t-info (.getThreadInfo tmxb ^long t-id)
                t-name (.getThreadName t-info)
                cpu-time (if cpu-time-supported
                           (double (/ (.getThreadCpuTime tmxb t-id) 1000000000.0))
                           -1)
                user-time (if cpu-time-supported
                            (double (/ (.getThreadUserTime tmxb t-id) 1000000000.0))
                            -1)
                waited (.getWaitedTime t-info)
                blocked (.getBlockedTime t-info)]
            (println (str t-id "," t-name "," cpu-time "," user-time "," waited "," blocked ","
                       (delta-cntr (str "cpu-" t-id) cpu-time) ","
                       (delta-cntr (str "user-" t-id) user-time) ","
                       (delta-cntr (str "waited-" t-id) waited) ","
                       (delta-cntr (str "blocked-" t-id) blocked)))))))))

(def cli-options
  [["-b" "--batch-size BATCH-SIZE"
    "The number of data instances to be generated for one batch."
    :default 2000
    :parse-fn #(Integer/parseInt %)]
   ["-d" "--batch-delay BATCH-DELAY"
    "The delay in ms between generating batches."
    :default 1
    :parse-fn #(Integer/parseInt %)]
   ["-h" "--help"]
   ["-i" "--in-data IN-DATA"
    "The input data to be used."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-l" "--pipeline-length PIPELINE-LENGTH"
    :default 2
    :parse-fn #(Integer/parseInt %)]
   ["-m" "--fn-mapping FN-MAPPING"
    "The mapping of dsl-expressions to processing functions."
    :default [5 5 4 3]
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-s" "--scenario SCENARIO"
    "The scenario that is to be used."
    :default "no-op"]
   ])

(defn -main [& args]
  (println "Starting dsbdp main...")
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    (when (:help options)
      (println summary)
      (System/exit 0))
    (println "Using options:" options)
    (println "Using args:" arguments)
    (let [in-cntr (Counter.)
          out-cntr (Counter.)
          delta-cntr (delta-counter)
          out-fn (fn [_ _]
                   (.inc out-cntr))
          ^String scenario (:scenario options)
          in-data-arg (:in-data options)
          in-data (if (not (nil? in-data-arg))
                    in-data-arg
                    (condp (fn [^String v ^String s] (.startsWith s v)) scenario
                      "no-op" 1
                      "busy-sleep" [100000 100000 100000 100000]
                      "factorial" 300N
                      "opennlp-single" "This is a simple sentence."
                      "opennlp-multi" (str
                                        "This is a simple sentence. "
                                        "The first example sentence is followed by another example sentence. "
                                        "The second sentence is followed by another example sentence.")
                      "pcap" pcap-byte-array-test-data
                      "self-adaptivity" 1
                      "nil" nil))
          _ (println "in-data:" in-data)
          fn-mapping (atom (:fn-mapping options))
          _ (println "fn-mapping:" @fn-mapping)
          pipeline-length (:pipeline-length options)
          proc-fns (atom
                     (condp = scenario
                       "no-op" (create-no-op-proc-fns pipeline-length)
                       "busy-sleep" (create-busy-sleep-proc-fns (count in-data))
                       "factorial" [(fn [i _] (factorial i))]
                       "factorial-inc" (create-factorial-proc-fns pipeline-length)
                       "opennlp-single-inc" (utils/combine-proc-fns-vec
                                              @fn-mapping
                                              opennlp-single-sentence-inc-test-fns)
                       "pcap-clj-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-clj-map)]
                                        [(fn [i _] (pcap-fn i))])
                       "pcap-clj-map-inc" (combine-proc-fns-vec
                                            @fn-mapping
                                            sample-pcap-processing-definition-clj-map)
                       "pcap-java-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-java-map)]
                                         [(fn [i _] (pcap-fn i))])
                       "pcap-java-map-inc" (combine-proc-fns-vec
                                             @fn-mapping
                                             sample-pcap-processing-definition-java-map)
                       "pcap-json" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-json)]
                                     [(fn [i _] (pcap-fn i))])
                       "pcap-json-inc" (combine-proc-fns-vec
                                         @fn-mapping
                                         sample-pcap-processing-definition-json)
                       "pcap-csv" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-csv)]
                                    [(fn [i _] (pcap-fn i))])
                       "pcap-csv-inc" (combine-proc-fns-vec
                                        @fn-mapping
                                        sample-pcap-processing-definition-csv)
                       "self-adaptive-low-throughput" (utils/combine-proc-fns-vec
                                                        @fn-mapping
                                                        synthetic-low-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-average-throughput" (utils/combine-proc-fns-vec
                                                            @fn-mapping
                                                            synthetic-average-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-high-throughput" (utils/combine-proc-fns-vec
                                                         @fn-mapping
                                                         synthetic-high-throughput-self-adaptivity-processing-fns)))
          pipeline (if (and
                         (not (nil? in-data))
                         (not (.endsWith scenario "-direct")))
                     (create-local-processing-pipeline
                       @proc-fns
                       out-fn))
          batch-delay (:batch-delay options)
          batch-size (:batch-size options)
          in-loop (ProcessingLoop.
                    "DataGenerationLoop"
                    (cond
                      (.endsWith scenario "-direct")
                        (let [proc-fn (condp = scenario
                                        "busy-sleep-direct" (fn [in] (ExperimentHelper/busySleep ^long (first in)))
                                        "factorial-direct" factorial
                                        "opennlp-single-direct" opennlp-single-sentence-direct-test-fn
                                        "opennlp-multi-direct" opennlp-multi-sentence-direct-test-fn
                                        "pcap-clj-map-direct" (create-proc-fn sample-pcap-processing-definition-clj-map)
                                        "pcap-java-map-direct" (create-proc-fn sample-pcap-processing-definition-java-map)
                                        "pcap-json-direct" (create-proc-fn sample-pcap-processing-definition-json)
                                        "pcap-csv-direct" (create-proc-fn sample-pcap-processing-definition-csv)
                                        nil)]
                          (fn []
                            (proc-fn in-data)
                            (.inc out-cntr)))
                      (and
                        in-data
                        (> batch-delay 0)
                        (> batch-size 0)) (let [in-fn (get-in-fn pipeline)]
                                           (fn []
                                             (doseq [i (repeat batch-size 0)]
                                               (in-fn in-data)
                                               (.inc in-cntr))
                                             (sleep batch-delay)))
                      in-data (let [in-fn (get-in-fn pipeline)]
                                (fn []
                                  (in-fn in-data)
                                  (.inc in-cntr)))
                      :default (fn [] (.inc out-cntr))))
          thread-info-fn (create-thread-info-fn)
          stats-fn (fn []
                     (let [in (double (/ (.value in-cntr) 1000.0))
                           out (double (/ (.value out-cntr) 1000.0))]
                       (println
                         "time-delta:" (delta-cntr :time (System/currentTimeMillis)) "ms;"
                         "in:" in "k;"
                         "out:" out "k;"
                         "in-delta:" (delta-cntr :in in) "k/s;"
                         "out-delta:" (delta-cntr :out out) "k/s;")
                       (if (not (nil? pipeline))
                         (println (get-counts pipeline)))))]
      (println "Starting experiment...")
      (.setName (Thread/currentThread) "Main")
      (.start in-loop)
      (run-repeat (executor) (fn []
                               (stats-fn)
                               (thread-info-fn) (println)
                               )
                  1000)
      (run-once (executor) (fn [] (System/exit 0)) 120000))))

;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Main class for launching experiments"}
  dsbdp.main
  (:require
    (clj-assorted-utils [util :refer :all])
    (clojure.tools [cli :refer :all])
    (dsbdp
      [data-processing-dsl :refer :all]
      [byte-array-conversion :refer :all]
      [experiment-helper :refer :all]
      [local-data-processing-pipeline :refer :all]
      [processing-fn-utils :as utils]))
  (:import
    (dsbdp Counter ExperimentHelper ProcessingLoop)
    (java.lang.management ManagementFactory ThreadInfo ThreadMXBean)
    (java.util HashMap Map))
  (:gen-class))

(defn create-thread-info-fn
  []
  (let [^ThreadMXBean tmxb (ManagementFactory/getThreadMXBean)
        cpu-time-supported (.isThreadCpuTimeSupported tmxb)
        delta-cntr (delta-counter)]
    (.setThreadContentionMonitoringEnabled tmxb true)
    (if cpu-time-supported
      (.setThreadCpuTimeEnabled tmxb true))
    (fn []
      (let [t-ids (sort (vec (.getAllThreadIds tmxb)))]
        (doseq [t-id t-ids]
          (let [^ThreadInfo t-info (.getThreadInfo tmxb ^long t-id)
                t-name (.getThreadName t-info)
                cpu-time (if cpu-time-supported
                           (double (/ (.getThreadCpuTime tmxb t-id) 1000000000.0))
                           -1)
                user-time (if cpu-time-supported
                            (double (/ (.getThreadUserTime tmxb t-id) 1000000000.0))
                            -1)
                waited (.getWaitedTime t-info)
                blocked (.getBlockedTime t-info)]
            (println (str t-id "," t-name "," cpu-time "," user-time "," waited "," blocked ","
                       (delta-cntr (str "cpu-" t-id) cpu-time) ","
                       (delta-cntr (str "user-" t-id) user-time) ","
                       (delta-cntr (str "waited-" t-id) waited) ","
                       (delta-cntr (str "blocked-" t-id) blocked)))))))))

(def cli-options
  [["-b" "--batch-size BATCH-SIZE"
    "The number of data instances to be generated for one batch."
    :default 2000
    :parse-fn #(Integer/parseInt %)]
   ["-d" "--batch-delay BATCH-DELAY"
    "The delay in ms between generating batches."
    :default 1
    :parse-fn #(Integer/parseInt %)]
   ["-h" "--help"]
   ["-i" "--in-data IN-DATA"
    "The input data to be used."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-l" "--pipeline-length PIPELINE-LENGTH"
    :default 2
    :parse-fn #(Integer/parseInt %)]
   ["-m" "--fn-mapping FN-MAPPING"
    "The mapping of dsl-expressions to processing functions."
    :default [5 5 4 3]
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-s" "--scenario SCENARIO"
    "The scenario that is to be used."
    :default "no-op"]
   ])

(defn -main [& args]
  (println "Starting dsbdp main...")
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    (when (:help options)
      (println summary)
      (System/exit 0))
    (println "Using options:" options)
    (println "Using args:" arguments)
    (let [in-cntr (Counter.)
          out-cntr (Counter.)
          delta-cntr (delta-counter)
          out-fn (fn [_ _]
                   (.inc out-cntr))
          ^String scenario (:scenario options)
          in-data-arg (:in-data options)
          in-data (if (not (nil? in-data-arg))
                    in-data-arg
                    (condp (fn [^String v ^String s] (.startsWith s v)) scenario
                      "no-op" 1
                      "busy-sleep" [100000 100000 100000 100000]
                      "factorial" 300N
                      "opennlp-single" "This is a simple sentence."
                      "opennlp-multi" (str
                                        "This is a simple sentence. "
                                        "The first example sentence is followed by another example sentence. "
                                        "The second sentence is followed by another example sentence.")
                      "pcap" pcap-byte-array-test-data
                      "self-adaptive" 1
                      "nil" nil))
          _ (println "in-data:" in-data)
          fn-mapping (atom (:fn-mapping options))
          _ (println "fn-mapping:" @fn-mapping)
          pipeline-length (:pipeline-length options)
          proc-fns (atom
                     (condp = scenario
                       "no-op" (create-no-op-proc-fns pipeline-length)
                       "busy-sleep" (create-busy-sleep-proc-fns (count in-data))
                       "factorial" [(fn [i _] (factorial i))]
                       "factorial-inc" (create-factorial-proc-fns pipeline-length)
                       "opennlp-single-inc" (utils/combine-proc-fns-vec
                                              @fn-mapping
                                              opennlp-single-sentence-inc-test-fns)
                       "pcap-clj-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-clj-map)]
                                        [(fn [i _] (pcap-fn i))])
                       "pcap-clj-map-inc" (combine-proc-fns-vec
                                            @fn-mapping
                                            sample-pcap-processing-definition-clj-map)
                       "pcap-java-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-java-map)]
                                         [(fn [i _] (pcap-fn i))])
                       "pcap-java-map-inc" (combine-proc-fns-vec
                                             @fn-mapping
                                             sample-pcap-processing-definition-java-map)
                       "pcap-json" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-json)]
                                     [(fn [i _] (pcap-fn i))])
                       "pcap-json-inc" (combine-proc-fns-vec
                                         @fn-mapping
                                         sample-pcap-processing-definition-json)
                       "pcap-csv" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-csv)]
                                    [(fn [i _] (pcap-fn i))])
                       "pcap-csv-inc" (combine-proc-fns-vec
                                        @fn-mapping
                                        sample-pcap-processing-definition-csv)
                       "self-adaptive-low-throughput" (utils/combine-proc-fns-vec
                                                        @fn-mapping
                                                        synthetic-low-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-average-throughput" (utils/combine-proc-fns-vec
                                                            @fn-mapping
                                                            synthetic-average-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-high-throughput" (utils/combine-proc-fns-vec
                                                         @fn-mapping
                                                         synthetic-high-throughput-self-adaptivity-processing-fns)))
          pipeline (if (and
                         (not (nil? in-data))
                         (not (.endsWith scenario "-direct")))
                     (create-local-processing-pipeline
                       @proc-fns
                       out-fn))
          batch-delay (:batch-delay options)
          batch-size (:batch-size options)
          in-loop (ProcessingLoop.
                    "DataGenerationLoop"
                    (cond
                      (.endsWith scenario "-direct")
                        (let [proc-fn (condp = scenario
                                        "busy-sleep-direct" (fn [in] (ExperimentHelper/busySleep ^long (first in)))
                                        "factorial-direct" factorial
                                        "opennlp-single-direct" opennlp-single-sentence-direct-test-fn
                                        "opennlp-multi-direct" opennlp-multi-sentence-direct-test-fn
                                        "pcap-clj-map-direct" (create-proc-fn sample-pcap-processing-definition-clj-map)
                                        "pcap-java-map-direct" (create-proc-fn sample-pcap-processing-definition-java-map)
                                        "pcap-json-direct" (create-proc-fn sample-pcap-processing-definition-json)
                                        "pcap-csv-direct" (create-proc-fn sample-pcap-processing-definition-csv)
                                        nil)]
                          (fn []
                            (proc-fn in-data)
                            (.inc out-cntr)))
                      (and
                        in-data
                        (> batch-delay 0)
                        (> batch-size 0)) (let [in-fn (get-in-fn pipeline)]
                                           (fn []
                                             (doseq [i (repeat batch-size 0)]
                                               (in-fn in-data)
                                               (.inc in-cntr))
                                             (sleep batch-delay)))
                      in-data (let [in-fn (get-in-fn pipeline)]
                                (fn []
                                  (in-fn in-data)
                                  (.inc in-cntr)))
                      :default (fn [] (.inc out-cntr))))
          thread-info-fn (create-thread-info-fn)
          stats-fn (fn []
                     (let [in (double (/ (.value in-cntr) 1000.0))
                           out (double (/ (.value out-cntr) 1000.0))]
                       (println
                         "time-delta:" (delta-cntr :time (System/currentTimeMillis)) "ms;"
                         "in:" in "k;"
                         "out:" out "k;"
                         "in-delta:" (delta-cntr :in in) "k/s;"
                         "out-delta:" (delta-cntr :out out) "k/s;")
                       (if (not (nil? pipeline))
                         (println (get-counts pipeline)))))]
      (println "Starting experiment...")
      (.setName (Thread/currentThread) "Main")
      (.start in-loop)
      (run-repeat (executor) (fn []
                               (stats-fn)
                               (thread-info-fn) (println)
                               )
                  1000)
      (run-once (executor) (fn [] (System/exit 0)) 120000))))

Unify naming convention.

Unify naming convention.


;; Browser and UI-related stuff goes in this file.
;; generic stuff should go elsewhere.

(ns cbfg.core
  (:require-macros [cljs.core.async.macros :refer [go go-loop]]
                   [cbfg.ago :refer [ago ago-loop achan-buf aput atake]])
  (:require [clojure.string :as string]
            [cljs.core.async :refer [<! >! put! chan timeout merge map<]]
            [goog.dom :as gdom]
            [goog.events :as gevents]
            cbfg.ddl
            [cbfg.fence :refer [make-fenced-pump]]))

(enable-console-print!)

(println cbfg.ddl/hi)

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

(defn get-el-value [elId]
  (.-value (gdom/getElement elId)))

(defn set-el-innerHTML [elId v]
  (set! (.-innerHTML (gdom/getElement elId)) v))

(defn listen [el type]
  (let [out (chan)]
    (gevents/listen el type (fn [e] (put! out e)))
    out))

(defn dissoc-in [m [k & ks :as keys]]
  (if ks
    (if-let [next-map (get m k)]
      (let [new-map (dissoc-in next-map ks)]
        (if (seq new-map)
          (assoc m k new-map)
          (dissoc m k)))
      m)
    (dissoc m k)))

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

(defn vis-add-ch [vis ch first-taker-actx]
  (-> vis
      (update-in [:chs ch] #(if (nil? %)
                              {:id ((:gen-id vis))
                               :msgs {}
                               :first-taker-actx first-taker-actx}
                              %))
      (update-in [:chs ch :first-taker-actx]
                 #(if % % first-taker-actx))))

(def vis-event-handlers
  {"ago"
   {:beg (fn [vis actx args]
           (let [[child-actx] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs child-actx]
                                       {:children {} :wait-chs {}})
                             (assoc-in [:actxs actx :children child-actx] true)))))
    :end (fn [vis actx args]
           (let [[child-actx result] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs child-actx])
                             (dissoc-in [:actxs actx :children child-actx])))))}
   "aclose"
   {:beg (fn [vis actx args]
           (let [[ch] args] nil))
    :end (fn [vis actx args]
           (let [[ch result] args] nil))}
   "atake"
   {:beg (fn [vis actx args]
           (let [[ch] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs actx :wait-chs ch] :take)
                             (vis-add-ch ch actx)))))
    :end (fn [vis actx args]
           (let [[ch msg] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs actx :wait-chs ch])
                             (dissoc-in [:chs ch :msgs msg])))
             (when (nil? msg) ; The ch is closed.
               (swap! vis #(dissoc-in % [:chs ch])))))}
   "aput"
   {:beg (fn [vis actx args]
           (let [[ch msg] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs actx :wait-chs ch] :put)
                             (vis-add-ch ch nil)
                             (assoc-in [:chs ch :msgs msg] true)))))
    :end (fn [vis actx args]
           (let [[ch msg result] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs actx :wait-chs ch])))
             ; NOTE: Normally we should cleanup ch when nil result but
             ; looks like CLJS async always incorrectly returns nil from >!.
             ))}
   "aalts"
   {:beg (fn [vis actx args]
           (let [[ch-bindings] args
                 ; The ch-actions will be [[ch :take] [ch :put] ...].
                 ch-actions (map #(if (seq? %) [(first %) :put] [% :take]) ch-bindings)]
             (doseq [ch-action ch-actions]
               (swap! vis #(-> %
                               (vis-add-ch (first ch-action)
                                           (if (= (second ch-action) :take) actx nil))
                               (assoc-in [:actxs actx :wait-chs (first ch-action)]
                                         (second ch-action)))))))
    :end (fn [vis actx args]
           (let [[ch-bindings result] args
                 chs (map #(if (seq? %) (first %) %) ch-bindings)
                 [result-msg result-ch] result]
             (doseq [ch chs]
               (swap! vis #(dissoc-in % [:actxs actx :wait-chs ch])))
             (swap! vis #(dissoc-in % [:chs result-ch :msgs result-msg]))
             (when (nil? result-msg) ; The ch is closed.
               (swap! vis #(dissoc-in % [:chs result-ch])))))}})

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

(defn vis-html-actx [vis actx actx-ch-ch-infos]
  (if actx
    (let [chs (:chs vis)
          actx-info (get-in vis [:actxs actx])
          children (:children actx-info)
          wait-chs (:wait-chs actx-info)]
      ["
" (last actx)
       (if (not-empty wait-chs)
         [" -- waiting: ("
          (map (fn [kv]
                 (let [[ch wait-kind] kv]
                   [(:id (get chs ch)) wait-kind ", "]))
               wait-chs)
          ")"]
         [])
       "
"
       "
"
       (map (fn [ch-ch-info]
              (let [ch-info (second ch-ch-info)]
                ["
" (:id ch-info) ": " (:msgs ch-info) "
"]))
            (get actx-ch-ch-infos actx))
       "
"
       "
"
       (if (not-empty children)
         ["
"
          (map (fn [child-actx-bool] ["
"
                                      (vis-html-actx vis (first child-actx-bool)
                                                     actx-ch-ch-infos)
                                      "
"])
               children)
          "
"]
         [])
       "
"])
    "no actx"))

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

(defn vis-init [cmds cmd-handlers]
  (let [max-inflight (atom 10)
        event-delay (atom 0)
        event-ch (chan)
        step-ch (chan)
        last-id (atom 0)
        gen-id #(swap! last-id inc)
        w [{:gen-id gen-id
            :event-ch event-ch}]
        root-actx (atom nil)
        vis (atom {:actxs {} ; {actx -> {:children {child-actx -> true},
                             ;           :wait-chs {ch -> (:take|:put)}}}.
                   :chs {}   ; {ch -> {:id (gen-id),
                             ;         :msgs {msg -> true}
                             ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})
        run-controls {"run"      #(do (when (< @event-delay 0) (put! step-ch true))
                                      (reset! event-delay 0))
                      "run-slow" #(do (when (< @event-delay 0) (put! step-ch true))
                                      (reset! event-delay
                                              (js/parseInt (get-el-value "run-slowness"))))
                      "pause"    #(reset! event-delay -1)
                      "step"     #(do (reset! event-delay -1)
                                      (put! step-ch true))}]
    (go-loop [run-control-ch (merge (map #(listen (gdom/getElement %) "click")
                                         (keys run-controls)))]
      ((get run-controls (.-id (.-target (<! run-control-ch)))))
      (recur run-control-ch))
    (go-loop [num-events 0]
      (when (> @event-delay 0) (<! (timeout @event-delay)))
      (when (< @event-delay 0) (<! step-ch))
      (let [[actx event] (<! event-ch)
            [verb step & args] event
            vis-event-handler (get (get vis-event-handlers verb) step)]
        (vis-event-handler vis actx args)
        (set-el-innerHTML "vis-html"
                          (apply str
                                 (flatten [(vis-html-actx @vis @root-actx
                                                          (group-by #(:first-taker-actx (second %))
                                                                    (:chs @vis)))])))
        (set-el-innerHTML "vis-svg"
                          (str "<circle cx='"
                               (mod num-events 500)
                               "' cy='100' r='10'"
                               " stroke='black' stroke-width='3'"
                               " fill='red'/>"))
        (set-el-innerHTML "event" (str (last actx) " " verb " " step " " args)))
      (recur (inc num-events)))
    (ago w-actx w
         (reset! root-actx w-actx)
         (let [in (achan-buf w-actx 100)
               out (achan-buf w-actx 0)]
           (ago-loop main-in w-actx [num-ins 0]
                     (let [cmd (<! cmds)
                           cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
                       (aput main-in in cmd-handler)
                       (recur (inc num-ins))))
           (ago-loop main-out w-actx [num-outs 0]
                     (let [result (atake main-out out)]
                       (set-el-innerHTML "output" result)
                       (recur (inc num-outs))))
           (make-fenced-pump w-actx in out @max-inflight)))))

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

(defn example-add [actx x y delay]
  (ago example-add actx
       (<! (timeout delay))
       (+ x y)))

(defn example-sub [actx x y delay]
  (ago example-sub actx
       (<! (timeout delay))
       (- x y)))

(def example-cmd-handlers
  {"add"  (fn [cmd] {:rq #(example-add % (:x cmd) (:y cmd) (:delay cmd))
                     :fence (:fence cmd)})
   "sub"  (fn [cmd] {:rq #(example-sub % (:x cmd) (:y cmd) (:delay cmd))
                     :fence (:fence cmd)})
   "test" (fn [cmd] {:rq #(cbfg.fence/test %)
                     :fence (:fence cmd)})})

(vis-init (map< (fn [ev] {:op (.-id (.-target ev))
                          :x (js/parseInt (get-el-value "x"))
                          :y (js/parseInt (get-el-value "y"))
                          :delay (js/parseInt (get-el-value "delay"))
                          :fence (= (get-el-value "fence") "1")})
                (merge (map #(listen (gdom/getElement %) "click")
                            (keys example-cmd-handlers))))
          example-cmd-handlers)

;; Browser and UI-related stuff goes in this file.
;; generic stuff should go elsewhere.

(ns cbfg.core
  (:require-macros [cljs.core.async.macros :refer [go go-loop]]
                   [cbfg.ago :refer [ago ago-loop achan-buf aput atake]])
  (:require [clojure.string :as string]
            [cljs.core.async :refer [<! >! put! chan timeout merge map<]]
            [goog.dom :as gdom]
            [goog.events :as gevents]
            cbfg.ddl
            [cbfg.fence :refer [make-fenced-pump]]))

(enable-console-print!)

(println cbfg.ddl/hi)

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

(defn get-el-value [elId]
  (.-value (gdom/getElement elId)))

(defn set-el-innerHTML [elId v]
  (set! (.-innerHTML (gdom/getElement elId)) v))

(defn listen [el type]
  (let [out (chan)]
    (gevents/listen el type (fn [e] (put! out e)))
    out))

(defn dissoc-in [m [k & ks :as keys]]
  (if ks
    (if-let [next-map (get m k)]
      (let [new-map (dissoc-in next-map ks)]
        (if (seq new-map)
          (assoc m k new-map)
          (dissoc m k)))
      m)
    (dissoc m k)))

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

(defn vis-add-ch [vis ch first-taker-actx]
  (-> vis
      (update-in [:chs ch] #(if (nil? %)
                              {:id ((:gen-id vis))
                               :msgs {}
                               :first-taker-actx first-taker-actx}
                              %))
      (update-in [:chs ch :first-taker-actx]
                 #(if % % first-taker-actx))))

(def vis-event-handlers
  {"ago"
   {:beg (fn [vis actx args]
           (let [[child-actx] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs child-actx]
                                       {:children {} :wait-chs {}})
                             (assoc-in [:actxs actx :children child-actx] true)))))
    :end (fn [vis actx args]
           (let [[child-actx result] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs child-actx])
                             (dissoc-in [:actxs actx :children child-actx])))))}
   "aclose"
   {:beg (fn [vis actx args]
           (let [[ch] args] nil))
    :end (fn [vis actx args]
           (let [[ch result] args] nil))}
   "atake"
   {:beg (fn [vis actx args]
           (let [[ch] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs actx :wait-chs ch] :take)
                             (vis-add-ch ch actx)))))
    :end (fn [vis actx args]
           (let [[ch msg] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs actx :wait-chs ch])
                             (dissoc-in [:chs ch :msgs msg])))
             (when (nil? msg) ; The ch is closed.
               (swap! vis #(dissoc-in % [:chs ch])))))}
   "aput"
   {:beg (fn [vis actx args]
           (let [[ch msg] args]
             (swap! vis #(-> %
                             (assoc-in [:actxs actx :wait-chs ch] :put)
                             (vis-add-ch ch nil)
                             (assoc-in [:chs ch :msgs msg] true)))))
    :end (fn [vis actx args]
           (let [[ch msg result] args]
             (swap! vis #(-> %
                             (dissoc-in [:actxs actx :wait-chs ch])))
             ; NOTE: Normally we should cleanup ch when nil result but
             ; looks like CLJS async always incorrectly returns nil from >!.
             ))}
   "aalts"
   {:beg (fn [vis actx args]
           (let [[ch-bindings] args
                 ; The ch-actions will be [[ch :take] [ch :put] ...].
                 ch-actions (map #(if (seq? %) [(first %) :put] [% :take]) ch-bindings)]
             (doseq [ch-action ch-actions]
               (swap! vis #(-> %
                               (vis-add-ch (first ch-action)
                                           (if (= (second ch-action) :take) actx nil))
                               (assoc-in [:actxs actx :wait-chs (first ch-action)]
                                         (second ch-action)))))))
    :end (fn [vis actx args]
           (let [[ch-bindings result] args
                 chs (map #(if (seq? %) (first %) %) ch-bindings)
                 [result-msg result-ch] result]
             (doseq [ch chs]
               (swap! vis #(dissoc-in % [:actxs actx :wait-chs ch])))
             (swap! vis #(dissoc-in % [:chs result-ch :msgs result-msg]))
             (when (nil? result-msg) ; The ch is closed.
               (swap! vis #(dissoc-in % [:chs result-ch])))))}})

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

(defn vis-html-actx [vis actx actx-ch-ch-infos]
  (if actx
    (let [chs (:chs vis)
          actx-info (get-in vis [:actxs actx])
          children (:children actx-info)
          wait-chs (:wait-chs actx-info)]
      ["
" (last actx)
       (if (not-empty wait-chs)
         [" -- waiting: ("
          (map (fn [kv]
                 (let [[ch wait-kind] kv]
                   [(:id (get chs ch)) wait-kind ", "]))
               wait-chs)
          ")"]
         [])
       "
"
       "
"
       (map (fn [ch-ch-info]
              (let [ch-info (second ch-ch-info)]
                ["
" (:id ch-info) ": " (:msgs ch-info) "
"]))
            (get actx-ch-ch-infos actx))
       "
"
       "
"
       (if (not-empty children)
         ["
"
          (map (fn [child-actx-bool] ["
"
                                      (vis-html-actx vis (first child-actx-bool)
                                                     actx-ch-ch-infos)
                                      "
"])
               children)
          "
"]
         [])
       "
"])
    "no actx"))

(defn vis-svg-actx [vis actx actx-ch-ch-infos]
  ["<circle cx='"
   (mod ((:last-id vis)) 500)
   "' cy='100' r='10'"
   " stroke='black' stroke-width='3'"
   " fill='red'/>"])

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

(defn vis-init [cmds cmd-handlers]
  (let [max-inflight (atom 10)
        event-delay (atom 0)
        event-ch (chan)
        step-ch (chan)
        last-id (atom 0)
        gen-id #(swap! last-id inc)
        w [{:gen-id gen-id
            :event-ch event-ch}]
        root-actx (atom nil)
        vis (atom {:actxs {} ; {actx -> {:children {child-actx -> true},
                             ;           :wait-chs {ch -> (:take|:put)}}}.
                   :chs {}   ; {ch -> {:id (gen-id),
                             ;         :msgs {msg -> true}
                             ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id
                   :last-id (fn [] @last-id)})
        run-controls {"run"      #(do (when (< @event-delay 0) (put! step-ch true))
                                      (reset! event-delay 0))
                      "run-slow" #(do (when (< @event-delay 0) (put! step-ch true))
                                      (reset! event-delay
                                              (js/parseInt (get-el-value "run-slowness"))))
                      "pause"    #(reset! event-delay -1)
                      "step"     #(do (reset! event-delay -1)
                                      (put! step-ch true))}]
    (go-loop [run-control-ch (merge (map #(listen (gdom/getElement %) "click")
                                         (keys run-controls)))]
      ((get run-controls (.-id (.-target (<! run-control-ch)))))
      (recur run-control-ch))
    (go-loop [num-events 0]
      (when (> @event-delay 0) (<! (timeout @event-delay)))
      (when (< @event-delay 0) (<! step-ch))
      (let [[actx event] (<! event-ch)
            [verb step & args] event
            vis-event-handler (get (get vis-event-handlers verb) step)]
        (vis-event-handler vis actx args)
        (let [actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs @vis))]
          (set-el-innerHTML "vis-html"
                            (apply str (flatten (vis-html-actx @vis @root-actx
                                                               actx-ch-ch-infos))))
          (set-el-innerHTML "vis-svg"
                            (apply str (flatten (vis-svg-actx @vis @root-actx
                                                              actx-ch-ch-infos))))
          (set-el-innerHTML "event" (str (last actx) " " verb " " step " " args))))
      (recur (inc num-events)))
    (ago w-actx w
         (reset! root-actx w-actx)
         (let [in (achan-buf w-actx 100)
               out (achan-buf w-actx 0)]
           (ago-loop main-in w-actx [num-ins 0]
                     (let [cmd (<! cmds)
                           cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
                       (aput main-in in cmd-handler)
                       (recur (inc num-ins))))
           (ago-loop main-out w-actx [num-outs 0]
                     (let [result (atake main-out out)]
                       (set-el-innerHTML "output" result)
                       (recur (inc num-outs))))
           (make-fenced-pump w-actx in out @max-inflight)))))

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

(defn example-add [actx x y delay]
  (ago example-add actx
       (<! (timeout delay))
       (+ x y)))

(defn example-sub [actx x y delay]
  (ago example-sub actx
       (<! (timeout delay))
       (- x y)))

(def example-cmd-handlers
  {"add"  (fn [cmd] {:rq #(example-add % (:x cmd) (:y cmd) (:delay cmd))
                     :fence (:fence cmd)})
   "sub"  (fn [cmd] {:rq #(example-sub % (:x cmd) (:y cmd) (:delay cmd))
                     :fence (:fence cmd)})
   "test" (fn [cmd] {:rq #(cbfg.fence/test %)
                     :fence (:fence cmd)})})

(vis-init (map< (fn [ev] {:op (.-id (.-target ev))
                          :x (js/parseInt (get-el-value "x"))
                          :y (js/parseInt (get-el-value "y"))
                          :delay (js/parseInt (get-el-value "delay"))
                          :fence (= (get-el-value "fence") "1")})
                (merge (map #(listen (gdom/getElement %) "click")
                            (keys example-cmd-handlers))))
          example-cmd-handlers)

Refactor to have placeholder vis-svg-actx func.


(ns reagent.interop
  (:require [clojure.string :as string :refer [join]]))

(defn- js-call [f args]
  (let [argstr (->> (repeat (count args) "~{}")
                    (join ","))]
    (list* 'js* (str "~{}(" argstr ")") f args)))

(defn- dot-args [object member]
  (assert (or (symbol? member)
              (keyword? member))
          (str "Symbol or keyword expected, not " member))
  (assert (or (not (symbol? object))
              (not (re-find #"\." (name object))))
          (str "Dot not allowed in " object))
  (let [n (name member)
        field? (or (keyword? member)
                   (= (subs n 0 1) "-"))
        names (-> (if (symbol? member)
                    (string/replace n #"^-" "")
                    n)
                  (string/split #"\."))]
    [field? names]))

(defmacro $
  "Access member in a javascript object, in a Closure-safe way.
  'member' is assumed to be a field if it is a keyword or if
  the name starts with '-', otherwise the named function is
  called with the optional args.
  'member' may contain '.', to allow access in nested objects.
  If 'object' is a symbol it is not allowed contain '.'.

  ($ o :foo) is equivalent to (.-foo o), except that it gives
  the same result under advanced compilation.
  ($ o foo arg1 arg2) is the same as (.foo o arg1 arg2)."
  [object member & args]
  (let [[field names] (dot-args object member)]
    (if field
      (do
        (assert (empty? args)
                (str "Passing args to field doesn't make sense: " member))
        `(aget ~object ~@names))
      (js-call (list* 'aget object names) args))))

(defmacro $!
  "Set field in a javascript object, in a Closure-safe way.
  'field' should be a keyword or a symbol starting with '-'.
  'field' may contain '.', to allow access in nested objects.
  If 'object' is a symbol it is not allowed contain '.'.

  ($! o :foo 1) is equivalent to (set! (.-foo o) 1), except that it
  gives the same result under advanced compilation."
  [object field value]
  (let [[field names] (dot-args object field)]
    (assert field (str "Field name must start with - in " field))
    `(aset ~object ~@names ~value)))

#_(defmacro .' [& args]
  ;; Deprecated since names starting with . cause problems with bootstrapped cljs.
  (let [ns (str cljs.analyzer/*cljs-ns*)
        line (:line (meta &form))]
    (binding [*out* *err*]
      (println "WARNING: reagent.interop/.' is deprecated in " ns " line " line
               ". Use reagent.interop/$ instead.")))
  `($ ~@args))

#_(defmacro .! [& args]
  ;; Deprecated since names starting with . cause problems with bootstrapped cljs.
  (let [ns (str cljs.analyzer/*cljs-ns*)
        line (:line (meta &form))]
    (binding [*out* *err*]
      (println "WARNING: reagent.interop/.! is deprecated in " ns " line " line
               ". Use reagent.interop/$! instead.")))
  `($! ~@args))

remove deprecated code in interop.clj

remove deprecated code in interop.clj


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.util.dom
  (:require [goog.dom :as dom]))

(defn get-element-by-class
  ([classname]
   (dom/getElementByClass classname))
  ([classname node]
   (dom/getElementByClass classname node)))

(defn stop-propagation
  [e]
  (.stopPropagation e))

(defn prevent-default
  [e]
  (.preventDefault e))

(defn event->inner-text
  [e]
  (.-innerText (.-target e)))

(defn event->value
  [e]
  (.-value (.-target e)))

(defn event->target
  [e]
  (.-target e))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.util.dom
  (:require [goog.dom :as dom]))

(defn get-element-by-class
  ([classname]
   (dom/getElementByClass classname))
  ([classname node]
   (dom/getElementByClass classname node)))

(defn stop-propagation
  [e]
  (when e
    (.stopPropagation e)))

(defn prevent-default
  [e]
  (when e
    (.preventDefault e)))

(defn event->inner-text
  [e]
  (.-innerText (.-target e)))

(defn event->value
  [e]
  (.-value (.-target e)))

(defn event->target
  [e]
  (.-target e))

Make prevent-default and stop-propagation functions nil safe.


(ns riemann.logging
  "Configures log4j to log to a file. It's a trap!"
  ; With thanks to arohner
  (:import (org.apache.log4j
             Logger
             BasicConfigurator
             EnhancedPatternLayout
             Level
             ConsoleAppender
             FileAppender
             SimpleLayout)
           (net.logstash.log4j JSONEventLayoutV1 JSONEventLayout)
           (org.apache.log4j.spi RootLogger))
  (:import (org.apache.log4j.rolling TimeBasedRollingPolicy
                                     SizeBasedTriggeringPolicy
                                     FixedWindowRollingPolicy
                                     RollingFileAppender))
  (:import org.apache.commons.logging.LogFactory)
  (:require wall.hack))

(defn set-level
  "Set the level for the given logger, by string name. Use:
  (set-level \"riemann.client\", Level/DEBUG)"
  ([level]
   (. (Logger/getRootLogger) (setLevel level)))
  ([logger level]
   (. (Logger/getLogger logger) (setLevel level))))

(defmacro suppress
  "Turns off logging for the evaluation of body."
  [loggers & body]
  (let [[logger & more] (flatten [loggers])]
    (if logger
      `(let [old-level# (.getLevel (Logger/getLogger ~logger))]
         (try
           (set-level ~logger Level/FATAL)
           (suppress ~more ~@body)
           (finally
             (set-level ~logger old-level#))))
      `(do ~@body))))

(def ^{:doc "available logging patterns"}
  layouts
  {:riemann       (EnhancedPatternLayout. "%p [%d] %t - %c - %m%n%throwable")
   :json-event    (JSONEventLayout.)
   :json-event-v1 (JSONEventLayoutV1.)})

(defn get-layout
  "Fetch a logging layout by name"
  [layout-name]
  (get layouts (or layout-name :riemann)))

(defn init
  "Initialize log4j. You will probably call this from the config file. You can
  call init more than once; its changes are destructive. Options:

  :console         Determine if logging should happen on the console
  :console-layout  On the off-chance that someone runs riemann within runit,
                   keep the option of specifying the layout
  :file            The file to log to. If omitted, logs to console only. If
                   provided log to that file using the default layout
  :files           A list of files to log to. If provided, a seq is expected
                   containing maps with a :path and an optional :layout key
                   which can be any of: :riemann, :json-event :json-eventv1
  :logsize-rotate  If size(bytes) is specified rotate based on that size
                   otherwise use default time based.
  Example:

  (init {:console false :file \"/var/log/riemann.log\"})
    or
  (init {:console false :file \"/var/log/riemann.log\" :logsize-rotate 1000000000})"
  [& opts]
  ;; Reset loggers
  (let [{:keys [file
                files
                console-layout
                logsize-rotate]
         :as opts} (if (and (= 1 (count opts))
                            (map? (first opts)))
                     (first opts)
                     (apply array-map opts))
         console (get opts :console true)
         logger (doto (Logger/getRootLogger) (.removeAllAppenders))]

    (when console
      (.addAppender logger (ConsoleAppender. (get-layout console-layout))))

    (when file
      (if logsize-rotate
        (let [rolling-policy (doto (FixedWindowRollingPolicy.)
                               (.setActiveFileName file)
                               (.setMaxIndex 5)
                               (.setFileNamePattern
                                (str file "%d{yyyy-MM-dd}.%i.gz"))
                               (.activateOptions))
              triggering-policy (doto (SizeBasedTriggeringPolicy.)
                                  (.setMaxFileSize logsize-rotate)
                                  (.activateOptions))
              log-appender (doto (RollingFileAppender.)
                             (.setRollingPolicy rolling-policy)
                             (.setTriggeringPolicy triggering-policy)
                             (.setLayout (get-layout :riemann))
                             (.activateOptions))]
          (.addAppender logger log-appender))

        (let [rolling-policy (doto (TimeBasedRollingPolicy.)
                               (.setActiveFileName file)
                               (.setFileNamePattern
                                (str file ".%d{yyyy-MM-dd}.gz"))
                               (.activateOptions))
              log-appender (doto (RollingFileAppender.)
                             (.setRollingPolicy rolling-policy)
                             (.setLayout (get-layout :riemann))
                             (.activateOptions))]
          (.addAppender logger log-appender))))

    (when files
      (doseq [{:keys [path layout]} files
              :let [layout (get-layout layout)]]
        (if logsize-rotate
          (let [rolling-policy (doto (FixedWindowRollingPolicy.)
                                 (.setActiveFileName file)
                                 (.setMaxIndex 5)
                                 (.setFileNamePattern
                                  (str file "%d{yyyy-MM-dd}.%i.gz"))
                                 (.activateOptions))
                triggering-policy (doto (SizeBasedTriggeringPolicy.)
                                    (.setMaxFileSize logsize-rotate)
                                    (.activateOptions))
                log-appender (doto (RollingFileAppender.)
                               (.setRollingPolicy rolling-policy)
                               (.setTriggeringPolicy triggering-policy)
                               (.setLayout (get-layout :riemann))
                               (.activateOptions))]
            (.addAppender logger log-appender))

          (let [rolling-policy (doto (TimeBasedRollingPolicy.)
                                 (.setActiveFileName path)
                                 (.setFileNamePattern
                                  (str path ".%d{yyyy-MM-dd}.gz"))
                                 (.activateOptions))
                log-appender (doto (RollingFileAppender.)
                               (.setRollingPolicy rolling-policy)
                               (.setLayout layout)
                               (.activateOptions))]
            (.addAppender logger log-appender)))))

      ;; Set levels.
      (.setLevel logger Level/INFO)

    (set-level "riemann.client" Level/DEBUG)
    (set-level "riemann.server" Level/DEBUG)
    (set-level "riemann.streams" Level/DEBUG)
    (set-level "riemann.graphite" Level/DEBUG)))

(defn nice-syntax-error
  "Rewrites clojure.lang.LispReader$ReaderException to have error messages that
  might actually help someone."
  ([e] (nice-syntax-error e "(no file)"))
  ([e file]
   ; Lord help me.
   (let [line (wall.hack/field (class e) :line e)
         msg (.getMessage (or (.getCause e) e))]
    (RuntimeException. (str "Syntax error (" file ":" line ") " msg)))))

(ns riemann.logging
  "Configures log4j to log to a file. It's a trap!"
  ; With thanks to arohner
  (:import (org.apache.log4j
             Logger
             BasicConfigurator
             EnhancedPatternLayout
             Level
             ConsoleAppender
             FileAppender
             SimpleLayout)
           (net.logstash.log4j JSONEventLayoutV0
                               JSONEventLayoutV1)
           (org.apache.log4j.spi RootLogger))
  (:import (org.apache.log4j.rolling TimeBasedRollingPolicy
                                     SizeBasedTriggeringPolicy
                                     FixedWindowRollingPolicy
                                     RollingFileAppender))
  (:import org.apache.commons.logging.LogFactory)
  (:require wall.hack))

(defn set-level
  "Set the level for the given logger, by string name. Use:
  (set-level \"riemann.client\", Level/DEBUG)"
  ([level]
   (. (Logger/getRootLogger) (setLevel level)))
  ([logger level]
   (. (Logger/getLogger logger) (setLevel level))))

(defmacro suppress
  "Turns off logging for the evaluation of body."
  [loggers & body]
  (let [[logger & more] (flatten [loggers])]
    (if logger
      `(let [old-level# (.getLevel (Logger/getLogger ~logger))]
         (try
           (set-level ~logger Level/FATAL)
           (suppress ~more ~@body)
           (finally
             (set-level ~logger old-level#))))
      `(do ~@body))))

(def ^{:doc "available logging patterns"}
  layouts
  {:riemann       (EnhancedPatternLayout. "%p [%d] %t - %c - %m%n%throwable")
   :json-event    (JSONEventLayoutV0.)
   :json-event-v0 (JSONEventLayoutV0.)
   :json-event-v1 (JSONEventLayoutV1.)})

(defn get-layout
  "Fetch a logging layout by name"
  [layout-name]
  (get layouts (or layout-name :riemann)))

(defn init
  "Initialize log4j. You will probably call this from the config file. You can
  call init more than once; its changes are destructive. Options:

  :console         Determine if logging should happen on the console
  :console-layout  On the off-chance that someone runs riemann within runit,
                   keep the option of specifying the layout
  :file            The file to log to. If omitted, logs to console only. If
                   provided log to that file using the default layout
  :files           A list of files to log to. If provided, a seq is expected
                   containing maps with a :path and an optional :layout key
                   which can be any of: :riemann, :json-event :json-eventv1
  :logsize-rotate  If size(bytes) is specified rotate based on that size
                   otherwise use default time based.
  Example:

  (init {:console false :file \"/var/log/riemann.log\"})
    or
  (init {:console false :file \"/var/log/riemann.log\" :logsize-rotate 1000000000})"
  [& opts]
  ;; Reset loggers
  (let [{:keys [file
                files
                console-layout
                logsize-rotate]
         :as opts} (if (and (= 1 (count opts))
                            (map? (first opts)))
                     (first opts)
                     (apply array-map opts))
         console (get opts :console true)
         logger (doto (Logger/getRootLogger) (.removeAllAppenders))]

    (when console
      (.addAppender logger (ConsoleAppender. (get-layout console-layout))))

    (when file
      (if logsize-rotate
        (let [rolling-policy (doto (FixedWindowRollingPolicy.)
                               (.setActiveFileName file)
                               (.setMaxIndex 5)
                               (.setFileNamePattern
                                (str file "%d{yyyy-MM-dd}.%i.gz"))
                               (.activateOptions))
              triggering-policy (doto (SizeBasedTriggeringPolicy.)
                                  (.setMaxFileSize logsize-rotate)
                                  (.activateOptions))
              log-appender (doto (RollingFileAppender.)
                             (.setRollingPolicy rolling-policy)
                             (.setTriggeringPolicy triggering-policy)
                             (.setLayout (get-layout :riemann))
                             (.activateOptions))]
          (.addAppender logger log-appender))

        (let [rolling-policy (doto (TimeBasedRollingPolicy.)
                               (.setActiveFileName file)
                               (.setFileNamePattern
                                (str file ".%d{yyyy-MM-dd}.gz"))
                               (.activateOptions))
              log-appender (doto (RollingFileAppender.)
                             (.setRollingPolicy rolling-policy)
                             (.setLayout (get-layout :riemann))
                             (.activateOptions))]
          (.addAppender logger log-appender))))

    (when files
      (doseq [{:keys [path layout]} files
              :let [layout (get-layout layout)]]
        (if logsize-rotate
          (let [rolling-policy (doto (FixedWindowRollingPolicy.)
                                 (.setActiveFileName file)
                                 (.setMaxIndex 5)
                                 (.setFileNamePattern
                                  (str file "%d{yyyy-MM-dd}.%i.gz"))
                                 (.activateOptions))
                triggering-policy (doto (SizeBasedTriggeringPolicy.)
                                    (.setMaxFileSize logsize-rotate)
                                    (.activateOptions))
                log-appender (doto (RollingFileAppender.)
                               (.setRollingPolicy rolling-policy)
                               (.setTriggeringPolicy triggering-policy)
                               (.setLayout (get-layout :riemann))
                               (.activateOptions))]
            (.addAppender logger log-appender))

          (let [rolling-policy (doto (TimeBasedRollingPolicy.)
                                 (.setActiveFileName path)
                                 (.setFileNamePattern
                                  (str path ".%d{yyyy-MM-dd}.gz"))
                                 (.activateOptions))
                log-appender (doto (RollingFileAppender.)
                               (.setRollingPolicy rolling-policy)
                               (.setLayout layout)
                               (.activateOptions))]
            (.addAppender logger log-appender)))))

      ;; Set levels.
      (.setLevel logger Level/INFO)

    (set-level "riemann.client" Level/DEBUG)
    (set-level "riemann.server" Level/DEBUG)
    (set-level "riemann.streams" Level/DEBUG)
    (set-level "riemann.graphite" Level/DEBUG)))

(defn nice-syntax-error
  "Rewrites clojure.lang.LispReader$ReaderException to have error messages that
  might actually help someone."
  ([e] (nice-syntax-error e "(no file)"))
  ([e file]
   ; Lord help me.
   (let [line (wall.hack/field (class e) :line e)
         msg (.getMessage (or (.getCause e) e))]
    (RuntimeException. (str "Syntax error (" file ":" line ") " msg)))))

Fix logger JSONLayout bug: it's called JSONLayoutV0 now.


(defproject totem-destroyer "0.0.1-SNAPSHOT"
  :description "FIXME: write description"

  :dependencies [[com.badlogicgames.gdx/gdx "1.9.3"]
                 [com.badlogicgames.gdx/gdx-backend-lwjgl "1.9.3"]
                 [com.badlogicgames.gdx/gdx-box2d "1.9.3"]
                 [com.badlogicgames.gdx/gdx-box2d-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [com.badlogicgames.gdx/gdx-bullet "1.9.3"]
                 [com.badlogicgames.gdx/gdx-bullet-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [com.badlogicgames.gdx/gdx-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [org.clojure/clojure "1.7.0"]
                 [play-clj "1.1.1"]]

  :source-paths ["src" "src-common"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]
  :aot [totem-destroyer.core.desktop-launcher]
  :main totem-destroyer.core.desktop-launcher)

(defproject totem-destroyer "0.0.1-SNAPSHOT"
  :description "FIXME: write description"

  :dependencies [[com.badlogicgames.gdx/gdx "1.9.3"]
                 [com.badlogicgames.gdx/gdx-backend-lwjgl "1.9.3"]
                 [com.badlogicgames.gdx/gdx-box2d "1.9.3"]
                 [com.badlogicgames.gdx/gdx-box2d-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [com.badlogicgames.gdx/gdx-bullet "1.9.3"]
                 [com.badlogicgames.gdx/gdx-bullet-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [com.badlogicgames.gdx/gdx-platform "1.9.3"
                  :classifier "natives-desktop"]
                 [org.clojure/clojure "1.7.0"]
                 [play-clj "1.2.0-SNAPSHOT"]]

  :source-paths ["src" "src-common"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]
  :aot [totem-destroyer.core.desktop-launcher]
  :main totem-destroyer.core.desktop-launcher)

Use local snapshot version of play-clj with fixes


(ns isla.story
  (:use [clojure.pprint])
  (:require [clojure.string :as str])
  (:require [isla.parser :as parser])
  (:require [isla.interpreter :as interpreter])
  (:require [isla.story-utils :as story-utils])
  (:require [mrc.utils :as utils])
  (:require [isla.library :as library]))

(declare types name-into-objs extract-by-class get-story-ctx seq-to-hash resolve-)

(defprotocol Queryable
  (get-all-items [this])
  (get-item [this name]))

(defprotocol Playable

(defrecord Story [player rooms]
  Queryable
  (get-all-items [this]
    (concat (map (fn [x] (:items x)) rooms)))
  (get-item [this name]
    (if-let [item (first (filter (fn [y] (= name (:name y))) (get-all-items this)))]
      item ;; item getter untested because didn't have items when wrote it
      (if (> (.indexOf ["myself" "me"] name) -1)
        player
        nil)))

  Playable
  (look [this arguments]
    (if (nil? arguments)
      (:summary (get player :room))
      (let [arguments-vec (str/split arguments #" ")]
        (if (= "at" (first arguments-vec))
          (if-let [item (get-item this (second arguments-vec))]
            (:summary item))
          nil)))))

(defrecord Monster [name summary])
(def monster-defaults ["" ""])

(defrecord Player [name summary room])
(def player-defaults ["" "" :undefined])

(defrecord Room [name summary items exit])
(def room-defaults ["" "" [] :undefined])

(defn init-story [story-str]
  (let [raw-env (interpreter/interpret
                 (parser/parse story-str)
                 (library/get-initial-env types (get-story-ctx)))
        env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
        ctx (interpreter/resolve- (:ctx env) env)

        rooms (extract-by-class ctx (:type (get types "room")))
        player (val (first (extract-by-class ctx (:type (get types "_player")))))]
    (Story. player rooms)))

(defn run-command [story command-str]
  (let [command (first (str/split command-str #" "))
        arguments-str (second (str/split command-str #" " 2))
        arguments-vec (if (nil? arguments-str) [nil] [arguments-str])]
    (utils/run-method story command arguments-vec)))

(defn get-story-ctx []
  {"my" (story-utils/instantiate-type (get types "_player"))})

(defn name-into-objs [objs]
  (tuples-to-hash (map (fn [{k 0 v 1}]
                         [k (if (and (contains? v :name) (str/blank? (:name v)))
                              (assoc v :name k)
                              v)])
                       objs)))

(defn extract-by-class [ctx clazz]
  (tuples-to-hash (filter
                   (fn [x] (= clazz (class (val x))))
                   ctx)))

(defn tuples-to-hash [seq-]
  (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
          {}
          seq-))

(def types
  {
   "monster" {:type isla.story.Monster :defaults monster-defaults}
   "room" {:type isla.story.Room :defaults room-defaults}
   "_player" {:type isla.story.Player :defaults player-defaults}
   })

(ns isla.story
  (:use [clojure.pprint])
  (:require [clojure.string :as str])
  (:require [isla.parser :as parser])
  (:require [isla.interpreter :as interpreter])
  (:require [isla.story-utils :as story-utils])
  (:require [mrc.utils :as utils])
  (:require [isla.library :as library]))

(declare types name-into-objs extract-by-class get-story-ctx seq-to-hash resolve-)

(defprotocol Queryable
  (get-all-items [this])
  (get-item [this name]))
(defrecord Monster [name summary])
(def monster-defaults ["" ""])

(defrecord Player [name summary room])
(def player-defaults ["" "" :undefined])

(defprotocol Playable

(defrecord Story [player rooms]
  Queryable
  (get-all-items [this]
    (concat (map (fn [x] (:items x)) rooms)))
  (get-item [this name]
    (if-let [item (first (filter (fn [y] (= name (:name y))) (get-all-items this)))]
      item ;; item getter untested because didn't have items when wrote it
      (if (> (.indexOf ["myself" "me"] name) -1)
        player
        nil)))

  Playable
  (look [this arguments]
    (if (nil? arguments)
      (:summary (get player :room))
      (let [arguments-vec (str/split arguments #" ")]
        (if (= "at" (first arguments-vec))
          (if-let [item (get-item this (second arguments-vec))]
            (:summary item))
          nil)))))

(defrecord Room [name summary items exit])
(def room-defaults ["" "" [] :undefined])

(defn init-story [story-str]
  (let [raw-env (interpreter/interpret
                 (parser/parse story-str)
                 (library/get-initial-env types (get-story-ctx)))
        env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
        ctx (interpreter/resolve- (:ctx env) env)

        rooms (extract-by-class ctx (:type (get types "room")))
        player (val (first (extract-by-class ctx (:type (get types "_player")))))]
    (Story. player rooms)))

(defn run-command [story command-str]
  (let [command (first (str/split command-str #" "))
        arguments-str (second (str/split command-str #" " 2))
        arguments-vec (if (nil? arguments-str) [nil] [arguments-str])]
    (utils/run-method story command arguments-vec)))

(defn get-story-ctx []
  {"my" (story-utils/instantiate-type (get types "_player"))})

(defn name-into-objs [objs]
  (tuples-to-hash (map (fn [{k 0 v 1}]
                         [k (if (and (contains? v :name) (str/blank? (:name v)))
                              (assoc v :name k)
                              v)])
                       objs)))

(defn extract-by-class [ctx clazz]
  (tuples-to-hash (filter
                   (fn [x] (= clazz (class (val x))))
                   ctx)))

(defn tuples-to-hash [seq-]
  (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
          {}
          seq-))

(def types
  {
   "monster" {:type isla.story.Monster :defaults monster-defaults}
   "room" {:type isla.story.Room :defaults room-defaults}
   "_player" {:type isla.story.Player :defaults player-defaults}
   })

Move monster and player defs.

Move monster and player defs.


(ns isla.story
  (:use [clojure.pprint])
  (:require [clojure.string :as str])
  (:require [isla.parser :as parser])
  (:require [isla.interpreter :as interpreter])
  (:require [isla.story-utils :as story-utils])
  (:require [mrc.utils :as utils])
  (:require [isla.library :as library]))

(declare types name-into-objs extract-by-class get-story-ctx tuples-to-hash resolve-
         extract-arguments creturn)

(defrecord Monster [name summary])
(def monster-defaults ["" ""])

(defrecord Player [name summary room])
(def player-defaults ["" "" :undefined])

(defprotocol QueryableRoom
  (connected-rooms [this story]))

(defprotocol QueryableStory
  (all-items [this])
  (item [this name]))

(defprotocol Playable
  (look [this arguments-str]))

(def room-defaults ["" "" [] :undefined])
(defrecord Room [name summary items exit]
  QueryableRoom
  (connected-rooms [this story]
    (set (conj (filter (fn [x] (= this (:exit x))) (:rooms story))
               (:exit this)))))

(defrecord Story [player rooms]
  QueryableStory
  (all-items [this]
    (concat (map (fn [x] (:items x)) rooms)))
  (item [this name]
    (if-let [item (first (filter (fn [y] (= name (:name y))) (all-items this)))]
      item ;; item getter untested because didn't have items when wrote it
      (if (> (.indexOf ["myself" "me"] name) -1)
        player
        nil)))

  Playable
  (look [this arguments-str]
    (let [arguments (extract-arguments arguments-str)]
      (if (empty? arguments)
        (:summary (get player :room))
        (if (= "at" (first arguments))
          (if-let [item (item this (second arguments))]
            (:summary item)))))))

(defn init-story [story-str]
  (let [raw-env (interpreter/interpret
                 (parser/parse story-str)
                 (library/get-initial-env types (get-story-ctx)))
        env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
        ctx (interpreter/resolve- (:ctx env) env)

        rooms (extract-by-class ctx (:type (get types "room")))
        player (val (first (extract-by-class ctx (:type (get types "_player")))))]
    (Story. player rooms)))

(defn run-command [story command-str]
  (let [command (first (str/split command-str #" "))
        arguments-str (second (str/split command-str #" " 2))
        arguments-vec (if (nil? arguments-str) [nil] [arguments-str])]
    (utils/run-method story command arguments-vec)))

(defn extract-arguments [arguments]
  (if (nil? arguments)
    []
    (str/split arguments #" ")))

(defn get-story-ctx []
  {"my" (story-utils/instantiate-type (get types "_player"))})

(defn name-into-objs [objs]
  (tuples-to-hash (map (fn [{k 0 v 1}]
                         [k (if (and (contains? v :name) (str/blank? (:name v)))
                              (assoc v :name k)
                              v)])
                       objs)))

(defn extract-by-class [ctx clazz]
  (tuples-to-hash (filter
                   (fn [x] (= clazz (class (val x))))
                   ctx)))

(defn tuples-to-hash [seq-]
  (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
          {}
          seq-))

(def types
  {
   "monster" {:type isla.story.Monster :defaults monster-defaults}
   "room" {:type isla.story.Room :defaults room-defaults}
   "_player" {:type isla.story.Player :defaults player-defaults}
   })

(ns isla.story
  (:use [clojure.pprint])
  (:require [clojure.string :as str])
  (:require [isla.parser :as parser])
  (:require [isla.interpreter :as interpreter])
  (:require [isla.story-utils :as story-utils])
  (:require [mrc.utils :as utils])
  (:require [isla.library :as library]))

(declare types name-into-objs extract-by-class get-story-ctx tuples-to-hash resolve-
         extract-arguments creturn)

(defrecord Monster [name summary])
(def monster-defaults ["" ""])

(defrecord Player [name summary room])
(def player-defaults ["" "" :undefined])

(defprotocol QueryableRoom
  (connected-rooms [this story]))

(defprotocol QueryableStory
  (all-items [this])
  (item [this name]))

(defprotocol Playable
  (look [this arguments-str]))

(def room-defaults ["" "" [] :undefined])
(defrecord Room [name summary items exit]
  QueryableRoom
  (connected-rooms [this story]
    (set (conj (filter (fn [x] (= this (:exit x))) (:rooms story))
               (:exit this)))))

(defrecord Story [player rooms]
  QueryableStory
  (all-items [this]
    (concat (map (fn [x] (:items x)) rooms)))
  (item [this name]
    (if-let [item (first (filter (fn [y] (= name (:name y))) (all-items this)))]
      item ;; item getter untested because didn't have items when wrote it
      (if (> (.indexOf ["myself" "me"] name) -1)
        player
        nil)))

  Playable
  (look [this arguments-str]
    (let [arguments (extract-arguments arguments-str)]
      (if (empty? arguments)
        (:summary (get player :room))
        (if (= "at" (first arguments))
          (if-let [item (item this (second arguments))]
            (:summary item)))))))

(defn init-story [story-str]
  (let [raw-env (interpreter/interpret
                 (parser/parse story-str)
                 (library/get-initial-env types (get-story-ctx)))
        env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
        ctx (interpreter/resolve- (:ctx env) env)

        rooms (extract-by-class ctx (:type (get types "room")))
        player (val (first (extract-by-class ctx (:type (get types "_player")))))]
    (Story. player rooms)))

(defn run-command [story command-str]
  (let [command (first (str/split command-str #" "))
        arguments-str (second (str/split command-str #" " 2))
        arguments-vec (if (nil? arguments-str) [nil] [arguments-str])]
    (utils/run-method story command arguments-vec)))

(defn extract-arguments [arguments]
  (if (nil? arguments)
    []
    (str/split arguments #" ")))

(defn get-story-ctx []
  {"my" (story-utils/instantiate-type (get types "_player"))})

(defn name-into-objs [objs]
  (tuples-to-hash (map (fn [{k 0 v 1}]
                         [k (if (and (contains? v :name) (str/blank? (:name v)))
                              (assoc v :name k)
                              v)])
                       objs)))

(defn extract-by-class [ctx clazz]
  (tuples-to-hash (filter
                   (fn [x] (= clazz (class (val x))))
                   ctx)))

(defn tuples-to-hash [seq-]
  (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
          {}
          seq-))

(defn creturn
  ([story] {:sto story :out nil})
  ([story output] {:sto story :out output}))

(def types
  {
   "monster" {:type isla.story.Monster :defaults monster-defaults}
   "room" {:type isla.story.Room :defaults room-defaults}
   "_player" {:type isla.story.Player :defaults player-defaults}
   })

Add creturn fn. Creates hash of story and output.


(ns neuseg.dbn
  (:use [clojure.core.matrix :only [set-current-implementation new-vector]])
  (:import (com.guokr.dbn DBN)))

(set-current-implementation :vectorz)

(defn- normalize [val]
  (/ (+ 1 val) 2))

(defn- vectorize [line dim]
  (new-vector (map #(normalize (.Double %)) (clojure.string/split line #" ")) dim))

(defn create [layers]
  (DBN. (int-array layers)))

(defn pretrain [nn k lr train-file-name]
  (with-open [rdr (clojure.java.io/reader train-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")]
      (doall (map #(.pretrain nn k lr (vectorize % idm))
                  (flatten (partition 1 2 (rest (line-seq rdr)))))))))

(defn finetune [nn lr train-file-name]
  (with-open [rdr (clojure.java.io/reader train-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")]
      (doall (map #(.finetune lr (vectorize (first %) idm) (vectorize (second %) odm))
                  (partition 2 (rest (line-seq rdr))))))))

(defn predict [nn input dim]
  (map #(- (* 2 (Math/round %)) 1)) (.pridict nn (vectorize input dim)))

(defn- testfun [nn idim odim]
  (fn [input output]
    (if (= (predict nn input idim) output) 1 0)))

(defn testnn [nn test-file-name]
  (with-open [rdr (clojure.java.io/reader test-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")
          tfn (testfun nn idm odm)]
      (/ (reduce + (map #(tfn (vectorize (first %) idm) (vectorize (second %) odm))
                        (partition 2 (rest (line-seq rdr))))) (Double. total)))))

(defn save [nn])

(ns neuseg.dbn
  (:use [clojure.core.matrix :only [set-current-implementation new-vector]])
  (:import (com.guokr.dbn DBN)))

(set-current-implementation :vectorz)

(defn- normalize [val]
  (/ (+ 1 val) 2))

(defn- vectorize [line dim]
  (new-vector (map #(normalize (Double. %)) (clojure.string/split line #" ")) dim))

(defn create [layers]
  (DBN. (int-array layers)))

(defn pretrain [nn k lr train-file-name]
  (with-open [rdr (clojure.java.io/reader train-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")]
      (doall (map #(.pretrain nn k lr (vectorize % (Integer. idm)))
                  (flatten (partition 1 2 (rest (line-seq rdr)))))))))

(defn finetune [nn lr train-file-name]
  (with-open [rdr (clojure.java.io/reader train-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")
          idm (Integer. idm)
          odm (Integer. odm)]
      (doall (map #(.finetune nn lr (vectorize (first %) idm) (vectorize (second %) odm))
                  (partition 2 (rest (line-seq rdr))))))))

(defn predict [nn input dim]
  (map #(- (* 2 (Math/round %)) 1)) (.pridict nn (vectorize input dim)))

(defn- testfun [nn idim odim]
  (fn [input output]
    (if (= (predict nn input idim) output) 1 0)))

(defn testnn [nn test-file-name]
  (with-open [rdr (clojure.java.io/reader test-file-name)]
    (let [data (line-seq rdr)
          [total idm odm] (clojure.string/split (first data) #" ")
          idm (Integer. idm)
          odm (Integer. odm)
          tfn (testfun nn idm odm)]
      (/ (reduce + (map #(tfn (vectorize (first %) idm) (vectorize (second %) odm))
                        (partition 2 (rest (line-seq rdr))))) (Double. total)))))

(defn save [nn])

fix dbn

fix dbn