(ns lt.objs.find
  (:require [lt.object :as object]
            [lt.objs.context :as ctx]
            [lt.objs.status-bar :as status-bar]
            [lt.util.load :as load]
            [lt.objs.canvas :as canvas]
            [lt.objs.sidebar.command :as cmd]
            [lt.objs.editor.pool :as pool]
            [lt.objs.keyboard :as keyboard]
            [lt.objs.editor :as editor]
            [lt.util.dom :as dom]
            [crate.binding :refer [bound subatom]]
            [lt.util.style :refer [->px]])
  (:require-macros [lt.macros :refer [behavior defui]]))

(def find-height 30)

(defui input [this]
  [:input.find {:type "text"
                :placeholder "find"}]
  :keydown (fn []
           (this-as me
                    (object/raise this :search! (dom/val me))))
  :focus (fn []
           (ctx/in! :find-bar this)
           (object/raise bar :active))
  :blur (fn []
          (ctx/out! :find-bar)
          (object/raise bar :inactive)))

(defui replace-input [this]
  [:input.replace {:type "text"
                   :placeholder "replace"}]
  :keyup (fn []
           (this-as me
                    (object/raise this :replace.changed (dom/val me))))
  :focus (fn []
           (ctx/in! :find-bar.replace this)
           (object/raise bar :active))
  :blur (fn []
          (ctx/out! :find-bar.replace)
          (object/raise bar :inactive)))

(defui replace-all-button [this]
  [:button "all"]
  :click (fn []
           (cmd/exec! :find.replace-all)))

(defn current-ed []
  (editor/->cm-ed (pool/last-active)))

(defn ->shown-width [shown?]
  (if shown?
    ""
    "0"))

(defn ->val [this]
  (dom/val (dom/$ :input.find (object/->content this))))

(defn ->replacement [this]
  (dom/val (dom/$ :input.replace (object/->content this))))

(defn set-val [this v]
  (dom/val (dom/$ :input.find (object/->content this)) v))

(behavior ::show!
          :triggers #{:show!}
          :reaction (fn [this]
                      (object/merge! this {:pos (when-let [ed (pool/last-active)]
                                                  (editor/->cursor ed))})))

(behavior ::hide!
          :triggers #{:hide!}
          :reaction (fn [this]
                      (when-let [ed (pool/last-active)]
                            (editor/focus ed))))

(behavior ::next!
          :triggers #{:next!}
          :reaction (fn [this]
                      (when-let [cur (pool/last-active)]
                        (if (and (:searching? @this)
                                 (= (:searching.for @cur) (->val this)))
                          (js/CodeMirror.commands.findNext (current-ed) (:reverse? @this))
                          (object/raise this :search! (->val this))))))

(behavior ::prev!
          :triggers #{:prev!}
          :reaction (fn [this]
                      (when-let [cur (pool/last-active)]
                        (if (and (:searching? @this)
                                 (= (:searching.for @cur) (->val this)))
                          (js/CodeMirror.commands.findPrev (current-ed) (:reverse? @this))
                          (object/raise this :search! (->val this))))))

(behavior ::focus!
          :triggers #{:focus!}
          :reaction (fn [this]
                      (let [input (dom/$ :input (object/->content this))]
                        (dom/focus input)
                        (.select input))))

(behavior ::clear!
          :triggers #{:clear!}
          :reaction (fn [this]
                      (object/merge! this {:searching? false})
                      (when-let [ed (pool/last-active)]
                        (js/CodeMirror.commands.clearSearch (editor/->cm-ed ed)))
                      (let [input (dom/$ :input (object/->content this))]
                        (when (= "" (dom/val input))
                          (dom/val input "")))))

(behavior ::replace!
          :triggers #{:replace!}
          :reaction (fn [this all?]
                      (when-not (:searching? @this)
                        (object/raise this :search! (->val this)))
                      (js/CodeMirror.commands.replace (editor/->cm-ed (pool/last-active)) (->replacement this) (:reverse? @this) (boolean all?))
                      (object/raise this :next!)))

(behavior ::search!
          :triggers #{:search!}
          :debounce 50
          :reaction (fn [this v]
                      (if (empty? v)
                        (object/raise this :clear!)
                        (when-let [e (pool/last-active)]
                          (when-let [pos (:pos @this)]
                            (editor/move-cursor e pos))
                          (object/merge! this {:searching? true})
                          (object/merge! e {:searching.for v})
                          (let [ed (editor/->cm-ed e)]
                            (js/CodeMirror.commands.find ed v (:reverse? @this)))))))

(object/object* ::find-bar
                :tags #{:find-bar}
                :height 30
                :order -1
                :searching? false
                :reverse? false
                :shown false
                :pos nil
                :init (fn [this]
                        [:div#find-bar
                         (input this)
                         (replace-input this)
                         (replace-all-button this)]))

(behavior ::init
          :triggers #{:init}
          :reaction (fn [this]
                      (load/js "core/node_modules/codemirror/search.js" :sync)
                      (load/js "core/node_modules/codemirror/searchcursor.js" :sync)

                      ))

(def bar (object/create ::find-bar))
(status-bar/add-container bar)

(cmd/command {:command :find.show
              :desc "Find: In current editor"
              :exec (fn [rev?]
                      (object/merge! bar {:reverse? rev?})
                      (object/raise bar :show!)
                      (object/raise bar :focus!))})

(cmd/command {:command :find.fill-selection
              :desc "Find: Fill with selection"
              :exec (fn []
                      (when-let [e (pool/last-active)]
                        (when-let [sel (editor/selection e)]
                          (when-not (empty? sel)
                            (set-val bar sel)))))})

(cmd/command {:command :find.clear
              :desc "Find: Clear the find bar"
              :hidden true
              :exec (fn []
                      (object/raise bar :clear!))})

(cmd/command {:command :find.hide
              :desc "Find: Hide the find bar"
              :exec (fn []
                      (object/raise bar :hide!))})

(cmd/command {:command :find.next
              :desc "Find: Next find result"
              :exec (fn []
                      (object/raise bar :next!))})

(cmd/command {:command :find.prev
              :desc "Find: Previous find result"
              :exec (fn []
                      (object/raise bar :prev!))})

(cmd/command {:command :find.replace
              :desc "Find: Replace current"
              :exec (fn []
                      (object/raise bar :replace!))})

(cmd/command {:command :find.replace-all
              :desc "Find: Replace all occurrences"
              :exec (fn []
                      (object/raise bar :replace! :all))})

(def line-input (cmd/options-input {:placeholder "line number"}))

(behavior ::exec-active!
          :triggers #{:select}
          :reaction (fn [this l]
                      (cmd/exec-active! l)))

(object/add-behavior! line-input ::exec-active!)

(cmd/command {:command :goto-line
              :desc "Editor: Goto line"
              :options line-input
              :exec (fn [l]
                      (when (or (number? l) (not (empty? l)))
                        (let [cur (pool/last-active)]
                          (editor/move-cursor cur {:ch 0
                                                   :line (dec (if-not (number? l)
                                                                (js/parseInt l)
                                                                l))})
                          (editor/center-cursor cur))))})

(ns lt.objs.find
  (:require [lt.object :as object]
            [lt.objs.context :as ctx]
            [lt.objs.status-bar :as status-bar]
            [lt.util.load :as load]
            [lt.objs.canvas :as canvas]
            [lt.objs.sidebar.command :as cmd]
            [lt.objs.editor.pool :as pool]
            [lt.objs.keyboard :as keyboard]
            [lt.objs.editor :as editor]
            [lt.util.dom :as dom]
            [crate.binding :refer [bound subatom]]
            [lt.util.style :refer [->px]])
  (:require-macros [lt.macros :refer [behavior defui]]))

(def find-height 30)

(defui input [this]
  [:input.find {:type "text"
                :placeholder "find"}]
  :input (fn []
           (this-as me
                    (object/raise this :search! (dom/val me))))
  :focus (fn []
           (ctx/in! :find-bar this)
           (object/raise bar :active))
  :blur (fn []
          (ctx/out! :find-bar)
          (object/raise bar :inactive)))

(defui replace-input [this]
  [:input.replace {:type "text"
                   :placeholder "replace"}]
  :input (fn []
           (this-as me
                    (object/raise this :replace.changed (dom/val me))))
  :focus (fn []
           (ctx/in! :find-bar.replace this)
           (object/raise bar :active))
  :blur (fn []
          (ctx/out! :find-bar.replace)
          (object/raise bar :inactive)))

(defui replace-all-button [this]
  [:button "all"]
  :click (fn []
           (cmd/exec! :find.replace-all)))

(defn current-ed []
  (editor/->cm-ed (pool/last-active)))

(defn ->shown-width [shown?]
  (if shown?
    ""
    "0"))

(defn ->val [this]
  (dom/val (dom/$ :input.find (object/->content this))))

(defn ->replacement [this]
  (dom/val (dom/$ :input.replace (object/->content this))))

(defn set-val [this v]
  (dom/val (dom/$ :input.find (object/->content this)) v))

(behavior ::show!
          :triggers #{:show!}
          :reaction (fn [this]
                      (object/merge! this {:pos (when-let [ed (pool/last-active)]
                                                  (editor/->cursor ed))})))

(behavior ::hide!
          :triggers #{:hide!}
          :reaction (fn [this]
                      (when-let [ed (pool/last-active)]
                            (editor/focus ed))))

(behavior ::next!
          :triggers #{:next!}
          :reaction (fn [this]
                      (when-let [cur (pool/last-active)]
                        (if (and (:searching? @this)
                                 (= (:searching.for @cur) (->val this)))
                          (js/CodeMirror.commands.findNext (current-ed) (:reverse? @this))
                          (object/raise this :search! (->val this))))))

(behavior ::prev!
          :triggers #{:prev!}
          :reaction (fn [this]
                      (when-let [cur (pool/last-active)]
                        (if (and (:searching? @this)
                                 (= (:searching.for @cur) (->val this)))
                          (js/CodeMirror.commands.findPrev (current-ed) (:reverse? @this))
                          (object/raise this :search! (->val this))))))

(behavior ::focus!
          :triggers #{:focus!}
          :reaction (fn [this]
                      (let [input (dom/$ :input (object/->content this))]
                        (dom/focus input)
                        (.select input))))

(behavior ::clear!
          :triggers #{:clear!}
          :reaction (fn [this]
                      (object/merge! this {:searching? false})
                      (when-let [ed (pool/last-active)]
                        (js/CodeMirror.commands.clearSearch (editor/->cm-ed ed)))
                      (let [input (dom/$ :input (object/->content this))]
                        (when (= "" (dom/val input))
                          (dom/val input "")))))

(behavior ::replace!
          :triggers #{:replace!}
          :reaction (fn [this all?]
                      (when-not (:searching? @this)
                        (object/raise this :search! (->val this)))
                      (js/CodeMirror.commands.replace (editor/->cm-ed (pool/last-active)) (->replacement this) (:reverse? @this) (boolean all?))
                      (object/raise this :next!)))

(behavior ::search!
          :triggers #{:search!}
          :debounce 50
          :reaction (fn [this v]
                      (if (empty? v)
                        (object/raise this :clear!)
                        (when-let [e (pool/last-active)]
                          (when-let [pos (:pos @this)]
                            (editor/move-cursor e pos))
                          (object/merge! this {:searching? true})
                          (object/merge! e {:searching.for v})
                          (let [ed (editor/->cm-ed e)]
                            (js/CodeMirror.commands.find ed v (:reverse? @this)))))))

(object/object* ::find-bar
                :tags #{:find-bar}
                :height 30
                :order -1
                :searching? false
                :reverse? false
                :shown false
                :pos nil
                :init (fn [this]
                        [:div#find-bar
                         (input this)
                         (replace-input this)
                         (replace-all-button this)]))

(behavior ::init
          :triggers #{:init}
          :reaction (fn [this]
                      (load/js "core/node_modules/codemirror/search.js" :sync)
                      (load/js "core/node_modules/codemirror/searchcursor.js" :sync)

                      ))

(def bar (object/create ::find-bar))
(status-bar/add-container bar)

(cmd/command {:command :find.show
              :desc "Find: In current editor"
              :exec (fn [rev?]
                      (object/merge! bar {:reverse? rev?})
                      (object/raise bar :show!)
                      (object/raise bar :focus!))})

(cmd/command {:command :find.fill-selection
              :desc "Find: Fill with selection"
              :exec (fn []
                      (when-let [e (pool/last-active)]
                        (when-let [sel (editor/selection e)]
                          (when-not (empty? sel)
                            (set-val bar sel)))))})

(cmd/command {:command :find.clear
              :desc "Find: Clear the find bar"
              :hidden true
              :exec (fn []
                      (object/raise bar :clear!))})

(cmd/command {:command :find.hide
              :desc "Find: Hide the find bar"
              :exec (fn []
                      (object/raise bar :hide!))})

(cmd/command {:command :find.next
              :desc "Find: Next find result"
              :exec (fn []
                      (object/raise bar :next!))})

(cmd/command {:command :find.prev
              :desc "Find: Previous find result"
              :exec (fn []
                      (object/raise bar :prev!))})

(cmd/command {:command :find.replace
              :desc "Find: Replace current"
              :exec (fn []
                      (object/raise bar :replace!))})

(cmd/command {:command :find.replace-all
              :desc "Find: Replace all occurrences"
              :exec (fn []
                      (object/raise bar :replace! :all))})

(def line-input (cmd/options-input {:placeholder "line number"}))

(behavior ::exec-active!
          :triggers #{:select}
          :reaction (fn [this l]
                      (cmd/exec-active! l)))

(object/add-behavior! line-input ::exec-active!)

(cmd/command {:command :goto-line
              :desc "Editor: Goto line"
              :options line-input
              :exec (fn [l]
                      (when (or (number? l) (not (empty? l)))
                        (let [cur (pool/last-active)]
                          (editor/move-cursor cur {:ch 0
                                                   :line (dec (if-not (number? l)
                                                                (js/parseInt l)
                                                                l))})
                          (editor/center-cursor cur))))})

fix use of keydown/keyup for search

fix use of keydown/keyup for search

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>


(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]
  (-> (model-builder)
      (model-builder! :create-sphere 4 4 4 24 24 (get-material) (get-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]
  (-> (model-builder)
      (model-builder! :create-box 4 4 2 (get-material) (get-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)
         (body-position! 0 5 5))
       (doto (create-box! screen)
         (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))))

(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-environment
  []
  (let [attr-type (attribute-type :color :ambient-light)
        attr (attribute :color attr-type 0.3 0.3 0.3 1)]
    (environment :set attr)))

(defn get-camera
  []
  (doto (perspective 67 (game :width) (game :height))
    (position! 10 10 10)
    (direction! 0 0 0)))

(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 radius]
  (let [shape (sphere-shape radius)
        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 w h]
  (-> (model-builder)
      (model-builder! :create-sphere w h 4 24 24 (get-material) (get-attrs))
      model
      (assoc :body (create-sphere-body! screen (/ w 2)))))

(defn create-box-body!
  [screen half-w half-h]
  (let [shape (box-shape (vector-3 half-w half-h 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 w h]
  (-> (model-builder)
      (model-builder! :create-box w h 2 (get-material) (get-attrs))
      model
      (assoc :body (create-box-body! screen (/ w 2) (/ h 2)))))

(defscreen main-screen
  :on-show
  (fn [screen entities]
    (let [screen (update! screen
                          :renderer (model-batch)
                          :world (bullet-3d :discrete-dynamics
                                            :set-gravity (vector-3 0 -10 0))
                          :attributes (get-environment)
                          :camera (get-camera))]
      [(doto (create-sphere! screen 4 4)
         (body-position! 0 5 5))
       (doto (create-box! screen 4 4)
         (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 4 4))))

(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)))

Clean up :on-show and add size arguments to shape functions for clarity


(ns misaki.server
  "Development server

  Listen *port* to publish developing site,
  and watch template updates.
  "
  (:use
    [misaki core config]
    [misaki.util.file     :only [find-clj-files normalize-path has-extension? file?]]
    [misaki.util.string   :only [msec->string]]
    [text-decoration.core :only [cyan red bold]]
    watchtower.core
    [compojure.core       :only [routes]]
    [compojure.route      :only [files]]
    [ring.adapter.jetty   :only [run-jetty]]))

; =elapsing
(defmacro elapsing
  [& body]
  `(let [start-time# (System/currentTimeMillis)
         ~'get-elapsed-time (fn [] (- (System/currentTimeMillis) start-time#))]
     ~@body))

; =get-result-text
(defn get-result-text
  [result & optional-string]
  (case result
    true  (cyan (apply str "DONE" optional-string))
    false (red (apply str "FAIL" optional-string))
    (cyan "SKIP")))

; =print-result
(defmacro print-compile-result
  "Print colored compile result."
  [#^String message, compile-sexp]
  `(do
     (println (str " * Compiling " (bold ~message)))
     (flush)
     (elapsing
       (let [result#  ~compile-sexp
             elapsed# (msec->string (~'get-elapsed-time))]
         (println "  " (get-result-text result# " in " elapsed#))
         result#))))

;; ## Dev Compiler

; =do-all-compile
(defn do-all-compile []
  (print-compile-result "all templates" (compiler-all-compile))
  (println " * Finish Compiling"))

; =do-compile
(defn do-compile
  [#^java.io.File file]

  (if (config-file? file)
    (print-compile-result "all templates" (compiler-all-compile))
    (print-compile-result (.getName file) (compiler-compile file)))

  (println " * Finish Compiling"))

;; ## Template Watcher

; =start-watcher
(defn start-watcher
  "Start watchtower watcher to compile changed templates"
  [template-dir]
  ; compile all templates at first
  ;(do-all-compile)

  (watcher
    [template-dir
     (str *base-dir* *config-file*)]
    (rate 50)
    (change-first? false) ; do not compile each templates at first
    (file-filter ignore-dotfiles)
    (file-filter (apply extensions (get-watch-file-extensions)))
    (on-change #(doseq [file %]
                  ; use `wrap-config` to apply config file updates
                  (with-config (do-compile file))))))

;; ## main

; =main
(defn -main [& [dir :as args]]
  (binding [*base-dir* (normalize-path dir)]
    (with-config
      ; compile all templates at first
      (do-all-compile)

      ; compile all only if '--compile' option is specified
      (when-not (contains? (set args) "--compile")
        ;(do-all-compile)
        ; start watching and server
        (start-watcher *template-dir*)
        (println " * starting server: "
                 (cyan (str "http://localhost:" *port* *url-base*)))
        (run-jetty
          (routes (files *url-base* {:root *public-dir*}))
          {:port *port*})))))

(ns misaki.server
  "Development server

  Listen *port* to publish developing site,
  and watch template updates.
  "
  (:use
    [misaki core config]
    [misaki.util.file     :only [find-clj-files normalize-path has-extension? file?]]
    [misaki.util.string   :only [msec->string]]
    [text-decoration.core :only [cyan red bold]]
    watchtower.core
    [compojure.core       :only [routes]]
    [compojure.route      :only [files]]
    [ring.adapter.jetty   :only [run-jetty]]))

; =elapsing
(defmacro elapsing
  [& body]
  `(let [start-time# (System/currentTimeMillis)
         ~'get-elapsed-time (fn [] (- (System/currentTimeMillis) start-time#))]
     ~@body))

; =get-result-text
(defn get-result-text
  [result & optional-string]
  (case result
    true  (cyan (apply str "DONE" optional-string))
    false (red (apply str "FAIL" optional-string))
    (cyan "SKIP")))

; =print-result
(defmacro print-compile-result
  "Print colored compile result."
  [#^String message, compile-sexp]
  `(do
     (println (str " * Compiling " (bold ~message)))
     (flush)
     (elapsing
       (let [result#  ~compile-sexp
             elapsed# (msec->string (~'get-elapsed-time))]
         (println "  " (get-result-text result# " in " elapsed#))
         result#))))

;; ## Dev Compiler

; =do-all-compile
(defn do-all-compile []
  (print-compile-result "all templates" (compiler-all-compile))
  (println " * Finish Compiling"))

; =do-compile
(defn do-compile
  [#^java.io.File file]

  (if (config-file? file)
    (print-compile-result "all templates" (compiler-all-compile))
    (print-compile-result (.getName file) (compiler-compile file)))

  (println " * Finish Compiling"))

;; ## Template Watcher

; =start-watcher
(defn start-watcher
  "Start watchtower watcher to compile changed templates"
  [template-dir]

  (watcher
    [template-dir
     (str *base-dir* *config-file*)]
    (rate 50)
    (change-first? false) ; do not compile each templates at first
    (file-filter ignore-dotfiles)
    (file-filter (apply extensions (get-watch-file-extensions)))
    (on-change #(doseq [file %]
                  ; use `wrap-config` to apply config file updates
                  (with-config (do-compile file))))))

;; ## main

; =main
(defn -main [& [dir :as args]]
  (binding [*base-dir* (normalize-path dir)]
    (with-config
      ; compile all templates at first
      (do-all-compile)

      ; compile all only if '--compile' option is specified
      (when-not (contains? (set args) "--compile")
        (start-watcher *template-dir*)
        (println " * starting server: "
                 (cyan (str "http://localhost:" *port* *url-base*)))
        (run-jetty
          (routes (files *url-base* {:root *public-dir*}))
          {:port *port*})))))

delete comment

delete comment


(ns notifier.core
  (:gen-class)
  (:require [chime :refer [chime-at]]
            [clj-time
             [core :as t]
             [periodic :refer [periodic-seq]]]
            [clojure.data.json :as json]
            [clojure.edn :as edn]
            [org.httpkit.client :as http])
  (:import [java.io FileReader PushbackReader]
           java.util.Base64
           javax.crypto.Mac
           javax.crypto.spec.SecretKeySpec))

;; ASX-ordinaries http://www.marketindex.com.au/all-ordinaries

(def ifttt-key (delay (System/getProperty "ifttt-key")))

(defn sign-req [uri key body]
  (let [mac (doto (Mac/getInstance "HmacSHA512")
              (.init (SecretKeySpec. (.getBytes key) "HmacSHA512")))
        input (str uri \n (System/currentTimeMillis) (if body (str \n body)))]

    (.encodeToString (Base64/getEncoder)
                     (.doFinal mac (.getBytes input "UTF-8")))))

(defn get-btc-price []
  (let [{:keys [status headers body error] :as resp} @(http/get "https://api.btcmarkets.net/market/BTC/AUD/tick")
        data (json/read-str body)
        last-price (data "lastPrice")]
    (println "retrieved btc status:" status ", error:" error ", price:" last-price)
    (if error (println "failed with " error)
        last-price)))

(defn get-asx-prices []
  )

(defn publish-event [level price percent]
  (let[url (format  "https://maker.ifttt.com/trigger/BTC-AUD-%s/with/key/%s" level @ifttt-key)
       {:keys[status body]} @(http/post url {:headers {"Content-Type" "application/json"}
                                            :body (json/write-str {:value1 (str price)
                                                                   :value2 (str percent)})})]
    (println "published event:" url " result:" status ":" body)
    status))

(defn persistent-atom [file initial]
  (let[data (atom (try
                    (-> file (FileReader.) (PushbackReader.) (edn/read))
                    (catch Exception e
                      (println "failed reading file " file ":" e)
                      initial)))]
    (add-watch data
               (fn[k r o n]
                 (spit file (pr-str n))))
    data))

(defn mk-price-nofifier [changes file]
  (let[last-prices (persistent-atom file {})]
    (fn[]
      (if-let [price (get-btc-price)]
        (doseq [c changes :let [last-price (@last-prices c)]]
          (if-let [change (and last-price (- price last-price))]
            (when (>= (Math/abs change) c)
              (publish-event c price (-> change (* 100) (/ last-price)))
              (swap! last-prices assoc c price))
            (swap! last-prices assoc c price)))))))

(defn schedule []
  (let [notifier (mk-price-nofifier [5 10 20 30 40 50 100] "btc-prices.edn")
        times (periodic-seq (t/now) (-> 2 t/minutes))]
    (chime-at times (fn[time]
                      (println "chiming at " time)
                      (notifier)))))

(defn -main
  "Starting notifier..."
  [& args]
  (println "Starting notifier..")
  (schedule)
  (Thread/sleep (Long/MAX_VALUE)))

(ns notifier.core
  (:gen-class)
  (:require [chime :refer [chime-at]]
            [clj-time
             [core :as t]
             [periodic :refer [periodic-seq]]]
            [clojure.data.json :as json]
            [clojure.edn :as edn]
            [org.httpkit.client :as http])
  (:import [java.io FileReader PushbackReader]
           java.util.Base64
           javax.crypto.Mac
           javax.crypto.spec.SecretKeySpec))

;; ASX-ordinaries http://www.marketindex.com.au/all-ordinaries

(def ifttt-key (delay (System/getProperty "ifttt-key")))

(defn sign-req [uri key body]
  (let [mac (doto (Mac/getInstance "HmacSHA512")
              (.init (SecretKeySpec. (.getBytes key) "HmacSHA512")))
        input (str uri \n (System/currentTimeMillis) (if body (str \n body)))]

    (.encodeToString (Base64/getEncoder)
                     (.doFinal mac (.getBytes input "UTF-8")))))

(defn get-btc-price []
  (let [{:keys [status headers body error] :as resp} @(http/get "https://api.btcmarkets.net/market/BTC/AUD/tick")
        data (json/read-str body)
        last-price (data "lastPrice")]
    (println "retrieved btc status:" status ", error:" error ", price:" last-price)
    (if error (println "failed with " error)
        last-price)))

(defn get-asx-prices []
  )

(defn publish-event [level price percent]
  (let[url (format  "https://maker.ifttt.com/trigger/BTC-AUD-%s/with/key/%s" level @ifttt-key)
       {:keys[status body]} @(http/post url {:headers {"Content-Type" "application/json"}
                                            :body (json/write-str {:value1 (str price)
                                                                   :value2 (str percent)})})]
    (println "published event:" url " result:" status ":" body)
    status))

(defn persistent-atom [file initial]
  (let[data (atom (try
                    (-> file (FileReader.) (PushbackReader.) (edn/read))
                    (catch Exception e
                      (println "failed reading file " file ":" e)
                      initial)))]
    (add-watch data :key
               (fn[k r o n]
                 (spit file (pr-str n))))
    data))

(defn mk-price-nofifier [changes file]
  (let[last-prices (persistent-atom file {})]
    (fn[]
      (if-let [price (get-btc-price)]
        (doseq [c changes :let [last-price (@last-prices c)]]
          (if-let [change (and last-price (- price last-price))]
            (when (>= (Math/abs change) c)
              (publish-event c price (-> change (* 100) (/ last-price)))
              (swap! last-prices assoc c price))
            (swap! last-prices assoc c price)))))))

(defn schedule []
  (let [notifier (mk-price-nofifier [5 10 20 30 40 50 100] "btc-prices.edn")
        times (periodic-seq (t/now) (-> 2 t/minutes))]
    (chime-at times (fn[time]
                      (println "chiming at " time)
                      (notifier)))))

(defn -main
  "Starting notifier..."
  [& args]
  (println "Starting notifier..")
  (schedule)
  (Thread/sleep (Long/MAX_VALUE)))

fix arg missing

fix arg missing


;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
;;   and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0
;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
;;   found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be
;;   bound by the terms of this license.  You must not remove this
;;   notice, or any other, from this software.

(ns oxcart.passes
  {:doc "Implements a naive pass manager and dependency system."
   :author "Reid McKenzie"
   :added  "0.0.6"}
  (:require [oxcart.util :refer [update]]))

;; Whole-ASTs are maps of this structure:
;;   {:modules #{symbol}
;;    :passes  (Option #{Var})
;;    ∀ m ∈ Modules m → Module
;;   }
;;
;; Where a Module is at least
;;   {:forms (Vec AST)}
;;
;; The rationale for this structure is that loading is done in the
;; refernce JVM Clojure implementation on a per-module basis where
;; modules are defined to be single files but compilation and
;; evaluation occur sequentially over forms in order of
;; occurrance. Grouping forms from the same namespace together into a
;; module is pretty obvious choice, as is storing forms in file/load
;; order.

(defn whole-ast->modules
  "λ Whole-AST → (Seq Module)

  Returns the modules of the ASt as a sequence."
  [{:keys [modules] :as whole-ast}]
  (map whole-ast modules))

(defn whole-ast->forms
  "λ Whole-AST → (Seq AST)

  Returns a sequence of all the individual top level form ASTs in the
  given Whole-AST."
  [whole-ast]
  (->> whole-ast
       whole-ast->modules
       (mapcat :forms)))

(defn update-modules
  "λ Whole-AST → (λ Module → args * → Module) → args *

  Updates every module in the AST, replacing it with (apply f module
  args). Intended to eliminate repetitive Whole-AST comprehensions in
  pass implementations."
  [{:keys [modules] :as whole-ast} f & args]
  (->> (for [m modules]
         [m (apply f (get whole-ast m) args)])
       (into {})
       (merge whole-ast)))

(defn update-forms
  "λ Whole-AST → (λ Form → args * → Form) → args *

  Updates every form in the given Whole-ast, replacing it with (apply
  f form args). Intended to eliminate repetitive Whole-AST
  comprehensions in pass implementations."
  [whole-ast f & args]
  (-> whole-ast
      (update-modules
       (fn [module]
         (update module :forms
                 (fn [forms]
                   (mapv #(apply f %1 args)
                         forms)))))))

;; Passes are then functions from Whole-ASTs to Whole-ASTs. For user
;; "friendliness" each pass shall also take an options argument which
;; may change the behavior of the pass by enabling or disabling a
;; given transformation or logging output.
;;
;; As it is considered good practice for passes to be composed to
;; achieve some result rather than being monolithic, passes are
;; expected to depend on other passes, especially when a given
;; transformation requires previous enabling analysis. To assist this
;; pattern, when a non-transforming pass completes, it is expected to
;; conj it's identifier into the :passes set. Other passes may then
;; elect not to re-run analyses on which they depend if they have
;; already been run.

(defn record-pass
  [whole-ast pass]
  (update-in whole-ast [:passes] (fn [x y] (conj (or x #{}) y)) pass))

(defn require-pass
  [whole-ast pass options]
  (if (contains? (:passes whole-ast) pass)
    whole-ast
    (pass whole-ast options)))

(defn do-passes
  [whole-ast options & passes]
  (reduce #(require-pass %1 %2 options)
          whole-ast passes))

;; To enable this pattern however, transforming passes are required to
;; clobber the :passes key replacing it with #{}. This indicates to
;; subsequent passes that while information may exist in the program
;; AST it is likely stale and should (must) be re-analyzed before use.

(defn clobber-passes
  [whole-ast]
  (assoc whole-ast :passes #{}))

;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
;;   and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0
;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
;;   found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be
;;   bound by the terms of this license.  You must not remove this
;;   notice, or any other, from this software.

(ns oxcart.passes
  {:doc "Implements a naive pass manager and dependency system."
   :author "Reid McKenzie"
   :added  "0.0.6"}
  (:require [oxcart.util :refer [update]]))

;; Whole-ASTs are maps of this structure:
;;   {:modules #{symbol}
;;    :passes  (Option #{Var})
;;    ∀ m ∈ Modules m → Module
;;   }
;;
;; Where a Module is at least
;;   {:forms (Vec AST)}
;;
;; The rationale for this structure is that loading is done in the
;; refernce JVM Clojure implementation on a per-module basis where
;; modules are defined to be single files but compilation and
;; evaluation occur sequentially over forms in order of
;; occurrance. Grouping forms from the same namespace together into a
;; module is pretty obvious choice, as is storing forms in file/load
;; order.

(defn whole-ast->modules
  "λ Whole-AST → (Seq Module)

  Returns the modules of the ASt as a sequence."
  [{:keys [modules] :as whole-ast}]
  (map whole-ast modules))

(defn whole-ast->forms
  "λ Whole-AST → (Seq AST)

  Returns a sequence of all the individual top level form ASTs in the
  given Whole-AST."
  [whole-ast]
  (->> whole-ast
       whole-ast->modules
       (mapcat :forms)))

(defn update-modules
  "λ Whole-AST → (λ Module → args * → Module) → args *

  Updates every module in the AST, replacing it with (apply f module
  args). Intended to eliminate repetitive Whole-AST comprehensions in
  pass implementations."
  [{:keys [modules] :as whole-ast} f & args]
  (->> (for [m modules]
         [m (apply f (get whole-ast m) args)])
       (into {})
       (merge whole-ast)))

(defn update-forms
  "λ Whole-AST → (λ Form → args * → Form) → args *

  Updates every form in the given Whole-ast, replacing it with (apply
  f form args). Intended to eliminate repetitive Whole-AST
  comprehensions in pass implementations. Note that if a form is nil,
  it will be discarded. Consequently this operation and anything built
  atop it has the potential to be highly destructive."
  [whole-ast f & args]
  (-> whole-ast
      (update-modules
       (fn [module]
         (update module :forms
                 (fn [forms]
                   (->> forms
                        (map #(apply f %1 args))
                        (keep identity)
                        (vec))))))))

;; Passes are then functions from Whole-ASTs to Whole-ASTs. For user
;; "friendliness" each pass shall also take an options argument which
;; may change the behavior of the pass by enabling or disabling a
;; given transformation or logging output.
;;
;; As it is considered good practice for passes to be composed to
;; achieve some result rather than being monolithic, passes are
;; expected to depend on other passes, especially when a given
;; transformation requires previous enabling analysis. To assist this
;; pattern, when a non-transforming pass completes, it is expected to
;; conj it's identifier into the :passes set. Other passes may then
;; elect not to re-run analyses on which they depend if they have
;; already been run.

(defn record-pass
  [whole-ast pass]
  (update-in whole-ast [:passes] (fn [x y] (conj (or x #{}) y)) pass))

(defn require-pass
  [whole-ast pass options]
  (if (contains? (:passes whole-ast) pass)
    whole-ast
    (pass whole-ast options)))

(defn do-passes
  [whole-ast options & passes]
  (reduce #(require-pass %1 %2 options)
          whole-ast passes))

;; To enable this pattern however, transforming passes are required to
;; clobber the :passes key replacing it with #{}. This indicates to
;; subsequent passes that while information may exist in the program
;; AST it is likely stale and should (must) be re-analyzed before use.

(defn clobber-passes
  [whole-ast]
  (assoc whole-ast :passes #{}))

Tweak update-forms to drop nil forms

Tweak update-forms to drop nil forms


(ns play-clj.core
  (:require [play-clj.utils :as u])
  (:import [com.badlogic.gdx Application Audio Files Game Gdx Graphics Input
            InputMultiplexer InputProcessor Net Screen]
           [com.badlogic.gdx.audio Sound]
           [com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera
            PerspectiveCamera VertexAttributes$Usage]
           [com.badlogic.gdx.graphics.g2d NinePatch ParticleEffect SpriteBatch
            TextureRegion]
           [com.badlogic.gdx.graphics.g3d Environment ModelBatch ModelInstance]
           [com.badlogic.gdx.input GestureDetector
            GestureDetector$GestureListener]
           [com.badlogic.gdx.maps MapLayer MapLayers]
           [com.badlogic.gdx.maps.tiled TiledMap TiledMapTileLayer
            TiledMapTileLayer$Cell TmxMapLoader]
           [com.badlogic.gdx.maps.tiled.renderers
            BatchTiledMapRenderer
            HexagonalTiledMapRenderer
            IsometricStaggeredTiledMapRenderer
            IsometricTiledMapRenderer
            OrthogonalTiledMapRenderer]
           [com.badlogic.gdx.physics.box2d ContactListener Joint World]
           [com.badlogic.gdx.scenes.scene2d Actor Stage]
           [com.badlogic.gdx.scenes.scene2d.utils ActorGestureListener Align
            ChangeListener ClickListener DragListener FocusListener]))

(load "core_global")
(load "core_graphics")
(load "core_listeners")

(defn ^:private reset-changed!
  "Internal use only"
  [e-atom e-old e-new]
  (when (not= e-old e-new)
    (compare-and-set! e-atom e-old e-new)))

(defn defscreen*
  "Internal use only"
  [{:keys [on-show on-render on-hide on-pause on-resize on-resume]
    :as options}]
  (let [screen (atom {})
        entities (atom '())
        execute-fn! (fn [func & {:keys [] :as options}]
                      (when func
                        (let [old-entities @entities]
                          (some->> (func (merge @screen options) old-entities)
                                   list
                                   flatten
                                   (remove nil?)
                                   (reset-changed! entities old-entities)))))]
    ; update screen when either the screen or entities are changed
    (add-watch screen :changed (fn [_ _ _ new-screen]
                                 (update-screen! new-screen)))
    (add-watch entities :changed (fn [_ _ _ new-entities]
                                   (update-screen! @screen new-entities)))
    ; return a map with all values related to the screen
    {:screen screen
     :entities entities
     :show (fn []
             (swap! screen assoc
                    :total-time 0
                    :update-fn! #(swap! screen merge %)
                    :ui-listeners (ui-listeners options execute-fn!)
                    :g2dp-listener (contact-listener options execute-fn!))
             (execute-fn! on-show))
     :render (fn [d]
               (swap! screen #(assoc % :total-time (+ (:total-time %) d)))
               (execute-fn! on-render :delta-time d))
     :hide #(execute-fn! on-hide)
     :pause #(execute-fn! on-pause)
     :resize #(execute-fn! on-resize :width %1 :height %2)
     :resume #(execute-fn! on-resume)
     :input-listeners (global-listeners options execute-fn!)}))

(defmacro defscreen
  "Creates vars for all the anonymous functions provided to it, so they can be
replaced by simply reloading the namespace, and creates a var for the symbol `n`
bound to a map containing various important values related to the screen"
  [n & {:keys [] :as options}]
  `(let [fns# (->> (for [[k# v#] ~options]
                     [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
                   flatten
                   (apply hash-map))]
     (defonce ~n (defscreen* fns#))))

(defn defgame*
  "Internal use only"
  [{:keys [on-create]}]
  (proxy [Game] []
    (create []
      (when on-create (on-create this)))))

(defmacro defgame
  "Creates a var for the symbol `n` bound to a [Game](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Game.html)
object"
  [n & {:keys [] :as options}]
  `(defonce ~n (defgame* ~options)))

(defn set-screen!
  "Creates a [Screen](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Screen.html)
object, sets it as the screen for the `game`, and runs the functions from
`screens` in the order they are provided in

    (set-screen! hello-world main-screen text-screen)"
  [^Game game & screens]
  (let [add-inputs! (fn []
                      (input! :set-input-processor (InputMultiplexer.))
                      (doseq [{:keys [input-listeners]} screens]
                        (doseq [listener input-listeners]
                          (add-input! listener))))
        run-fn! (fn [k & args]
                  (doseq [screen screens]
                    (apply (get screen k) args)))]
    (.setScreen game (reify Screen
                       (show [this] (add-inputs!) (run-fn! :show))
                       (render [this d] (run-fn! :render d))
                       (hide [this] (run-fn! :hide))
                       (pause [this] (run-fn! :pause))
                       (resize [this w h] (run-fn! :resize w h))
                       (resume [this] (run-fn! :resume))
                       (dispose [this])))))

(defn update!
  "Runs the equivalent of `(swap! screen-atom assoc ...)`, where `screen-atom`
is the atom storing the screen map behind the scenes, and returns the new screen
map

    (update! screen :renderer (stage))"
  [{:keys [update-fn!]} & {:keys [] :as args}]
  (update-fn! args))

(ns play-clj.core
  (:require [play-clj.utils :as u])
  (:import [com.badlogic.gdx Application Audio Files Game Gdx Graphics Input
            InputMultiplexer InputProcessor Net Screen]
           [com.badlogic.gdx.audio Sound]
           [com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera
            PerspectiveCamera VertexAttributes$Usage]
           [com.badlogic.gdx.graphics.g2d NinePatch ParticleEffect SpriteBatch
            TextureRegion]
           [com.badlogic.gdx.graphics.g3d Environment ModelBatch ModelInstance]
           [com.badlogic.gdx.input GestureDetector
            GestureDetector$GestureListener]
           [com.badlogic.gdx.maps MapLayer MapLayers]
           [com.badlogic.gdx.maps.tiled TiledMap TiledMapTileLayer
            TiledMapTileLayer$Cell TmxMapLoader]
           [com.badlogic.gdx.maps.tiled.renderers
            BatchTiledMapRenderer
            HexagonalTiledMapRenderer
            IsometricStaggeredTiledMapRenderer
            IsometricTiledMapRenderer
            OrthogonalTiledMapRenderer]
           [com.badlogic.gdx.physics.box2d ContactListener Joint World]
           [com.badlogic.gdx.scenes.scene2d Actor Stage]
           [com.badlogic.gdx.scenes.scene2d.utils ActorGestureListener Align
            ChangeListener ClickListener DragListener FocusListener]))

(load "core_global")
(load "core_graphics")
(load "core_listeners")

(defn ^:private reset-changed!
  "Internal use only"
  [e-atom e-old e-new]
  (when (not= e-old e-new)
    (compare-and-set! e-atom e-old e-new)))

(defn defscreen*
  "Internal use only"
  [{:keys [on-show on-render on-hide on-pause on-resize on-resume]
    :as options}]
  (let [screen (atom {})
        entities (atom [])
        execute-fn! (fn [func & {:keys [] :as options}]
                      (when func
                        (let [old-entities @entities]
                          (some->> (func (merge @screen options) old-entities)
                                   list
                                   flatten
                                   (remove nil?)
                                   vec
                                   (reset-changed! entities old-entities)))))]
    ; update screen when either the screen or entities are changed
    (add-watch screen :changed (fn [_ _ _ new-screen]
                                 (update-screen! new-screen)))
    (add-watch entities :changed (fn [_ _ _ new-entities]
                                   (update-screen! @screen new-entities)))
    ; return a map with all values related to the screen
    {:screen screen
     :entities entities
     :show (fn []
             (swap! screen assoc
                    :total-time 0
                    :update-fn! #(swap! screen merge %)
                    :ui-listeners (ui-listeners options execute-fn!)
                    :g2dp-listener (contact-listener options execute-fn!))
             (execute-fn! on-show))
     :render (fn [d]
               (swap! screen #(assoc % :total-time (+ (:total-time %) d)))
               (execute-fn! on-render :delta-time d))
     :hide #(execute-fn! on-hide)
     :pause #(execute-fn! on-pause)
     :resize #(execute-fn! on-resize :width %1 :height %2)
     :resume #(execute-fn! on-resume)
     :input-listeners (global-listeners options execute-fn!)}))

(defmacro defscreen
  "Creates vars for all the anonymous functions provided to it, so they can be
replaced by simply reloading the namespace, and creates a var for the symbol `n`
bound to a map containing various important values related to the screen"
  [n & {:keys [] :as options}]
  `(let [fns# (->> (for [[k# v#] ~options]
                     [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
                   flatten
                   (apply hash-map))]
     (defonce ~n (defscreen* fns#))))

(defn defgame*
  "Internal use only"
  [{:keys [on-create]}]
  (proxy [Game] []
    (create []
      (when on-create (on-create this)))))

(defmacro defgame
  "Creates a var for the symbol `n` bound to a [Game](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Game.html)
object"
  [n & {:keys [] :as options}]
  `(defonce ~n (defgame* ~options)))

(defn set-screen!
  "Creates a [Screen](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Screen.html)
object, sets it as the screen for the `game`, and runs the functions from
`screens` in the order they are provided in

    (set-screen! hello-world main-screen text-screen)"
  [^Game game & screens]
  (let [add-inputs! (fn []
                      (input! :set-input-processor (InputMultiplexer.))
                      (doseq [{:keys [input-listeners]} screens]
                        (doseq [listener input-listeners]
                          (add-input! listener))))
        run-fn! (fn [k & args]
                  (doseq [screen screens]
                    (apply (get screen k) args)))]
    (.setScreen game (reify Screen
                       (show [this] (add-inputs!) (run-fn! :show))
                       (render [this d] (run-fn! :render d))
                       (hide [this] (run-fn! :hide))
                       (pause [this] (run-fn! :pause))
                       (resize [this w h] (run-fn! :resize w h))
                       (resume [this] (run-fn! :resume))
                       (dispose [this])))))

(defn update!
  "Runs the equivalent of `(swap! screen-atom assoc ...)`, where `screen-atom`
is the atom storing the screen map behind the scenes, and returns the new screen
map

    (update! screen :renderer (stage))"
  [{:keys [update-fn!]} & {:keys [] :as args}]
  (update-fn! args))

Make the entities list a vector

Make the entities list a vector


(ns todo-repl-webapp.handler
  (:use compojure.core
        hiccup.core)
  (:require [compojure.handler :as handler]
            [compojure.route :as route]
            [hiccup.form :as form]
            [ring.adapter.jetty :as jetty]))

(defn home-page [& x]
  (html [:head [:title "todo-repl"]]
        [:body [:h1 "todo-repl"]
               (form/form-to [:put "/eval"]
                        (form/text-area [] "blah")
                        [:br]
                        (form/submit-button "eval"))]))
(defn eval-page [& x]
  (html [:h1 x]))

(defroutes app-routes
  (GET "/" [] (home-page))
  (PUT "/eval/:x" [x] (eval-page x))
  (route/resources "/")
  (route/not-found "Not Found"))

(def app
  (handler/site app-routes))

(defn -main [port]
  (jetty/run-jetty app-routes {:port (Integer. port) :join? false}))

(ns todo-repl-webapp.handler
  (:gen-class :main true)
  (:use compojure.core
        hiccup.core)
  (:require [compojure.handler :as handler]
            [compojure.route :as route]
            [hiccup.form :as form]
            [ring.adapter.jetty :as jetty]))

(defn home-page [& x]
  (html [:head [:title "todo-repl"]]
        [:body [:h1 "todo-repl"]
               (form/form-to [:put "/eval"]
                        (form/text-area [] "blah")
                        [:br]
                        (form/submit-button "eval"))]))
(defn eval-page [& x]
  (html [:h1 x]))

(defroutes app-routes
  (GET "/" [] (home-page))
  (PUT "/eval/:x" [x] (eval-page x))
  (route/resources "/")
  (route/not-found "Not Found"))

(def app
  (handler/site app-routes))

(defn -main [port]
  (jetty/run-jetty app-routes {:port (Integer. port) :join? false}))

Add gen-class dec to todo-repl-webapp.handler


{
  :user {
    :plugins [
      [cider/cider-nrepl "0.7.0"]
      [lein-ancient "0.5.5"]
    ]
  }
  :dev {
    :dependencies [[clj-stacktrace "0.2.8"]]
    :injections [(require 'clj-stacktrace.repl)]
    :repl-options {
      :caught clj-stacktrace.repl/pst+
    }
  }
}

{
  :user {
    :plugins [
      [cider/cider-nrepl "0.8.2"]
      [lein-ancient "0.5.5"]
    ]
  }
  :dev {
    :dependencies [[clj-stacktrace "0.2.8"]]
    :injections [(require 'clj-stacktrace.repl)]
    :repl-options {
      :caught clj-stacktrace.repl/pst+
    }
  }
}

Update cider

Update cider


(ns ^{:author "Daniel Leong"
      :doc "Communication functions; copied for convenience into core"}
  rainboots.comms
  (:require [clojure.core.async :refer [put!]]
            [aleph.tcp :as tcp]
            [manifold.stream :as s]
            [rainboots
             [color :refer [process-colors strip-colors]]
             [hooks :refer [hook! trigger!]]]))

(def ^:dynamic *svr*)

(defn default-colorize-hook
  "Default hook fn for colorizing output, installed by default.
   Automatically strips color codes if the client has declared it
   doesn't support them."
  [{:keys [cli text] :as arg}]
  (update arg :text (if (:colors @cli)
                      process-colors
                      strip-colors)))

(hook! :process-send! default-colorize-hook)

(defmacro ^:private with-extras
  "Expects the following vars to be defined in context:
  - process-extras?
  - body
  - <cli-var> (you provide)
  This then declares `process-extras` and shifts vars around
  as appropriate."
  [cli-var & body]
  (let [cli-decl (when cli-var
                   `(~cli-var (if ~'has-extras?
                                ~cli-var
                                ~'process-extras?)))
        no-extras-body (if cli-var
                         `(cons ~cli-var ~'body)
                         `(cons ~'process-extras? ~'body))]
    `(let [~'has-extras? (map? ~'process-extras?)
           ~'process-extras (if ~'has-extras?
                              ~'process-extras?
                              {})
           ~'body (if ~'has-extras?
                    ~'body
                    ~no-extras-body)
           ~@cli-decl]
       ~@body)))

;;
;; The following are manually def'd so they can have nice, clean
;; arglists in the help docs, specifying clearly how they may be used:
;;

(def
  ^{:doc
    "Send text to the client. You can pass in a variable number of
     args, which may in turn be strings, vectors, or functions. Vectors
     will be treated as additional varargs (IE: (apply)'d to this
     function).  Functions will be called with the client as a single
     argument, and the result sent as if it were passed directly.
     Strings, and any string returned by a function argument or in a
     vector, will be processed for color sequences (see the colors
     module).

    Maps will be treated as telnet sequences (see telnet!) Strings are
     processed via the :process-send! hook, which is how the colors are
     applied. :process-send!  is triggered with a map containing the
     recipient as :cli and the text as :text.

    You may optionally provide a map as the first argument, before the
     client object, whose keys and values will also be passed along in
     the map for the :process-send! hook."
    :arglists '([cli & body]
                [process-extras cli & body])}
  send!
  (fn [process-extras? cli & body]
    (with-extras cli
      (let [cli' @cli]
        (when-let [s (:stream cli')]
          (doseq [p body]
            (when p
              (condp #(%1 %2) p
                vector? (apply send! process-extras cli p)
                string? (s/put! s (:text
                                    (trigger! :process-send!
                                              (assoc process-extras
                                                     :cli cli
                                                     :text p))))
                map? (s/put! s p)
                fn? (send! process-extras cli (p cli)))))

          (s/put! s "\r\n")

          ; attempt to prompt
          (when-not (:rainboots/in-prompt process-extras)
            (when-let [prompt-chan (:rainboots/prompt-chan cli')]
              (put! prompt-chan cli))))))))

(def
  ^{:doc
    "Send text to every connected client for which (pred cli) returns
     true. The message body will be handled in the same way (send!)
     handles it. See send! for the meaning of the optional
     process-extras."
    :arglists '([pred & body]
                [process-extras pred & body])}
  send-if!
  (fn [process-extras? pred & body]
    (when (bound? #'*svr*)
      (when-let [connected (:connected @*svr*)]
        (when-let [clients (seq @connected)]
          (with-extras pred
            (doseq [cli clients]
              (when (pred cli)
                (apply send! process-extras cli body)))))))))

(def
  ^{:doc
    "Send text to every connected client. This is a convenience
     function. See send! for the meaning of the optional
     process-extras"
    :arglists '([& body]
                [process-extras & body])}
  send-all!
  (fn [process-extras? & body]
    (with-extras nil
      (apply send-if! process-extras (constantly true) body))))

(defn redef-svr!
  [svr]
  (def ^:dynamic *svr* svr))

(ns ^{:author "Daniel Leong"
      :doc "Communication functions; copied for convenience into core"}
  rainboots.comms
  (:require [clojure.core.async :refer [put!]]
            [manifold.stream :as s]
            [rainboots
             [color :refer [process-colors strip-colors]]
             [hooks :refer [hook! trigger!]]]))

(def ^:dynamic *svr*)

(defn default-colorize-hook
  "Default hook fn for colorizing output, installed by default.
   Automatically strips color codes if the client has declared it
   doesn't support them."
  [{:keys [cli _text] :as arg}]
  (update arg :text (if (:colors @cli)
                      process-colors
                      strip-colors)))

(hook! :process-send! default-colorize-hook)

(defmacro ^:private with-extras
  "Expects the following vars to be defined in context:
  - body
  - <?process-extras> (you provide)
  - <cli-var> (you provide)
  This then declares `process-extras` and shifts vars around
  as appropriate."
  [?process-extras-var cli-var & body]
  (let [cli-decl (when cli-var
                   `(~cli-var (if ~'has-extras?
                                ~cli-var
                                ~?process-extras-var)))
        no-extras-body (if cli-var
                         `(cons ~cli-var ~'body)
                         `(cons ~?process-extras-var ~'body))]
    `(let [~'has-extras? (map? ~?process-extras-var)
           ~'process-extras (if ~'has-extras?
                              ~?process-extras-var
                              {})
           ~'body (if ~'has-extras?
                    ~'body
                    ~no-extras-body)
           ~@cli-decl]
       ~@body)))

;;
;; The following are manually def'd so they can have nice, clean
;; arglists in the help docs, specifying clearly how they may be used:
;;

(def
  ^{:doc
    "Send text to the client. You can pass in a variable number of
     args, which may in turn be strings, vectors, or functions. Vectors
     will be treated as additional varargs (IE: (apply)'d to this
     function).  Functions will be called with the client as a single
     argument, and the result sent as if it were passed directly.
     Strings, and any string returned by a function argument or in a
     vector, will be processed for color sequences (see the colors
     module).

    Maps will be treated as telnet sequences (see telnet!) Strings are
     processed via the :process-send! hook, which is how the colors are
     applied. :process-send!  is triggered with a map containing the
     recipient as :cli and the text as :text.

    You may optionally provide a map as the first argument, before the
     client object, whose keys and values will also be passed along in
     the map for the :process-send! hook."
    :arglists '([cli & body]
                [process-extras cli & body])}
  send!
  (fn [?process-extras cli & body]
    (with-extras ?process-extras cli
      (let [cli' @cli]
        (when-let [s (:stream cli')]
          (doseq [p body]
            (when p
              (condp #(%1 %2) p
                vector? (apply send! process-extras cli p)
                string? (s/put! s (:text
                                    (trigger! :process-send!
                                              (assoc process-extras
                                                     :cli cli
                                                     :text p))))
                map? (s/put! s p)
                fn? (send! process-extras cli (p cli)))))

          (s/put! s "\r\n")

          ; attempt to prompt
          (when-not (:rainboots/in-prompt process-extras)
            (when-let [prompt-chan (:rainboots/prompt-chan cli')]
              (put! prompt-chan cli))))))))

(def
  ^{:doc
    "Send text to every connected client for which (pred cli) returns
     true. The message body will be handled in the same way (send!)
     handles it. See send! for the meaning of the optional
     process-extras."
    :arglists '([pred & body]
                [process-extras pred & body])}
  send-if!
  (fn [?process-extras pred & body]
    (when (bound? #'*svr*)
      (when-let [clients (some-> @*svr* :connected deref seq)]
        (doseq [cli clients]
          (when (pred cli)
            (with-extras ?process-extras cli
              (apply send! process-extras cli body))))))))

(def
  ^{:doc
    "Send text to every connected client. This is a convenience
     function. See send! for the meaning of the optional
     process-extras"
    :arglists '([& body]
                [process-extras & body])}
  send-all!
  (fn [?process-extras & body]
    (with-extras ?process-extras nil
      (apply send-if! process-extras (constantly true) body))))

(defn redef-svr!
  [svr]
  (def ^:dynamic *svr* svr))

Refactor for name clarity, avoiding lint warnings


(ns libx.core-test
    (:require [clojure.test :refer [run-tests]]
              [libx.lang-test]
              [libx.deflogical-test]
              [libx.macros-test]
              [libx.tuple-rule-test]
              [libx.util-test]
              [libx.defaction-test]
              [libx.listeners-test]))

(defn run []
  (for [ns
        ['libx.lang-test
         'libx.deflogical-test
         'libx.macros-test
         'libx.tuple-rule-test
         'libx.util-test
         'libx.defaction-test
         [libx.listeners-test]]]
    (dosync (-> ns (in-ns) (run-tests)))))

(run)

(ns libx.core-test
    (:require [clojure.test :refer [run-tests]]
              [libx.lang-test]
              [libx.deflogical-test]
              [libx.macros-test]
              [libx.tuple-rule-test]
              [libx.util-test]
              [libx.defaction-test]
              [libx.listeners-test]))

(defn run []
  (for [ns
        ['libx.lang-test
         'libx.deflogical-test
         'libx.macros-test
         'libx.tuple-rule-test
         'libx.util-test
         'libx.defaction-test
         '[libx.listeners-test]]]
    (dosync (-> ns (in-ns) (run-tests)))))

(run)

Fix missing quote in core-test

Fix missing quote in core-test


{:user {:dependencies [[clj-stacktrace "0.2.4"]]
        :plugins [[lein-tarsier "0.9.4-SNAPSHOT"]
                  [lein-swank "1.4.4"]
                  [lein-difftest "1.3.7"]
                  [lein-clojars "0.9.0"]
                  ;[jark/jark-server "0.4.0"]
                  [lein-pprint "1.1.1"]
                  [slamhound "1.2.0"]
                  [lein-cljsbuild "0.1.9"]
                  [lein-deps-tree "0.1.1"]
                  ;[lein-autodoc "0.9.0"]
                  [lein-marginalia "0.7.1"]]
        :repl-options {:timeout 60000}
        :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
                                            'print-cause-trace)
                           new (ns-resolve (doto 'clj-stacktrace.repl require)
                                           'pst)]
                       (alter-var-root orig (constantly @new)))]
        :vimclojure-opts {:repl true}}}

{:user {:dependencies [[clj-stacktrace "0.2.4"]]
        :plugins [[lein-tarsier "0.9.4-SNAPSHOT"]
                  [lein-swank "1.4.4"]
                  [lein-difftest "1.3.7"]
                  [lein-clojars "0.9.1"]
                  ;[jark/jark-server "0.4.0"]
                  [lein-pprint "1.1.1"]
                  [slamhound "1.2.0"]
                  [lein-cljsbuild "0.1.9"]
                  [lein-deps-tree "0.1.1"]
                  ;[lein-autodoc "0.9.0"]
                  [lein-marginalia "0.7.1"]]
        :repl-options {:timeout 60000}
        :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
                                            'print-cause-trace)
                           new (ns-resolve (doto 'clj-stacktrace.repl require)
                                           'pst)]
                       (alter-var-root orig (constantly @new)))]
        :vimclojure-opts {:repl true}}}

Upgrade lein-clojars to 0.9.1.

Upgrade lein-clojars to 0.9.1.


{:foreign-libs
 [{:file "js/snapsvg/snap.svg.js"
   :file-min "js/snapsvg/snap.svg.min.js"
   :provides ["vendor.snapsvg"]}]
 :externs ["js/snapsvg/externs.js"]}

{:foreign-libs
 [{:file "js/snapsvg/snap.svg.js"
   :file-min "js/snapsvg/snap.svg.min.js"
   :provides ["vendor.snapsvg"]}
  {:file "js/jszip/jszip.js"
   :file-min "js/jszip/jszip.min.js"
   :provides ["vendor.jszip"]}]
 :externs ["js/snapsvg/externs.js"
           "js/jszip/externs.js"]}

Add jszip into resources/deps.cljs.

Add jszip into resources/deps.cljs.


; 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

; ; Plugins Jan
; Calva
; Clojure
; GitLens
; Python
; "TODO Highlight"
; Todo Tree

add extension documentation

add extension documentation


{:dev
 {:aliases {"test-all" ["with-profile" "dev,1.7:dev" "test"]}
  :codeina {:sources ["src"]
            :reader :clojure
            :target "doc/dist/latest/api"
            :src-uri "http://github.com/funcool/buddy-core/blob/master/"
            :src-uri-prefix "#L"}
  :plugins [[funcool/codeina "0.4.0"]
            [lein-ancient "0.6.10"]]}
 :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}

 :examples
 {:dependencies [[ring "1.4.0"]
                 [ring/ring-json "0.4.0"]
                 [compojure "1.4.0"]]}

 :session-example
 [:examples
  {:source-paths ["examples/session/src"]
   :resource-paths ["examples/session/resources"]
   :main ^:skip-aot authexample.web}]

 :httpbasic-example
 [:examples
  {:source-paths ["examples/httpbasic/src"]
   :resource-paths ["examples/httpbasic/resources"]
   :main ^:skip-aot authexample.web}]

 :token-example
 [:examples
  {:source-paths ["examples/token/src"]
   :resource-paths ["examples/token/resources"]
   :main ^:skip-aot authexample.web}]

 :jws-example
 [:examples
  {:source-paths ["examples/jws/src"]
   :resource-paths ["examples/jws/resources"]
   :main ^:skip-aot authexample.web}]

 :jwe-example
 [:examples
  {:source-paths ["examples/jwe/src"]
   :resource-paths ["examples/jwe/resources"]
   :main ^:skip-aot authexample.web}]
 }

{:dev
 {:aliases {"test-all" ["with-profile" "dev,1.7:dev,1.8:dev" "test"]}
  :codeina {:sources ["src"]
            :reader :clojure
            :target "doc/dist/latest/api"
            :src-uri "http://github.com/funcool/buddy-core/blob/master/"
            :src-uri-prefix "#L"}
  :plugins [[funcool/codeina "0.4.0"]
            [lein-ancient "0.6.10"]]}

 :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]}
 :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}

 :examples
 {:dependencies [[ring "1.4.0"]
                 [ring/ring-json "0.4.0"]
                 [compojure "1.4.0"]]}

 :session-example
 [:examples
  {:source-paths ["examples/session/src"]
   :resource-paths ["examples/session/resources"]
   :main ^:skip-aot authexample.web}]

 :httpbasic-example
 [:examples
  {:source-paths ["examples/httpbasic/src"]
   :resource-paths ["examples/httpbasic/resources"]
   :main ^:skip-aot authexample.web}]

 :token-example
 [:examples
  {:source-paths ["examples/token/src"]
   :resource-paths ["examples/token/resources"]
   :main ^:skip-aot authexample.web}]

 :jws-example
 [:examples
  {:source-paths ["examples/jws/src"]
   :resource-paths ["examples/jws/resources"]
   :main ^:skip-aot authexample.web}]

 :jwe-example
 [:examples
  {:source-paths ["examples/jwe/src"]
   :resource-paths ["examples/jwe/resources"]
   :main ^:skip-aot authexample.web}]
 }

Add clojure 1.8 to the test suite.

Add clojure 1.8 to the test suite.


(ns org.spootnik.cyanite.http
  "Very simple asynchronous HTTP API, implements two
   routes: paths and metrics to query existing paths
   and retrieve metrics"
  (:use net.cgrand.moustache)
  ;(:use lamina.core)
  (:use aleph.http)
  (:use ring.middleware.json)
  (:use ring.middleware.params)
  (:use ring.middleware.keyword-params)
  (:require [ring.util.codec            :as codec]
            [org.spootnik.cyanite.store :as store]
            [org.spootnik.cyanite.rollup :as rollup]
            [org.spootnik.cyanite.path  :as path]
            [org.spootnik.cyanite.util  :refer [counter-inc! now]]
            [cheshire.core              :as json]
            [clojure.string             :as str]
            [lamina.core                :refer [enqueue]]
            [clojure.string             :refer [lower-case]]
            [clojure.tools.logging      :refer [info error debug]]))

(defn wrap-local-params [handler params]
  "Adds additional parameters to request"
  (fn [request]
    (handler (assoc request :local-params params))))

(defn paths-handler [response-channel {{:keys [query tenant]}  :params
                                       {:keys [index]} :local-params}]
  (debug "query now: " query)
  (enqueue
    response-channel
    (try
      {:status 200
       :headers {"Content-Type" "application/json"}
       :body (json/generate-string
               (path/prefixes index (or tenant "NONE") (if (str/blank? query) "*" query)))}
      (catch Exception e
        (let [{:keys [status body suppress?]} (ex-data e)]
          (when-not suppress?
            (error e "could not process request"))
          {:status (or status 500)
           :headers {"Content-Type" "application/json"}
           :body    (json/generate-string
                      (or body {:error (.getMessage e)}))})))))

(defn lookup-path
  [index tenant path]
  (path/lookup index tenant path))

(defn lookup-paths
  [index tenant paths]
  (let [paths (if (sequential? paths) paths [paths])]
    (flatten (pmap (partial lookup-path index tenant) paths))))

(defn metrics-handler [response-channel
                       {{:keys [index store rollup-finder]} :local-params
                        {:keys [from to path agg tenant]} :params :as request}]
  (debug "fetching paths: " path)
  (enqueue
   response-channel
    (try
      (do
        (counter-inc! (keyword (str "tenants." tenant ".metrics_read")) 1)
        {:status 200
         :headers {"Content-Type" "application/json"}
         :body (let [to (if to (Long/parseLong (str to)) (now))
                     from (Long/parseLong (str from))]
                 (if-let [{:keys [rollup period]}
                          (rollup/find-rollup rollup-finder from to)]
                   (let [paths (lookup-paths index (or tenant "NONE") path)]
                     (store/fetch store (or agg "mean") paths (or tenant "NONE")
                                  rollup period from to))
                   (json/generate-string
                    {:step nil :from nil :to nil :series {}})))})
      (catch Exception e
        (let [{:keys [status body suppress?]} (ex-data e)]
          (when-not suppress?
            (error e "could not process request"))
          {:status (or status 500)
           :headers {"Content-Type" "application/json"}
           :body    (json/generate-string
                     (or body {:error (.getMessage e)}))})))))

(def handler
  (app
    ["ping"] {:get "OK"}
    ["metrics"] {:any (-> metrics-handler
                          (wrap-aleph-handler)
                          (wrap-keyword-params)
                          (wrap-json-params)
                          (wrap-params))}
    ["paths"] {:any (-> paths-handler
                        (wrap-aleph-handler)
                        (wrap-keyword-params)
                        (wrap-json-params)
                        (wrap-params))}
    [&] {:any (json/generate-string {:status "Error" :reason "Unknown action"})}))

(defn start
  "Start the API, handling each request by parsing parameters and
   routes then handing over to the request processor"
  [{:keys [http store-middleware rollup-finder index] :as config}]
  (start-http-server (wrap-ring-handler  (wrap-local-params handler {:store store-middleware
                                                                     :rollup-finder rollup-finder
                                                                     :index index})) http)
  nil)

(ns org.spootnik.cyanite.http
  "Very simple asynchronous HTTP API, implements two
   routes: paths and metrics to query existing paths
   and retrieve metrics"
  (:use net.cgrand.moustache)
  ;(:use lamina.core)
  (:use aleph.http)
  (:use ring.middleware.json)
  (:use ring.middleware.params)
  (:use ring.middleware.keyword-params)
  (:require [ring.util.codec            :as codec]
            [org.spootnik.cyanite.store :as store]
            [org.spootnik.cyanite.rollup :as rollup]
            [org.spootnik.cyanite.path  :as path]
            [org.spootnik.cyanite.util  :refer [counter-inc! now]]
            [cheshire.core              :as json]
            [clojure.string             :as str]
            [lamina.core                :refer [enqueue]]
            [clojure.string             :refer [lower-case]]
            [clojure.tools.logging      :refer [info error debug]]))

(defn wrap-local-params [handler params]
  "Adds additional parameters to request"
  (fn [request]
    (handler (assoc request :local-params params))))

(defn paths-handler [response-channel {{:keys [query tenant]}  :params
                                       {:keys [index]} :local-params}]
  (debug "query now: " query)
  (enqueue
    response-channel
    (try
      {:status 200
       :headers {"Content-Type" "application/json"}
       :body (json/generate-string
               (path/prefixes index (or tenant "NONE") (if (str/blank? query) "*" query)))}
      (catch Exception e
        (let [{:keys [status body suppress?]} (ex-data e)]
          (when-not suppress?
            (error e "could not process request"))
          {:status (or status 500)
           :headers {"Content-Type" "application/json"}
           :body    (json/generate-string
                      (or body {:error (.getMessage e)}))})))))

(defn lookup-path
  [index tenant path]
  (path/lookup index tenant path))

(defn has-wildcard?
  [path]
  (if (re-find #"(\*|\[|\{)" path) true false))

(defn lookup-paths
  [index tenant paths]
  (let [paths (if (sequential? paths) paths [paths])]
    (if (and (= (count paths) 1) (has-wildcard? (first paths)))
      (flatten (pmap (partial lookup-path index tenant) paths))
      paths)))

(defn metrics-handler [response-channel
                       {{:keys [index store rollup-finder]} :local-params
                        {:keys [from to path agg tenant]} :params :as request}]
  (debug "fetching paths: " path)
  (enqueue
   response-channel
    (try
      (do
        (counter-inc! (keyword (str "tenants." tenant ".metrics_read")) 1)
        {:status 200
         :headers {"Content-Type" "application/json"}
         :body (let [to (if to (Long/parseLong (str to)) (now))
                     from (Long/parseLong (str from))]
                 (if-let [{:keys [rollup period]}
                          (rollup/find-rollup rollup-finder from to)]
                   (let [paths (lookup-paths index (or tenant "NONE") path)]
                     (store/fetch store (or agg "mean") paths (or tenant "NONE")
                                  rollup period from to))
                   (json/generate-string
                    {:step nil :from nil :to nil :series {}})))})
      (catch Exception e
        (let [{:keys [status body suppress?]} (ex-data e)]
          (when-not suppress?
            (error e "could not process request"))
          {:status (or status 500)
           :headers {"Content-Type" "application/json"}
           :body    (json/generate-string
                     (or body {:error (.getMessage e)}))})))))

(def handler
  (app
    ["ping"] {:get "OK"}
    ["metrics"] {:any (-> metrics-handler
                          (wrap-aleph-handler)
                          (wrap-keyword-params)
                          (wrap-json-params)
                          (wrap-params))}
    ["paths"] {:any (-> paths-handler
                        (wrap-aleph-handler)
                        (wrap-keyword-params)
                        (wrap-json-params)
                        (wrap-params))}
    [&] {:any (json/generate-string {:status "Error" :reason "Unknown action"})}))

(defn start
  "Start the API, handling each request by parsing parameters and
   routes then handing over to the request processor"
  [{:keys [http store-middleware rollup-finder index] :as config}]
  (start-http-server (wrap-ring-handler  (wrap-local-params handler {:store store-middleware
                                                                     :rollup-finder rollup-finder
                                                                     :index index})) http)
  nil)

Optimize paths lookup in index

Optimize paths lookup in index


(ns videotest.falling.cv-draw
  (:import
   [org.opencv.core Core MatOfPoint Scalar]
   [java.util ArrayList]))

(defn draw-poly-with-pts
  "Draw a filled polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [poly (MatOfPoint.)
        c (apply (fn [r g b a]
                   (Scalar. r g b a))
                 color)]
    (.fromList poly (ArrayList. glyph-pts))
    (Core/fillPoly img-mat (ArrayList. [poly]) c)))

(defn draw-line-with-pts
  [img-mat color-scalar [pt1 pt2]]
  (Core/line img-mat pt1 pt2 color-scalar 1 Core/LINE_4 0))

(defn draw-poly-outline-with-pts
  "Draw an outlined polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [pts (take 3 (partition 2 1 (cycle glyph-pts)))
        c (apply (fn [r g b a]
                   (Scalar. r g b a))
                 color)]
    (dorun
     (map (partial draw-line-with-pts
                   img-mat
                   c)
          pts))))

(defn draw-partial-poly-outline-with-pts
  "Draw an outlined polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [pts (take 3 (partition 2 1 (cycle glyph-pts)))
        rand-nth (rand-int (count pts))
        ;;pts (concat (take rand-nth pts) (drop (inc rand-nth) pts))
        pts (nth pts rand-nth)
        c (apply (fn [r g b a]
                   (Scalar. r g b a))
                 color)]
    (draw-line-with-pts img-mat c pts)))

(ns videotest.falling.cv-draw
  (:import
   [org.opencv.core Core MatOfPoint Scalar]
   [java.util ArrayList]))

(defn draw-poly-with-pts
  "Draw a filled polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [poly (MatOfPoint.)
        c (if (> 4 (count color))
            (Scalar. 0 0 0 255)
            (apply (fn [r g b a]
                          (Scalar. r g b a))
                        color))]
    (.fromList poly (ArrayList. glyph-pts))
    (Core/fillPoly img-mat (ArrayList. [poly]) c)))

(defn draw-line-with-pts
  [img-mat color-scalar [pt1 pt2]]
  (Core/line img-mat pt1 pt2 color-scalar 1 Core/LINE_4 0))

(defn draw-poly-outline-with-pts
  "Draw an outlined polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [pts (take 3 (partition 2 1 (cycle glyph-pts)))
        c (apply (fn [r g b a]
                   (Scalar. r g b a))
                 color)]
    (dorun
     (map (partial draw-line-with-pts
                   img-mat
                   c)
          pts))))

(defn draw-partial-poly-outline-with-pts
  "Draw an outlined polygon with the given points and color."
  [img-mat color glyph-pts]
  (let [pts (take 3 (partition 2 1 (cycle glyph-pts)))
        rand-nth (rand-int (count pts))
        ;;pts (concat (take rand-nth pts) (drop (inc rand-nth) pts))
        pts (nth pts rand-nth)
        c (apply (fn [r g b a]
                   (Scalar. r g b a))
                 color)]
    (draw-line-with-pts img-mat c pts)))

Add guard against bad data.

Add guard against bad data.


(defproject ring/ring-jetty-adapter "1.7.0"
  :description "Ring Jetty adapter."
  :url "https://github.com/ring-clojure/ring"
  :scm {:dir ".."}
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-core "1.7.0"]
                 [ring/ring-servlet "1.7.0"]
                 [org.eclipse.jetty/jetty-server "9.2.24.v20180105"]]
  :aliases {"test-all" ["with-profile" "default:+1.8:+1.9" "test"]}
  :profiles
  {:dev {:dependencies [[clj-http "2.2.0"]]
         :jvm-opts ["-Dorg.eclipse.jetty.server.HttpChannelState.DEFAULT_TIMEOUT=500"]}
   :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]}
   :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]}})

(defproject ring/ring-jetty-adapter "1.7.0"
  :description "Ring Jetty adapter."
  :url "https://github.com/ring-clojure/ring"
  :scm {:dir ".."}
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-core "1.7.0"]
                 [ring/ring-servlet "1.7.0"]
                 [org.eclipse.jetty/jetty-server "9.4.12.v20180830"]]
  :aliases {"test-all" ["with-profile" "default:+1.8:+1.9" "test"]}
  :profiles
  {:dev {:dependencies [[clj-http "2.2.0"]]
         :jvm-opts ["-Dorg.eclipse.jetty.server.HttpChannelState.DEFAULT_TIMEOUT=500"]}
   :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]}
   :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]}})

Update Jetty dependency to 9.4.12.v20180830

Jetty 9.2 has reached End of Life. See the announcement:
https://www.eclipse.org/lists/jetty-announce/msg00116.html

Fixes #347.


;; Copyright (c) Daniel Borchmann. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.

;;;

(defproject conexp-clj "2.0.0-SNAPSHOT"
  :min-lein-version "2.0.0"
  :description "A ConExp rewrite in clojure"
  :url "http://github.com/exot/conexp-clj/"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure             "1.8.0"]
                 [org.clojure/tools.cli           "0.3.5"]
                 [org.clojure/math.combinatorics  "0.1.1"]
                 [org.clojure/math.numeric-tower  "0.0.4"]
                 [org.apache.commons/commons-math "2.2"]
                 [seesaw                          "1.4.3"]
                 [reply                           "0.3.7"
                  :exclusions [org.clojure/clojure
                               net.cgrand.parsley]]
                 [net.cgrand/parsley              "0.9.3"
                  :exclusions [org.clojure/clojure]]
                 [org.clojure/data.xml            "0.0.8"]
                 [org.clojure/core.async          "0.2.374"]]
  :main conexp.main
  :aot [conexp.main conexp.contrib.java]
  :keep-non-project-classes true
  :source-paths ["src/main/clojure" "src/test/clojure"]
  :java-source-paths ["src/main/java"]
  :test-paths ["src/test/clojure"]
  :resource-paths ["src/main/resources"]
  :target-path "builds/%s"
  :compile-path "%s/classes/"
  :scm {:url "git@github.com:exot/conexp-clj.git"}
  :java-opts ["-Dawt.useSystemAAFontSettings=on"])

;;;

nil

;; Copyright (c) Daniel Borchmann. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.

;;;

(defproject conexp-clj "2.0.0-SNAPSHOT"
  :min-lein-version "2.0.0"
  :description "A ConExp rewrite in clojure"
  :url "http://github.com/exot/conexp-clj/"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure             "1.8.0"]
                 [org.clojure/tools.cli           "0.3.5"]
                 [org.clojure/math.combinatorics  "0.1.3"]
                 [org.clojure/math.numeric-tower  "0.0.4"]
                 [org.apache.commons/commons-math "2.2"]
                 [seesaw                          "1.4.5"]
                 [reply                           "0.3.7"
                  :exclusions [org.clojure/clojure
                               net.cgrand.parsley]]
                 [net.cgrand/parsley              "0.9.3"
                  :exclusions [org.clojure/clojure]]
                 [org.clojure/data.xml            "0.0.8"]
                 [org.clojure/core.async          "0.2.391"]]
  :main conexp.main
  :aot [conexp.main conexp.contrib.java]
  :keep-non-project-classes true
  :source-paths ["src/main/clojure" "src/test/clojure"]
  :java-source-paths ["src/main/java"]
  :test-paths ["src/test/clojure"]
  :resource-paths ["src/main/resources"]
  :target-path "builds/%s"
  :compile-path "%s/classes/"
  :scm {:url "git@github.com:exot/conexp-clj.git"}
  :java-opts ["-Dawt.useSystemAAFontSettings=on"])

;;;

nil

Update project dependencies

Update project dependencies

Signed-off-by: Daniel Borchmann <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@algebra20.de>