From bf621cc444f83034ce56f031cf4fb732178e9768 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Mon, 1 Jun 2020 21:51:08 +0200 Subject: [PATCH 01/12] WIP: oasis in 3 proper modules --- dev_src/dev/core.cljs | 8 +- dev_src/dev/render.cljc | 114 ++- src/samak/nodes.cljc | 6 +- src/samak/pipes.cljc | 55 +- src/samak/runtime.cljc | 82 +- src/samak/runtime/stores.cljc | 2 +- src/samak/stdlib.cljc | 5 +- src/samak/trace.cljc | 16 +- ui_src/samak/caravan.cljc | 25 +- ui_src/samak/layout.cljs | 4 +- ui_src/samak/oasis.cljc | 1613 +++++++++++++++++---------------- 11 files changed, 1041 insertions(+), 889 deletions(-) diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index 72623ed..7fbb592 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -58,12 +58,12 @@ (println "start") (let [in (chan) out (chan)] - (render/start-render-runtime in out) - (let [w (js/Worker. "/js/oasis-worker.js") + (let [;; w (js/Worker. "/js/oasis-worker.js") loading (chan)] + (render/start-render-runtime loading in out) (handle-update loading) - (aset w "onmessage" (make-handler loading in)) - (handle-send w out) + ;; (aset w "onmessage" (make-handler loading in)) + ;; (handle-send w out) ;; (.postMessage w (pr-str {:cmd "init" :args {:name "tl"}})) ) )) diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index 8a5f450..8298a70 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -5,11 +5,14 @@ [clojure.string :as str] [clojure.edn :as edn] [clojure.core.async :as a :refer [! chan go go-loop close! put! pipe]] + [clojure.walk :as w] + [samak.api :as api] [samak.helpers :as helpers] [samak.lisparser :as p] [samak.builtins :as builtins] [samak.stdlib :as std] [samak.trace :as trace] + [samak.oasis :as oasis] [samak.caravan :as caravan] [samak.pipes :as pipes] [samak.runtime :as run] @@ -19,12 +22,15 @@ [clojure.string :as str] [cljs.reader :as edn] [clojure.core.async :as a :refer [! chan close! put! pipe]] + [clojure.walk :as w] + [samak.api :as api] [samak.helpers :as helpers] [samak.lisparser :as p] [samak.ui_stdlib :as uistd] [samak.builtins :as builtins] [samak.stdlib :as std] [samak.trace :as trace] + [samak.oasis :as oasis] [samak.caravan :as caravan] [samak.layout :as layout] [samak.pipes :as pipes] @@ -46,7 +52,9 @@ (def renderer-symbols (merge builtins/samak-symbols - std-mock-symbols + std/pipe-symbols + caravan/symbols + ;; std-mock-symbols #?(:cljs layout/layout-symbols) #?(:cljs uistd/ui-symbols))) @@ -69,8 +77,8 @@ (fn [broadcast] (println "sched") (let [to-rt (pipes/pipe (chan))] - ;; (handle-update "out" broadcast) - ;; (handle-update "in" to-rt) + (handle-update "out" broadcast) + (handle-update "in" to-rt) to-rt))) @@ -91,7 +99,7 @@ (let [p ( mod :-sources :-mouse) 42) (pipes/to-mouse))" "(| ((-> mod :-sources :-keyboard) 42) (pipes/to-keyboard))"]) -(defn eval-render +;; (defn eval-render +;; "" +;; [] +;; (let [code (str/join " " renderer) +;; parsed (p/parse-all code)] +;; (swap! rt #(reduce run/eval-expression! % (:value parsed))))) + +(defn fire-event-into-named-pipe + [pipe-name event] + (let [pipe (run/get-definition-by-name @rt (symbol pipe-name))] + (if (pipes/pipe? pipe) + (do (let [arg (edn/read-string event)] + (pipes/fire! pipe arg pipe-name)) + {}) + (println (str "could not find pipe " pipe-name))))) + +(defn eval-oasis + "" + [length cb state [nr exp]] + (println "eval" nr exp) + (let [progress (int (* (/ nr length) 100))] + (when (= 0 (mod progress 10)) + (put! cb progress) + (println (str progress "%"))) + (update state :server run/eval-all [exp]) + )) + +(defn run-oasis + "" + [state cb] + (put! cb 100) + (reset! rt state) + (caravan/init @rt) + (fire-event-into-named-pipe "oasis-init" "1") + (println "oasis started") + (let [parsed [(api/defexp 'start (api/fn-call (api/symbol 'pipes/debug) []))]] + (doseq [expression parsed] + (caravan/repl-eval expression)))) + +(defn load-bundle "" - [] - (let [code (str/join " " renderer) - parsed (p/parse-all code)] - (swap! rt #(reduce run/eval-expression! % (:value parsed))))) + [sym rt] + (let [_ (print " V" "Fetching bundle from DB: " sym) + bundle (run/load-bundle rt sym) + _ (println bundle) + sources (map #(run/load-network rt %) bundle) + net (reduce (fn [a, v] + (let [val (vals v)] + {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) + :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) + })) + {:nodes (into [] bundle) + :pipes []} + sources)] + net +)) + +(defn load-ast + "loads an ast given by its entity id from the database" + [rt id] + (w/postwalk (fn [form] + (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) + (:db/id form))] + (run/load-by-id rt sub-id) + form)) + (run/load-by-id rt id))) + +(defn start-oasis + [cb] + (let [c (chan) + net (load-bundle 'oasis @rt) + _ (println net) + exps (into (into [] (distinct (:nodes net))) (distinct (:pipes net))) + _ (println exps) + source (map #(load-ast @rt %) exps) + ;; _ (println source) + numbered (map-indexed vector source) + cnt (count numbered)] + (go-loop [state @rt] + (let [part ( " ex))))) (defmethod eval-node ::link [{:keys [::from ::to]}] diff --git a/src/samak/pipes.cljc b/src/samak/pipes.cljc index e616801..fa6b3bd 100644 --- a/src/samak/pipes.cljc +++ b/src/samak/pipes.cljc @@ -1,4 +1,5 @@ (ns samak.pipes + (:refer-clojure :exclude [uuid]) #? (:clj (:require @@ -24,6 +25,7 @@ ;; Pipes and flow control (defprotocol Pipe + (uuid [this]) (in-port [this]) (out-port [this]) (in-spec [this]) @@ -35,20 +37,24 @@ (defprotocol CleanupRequired (clean-up [this])) -(defrecord Sink [ch in-spec] +(defrecord Sink [ch in-spec uuid] Pipe + (uuid [_] uuid) (in-port [_] ch) (in-spec [_] in-spec) (out-port [_] nil) (out-spec [_] nil)) (defn sink - ([ch] (sink ch nil)) + ([ch] (sink ch nil (help/uuid))) ([ch spec] - (Sink. ch in-spec))) + (Sink. ch in-spec (help/uuid))) + ([ch spec uuid] + (Sink. ch in-spec uuid))) -(defrecord Source [ch out-spec] +(defrecord Source [ch out-spec uuid] Pipe + (uuid [_] uuid) (in-port [_] nil) (in-spec [_] nil) (out-port [_] ch) @@ -57,32 +63,37 @@ (defn source ([ch] (source ch nil)) ([ch out-spec] - (Source. (a/mult ch) out-spec))) + (Source. (a/mult ch) out-spec (help/uuid))) + ([ch out-spec uuid] + (Source. (a/mult ch) out-spec uuid))) -(defrecord Pipethrough [in out in-spec out-spec] +(defrecord Pipethrough [in out in-spec out-spec uuid] Pipe + (uuid [_] uuid) (in-port [_] in) (in-spec [_] in-spec) (out-port [_] out) (out-spec [_] out-spec)) (defn pipe - ([ch] (pipe ch nil nil)) - ([ch in-spec out-spec] - (Pipethrough. ch (a/mult ch) in-spec out-spec)) - ([in out] (pipe in out nil nil)) - ([in out in-spec out-spec] - (Pipethrough. in (a/mult out) in-spec out-spec))) + ([ch] (pipe ch nil nil (help/uuid))) + ([ch uuid] (pipe ch nil nil uuid)) + ([ch in-spec out-spec uuid] + (Pipethrough. ch (a/mult ch) in-spec out-spec uuid)) + ([in out uuid] (pipe in out nil nil uuid)) + ([in out in-spec out-spec uuid] + (Pipethrough. in (a/mult out) in-spec out-spec uuid))) -(defn transduction-pipe [xf] - (pipe (chan 1 xf))) +(defn transduction-pipe + ([xf] (transduction-pipe xf nil)) + ([xf uuid] (pipe (chan 1 xf) uuid))) (defn async-pipe [xf in-spec out-spec] (let [in-chan (chan) out-chan (chan)] (a/pipeline-async 1 out-chan xf in-chan) - (Pipethrough. in-chan (a/mult out-chan) in-spec out-spec))) + (Pipethrough. in-chan (a/mult out-chan) in-spec out-spec (help/uuid)))) (def ports (juxt in-port out-port)) @@ -108,6 +119,7 @@ (defn fire-raw! "put a raw event into the given pipe. should be used for testing only." [pipe event] + (println "pipe fire" pipe) (put! (in-port pipe) event)) @@ -159,17 +171,18 @@ [state spec paket] (let [x (::content paket)] (when (not (s/valid? spec x)) - (println "spec error in state " state) + (println "spec error in state" state) (let [reason (s/explain spec x)] - (println reason) + (println "reason for" x ":" reason) reason))) paket) (defn checked-pipe "" - [pipe in-spec out-spec] - (let [in-checked (transduction-pipe (map #(check-values "in" in-spec %))) - out-checked (transduction-pipe (map #(check-values "out" out-spec %)))] + [pipe in-spec out-spec uuid] + (println "checked setup:" uuid (help/uuid)) + (let [in-checked (transduction-pipe (map #(check-values (str uuid "-in") in-spec %))) + out-checked (transduction-pipe (map #(check-values (str uuid "-out") out-spec %)))] (link! in-checked pipe) (link! pipe out-checked) - (Pipethrough. (in-port in-checked) (out-port out-checked) in-spec out-spec))) + (Pipethrough. (in-port in-checked) (out-port out-checked) in-spec out-spec uuid))) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index 029319b..f885960 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -32,6 +32,18 @@ (def resolver (atom {})) (def cancel-conditions (atom {})) +(defn eval-all [server forms] + (reduce (fn [server form] + (swap! resolver #(assoc % :server server)) + (servers/eval-ast server form)) + server forms)) + +(defn load-by-id + "" + [{store :store} id] + (stores/load-by-id store id)) + + (defn cancel? "" [paket] @@ -46,11 +58,6 @@ [id condition] (swap! cancel-conditions update id merge condition)) -(defn eval-all [server forms] - (reduce (fn [server form] - (swap! resolver #(assoc % :server server)) - (servers/eval-ast server form)) - server forms)) (defn resolve-fn ([id] @@ -58,10 +65,11 @@ ([rt id] (let [defs (servers/get-defined (:server rt)) fn (get defs id)] - ;; (println "found: " id fn) - (if fn - fn - (println "not found: " id))))) + fn + ;; (if fn + ;; fn + ;; (println "not evaluated: " id " -> " (stores/load-by-id (:store rt) id))) + ))) (defn wrap-out "" @@ -97,10 +105,10 @@ out-mapped (pipes/link! trans-out to-world)] (pipes/composite-pipe out-mapped in-mapped))))) - (defn link-fn "" [from to xf] + (println "linking" from to) (let [a (replace-piped from "from") c (replace-piped to "to")] (when (not a) @@ -132,7 +140,7 @@ (update :server servers/load-builtins! builtins)) rt2 (->> (keys builtins) (map (partial stores/resolve-name (:store runtime))) - (map (partial stores/load-by-id (:store runtime))) + (map (partial load-by-id runtime)) (update runtime :server eval-all))] (reset! resolver rt2) rt2))) @@ -180,16 +188,11 @@ (store! store) (eval-all server))) -(defn load-by-id - "" - [{store :store} id] - (stores/load-by-id store id)) - (defn load-by-sym "" - [{store :store} sym] + [{store :store :as rt} sym] (when-let [ref (stores/resolve-name store sym)] - (stores/load-by-id store ref))) + (load-by-id rt ref))) (defn load-network "loads the given network from storage" @@ -202,24 +205,43 @@ fn (if (:samak.nodes/fn-expression val) (:samak.nodes/fn-expression val) val)] (get-in fn [:samak.nodes/fn :db/id]))) +(defn get-ids-from-source-def + [def type-set] + (let [deps (filter #(type-set (:samak.nodes/value (:samak.nodes/mapkey %))) def) + _ (println "deps" deps) + sources (mapcat #(:samak.nodes/mapkv-pairs (:samak.nodes/mapvalue %)) deps)] ;; FIXME, move to db? + (println "sources" sources) + sources)) -(defn load-sources-from-bundle + +(defn load-roots-from-bundle "" - [defns] - (let [kv (:samak.nodes/mapkv-pairs defns) - sources (:samak.nodes/mapkv-pairs (:samak.nodes/mapvalue (first kv))) ;; FIXME, move to db? - value (map get-id-from-source-val sources)] - value)) + [rt defns] + (let [defs (if (= (:samak.nodes/type defns) :samak.nodes/def) + (:samak.nodes/rhs defns) + (:samak.nodes/definition defns)) + kvs (:samak.nodes/mapkv-pairs defs) + _ (println "kvs" kvs) + sources (get-ids-from-source-def kvs #{:sources}) + deps (get-ids-from-source-def kvs #{:depends}) + source-ids (map get-id-from-source-val sources) + dep-ids (map get-id-from-source-val deps) + _ (println "dep-ids" dep-ids) + deps-sources (map #(load-by-id rt %) dep-ids) + _ (println "dep-s" deps-sources) + deps-source-ids (map #(load-roots-from-bundle rt %) deps-sources) + _ (println "dep-s-id" deps-source-ids) + roots (flatten (concat deps-source-ids dep-ids source-ids))] + (println "roots: " roots) + roots)) (defn load-bundle "loads the definition of a bundle" - [{store :store :as rt} sym] + [rt sym] (let [defns (load-by-sym rt sym) - value (load-sources-from-bundle (if (= (:samak.nodes/type defns) :samak.nodes/def) - (:samak.nodes/rhs defns) - (:samak.nodes/definition defns)))] - value)) + value (load-roots-from-bundle rt defns)] + (distinct value))) (defn eval-expression! [{:keys [store server] :as rt} form] @@ -231,8 +253,10 @@ (defn get-definition-by-name [runtime sym] (let [id (-> runtime :store (stores/resolve-name sym))] + (println "def id:" id) (-> runtime :server servers/get-defined (get id)))) + (defn fire-into-named-pipe "" [rt pipe-name data timeout] diff --git a/src/samak/runtime/stores.cljc b/src/samak/runtime/stores.cljc index 73ba03a..de87d23 100644 --- a/src/samak/runtime/stores.cljc +++ b/src/samak/runtime/stores.cljc @@ -13,7 +13,7 @@ (persist-tree! [_ tree] (db/parse-tree->db! db tree)) (load-by-id [_ id] - (db/load-by-id db id)) + (db/load-recurse db id)) (load-network [_ id] (db/load-network db id)) (resolve-name [_ db-name] diff --git a/src/samak/stdlib.cljc b/src/samak/stdlib.cljc index 29e2dcf..5a733f2 100644 --- a/src/samak/stdlib.cljc +++ b/src/samak/stdlib.cljc @@ -35,7 +35,8 @@ (defn debug ([] (pipes/pipe (chan))) - ([spec] (pipes/checked-pipe (debug) spec spec))) + ([spec] (debug spec (helpers/uuid))) + ([spec id] (pipes/checked-pipe (debug) spec spec id))) (defn log-through ([] @@ -57,7 +58,7 @@ (tools/log prefix x) (tools/log x)) (recur))) - (pipes/sink log-chan)))) + (pipes/sink log-chan nil prefix)))) ;; Networking diff --git a/src/samak/trace.cljc b/src/samak/trace.cljc index 9fdb215..5a09806 100644 --- a/src/samak/trace.cljc +++ b/src/samak/trace.cljc @@ -39,24 +39,16 @@ (reset! tracer {:trace-fn (fn [t x] (println pre x) t)})))) -(defn load-ast - "loads an ast given by its entity id from the database" - [rt id] - (w/postwalk (fn [form] - (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) - (:db/id form))] - (store/load-by-id rt sub-id) - form)) - (store/load-by-id rt id))) - (defn node-as-str "" [node] (if (number? node) - (let [ast (load-ast (:store @rt) node)] + (let [ast (store/load-by-id (:store @rt) node)] (if (api/is-def? ast) (str "(" node ") " (:samak.nodes/name ast)) - (str ast))) + (if (api/is-def? (:samak.nodes/fn ast)) + (str "(" node ") " (:samak.nodes/name (:samak.nodes/fn ast))) + (str ast)))) node)) (defn make-trace diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 30e4a50..6de1733 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -272,12 +272,14 @@ (defn load-ast "loads an ast given by its entity id from the database" [rt id] - (w/postwalk (fn [form] - (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) - (:db/id form))] - (rt/load-by-id rt sub-id) - form)) - (rt/load-by-id rt id))) + (rt/load-by-id rt id) + ;; (w/postwalk (fn [form] + ;; (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) + ;; (:db/id form))] + ;; (rt/load-by-id rt sub-id) + ;; form)) + ;; (rt/load-by-id rt id)) + ) (defn persist! @@ -679,11 +681,11 @@ (defn load-bundle "" - [sym] + [sym rt] (let [_ (print " V" "Fetching bundle from DB: ") - bundle (rt/load-bundle @rt-conn sym) + bundle (rt/load-bundle rt sym) _ (println (s/join "," bundle)) - sources (map #(rt/load-network @rt-conn %) bundle) + sources (map #(rt/load-network rt %) bundle) net (reduce (fn [a, v] (let [val (vals v)] {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) @@ -699,13 +701,13 @@ (defn eval-bundle "" [sym] - (database-net (load-bundle sym))) + (database-net (load-bundle sym @rt-conn))) (defn test-bundle "" [sym test] (let [verify (setup-verify) - bundle (load-bundle sym)] + bundle (load-bundle sym @rt-conn)] (runtime-net bundle test verify) verify)) @@ -869,7 +871,6 @@ [] (let [caravan-in (chan) caravan-out (chan)] - (tools/log "pipe: " caravan-out) (go-loop [] (when-let [x (js {"workerFactory" make-worker @@ -68,7 +68,7 @@ (let [in-chan (chan (a/sliding-buffer 1)) out-chan (chan)] (a/pipeline-async 1 out-chan layout-call in-chan) - (pipes/Pipethrough. in-chan (a/mult out-chan) nil nil))) + (pipes/Pipethrough. in-chan (a/mult out-chan) nil nil (helpers/uuid)))) (def layout-symbols {'pipes/layout layout}) diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index 9d51dd0..ed61437 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -1,23 +1,25 @@ (ns ^:figwheel-no-load samak.oasis #?@ - (:clj - [(:require - [clojure.spec.alpha :as s] - [samak.api :as api] - [samak.code-db :as db] - [samak.nodes :as n] - [samak.pipes :as pipes] - samak.spec - [samak.stdlib :as std])] - :cljs - [(:require - [cljs.spec.alpha :as s] - [samak.api :as api] - [samak.code-db :as db] - [samak.nodes :as n] - [samak.pipes :as pipes] - samak.spec - [samak.stdlib :as std])])) + (:clj + [(:require + [clojure.spec.alpha :as s] + [samak.api :as api] + [samak.code-db :as db] + [samak.nodes :as n] + [samak.pipes :as pipes] + [samak.runtime.stores :as stores] + samak.spec + [samak.stdlib :as std])] + :cljs + [(:require + [cljs.spec.alpha :as s] + [samak.api :as api] + [samak.code-db :as db] + [samak.nodes :as n] + [samak.pipes :as pipes] + [samak.runtime.stores :as stores] + samak.spec + [samak.stdlib :as std])])) (defn defncall ([sym fn-name] @@ -86,65 +88,6 @@ (defncall 'log-keyboard 'pipes/log (api/string "keyboard: ")) (defncall 'log-caravan 'pipes/log (api/string "caravan: ")) - ;; dark theme based on base16-atelierdune-dark - ;; (http://atelierbram.github.io/syntax-highlighting/atelier-schemes/dune) - (defmap 'get-color - {(api/keyword :cell-active) (api/string "#4d4a41") - (api/keyword :cell-edit) (api/string "#6684e1") - (api/keyword :cell-seclight) (api/string "#999580") - (api/keyword :cell-background) (api/string "#292824") - (api/keyword :cell-content) (api/string "#e8e4cf") - (api/keyword :cell-active-content) (api/string "#fefbec") - (api/keyword :cell-dividers) (api/string "#6e6b5e") - (api/keyword :cell-type-fill) (api/string "#6e6b5e") - (api/keyword :cell-type-stroke) (api/string "#20201d") - (api/keyword :cell-counter-stroke) (api/string "#6e6b5e") - (api/keyword :node-selected) (api/string "#6684e1") - (api/keyword :node-bg) (api/string "#292824") - (api/keyword :node-name-stroke) (api/string "#e8e4cf") - (api/keyword :node-gutter) (api/string "#292824") - (api/keyword :element-highlight-stroke) (api/string "#6684e1") - (api/keyword :pipe-fill) (api/string "#292824") - (api/keyword :pipe-glow) (api/string "#6684e1") - (api/keyword :pipe-stroke) (api/string "#a6a28c") - (api/keyword :pipe-drag) (api/string "#b65611") - (api/keyword :edge-in) (api/string "#6684e1") - (api/keyword :edge-out) (api/string "#b65611") - (api/keyword :edge-neutral) (api/string "#a6a28c") - (api/keyword :graph-background) (api/string "#20201d") - (api/keyword :shadow-flood) (api/string "#292824") - (api/keyword :menu-entry-bg) (api/string "#999580") - (api/keyword :menu-entry-active-bg) (api/string "#a6a28c") - (api/keyword :menu-entry-text) (api/string "#fefbec") - (api/keyword :menu-bar-bg) (api/string "#6e6b5e") - (api/keyword :menu-bar-text) (api/string "#a6a28c") - }) - - (defmap 'get-font - {(api/string "str") (api/string "serif")}) - - (defmap 'get-syntax-color - {(api/keyword :caravan/str) (api/map {(api/keyword :cell-content) (api/string "#60ac39") - (api/keyword :cell-active-content) (api/string "#60ac39")}) - (api/keyword :caravan/kw) (api/map {(api/keyword :cell-content) (api/string "#b65611") - (api/keyword :cell-active-content) (api/string "#b65611")}) - (api/keyword :caravan/int) (api/map {(api/keyword :cell-content) (api/string "#1fad83") - (api/keyword :cell-active-content) (api/string "#1fad83")}) - (api/keyword :caravan/float) (api/map {(api/keyword :cell-content) (api/string "#1fad83") - (api/keyword :cell-active-content) (api/string "#1fad83")}) - (api/keyword :caravan/acc) (api/map {(api/keyword :cell-content) (api/string "#ae9513") - (api/keyword :cell-active-content) (api/string "#ae9513")}) - (api/keyword :caravan/func) (api/map {(api/keyword :cell-content) (api/string "#6684e1") - (api/keyword :cell-active-content) (api/string "#6684e1")}) - (api/keyword :caravan/table) (api/map {(api/keyword :cell-content) (api/string "#d43552") - (api/keyword :cell-active-content) (api/string "#d43552")}) - (api/keyword :caravan/list) (api/map {(api/keyword :cell-content) (api/string "#b854d4") - (api/keyword :cell-active-content) (api/string "#b854d4")})}) - - (defncall 'config-color '-> - (api/symbol 'get-color)) - - (defncall 'get-event-val '-> (api/key-fn :event) (api/key-fn :target) @@ -257,95 +200,6 @@ ;; helpers - (defncall 'translate-str 'str - (api/string "translate(") - (api/fn-call (api/symbol 'or) [(api/key-fn :x) (api/integer 0)]) - (api/string ",") - (api/fn-call (api/symbol 'or) [(api/key-fn :y) (api/integer 0)]) - (api/string ")")) - - (defncall 'translate-graph-str 'str - (api/string "matrix(") - (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 0)]) - (api/key-fn :zoom)]) - (api/string ",") - (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 1)]) - (api/key-fn :zoom)]) - (api/string ",") - (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 2)]) - (api/key-fn :zoom)]) - (api/string ",") - (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 3)]) - (api/key-fn :zoom)]) - (api/string ",") - (api/key-fn :x) - (api/string ",") - (api/key-fn :y) - (api/string ")")) - - (defncall 'translate-dialog '-> - (api/map {(api/keyword :x) - (api/integer 150) - (api/keyword :y) - (api/integer 50) - (api/keyword :zoom) - (api/float 1.5) - (api/keyword :matrix) - (api/vector [(api/float 1.0) - (api/float 0.0) - (api/float 0.0) - (api/float 1.0)])}) - (api/symbol 'translate-graph-str)) - - (defncall 'translate-func '-> - (api/fn-call (api/symbol 'into) [(api/symbol '_) - (api/map {(api/keyword :zoom) - (api/float 1.5) - ;; (api/keyword :x) - ;; (api/integer 150) - ;; (api/keyword :y) - ;; (api/integer -60) - (api/keyword :matrix) - (api/vector [(api/float 1.0) - (api/float 0.0) - (api/float 0.0) - (api/float 1.0)])})]) - (api/symbol 'translate-graph-str)) - - (defncall 'translate-blur '-> - (api/fn-call (api/symbol 'into) [(api/symbol '_) - (api/map {(api/keyword :zoom) - (api/float 2.0) - (api/keyword :x) - (api/fn-call (api/symbol '-) [(api/key-fn :x) (api/integer 100)]) - ;; (api/keyword :y) - ;; (api/integer -50) - (api/keyword :matrix) - (api/vector [(api/float 1.0) - (api/float 0.0) - (api/float 0.0) - (api/float 1.0)])})]) - (api/symbol 'translate-graph-str)) - - (defncall 'translate-graph '-> - (api/fn-call (api/symbol 'assoc) [(api/symbol '_) (api/keyword :matrix) - (api/vector [(api/float 1.0) - (api/float -0.5) - (api/float 1.0) - (api/float 0.5)])]) - (api/symbol 'translate-graph-str)) - - (defncall 'translate-ident '-> - (api/fn-call (api/symbol 'into) [(api/symbol '_) - (api/map {(api/keyword :zoom) - (api/float 1.0) - (api/keyword :matrix) - (api/vector [(api/float 1.0) - (api/float 0.0) - (api/float 0.0) - (api/float 1.0)])})]) - (api/symbol 'translate-graph-str)) - (defncall 'fn-name-from-select '-> (api/fn-call (api/symbol 'str-split) [(api/symbol '_) (api/string "/")]) ;; func/ (api/fn-call (api/symbol 'incase) [(api/symbol 'is-valid-target) @@ -364,339 +218,6 @@ (api/keyword :id) (api/string "input/repl") (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "auto")})})])])})}) - (defncall 'header '-> - (api/map {(api/keyword :header) - (api/map {(api/keyword :oasis.gui/order) - (api/integer 1) - (api/keyword :oasis.gui/element) - (api/vector [(api/keyword :h1) - (api/string "사막 Oasis")])})})) - - (defncall 'calculate-y '-> - (api/fn-call (api/symbol '*) [(api/integer 100) (api/key-fn :position)]) - (api/fn-call (api/symbol '+) [(api/integer 10) (api/symbol '_)])) - - (defncall 'menu-transform '-> - (api/key-fn :item) - (api/map {(api/keyword :x) (api/integer 50) - (api/keyword :y) (api/symbol 'calculate-y)}) - (api/symbol 'translate-str)) - - (defncall 'animate-sink '-> - (api/vector [(api/vector [(api/keyword :animate) - (api/map {(api/keyword :attributeName) (api/string "stroke") - (api/keyword :values) (api/string "#999580;#6684e1;#6684e1;#6684e1;#999580") - (api/keyword :dur) (api/string "3s") - (api/keyword :repeatCount) (api/string "indefinite")})]) - (api/vector [(api/keyword :animate) - (api/map {(api/keyword :attributeName) (api/string "r") - (api/keyword :values) (api/string "43;37;37;37;35") - (api/keyword :dur) (api/string "3s") - (api/keyword :repeatCount) (api/string "indefinite")})])])) - - (defncall 'animate-source '-> - (api/vector [(api/vector [(api/keyword :animate) - (api/map {(api/keyword :attributeName) (api/string "stroke") - (api/keyword :values) (api/string "#999580;#6684e1;#6684e1;#6684e1;#999580") - (api/keyword :dur) (api/string "3s") - (api/keyword :repeatCount) (api/string "indefinite")})]) - (api/vector [(api/keyword :animate) - (api/map {(api/keyword :attributeName) (api/string "r") - (api/keyword :values) (api/string "35;37;37;37;43") - (api/keyword :dur) (api/string "3s") - (api/keyword :repeatCount) (api/string "indefinite")})])])) - - (defncall 'is-hovered-entry '-> - (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :item) - (api/vector [(api/key-fn :type) (api/key-fn :name)])]) - (api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/key-fn :hover) - (api/key-fn :current) - (api/vector [(api/key-fn :type) (api/key-fn :name)])])]) - (api/fn-call (api/symbol '->) [(api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) - (api/fn-call (api/symbol 'count) [(api/symbol '_)]) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])) - - (defncall 'is-entry-sink '-> - (api/key-fn :item) - (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")])) - - (defncall 'get-animation-style '-> - (api/fn-call (api/symbol 'if) [(api/symbol 'is-hovered-entry) - (api/fn-call (api/symbol 'if) [(api/symbol 'is-entry-sink) - (api/symbol 'animate-sink) - (api/symbol 'animate-source)]) - (api/string "")])) - - (defncall 'get-entry-bg '-> - (api/fn-call (api/symbol 'if) [(api/symbol 'is-hovered-entry) - (api/keyword :menu-entry-active-bg) - (api/keyword :menu-entry-bg)])) - - (defncall 'render-menu-entry '-> - (api/vector [(api/keyword :g) - (api/map {(api/keyword :transform) (api/symbol 'menu-transform)}) - (api/vector [(api/keyword :circle) - (api/map {(api/keyword :cx) (api/integer 0) - (api/keyword :cy) (api/integer 45) - (api/keyword :r) (api/integer 40) - (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#shadow)") - (api/keyword :pointer-events) (api/string "all")}) - (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :menu-entry-bg) - (api/symbol 'get-color)]) - (api/keyword :stroke) (api/fn-call (api/symbol '->) [(api/keyword :menu-entry-text) - (api/symbol 'get-color)])})]) - (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :circle) - (api/map {(api/keyword :cx) (api/integer 0) - (api/keyword :cy) (api/integer 45) - (api/keyword :r) (api/integer 35) - (api/keyword :stroke-width) (api/integer 2) - (api/keyword :stroke) (api/fn-call (api/symbol '->) [(api/keyword :element-highlight-stroke) - (api/symbol 'get-color)]) - (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/symbol 'get-entry-bg) - (api/symbol 'get-color)])})]) - (api/symbol 'get-animation-style)]) - (api/vector [(api/keyword :text) - (api/map {(api/keyword :height) (api/integer 20) - (api/keyword :width) (api/string "100%") - (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :menu-entry-text) (api/symbol 'get-color)]) - (api/keyword :text-anchor) (api/keyword :middle) - (api/keyword :x) (api/integer 0) - (api/keyword :y) (api/integer 35) - (api/keyword :dy) (api/integer 14)}) - (api/fn-call (api/symbol '->) [(api/key-fn :item) - (api/key-fn :name)])]) - (api/vector [(api/keyword :circle) - (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :item) - (api/key-fn :id)]) - (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "all")}) - (api/keyword :cx) (api/integer 0) - (api/keyword :cy) (api/integer 45) - (api/keyword :r) (api/integer 40) - (api/keyword :fill-opacity) (api/integer 0)})])])) - - (defncall 'get-menu-fill '-> - (api/keyword :menu-bar-bg) - (api/symbol 'config-color)) - - (defncall 'get-menu-fg '-> - (api/keyword :menu-bar-text) - (api/symbol 'config-color)) - - - (defncall 'tag-item-context '-> - (api/map {(api/keyword :item) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) - (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) - - (defncall 'get-menu-items '-> - (api/key-fn :items) - (api/fn-call (api/symbol 'map) [(api/symbol 'tag-item-context) (api/symbol '_)]) - (api/fn-call (api/symbol 'map) [(api/symbol 'render-menu-entry) (api/symbol '_)]) - (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g)]) (api/symbol '_)]) - ) - - - (defncall 'render-source-menu '-> - (api/key-fn :source-menu) - (api/map {(api/keyword :items) (api/key-fn :items) - (api/keyword :context) (api/map {(api/keyword :hover) (api/key-fn :hover) - (api/keyword :resize) (api/key-fn :resize)})}) - (api/map {(api/keyword :items) (api/fn-call (api/symbol 'myzip) [(api/key-fn :items) - (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :items)]) - (api/key-fn :context)])]) - (api/keyword :context) (api/key-fn :context)}) - (api/vector [(api/keyword :g) - (api/vector [(api/keyword :rect) - (api/map {(api/keyword :id) (api/string "menu/source") - (api/keyword :height) (api/string "100%") - (api/keyword :width) (api/integer 100) - (api/keyword :stroke) (api/symbol 'get-menu-fg) - (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#shadow)") - (api/keyword :pointer-events) (api/string "all")}) - (api/keyword :fill-opacity) (api/float 0.8) - (api/keyword :fill) (api/symbol 'get-menu-fill)})]) - (api/symbol 'get-menu-items)]) - (api/map {(api/keyword :source-menu) (api/symbol '_)})) - - (defncall 'get-sink-position '-> - (api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :resize) (api/key-fn :width)]) - (api/fn-call (api/symbol '-) [(api/symbol '_) (api/integer 100)]) - (api/map {(api/keyword :x) (api/symbol '_)}) - (api/symbol 'translate-str)) - - (defncall 'render-sink-menu '-> - (api/key-fn :sink-menu) - (api/map {(api/keyword :items) (api/key-fn :items) - (api/keyword :context) (api/map {(api/keyword :hover) (api/key-fn :hover) - (api/keyword :resize) (api/key-fn :resize)})}) - (api/map {(api/keyword :items) (api/fn-call (api/symbol 'myzip) [(api/key-fn :items) - (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :items)]) - (api/key-fn :context)])]) - (api/keyword :context) (api/key-fn :context)}) - (api/vector [(api/keyword :g) - (api/map {(api/keyword :transform) (api/symbol 'get-sink-position)}) - (api/vector [(api/keyword :rect) - (api/map {(api/keyword :id) (api/string "menu/sink") - (api/keyword :height) (api/string "100%") - (api/keyword :width) (api/integer 100) - (api/keyword :stroke) (api/symbol 'get-menu-fg) - (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#leftshadow)") - (api/keyword :pointer-events) (api/string "all")}) - (api/keyword :fill-opacity) (api/float 0.8) - (api/keyword :fill) (api/symbol 'get-menu-fill)})]) - (api/symbol 'get-menu-items)]) - (api/map {(api/keyword :sink-menu) (api/symbol '_)})) - - (defncall 'get-menu-state '-> - (api/vector [(api/string "mode: ") - (api/fn-call (api/symbol '->) [(api/key-fn :editor) - (api/key-fn :mode)]) - (api/string "/") - (api/fn-call (api/symbol '->) [(api/key-fn :editor) - (api/key-fn :activity)])]) - (api/fn-call (api/symbol 'str-join) [(api/string " ") (api/symbol '_)])) - - (defncall 'render-menu-action '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "render action")]) - (api/symbol '_)) - - (defncall 'get-menu-actions '-> - (api/fn-call (api/symbol '->) [(api/key-fn :mode) - (api/key-fn :actions) - (api/fn-call (api/symbol 'map) [(api/symbol 'render-menu-action) (api/symbol '_)])]) - (api/fn-call (api/symbol 'str-join) [(api/string ", ") (api/symbol '_)]) - (api/vector [(api/string "type: ") (api/symbol '_)]) - (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])) - - (defncall 'get-action-position '-> - (api/fn-call (api/symbol '->) [(api/key-fn :resize) (api/key-fn :height)]) - (api/fn-call (api/symbol '-) [(api/symbol '_) (api/integer 50)]) - (api/map {(api/keyword :y) (api/symbol '_)}) - (api/symbol 'translate-str)) - - (defncall 'render-action-menu '-> - (api/map {(api/keyword :action-menu) - (api/vector [(api/keyword :g) - (api/map {(api/keyword :transform) (api/symbol 'get-action-position)}) - (api/vector [(api/keyword :rect) - (api/map {(api/keyword :id) (api/string "menu/action") - (api/keyword :height) (api/integer 50) - (api/keyword :width) (api/string "100%") - (api/keyword :stroke) (api/symbol 'get-menu-fg) - (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#upshadow)") - (api/keyword :pointer-events) (api/string "all")}) - (api/keyword :fill-opacity) (api/float 0.8) - (api/keyword :fill) (api/symbol 'get-menu-fill)})]) - (api/vector [(api/keyword :text) - (api/map {(api/keyword :height) (api/integer 20) - (api/keyword :width) (api/string "100%") - (api/keyword :text-anchor) (api/keyword :middle) - (api/keyword :x) (api/integer 600) - (api/keyword :y) (api/integer 5) - (api/keyword :dy) (api/integer 14)}) - (api/fn-call (api/symbol '->) - [(api/vector [(api/string "state: ") - (api/symbol 'get-menu-state)]) - (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])])]) - (api/vector [(api/keyword :text) - (api/map {(api/keyword :height) (api/integer 20) - (api/keyword :width) (api/string "100%") - (api/keyword :text-anchor) (api/keyword :middle) - (api/keyword :x) (api/integer 600) - (api/keyword :y) (api/integer 25) - (api/keyword :dy) (api/integer 14)}) - (api/fn-call (api/symbol '->) - [(api/vector [(api/string "actions: ") - (api/symbol 'get-menu-actions)]) - (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])])])])})) - - (defncall 'source-menu 'pipes/debug) - (defncall 'source-menu-items 'pipes/debug) - (defncall 'source-menu-events 'pipes/debug) - (defncall 'source-menu-state 'pipes/debug) - - - (defncall 'source-menu-const '-> - (api/vector [(api/string "debug") - (api/string "ui") - (api/string "http")]) - (api/symbol 'many)) - - (defncall 'sink-menu 'pipes/debug) - (defncall 'sink-menu-items 'pipes/debug) - (defncall 'sink-menu-events 'pipes/debug) - (defncall 'sink-menu-state 'pipes/debug) - - (defncall 'sink-menu-const '-> - (api/vector [(api/string "debug") - (api/string "log") - (api/string "ui") - (api/string "http")]) - (api/symbol 'many)) - - (defncall 'map-menu-item '-> - (api/map {(api/keyword :position) - (api/key-fn :count) - (api/keyword :name) - (api/key-fn :name) - (api/keyword :type) - (api/key-fn :type) - (api/keyword :id) - (api/fn-call (api/symbol 'str) [(api/key-fn :type) - (api/string "/") - (api/key-fn :name)])})) - - (defncall 'source-menu-map 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/vector [(api/key-fn :state) - (api/fn-call (api/symbol '->) [(api/map {(api/keyword :count) - (api/fn-call (api/symbol 'count) [(api/key-fn :state)]) - (api/keyword :type) - (api/string "source") - (api/keyword :name) - (api/key-fn :next)}) - (api/symbol 'map-menu-item)])]) - (api/fn-call (api/symbol 'flatten) [(api/symbol '_)])]) - (api/vector [])) - - (defncall 'sink-menu-map 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/vector [(api/key-fn :state) - (api/fn-call (api/symbol '->) [(api/map {(api/keyword :count) - (api/fn-call (api/symbol 'count) [(api/key-fn :state)]) - (api/keyword :type) - (api/string "sink") - (api/keyword :name) - (api/key-fn :next)}) - (api/symbol 'map-menu-item)])]) - (api/fn-call (api/symbol 'flatten) [(api/symbol '_)])]) - (api/vector [])) - - (defncall 'tag-items '-> - (api/map {(api/keyword :items) (api/symbol '_)})) - - (defncall 'tag-menu-source '-> - (api/map {(api/keyword :source-menu) (api/symbol '_)})) - - (defncall 'reduce-menu-source 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/vector [(api/key-fn :state) (api/key-fn :next)]) - (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])]) - (api/map {(api/keyword :items) (api/vector []) - (api/keyword :hover) (api/map {})})) - - (defncall 'tag-sink-menu '-> - (api/map {(api/keyword :sink-menu) (api/symbol '_)})) - - (defncall 'reduce-menu-sink 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/vector [(api/key-fn :state) (api/key-fn :next)]) - (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])]) - (api/map {(api/keyword :items) (api/vector []) - (api/keyword :hover) (api/map {}) - (api/keyword :resize) (api/map {})})) - (defncall 'is-mouse-move '-> (api/key-fn :next) (api/key-fn :samak.mouse/type) @@ -1900,6 +1421,93 @@ (api/keyword :hovered) (api/map {}) (api/keyword :hover) (api/vector [])})) + (defncall 'source-menu 'pipes/debug) + (defncall 'source-menu-items 'pipes/debug) + (defncall 'source-menu-events 'pipes/debug) + (defncall 'source-menu-state 'pipes/debug) + + + (defncall 'source-menu-const '-> + (api/vector [(api/string "debug") + (api/string "ui") + (api/string "http")]) + (api/symbol 'many)) + + (defncall 'sink-menu 'pipes/debug) + (defncall 'sink-menu-items 'pipes/debug) + (defncall 'sink-menu-events 'pipes/debug) + (defncall 'sink-menu-state 'pipes/debug) + + (defncall 'sink-menu-const '-> + (api/vector [(api/string "debug") + (api/string "log") + (api/string "ui") + (api/string "http")]) + (api/symbol 'many)) + + (defncall 'map-menu-item '-> + (api/map {(api/keyword :position) + (api/key-fn :count) + (api/keyword :name) + (api/key-fn :name) + (api/keyword :type) + (api/key-fn :type) + (api/keyword :id) + (api/fn-call (api/symbol 'str) [(api/key-fn :type) + (api/string "/") + (api/key-fn :name)])})) + + (defncall 'source-menu-map 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/vector [(api/key-fn :state) + (api/fn-call (api/symbol '->) [(api/map {(api/keyword :count) + (api/fn-call (api/symbol 'count) [(api/key-fn :state)]) + (api/keyword :type) + (api/string "source") + (api/keyword :name) + (api/key-fn :next)}) + (api/symbol 'map-menu-item)])]) + (api/fn-call (api/symbol 'flatten) [(api/symbol '_)])]) + (api/vector [])) + + (defncall 'sink-menu-map 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/vector [(api/key-fn :state) + (api/fn-call (api/symbol '->) [(api/map {(api/keyword :count) + (api/fn-call (api/symbol 'count) [(api/key-fn :state)]) + (api/keyword :type) + (api/string "sink") + (api/keyword :name) + (api/key-fn :next)}) + (api/symbol 'map-menu-item)])]) + (api/fn-call (api/symbol 'flatten) [(api/symbol '_)])]) + (api/vector [])) + + (defncall 'tag-items '-> + (api/map {(api/keyword :items) (api/symbol '_)})) + + (defncall 'tag-menu-source '-> + (api/map {(api/keyword :source-menu) (api/symbol '_)})) + + (defncall 'reduce-menu-source 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/vector [(api/key-fn :state) (api/key-fn :next)]) + (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])]) + (api/map {(api/keyword :items) (api/vector []) + (api/keyword :hover) (api/map {})})) + + (defncall 'tag-sink-menu '-> + (api/map {(api/keyword :sink-menu) (api/symbol '_)})) + + (defncall 'reduce-menu-sink 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/vector [(api/key-fn :state) (api/key-fn :next)]) + (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])]) + (api/map {(api/keyword :items) (api/vector []) + (api/keyword :hover) (api/map {}) + (api/keyword :resize) (api/map {})})) + + ;; global state (defncall 'load-state 'pipes/debug ;; (api/keyword :oasis.spec/state) @@ -1926,119 +1534,6 @@ ) - ;; cell handling - - (defncall 'func-id 'str - (api/string "func/") - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])) - - - (defncall 'is-same '-> - (api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) - (api/fn-call (api/symbol 'count) [(api/symbol '_)]) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])) - - - (defncall 'is-selected '-> - (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :selected)]) - (api/symbol 'func-id)]) - (api/symbol 'is-same)) - - (defncall 'is-hovered '-> - (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])]) - (api/symbol 'is-same)) - - - (defncall 'cell-y '-> - (api/fn-call (api/symbol '*) [(api/integer 20) - (api/key-fn :counter)]) - (api/fn-call (api/symbol '+) [(api/integer 10) - (api/symbol '_)])) - - (defncall 'cell-x '-> - (api/fn-call (api/symbol '*) [(api/integer 15) - (api/key-fn :level)])) - - (defncall 'cell-pos '-> - (api/map {(api/keyword :x) - (api/integer 0) - (api/keyword :y) - (api/symbol 'cell-y)}) - (api/symbol 'translate-str)) - - (defncall 'line-pos '-> - (api/map {(api/keyword :x) - (api/integer 0) - (api/keyword :y) - (api/integer -15)}) - (api/symbol 'translate-str)) - - - (defncall 'text-pos '-> - (api/map {(api/keyword :x) - (api/symbol 'cell-x) - (api/keyword :y) - (api/integer 0)}) - (api/symbol 'translate-str)) - - (defncall 'counter-pos '-> - (api/map {(api/keyword :x) - (api/integer 10) - (api/keyword :y) - (api/integer 0)}) - (api/symbol 'translate-str)) - - (defncall 'type-pos '-> - (api/map {(api/keyword :x) - (api/fn-call (api/symbol '+) [(api/integer 190) - ;; (api/symbol 'cell-x) - (api/integer 10)]) - (api/keyword :y) - (api/integer 0)}) - (api/symbol 'translate-str)) - - (defncall 'is-marked-cell '-> - (api/fn-call (api/symbol '-) [(api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/key-fn :mark)]) - (api/fn-call (api/symbol '->) [(api/key-fn :exp) - (api/key-fn :counter)])]) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 0)])) - - (defncall 'is-active-cell '-> - (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/key-fn :selected)]) - (api/symbol 'is-marked-cell)])) - - (defncall 'is-edited-cell '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "edited")]) - (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/key-fn :activity) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :edit)])]) - (api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/key-fn :selected)]) - (api/symbol 'is-marked-cell)])) - - (defncall 'is-active-branch '-> - (api/key-fn :exp) - (api/key-fn :counter) - (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '>) [(api/symbol '_) (api/integer 100)]) - (api/fn-call (api/symbol '<) [(api/symbol '_) (api/integer 101)])])) - - (defncall 'get-fill '-> - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-edited-cell) - (api/fn-call (api/symbol '->) [(api/keyword :cell-edit) - (api/symbol 'get-color)])]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-active-cell) - (api/fn-call (api/symbol '->) [(api/keyword :cell-active) - (api/symbol 'get-color)])]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-active-branch) - (api/fn-call (api/symbol '->) [(api/keyword :cell-seclight) - (api/symbol 'get-color)])]) - (api/fn-call (api/symbol 'incase) [(api/key-fn :exp) - (api/fn-call (api/symbol '->) [(api/keyword :cell-background) - (api/symbol 'get-color)])])) - (defncall 'make-cell '-> (api/symbol '_)) @@ -2135,9 +1630,6 @@ (api/key-fn :state) (api/key-fn :editor) (api/key-fn :mark)) - ]) - -(def oasis3 [ (defncall 'map-choice-to-type '-> (api/fn-call (api/symbol 'incase) [(api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :first)]) @@ -2516,155 +2008,159 @@ (def oasis-core-defs [(defncall 'oasis-core-init 'pipes/debug) + (defncall 'oasis-kb 'pipes/debug) + (defncall 'oasis-mouse 'pipes/debug) (defncall 'oasis-core-out 'pipes/debug) - (api/defmodule 'oasis-core (api/map {(api/keyword :sources) (api/map {(api/keyword :init) (api/symbol 'oasis-core-init)}) + (api/defmodule 'oasis-core (api/map {;;(api/keyword :depends) (api/map {(api/keyword :caravan) (api/symbol 'modules/caravan)}) + (api/keyword :sources) (api/map {;; (api/keyword :caravan) (api/symbol 'm-caravan) + (api/keyword :eval) (api/symbol 'oasis-eval) + (api/keyword :layout) (api/symbol 'oasis-layout) + (api/keyword :init) (api/symbol 'oasis-core-init) + (api/keyword :kb) (api/symbol 'oasis-kb) + (api/keyword :mouse) (api/symbol 'oasis-mouse) + (api/keyword :state) (api/symbol 'oasis-core-out)}) (api/keyword :sinks) (api/map {(api/keyword :state) (api/symbol 'oasis-core-out)})}))]) (def oasis-core-net [ ;; networks - (pipe 'oasis-mouse 'mouse-reduce) - (pipe 'mouse-reduce 'mouse-state) - (pipe 'oasis-mouse 'target-reduce) - (pipe 'target-reduce 'target-events) - - (pipe 'target-events 'only-different 'hover-events) - (pipe 'hover-events 'tag-hover 'hover-state) - - (pipe 'oasis-kb 'filter-key-input 'keyboard-filtered) - (pipe 'keyboard-filtered 'filter-edit 'editor-commands) - (pipe 'keyboard-filtered 'filter-menu 'editor-commands) - ;; (pipe 'keyboard-filtered 'log-keyboard) - ;; (pipe 'oasis-kb 'log-keyboard) - - (pipe 'keyboard-filtered 'filter-view 'view-commands) - (pipe 'view-commands 'make-zoom) - (pipe 'make-zoom 'zoom-events) - (pipe 'zoom-events 'view-events) - (pipe 'view-commands 'view-deltas) - - (pipe 'raw-events 'input-reduce) - (pipe 'input-reduce 'reduced-events) - (pipe 'raw-events 'tag-events 'events) - - ;; (pipe 'oasis-ev 'filter-input 'raw-events) - ;; (pipe 'oasis-ev 'filter-submit 'raw-events) - - (pipe 'oasis-ui-out 'filter-resize 'events) - - ;; (pipe 'select-events 'editor-commands) - - (pipe 'oasis-eval 'eval-events) - - ;; (pipe 'eval-events 'log-events) - (pipe 'eval-events 'eval-reduce) - (pipe 'eval-reduce 'eval-raw) - (pipe 'eval-raw 'tag-eval 'eval-state) - - (pipe 'mouse-state 'filter-drag 'drag-events) - - (pipe 'drag-events 'filter-drag-end-or-start 'drag-state) ;; FIXME reduce - ;; (pipe 'drag-state 'log-mouse) - (pipe 'drag-state 'interpret-drag 'editor-commands) - ;; (pipe 'drag-events 'log-mouse) - - (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) - (api/symbol 'handle-caravan-command) - (api/symbol 'editor-commands)) - ;; (pipe 'caravan 'handle-caravan-command 'editor-commands) - (pipe 'editor-commands 'handle-commands 'editor-events) - (pipe 'hover-state 'editor-events) - (pipe 'scroll-state 'editor-events) - (pipe 'editor-events 'editor-state-reduce) - (pipe 'editor-state-reduce 'editor-cooked) - (pipe 'editor-cooked 'tag-editor 'editor-state) - ;; (pipe 'editor-state 'log-editor) - - (pipe 'editor-commands 'filter-immediate 'editor-immediate) - ;; (pipe 'editor-immediate 'log-command) - - (pipe 'mouse-state 'filter-scroll 'scroll-state) - (pipe 'scroll-state 'construct-view 'view-deltas) - (pipe 'view-deltas 'view-delta) - (pipe 'view-delta 'view-events) - (pipe 'view-events 'view-reduce) - (pipe 'view-reduce 'view-raw) - (pipe 'view-raw 'tag-view 'view-state) - - - (pipe 'editor-state 'state-dedupe) - (pipe 'loaded-state 'state-dedupe) - (pipe 'view-state 'state-dedupe) - (pipe 'drag-events 'state-dedupe) - (pipe 'hover-state 'state-dedupe) - (pipe 'mode-state 'state-dedupe) - (pipe 'events 'state-dedupe) - (pipe 'state-dedupe 'filter-state 'oasis-core-out) - - (pipe 'mode-state 'load-reduce) - (pipe 'hover-state 'load-reduce) - (pipe 'eval-state 'load-reduce) - (pipe 'zoom-events 'load-reduce) - (pipe 'load-reduce 'load-state) - (pipe 'load-state 'filter-load 'loaded-state) - - (pipe 'loaded-state 'format-state 'oasis-layout) - ;; (pipe 'eval-state 'format-state 'log-layout) - - (pipe 'eval-state 'edit-information 'editor-events) - - (pipe 'oasis-layout 'tag-layout 'layout-state) - ;; (pipe 'layout-state 'log-layout) - (pipe 'layout-state 'state-dedupe) - - ;; (pipe 'select-events 'center-view) - ;; (pipe 'layout-state 'center-view) - ;; (pipe 'center-view 'view-events) - - (pipe 'editor-state 'mode-data) - (pipe 'mode-data 'mode-raw) - (pipe 'mode-raw 'tag-mode 'mode-state) - - (pipe 'editor-state 'editor-actions) - (pipe 'editor-immediate 'editor-actions) - (pipe 'mode-state 'editor-actions) - (pipe 'events 'editor-actions) - - (pipe 'editor-actions 'handle-state) - (pipe 'handle-state 'be-commands) - ;; (pipe 'be-commands 'log-command) - (api/pipe (api/symbol 'be-commands) - (api/symbol 'filter-call) - (api/symbol 'm-caravan-actions)) - - (pipe 'oasis-core-init 'source-menu-const 'source-menu-items) - (pipe 'source-menu-items 'source-menu-map) - (pipe 'source-menu-map 'source-menu) - (pipe 'source-menu 'tag-items 'source-menu-events) - (pipe 'hover-state 'source-menu-events) - (pipe 'source-menu-events 'reduce-menu-source) - (pipe 'reduce-menu-source 'source-menu-state) - (pipe 'source-menu-state 'tag-menu-source 'state-reduce) - - (pipe 'oasis-core-init 'sink-menu-const 'sink-menu-items) - (pipe 'sink-menu-items 'sink-menu-map) - (pipe 'sink-menu-map 'sink-menu) - (pipe 'sink-menu 'tag-items 'sink-menu-events) - (pipe 'hover-state 'sink-menu-events) - (pipe 'events 'sink-menu-events) - (pipe 'sink-menu-events 'reduce-menu-sink) - (pipe 'reduce-menu-sink 'sink-menu-state) - (pipe 'sink-menu-state 'tag-sink-menu 'state-reduce) - - - ;; (pipe 'init 'header 'render) - ;; (pipe 'init 'repl 'render) - (pipe 'oasis-core-init 'init-view 'view-events) - - (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) - (api/symbol 'log-caravan)) - + (pipe 'oasis-mouse 'mouse-reduce) + (pipe 'mouse-reduce 'mouse-state) + (pipe 'oasis-mouse 'target-reduce) + (pipe 'target-reduce 'target-events) + + (pipe 'target-events 'only-different 'hover-events) + (pipe 'hover-events 'tag-hover 'hover-state) + + (pipe 'oasis-kb 'filter-key-input 'keyboard-filtered) + (pipe 'keyboard-filtered 'filter-edit 'editor-commands) + (pipe 'keyboard-filtered 'filter-menu 'editor-commands) + ;; (pipe 'keyboard-filtered 'log-keyboard) + + (pipe 'keyboard-filtered 'filter-view 'view-commands) + (pipe 'view-commands 'make-zoom) + (pipe 'make-zoom 'zoom-events) + (pipe 'zoom-events 'view-events) + (pipe 'view-commands 'view-deltas) + + (pipe 'raw-events 'input-reduce) + (pipe 'input-reduce 'reduced-events) + (pipe 'raw-events 'tag-events 'events) + + ;; (pipe 'oasis-ev 'filter-input 'raw-events) + ;; (pipe 'oasis-ev 'filter-submit 'raw-events) + + ;; (pipe 'oasis-ui-out 'filter-resize 'events) + + ;; (pipe 'select-events 'editor-commands) + + (pipe 'oasis-eval 'eval-events) + + ;; (pipe 'eval-events 'log-events) + (pipe 'eval-events 'eval-reduce) + (pipe 'eval-reduce 'eval-raw) + (pipe 'eval-raw 'tag-eval 'eval-state) + + (pipe 'mouse-state 'filter-drag 'drag-events) + + (pipe 'drag-events 'filter-drag-end-or-start 'drag-state) ;; FIXME reduce + ;; (pipe 'drag-state 'log-mouse) + (pipe 'drag-state 'interpret-drag 'editor-commands) + ;; (pipe 'drag-events 'log-mouse) + + (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) + (api/symbol 'handle-caravan-command) + (api/symbol 'editor-commands)) + ;; (pipe 'caravan 'handle-caravan-command 'editor-commands) + (pipe 'editor-commands 'handle-commands 'editor-events) + (pipe 'hover-state 'editor-events) + (pipe 'scroll-state 'editor-events) + (pipe 'editor-events 'editor-state-reduce) + (pipe 'editor-state-reduce 'editor-cooked) + (pipe 'editor-cooked 'tag-editor 'editor-state) + ;; (pipe 'editor-state 'log-editor) + + (pipe 'editor-commands 'filter-immediate 'editor-immediate) + ;; (pipe 'editor-immediate 'log-command) + + (pipe 'mouse-state 'filter-scroll 'scroll-state) + (pipe 'scroll-state 'construct-view 'view-deltas) + (pipe 'view-deltas 'view-delta) + (pipe 'view-delta 'view-events) + (pipe 'view-events 'view-reduce) + (pipe 'view-reduce 'view-raw) + (pipe 'view-raw 'tag-view 'view-state) + + (pipe 'oasis-core-init 'source-menu-const 'source-menu-items) + (pipe 'source-menu-items 'source-menu-map) + (pipe 'source-menu-map 'source-menu) + (pipe 'source-menu 'tag-items 'source-menu-events) + (pipe 'hover-state 'source-menu-events) + (pipe 'source-menu-events 'reduce-menu-source) + (pipe 'reduce-menu-source 'source-menu-state) + (pipe 'source-menu-state 'tag-menu-source 'state-dedupe) + + (pipe 'oasis-core-init 'sink-menu-const 'sink-menu-items) + (pipe 'sink-menu-items 'sink-menu-map) + (pipe 'sink-menu-map 'sink-menu) + (pipe 'sink-menu 'tag-items 'sink-menu-events) + (pipe 'hover-state 'sink-menu-events) + (pipe 'events 'sink-menu-events) + (pipe 'sink-menu-events 'reduce-menu-sink) + (pipe 'reduce-menu-sink 'sink-menu-state) + (pipe 'sink-menu-state 'tag-sink-menu 'state-dedupe) + + (pipe 'editor-state 'state-dedupe) + (pipe 'loaded-state 'state-dedupe) + (pipe 'view-state 'state-dedupe) + (pipe 'drag-events 'state-dedupe) + (pipe 'hover-state 'state-dedupe) + (pipe 'mode-state 'state-dedupe) + (pipe 'events 'state-dedupe) + (pipe 'state-dedupe 'filter-state 'oasis-core-out) + + (pipe 'mode-state 'load-reduce) + (pipe 'hover-state 'load-reduce) + (pipe 'eval-state 'load-reduce) + (pipe 'zoom-events 'load-reduce) + (pipe 'load-reduce 'load-state) + (pipe 'load-state 'filter-load 'loaded-state) + + (pipe 'loaded-state 'format-state 'oasis-layout) + ;; (pipe 'eval-state 'format-state 'log-layout) + + (pipe 'eval-state 'edit-information 'editor-events) + + (pipe 'oasis-layout 'tag-layout 'layout-state) + (pipe 'layout-state 'log-layout) + (pipe 'layout-state 'state-dedupe) + + ;; (pipe 'select-events 'center-view) + ;; (pipe 'layout-state 'center-view) + ;; (pipe 'center-view 'view-events) + + (pipe 'editor-state 'mode-data) + (pipe 'mode-data 'mode-raw) + (pipe 'mode-raw 'tag-mode 'mode-state) + + (pipe 'editor-state 'editor-actions) + (pipe 'editor-immediate 'editor-actions) + (pipe 'mode-state 'editor-actions) + (pipe 'events 'editor-actions) + + (pipe 'editor-actions 'handle-state) + (pipe 'handle-state 'be-commands) + ;; (pipe 'be-commands 'log-command) + (api/pipe (api/symbol 'be-commands) + (api/symbol 'filter-call) + (api/symbol 'm-caravan-actions)) + + + (pipe 'oasis-core-init 'init-view 'view-events) + + (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) + (api/symbol 'log-caravan)) ]) (def oasis-render-defs @@ -2672,6 +2168,393 @@ (defncall 'oasis-render-in 'pipes/debug) (defncall 'oasis-render-out 'pipes/debug) + ;; dark theme based on base16-atelierdune-dark + ;; (http://atelierbram.github.io/syntax-highlighting/atelier-schemes/dune) + (defmap 'get-color + {(api/keyword :cell-active) (api/string "#4d4a41") + (api/keyword :cell-edit) (api/string "#6684e1") + (api/keyword :cell-seclight) (api/string "#999580") + (api/keyword :cell-background) (api/string "#292824") + (api/keyword :cell-content) (api/string "#e8e4cf") + (api/keyword :cell-active-content) (api/string "#fefbec") + (api/keyword :cell-dividers) (api/string "#6e6b5e") + (api/keyword :cell-type-fill) (api/string "#6e6b5e") + (api/keyword :cell-type-stroke) (api/string "#20201d") + (api/keyword :cell-counter-stroke) (api/string "#6e6b5e") + (api/keyword :node-selected) (api/string "#6684e1") + (api/keyword :node-bg) (api/string "#292824") + (api/keyword :node-name-stroke) (api/string "#e8e4cf") + (api/keyword :node-gutter) (api/string "#292824") + (api/keyword :element-highlight-stroke) (api/string "#6684e1") + (api/keyword :pipe-fill) (api/string "#292824") + (api/keyword :pipe-glow) (api/string "#6684e1") + (api/keyword :pipe-stroke) (api/string "#a6a28c") + (api/keyword :pipe-drag) (api/string "#b65611") + (api/keyword :edge-in) (api/string "#6684e1") + (api/keyword :edge-out) (api/string "#b65611") + (api/keyword :edge-neutral) (api/string "#a6a28c") + (api/keyword :graph-background) (api/string "#20201d") + (api/keyword :shadow-flood) (api/string "#292824") + (api/keyword :menu-entry-bg) (api/string "#999580") + (api/keyword :menu-entry-active-bg) (api/string "#a6a28c") + (api/keyword :menu-entry-text) (api/string "#fefbec") + (api/keyword :menu-bar-bg) (api/string "#6e6b5e") + (api/keyword :menu-bar-text) (api/string "#a6a28c") + }) + + (defmap 'get-font + {(api/string "str") (api/string "serif")}) + + (defmap 'get-syntax-color + {(api/keyword :caravan/str) (api/map {(api/keyword :cell-content) (api/string "#60ac39") + (api/keyword :cell-active-content) (api/string "#60ac39")}) + (api/keyword :caravan/kw) (api/map {(api/keyword :cell-content) (api/string "#b65611") + (api/keyword :cell-active-content) (api/string "#b65611")}) + (api/keyword :caravan/int) (api/map {(api/keyword :cell-content) (api/string "#1fad83") + (api/keyword :cell-active-content) (api/string "#1fad83")}) + (api/keyword :caravan/float) (api/map {(api/keyword :cell-content) (api/string "#1fad83") + (api/keyword :cell-active-content) (api/string "#1fad83")}) + (api/keyword :caravan/acc) (api/map {(api/keyword :cell-content) (api/string "#ae9513") + (api/keyword :cell-active-content) (api/string "#ae9513")}) + (api/keyword :caravan/func) (api/map {(api/keyword :cell-content) (api/string "#6684e1") + (api/keyword :cell-active-content) (api/string "#6684e1")}) + (api/keyword :caravan/table) (api/map {(api/keyword :cell-content) (api/string "#d43552") + (api/keyword :cell-active-content) (api/string "#d43552")}) + (api/keyword :caravan/list) (api/map {(api/keyword :cell-content) (api/string "#b854d4") + (api/keyword :cell-active-content) (api/string "#b854d4")})}) + + + (defncall 'translate-str 'str + (api/string "translate(") + (api/fn-call (api/symbol 'or) [(api/key-fn :x) (api/integer 0)]) + (api/string ",") + (api/fn-call (api/symbol 'or) [(api/key-fn :y) (api/integer 0)]) + (api/string ")")) + + (defncall 'translate-graph-str 'str + (api/string "matrix(") + (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 0)]) + (api/key-fn :zoom)]) + (api/string ",") + (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 1)]) + (api/key-fn :zoom)]) + (api/string ",") + (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 2)]) + (api/key-fn :zoom)]) + (api/string ",") + (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol 'nth) [(api/key-fn :matrix) (api/integer 3)]) + (api/key-fn :zoom)]) + (api/string ",") + (api/key-fn :x) + (api/string ",") + (api/key-fn :y) + (api/string ")")) + + (defncall 'translate-dialog '-> + (api/map {(api/keyword :x) + (api/integer 150) + (api/keyword :y) + (api/integer 50) + (api/keyword :zoom) + (api/float 1.5) + (api/keyword :matrix) + (api/vector [(api/float 1.0) + (api/float 0.0) + (api/float 0.0) + (api/float 1.0)])}) + (api/symbol 'translate-graph-str)) + + (defncall 'translate-func '-> + (api/fn-call (api/symbol 'into) [(api/symbol '_) + (api/map {(api/keyword :zoom) + (api/float 1.5) + ;; (api/keyword :x) + ;; (api/integer 150) + ;; (api/keyword :y) + ;; (api/integer -60) + (api/keyword :matrix) + (api/vector [(api/float 1.0) + (api/float 0.0) + (api/float 0.0) + (api/float 1.0)])})]) + (api/symbol 'translate-graph-str)) + + (defncall 'translate-blur '-> + (api/fn-call (api/symbol 'into) [(api/symbol '_) + (api/map {(api/keyword :zoom) + (api/float 2.0) + (api/keyword :x) + (api/fn-call (api/symbol '-) [(api/key-fn :x) (api/integer 100)]) + ;; (api/keyword :y) + ;; (api/integer -50) + (api/keyword :matrix) + (api/vector [(api/float 1.0) + (api/float 0.0) + (api/float 0.0) + (api/float 1.0)])})]) + (api/symbol 'translate-graph-str)) + + (defncall 'translate-graph '-> + (api/fn-call (api/symbol 'assoc) [(api/symbol '_) (api/keyword :matrix) + (api/vector [(api/float 1.0) + (api/float -0.5) + (api/float 1.0) + (api/float 0.5)])]) + (api/symbol 'translate-graph-str)) + + (defncall 'translate-ident '-> + (api/fn-call (api/symbol 'into) [(api/symbol '_) + (api/map {(api/keyword :zoom) + (api/float 1.0) + (api/keyword :matrix) + (api/vector [(api/float 1.0) + (api/float 0.0) + (api/float 0.0) + (api/float 1.0)])})]) + (api/symbol 'translate-graph-str)) + + ;; FIXME: menu + + (defncall 'calculate-y '-> + (api/fn-call (api/symbol '*) [(api/integer 100) (api/key-fn :position)]) + (api/fn-call (api/symbol '+) [(api/integer 10) (api/symbol '_)])) + + (defncall 'menu-transform '-> + (api/key-fn :item) + (api/map {(api/keyword :x) (api/integer 50) + (api/keyword :y) (api/symbol 'calculate-y)}) + (api/symbol 'translate-str)) + + (defncall 'animate-sink '-> + (api/vector [(api/vector [(api/keyword :animate) + (api/map {(api/keyword :attributeName) (api/string "stroke") + (api/keyword :values) (api/string "#999580;#6684e1;#6684e1;#6684e1;#999580") + (api/keyword :dur) (api/string "3s") + (api/keyword :repeatCount) (api/string "indefinite")})]) + (api/vector [(api/keyword :animate) + (api/map {(api/keyword :attributeName) (api/string "r") + (api/keyword :values) (api/string "43;37;37;37;35") + (api/keyword :dur) (api/string "3s") + (api/keyword :repeatCount) (api/string "indefinite")})])])) + + (defncall 'animate-source '-> + (api/vector [(api/vector [(api/keyword :animate) + (api/map {(api/keyword :attributeName) (api/string "stroke") + (api/keyword :values) (api/string "#999580;#6684e1;#6684e1;#6684e1;#999580") + (api/keyword :dur) (api/string "3s") + (api/keyword :repeatCount) (api/string "indefinite")})]) + (api/vector [(api/keyword :animate) + (api/map {(api/keyword :attributeName) (api/string "r") + (api/keyword :values) (api/string "35;37;37;37;43") + (api/keyword :dur) (api/string "3s") + (api/keyword :repeatCount) (api/string "indefinite")})])])) + + (defncall 'is-hovered-entry '-> + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :item) + (api/vector [(api/key-fn :type) (api/key-fn :name)])]) + (api/fn-call (api/symbol '->) [(api/key-fn :context) + (api/key-fn :hover) + (api/key-fn :current) + (api/vector [(api/key-fn :type) (api/key-fn :name)])])]) + (api/fn-call (api/symbol '->) [(api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) + (api/fn-call (api/symbol 'count) [(api/symbol '_)]) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])) + + (defncall 'is-entry-sink '-> + (api/key-fn :item) + (api/key-fn :type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")])) + + (defncall 'get-animation-style '-> + (api/fn-call (api/symbol 'if) [(api/symbol 'is-hovered-entry) + (api/fn-call (api/symbol 'if) [(api/symbol 'is-entry-sink) + (api/symbol 'animate-sink) + (api/symbol 'animate-source)]) + (api/string "")])) + + (defncall 'get-entry-bg '-> + (api/fn-call (api/symbol 'if) [(api/symbol 'is-hovered-entry) + (api/keyword :menu-entry-active-bg) + (api/keyword :menu-entry-bg)])) + + (defncall 'render-menu-entry '-> + (api/vector [(api/keyword :g) + (api/map {(api/keyword :transform) (api/symbol 'menu-transform)}) + (api/vector [(api/keyword :circle) + (api/map {(api/keyword :cx) (api/integer 0) + (api/keyword :cy) (api/integer 45) + (api/keyword :r) (api/integer 40) + (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :fill) (api/fn-call (api/symbol 'get-color) [(api/keyword :menu-entry-bg)]) + (api/keyword :stroke) (api/fn-call (api/symbol 'get-color) [(api/keyword :menu-entry-text)])})]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :circle) + (api/map {(api/keyword :cx) (api/integer 0) + (api/keyword :cy) (api/integer 45) + (api/keyword :r) (api/integer 35) + (api/keyword :stroke-width) (api/integer 2) + (api/keyword :stroke) (api/fn-call (api/symbol '->) [(api/keyword :element-highlight-stroke) + (api/symbol 'get-color)]) + (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/symbol 'get-entry-bg) + (api/symbol 'get-color)])})]) + (api/symbol 'get-animation-style)]) + (api/vector [(api/keyword :text) + (api/map {(api/keyword :height) (api/integer 20) + (api/keyword :width) (api/string "100%") + (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :menu-entry-text) (api/symbol 'get-color)]) + (api/keyword :text-anchor) (api/keyword :middle) + (api/keyword :x) (api/integer 0) + (api/keyword :y) (api/integer 35) + (api/keyword :dy) (api/integer 14)}) + (api/fn-call (api/symbol '->) [(api/key-fn :item) + (api/key-fn :name)])]) + (api/vector [(api/keyword :circle) + (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :item) + (api/key-fn :id)]) + (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "all")}) + (api/keyword :cx) (api/integer 0) + (api/keyword :cy) (api/integer 45) + (api/keyword :r) (api/integer 40) + (api/keyword :fill-opacity) (api/integer 0)})])])) + + (defncall 'get-menu-fill '-> + (api/keyword :menu-bar-bg) + (api/symbol 'get-color)) + + (defncall 'get-menu-fg '-> + (api/keyword :menu-bar-text) + (api/symbol 'get-color)) + + + (defncall 'tag-item-context '-> + (api/map {(api/keyword :item) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + + (defncall 'get-menu-items '-> + (api/key-fn :items) + (api/fn-call (api/symbol 'map) [(api/symbol 'tag-item-context) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'render-menu-entry) (api/symbol '_)]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g)]) (api/symbol '_)]) + ) + + + (defncall 'render-source-menu '-> + (api/key-fn :source-menu) + (api/map {(api/keyword :items) (api/key-fn :items) + (api/keyword :context) (api/map {(api/keyword :hover) (api/key-fn :hover) + (api/keyword :resize) (api/key-fn :resize)})}) + (api/map {(api/keyword :items) (api/fn-call (api/symbol 'myzip) [(api/key-fn :items) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :items)]) + (api/key-fn :context)])]) + (api/keyword :context) (api/key-fn :context)}) + (api/vector [(api/keyword :g) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :id) (api/string "menu/source") + (api/keyword :height) (api/string "100%") + (api/keyword :width) (api/integer 100) + (api/keyword :stroke) (api/symbol 'get-menu-fg) + (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :fill-opacity) (api/float 0.8) + (api/keyword :fill) (api/symbol 'get-menu-fill)})]) + (api/symbol 'get-menu-items)]) + (api/map {(api/keyword :source-menu) (api/symbol '_)})) + + (defncall 'get-sink-position '-> + (api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :resize) (api/key-fn :width)]) + (api/fn-call (api/symbol '-) [(api/symbol '_) (api/integer 100)]) + (api/map {(api/keyword :x) (api/symbol '_)}) + (api/symbol 'translate-str)) + + (defncall 'render-sink-menu '-> + (api/key-fn :sink-menu) + (api/map {(api/keyword :items) (api/key-fn :items) + (api/keyword :context) (api/map {(api/keyword :hover) (api/key-fn :hover) + (api/keyword :resize) (api/key-fn :resize)})}) + (api/map {(api/keyword :items) (api/fn-call (api/symbol 'myzip) [(api/key-fn :items) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :items)]) + (api/key-fn :context)])]) + (api/keyword :context) (api/key-fn :context)}) + (api/vector [(api/keyword :g) + (api/map {(api/keyword :transform) (api/symbol 'get-sink-position)}) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :id) (api/string "menu/sink") + (api/keyword :height) (api/string "100%") + (api/keyword :width) (api/integer 100) + (api/keyword :stroke) (api/symbol 'get-menu-fg) + (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#leftshadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :fill-opacity) (api/float 0.8) + (api/keyword :fill) (api/symbol 'get-menu-fill)})]) + (api/symbol 'get-menu-items)]) + (api/map {(api/keyword :sink-menu) (api/symbol '_)})) + + (defncall 'get-menu-state '-> + (api/vector [(api/string "mode: ") + (api/fn-call (api/symbol '->) [(api/key-fn :editor) + (api/key-fn :mode)]) + (api/string "/") + (api/fn-call (api/symbol '->) [(api/key-fn :editor) + (api/key-fn :activity)])]) + (api/fn-call (api/symbol 'str-join) [(api/string " ") (api/symbol '_)])) + + (defncall 'render-menu-action '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "render action")]) + (api/symbol '_)) + + (defncall 'get-menu-actions '-> + (api/fn-call (api/symbol '->) [(api/key-fn :mode) + (api/key-fn :actions) + (api/fn-call (api/symbol 'map) [(api/symbol 'render-menu-action) (api/symbol '_)])]) + (api/fn-call (api/symbol 'str-join) [(api/string ", ") (api/symbol '_)]) + (api/vector [(api/string "type: ") (api/symbol '_)]) + (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])) + + (defncall 'get-action-position '-> + (api/fn-call (api/symbol '->) [(api/key-fn :resize) (api/key-fn :height)]) + (api/fn-call (api/symbol '-) [(api/symbol '_) (api/integer 50)]) + (api/map {(api/keyword :y) (api/symbol '_)}) + (api/symbol 'translate-str)) + + (defncall 'render-action-menu '-> + (api/map {(api/keyword :action-menu) + (api/vector [(api/keyword :g) + (api/map {(api/keyword :transform) (api/symbol 'get-action-position)}) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :id) (api/string "menu/action") + (api/keyword :height) (api/integer 50) + (api/keyword :width) (api/string "100%") + (api/keyword :stroke) (api/symbol 'get-menu-fg) + (api/keyword :style) (api/map {(api/keyword :filter) (api/string "url(#upshadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :fill-opacity) (api/float 0.8) + (api/keyword :fill) (api/symbol 'get-menu-fill)})]) + (api/vector [(api/keyword :text) + (api/map {(api/keyword :height) (api/integer 20) + (api/keyword :width) (api/string "100%") + (api/keyword :text-anchor) (api/keyword :middle) + (api/keyword :x) (api/integer 600) + (api/keyword :y) (api/integer 5) + (api/keyword :dy) (api/integer 14)}) + (api/fn-call (api/symbol '->) + [(api/vector [(api/string "state: ") + (api/symbol 'get-menu-state)]) + (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])])]) + (api/vector [(api/keyword :text) + (api/map {(api/keyword :height) (api/integer 20) + (api/keyword :width) (api/string "100%") + (api/keyword :text-anchor) (api/keyword :middle) + (api/keyword :x) (api/integer 600) + (api/keyword :y) (api/integer 25) + (api/keyword :dy) (api/integer 14)}) + (api/fn-call (api/symbol '->) + [(api/vector [(api/string "actions: ") + (api/symbol 'get-menu-actions)]) + (api/fn-call (api/symbol 'str-join) [(api/string "") (api/symbol '_)])])])])})) + + + ;; state + (defncall 'state-reduce 'pipes/reductions (api/fn-call (api/symbol '->) [(api/vector [(api/key-fn :state) (api/key-fn :next)]) @@ -2704,8 +2587,119 @@ (defncall 'only-resize '-> (api/map {(api/keyword :resize) (api/key-fn :resize)})) + + ;; cell handling + + (defncall 'func-id 'str + (api/string "func/") + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])) + + (defncall 'is-same '-> + (api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) + (api/fn-call (api/symbol 'count) [(api/symbol '_)]) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])) + + (defncall 'is-selected '-> + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :selected)]) + (api/symbol 'func-id)]) + (api/symbol 'is-same)) + + (defncall 'is-hovered '-> + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])]) + (api/symbol 'is-same)) + + (defncall 'cell-y '-> + (api/fn-call (api/symbol '*) [(api/integer 20) + (api/key-fn :counter)]) + (api/fn-call (api/symbol '+) [(api/integer 10) + (api/symbol '_)])) + + (defncall 'cell-x '-> + (api/fn-call (api/symbol '*) [(api/integer 15) + (api/key-fn :level)])) + + (defncall 'cell-pos '-> + (api/map {(api/keyword :x) + (api/integer 0) + (api/keyword :y) + (api/symbol 'cell-y)}) + (api/symbol 'translate-str)) + + (defncall 'line-pos '-> + (api/map {(api/keyword :x) + (api/integer 0) + (api/keyword :y) + (api/integer -15)}) + (api/symbol 'translate-str)) + + + (defncall 'text-pos '-> + (api/map {(api/keyword :x) + (api/symbol 'cell-x) + (api/keyword :y) + (api/integer 0)}) + (api/symbol 'translate-str)) + + (defncall 'counter-pos '-> + (api/map {(api/keyword :x) + (api/integer 10) + (api/keyword :y) + (api/integer 0)}) + (api/symbol 'translate-str)) + + (defncall 'type-pos '-> + (api/map {(api/keyword :x) + (api/fn-call (api/symbol '+) [(api/integer 190) + ;; (api/symbol 'cell-x) + (api/integer 10)]) + (api/keyword :y) + (api/integer 0)}) + (api/symbol 'translate-str)) + + (defncall 'is-marked-cell '-> + (api/fn-call (api/symbol '-) [(api/fn-call (api/symbol '->) [(api/key-fn :context) + (api/key-fn :mark)]) + (api/fn-call (api/symbol '->) [(api/key-fn :exp) + (api/key-fn :counter)])]) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 0)])) + + (defncall 'is-active-cell '-> + (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '->) [(api/key-fn :context) + (api/key-fn :selected)]) + (api/symbol 'is-marked-cell)])) + + (defncall 'is-edited-cell '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "edited")]) + (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '->) [(api/key-fn :context) + (api/key-fn :activity) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :edit)])]) + (api/fn-call (api/symbol '->) [(api/key-fn :context) + (api/key-fn :selected)]) + (api/symbol 'is-marked-cell)])) + + (defncall 'is-active-branch '-> + (api/key-fn :exp) + (api/key-fn :counter) + (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '>) [(api/symbol '_) (api/integer 100)]) + (api/fn-call (api/symbol '<) [(api/symbol '_) (api/integer 101)])])) + ;; graphing of nodes + (defncall 'get-fill '-> + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-edited-cell) + (api/fn-call (api/symbol '->) [(api/keyword :cell-edit) + (api/symbol 'get-color)])]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-active-cell) + (api/fn-call (api/symbol '->) [(api/keyword :cell-active) + (api/symbol 'get-color)])]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-active-branch) + (api/fn-call (api/symbol '->) [(api/keyword :cell-seclight) + (api/symbol 'get-color)])]) + (api/fn-call (api/symbol 'incase) [(api/key-fn :exp) + (api/fn-call (api/symbol '->) [(api/keyword :cell-background) + (api/symbol 'get-color)])])) + (defncall 'get-func-stroke '-> (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol 'or) [(api/symbol 'is-selected) (api/key-fn :expanded)]) (api/fn-call (api/symbol '->) [(api/keyword :node-selected) @@ -3187,6 +3181,7 @@ (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "all")})})])) (defncall 'graph '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "graph")]) (api/map {(api/keyword :layout) (api/key-fn :layout) (api/keyword :view) (api/key-fn :view) (api/keyword :context) (api/symbol 'build-context)}) @@ -3313,8 +3308,7 @@ (api/vector [(api/keyword :feDropShadow) (api/map {(api/keyword :dx) (api/string "3") (api/keyword :dy) (api/string "3") - (api/keyword :flood-color) (api/fn-call (api/symbol '->) [(api/keyword :shadow-flood) - (api/symbol 'get-color)]) + (api/keyword :flood-color) (api/fn-call (api/symbol 'get-color) [(api/keyword :shadow-flood)]) (api/keyword :flood-opacity) (api/string "0.3") (api/keyword :stdDeviation) (api/string "3")})])]) @@ -3349,8 +3343,7 @@ (api/vector [(api/keyword :feDropShadow) (api/map {(api/keyword :dx) (api/string "-3") (api/keyword :dy) (api/string "3") - (api/keyword :flood-color) (api/fn-call (api/symbol '->) [(api/keyword :shadow-flood) - (api/symbol 'get-color)]) + (api/keyword :flood-color) (api/fn-call (api/symbol 'get-color) [(api/keyword :shadow-flood)]) (api/keyword :flood-opacity) (api/string "0.3") (api/keyword :stdDeviation) (api/string "3")})])]) (api/vector [(api/keyword :filter) @@ -3358,8 +3351,7 @@ (api/vector [(api/keyword :feDropShadow) (api/map {(api/keyword :dx) (api/string "0") (api/keyword :dy) (api/string "-3") - (api/keyword :flood-color) (api/fn-call (api/symbol '->) [(api/keyword :shadow-flood) - (api/symbol 'get-color)]) + (api/keyword :flood-color) (api/fn-call (api/symbol 'get-color) [(api/keyword :shadow-flood)]) (api/keyword :flood-opacity) (api/string "0.3") (api/keyword :stdDeviation) (api/string "3")})])])])) @@ -3394,7 +3386,8 @@ ])})})) - (api/defmodule 'oasis-render (api/map {(api/keyword :sources) (api/map {(api/keyword :state) (api/symbol 'oasis-render-in)}) + (api/defmodule 'oasis-render (api/map {(api/keyword :sources) (api/map {(api/keyword :state) (api/symbol 'oasis-render-in) + (api/keyword :svg-elems) (api/symbol 'oasis-render-out)}) (api/keyword :sinks) (api/map {(api/keyword :svg-elems) (api/symbol 'oasis-render-out)})})) ]) @@ -3439,7 +3432,9 @@ (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :div) (api/map {(api/keyword :class) (api/string "fullscreen")})]) (api/symbol '_)])) - (api/defmodule 'oasis-ui (api/map {(api/keyword :sources) (api/map {(api/keyword :render) (api/symbol 'oasis-ui-in)}) + (api/defmodule 'oasis-ui (api/map {(api/keyword :sources) (api/map {(api/keyword :render) (api/symbol 'oasis-ui-in) + (api/keyword :kb) (api/symbol 'oasis-ui-kb) + (api/keyword :mouse) (api/symbol 'oasis-ui-mouse)}) (api/keyword :sinks) (api/map {(api/keyword :mouse) (api/symbol 'oasis-ui-mouse) (api/keyword :kb) (api/symbol 'oasis-ui-kb)}) (api/keyword :tests) (api/map {(api/keyword :t1) (api/map {(api/keyword :when) (api/map {(api/string "oasis-ui-in") (api/vector [(api/map {(api/keyword :header) @@ -3464,7 +3459,8 @@ ]) (def oasis-module-defs - [(defncall 'm-ui '-> + [ + (defncall 'm-ui '-> (api/symbol 'oasis-ui)) (defncall 'm-render-fn '-> (api/symbol 'm-ui) @@ -3475,12 +3471,12 @@ (api/symbol 'm-ui) (api/key-fn :sinks) (api/key-fn :mouse)) - (defncall 'oasis-mouse 'm-mouse-fn) + (defncall 'oasis-bug 'm-mouse-fn) (defncall 'm-kb-fn '-> (api/symbol 'm-ui) (api/key-fn :sinks) (api/key-fn :kb)) - (defncall 'oasis-kb 'm-kb-fn) + (defncall 'oasis-keyboard 'm-kb-fn) (defncall 'm-render '-> (api/symbol 'oasis-render)) @@ -3507,36 +3503,71 @@ (api/key-fn :sources) (api/key-fn :init)) (defncall 'core-init 'm-init-fn) + (defncall 'm-core-kb-fn '-> + (api/symbol 'm-core) + (api/key-fn :sources) + (api/key-fn :kb)) + (defncall 'core-kb-in 'm-core-kb-fn) + (defncall 'm-core-mouse-fn '-> + (api/symbol 'm-core) + (api/key-fn :sources) + (api/key-fn :mouse)) + (defncall 'core-mouse-in 'm-core-mouse-fn) (defncall 'log-state 'pipes/log (api/string "log-state: ")) (defncall 'log-render 'pipes/log (api/string "render: ")) + (defncall 'log-foo 'pipes/log (api/string "foo: ")) + + (defncall 'header '-> + (api/map {(api/keyword :header) + (api/map {(api/keyword :oasis.gui/order) + (api/integer 1) + (api/keyword :oasis.gui/element) + (api/vector [(api/keyword :h1) + (api/string "사막 Oasis")])})})) + (defncall 'oasis-init 'pipes/debug) - (defncall 'init 'pipes/debug) - (api/defexp 'oasis-main (api/pipe (api/symbol 'oasis-init) - (api/symbol 'init))) - (api/defexp 'oasis (api/map {(api/keyword :sources) (api/map {(api/keyword :main) (api/symbol 'oasis-init) - - (api/keyword :mouse) (api/symbol 'oasis-mouse) - (api/keyword :kb) (api/symbol 'oasis-kb) - (api/keyword :eval) (api/symbol 'oasis-eval) - (api/keyword :layout) (api/symbol 'oasis-layout) - }) - ;; (api/keyword :sink) (api/vector [(api/symbol 'oasisp)]) - (api/keyword :tests) (api/map {(api/keyword ::test) - (api/map {(api/keyword :when) (api/map {(api/string "init") - (api/vector [(api/integer 1)])}) - (api/keyword :then) (api/map {(api/string "oasis-ui-out") - (api/vector [(api/keyword :success)])})})})}))]) + (api/defmodule 'oasis (api/map {(api/keyword :depends) (api/map {(api/keyword :oasis-core) (api/symbol 'oasis-core) + + (api/keyword :oasis-render) (api/symbol 'oasis-render) + (api/keyword :oasis-ui) (api/symbol 'oasis-ui) + }) + (api/keyword :sources) (api/map {(api/keyword :module-core) (api/symbol 'm-core) + (api/keyword :module-core-out) (api/symbol 'core-state) + (api/keyword :module-render) (api/symbol 'm-render) + (api/keyword :module-render-out) (api/symbol 'render-elems) + (api/keyword :module-ui) (api/symbol 'm-ui) + (api/keyword :kb) (api/symbol 'oasis-keyboard) + (api/keyword :mouse) (api/symbol 'oasis-bug) + (api/keyword :main) (api/symbol 'oasis-init) + })})) + (api/defexp 'oasis-legacy (api/map {(api/keyword :sources) (api/map {(api/keyword :main) (api/symbol 'oasis-init) + + (api/keyword :mouse) (api/symbol 'oasis-mouse) + (api/keyword :kb) (api/symbol 'oasis-kb) + (api/keyword :eval) (api/symbol 'oasis-eval) + (api/keyword :layout) (api/symbol 'oasis-layout) + }) + ;; (api/keyword :sink) (api/vector [(api/symbol 'oasisp)]) + (api/keyword :tests) (api/map {(api/keyword ::test) + (api/map {(api/keyword :when) (api/map {(api/string "init") + (api/vector [(api/integer 1)])}) + (api/keyword :then) (api/map {(api/string "oasis-ui-out") + (api/vector [(api/keyword :success)])})})})})) + ]) (def oasis-module-net [ - (pipe 'init 'header 'ui-render) - (pipe 'init 'core-init) + (pipe 'oasis-init 'header 'ui-render) + (pipe 'oasis-init 'core-init) ;; (pipe 'core-state 'log-state) (pipe 'core-state 'render-state) ;; (pipe 'render-elems 'log-render) (pipe 'render-elems 'ui-render) + + (pipe 'oasis-keyboard 'core-kb-in) + (pipe 'oasis-bug 'core-mouse-in) ]) @@ -3544,12 +3575,12 @@ (into oasis-ui-defs (flatten oasis-ui-net))) (def network (concat oasis-module-net oasis-ui-net oasis-core-net oasis-render-net)) -(def oasis (into oasis1 (into oasis2 (into oasis3 (into oasis-core-defs (into oasis-render-defs (into oasis-ui-defs oasis-module-defs))))))) +(def oasis (into oasis1 (into oasis2 (into oasis-core-defs (into oasis-render-defs (into oasis-ui-defs oasis-module-defs)))))) (defn start [] (into oasis (flatten network))) -(defn store [stores] - (.persist-tree! stores oasis) - (.persist-tree! stores (flatten network)) - stores) +(defn store [s] + (stores/persist-tree! s oasis) + (stores/persist-tree! s (flatten network)) + s) From 07aae8f4ef587a4b44ed30d4ec4b6ef2b89d701e Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Mon, 8 Jun 2020 22:04:45 +0200 Subject: [PATCH 02/12] WIP runtime module loading --- dev_src/dev/render.cljc | 86 ++++++++++++++++++++++---------- src/samak/runtime.cljc | 30 +++++++----- ui_src/samak/oasis.cljc | 105 +++++++++++++++++++++++----------------- 3 files changed, 139 insertions(+), 82 deletions(-) diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index 8298a70..b0b18b2 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -134,7 +134,7 @@ (defn eval-oasis "" [length cb state [nr exp]] - (println "eval" nr exp) + ;; (println "eval" nr exp) (let [progress (int (* (/ nr length) 100))] (when (= 0 (mod progress 10)) (put! cb progress) @@ -154,22 +154,40 @@ (doseq [expression parsed] (caravan/repl-eval expression)))) -(defn load-bundle +(defn load-module "" - [sym rt] - (let [_ (print " V" "Fetching bundle from DB: " sym) - bundle (run/load-bundle rt sym) - _ (println bundle) - sources (map #(run/load-network rt %) bundle) + [rt mod] + (let [sources (map #(run/load-network rt %) (:roots mod)) net (reduce (fn [a, v] (let [val (vals v)] {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) })) - {:nodes (into [] bundle) + {:nodes (into [] (:roots mod)) :pipes []} sources)] - net + net)) + + +(defn load-deps + "" + [rt [id mod]] + (println "load-deps" id mod) + (let [deps (:dependencies mod)] + {:id id + :deps (mapv (fn [m] (load-deps rt (first m))) deps) + :roots (load-module rt mod)}) + ) + + +(defn load-bundle + "" + [rt sym] + (let [_ (print " V" "Fetching bundle from DB: " sym) + bundle (get (run/load-bundle rt sym) sym) + _ (println "bundle: " bundle) + deps (load-deps rt [sym bundle])] + deps )) (defn load-ast @@ -182,25 +200,43 @@ form)) (run/load-by-id rt id))) + +(defn eval-module + "" + [rt module] + (println "eval" (:id module)) + (doall (map #(eval-module rt %) (:deps module))) + (let [roots (:roots module) + asts (map #(load-ast rt %) (into (into [] (distinct (:nodes roots))) (distinct (:pipes roots))))] + (update rt :server run/eval-all asts))) + + (defn start-oasis [cb] - (let [c (chan) - net (load-bundle 'oasis @rt) + (let [net (load-bundle @rt 'oasis) _ (println net) - exps (into (into [] (distinct (:nodes net))) (distinct (:pipes net))) - _ (println exps) - source (map #(load-ast @rt %) exps) - ;; _ (println source) - numbered (map-indexed vector source) - cnt (count numbered)] - (go-loop [state @rt] - (let [part ( - (api/symbol 'oasis-ui)) - (defncall 'm-render-fn '-> - (api/symbol 'm-ui) - (api/key-fn :sources) - (api/key-fn :render)) - (defncall 'ui-render 'm-render-fn) - (defncall 'm-mouse-fn '-> - (api/symbol 'm-ui) - (api/key-fn :sinks) - (api/key-fn :mouse)) - (defncall 'oasis-bug 'm-mouse-fn) - (defncall 'm-kb-fn '-> - (api/symbol 'm-ui) - (api/key-fn :sinks) - (api/key-fn :kb)) - (defncall 'oasis-keyboard 'm-kb-fn) - - (defncall 'm-render '-> - (api/symbol 'oasis-render)) - (defncall 'm-state-fn '-> - (api/symbol 'm-render) - (api/key-fn :sources) - (api/key-fn :state)) - (defncall 'render-state 'm-state-fn) - (defncall 'm-elems-fn '-> - (api/symbol 'm-render) - (api/key-fn :sinks) - (api/key-fn :svg-elems)) - (defncall 'render-elems 'm-elems-fn) + ;; (defncall 'm-ui '-> + ;; (api/symbol 'oasis-ui)) + ;; (defncall 'm-render-fn '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sources) + ;; (api/key-fn :render)) + ;; (defncall 'ui-render 'm-render-fn) + ;; (defncall 'm-mouse-fn '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :mouse)) + ;; (defncall 'oasis-bug 'm-mouse-fn) + ;; (defncall 'm-kb-fn '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :kb)) + ;; (defncall 'oasis-keyboard 'm-kb-fn) + ;; (defncall 'm-events-fn '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :events)) + ;; (defncall 'oasis-events 'm-events-fn) + + ;; (defncall 'm-render '-> + ;; (api/symbol 'oasis-render)) + ;; (defncall 'm-state-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sources) + ;; (api/key-fn :state)) + ;; (defncall 'render-state 'm-state-fn) + ;; (defncall 'm-elems-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sinks) + ;; (api/key-fn :svg-elems)) + ;; (defncall 'render-elems 'm-elems-fn) (defncall 'm-core '-> (api/symbol 'oasis-core)) @@ -3513,6 +3523,11 @@ (api/key-fn :sources) (api/key-fn :mouse)) (defncall 'core-mouse-in 'm-core-mouse-fn) + (defncall 'm-core-events-fn '-> + (api/symbol 'm-core) + (api/key-fn :sources) + (api/key-fn :events)) + (defncall 'core-events-in 'm-core-events-fn) (defncall 'log-state 'pipes/log (api/string "log-state: ")) (defncall 'log-render 'pipes/log (api/string "render: ")) @@ -3535,11 +3550,12 @@ }) (api/keyword :sources) (api/map {(api/keyword :module-core) (api/symbol 'm-core) (api/keyword :module-core-out) (api/symbol 'core-state) - (api/keyword :module-render) (api/symbol 'm-render) - (api/keyword :module-render-out) (api/symbol 'render-elems) - (api/keyword :module-ui) (api/symbol 'm-ui) - (api/keyword :kb) (api/symbol 'oasis-keyboard) - (api/keyword :mouse) (api/symbol 'oasis-bug) + ;; (api/keyword :module-render) (api/symbol 'm-render) + ;; (api/keyword :module-render-out) (api/symbol 'render-elems) + ;; (api/keyword :module-ui) (api/symbol 'm-ui) + ;; (api/keyword :kb) (api/symbol 'oasis-keyboard) + ;; (api/keyword :mouse) (api/symbol 'oasis-bug) + ;; (api/keyword :events) (api/symbol 'oasis-events) (api/keyword :main) (api/symbol 'oasis-init) })})) (api/defexp 'oasis-legacy (api/map {(api/keyword :sources) (api/map {(api/keyword :main) (api/symbol 'oasis-init) @@ -3559,15 +3575,16 @@ (def oasis-module-net [ - (pipe 'oasis-init 'header 'ui-render) + ;; (pipe 'oasis-init 'header 'ui-render) (pipe 'oasis-init 'core-init) ;; (pipe 'core-state 'log-state) - (pipe 'core-state 'render-state) + ;; (pipe 'core-state 'render-state) ;; (pipe 'render-elems 'log-render) - (pipe 'render-elems 'ui-render) + ;; (pipe 'render-elems 'ui-render) - (pipe 'oasis-keyboard 'core-kb-in) - (pipe 'oasis-bug 'core-mouse-in) + ;; (pipe 'oasis-keyboard 'core-kb-in) + ;; (pipe 'oasis-bug 'core-mouse-in) + ;; (pipe 'oasis-events 'core-events-in) ]) From 6f5c54adb755f0cab8d0d47886ac46190b165ba1 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Thu, 23 Jul 2020 06:42:00 +0200 Subject: [PATCH 03/12] Implement proper module handling and port Oasis over - works except for UI events --- dev_src/dev/core.cljs | 25 ++- dev_src/dev/render.cljc | 244 +++++++-------------- src/samak/nodes.cljc | 35 ++-- src/samak/pipes.cljc | 2 +- src/samak/runtime.cljc | 95 ++++++--- src/samak/runtime/servers.cljc | 1 + src/samak/scheduler.cljc | 122 +++++++++++ ui_src/samak/caravan.cljc | 185 ++++++++-------- ui_src/samak/layout.cljs | 1 + ui_src/samak/oasis.cljc | 373 +++++++++++++++++++++++---------- ui_src/samak/ui_stdlib.cljs | 85 +++++--- ui_src/samak/worker.cljc | 123 +++++------ 12 files changed, 777 insertions(+), 514 deletions(-) create mode 100644 src/samak/scheduler.cljc diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index 7fbb592..b0e76e8 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -9,6 +9,11 @@ [samak.builtins :as builtins]) (:require-macros [cljs.core.async.macros :refer [go go-loop]])) +(defn start-main + [load in out] + (render/start-render-runtime load in out) + (render/start-oasis)) + (defn update-bar "" @@ -22,10 +27,14 @@ (defn handle-update "" - [c] + [c done] (go-loop [] (let [p (! chan go go-loop close! put! pipe]] - [clojure.walk :as w] [samak.api :as api] [samak.helpers :as helpers] - [samak.lisparser :as p] [samak.builtins :as builtins] [samak.stdlib :as std] [samak.trace :as trace] [samak.oasis :as oasis] [samak.caravan :as caravan] + [samak.lisparser :as p] + [samak.test-programs :as test-programs] [samak.pipes :as pipes] - [samak.runtime :as run] - [samak.runtime.stores :as stores])] + [samak.scheduler :as sched] + [samak.runtime :as run])] :cljs [(:require [clojure.string :as str] [cljs.reader :as edn] [clojure.core.async :as a :refer [! chan close! put! pipe]] - [clojure.walk :as w] [samak.api :as api] [samak.helpers :as helpers] [samak.lisparser :as p] @@ -32,37 +31,39 @@ [samak.trace :as trace] [samak.oasis :as oasis] [samak.caravan :as caravan] + [samak.lisparser :as p] + [samak.test-programs :as test-programs] [samak.layout :as layout] [samak.pipes :as pipes] - [samak.runtime :as run] - [samak.runtime.stores :as stores]) + [samak.scheduler :as sched] + [samak.runtime :as run]) (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) -(defn make-piped - "" - [name] - {:target :pipe :named (keyword name)}) - -(def std-mock-symbols - {'pipes/to-mouse (make-piped 'pipes/to-mouse) - 'pipes/to-keyboard (make-piped 'pipes/to-keyboard) - 'pipes/to-ui (make-piped 'pipes/to-ui) - 'pipes/to-log (make-piped 'pipes/to-log)}) - (def renderer-symbols (merge builtins/samak-symbols std/pipe-symbols caravan/symbols - ;; std-mock-symbols #?(:cljs layout/layout-symbols) #?(:cljs uistd/ui-symbols))) (def rt (atom {})) +(def rt2 (atom {})) (def config {:tracer {:backend :none :url "/api/v2/"}}) (def tracer (atom {})) +(def main-conf {"oasis-core" {:depends {} + :sinks {:state (sched/make-pipe-id {:module :lone :type :sinks :name :state})} + :sources { + :init (sched/make-pipe-id {:module :lone :type :sources :name :init}) + :kb (sched/make-pipe-id {:module :lone :type :sources :name :kb}) + :mouse (sched/make-pipe-id {:module :lone :type :sources :name :mouse}) + :events (sched/make-pipe-id {:module :lone :type :sources :name :events}) + } + }}) + + (defn handle-update "" [msg pipe] @@ -70,188 +71,101 @@ (a/tap (pipes/out-port pipe) c) (go-loop [] (let [p (" mod "/" pipe)))) (def get-named-pipe-memo (memoize get-named-pipe)) (defn handle-render "" - [c] + [rt c] (go-loop [] (let [p ( mod :-sinks :-render) 42))" - "(| ((-> mod :-sources :-events) 42) (pipes/to-ui))" - "(| ((-> mod :-sources :-mouse) 42) (pipes/to-mouse))" - "(| ((-> mod :-sources :-keyboard) 42) (pipes/to-keyboard))"]) - -;; (defn eval-render -;; "" -;; [] -;; (let [code (str/join " " renderer) -;; parsed (p/parse-all code)] -;; (swap! rt #(reduce run/eval-expression! % (:value parsed))))) - -(defn fire-event-into-named-pipe - [pipe-name event] - (let [pipe (run/get-definition-by-name @rt (symbol pipe-name))] - (if (pipes/pipe? pipe) - (do (let [arg (edn/read-string event)] - (pipes/fire! pipe arg pipe-name)) - {}) - (println (str "could not find pipe " pipe-name))))) - -(defn eval-oasis - "" - [length cb state [nr exp]] - ;; (println "eval" nr exp) - (let [progress (int (* (/ nr length) 100))] - (when (= 0 (mod progress 10)) - (put! cb progress) - (println (str progress "%"))) - (update state :server run/eval-all [exp]) - )) - -(defn run-oasis - "" - [state cb] - (put! cb 100) - (reset! rt state) - (caravan/init @rt) - (fire-event-into-named-pipe "oasis-init" "1") - (println "oasis started") - (let [parsed [(api/defexp 'start (api/fn-call (api/symbol 'pipes/debug) []))]] - (doseq [expression parsed] - (caravan/repl-eval expression)))) - -(defn load-module - "" - [rt mod] - (let [sources (map #(run/load-network rt %) (:roots mod)) - net (reduce (fn [a, v] - (let [val (vals v)] - {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) - :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) - })) - {:nodes (into [] (:roots mod)) - :pipes []} - sources)] - net)) - +(defn trace + [src duration msg] + (trace/trace src duration msg)) -(defn load-deps +(defn start-oasis "" - [rt [id mod]] - (println "load-deps" id mod) - (let [deps (:dependencies mod)] - {:id id - :deps (mapv (fn [m] (load-deps rt (first m))) deps) - :roots (load-module rt mod)}) + [] + (run-oasis @rt) ) -(defn load-bundle - "" - [rt sym] - (let [_ (print " V" "Fetching bundle from DB: " sym) - bundle (get (run/load-bundle rt sym) sym) - _ (println "bundle: " bundle) - deps (load-deps rt [sym bundle])] - deps -)) - -(defn load-ast - "loads an ast given by its entity id from the database" - [rt id] - (w/postwalk (fn [form] - (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) - (:db/id form))] - (run/load-by-id rt sub-id) - form)) - (run/load-by-id rt id))) - - -(defn eval-module - "" - [rt module] - (println "eval" (:id module)) - (doall (map #(eval-module rt %) (:deps module))) - (let [roots (:roots module) - asts (map #(load-ast rt %) (into (into [] (distinct (:nodes roots))) (distinct (:pipes roots))))] - (update rt :server run/eval-all asts))) - - -(defn start-oasis - [cb] - (let [net (load-bundle @rt 'oasis) - _ (println net) - state (eval-module @rt net)] - (run-oasis state cb))) - -;; (defn start-oasis -;; [cb] -;; (let [c (chan) -;; net (load-bundle @rt 'oasis) -;; _ (println net) -;; exps (into (into [] (distinct (:nodes net))) (distinct (:pipes net))) -;; _ (println "exps" exps) -;; source (map #(load-ast @rt %) exps) -;; ;; _ (println source) -;; numbered (map-indexed vector source) -;; cnt (count numbered)] -;; (go-loop [state @rt] -;; (let [part (" evaled)) - evaled))) +(defn foo + "" + [& args] + (println args)) + + +(defmethod eval-node ::fuse [{:keys [::module-name ::bindings] :as module}] + (foo module) + (let [mod (eval-node module-name)] + )) (defmethod eval-node ::map [{:keys [::mapkv-pairs]}] (reduce (fn [a {:keys [::mapkey ::mapvalue]}] @@ -87,8 +90,14 @@ (defmethod eval-node ::fn-ref [{:keys [::fn] :as f}] (or ((:resolve *manager*) (:db/id fn)) - (when (api/is-def? fn) (eval-node fn)) - (compile-error "Undefined reference " fn " in " *manager*))) + (when (api/is-def? fn) + (let [res (eval-node fn)] + (println "evaling" (:db/id fn) "->" res "def" fn) res)) + ;; (when (api/is-module? fn) + ;; (let [res (eval-node fn)] + ;; (println "evaling" (:db/id fn) "->" res "mod" fn) res)) + (println "type:" (::type fn) (:db/id fn)) + (compile-error "Undefined reference for evaling " *db-id* " fn " fn))) (defmethod eval-node ::fn-call [{:keys [::fn-expression ::arguments]}] (let [func (eval-node fn-expression)] diff --git a/src/samak/pipes.cljc b/src/samak/pipes.cljc index fa6b3bd..919ad29 100644 --- a/src/samak/pipes.cljc +++ b/src/samak/pipes.cljc @@ -119,7 +119,7 @@ (defn fire-raw! "put a raw event into the given pipe. should be used for testing only." [pipe event] - (println "pipe fire" pipe) + ;; (println "pipe fire" pipe) (put! (in-port pipe) event)) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index d35a6e6..f7c18d7 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -3,6 +3,7 @@ (:clj [(:require [clojure.core.async :as a :refer [! chan go go-loop close! put!]] + [clojure.walk :as w] [samak.runtime.stores :as stores] [samak.runtime.servers :as servers] [samak.helpers :as helpers] @@ -16,6 +17,7 @@ :cljs [(:require [clojure.core.async :as a :refer [! chan close! put!]] + [clojure.walk :as w] [samak.runtime.stores :as stores] [samak.runtime.servers :as servers] [samak.helpers :as helpers] @@ -35,14 +37,26 @@ (defn eval-all [server forms] (reduce (fn [server form] (swap! resolver #(assoc % :server server)) + ;; (println "form" (:db/id form) "->" form) (servers/eval-ast server form)) server forms)) + (defn load-by-id "" [{store :store} id] (stores/load-by-id store id)) +(defn load-ast + "loads an ast given by its entity id from the database" + [rt id] + (w/postwalk (fn [form] + (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) + (:db/id form))] + (load-by-id rt sub-id) + form)) + (load-by-id rt id))) + (defn cancel? "" @@ -67,40 +81,44 @@ fn (get defs id)] fn ;; (if fn - ;; fn + ;; (do + ;; ;; (println "resolved " id "-> " fn) + ;; fn) ;; (println "not evaluated: " id " -> " (stores/load-by-id (:store rt) id))) ))) (defn wrap-out "" - [target] + [target id] (fn [paket] + ;; (println id "wrap-out paket" target paket) {::type ::paket ::target (:named target) ::content paket})) (defn wrap-in "" - [wrapped] + [wrapped id] (fn [paket] + ;; (println id "wrap-in paket" wrapped paket) (let [type (::type paket) - target (subs (name (::target paket)) 3)] - (if (and (= type ::paket) (= target (name (:named wrapped)))) + target (::target paket)] + (if (and (= type ::paket) (= target (:name (:named wrapped)))) (do - ;; (println "wrap-in" wrapped target) + ;; (println "wrap-in target" target (::content paket)) (::content paket)) ::ignore)))) ;;FIXME (defn replace-piped "" - [{target :target :as pipe} dir] + [{target :target :as pipe}] (if (not= target :pipe) pipe (do (println "replacing " pipe) (let [from-scheduler (:scheduler @resolver) - trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe)) (remove #(= % ::ignore)))) + trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe (:id @resolver))) (remove #(= % ::ignore)))) to-world (:broadcast @resolver) - trans-out (pipes/transduction-pipe (map (wrap-out pipe))) + trans-out (pipes/transduction-pipe (map (wrap-out pipe (:id @resolver)))) in-mapped (pipes/link! from-scheduler trans-in) out-mapped (pipes/link! trans-out to-world)] (pipes/composite-pipe out-mapped in-mapped))))) @@ -109,23 +127,46 @@ "" [from to xf] (println "linking" from to) - (let [a (replace-piped from "from") - c (replace-piped to "to")] - (when (not a) + (let [a (replace-piped from) + c (replace-piped to)] + (when (not (pipes/pipe? a)) (fail "cant link from " from)) - (when (not c) + (when (not (pipes/pipe? c)) (fail "cant link to " to)) (if xf (pipes/link! (pipes/link! a xf) c) (pipes/link! a c)))) +(defn instanciate-module + "" + [{:keys [:samak.nodes/definition] :as module} man] + (let [n (str (:samak.nodes/name module)) + c (get (:config man) n)] + (if c + (fn [] + (println "return stub for" n "[" (:db/id module) "] -> " c) + c) + (fn [] + ;; FIXME + ;; needs to prep resolve magic when instanciating pipes, to select same runtime + ;; maybe simply do so explicitly + ;; (if (:config man)) + (println (str "about to eval module: " module)) + (let [evaled (n/eval-env man nil definition (:db/id module))] + (println (str "used module: " module "->" evaled)) + evaled))))) + (defn make-runtime-internal "" - [scheduler] + [scheduler conf] (let [c (pipes/pipe (chan))] {:id (str "rt-" (helpers/uuid)) :store (stores/make-local-store) - :server (servers/make-local-server {:resolve resolve-fn :link link-fn :cancel? cancel?}) + :server (servers/make-local-server {:config conf + :resolve resolve-fn + :link link-fn + :cancel? cancel? + :module instanciate-module}) :broadcast c :scheduler (when scheduler (scheduler c))})) @@ -135,7 +176,9 @@ ([builtins] (make-runtime builtins nil)) ([builtins scheduler] - (let [runtime (-> (make-runtime-internal scheduler) + (make-runtime builtins scheduler {})) + ([builtins scheduler conf] + (let [runtime (-> (make-runtime-internal scheduler conf) (update :store stores/load-builtins! (keys builtins)) (update :server servers/load-builtins! builtins)) rt2 (->> (keys builtins) @@ -205,6 +248,7 @@ fn (if (:samak.nodes/fn-expression val) (:samak.nodes/fn-expression val) val)] (get-in fn [:samak.nodes/fn :db/id]))) + (defn get-ids-from-source-def [def type-set] (let [deps (filter #(type-set (:samak.nodes/value (:samak.nodes/mapkey %))) def) @@ -225,8 +269,8 @@ ;; _ (println "kvs" kvs) sources (get-ids-from-source-def kvs #{:sources}) deps (get-ids-from-source-def kvs #{:depends}) - source-ids (mapv get-id-from-source-val sources) - _ (println "sources" source-ids) + source-ids (apply sorted-set (map get-id-from-source-val sources)) + _ (println "source-ids:" source-ids) dep-ids (mapv get-id-from-source-val deps) _ (println "dep-ids" dep-ids) deps-source-ids (mapv (fn [dep] @@ -242,10 +286,10 @@ (defn load-bundle - "loads the definition of a bundle" - [rt sym] - (let [defns (load-by-sym rt sym)] - (load-roots-from-bundle rt sym defns))) + "loads the definition of a bundle by the given id" + [rt id] + (let [defns (load-by-id rt id)] + (load-roots-from-bundle rt id defns))) (defn eval-expression! [{:keys [store server] :as rt} form] @@ -255,10 +299,13 @@ (defn resolve-name [runtime sym] (-> runtime :store (stores/resolve-name sym))) +(defn get-definition-by-id [runtime id] + (when id + (-> runtime :server servers/get-defined (get id)))) + (defn get-definition-by-name [runtime sym] (let [id (-> runtime :store (stores/resolve-name sym))] - (println "def id:" id) - (-> runtime :server servers/get-defined (get id)))) + (get-definition-by-id runtime id))) (defn fire-into-named-pipe diff --git a/src/samak/runtime/servers.cljc b/src/samak/runtime/servers.cljc index 5879e53..957b4ed 100644 --- a/src/samak/runtime/servers.cljc +++ b/src/samak/runtime/servers.cljc @@ -19,6 +19,7 @@ (load-builtins [this builtins]) (unload [this ids])) + (defrecord LocalSamakServer [defined-ids builtins manager] SamakServer (eval-ast [this {:keys [db/id] :as ast}] diff --git a/src/samak/scheduler.cljc b/src/samak/scheduler.cljc new file mode 100644 index 0000000..1b4b391 --- /dev/null +++ b/src/samak/scheduler.cljc @@ -0,0 +1,122 @@ +(ns samak.scheduler + #?@ + (:clj + [(:require + [clojure.string :as str] + [clojure.core.async :as a :refer [! chan go go-loop close! put! pipe]] + [samak.api :as api] + [samak.helpers :as helpers] + [samak.lisparser :as p] + [samak.builtins :as builtins] + [samak.stdlib :as std] + [samak.pipes :as pipes] + [samak.runtime :as run])] + :cljs + [(:require + [clojure.string :as str] + [clojure.core.async :as a :refer [! chan close! put! pipe]] + [samak.api :as api] + [samak.helpers :as helpers] + [samak.pipes :as pipes] + [samak.runtime :as run]) + (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) + +(defn make-pipe-id + "" + [name] + {:target :pipe :named name}) + +(defn module-id + "" + [sym] + (keyword (str "dynamic-" (name sym)))) + +(defn load-module + "" + [rt mod] + (let [sources (map #(run/load-network rt %) (:roots mod)) + net (reduce (fn [a, v] + (let [val (vals v)] + + {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) + :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) + })) + {:nodes (into [] (:roots mod)) + :pipes []} + sources)] + {:nodes (distinct (:nodes net)) + :pipes (distinct (:pipes net))})) + +(defn load-deps + "" + [rt [id mod]] + (println "load-deps" id mod) + (let [deps (:dependencies mod)] + {:id id + :deps (mapv (fn [m] (load-deps rt (first m))) deps) + :roots (load-module rt mod)}) + ) + + +(defn load-bundle + "" + [rt sym] + (let [_ (print " V" "Fetching bundle from DB:" sym) + bundle-id (run/resolve-name rt sym) + _ (print " V" "Bundle id:" bundle-id) + bundle (get (run/load-bundle rt bundle-id) bundle-id) + _ (println "bundle: " bundle) + deps (load-deps rt [bundle-id bundle])] + deps +)) + +(defn eval-module + "" + [rt conf module root] + (if (contains? conf (:id module)) + (println "skipping" (:id module)) + (do + (println "eval" (:id module) "->" module) + (doall (map #(eval-module rt conf % (:id %)) (:deps module))) + (println "loading" (:id module)) + (let [roots (:roots module) + base (if root [root] []) + root-ids (into (into base (:nodes roots)) (:pipes roots)) + _ (println "[" (:id module) "] roots" root-ids) + asts (doall (map #(run/load-ast @rt %) root-ids))] + (println "evaling" (:id module)) + (reset! rt (update @rt :server run/eval-all asts)) + (println "done" (:id module)))))) + +(defn run-module + "" + [rt id sym] + (let [mod (run/get-definition-by-id @rt id) + exp [(assoc (api/fn-call {:db/id id} []) :db/id sym)]] + (reset! rt (update @rt :server run/eval-all exp)))) + +(defn setup-out + "" + [rt [key pipe]] + (println (:id @rt) "setup out" key) + (let [wrap (pipes/transduction-pipe (map (run/wrap-out {:named key} :setup)))] + (pipes/link! pipe wrap) + (pipes/link! wrap (:broadcast @rt)))) + + +(defn setup-outs + "" + [rt mod] + (doall (map (partial setup-out rt) (:sinks mod)))) + + +(defn start-module + [rt conf sym] + (let [net (load-bundle @rt sym) + mod-name (module-id 'lone)] + (eval-module rt conf net (:id net)) + (println "module" sym "done \\o/" rt) + (run-module rt (:id net) mod-name) + (let [mod (run/resolve-fn @rt mod-name)] + (println "mod" mod) + (setup-outs rt mod)))) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 6de1733..7fa56c3 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -3,10 +3,11 @@ (:clj [(:require [clojure.string :as s] [clojure.walk :as w] - [clojure.core.async :as a :refer [! chan go go-loop close!]] + [clojure.core.async :as a :refer [! put! chan go go-loop close!]] [samak.test-programs :as test-programs] [samak.api :as api] [samak.lisparser :as p] + [samak.scheduler :as sched] [samak.runtime :as rt] [samak.runtime.servers :as servers] [samak.pipes :as pipes] @@ -22,10 +23,11 @@ :cljs [(:require [clojure.string :as s] [clojure.walk :as w] - [clojure.core.async :as a :refer [! chan close!]] + [clojure.core.async :as a :refer [! put! chan close!]] [samak.test-programs :as test-programs] [samak.api :as api] [samak.lisparser :as p] + [samak.scheduler :as sched] [samak.runtime :as rt] [samak.runtime.servers :as servers] [samak.pipes :as pipes] @@ -37,7 +39,7 @@ [samak.tools :as tools]) (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) -(def rt-conn (atom {})) +(def rt-conn (atom {:state :uninited})) (def rt-preview (atom {})) (def fns (atom {})) (def net (atom {})) @@ -174,8 +176,13 @@ (defn notify-source "" - [src] - (doall (map (fn [[key val]] (std/notify-source {(str key) val})) src))) + ([c src] + (notify-source c src nil)) + ([c src cb] + (doall (map (fn [[key val]] (if cb + (put! c (pipes/make-paket {(str key) val} ::notify) cb) + (put! c (pipes/make-paket {(str key) val} ::notify)))) + src)))) (defn is-sink? @@ -297,10 +304,12 @@ (defn repl-eval [exp] - (if (api/is-pipe? exp) - (notify-source (add-pipe exp)) - (let [loaded (single! exp)] - (notify-source (add-node (symbol (str (:samak.nodes/name exp))) loaded))))) + (throw (str "broken: " exp)) + ;; (if (api/is-pipe? exp) + ;; (notify-source (add-pipe exp)) + ;; (let [loaded (single! exp)] + ;; (notify-source (add-node (symbol (str (:samak.nodes/name exp))) loaded)))) + ) (defn find-cell-internal @@ -384,7 +393,7 @@ (defn add-cell "" - [{:keys [sym cell type] :as x}] + [ev {:keys [sym cell type] :as x}] (println (str "adding: " x)) (let [src (get @fns (symbol sym)) idx (dec cell)] @@ -400,7 +409,7 @@ (let [write (persist! @rt-conn [updated]) exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) - (notify-source (add-node (symbol sym) exp)) + (notify-source ev (add-node (symbol sym) exp)) :done))))) (defn value-from-type @@ -415,7 +424,7 @@ (defn edit-cell "" - [{:keys [sym cell value] :as x}] + [ev {:keys [sym cell value] :as x}] (println (str "editing: " x)) (let [src (get @fns (symbol sym)) idx (dec cell)] @@ -426,7 +435,7 @@ (let [write (persist! @rt-conn [updated]) exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) - (notify-source (add-node (symbol sym) exp))))))) + (notify-source ev (add-node (symbol sym) exp))))))) (defn change-order @@ -439,7 +448,7 @@ (defn swap-cell "" - [{:keys [:sym :cell-idx :target] :as x}] + [ev {:keys [:sym :cell-idx :target] :as x}] (println (str "swap: " x)) (let [src (get @fns (symbol sym)) idx (dec cell-idx)] @@ -454,7 +463,7 @@ (let [write (persist! @rt-conn [node]) exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) - (notify-source (add-node (symbol sym) exp))) + (notify-source ev (add-node (symbol sym) exp))) )))) (defn remove-arg @@ -469,7 +478,7 @@ (defn cut-cell "" - [{:keys [sym cell-idx] :as x}] + [ev {:keys [sym cell-idx] :as x}] (println (str "cut: " x)) (let [src (get @fns (symbol sym)) idx (dec cell-idx)] @@ -484,12 +493,12 @@ (let [write (persist! @rt-conn [updated retract]) exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) - (notify-source (add-node (symbol sym) exp)) + (notify-source ev (add-node (symbol sym) exp)) :done))))) (defn indent-cell "" - [{:keys [sym cell-idx] :as x}] + [ev {:keys [sym cell-idx] :as x}] (println (str "indent: " x)) (let [src (get @fns (symbol sym)) idx (dec cell-idx)] @@ -517,7 +526,7 @@ (let [write (persist! @rt-conn [insertion fixup retract]) exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) - (notify-source (add-node (symbol sym) exp)) + (notify-source ev (add-node (symbol sym) exp)) :done))))))) (defn create-sink @@ -530,7 +539,7 @@ exp (api/defexp (symbol sym) (api/fn-call (api/symbol (symbol (str "pipes/" pipe-name))) nil)) ast (single! exp)] (println (str "res: " ast)) - (notify-source (add-node (symbol sym) ast)) + ;; (notify-source ev (add-node (symbol sym) ast)) ;; FIXME :okay))) (defn disconnect @@ -540,15 +549,15 @@ (defn connect "" - [source connector sink] + [ev source connector sink] ;; (println (str "connect " source " with " connector " to " sink)) (let [fn (api/defexp (symbol connector) (api/symbol '_)) fn-ast (single! fn) pipe (api/pipe (api/symbol (symbol source)) (api/symbol (symbol connector)) (api/symbol (symbol sink)))] - (notify-source (add-node (symbol connector) fn-ast)) - (notify-source (add-pipe pipe)))) + (notify-source ev (add-node (symbol connector) fn-ast)) + (notify-source ev (add-pipe pipe)))) (defn link @@ -562,7 +571,8 @@ (when (and sink source (not= sink source) ) (if existing (disconnect) - (connect source connector sink)))))) + ;; (connect ev source connector sink) ;; FIXME + ))))) (defn link-pipes "" @@ -663,6 +673,23 @@ pipe-asts (doall (map #(load-ast @rt-conn %1) pipes))] [node-notify pipe-asts])) +(defn handle-mod + "" + [module] + (println "mod" module) + (let [id (:id module) + root (:roots module)] + {id {:caravan/type :caravan/module + :caravan/name (str id) + :caravan/nodes (:nodes root) + :caravan/pipes (:pipes root)}})) + + +(defn handle-deps + "" + [deps] + (map handle-mod deps)) + (defn runtime-net "" @@ -679,35 +706,20 @@ {:nodes node-notify :pipes pipe-notify})) -(defn load-bundle - "" - [sym rt] - (let [_ (print " V" "Fetching bundle from DB: ") - bundle (rt/load-bundle rt sym) - _ (println (s/join "," bundle)) - sources (map #(rt/load-network rt %) bundle) - net (reduce (fn [a, v] - (let [val (vals v)] - {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) - :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) - })) - {:nodes (set bundle) - :pipes #{}} - sources)] - net -)) - - (defn eval-bundle "" [sym] - (database-net (load-bundle sym @rt-conn))) + (let [bundle (sched/load-bundle @rt-conn sym) + roots (:roots bundle) + deps (handle-deps (:deps bundle))] + (assoc (database-net roots) :modules deps) + )) (defn test-bundle "" [sym test] (let [verify (setup-verify) - bundle (load-bundle sym @rt-conn)] + bundle (:roots (sched/load-bundle @rt-conn sym))] (runtime-net bundle test verify) verify)) @@ -790,26 +802,29 @@ (defn load-lib "" - [c sym] + [cmd ev sym] (let [bundle (doall (eval-bundle sym)) - ;; merged (merge-with concat bundle) - ;; _ (println (str "bundle: " merged)) + merged (merge-with concat bundle) + _ (println (str "bundle: " merged)) ;; dist (into {} (for [[k v] merged] [k (distinct v)])) ;; _ (println (str "bundle2: " dist)) ;; cnt (apply + (map #(map count (vals %)) merged)) ] ;; (println (str "count: " cnt)) - (doall (map notify-source (:nodes bundle))) - (doall (map notify-source (:pipes bundle))) - (std/notify-source + (doall (map #(notify-source ev %) (:modules bundle))) + (doall (map #(notify-source ev %) (:nodes bundle))) + (doall (map #(notify-source ev %) (:pipes bundle))) + (println "notify done") + (notify-source + ev {::state ::done} - #(a/put! c (pipes/make-paket {::event ::load ::status ::done ::percent 100} ::caravan))))) + #(a/put! cmd (pipes/make-paket {::event ::load ::status ::done ::percent 100} ::caravan))))) (defn load-net "" - [c prog sym] + [cmd ev prog sym] (persist-net prog) - (load-lib c sym)) + (load-lib cmd ev sym)) (defn test-net "" @@ -819,8 +834,9 @@ (defn load-chuck "" - [c] - (load-net c test-programs/chuck 'chuck)) + [cmd ev] + (load-net cmd ev test-programs/chuck 'chuck) + ) (defn test-chuck "" @@ -829,8 +845,8 @@ (defn load-oasis "" - [c] - (load-lib c 'oasis)) + [cmd ev] + (load-lib cmd ev 'oasis)) (defn test-oasis "" @@ -869,30 +885,35 @@ (defn caravan-module "" [] - (let [caravan-in (chan) - caravan-out (chan)] - (go-loop [] - (when-let [x ( (api/symbol 'm-caravan) (api/key-fn :sinks) (api/key-fn :actions)) - (defncall 'caravan-commands '-> + (defncall 'm-caravan-commands '-> (api/symbol 'm-caravan) (api/key-fn :sources) (api/key-fn :commands)) + (defncall 'caravan-commands 'm-caravan-commands) + (defncall 'm-caravan-eval '-> + (api/symbol 'm-caravan) + (api/key-fn :sources) + (api/key-fn :eval)) + (defncall 'caravan-eval 'm-caravan-eval) (defncall 'log 'pipes/log) @@ -83,10 +89,10 @@ (defncall 'log-layout 'pipes/log (api/string "layout: ")) (defncall 'log-events 'pipes/log (api/string "events: ")) (defncall 'log-editor 'pipes/log (api/string "editor: ")) - (defncall 'log-mouse 'pipes/log (api/string "mouse: ")) (defncall 'log-hover 'pipes/log (api/string "hover: ")) (defncall 'log-keyboard 'pipes/log (api/string "keyboard: ")) - (defncall 'log-caravan 'pipes/log (api/string "caravan: ")) + (defncall 'log-caravan 'pipes/log (api/string "caravan-cmd: ")) + (defncall 'log-caravan-ev 'pipes/log (api/string "caravan-eval: ")) (defncall 'get-event-val '-> (api/key-fn :event) @@ -914,6 +920,7 @@ (api/keyword :data) (api/keyword :scouting)})])) (defncall 'handle-caravan-command '-> + (api/fn-call (api/symbol 'spy) [(api/string "car cmd")]) (api/symbol 'construct-back)) (defncall 'is-scroll '-> @@ -1010,6 +1017,9 @@ (defncall 'eval-events 'pipes/debug ;; (api/keyword :oasis.spec/eval-state) ) + ;; (defncall 'extract-eval '-> + ;; (api/key-fn :samak.pipes/content)) + (defncall 'eval-reduce 'pipes/reductions (api/fn-call (api/symbol '->) [(api/map {(api/keyword :org) (api/symbol '_) @@ -1559,9 +1569,18 @@ - (defncall 'is-pipe-eval '-> - (api/key-fn :caravan/type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/pipe)])) + (defncall 'is-pipe-eval '-> + (api/key-fn :caravan/type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/pipe)])) + + (defncall 'is-module-eval '-> + (api/key-fn :caravan/type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/module)])) + + (defncall 'filter-modules '-> + (api/key-fn :eval) + (api/fn-call (api/symbol 'filter) [(api/symbol 'is-module-eval) + (api/symbol '_)])) (defncall 'filter-nodes '-> (api/key-fn :eval) @@ -1573,6 +1592,18 @@ (api/fn-call (api/symbol 'filter) [(api/symbol 'is-pipe-eval) (api/symbol '_)])) + (defncall 'format-mod '-> + (api/fn-call (api/symbol 'spy) [(api/string "fmod2")]) + (api/map {(api/keyword :id) (api/key-fn :caravan/name) + (api/keyword :name) (api/key-fn :caravan/name) + (api/keyword :type) (api/keyword :module) + ;; (api/keyword :width) (api/integer 300) + ;; (api/keyword :height) (api/integer 300) + })) + + (defncall 'format-modules '-> + (api/fn-call (api/symbol 'map) [(api/symbol 'format-mod) (api/key-fn :modules)])) + (defncall 'merge-defs '-> (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) @@ -1603,13 +1634,17 @@ (api/map {(api/keyword :eval) (api/fn-call (api/symbol '->) [(api/key-fn :eval) (api/fn-call (api/symbol 'vals) [(api/symbol '_)])]) (api/keyword :context) (api/symbol '_)}) - (api/map {(api/keyword :defs) (api/symbol 'filter-nodes) - (api/keyword :pipes) (api/symbol 'filter-connections) - (api/keyword :context) (api/key-fn :context)}) + (api/map {(api/keyword :defs) (api/symbol 'filter-nodes) + (api/keyword :pipes) (api/symbol 'filter-connections) + (api/keyword :modules) (api/symbol 'filter-modules) + (api/keyword :context) (api/key-fn :context)}) + (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) (api/map {(api/keyword :id) (api/string "root") (api/keyword :layoutOptions) (api/map {(api/string "elk.algorithm") (api/string "layered")}) - (api/keyword :children) (api/symbol 'format-defs) - (api/keyword :edges) (api/symbol 'format-pipes)})) + (api/keyword :children) (api/symbol 'format-modules) + ;; (api/keyword :children) (api/symbol 'format-defs) + ;; (api/keyword :edges) (api/symbol 'format-pipes) + })) (defncall 'lay-in 'pipes/debug) @@ -2003,7 +2038,7 @@ (api/keyword :x) (api/integer 150) (api/keyword :y) (api/integer 50)})) - (defncall 'm-caravan-actions 'caravan-actions (api/integer 42)) + (defncall 'm-caravan-actions 'caravan-actions) ]) (def oasis-core-defs @@ -2012,21 +2047,32 @@ (defncall 'oasis-mouse 'pipes/debug) (defncall 'oasis-core-events 'pipes/debug) (defncall 'oasis-core-out 'pipes/debug) - (api/defmodule 'oasis-core (api/map {;;(api/keyword :depends) (api/map {(api/keyword :caravan) (api/symbol 'modules/caravan)}) - (api/keyword :sources) (api/map {;; (api/keyword :caravan) (api/symbol 'm-caravan) - (api/keyword :eval) (api/symbol 'oasis-eval) - (api/keyword :layout) (api/symbol 'oasis-layout) + + (defncall 'log-mouse 'pipes/log (api/string "mouse: ")) + (defncall 'log-state2 'pipes/log (api/string "state: ")) + + (api/defmodule 'oasis-core (api/map {(api/keyword :depends) (api/map {(api/keyword :caravan) (api/symbol 'modules/caravan)}) + (api/keyword :sources) (api/map {(api/keyword :module-caravan-inst) (api/symbol 'carv-mod) + (api/keyword :module-caravan) (api/symbol 'm-caravan) + (api/keyword :caravan-commands) (api/symbol 'm-caravan-commands) + (api/keyword :caravan-commands-inst) (api/symbol 'caravan-commands) + (api/keyword :caravan-eval) (api/symbol 'm-caravan-eval) + (api/keyword :caravan-eval-inst) (api/symbol 'caravan-eval) + ;(api/keyword :layout) (api/symbol 'oasis-layout) (api/keyword :init) (api/symbol 'oasis-core-init) (api/keyword :kb) (api/symbol 'oasis-kb) (api/keyword :mouse) (api/symbol 'oasis-mouse) (api/keyword :events) (api/symbol 'oasis-core-events) - (api/keyword :state) (api/symbol 'oasis-core-out)}) - (api/keyword :sinks) (api/map {(api/keyword :state) (api/symbol 'oasis-core-out)})}))]) + (api/keyword :state) (api/symbol 'oasis-core-out) + }) + (api/keyword :sinks) (api/map {(api/keyword :state) (api/symbol 'oasis-core-out) + })}))]) (def oasis-core-net - [ ;; networks + [;; networks + (pipe 'oasis-mouse 'log-mouse) (pipe 'oasis-mouse 'mouse-reduce) (pipe 'mouse-reduce 'mouse-state) (pipe 'oasis-mouse 'target-reduce) @@ -2038,7 +2084,7 @@ (pipe 'oasis-kb 'filter-key-input 'keyboard-filtered) (pipe 'keyboard-filtered 'filter-edit 'editor-commands) (pipe 'keyboard-filtered 'filter-menu 'editor-commands) - ;; (pipe 'keyboard-filtered 'log-keyboard) + (pipe 'keyboard-filtered 'log-keyboard) (pipe 'keyboard-filtered 'filter-view 'view-commands) (pipe 'view-commands 'make-zoom) @@ -2057,7 +2103,8 @@ ;; (pipe 'select-events 'editor-commands) - (pipe 'oasis-eval 'eval-events) + ;; (pipe 'caravan-eval 'log-caravan-ev) + (pipe 'caravan-eval 'eval-events) ;; (pipe 'eval-events 'log-events) (pipe 'eval-events 'eval-reduce) @@ -2071,10 +2118,7 @@ (pipe 'drag-state 'interpret-drag 'editor-commands) ;; (pipe 'drag-events 'log-mouse) - (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) - (api/symbol 'handle-caravan-command) - (api/symbol 'editor-commands)) - ;; (pipe 'caravan 'handle-caravan-command 'editor-commands) + (pipe 'caravan-commands 'handle-caravan-command 'editor-commands) (pipe 'editor-commands 'handle-commands 'editor-events) (pipe 'hover-state 'editor-events) (pipe 'scroll-state 'editor-events) @@ -2121,6 +2165,7 @@ (pipe 'mode-state 'state-dedupe) (pipe 'events 'state-dedupe) (pipe 'state-dedupe 'filter-state 'oasis-core-out) + ;; (pipe 'state-dedupe 'oasis-core-out) (pipe 'mode-state 'load-reduce) (pipe 'hover-state 'load-reduce) @@ -2152,7 +2197,7 @@ (pipe 'editor-actions 'handle-state) (pipe 'handle-state 'be-commands) - ;; (pipe 'be-commands 'log-command) + (pipe 'be-commands 'filter-call 'log-command) (api/pipe (api/symbol 'be-commands) (api/symbol 'filter-call) (api/symbol 'm-caravan-actions)) @@ -2160,13 +2205,17 @@ (pipe 'oasis-core-init 'init-view 'view-events) - (api/pipe (api/fn-call (api/symbol 'caravan-commands) [(api/integer 42)]) - (api/symbol 'log-caravan)) + (pipe 'oasis-core-init 'm-caravan-actions) + + (pipe 'caravan-commands 'log-caravan) ]) (def oasis-render-defs [ (defncall 'oasis-render-in 'pipes/debug) + (defncall 'log-mouse2 'pipes/log (api/string "mouse2: ")) + (defncall 'oasis-render-mouse-in 'pipes/debug) + (defncall 'oasis-render-mouse-out 'pipes/debug) (defncall 'oasis-render-out 'pipes/debug) ;; dark theme based on base16-atelierdune-dark @@ -3066,6 +3115,39 @@ (api/keyword :hovered) (api/symbol 'is-pipe-hovered)}) (api/symbol 'graph-pipe-single)) + (defncall 'graph-module '-> + (api/fn-call (api/symbol 'spy) [(api/string "gmod")]) + (api/vector [(api/keyword :g) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :id) (api/symbol 'func-id) + (api/keyword :fill-opacity) (api/float 0.7) + + (api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-gutter) (api/symbol 'get-color)]) + (api/keyword :stroke) (api/symbol 'get-func-stroke) + (api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) + (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) + (api/keyword :width) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :width)]) + (api/keyword :height) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :height)])})]) + (api/vector [(api/keyword :text) + (api/map {;; (api/keyword :transform) (api/string "rotate(90 50 50)") + (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) + (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) + (api/keyword :dy) (api/integer 14) + (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-name-stroke) (api/symbol 'get-color)]) + (api/keyword :text-anchor) (api/keyword :middle) + (api/keyword :font-weight) (api/string "bold") + (api/keyword :pointer-events) (api/string "none")}) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])]) + (api/fn-call (api/symbol 'spy) [(api/string "gmod2")]) + ) + + (defncall 'is-module '-> + (api/key-fn :node) + (api/key-fn :type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/module)])) + (defncall 'is-pipe-node '-> (api/key-fn :node) (api/key-fn :type) @@ -3076,6 +3158,8 @@ (api/key-fn :value)) (defncall 'graph-node '-> + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-module) + (api/symbol 'graph-module)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-pipe-node) (api/symbol 'graph-pipe)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-func-node) @@ -3094,7 +3178,7 @@ (api/key-fn :context)])]) (api/fn-call (api/symbol 'map) [(api/symbol 'merge-node) (api/symbol '_)]) (api/fn-call (api/symbol 'map) [(api/symbol 'graph-node) (api/symbol '_)]) - (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g)]) (api/symbol '_)])) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "nodes")})]) (api/symbol '_)])) (defncall 'graph-coords 'str (api/key-fn :x) @@ -3388,8 +3472,10 @@ (api/defmodule 'oasis-render (api/map {(api/keyword :sources) (api/map {(api/keyword :state) (api/symbol 'oasis-render-in) + (api/keyword :mouse) (api/symbol 'oasis-render-mouse-in) (api/keyword :svg-elems) (api/symbol 'oasis-render-out)}) - (api/keyword :sinks) (api/map {(api/keyword :svg-elems) (api/symbol 'oasis-render-out)})})) + (api/keyword :sinks) (api/map {(api/keyword :svg-elems) (api/symbol 'oasis-render-out) + (api/keyword :mouse) (api/symbol 'oasis-render-mouse-out)})})) ]) (def oasis-render-net @@ -3397,6 +3483,9 @@ (pipe 'oasis-render-in 'state-reduce) (pipe 'state-reduce 'condensed-state) + ;; (pipe 'oasis-render-mouse-in 'log-mouse2) + (pipe 'oasis-render-mouse-in 'oasis-render-mouse-out) + (pipe 'condensed-state 'only-resize 'svg-render) (pipe 'condensed-state 'graph 'svg-render) (pipe 'condensed-state 'graph-drag 'svg-render) @@ -3414,11 +3503,31 @@ (def oasis-ui-defs [ - (defncall 'oasis-ui-in 'pipes/debug) - (defncall 'oasis-ui-out 'pipes/ui (api/integer 2)) - (defncall 'oasis-ui-mouse 'pipes/mouse (api/integer 2)) + ;; (api/defexp 'ui-mod (api/fn-call (api/symbol 'modules/ui) [(api/integer 2)])) + ;; (api/defexp 'm-ui (api/fn-call (api/symbol 'ui-mod) [])) + + ;; (defncall 'm-ui-kb '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sources) + ;; (api/key-fn :keyboard)) + ;; (defncall 'oasis-ui-mod-kb 'm-ui-kb) + ;; (defncall 'm-ui-mouse '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sources) + ;; (api/key-fn :mouse)) + ;; (defncall 'oasis-ui-mod-mouse 'm-ui-mouse) + ;; (defncall 'm-ui-render '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :render)) + ;; (defncall 'oasis-ui-out 'm-ui-render) + + (defncall 'oasis-ui-render 'pipes/ui (api/integer 2)) + (defncall 'oasis-ui-events 'pipes/events (api/integer 2)) + (defncall 'oasis-ev 'pipes/debug) + (defncall 'oasis-ui-mouse 'pipes/mouse) (defncall 'oasis-ui-kb 'pipes/keyboard) - (defncall 'oasis-ui-events 'pipes/debug) + (defncall 'oasis-ui-in 'pipes/debug) (defncall 'render 'pipes/debug ;; (api/keyword :oasis.spec/render) ) (defncall 'reducer 'pipes/debug ;; (api/keyword :oasis.spec/gui) @@ -3427,82 +3536,105 @@ (api/fn-call (api/symbol 'into) [(api/key-fn :state) (api/key-fn :next)]) (api/map {})) (defncall 'render-elements '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "vals1")]) + ;; (api/fn-call (api/symbol 'spy) [(api/string "vals")]) (api/fn-call (api/symbol 'vals) [(api/symbol '_)]) ;; (api/fn-call (api/symbol 'sort-by [(api/symbol '_)])) (api/fn-call (api/symbol 'map) [(api/key-fn :oasis.gui/element) (api/symbol '_)]) (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :div) (api/map {(api/keyword :class) (api/string "fullscreen")})]) (api/symbol '_)])) + (defncall 'log-render2 'pipes/log (api/string "render2: ")) - (api/defmodule 'oasis-ui (api/map {(api/keyword :sources) (api/map {(api/keyword :render) (api/symbol 'oasis-ui-in) + (api/defmodule 'oasis-ui (api/map {;; (api/keyword :depends) (api/map {(api/keyword :ui) (api/symbol 'modules/ui)}) + (api/keyword :sources) (api/map {(api/keyword :render) (api/symbol 'oasis-ui-in) + ;; (api/keyword :m-ui) (api/symbol 'm-ui) + ;; (api/keyword :ui-mod) (api/symbol 'ui-mod) + ;; (api/keyword :m-ui-kb) (api/symbol 'm-ui-kb) (api/keyword :kb) (api/symbol 'oasis-ui-kb) (api/keyword :mouse) (api/symbol 'oasis-ui-mouse) - (api/keyword :events) (api/symbol 'oasis-ui-out)}) + ;; (api/keyword :m-ui-mouse) (api/symbol 'm-ui-mouse) + ;; (api/keyword :m-ui-render) (api/symbol 'm-ui-render) + ;; (api/keyword :oasis-ui-out) (api/symbol 'oasis-ui-out) + (api/keyword :events) (api/symbol 'oasis-ui-events) + }) (api/keyword :sinks) (api/map {(api/keyword :mouse) (api/symbol 'oasis-ui-mouse) (api/keyword :kb) (api/symbol 'oasis-ui-kb) - (api/keyword :events) (api/symbol 'oasis-ui-events)}) - (api/keyword :tests) (api/map {(api/keyword :t1) (api/map {(api/keyword :when) (api/map {(api/string "oasis-ui-in") (api/vector [(api/map {(api/keyword :header) - (api/map {(api/keyword :oasis.gui/order) - (api/integer 1) - (api/keyword :oasis.gui/element) - (api/vector [(api/keyword :h1) - (api/string "사막 Oasis")])})})])}) - (api/keyword :then) (api/map {(api/string "oasis-ui-out") - (api/vector [(api/fn-call (api/symbol 'incase) [(api/fn-call (api/symbol '=) [(api/keyword :div) - (api/fn-call (api/symbol 'first) [(api/symbol '_)])]) - (api/keyword :success)])])})})})})) + (api/keyword :events) (api/symbol 'oasis-ev) + }) + ;; (api/keyword :tests) (api/map {(api/keyword :t1) (api/map {(api/keyword :when) (api/map {(api/string "oasis-ui-in") (api/vector [(api/map {(api/keyword :header) + ;; (api/map {(api/keyword :oasis.gui/order) + ;; (api/integer 1) + ;; (api/keyword :oasis.gui/element) + ;; (api/vector [(api/keyword :h1) + ;; (api/string "사막 Oasis")])})})])}) + ;; (api/keyword :then) (api/map {(api/string "oasis-ui-out") + ;; (api/vector [(api/fn-call (api/symbol 'incase) [(api/fn-call (api/symbol '=) [(api/keyword :div) + ;; (api/fn-call (api/symbol 'first) [(api/symbol '_)])]) + ;; (api/keyword :success)])])})})}) + })) ]) (def oasis-ui-net [(pipe 'oasis-ui-in 'render) + ;; (pipe 'oasis-ui-in 'log-render2) (pipe 'render 'elements-reduce) (pipe 'elements-reduce 'reducer) - (pipe 'reducer 'render-elements 'oasis-ui-out) - (pipe 'oasis-ui-out 'oasis-ui-events) - ;; (pipe 'reducer 'render-elements 'log-render) + (pipe 'reducer 'render-elements 'oasis-ui-render) + (pipe 'oasis-ui-events 'oasis-ev) + (pipe 'oasis-ui-events 'log-render2) + ;; (pipe 'reducer 'render-elements 'log-render2) ]) (def oasis-module-defs [ - ;; (defncall 'm-ui '-> - ;; (api/symbol 'oasis-ui)) - ;; (defncall 'm-render-fn '-> - ;; (api/symbol 'm-ui) - ;; (api/key-fn :sources) - ;; (api/key-fn :render)) - ;; (defncall 'ui-render 'm-render-fn) - ;; (defncall 'm-mouse-fn '-> - ;; (api/symbol 'm-ui) - ;; (api/key-fn :sinks) - ;; (api/key-fn :mouse)) - ;; (defncall 'oasis-bug 'm-mouse-fn) - ;; (defncall 'm-kb-fn '-> - ;; (api/symbol 'm-ui) - ;; (api/key-fn :sinks) - ;; (api/key-fn :kb)) - ;; (defncall 'oasis-keyboard 'm-kb-fn) - ;; (defncall 'm-events-fn '-> - ;; (api/symbol 'm-ui) - ;; (api/key-fn :sinks) - ;; (api/key-fn :events)) - ;; (defncall 'oasis-events 'm-events-fn) + (defncall 'm-ui-mod 'oasis-ui) + (defncall 'm-oasis-ui 'm-ui-mod) + (defncall 'm-render-fn '-> + (api/symbol 'm-oasis-ui) + (api/key-fn :sources) + (api/key-fn :render)) + (defncall 'ui-render 'm-render-fn) + (defncall 'm-mouse-fn '-> + (api/symbol 'm-oasis-ui) + (api/key-fn :sinks) + (api/key-fn :mouse)) + (defncall 'oasis-bug 'm-mouse-fn) + (defncall 'm-kb-fn '-> + (api/symbol 'm-oasis-ui) + (api/key-fn :sinks) + (api/key-fn :kb)) + (defncall 'oasis-keyboard 'm-kb-fn) + (defncall 'm-events-fn '-> + (api/symbol 'm-oasis-ui) + (api/key-fn :sinks) + (api/key-fn :events)) + (defncall 'oasis-events 'm-events-fn) - ;; (defncall 'm-render '-> - ;; (api/symbol 'oasis-render)) - ;; (defncall 'm-state-fn '-> - ;; (api/symbol 'm-render) - ;; (api/key-fn :sources) - ;; (api/key-fn :state)) - ;; (defncall 'render-state 'm-state-fn) - ;; (defncall 'm-elems-fn '-> - ;; (api/symbol 'm-render) - ;; (api/key-fn :sinks) - ;; (api/key-fn :svg-elems)) - ;; (defncall 'render-elems 'm-elems-fn) + (defncall 'm-render-mod 'oasis-render) + (defncall 'm-render 'm-render-mod) + (defncall 'm-state-fn '-> + (api/symbol 'm-render) + (api/key-fn :sources) + (api/key-fn :state)) + (defncall 'render-state 'm-state-fn) + (defncall 'm-r-mouse-fn '-> + (api/symbol 'm-render) + (api/key-fn :sources) + (api/key-fn :mouse)) + (defncall 'render-mouse-in 'm-r-mouse-fn) + (defncall 'm-elems-fn '-> + (api/symbol 'm-render) + (api/key-fn :sinks) + (api/key-fn :svg-elems)) + (defncall 'render-elems 'm-elems-fn) + (defncall 'm-ro-mouse-fn '-> + (api/symbol 'm-render) + (api/key-fn :sinks) + (api/key-fn :mouse)) + (defncall 'render-mouse-out 'm-ro-mouse-fn) - (defncall 'm-core '-> - (api/symbol 'oasis-core)) + (defncall 'm-core-mod 'oasis-core) + (defncall 'm-core 'm-core-mod) (defncall 'm-state-out-fn '-> (api/symbol 'm-core) (api/key-fn :sinks) @@ -3541,50 +3673,59 @@ (api/vector [(api/keyword :h1) (api/string "사막 Oasis")])})})) - (defncall 'oasis-init 'pipes/debug) (api/defmodule 'oasis (api/map {(api/keyword :depends) (api/map {(api/keyword :oasis-core) (api/symbol 'oasis-core) (api/keyword :oasis-render) (api/symbol 'oasis-render) (api/keyword :oasis-ui) (api/symbol 'oasis-ui) }) - (api/keyword :sources) (api/map {(api/keyword :module-core) (api/symbol 'm-core) - (api/keyword :module-core-out) (api/symbol 'core-state) - ;; (api/keyword :module-render) (api/symbol 'm-render) - ;; (api/keyword :module-render-out) (api/symbol 'render-elems) - ;; (api/keyword :module-ui) (api/symbol 'm-ui) - ;; (api/keyword :kb) (api/symbol 'oasis-keyboard) - ;; (api/keyword :mouse) (api/symbol 'oasis-bug) - ;; (api/keyword :events) (api/symbol 'oasis-events) + (api/keyword :sources) (api/map {(api/keyword :module-core-out) (api/symbol 'core-state) + ;(api/keyword :module-core-kb-in) (api/symbol 'core-kb-in) + (api/keyword :module-core-mouse-in) (api/symbol 'core-mouse-in) + (api/keyword :module-render-state) (api/symbol 'render-state) + (api/keyword :module-render-mouse-in) (api/symbol 'render-mouse-in) + (api/keyword :module-render-mouse-out) (api/symbol 'render-mouse-out) + (api/keyword :module-render-out) (api/symbol 'render-elems) + (api/keyword :kb) (api/symbol 'oasis-keyboard) + (api/keyword :mouse) (api/symbol 'oasis-bug) + (api/keyword :events) (api/symbol 'oasis-events) + (api/keyword :main-inst-fn) (api/symbol 'core-init) (api/keyword :main) (api/symbol 'oasis-init) + (api/keyword :ui-r) (api/symbol 'ui-render) + ;(api/keyword :ui-m-r) (api/symbol 'm-render-fn) })})) - (api/defexp 'oasis-legacy (api/map {(api/keyword :sources) (api/map {(api/keyword :main) (api/symbol 'oasis-init) - - (api/keyword :mouse) (api/symbol 'oasis-mouse) - (api/keyword :kb) (api/symbol 'oasis-kb) - (api/keyword :eval) (api/symbol 'oasis-eval) - (api/keyword :layout) (api/symbol 'oasis-layout) - }) - ;; (api/keyword :sink) (api/vector [(api/symbol 'oasisp)]) - (api/keyword :tests) (api/map {(api/keyword ::test) - (api/map {(api/keyword :when) (api/map {(api/string "init") - (api/vector [(api/integer 1)])}) - (api/keyword :then) (api/map {(api/string "oasis-ui-out") - (api/vector [(api/keyword :success)])})})})})) + ;; (api/defexp 'oasis-legacy (api/map {(api/keyword :sources) (api/map {(api/keyword :main) (api/symbol 'oasis-init) + + ;; (api/keyword :mouse) (api/symbol 'oasis-mouse) + ;; (api/keyword :kb) (api/symbol 'oasis-kb) + ;; (api/keyword :eval) (api/symbol 'oasis-eval) + ;; (api/keyword :layout) (api/symbol 'oasis-layout) + ;; }) + ;; ;; (api/keyword :sink) (api/vector [(api/symbol 'oasisp)]) + ;; (api/keyword :tests) (api/map {(api/keyword ::test) + ;; (api/map {(api/keyword :when) (api/map {(api/string "init") + ;; (api/vector [(api/integer 1)])}) + ;; (api/keyword :then) (api/map {(api/string "oasis-ui-out") + ;; (api/vector [(api/keyword :success)])})})})})) ]) (def oasis-module-net [ - ;; (pipe 'oasis-init 'header 'ui-render) + (pipe 'oasis-init 'header 'ui-render) + ;; (pipe 'oasis-init 'header 'log-render) (pipe 'oasis-init 'core-init) ;; (pipe 'core-state 'log-state) - ;; (pipe 'core-state 'render-state) + (pipe 'core-state 'render-state) ;; (pipe 'render-elems 'log-render) - ;; (pipe 'render-elems 'ui-render) + (pipe 'render-elems 'ui-render) - ;; (pipe 'oasis-keyboard 'core-kb-in) + (pipe 'oasis-keyboard 'core-kb-in) ;; (pipe 'oasis-bug 'core-mouse-in) - ;; (pipe 'oasis-events 'core-events-in) + (pipe 'oasis-bug 'render-mouse-in) + (pipe 'render-mouse-out 'core-mouse-in) + ;; (pipe 'render-mouse-out 'log-foo) + (pipe 'oasis-events 'core-events-in) + (pipe 'oasis-events 'log-state) ]) diff --git a/ui_src/samak/ui_stdlib.cljs b/ui_src/samak/ui_stdlib.cljs index d5a70d8..7058f4c 100644 --- a/ui_src/samak/ui_stdlib.cljs +++ b/ui_src/samak/ui_stdlib.cljs @@ -82,37 +82,58 @@ (map #(transform-element % ch) children))) x)) -(defn ui [n events] - (let [ui-in (chan (a/sliding-buffer 1)) - ui-out (chan (a/sliding-buffer 1000)) - init (atom true)] - (go-loop [] - (when-some [i (clj e :keywordize-keys true)] + (fn [e] (do (println "rez: " n) + (put-meta! c (let [event (js->clj e :keywordize-keys true)] {:data :resize :width (.-clientWidth (.-documentElement js/document)) :height (.-clientHeight (.-documentElement js/document)) :samak.view/target (.-id (.-target event))} ) ::view) - false))) - (pipes/pipe ui-in ui-out))) + (println "EVS: " n) + false))) + (pipes/source c))) + +(defn ui + ([n] + (ui n true)) + ([n events] + (let [ui-in (chan (a/sliding-buffer 1)) + ui-out (chan (a/sliding-buffer 1000)) + init (atom true)] + (go-loop [] + (when-some [i (clj e :keywordize-keys true)] + {:data :resize + :width (.-clientWidth (.-documentElement js/document)) + :height (.-clientHeight (.-documentElement js/document)) + :samak.view/target (.-id (.-target event))} + ) + ::view) + false))) + (pipes/pipe ui-in ui-out)))) (defn translate-coords "" @@ -196,11 +217,16 @@ (defn ui-module [id] - (let [render (ui id true)] - {:sources {:events render - :mouse (mouse id) - :keyboard (keyboard)} - :sinks {:render render}})) + (println "init ui") + (fn [] + (let [xid 2 + render (ui id true) + m (mouse id)] + (println "start ui:" m) + {:sources {:events render + :mouse m + :keyboard (keyboard)} + :sinks {:render render}}))) ;; Exported symbols @@ -208,5 +234,6 @@ (def ui-symbols {'modules/ui ui-module 'pipes/ui ui + 'pipes/events events 'pipes/mouse mouse 'pipes/keyboard keyboard}) diff --git a/ui_src/samak/worker.cljc b/ui_src/samak/worker.cljc index ef9c8ac..5c5f745 100644 --- a/ui_src/samak/worker.cljc +++ b/ui_src/samak/worker.cljc @@ -6,53 +6,46 @@ [clojure.edn :as edn] [clojure.core.async :as a :refer [! chan go go-loop close! put! pipe]] [samak.api :as api] + [samak.helpers :as helpers] [samak.runtime :as run] [samak.stdlib :as std] [samak.builtins :as builtins] [samak.caravan :as caravan] - [samak.test-programs :as test-programs] [samak.trace :as trace] [samak.oasis :as oasis] - [samak.lisparser :as p] [samak.pipes :as pipes] - [samak.runtime.servers :as servers] - [samak.runtime.stores :as stores])] + [samak.scheduler :as sched])] :cljs [(:require [clojure.string :as str] [cljs.reader :as edn] [clojure.core.async :as a :refer [! chan close! put! pipe]] [samak.api :as api] + [samak.helpers :as helpers] [samak.runtime :as run] [samak.stdlib :as std] [samak.builtins :as builtins] [samak.layout :as layout] [samak.caravan :as caravan] - [samak.test-programs :as test-programs] [samak.trace :as trace] [samak.oasis :as oasis] - [samak.lisparser :as p] [samak.pipes :as pipes] - [samak.runtime.servers :as servers] - [samak.runtime.stores :as stores]) + [samak.scheduler :as sched]) (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) -(defn make-piped - "" - [name] - {:target :pipe :named (keyword name)}) - (def ui-mock-symbols - {'pipes/ui (make-piped 'pipes/ui) - 'pipes/mouse (make-piped 'pipes/mouse) - 'pipes/keyboard (make-piped 'pipes/keyboard)}) + {'modules/ui :blank + 'pipes/ui :blank + 'pipes/events :blank + 'pipes/mouse :blank + 'pipes/keyboard :blank}) (def worker-symbols (merge builtins/samak-symbols + std/pipe-symbols caravan/symbols - #?(:cljs layout/layout-symbols) ui-mock-symbols - std/pipe-symbols)) + #?(:cljs layout/layout-symbols))) (defn handle-update @@ -75,61 +68,6 @@ (def rt (atom {})) -(defn fire-event-into-named-pipe - [pipe-name event] - (let [pipe (run/get-definition-by-name @rt (symbol pipe-name))] - (if (pipes/pipe? pipe) - (do (let [arg (edn/read-string event)] - (pipes/fire! pipe arg pipe-name)) - {}) - (println (str "could not find pipe " pipe-name))))) - -(defn eval-test - "" - [] - (let [code (str/join " " test-programs/tw) - parsed (p/parse-all code)] - (swap! rt #(reduce run/eval-expression! % (:value parsed))) - (fire-event-into-named-pipe "in" "5"))) - -(defn eval-oasis - "" - [length cb state [nr exp]] - (let [progress (int (* (/ nr length) 100))] - (when (= 0 (mod progress 10)) - (put! cb progress) - (println (str progress "%"))) - (run/eval-expression! state exp))) - -(defn run-oasis - "" - [state cb] - (put! cb 100) - (reset! rt state) - (caravan/init @rt) - (fire-event-into-named-pipe "init" "1") - (println "oasis started") - (let [parsed [(api/defexp 'start (api/fn-call (api/symbol 'pipes/debug) []))]] - (doseq [expression parsed] - (caravan/repl-eval expression))) - (servers/get-defined (:server @rt))) - - -(defn start-oasis - [cb] - (let [c (chan) - exps (oasis/start) - numbered (map-indexed vector exps) - cnt (count numbered)] - (go-loop [state @rt] - (let [part (" mod "/" pipe)))) + +(def get-named-pipe-memo (memoize get-named-pipe)) + +(defn handle-input + "" + [rt c] + (go-loop [] + (let [p ( Date: Sun, 13 Sep 2020 07:07:51 +0200 Subject: [PATCH 04/12] display modules in oasis --- src/samak/nodes.cljc | 3 +- src/samak/runtime.cljc | 28 +-- src/samak/scheduler.cljc | 9 +- src/samak/test_programs.cljc | 38 +++- test/samak/caravan_test.cljc | 11 ++ ui_src/samak/caravan.cljc | 76 +++++--- ui_src/samak/oasis.cljc | 362 ++++++++++++++++++++++++++--------- ui_src/samak/ui_stdlib.cljs | 4 +- 8 files changed, 394 insertions(+), 137 deletions(-) diff --git a/src/samak/nodes.cljc b/src/samak/nodes.cljc index 325f9ec..fc81548 100644 --- a/src/samak/nodes.cljc +++ b/src/samak/nodes.cljc @@ -92,7 +92,8 @@ (or ((:resolve *manager*) (:db/id fn)) (when (api/is-def? fn) (let [res (eval-node fn)] - (println "evaling" (:db/id fn) "->" res "def" fn) res)) + ;; (println "evaling" (:db/id fn) "->" res "def" fn) + res)) ;; (when (api/is-module? fn) ;; (let [res (eval-node fn)] ;; (println "evaling" (:db/id fn) "->" res "mod" fn) res)) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index f7c18d7..667ba8f 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -126,7 +126,7 @@ (defn link-fn "" [from to xf] - (println "linking" from to) + ;; (println "linking" from to) (let [a (replace-piped from) c (replace-piped to)] (when (not (pipes/pipe? a)) @@ -151,9 +151,9 @@ ;; needs to prep resolve magic when instanciating pipes, to select same runtime ;; maybe simply do so explicitly ;; (if (:config man)) - (println (str "about to eval module: " module)) + ;; (println (str "about to eval module: " module)) (let [evaled (n/eval-env man nil definition (:db/id module))] - (println (str "used module: " module "->" evaled)) + ;; (println (str "used module: " module "->" evaled)) evaled))))) (defn make-runtime-internal @@ -258,7 +258,7 @@ sources)) -(defn load-roots-from-bundle +(defn load-def-from-bundle "" [rt id defns] (let [defs (if (= (:samak.nodes/type defns) :samak.nodes/def) @@ -268,28 +268,32 @@ kvs (:samak.nodes/mapkv-pairs defs) ;; _ (println "kvs" kvs) sources (get-ids-from-source-def kvs #{:sources}) - deps (get-ids-from-source-def kvs #{:depends}) source-ids (apply sorted-set (map get-id-from-source-val sources)) _ (println "source-ids:" source-ids) + sinks (get-ids-from-source-def kvs #{:sinks}) + sink-ids (apply sorted-set (map get-id-from-source-val sinks)) + _ (println "sink-ids:" sink-ids) + deps (get-ids-from-source-def kvs #{:depends}) dep-ids (mapv get-id-from-source-val deps) _ (println "dep-ids" dep-ids) deps-source-ids (mapv (fn [dep] (println "dep" dep) - (load-roots-from-bundle rt dep (load-by-id rt dep))) + (load-def-from-bundle rt dep (load-by-id rt dep))) dep-ids) _ (println "dep-s-id" deps-source-ids) - roots {id {:depends dep-ids - :dependencies deps-source-ids - :roots source-ids}}] - (println "roots: " roots) - roots)) + def {id {:depends dep-ids + :dependencies deps-source-ids + :sinks sink-ids + :roots source-ids}}] + (println "def: " def) + def)) (defn load-bundle "loads the definition of a bundle by the given id" [rt id] (let [defns (load-by-id rt id)] - (load-roots-from-bundle rt id defns))) + (load-def-from-bundle rt id defns))) (defn eval-expression! [{:keys [store server] :as rt} form] diff --git a/src/samak/scheduler.cljc b/src/samak/scheduler.cljc index 1b4b391..11b0270 100644 --- a/src/samak/scheduler.cljc +++ b/src/samak/scheduler.cljc @@ -37,7 +37,6 @@ (let [sources (map #(run/load-network rt %) (:roots mod)) net (reduce (fn [a, v] (let [val (vals v)] - {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) })) @@ -54,6 +53,8 @@ (let [deps (:dependencies mod)] {:id id :deps (mapv (fn [m] (load-deps rt (first m))) deps) + :sinks (:sinks mod) + :sources (:roots mod) :roots (load-module rt mod)}) ) @@ -76,15 +77,15 @@ (if (contains? conf (:id module)) (println "skipping" (:id module)) (do - (println "eval" (:id module) "->" module) + ;; (println "eval" (:id module) "->" module) (doall (map #(eval-module rt conf % (:id %)) (:deps module))) (println "loading" (:id module)) (let [roots (:roots module) base (if root [root] []) root-ids (into (into base (:nodes roots)) (:pipes roots)) - _ (println "[" (:id module) "] roots" root-ids) + ;; _ (println "[" (:id module) "] roots" root-ids) asts (doall (map #(run/load-ast @rt %) root-ids))] - (println "evaling" (:id module)) + ;; (println "evaling" (:id module)) (reset! rt (update @rt :server run/eval-all asts)) (println "done" (:id module)))))) diff --git a/src/samak/test_programs.cljc b/src/samak/test_programs.cljc index 3c38b5b..491f343 100644 --- a/src/samak/test_programs.cljc +++ b/src/samak/test_programs.cljc @@ -126,6 +126,42 @@ ]) +(def test-nested-modules-test + ["(def in (pipes/debug))" + "(def out (pipes/debug))" + "(def mod ((modules/caravan) 42))" + "(def a ((-> mod :-sinks :-actions) 42))" + "(def b ((-> mod :-sources :-commands) 42))" + "(| in a)" + "(| b out)" + "(defmodule bar {:depends {:caravan modules/caravan} + :sources {:in in :b b} + :sinks {:out out} + :tests {:t1 {:when {\"in\" [1]} + :then {\"out\" [(incase 2 :success)]}}}})" + "(def s (pipes/debug))" + "(def t (pipes/debug))" + "(| s t)" + "(defmodule quux {:sources {:s s} + :sinks {:t t} + :tests {:t1 {:when {\"s\" [1]} + :then {\"t\" [(incase 1 :success)]}}}})" + "(def barmod (bar))" + "(def quuxmod (quux))" + "(def x (pipes/debug))" + "(def quuxin ((-> barmod :-sources :-in) 42))" + "(def quuxout ((-> barmod :-sources :-in) 42))" + "(def barin ((-> barmod :-sources :-in) 42))" + "(def barout ((-> barmod :-sinks :-out) 42))" + "(| x quuxin)" + "(defmodule baz {:depends {:bar bar :quux quux} + :sources {:x x :barmod barmod} + :tests {:t1 {:when {\"in\" [1]} + :then {\"out\" [(incase 2 :success)]}}}})" + ;; "!f in \"!!!\"" + ]) + + (def chuck ["(def in (pipes/debug)) (def ui-in (pipes/ui)) @@ -163,7 +199,7 @@ (| in joke-list) (| joke-list render-ui ui-out) - (def chuck {:sources {:main in + (defmodule chuck {:sources {:main in :ui-in ui-in :http-in http-in} :tests { diff --git a/test/samak/caravan_test.cljc b/test/samak/caravan_test.cljc index e84bc56..128be22 100644 --- a/test/samak/caravan_test.cljc +++ b/test/samak/caravan_test.cljc @@ -226,3 +226,14 @@ (println (str "\ntraces: ")) (sut/trace-dump) (is (= :success val))))))) + +(deftest should-eval-lib + (let [syms core/samak-symbols + c (chan 1) + rt (rt/make-runtime syms)] + ;; (trace/init-tracer rt {:backend :logging}) + (sut/init rt) + (sut/persist-net test-programs/test-nested-modules-test) + (let [res (sut/eval-bundle 'baz)] + (is (= :foo res))) + )) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 7fa56c3..55a2a03 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -216,9 +216,10 @@ ast (make-cell-list fn)] (if (empty? ast) (println (str "ERROR: no ast for: " sym " - " fn)) - {(str sym) {:caravan/type type - :caravan/name (str sym) - :caravan/ast ast}}))) + {sym {:caravan/type type + :caravan/id sym + :caravan/name (:samak.nodes/name fn) + :caravan/ast ast}}))) (defn add-node "" [sym fn] @@ -252,12 +253,18 @@ xf (:samak.nodes/xf pipe) func (if xf (name-of-node xf) nil) sink (name-of-node (:samak.nodes/to pipe)) - pipe-name (str source "-" func "-" sink)] - {pipe-name {:caravan/type :caravan/pipe - :caravan/name pipe-name - :caravan/source source - :caravan/func func - :caravan/sink sink}})) + pipe-name (str source "-" func "-" sink) + id (:db/id pipe)] + {id {:caravan/type :caravan/pipe + :caravan/id id + :caravan/name pipe-name + :caravan/source (:db/id (:samak.nodes/fn (:samak.nodes/from pipe))) + :caravan/source-name source + :caravan/func (:db/id (:samak.nodes/fn xf)) ;;This might be wrong? + :caravan/func-name func + :caravan/sink (:db/id (:samak.nodes/fn (:samak.nodes/to pipe))) + :caravan/sink-name sink + }})) (defn add-pipe @@ -665,9 +672,9 @@ (let [nodes (:nodes source) _ (println " V" "Loading asts: " (s/join ", " nodes)) asts (map #(load-ast @rt-conn %1) nodes) - _ (println " V" "Adding nodes: " (s/join ", " (map :samak.nodes/name asts))) + _ (println " V" "Adding nodes: " (s/join ", " (map #(str (:samak.nodes/name %) "(" (:db/id %) ")") asts))) adder (if eval? add-node format-node) - node-notify (doall (map #(adder (symbol (name-of-node %)) %) asts)) + node-notify (doall (map #(adder (:db/id %) %) asts)) pipes (:pipes source) _ (println " V" "Adding pipes: " (s/join ", " pipes)) pipe-asts (doall (map #(load-ast @rt-conn %1) pipes))] @@ -681,14 +688,9 @@ root (:roots module)] {id {:caravan/type :caravan/module :caravan/name (str id) - :caravan/nodes (:nodes root) - :caravan/pipes (:pipes root)}})) - - -(defn handle-deps - "" - [deps] - (map handle-mod deps)) + :caravan/ports (into [] (concat (:sources module) (:sinks module))) + :caravan/nodes (into [] (:nodes root)) + :caravan/pipes (into [] (:pipes root))}})) (defn runtime-net @@ -698,6 +700,7 @@ (let [[_ pipe-asts] (handle-source net true)] (doall (map #(add-pipe-net verify (:then config) %) pipe-asts)))) + (defn database-net "" [net] @@ -706,13 +709,34 @@ {:nodes node-notify :pipes pipe-notify})) +(defn handle-deps + "" + [deps] + (reduce (fn [acc x] + (let [roots (database-net (:roots x))] + {:nodes (into [] (concat (:nodes acc) (:nodes roots))) + :pipes (into [] (concat (:pipes acc) (:pipes roots))) + :modules (conj (:modules acc) (handle-mod x))})) + {:nodes [] + :pipes [] + :modules []} + deps)) + (defn eval-bundle "" [sym] (let [bundle (sched/load-bundle @rt-conn sym) + _ (println "ev b" bundle) roots (:roots bundle) - deps (handle-deps (:deps bundle))] - (assoc (database-net roots) :modules deps) + deps (handle-deps (:deps bundle)) + _ (println "deps" deps) + rootnotify (assoc (database-net roots) :modules [(handle-mod bundle)]) + ;; rootnotify (database-net roots) + _ (println "root" rootnotify) + a1 (merge-with into rootnotify deps) + ] + _ (println "ev n" a1) + (assoc a1 :id (:id bundle)) )) (defn test-bundle @@ -803,7 +827,7 @@ (defn load-lib "" [cmd ev sym] - (let [bundle (doall (eval-bundle sym)) + (let [bundle (eval-bundle sym) merged (merge-with concat bundle) _ (println (str "bundle: " merged)) ;; dist (into {} (for [[k v] merged] [k (distinct v)])) @@ -818,7 +842,7 @@ (notify-source ev {::state ::done} - #(a/put! cmd (pipes/make-paket {::event ::load ::status ::done ::percent 100} ::caravan))))) + #(a/put! cmd (pipes/make-paket {::event ::load ::status ::done ::percent 100 ::id (:id bundle)} ::caravan))))) (defn load-net "" @@ -838,6 +862,12 @@ (load-net cmd ev test-programs/chuck 'chuck) ) +(defn load-test + "" + [cmd ev] + (load-net cmd ev test-programs/test-nested-modules-test 'baz) + ) + (defn test-chuck "" [c] diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index cc81a01..06e125b 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -618,6 +618,10 @@ (api/keyword :fall) (api/symbol 'construct-action)) + (defncall 'construct-scope '-> + (api/map {(api/keyword :command) (api/keyword :scope) + (api/keyword :data) (api/symbol '_)})) + (defncall 'filter-edit '-> (api/fn-call (api/symbol 'incase) [(api/symbol 'is-phase-up) (api/fn-call (api/symbol '->) [(api/map {(api/keyword :key) (api/keyword :ignore)})])]) @@ -921,7 +925,8 @@ (defncall 'handle-caravan-command '-> (api/fn-call (api/symbol 'spy) [(api/string "car cmd")]) - (api/symbol 'construct-back)) + (api/key-fn :samak.caravan/id) + (api/symbol 'construct-scope)) (defncall 'is-scroll '-> (api/key-fn :mouse) @@ -1162,6 +1167,13 @@ (api/key-fn :data) (api/map {(api/keyword :activity) (api/symbol '_)})) + (defncall 'is-scope-change '-> + (api/key-fn :command) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :scope)])) + + (defncall 'handle-scope '-> + (api/key-fn :data) + (api/map {(api/keyword :scope) (api/symbol '_)})) (defncall 'handle-commands '-> (api/fn-call (api/symbol 'spy) [(api/string "comm")]) @@ -1183,6 +1195,8 @@ (api/symbol 'handle-trace)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-mode-change) (api/symbol 'handle-mode)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-scope-change) + (api/symbol 'handle-scope)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-activity-change) (api/symbol 'handle-activity)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-command) @@ -1251,7 +1265,7 @@ (defncall 'def-name 'str (api/string "d/") - (api/key-fn :caravan/name)) + (api/key-fn :caravan/id)) (defncall 'detect-pipe-node '-> (api/key-fn :caravan/type) @@ -1318,6 +1332,17 @@ (api/keyword :formatted) (api/fn-call (api/symbol '->) [(api/map {(api/keyword :def) (api/symbol 'selected-source-change)}) (api/symbol 'format-def)])})})) + (defncall 'is-next-scope '-> + (api/key-fn :next) + (api/key-fn :scope)) + + (defncall 'process-scope '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/map {(api/keyword :mode) (api/keyword :back) + (api/keyword :scope) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :scope)])})}) + (api/fn-call (api/symbol 'spy) [(api/string "scope")]) + ) + (defncall 'is-next-mode '-> (api/key-fn :next) (api/key-fn :mode)) @@ -1413,6 +1438,8 @@ (api/symbol 'process-activity)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-next-cursor) (api/symbol 'process-cursor)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-next-scope) + (api/symbol 'process-scope)]) (api/fn-call (api/symbol 'incase) [(api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :selected)]) (api/symbol 'process-select)]) (api/fn-call (api/symbol 'incase) [(api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :eval)]) @@ -1592,17 +1619,110 @@ (api/fn-call (api/symbol 'filter) [(api/symbol 'is-pipe-eval) (api/symbol '_)])) + + (defncall 'format-child-fn '-> + (api/map {(api/keyword :def) (api/fn-call (api/symbol 'lookup) [(api/key-fn :evalorig) (api/fn-call (api/symbol 'str) [(api/key-fn :node)]) (api/map {(api/keyword :unknown) (api/fn-call (api/symbol 'str) [(api/key-fn :node)])})]) + (api/keyword :context) (api/map {(api/keyword :zoom) (api/integer 2)})}) + (api/symbol 'format-def) + ) + + (defncall 'merge-child-fn '-> + (api/map {(api/keyword :node) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :evalorig) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + + (defncall 'format-child-fns '-> + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/nodes)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/nodes) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :evalorig)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-child-fn) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'format-child-fn) (api/symbol '_)])) + + (defncall 'port-name 'str + (api/string "d/") + (api/key-fn :caravan/id)) + + (defncall 'format-port-def '-> + (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :def) (api/symbol 'port-name)]) + (api/keyword :name) (api/fn-call (api/symbol '->) [(api/key-fn :def) (api/key-fn :caravan/name)]) + (api/keyword :width) (api/integer 30) + (api/keyword :height) (api/integer 30)})) + + (defncall 'format-port '-> + (api/map {(api/keyword :def) (api/fn-call (api/symbol 'lookup) [(api/key-fn :evalorig) (api/fn-call (api/symbol 'str) [(api/key-fn :port)]) (api/map {(api/keyword :unknown) (api/fn-call (api/symbol 'str) [(api/key-fn :port)])})])}) + (api/symbol 'format-port-def) + ) + + (defncall 'merge-port '-> + (api/map {(api/keyword :port) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :evalorig) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + + (defncall 'format-ports '-> + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/ports)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/ports) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :evalorig)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-port) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'format-port) (api/symbol '_)])) + + (defncall 'extract-connection '-> + (api/fn-call (api/symbol 'if) [(api/key-fn :caravan/func) + (api/vector [(api/map {(api/keyword :from) (api/key-fn :caravan/source) + + (api/keyword :to) (api/key-fn :caravan/func)}) + (api/map {(api/keyword :from) (api/key-fn :caravan/func) + (api/keyword :to) (api/key-fn :caravan/sink)})]) + (api/vector [(api/map {(api/keyword :from) (api/key-fn :caravan/source) + + (api/keyword :to) (api/key-fn :caravan/sink)})])])) + + (defncall 'merge-child-pipe '-> + (api/map {(api/keyword :pipe) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :evalorig) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + + (defncall 'extract-child-pipe '-> + (api/fn-call (api/symbol 'lookup) [(api/key-fn :evalorig) (api/fn-call (api/symbol 'str) [(api/key-fn :pipe)]) (api/map {(api/keyword :unknown) (api/fn-call (api/symbol 'str) [(api/key-fn :pipe)])})]) + ;; (api/fn-call (api/symbol 'spy) [(api/string "fconn")]) + (api/symbol 'extract-connection)) + + (defncall 'format-child-pipes '-> + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/pipes)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :mod) + (api/key-fn :caravan/pipes) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :evalorig)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-child-pipe) (api/symbol '_)]) + (api/fn-call (api/symbol 'mapcat) [(api/symbol 'extract-child-pipe) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'format-pipe) (api/symbol '_)])) + (defncall 'format-mod '-> - (api/fn-call (api/symbol 'spy) [(api/string "fmod2")]) - (api/map {(api/keyword :id) (api/key-fn :caravan/name) - (api/keyword :name) (api/key-fn :caravan/name) + ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod2")]) + (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :mod) (api/key-fn :caravan/name)]) + (api/keyword :name) (api/fn-call (api/symbol '->) [(api/key-fn :mod) (api/key-fn :caravan/name)]) (api/keyword :type) (api/keyword :module) - ;; (api/keyword :width) (api/integer 300) - ;; (api/keyword :height) (api/integer 300) - })) + (api/keyword :ports) (api/symbol 'format-ports) + (api/keyword :children) (api/symbol 'format-child-fns) + (api/keyword :edges) (api/symbol 'format-child-pipes) + }) + ) + + + (defncall 'merge-mod '-> + (api/map {(api/keyword :mod) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :evalorig) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) (defncall 'format-modules '-> - (api/fn-call (api/symbol 'map) [(api/symbol 'format-mod) (api/key-fn :modules)])) + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :modules)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :modules) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :evalorig)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-mod) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'format-mod) (api/symbol '_)])) (defncall 'merge-defs '-> (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) @@ -1615,35 +1735,26 @@ (api/fn-call (api/symbol 'map) [(api/symbol 'merge-defs) (api/symbol '_)]) (api/fn-call (api/symbol 'map) [(api/symbol 'format-def) (api/symbol '_)])) - (defncall 'extract-connection '-> - (api/fn-call (api/symbol 'if) [(api/key-fn :caravan/func) - (api/vector [(api/map {(api/keyword :from) (api/key-fn :caravan/source) - - (api/keyword :to) (api/key-fn :caravan/func)}) - (api/map {(api/keyword :from) (api/key-fn :caravan/func) - (api/keyword :to) (api/key-fn :caravan/sink)})]) - (api/vector [(api/map {(api/keyword :from) (api/key-fn :caravan/source) - - (api/keyword :to) (api/key-fn :caravan/sink)})])])) - (defncall 'format-pipes '-> (api/fn-call (api/symbol 'mapcat) [(api/symbol 'extract-connection) (api/key-fn :pipes)]) (api/fn-call (api/symbol 'map) [(api/symbol 'format-pipe) (api/symbol '_)])) (defncall 'format-state '-> - (api/map {(api/keyword :eval) (api/fn-call (api/symbol '->) [(api/key-fn :eval) + (api/map {(api/keyword :evalorig) (api/key-fn :eval) + (api/keyword :eval) (api/fn-call (api/symbol '->) [(api/key-fn :eval) (api/fn-call (api/symbol 'vals) [(api/symbol '_)])]) (api/keyword :context) (api/symbol '_)}) - (api/map {(api/keyword :defs) (api/symbol 'filter-nodes) + (api/map {(api/keyword :evalorig) (api/key-fn :evalorig) + (api/keyword :defs) (api/symbol 'filter-nodes) (api/keyword :pipes) (api/symbol 'filter-connections) (api/keyword :modules) (api/symbol 'filter-modules) (api/keyword :context) (api/key-fn :context)}) - (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) + ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) (api/map {(api/keyword :id) (api/string "root") (api/keyword :layoutOptions) (api/map {(api/string "elk.algorithm") (api/string "layered")}) - (api/keyword :children) (api/symbol 'format-modules) - ;; (api/keyword :children) (api/symbol 'format-defs) - ;; (api/keyword :edges) (api/symbol 'format-pipes) + (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules) ;; (api/symbol 'format-defs) + ]) + (api/keyword :edges) (api/symbol 'format-pipes) })) @@ -2022,12 +2133,17 @@ (api/vector [(api/keyword :next) (api/keyword :mode)]) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :editor) (api/key-fn :mode)])]) + (api/fn-call (api/symbol 'assoc-in) [(api/symbol '_) + (api/vector [(api/keyword :next) + (api/keyword :scope)]) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :editor) (api/key-fn :scope)])]) (api/fn-call (api/symbol 'update-in) [(api/symbol '_) (api/vector [(api/keyword :next) (api/keyword :editor)]) (api/keyword :removed)]) (api/vector [(api/key-fn :state) (api/key-fn :next)]) (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)]) ]) (api/map {(api/keyword :mode) (api/keyword :unknown) + (api/keyword :scope) (api/keyword :none) (api/keyword :actions) (api/vector [])})) (defncall 'tag-mode '-> @@ -2175,7 +2291,7 @@ (pipe 'load-state 'filter-load 'loaded-state) (pipe 'loaded-state 'format-state 'oasis-layout) - ;; (pipe 'eval-state 'format-state 'log-layout) + ;; (pipe 'loaded-state 'format-state 'log-layout) (pipe 'eval-state 'edit-information 'editor-events) @@ -2240,6 +2356,7 @@ (api/keyword :pipe-glow) (api/string "#6684e1") (api/keyword :pipe-stroke) (api/string "#a6a28c") (api/keyword :pipe-drag) (api/string "#b65611") + (api/keyword :module-bg) (api/string "#6684e1") (api/keyword :edge-in) (api/string "#6684e1") (api/keyword :edge-out) (api/string "#b65611") (api/keyword :edge-neutral) (api/string "#a6a28c") @@ -2545,7 +2662,10 @@ (api/key-fn :mode)]) (api/string "/") (api/fn-call (api/symbol '->) [(api/key-fn :editor) - (api/key-fn :activity)])]) + (api/key-fn :activity)]) + (api/string " - scope: ") + (api/fn-call (api/symbol '->) [(api/key-fn :editor) + (api/key-fn :scope)])]) (api/fn-call (api/symbol 'str-join) [(api/string " ") (api/symbol '_)])) (defncall 'render-menu-action '-> @@ -3056,7 +3176,8 @@ (api/keyword :pointer-events) (api/string "all")})})]) (api/vector [(api/keyword :g)])]) (api/vector [(api/keyword :circle) - (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'pipe-id)]) + (api/map {(api/keyword :id) (api/key-fn :id) + (api/keyword :class) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'pipe-id)]) (api/keyword :cx) (api/integer 50) (api/keyword :cy) (api/integer 50) (api/keyword :r) (api/integer 50) @@ -3115,71 +3236,10 @@ (api/keyword :hovered) (api/symbol 'is-pipe-hovered)}) (api/symbol 'graph-pipe-single)) - (defncall 'graph-module '-> - (api/fn-call (api/symbol 'spy) [(api/string "gmod")]) - (api/vector [(api/keyword :g) - (api/vector [(api/keyword :rect) - (api/map {(api/keyword :id) (api/symbol 'func-id) - (api/keyword :fill-opacity) (api/float 0.7) - - (api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-gutter) (api/symbol 'get-color)]) - (api/keyword :stroke) (api/symbol 'get-func-stroke) - (api/keyword :filter) (api/string "url(#shadow)") - (api/keyword :pointer-events) (api/string "all")}) - (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) - (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) - (api/keyword :width) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :width)]) - (api/keyword :height) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :height)])})]) - (api/vector [(api/keyword :text) - (api/map {;; (api/keyword :transform) (api/string "rotate(90 50 50)") - (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) - (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) - (api/keyword :dy) (api/integer 14) - (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-name-stroke) (api/symbol 'get-color)]) - (api/keyword :text-anchor) (api/keyword :middle) - (api/keyword :font-weight) (api/string "bold") - (api/keyword :pointer-events) (api/string "none")}) - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])]) - (api/fn-call (api/symbol 'spy) [(api/string "gmod2")]) - ) - - (defncall 'is-module '-> - (api/key-fn :node) - (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/module)])) - - (defncall 'is-pipe-node '-> - (api/key-fn :node) - (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/sink)])) - - (defncall 'is-func-node '-> - (api/key-fn :node) - (api/key-fn :value)) - - (defncall 'graph-node '-> - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-module) - (api/symbol 'graph-module)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-pipe-node) - (api/symbol 'graph-pipe)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-func-node) - (api/symbol 'graph-func)])) - (defncall 'merge-node '-> (api/map {(api/keyword :node) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) - (defncall 'graph-nodes '-> - (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) - (api/key-fn :children)]) - (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) - (api/key-fn :children) - (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) - (api/key-fn :context)])]) - (api/fn-call (api/symbol 'map) [(api/symbol 'merge-node) (api/symbol '_)]) - (api/fn-call (api/symbol 'map) [(api/symbol 'graph-node) (api/symbol '_)]) - (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "nodes")})]) (api/symbol '_)])) - (defncall 'graph-coords 'str (api/key-fn :x) (api/string " ") @@ -3227,18 +3287,121 @@ (defncall 'prepare-edges '-> (api/fn-call (api/symbol 'map) [(api/symbol 'build-edge) - (api/fn-call (api/symbol '->) [(api/key-fn :layout) - (api/key-fn :edges)])])) + (api/key-fn :edges)])) (defncall 'graph-connections '-> - (api/fn-call (api/symbol 'myzip) [(api/symbol 'prepare-edges) + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) (api/symbol 'prepare-edges)]) (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) (api/key-fn :edges) (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) (api/key-fn :context)])]) (api/fn-call (api/symbol 'map) [(api/symbol 'merge-connection) (api/symbol '_)]) + (api/fn-call (api/symbol 'filter) [(api/fn-call (api/symbol '->) [(api/key-fn :edge) (api/key-fn :section)]) (api/symbol '_)]) (api/fn-call (api/symbol 'map) [(api/symbol 'graph-connection) (api/symbol '_)]) - (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g)]) (api/symbol '_)])) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "edges")})]) (api/symbol '_)])) + + (defncall 'graph-module-edges '-> + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'prepare-edges)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :node) + (api/key-fn :edges) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :context)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-connection) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'graph-connection) (api/symbol '_)]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "edges")})]) (api/symbol '_)])) + + (defncall 'graph-module-stub '-> + (api/vector [(api/keyword :g) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :id) (api/symbol 'func-id) + (api/keyword :fill-opacity) (api/float 0.4) + + (api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :module-bg) (api/symbol 'get-color)]) + (api/keyword :stroke) (api/symbol 'get-func-stroke) + (api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :rx) (api/integer 10) + ;; (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) + (api/keyword :width) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :width)]) + (api/keyword :height) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :height)])})]) + (api/vector [(api/keyword :text) + (api/map {;; (api/keyword :transform) (api/string "rotate(90 50 50)") + (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) + (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) + (api/keyword :dy) (api/integer 14) + (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-name-stroke) (api/symbol 'get-color)]) + (api/keyword :text-anchor) (api/keyword :middle) + (api/keyword :font-weight) (api/string "bold") + (api/keyword :pointer-events) (api/string "none")}) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])])) + + (defncall 'is-module '-> + (api/key-fn :node) + (api/key-fn :type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/module)])) + + (defncall 'is-pipe-node '-> + (api/key-fn :node) + (api/key-fn :type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")])) + + (defncall 'is-func-node '-> + (api/key-fn :node) + (api/key-fn :value)) + + (defncall 'graph-inner '-> + (api/map {(api/keyword :node) (api/symbol '_)}) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-module) + (api/symbol 'graph-module-stub)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-pipe-node) + (api/symbol 'graph-pipe)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-func-node) + (api/symbol 'graph-func)])) + + + (defncall 'graph-module-elems '-> + (api/key-fn :node) + (api/key-fn :children) + (api/fn-call (api/symbol 'map) [(api/symbol 'graph-inner) (api/symbol '_)]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "inner")})]) (api/symbol '_)]) + ) + + (defncall 'graph-port '-> + (api/vector [(api/keyword :g) + (api/map {(api/keyword :id) (api/key-fn :id) + (api/keyword :name) (api/key-fn :name) + (api/keyword :transform) (api/symbol 'translate-str)}) + (api/vector [(api/keyword :rect) + (api/map {(api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :module-bg) (api/symbol 'get-color)]) + (api/keyword :stroke) (api/symbol 'get-func-stroke) + (api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :pointer-events) (api/string "all")}) + (api/keyword :width) (api/key-fn :width) + (api/keyword :height) (api/key-fn :height)})])])) + + (defncall 'graph-module-ports '-> + (api/key-fn :node) + (api/key-fn :ports) + (api/fn-call (api/symbol 'map) [(api/symbol 'graph-port) (api/symbol '_)]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "ports")})]) (api/symbol '_)])) + + (defncall 'graph-module '-> + (api/vector [(api/keyword :g) + (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)]) + (api/keyword :transform) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'translate-str)])}) + (api/symbol 'graph-module-stub) + (api/symbol 'graph-module-ports) + (api/symbol 'graph-module-elems) + (api/symbol 'graph-module-edges) + ])) + + (defncall 'graph-node '-> + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-module) + (api/symbol 'graph-module)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-pipe-node) + (api/symbol 'graph-pipe)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-func-node) + (api/symbol 'graph-func)])) (defncall 'build-context '-> (api/map {(api/keyword :editor) (api/key-fn :editor) @@ -3265,6 +3428,17 @@ ;; (api/symbol 'get-color)]) (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "all")})})])) + (defncall 'graph-nodes '-> + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) + (api/key-fn :children)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :layout) + (api/key-fn :children) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :context)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-node) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'graph-node) (api/symbol '_)]) + (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "nodes")})]) (api/symbol '_)])) + (defncall 'graph '-> ;; (api/fn-call (api/symbol 'spy) [(api/string "graph")]) (api/map {(api/keyword :layout) (api/key-fn :layout) diff --git a/ui_src/samak/ui_stdlib.cljs b/ui_src/samak/ui_stdlib.cljs index 7058f4c..3159406 100644 --- a/ui_src/samak/ui_stdlib.cljs +++ b/ui_src/samak/ui_stdlib.cljs @@ -102,7 +102,7 @@ (defn ui ([n] - (ui n true)) + (ui n false)) ;;FIXME ([n events] (let [ui-in (chan (a/sliding-buffer 1)) ui-out (chan (a/sliding-buffer 1000)) @@ -111,7 +111,7 @@ (when-some [i ( Date: Sun, 13 Sep 2020 22:00:39 +0200 Subject: [PATCH 05/12] move scrolling to render module --- dev_src/dev/render.cljc | 3 +- ui_src/samak/oasis.cljc | 485 ++++++++++++++++++++++------------------ 2 files changed, 273 insertions(+), 215 deletions(-) diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index 0d9d766..c5004d4 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -58,7 +58,8 @@ :sources { :init (sched/make-pipe-id {:module :lone :type :sources :name :init}) :kb (sched/make-pipe-id {:module :lone :type :sources :name :kb}) - :mouse (sched/make-pipe-id {:module :lone :type :sources :name :mouse}) + :drag (sched/make-pipe-id {:module :lone :type :sources :name :drag}) + :hover (sched/make-pipe-id {:module :lone :type :sources :name :hover}) :events (sched/make-pipe-id {:module :lone :type :sources :name :events}) } }}) diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index 06e125b..3b4dc6b 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -301,82 +301,13 @@ (api/keyword :target) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/target)]) (api/keyword :source) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mouse) (api/key-fn :drag) (api/key-fn :source)])})})})) - (defncall 'mouse-reduce 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-move) - (api/symbol 'handle-mouse-move)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-down) - (api/symbol 'handle-mouse-down)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-up) - (api/symbol 'handle-mouse-up)]) - (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :state) - (api/key-fn :mouse)]) - (api/key-fn :next)]) - (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)]) - (api/map {(api/keyword :mouse) (api/symbol '_)})]) - (api/map {(api/keyword :mouse) (api/map {})})) - - (defncall 'mouse-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - (defncall 'target-reduce 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :prev) (api/fn-call (api/symbol '->) [(api/key-fn :state) - (api/key-fn :current)]) - (api/keyword :current) (api/fn-call (api/symbol '->) [(api/key-fn :next) - (api/key-fn :samak.mouse/target) - (api/symbol 'make-target)])})]) - (api/map {(api/keyword :current) (api/map {(api/keyword :type) (api/string "none") - (api/keyword :name) (api/string "none")}) - (api/keyword :prev) (api/map {(api/keyword :type) (api/string "none") - (api/keyword :name) (api/string "none")})})) - - (defncall 'only-different '-> - (api/fn-call (api/symbol 'except) [(api/fn-call (api/symbol '->) [(api/vector [(api/key-fn :prev) (api/key-fn :current)]) - (api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) - (api/fn-call (api/symbol 'count) [(api/symbol '_)]) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])])) (defncall 'tag-hover '-> (api/map {(api/keyword :hover) (api/symbol '_)})) - (defncall 'target-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - (defncall 'hover-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - (defncall 'hover-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - - (defncall 'is-drag '-> - (api/key-fn :mouse) - (api/key-fn :drag) - (api/key-fn :active) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :true)])) - - (defncall 'is-drag-end '-> - (api/key-fn :drag) - (api/key-fn :end) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :end)])) - - (defncall 'is-drag-start '-> - (api/key-fn :drag) - (api/key-fn :begin) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :true)])) - - (defncall 'is-drag-or-end 'or - (api/symbol 'is-drag) - (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-end)])) - - (defncall 'is-drag-end-or-start 'or - (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-start)]) - (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-end)])) - - (defncall 'filter-drag-end-or-start 'only (api/symbol 'is-drag-end-or-start)) - - (defncall 'filter-drag 'only (api/symbol 'is-drag-or-end)) (defncall 'drag-events 'pipes/debug) - (defncall 'drag-state 'pipes/debug) ;; (defncall 'drag-reduce 'pipes/reductions ;; (api/fn-call (api/symbol '->) @@ -797,12 +728,6 @@ (api/fn-call (api/symbol 'unless) [(api/key-fn :command) (api/symbol 'ignore)])) - (defncall 'make-zoom 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :zoom) (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :zoom)]) - (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :zoom)])])})]) - (api/map {(api/keyword :zoom) (api/integer 1)})) - (defncall 'make-view-move 'pipes/reductions (api/fn-call (api/symbol '->) [(api/key-fn :next) @@ -928,74 +853,6 @@ (api/key-fn :samak.caravan/id) (api/symbol 'construct-scope)) - (defncall 'is-scroll '-> - (api/key-fn :mouse) - (api/key-fn :drag) - (api/key-fn :button) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :secondary)])) - - (defncall 'filter-scroll 'only (api/fn-call (api/symbol 'and) [(api/symbol 'is-scroll) - (api/symbol 'is-drag-or-end)])) - - (defncall 'scroll-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - - (defncall 'construct-view '-> - (api/key-fn :mouse) - (api/map {(api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :delta) - (api/key-fn :x)]) - (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :delta) - (api/key-fn :y)])})) - - (defncall 'center-view 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :x) (api/integer 150) - (api/keyword :y) (api/integer 50)})]) - (api/map {})) - - (defncall 'view-reduce 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/fn-call (api/symbol 'into) [(api/key-fn :state) (api/key-fn :next)])]) - (api/map {(api/keyword :zoom) (api/integer 1) - (api/keyword :x) (api/integer 150) - (api/keyword :y) (api/integer 50)})) - - (defncall 'tag-view '-> - (api/map {(api/keyword :view) (api/symbol '_)})) - - - (defncall 'view-commands 'pipes/debug) - (defncall 'view-events 'pipes/debug) - (defncall 'zoom-events 'pipes/debug) - - (defncall 'view-delta 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :x) - (api/fn-call (api/symbol '+) [(api/fn-call (api/symbol '->) - [(api/key-fn :next) - (api/key-fn :x)]) - (api/fn-call (api/symbol '->) - [(api/key-fn :state) - (api/key-fn :x)])]) - (api/keyword :y) - (api/fn-call (api/symbol '+) [(api/fn-call (api/symbol '->) - [(api/key-fn :next) - (api/key-fn :y)]) - (api/fn-call (api/symbol '->) - [(api/key-fn :state) - (api/key-fn :y)])])} - )]) - (api/map {(api/keyword :x) (api/integer 150) - (api/keyword :y) (api/integer 50)})) - - - (defncall 'view-raw 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - (defncall 'view-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - (defncall 'view-deltas 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) - ) - ;; keep evaluations in state reduction (defncall 'is-node-func '-> @@ -1545,6 +1402,21 @@ (api/keyword :resize) (api/map {})})) + (defncall 'state-dedupe 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/map {(api/keyword :next) (api/key-fn :next) + (api/keyword :state) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :state)]) + (api/keyword :key) (api/fn-call (api/symbol 'first) [(api/fn-call (api/symbol 'keys) [(api/key-fn :next)])])}) + (api/map {(api/keyword :next) (api/key-fn :next) + (api/keyword :state) (api/key-fn :state) + (api/keyword :existing) (api/fn-call (api/symbol 'lookup) [(api/key-fn :state) (api/key-fn :key) (api/keyword :not-found)])}) + (api/map {(api/keyword :dupe) (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol '=) [(api/key-fn :existing) (api/key-fn :next)]) + (api/keyword :dupe) + (api/keyword :unique)]) + (api/keyword :state) (api/fn-call (api/symbol 'into) [(api/map {}) (api/vector [(api/key-fn :state) (api/key-fn :next)])])})]) + (api/map {(api/keyword :state) (api/map {})})) + + ;; global state (defncall 'load-state 'pipes/debug ;; (api/keyword :oasis.spec/state) @@ -2149,22 +2021,21 @@ (defncall 'tag-mode '-> (api/map {(api/keyword :mode) (api/symbol '_)})) - (defncall 'init-view '-> - (api/map {(api/keyword :zoom) (api/integer 1) - (api/keyword :x) (api/integer 150) - (api/keyword :y) (api/integer 50)})) - (defncall 'm-caravan-actions 'caravan-actions) ]) (def oasis-core-defs [(defncall 'oasis-core-init 'pipes/debug) (defncall 'oasis-kb 'pipes/debug) - (defncall 'oasis-mouse 'pipes/debug) + (defncall 'oasis-hover-state 'pipes/debug) + (defncall 'oasis-scroll-state 'pipes/debug) + (defncall 'oasis-drag-state 'pipes/debug) (defncall 'oasis-core-events 'pipes/debug) (defncall 'oasis-core-out 'pipes/debug) - (defncall 'log-mouse 'pipes/log (api/string "mouse: ")) + (defncall 'log-drag 'pipes/log (api/string "drag: ")) + (defncall 'log-hover 'pipes/log (api/string "hover: ")) + (defncall 'log-scroll 'pipes/log (api/string "scroll: ")) (defncall 'log-state2 'pipes/log (api/string "state: ")) (api/defmodule 'oasis-core (api/map {(api/keyword :depends) (api/map {(api/keyword :caravan) (api/symbol 'modules/caravan)}) @@ -2177,7 +2048,8 @@ ;(api/keyword :layout) (api/symbol 'oasis-layout) (api/keyword :init) (api/symbol 'oasis-core-init) (api/keyword :kb) (api/symbol 'oasis-kb) - (api/keyword :mouse) (api/symbol 'oasis-mouse) + (api/keyword :drag) (api/symbol 'oasis-drag-state) + (api/keyword :hover) (api/symbol 'oasis-hover-state) (api/keyword :events) (api/symbol 'oasis-core-events) (api/keyword :state) (api/symbol 'oasis-core-out) }) @@ -2188,25 +2060,15 @@ (def oasis-core-net [;; networks - (pipe 'oasis-mouse 'log-mouse) - (pipe 'oasis-mouse 'mouse-reduce) - (pipe 'mouse-reduce 'mouse-state) - (pipe 'oasis-mouse 'target-reduce) - (pipe 'target-reduce 'target-events) - - (pipe 'target-events 'only-different 'hover-events) - (pipe 'hover-events 'tag-hover 'hover-state) + (pipe 'oasis-drag-state 'log-drag) + (pipe 'oasis-hover-state 'log-hover) (pipe 'oasis-kb 'filter-key-input 'keyboard-filtered) (pipe 'keyboard-filtered 'filter-edit 'editor-commands) (pipe 'keyboard-filtered 'filter-menu 'editor-commands) (pipe 'keyboard-filtered 'log-keyboard) - (pipe 'keyboard-filtered 'filter-view 'view-commands) - (pipe 'view-commands 'make-zoom) - (pipe 'make-zoom 'zoom-events) - (pipe 'zoom-events 'view-events) - (pipe 'view-commands 'view-deltas) + ;; (pipe 'keyboard-filtered 'filter-view 'view-commands) (pipe 'raw-events 'input-reduce) (pipe 'input-reduce 'reduced-events) @@ -2227,17 +2089,14 @@ (pipe 'eval-reduce 'eval-raw) (pipe 'eval-raw 'tag-eval 'eval-state) - (pipe 'mouse-state 'filter-drag 'drag-events) - - (pipe 'drag-events 'filter-drag-end-or-start 'drag-state) ;; FIXME reduce ;; (pipe 'drag-state 'log-mouse) - (pipe 'drag-state 'interpret-drag 'editor-commands) + (pipe 'oasis-drag-state 'interpret-drag 'editor-commands) ;; (pipe 'drag-events 'log-mouse) (pipe 'caravan-commands 'handle-caravan-command 'editor-commands) (pipe 'editor-commands 'handle-commands 'editor-events) - (pipe 'hover-state 'editor-events) - (pipe 'scroll-state 'editor-events) + (pipe 'oasis-hover-state 'editor-events) + ;; (pipe 'oasis-scroll-state 'editor-events) (pipe 'editor-events 'editor-state-reduce) (pipe 'editor-state-reduce 'editor-cooked) (pipe 'editor-cooked 'tag-editor 'editor-state) @@ -2246,19 +2105,12 @@ (pipe 'editor-commands 'filter-immediate 'editor-immediate) ;; (pipe 'editor-immediate 'log-command) - (pipe 'mouse-state 'filter-scroll 'scroll-state) - (pipe 'scroll-state 'construct-view 'view-deltas) - (pipe 'view-deltas 'view-delta) - (pipe 'view-delta 'view-events) - (pipe 'view-events 'view-reduce) - (pipe 'view-reduce 'view-raw) - (pipe 'view-raw 'tag-view 'view-state) (pipe 'oasis-core-init 'source-menu-const 'source-menu-items) (pipe 'source-menu-items 'source-menu-map) (pipe 'source-menu-map 'source-menu) (pipe 'source-menu 'tag-items 'source-menu-events) - (pipe 'hover-state 'source-menu-events) + (pipe 'oasis-hover-state 'source-menu-events) (pipe 'source-menu-events 'reduce-menu-source) (pipe 'reduce-menu-source 'source-menu-state) (pipe 'source-menu-state 'tag-menu-source 'state-dedupe) @@ -2267,7 +2119,7 @@ (pipe 'sink-menu-items 'sink-menu-map) (pipe 'sink-menu-map 'sink-menu) (pipe 'sink-menu 'tag-items 'sink-menu-events) - (pipe 'hover-state 'sink-menu-events) + (pipe 'oasis-hover-state 'sink-menu-events) (pipe 'events 'sink-menu-events) (pipe 'sink-menu-events 'reduce-menu-sink) (pipe 'reduce-menu-sink 'sink-menu-state) @@ -2275,18 +2127,16 @@ (pipe 'editor-state 'state-dedupe) (pipe 'loaded-state 'state-dedupe) - (pipe 'view-state 'state-dedupe) (pipe 'drag-events 'state-dedupe) - (pipe 'hover-state 'state-dedupe) + (pipe 'oasis-hover-state 'state-dedupe) (pipe 'mode-state 'state-dedupe) (pipe 'events 'state-dedupe) (pipe 'state-dedupe 'filter-state 'oasis-core-out) ;; (pipe 'state-dedupe 'oasis-core-out) (pipe 'mode-state 'load-reduce) - (pipe 'hover-state 'load-reduce) + (pipe 'oasis-hover-state 'load-reduce) (pipe 'eval-state 'load-reduce) - (pipe 'zoom-events 'load-reduce) (pipe 'load-reduce 'load-state) (pipe 'load-state 'filter-load 'loaded-state) @@ -2319,8 +2169,6 @@ (api/symbol 'm-caravan-actions)) - (pipe 'oasis-core-init 'init-view 'view-events) - (pipe 'oasis-core-init 'm-caravan-actions) (pipe 'caravan-commands 'log-caravan) @@ -2329,10 +2177,13 @@ (def oasis-render-defs [ (defncall 'oasis-render-in 'pipes/debug) - (defncall 'log-mouse2 'pipes/log (api/string "mouse2: ")) + (defncall 'oasis-render-init 'pipes/debug) (defncall 'oasis-render-mouse-in 'pipes/debug) - (defncall 'oasis-render-mouse-out 'pipes/debug) + (defncall 'oasis-render-drag-out 'pipes/debug) + (defncall 'oasis-render-hover-out 'pipes/debug) (defncall 'oasis-render-out 'pipes/debug) + (defncall 'scroll-state 'pipes/debug) + (defncall 'log-view 'pipes/log (api/string "view: ")) ;; dark theme based on base16-atelierdune-dark ;; (http://atelierbram.github.io/syntax-highlighting/atelier-schemes/dune) @@ -2391,6 +2242,163 @@ (api/keyword :cell-active-content) (api/string "#b854d4")})}) + ;; View handling + + (defncall 'view-raw 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + (defncall 'view-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + (defncall 'view-deltas 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + (defncall 'view-commands 'pipes/debug) + (defncall 'view-events 'pipes/debug) + (defncall 'zoom-events 'pipes/debug) + + (defncall 'init-view '-> + (api/map {(api/keyword :zoom) (api/integer 1) + (api/keyword :x) (api/integer 150) + (api/keyword :y) (api/integer 50)})) + + (defncall 'make-zoom 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/map {(api/keyword :zoom) (api/fn-call (api/symbol '*) [(api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :zoom)]) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :zoom)])])})]) + (api/map {(api/keyword :zoom) (api/integer 1)})) + + + (defncall 'view-delta 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/map {(api/keyword :x) + (api/fn-call (api/symbol '+) [(api/fn-call (api/symbol '->) + [(api/key-fn :next) + (api/key-fn :x)]) + (api/fn-call (api/symbol '->) + [(api/key-fn :state) + (api/key-fn :x)])]) + (api/keyword :y) + (api/fn-call (api/symbol '+) [(api/fn-call (api/symbol '->) + [(api/key-fn :next) + (api/key-fn :y)]) + (api/fn-call (api/symbol '->) + [(api/key-fn :state) + (api/key-fn :y)])])} + )]) + (api/map {(api/keyword :x) (api/integer 150) + (api/keyword :y) (api/integer 50)})) + + (defncall 'construct-view '-> + (api/key-fn :mouse) + (api/map {(api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :delta) + (api/key-fn :x)]) + (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :delta) + (api/key-fn :y)])})) + + (defncall 'center-view 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/map {(api/keyword :x) (api/integer 150) + (api/keyword :y) (api/integer 50)})]) + (api/map {})) + + (defncall 'view-reduce 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/fn-call (api/symbol 'into) [(api/key-fn :state) (api/key-fn :next)])]) + (api/map {(api/keyword :zoom) (api/integer 1) + (api/keyword :x) (api/integer 150) + (api/keyword :y) (api/integer 50)})) + + (defncall 'tag-view '-> + (api/map {(api/keyword :view) (api/symbol '_)})) + + + ;; Mouse handling + (defncall 'mouse-reduce 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-move) + (api/symbol 'handle-mouse-move)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-down) + (api/symbol 'handle-mouse-down)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-up) + (api/symbol 'handle-mouse-up)]) + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :state) + (api/key-fn :mouse)]) + (api/key-fn :next)]) + (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)]) + (api/map {(api/keyword :mouse) (api/symbol '_)})]) + (api/map {(api/keyword :mouse) (api/map {})})) + + (defncall 'mouse-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + + (defncall 'is-drag '-> + (api/key-fn :mouse) + (api/key-fn :drag) + (api/key-fn :active) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :true)])) + + (defncall 'is-drag-end '-> + (api/key-fn :drag) + (api/key-fn :end) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :end)])) + + (defncall 'is-drag-start '-> + (api/key-fn :drag) + (api/key-fn :begin) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :true)])) + + (defncall 'is-drag-or-end 'or + (api/symbol 'is-drag) + (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-end)])) + + (defncall 'is-drag-end-or-start 'or + (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-start)]) + (api/fn-call (api/symbol '->) [(api/key-fn :mouse) (api/symbol 'is-drag-end)])) + + (defncall 'filter-drag-end-or-start 'only (api/symbol 'is-drag-end-or-start)) + + (defncall 'filter-drag 'only (api/symbol 'is-drag-or-end)) + + + (defncall 'is-scroll '-> + (api/key-fn :mouse) + (api/key-fn :drag) + (api/key-fn :button) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :secondary)])) + + (defncall 'filter-scroll 'only (api/fn-call (api/symbol 'and) [(api/symbol 'is-scroll) + (api/symbol 'is-drag-or-end)])) + + (defncall 'make-target-hover '-> + (api/fn-call (api/symbol 'str-split) [(api/symbol '_) (api/string "/")]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-valid-target) + (api/map {(api/keyword :type) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :name) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})])) + + + (defncall 'target-reduce 'pipes/reductions + (api/fn-call (api/symbol '->) + [(api/map {(api/keyword :prev) (api/fn-call (api/symbol '->) [(api/key-fn :state) + (api/key-fn :current)]) + (api/keyword :current) (api/fn-call (api/symbol '->) [(api/key-fn :next) + (api/key-fn :samak.mouse/target) + (api/symbol 'make-target-hover)])})]) + (api/map {(api/keyword :current) (api/map {(api/keyword :type) (api/string "none") + (api/keyword :name) (api/string "none")}) + (api/keyword :prev) (api/map {(api/keyword :type) (api/string "none") + (api/keyword :name) (api/string "none")})})) + + (defncall 'target-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + + (defncall 'only-different '-> + (api/fn-call (api/symbol 'except) [(api/fn-call (api/symbol '->) [(api/vector [(api/key-fn :prev) (api/key-fn :current)]) + (api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) + (api/fn-call (api/symbol 'count) [(api/symbol '_)]) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])])) + + (defncall 'hover-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + + ;; render handlers (defncall 'translate-str 'str (api/string "translate(") (api/fn-call (api/symbol 'or) [(api/key-fn :x) (api/integer 0)]) @@ -2731,20 +2739,6 @@ (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)]) ]) (api/map {})) - (defncall 'state-dedupe 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :next) (api/key-fn :next) - (api/keyword :state) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :state)]) - (api/keyword :key) (api/fn-call (api/symbol 'first) [(api/fn-call (api/symbol 'keys) [(api/key-fn :next)])])}) - (api/map {(api/keyword :next) (api/key-fn :next) - (api/keyword :state) (api/key-fn :state) - (api/keyword :existing) (api/fn-call (api/symbol 'lookup) [(api/key-fn :state) (api/key-fn :key) (api/keyword :not-found)])}) - (api/map {(api/keyword :dupe) (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol '=) [(api/key-fn :existing) (api/key-fn :next)]) - (api/keyword :dupe) - (api/keyword :unique)]) - (api/keyword :state) (api/fn-call (api/symbol 'into) [(api/map {}) (api/vector [(api/key-fn :state) (api/key-fn :next)])])})]) - (api/map {(api/keyword :state) (api/map {})})) - (defncall 'filter-state '-> (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol '=) [(api/key-fn :dupe) (api/keyword :unique)]) (api/key-fn :state) @@ -3647,9 +3641,13 @@ (api/defmodule 'oasis-render (api/map {(api/keyword :sources) (api/map {(api/keyword :state) (api/symbol 'oasis-render-in) (api/keyword :mouse) (api/symbol 'oasis-render-mouse-in) - (api/keyword :svg-elems) (api/symbol 'oasis-render-out)}) + (api/keyword :init) (api/symbol 'oasis-render-init) + (api/keyword :svg-elems) (api/symbol 'oasis-render-out) + (api/keyword :drag) (api/symbol 'oasis-render-drag-out) + (api/keyword :hover) (api/symbol 'oasis-render-hover-out)}) (api/keyword :sinks) (api/map {(api/keyword :svg-elems) (api/symbol 'oasis-render-out) - (api/keyword :mouse) (api/symbol 'oasis-render-mouse-out)})})) + (api/keyword :drag) (api/symbol 'oasis-render-drag-out) + (api/keyword :hover) (api/symbol 'oasis-render-hover-out)})})) ]) (def oasis-render-net @@ -3658,7 +3656,44 @@ (pipe 'state-reduce 'condensed-state) ;; (pipe 'oasis-render-mouse-in 'log-mouse2) - (pipe 'oasis-render-mouse-in 'oasis-render-mouse-out) + ;; (pipe 'oasis-render-mouse-in 'oasis-render-mouse-out) + + ;; mouse handling + (pipe 'oasis-render-mouse-in 'mouse-reduce) + (pipe 'mouse-reduce 'mouse-state) + (pipe 'mouse-state 'filter-drag 'drag-events) + + ;; (pipe 'drag-events 'filter-drag-end-or-start 'oasis-render-drag-out) ;; FIXME reduce + (pipe 'mouse-state 'filter-scroll 'scroll-state) + + (pipe 'oasis-render-mouse-in 'target-reduce) + (pipe 'target-reduce 'target-events) + (pipe 'target-events 'only-different 'hover-events) + ;; (pipe 'hover-events 'tag-hover 'oasis-render-hover-out) + + ;; keyboard handling + + + ;; view handling + + (pipe 'view-commands 'make-zoom) + (pipe 'make-zoom 'zoom-events) + ;; (pipe 'zoom-events 'view-events) + ;; (pipe 'view-commands 'view-deltas) ;; FIXME + + (pipe 'scroll-state 'construct-view 'view-deltas) + (pipe 'view-deltas 'view-delta) + (pipe 'view-delta 'view-events) + (pipe 'view-events 'view-reduce) + (pipe 'view-reduce 'view-raw) + (pipe 'view-raw 'tag-view 'view-state) + ;; (pipe 'view-state 'log-view) + (pipe 'view-state 'state-reduce) + + (pipe 'oasis-render-init 'init-view 'view-events) + + + ;; state rendering (pipe 'condensed-state 'only-resize 'svg-render) (pipe 'condensed-state 'graph 'svg-render) @@ -3791,6 +3826,11 @@ (api/key-fn :sources) (api/key-fn :state)) (defncall 'render-state 'm-state-fn) + (defncall 'm-ro-init-fn '-> + (api/symbol 'm-render) + (api/key-fn :sources) + (api/key-fn :init)) + (defncall 'render-init 'm-ro-init-fn) (defncall 'm-r-mouse-fn '-> (api/symbol 'm-render) (api/key-fn :sources) @@ -3801,11 +3841,16 @@ (api/key-fn :sinks) (api/key-fn :svg-elems)) (defncall 'render-elems 'm-elems-fn) - (defncall 'm-ro-mouse-fn '-> + (defncall 'm-ro-hover-fn '-> (api/symbol 'm-render) (api/key-fn :sinks) - (api/key-fn :mouse)) - (defncall 'render-mouse-out 'm-ro-mouse-fn) + (api/key-fn :hover)) + (defncall 'render-hover-out 'm-ro-hover-fn) + (defncall 'm-ro-drag-fn '-> + (api/symbol 'm-render) + (api/key-fn :sinks) + (api/key-fn :drag)) + (defncall 'render-drag-out 'm-ro-drag-fn) (defncall 'm-core-mod 'oasis-core) (defncall 'm-core 'm-core-mod) @@ -3824,11 +3869,16 @@ (api/key-fn :sources) (api/key-fn :kb)) (defncall 'core-kb-in 'm-core-kb-fn) - (defncall 'm-core-mouse-fn '-> + (defncall 'm-core-drag-fn '-> (api/symbol 'm-core) (api/key-fn :sources) - (api/key-fn :mouse)) - (defncall 'core-mouse-in 'm-core-mouse-fn) + (api/key-fn :drag)) + (defncall 'core-drag-in 'm-core-drag-fn) + (defncall 'm-core-hover-fn '-> + (api/symbol 'm-core) + (api/key-fn :sources) + (api/key-fn :hover)) + (defncall 'core-hover-in 'm-core-hover-fn) (defncall 'm-core-events-fn '-> (api/symbol 'm-core) (api/key-fn :sources) @@ -3855,10 +3905,14 @@ }) (api/keyword :sources) (api/map {(api/keyword :module-core-out) (api/symbol 'core-state) ;(api/keyword :module-core-kb-in) (api/symbol 'core-kb-in) - (api/keyword :module-core-mouse-in) (api/symbol 'core-mouse-in) + ;(api/keyword :module-core-drag-in) (api/symbol 'core-drag-in) + ;(api/keyword :module-core-scroll-in) (api/symbol 'core-scroll-in) + ;(api/keyword :module-core-hover-in) (api/symbol 'core-hover-in) (api/keyword :module-render-state) (api/symbol 'render-state) + (api/keyword :module-render-init) (api/symbol 'render-init) (api/keyword :module-render-mouse-in) (api/symbol 'render-mouse-in) - (api/keyword :module-render-mouse-out) (api/symbol 'render-mouse-out) + (api/keyword :module-render-drag-out) (api/symbol 'render-drag-out) + (api/keyword :module-render-hover-out) (api/symbol 'render-hover-out) (api/keyword :module-render-out) (api/symbol 'render-elems) (api/keyword :kb) (api/symbol 'oasis-keyboard) (api/keyword :mouse) (api/symbol 'oasis-bug) @@ -3888,15 +3942,18 @@ (pipe 'oasis-init 'header 'ui-render) ;; (pipe 'oasis-init 'header 'log-render) (pipe 'oasis-init 'core-init) + (pipe 'oasis-init 'render-init) ;; (pipe 'core-state 'log-state) (pipe 'core-state 'render-state) ;; (pipe 'render-elems 'log-render) (pipe 'render-elems 'ui-render) (pipe 'oasis-keyboard 'core-kb-in) - ;; (pipe 'oasis-bug 'core-mouse-in) (pipe 'oasis-bug 'render-mouse-in) - (pipe 'render-mouse-out 'core-mouse-in) + (pipe 'render-drag-out 'core-drag-in) + (pipe 'render-hover-out 'core-hover-in) + ;; (pipe 'render-drag-out 'log-foo) + ;; (pipe 'render-hover-out 'log-foo) ;; (pipe 'render-mouse-out 'log-foo) (pipe 'oasis-events 'core-events-in) (pipe 'oasis-events 'log-state) From 8669b56b4c4f13eb3db9c7ed50cf7e7669282fd0 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Sun, 4 Oct 2020 20:18:01 +0200 Subject: [PATCH 06/12] module, render thread and loading improvements --- dev_src/dev/core.cljs | 3 +- dev_src/dev/render.cljc | 27 +- src/samak/helpers.cljc | 7 + src/samak/nodes.cljc | 14 - src/samak/runtime.cljc | 4 +- src/samak/test_programs.cljc | 2 +- ui_src/samak/caravan.cljc | 30 ++- ui_src/samak/oasis.cljc | 507 ++++++++++++++++++++--------------- ui_src/samak/ui_stdlib.cljs | 51 +++- ui_src/samak/worker.cljc | 2 +- 10 files changed, 372 insertions(+), 275 deletions(-) diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index b0e76e8..0d6213b 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -11,8 +11,7 @@ (defn start-main [load in out] - (render/start-render-runtime load in out) - (render/start-oasis)) + (render/start-render-runtime load in out)) (defn update-bar diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index c5004d4..fa80093 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -75,7 +75,7 @@ (println msg p)) (recur)))) -(defn sched +(defn scheduler [id] (fn [broadcast] (println "sched" id) @@ -106,7 +106,6 @@ "" [rt] (fire-event-into-named-pipe rt "oasis-init" "1") - (fire-event-into-named-pipe rt "oasis-init" "1") (println "oasis started") ;; (let [parsed [(api/defexp 'start (api/fn-call (api/symbol 'pipes/debug) []))]] ;; (doseq [expression parsed] @@ -116,8 +115,7 @@ (defn eval-oasis [rt conf cb] (let [net (sched/load-bundle @rt 'oasis)] - (sched/eval-module rt conf net nil) - (println "eval done \\o/"))) + (helpers/debounce #(sched/eval-module rt conf net nil)))) (defn get-named-pipe [rt pipe-name] @@ -152,21 +150,26 @@ (defn start-oasis "" - [] - (run-oasis @rt) - ) + [load] + (eval-oasis rt main-conf load) + (println "renderer started oasis") + (helpers/debounce #(run-oasis @rt))) + +(defn init-oasis + "" + [load] + (oasis/store (:store @rt)) + (helpers/debounce #(start-oasis load))) (defn start-render-runtime "" [load in out] - (reset! rt (run/make-runtime renderer-symbols (sched "main") main-conf)) + (reset! rt (run/make-runtime renderer-symbols (scheduler "main") main-conf)) (reset! tracer (trace/init-tracer @rt (:tracer config))) (println "renderer started runtime" (:id @rt) @rt) - (oasis/store (:store @rt)) - (eval-oasis rt main-conf load) - (println "renderer started oasis") + (helpers/debounce #(init-oasis load)) - (pipes/link! (:broadcast @rt) (pipes/pipe out)) + (pipes/link! (:broadcast @rt) (pipes/sink out)) (pipes/link! (pipes/source in) (:scheduler @rt)) ) diff --git a/src/samak/helpers.cljc b/src/samak/helpers.cljc index fb913ea..8ec1511 100644 --- a/src/samak/helpers.cljc +++ b/src/samak/helpers.cljc @@ -10,6 +10,7 @@ :cljs [(:refer-clojure :exclude [uuid]) (:require + [goog.async.nextTick] [cljs-time.core :as time] [cljs-time.format :as time-format] [cljs-time.coerce :as time-coerce])])) @@ -106,3 +107,9 @@ (defn to-json [x] #?(:cljs (clj->js x) :clj (json/write-str x))) + +(defn debounce + "" + [f] + #?(:cljs (goog.async.nextTick f) + :clj (f))) diff --git a/src/samak/nodes.cljc b/src/samak/nodes.cljc index fc81548..e9aee11 100644 --- a/src/samak/nodes.cljc +++ b/src/samak/nodes.cljc @@ -42,22 +42,8 @@ :default (compile-error "unknown token during evaluation: " (str "type: " (or (type value) "nil") " with value: " (str value))))) (defmethod eval-node ::module [module] - (println "evaling module: " module) - ;; FIXME: also needs to make this stuff available for resolve? - ((:module *manager*) module *manager*)) -(defn foo - "" - [& args] - (println args)) - - -(defmethod eval-node ::fuse [{:keys [::module-name ::bindings] :as module}] - (foo module) - (let [mod (eval-node module-name)] - )) - (defmethod eval-node ::map [{:keys [::mapkv-pairs]}] (reduce (fn [a {:keys [::mapkey ::mapvalue]}] (assoc a (::value mapkey) (eval-node mapvalue))) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index 667ba8f..ee3cefc 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -114,7 +114,7 @@ (if (not= target :pipe) pipe (do - (println "replacing " pipe) + ;; (println "replacing " pipe) (let [from-scheduler (:scheduler @resolver) trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe (:id @resolver))) (remove #(= % ::ignore)))) to-world (:broadcast @resolver) @@ -144,7 +144,7 @@ c (get (:config man) n)] (if c (fn [] - (println "return stub for" n "[" (:db/id module) "] -> " c) + ;; (println "return stub for" n "[" (:db/id module) "] -> " c) c) (fn [] ;; FIXME diff --git a/src/samak/test_programs.cljc b/src/samak/test_programs.cljc index 491f343..d7bd627 100644 --- a/src/samak/test_programs.cljc +++ b/src/samak/test_programs.cljc @@ -135,7 +135,7 @@ "(| in a)" "(| b out)" "(defmodule bar {:depends {:caravan modules/caravan} - :sources {:in in :b b} + :sources {:in in :b b :mod mod} :sinks {:out out} :tests {:t1 {:when {\"in\" [1]} :then {\"out\" [(incase 2 :success)]}}}})" diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 55a2a03..8586c41 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -6,6 +6,7 @@ [clojure.core.async :as a :refer [! put! chan go go-loop close!]] [samak.test-programs :as test-programs] [samak.api :as api] + [samak.helpers :as helpers] [samak.lisparser :as p] [samak.scheduler :as sched] [samak.runtime :as rt] @@ -26,6 +27,7 @@ [clojure.core.async :as a :refer [! put! chan close!]] [samak.test-programs :as test-programs] [samak.api :as api] + [samak.helpers :as helpers] [samak.lisparser :as p] [samak.scheduler :as sched] [samak.runtime :as rt] @@ -734,8 +736,7 @@ ;; rootnotify (database-net roots) _ (println "root" rootnotify) a1 (merge-with into rootnotify deps) - ] - _ (println "ev n" a1) + _ (println "ev n" a1)] (assoc a1 :id (:id bundle)) )) @@ -827,18 +828,11 @@ (defn load-lib "" [cmd ev sym] - (let [bundle (eval-bundle sym) - merged (merge-with concat bundle) - _ (println (str "bundle: " merged)) - ;; dist (into {} (for [[k v] merged] [k (distinct v)])) - ;; _ (println (str "bundle2: " dist)) - ;; cnt (apply + (map #(map count (vals %)) merged)) - ] + (let [bundle (eval-bundle sym)] ;; (println (str "count: " cnt)) (doall (map #(notify-source ev %) (:modules bundle))) (doall (map #(notify-source ev %) (:nodes bundle))) (doall (map #(notify-source ev %) (:pipes bundle))) - (println "notify done") (notify-source ev {::state ::done} @@ -848,7 +842,7 @@ "" [cmd ev prog sym] (persist-net prog) - (load-lib cmd ev sym)) + (helpers/debounce #(load-lib cmd ev sym))) (defn test-net "" @@ -876,13 +870,22 @@ (defn load-oasis "" [cmd ev] - (load-lib cmd ev 'oasis)) + (helpers/debounce #(load-lib cmd ev 'oasis))) (defn test-oasis "" [c] (run-testsuite c 'oasis {:timeout 3000})) +(defn test-example + "" + [cmd ev arg] + (case arg + :load (load-test cmd ev) + :self (load-oasis cmd ev) + (tools/log "load unknown: " arg))) + + (defn oasis-hook "" [] @@ -930,9 +933,10 @@ (do (tools/log "caravan: " call) (case (:action call) - :load (load-oasis caravan-cmd caravan-eval) + :load (test-example caravan-cmd caravan-eval (:arguments call)) :test (test-chuck caravan-cmd) :trace (trace-dump) + ;; :sink (create-sink caravan-cmd caravan-eval (:arguments call)) :insert (add-cell caravan-eval (:arguments call)) :edit (edit-cell caravan-eval (:arguments call)) :cut (cut-cell caravan-eval (:arguments call)) diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index 3b4dc6b..baed13e 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -89,7 +89,6 @@ (defncall 'log-layout 'pipes/log (api/string "layout: ")) (defncall 'log-events 'pipes/log (api/string "events: ")) (defncall 'log-editor 'pipes/log (api/string "editor: ")) - (defncall 'log-hover 'pipes/log (api/string "hover: ")) (defncall 'log-keyboard 'pipes/log (api/string "keyboard: ")) (defncall 'log-caravan 'pipes/log (api/string "caravan-cmd: ")) (defncall 'log-caravan-ev 'pipes/log (api/string "caravan-eval: ")) @@ -224,11 +223,6 @@ (api/keyword :id) (api/string "input/repl") (api/keyword :style) (api/map {(api/keyword :pointer-events) (api/string "auto")})})])])})}) - (defncall 'is-mouse-move '-> - (api/key-fn :next) - (api/key-fn :samak.mouse/type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :move)])) - (defncall 'calculate-mouse-delta-x '-> (api/fn-call (api/symbol '+) [(api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/page-x)]) @@ -251,63 +245,6 @@ (api/key-fn :y) ])])])) - (defncall 'handle-mouse-move '-> - (api/map {(api/keyword :state) (api/key-fn :state) - (api/keyword :next) (api/map {(api/keyword :position) - (api/map {(api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/page-x)]) - (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/symbol 'get-mouse-y)])}) - (api/keyword :delta) - (api/map {(api/keyword :x) - (api/symbol 'calculate-mouse-delta-x) - (api/keyword :y) - (api/symbol 'calculate-mouse-delta-y)}) - (api/keyword :drag) - (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mouse) (api/key-fn :drag) - (api/map {(api/keyword :active) (api/key-fn :active) - (api/keyword :source) (api/key-fn :source) - (api/keyword :begin) (api/keyword :false) - (api/keyword :button) (api/key-fn :button)})])})})) - - (defncall 'is-mouse-down '-> - (api/key-fn :next) - (api/key-fn :samak.mouse/type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :down)])) - - (defncall 'handle-mouse-down '-> - (api/map {(api/keyword :state) (api/key-fn :state) - (api/keyword :next) (api/fn-call (api/symbol '->) - [(api/key-fn :next) - (api/map {(api/keyword :drag) (api/map {(api/keyword :begin) (api/keyword :true) - (api/keyword :active) (api/keyword :true) - (api/keyword :button) (api/key-fn :samak.mouse/button) - (api/keyword :source) (api/key-fn :samak.mouse/target)}) - - (api/keyword :position) (api/map {(api/keyword :x) (api/key-fn :samak.mouse/page-x) - (api/keyword :y) (api/symbol 'get-mouse-y)}) - (api/keyword :start) (api/map {(api/keyword :x) (api/key-fn :samak.mouse/page-x) - (api/keyword :y) (api/symbol 'get-mouse-y)})})])})) - - (defncall 'is-mouse-up '-> - (api/key-fn :next) - (api/key-fn :samak.mouse/type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :up)])) - - (defncall 'handle-mouse-up '-> - (api/map {(api/keyword :state) (api/key-fn :state) - (api/keyword :next) (api/map {(api/keyword :drag) - (api/map {(api/keyword :active) (api/keyword :false) - (api/keyword :end) (api/keyword :end) - (api/keyword :button) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/button)]) - (api/keyword :target) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/target)]) - (api/keyword :source) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mouse) (api/key-fn :drag) (api/key-fn :source)])})})})) - - - - (defncall 'tag-hover '-> - (api/map {(api/keyword :hover) (api/symbol '_)})) - - - (defncall 'drag-events 'pipes/debug) ;; (defncall 'drag-reduce 'pipes/reductions ;; (api/fn-call (api/symbol '->) @@ -617,7 +554,18 @@ (defncall 'construct-load '-> (api/map {(api/keyword :command) (api/keyword :load) (api/keyword :type) (api/keyword :immediate) - (api/keyword :data) (api/keyword :load)})) + (api/keyword :data) (api/keyword :load) + (api/keyword :load) (api/keyword :load)})) + + (defncall 'is-kb-self '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "p")])) + + (defncall 'construct-self '-> + (api/map {(api/keyword :command) (api/keyword :load) + (api/keyword :type) (api/keyword :immediate) + (api/keyword :data) (api/keyword :load) + (api/keyword :load) (api/keyword :self)})) (defncall 'is-kb-test '-> (api/key-fn :key) @@ -644,6 +592,8 @@ (api/symbol 'construct-menu)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-load) (api/symbol 'construct-load)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-self) + (api/symbol 'construct-self)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-test) (api/symbol 'construct-test)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-trace) @@ -652,82 +602,6 @@ (api/symbol 'ignore)])) - (defncall 'is-kb-move-left '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowLeft")])) - - (defncall 'is-kb-move-right '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowRight")])) - - (defncall 'is-kb-move-up '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowUp")])) - - (defncall 'is-kb-move-down '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowDown")])) - - (defncall 'construct-move-left '-> - (api/map {(api/keyword :command) (api/keyword :move) - (api/keyword :x) (api/integer 50) - (api/keyword :y) (api/integer 0) - (api/keyword :zoom) (api/integer 1)})) - - (defncall 'construct-move-right '-> - (api/map {(api/keyword :command) (api/keyword :move) - (api/keyword :x) (api/integer -50) - (api/keyword :y) (api/integer 0) - (api/keyword :zoom) (api/integer 1)})) - - (defncall 'construct-move-up '-> - (api/map {(api/keyword :command) (api/keyword :move) - (api/keyword :x) (api/integer 0) - (api/keyword :y) (api/integer 50) - (api/keyword :zoom) (api/integer 1)})) - - (defncall 'construct-move-down '-> - (api/map {(api/keyword :command) (api/keyword :move) - (api/keyword :x) (api/integer 0) - (api/keyword :y) (api/integer -50) - (api/keyword :zoom) (api/integer 1)})) - - (defncall 'is-kb-zoom-in '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "+")])) - - (defncall 'is-kb-zoom-out '-> - (api/key-fn :key) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "-")])) - - (defncall 'construct-zoom-out '-> - (api/map {(api/keyword :command) (api/keyword :zoom) - (api/keyword :zoom) (api/float 0.9)})) - - (defncall 'construct-zoom-in '-> - (api/map {(api/keyword :command) (api/keyword :zoom) - (api/keyword :zoom) (api/float 1.1)})) - - - - (defncall 'filter-view '-> - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-left) - (api/symbol 'construct-move-left)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-right) - (api/symbol 'construct-move-right)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-up) - (api/symbol 'construct-move-up)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-down) - (api/symbol 'construct-move-down)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-phase-up) - (api/fn-call (api/symbol '->) [(api/map {(api/keyword :key) (api/keyword :ignore)})])]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-zoom-in) - (api/symbol 'construct-zoom-in)]) - (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-zoom-out) - (api/symbol 'construct-zoom-out)]) - (api/fn-call (api/symbol 'unless) [(api/key-fn :command) - (api/symbol 'ignore)])) - (defncall 'make-view-move 'pipes/reductions (api/fn-call (api/symbol '->) [(api/key-fn :next) @@ -809,6 +683,7 @@ (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 0)])) (defncall 'is-source-source '-> + (api/fn-call (api/symbol 'spy) [(api/string "source")]) (api/key-fn :source) (api/symbol 'is-pipe)) @@ -827,6 +702,7 @@ (api/symbol 'is-target-sink)])) (defncall 'is-start '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod2")]) (api/fn-call (api/symbol 'and) [(api/symbol 'is-lmb-event) (api/symbol 'is-source-source) (api/fn-call (api/symbol '=) [(api/key-fn :begin) (api/keyword :true)])])) @@ -988,7 +864,7 @@ (defncall 'handle-load '-> (api/key-fn :data) (api/map {(api/keyword :mode) (api/keyword :load) - (api/keyword :load) (api/keyword :none)})) + (api/keyword :load) (api/keyword :test2)})) (defncall 'is-test '-> (api/key-fn :command) @@ -997,7 +873,7 @@ (defncall 'handle-test '-> (api/key-fn :data) (api/map {(api/keyword :mode) (api/keyword :test) - (api/keyword :test) (api/keyword :none)})) + (api/keyword :test) (api/keyword :self)})) (defncall 'is-trace '-> (api/key-fn :command) @@ -1596,20 +1472,26 @@ (api/fn-call (api/symbol 'map) [(api/symbol 'merge-mod) (api/symbol '_)]) (api/fn-call (api/symbol 'map) [(api/symbol 'format-mod) (api/symbol '_)])) - (defncall 'merge-defs '-> - (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) - (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + (defncall 'format-scope '-> + (api/map {(api/keyword :scope) (api/fn-call (api/keyword '->) [(api/key-fn :context)])}) + (api/fn-call (api/symbol 'spy) [(api/string "fscope")]) + ) - (defncall 'format-defs '-> - (api/fn-call (api/symbol 'myzip) [(api/key-fn :defs) - (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :defs)]) - (api/key-fn :context)])]) - (api/fn-call (api/symbol 'map) [(api/symbol 'merge-defs) (api/symbol '_)]) - (api/fn-call (api/symbol 'map) [(api/symbol 'format-def) (api/symbol '_)])) + ;; (defncall 'merge-defs '-> + ;; (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + ;; (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) - (defncall 'format-pipes '-> - (api/fn-call (api/symbol 'mapcat) [(api/symbol 'extract-connection) (api/key-fn :pipes)]) - (api/fn-call (api/symbol 'map) [(api/symbol 'format-pipe) (api/symbol '_)])) + ;; (defncall 'format-defs '-> + ;; (api/fn-call (api/symbol 'myzip) [(api/key-fn :defs) + ;; (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :defs)]) + ;; (api/key-fn :context)])]) + ;; (api/fn-call (api/symbol 'map) [(api/symbol 'merge-defs) (api/symbol '_)]) + ;; (api/fn-call (api/symbol 'map) [(api/symbol 'format-def) (api/symbol '_)])) + + ;; (defncall 'format-pipes '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "freepipe")]) + ;; (api/fn-call (api/symbol 'mapcat) [(api/symbol 'extract-connection) (api/key-fn :pipes)]) + ;; (api/fn-call (api/symbol 'map) [(api/symbol 'format-pipe) (api/symbol '_)])) (defncall 'format-state '-> (api/map {(api/keyword :evalorig) (api/key-fn :eval) @@ -1624,9 +1506,8 @@ ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) (api/map {(api/keyword :id) (api/string "root") (api/keyword :layoutOptions) (api/map {(api/string "elk.algorithm") (api/string "layered")}) - (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules) ;; (api/symbol 'format-defs) - ]) - (api/keyword :edges) (api/symbol 'format-pipes) + (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules)]) + ;; (api/keyword :edges) (api/symbol 'format-pipes) })) @@ -1773,7 +1654,9 @@ (api/map {(api/keyword :state) (api/key-fn :state) (api/keyword :next) (api/map {(api/keyword :call) (api/map {(api/keyword :action) - (api/keyword :load)})})})) + (api/keyword :load) + (api/keyword :arguments) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :load)])})})})) (defncall 'should-test '-> (api/key-fn :next) @@ -2028,6 +1911,7 @@ [(defncall 'oasis-core-init 'pipes/debug) (defncall 'oasis-kb 'pipes/debug) (defncall 'oasis-hover-state 'pipes/debug) + (defncall 'oasis-hover-in 'pipes/debug) (defncall 'oasis-scroll-state 'pipes/debug) (defncall 'oasis-drag-state 'pipes/debug) (defncall 'oasis-core-events 'pipes/debug) @@ -2049,7 +1933,7 @@ (api/keyword :init) (api/symbol 'oasis-core-init) (api/keyword :kb) (api/symbol 'oasis-kb) (api/keyword :drag) (api/symbol 'oasis-drag-state) - (api/keyword :hover) (api/symbol 'oasis-hover-state) + (api/keyword :hover) (api/symbol 'oasis-hover-in) (api/keyword :events) (api/symbol 'oasis-core-events) (api/keyword :state) (api/symbol 'oasis-core-out) }) @@ -2061,15 +1945,13 @@ [;; networks (pipe 'oasis-drag-state 'log-drag) - (pipe 'oasis-hover-state 'log-hover) + (pipe 'oasis-hover-in 'oasis-hover-state) (pipe 'oasis-kb 'filter-key-input 'keyboard-filtered) (pipe 'keyboard-filtered 'filter-edit 'editor-commands) (pipe 'keyboard-filtered 'filter-menu 'editor-commands) (pipe 'keyboard-filtered 'log-keyboard) - ;; (pipe 'keyboard-filtered 'filter-view 'view-commands) - (pipe 'raw-events 'input-reduce) (pipe 'input-reduce 'reduced-events) (pipe 'raw-events 'tag-events 'events) @@ -2089,9 +1971,7 @@ (pipe 'eval-reduce 'eval-raw) (pipe 'eval-raw 'tag-eval 'eval-state) - ;; (pipe 'drag-state 'log-mouse) (pipe 'oasis-drag-state 'interpret-drag 'editor-commands) - ;; (pipe 'drag-events 'log-mouse) (pipe 'caravan-commands 'handle-caravan-command 'editor-commands) (pipe 'editor-commands 'handle-commands 'editor-events) @@ -2127,7 +2007,6 @@ (pipe 'editor-state 'state-dedupe) (pipe 'loaded-state 'state-dedupe) - (pipe 'drag-events 'state-dedupe) (pipe 'oasis-hover-state 'state-dedupe) (pipe 'mode-state 'state-dedupe) (pipe 'events 'state-dedupe) @@ -2135,6 +2014,7 @@ ;; (pipe 'state-dedupe 'oasis-core-out) (pipe 'mode-state 'load-reduce) + ;; (pipe 'scope-state 'load-reduce) (pipe 'oasis-hover-state 'load-reduce) (pipe 'eval-state 'load-reduce) (pipe 'load-reduce 'load-state) @@ -2179,11 +2059,15 @@ (defncall 'oasis-render-in 'pipes/debug) (defncall 'oasis-render-init 'pipes/debug) (defncall 'oasis-render-mouse-in 'pipes/debug) + (defncall 'oasis-render-kb-in 'pipes/debug) + (defncall 'oasis-render-kb-out 'pipes/debug) (defncall 'oasis-render-drag-out 'pipes/debug) (defncall 'oasis-render-hover-out 'pipes/debug) (defncall 'oasis-render-out 'pipes/debug) (defncall 'scroll-state 'pipes/debug) (defncall 'log-view 'pipes/log (api/string "view: ")) + (defncall 'log-mouse2 'pipes/log (api/string "mouse2: ")) + (defncall 'log-hov 'pipes/log (api/string "hov: ")) ;; dark theme based on base16-atelierdune-dark ;; (http://atelierbram.github.io/syntax-highlighting/atelier-schemes/dune) @@ -2311,6 +2195,65 @@ ;; Mouse handling + (defncall 'drag-events 'pipes/debug) + + (defncall 'is-mouse-move '-> + (api/key-fn :next) + (api/key-fn :samak.mouse/type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :move)])) + + (defncall 'is-mouse-down '-> + (api/key-fn :next) + (api/key-fn :samak.mouse/type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :down)])) + + (defncall 'handle-mouse-down '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/fn-call (api/symbol '->) + [(api/key-fn :next) + (api/map {(api/keyword :drag) (api/map {(api/keyword :begin) (api/keyword :true) + (api/keyword :active) (api/keyword :true) + (api/keyword :button) (api/key-fn :samak.mouse/button) + (api/keyword :source) (api/key-fn :samak.mouse/target)}) + + (api/keyword :position) (api/map {(api/keyword :x) (api/key-fn :samak.mouse/page-x) + (api/keyword :y) (api/symbol 'get-mouse-y)}) + (api/keyword :start) (api/map {(api/keyword :x) (api/key-fn :samak.mouse/page-x) + (api/keyword :y) (api/symbol 'get-mouse-y)})})])})) + + (defncall 'is-mouse-up '-> + (api/key-fn :next) + (api/key-fn :samak.mouse/type) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :up)])) + + (defncall 'handle-mouse-up '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/map {(api/keyword :drag) + (api/map {(api/keyword :active) (api/keyword :false) + (api/keyword :end) (api/keyword :end) + (api/keyword :button) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/button)]) + (api/keyword :target) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/target)]) + (api/keyword :source) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mouse) (api/key-fn :drag) (api/key-fn :source)])})})})) + + + (defncall 'handle-mouse-move '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/map {(api/keyword :position) + (api/map {(api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/page-x)]) + (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/symbol 'get-mouse-y)])}) + (api/keyword :delta) + (api/map {(api/keyword :x) + (api/symbol 'calculate-mouse-delta-x) + (api/keyword :y) + (api/symbol 'calculate-mouse-delta-y)}) + (api/keyword :drag) + (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mouse) (api/key-fn :drag) + (api/map {(api/keyword :active) (api/key-fn :active) + (api/keyword :source) (api/key-fn :source) + (api/keyword :begin) (api/keyword :false) + (api/keyword :button) (api/key-fn :button)})])})})) + + (defncall 'mouse-reduce 'pipes/reductions (api/fn-call (api/symbol '->) [(api/fn-call (api/symbol 'incase) [(api/symbol 'is-mouse-move) @@ -2375,8 +2318,9 @@ (defncall 'target-reduce 'pipes/reductions - (api/fn-call (api/symbol '->) - [(api/map {(api/keyword :prev) (api/fn-call (api/symbol '->) [(api/key-fn :state) + (api/fn-call (api/symbol '->) [ + ;; (api/fn-call (api/symbol 'spy) [(api/string "target")]) + (api/map {(api/keyword :prev) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :current)]) (api/keyword :current) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :samak.mouse/target) @@ -2397,6 +2341,88 @@ (defncall 'hover-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) ) + (defncall 'hover-out 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + ) + (defncall 'tag-hover '-> + (api/map {(api/keyword :hover) (api/symbol '_)})) + + ;; keyboard handling + + + (defncall 'is-kb-move-left '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowLeft")])) + + (defncall 'is-kb-move-right '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowRight")])) + + (defncall 'is-kb-move-up '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowUp")])) + + (defncall 'is-kb-move-down '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "ArrowDown")])) + + (defncall 'construct-move-left '-> + (api/map {(api/keyword :command) (api/keyword :move) + (api/keyword :x) (api/integer 50) + (api/keyword :y) (api/integer 0) + (api/keyword :zoom) (api/integer 1)})) + + (defncall 'construct-move-right '-> + (api/map {(api/keyword :command) (api/keyword :move) + (api/keyword :x) (api/integer -50) + (api/keyword :y) (api/integer 0) + (api/keyword :zoom) (api/integer 1)})) + + (defncall 'construct-move-up '-> + (api/map {(api/keyword :command) (api/keyword :move) + (api/keyword :x) (api/integer 0) + (api/keyword :y) (api/integer 50) + (api/keyword :zoom) (api/integer 1)})) + + (defncall 'construct-move-down '-> + (api/map {(api/keyword :command) (api/keyword :move) + (api/keyword :x) (api/integer 0) + (api/keyword :y) (api/integer -50) + (api/keyword :zoom) (api/integer 1)})) + + (defncall 'is-kb-zoom-in '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "+")])) + + (defncall 'is-kb-zoom-out '-> + (api/key-fn :key) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "-")])) + + (defncall 'construct-zoom-out '-> + (api/map {(api/keyword :command) (api/keyword :zoom) + (api/keyword :zoom) (api/float 0.9)})) + + (defncall 'construct-zoom-in '-> + (api/map {(api/keyword :command) (api/keyword :zoom) + (api/keyword :zoom) (api/float 1.1)})) + + (defncall 'filter-view '-> + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-left) + (api/symbol 'construct-move-left)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-right) + (api/symbol 'construct-move-right)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-up) + (api/symbol 'construct-move-up)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-move-down) + (api/symbol 'construct-move-down)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-phase-up) + (api/fn-call (api/symbol '->) [(api/map {(api/keyword :key) (api/keyword :ignore)})])]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-zoom-in) + (api/symbol 'construct-zoom-in)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-kb-zoom-out) + (api/symbol 'construct-zoom-out)]) + (api/fn-call (api/symbol 'unless) [(api/key-fn :command) + (api/symbol 'ignore)])) + ;; render handlers (defncall 'translate-str 'str @@ -2754,9 +2780,9 @@ ;; cell handling - (defncall 'func-id 'str - (api/string "func/") - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])) + (defncall 'func-id '-> + (api/key-fn :node) + (api/key-fn :id)) (defncall 'is-same '-> (api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) @@ -3118,19 +3144,19 @@ ;; (api/fn-call (api/symbol '->) [(api/key-fn :node) ;; (api/symbol 'translate-blur)])}) ;; (api/symbol 'graph-func-single)])]) - (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol 'and) [(api/symbol 'is-hovered) - (api/fn-call (api/symbol '->) [(api/key-fn :context) - (api/symbol 'is-change-navigate)])]) - (api/vector [(api/keyword :g) - (api/map {(api/keyword :opacity) (api/string "1") - (api/keyword :transform) - (api/fn-call (api/symbol '->) [(api/key-fn :node) - (api/symbol 'translate-func)])}) - (api/fn-call (api/symbol '->) [(api/map {(api/keyword :node) (api/key-fn :node) - (api/keyword :context) (api/key-fn :context) - (api/keyword :expanded) (api/keyword :expand)}) - (api/symbol 'graph-func-single)])]) - (api/string "")]) + ;; (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol 'and) [(api/symbol 'is-hovered) + ;; (api/fn-call (api/symbol '->) [(api/key-fn :context) + ;; (api/symbol 'is-change-navigate)])]) + ;; (api/vector [(api/keyword :g) + ;; (api/map {(api/keyword :opacity) (api/string "1") + ;; (api/keyword :transform) + ;; (api/fn-call (api/symbol '->) [(api/key-fn :node) + ;; (api/symbol 'translate-func)])}) + ;; (api/fn-call (api/symbol '->) [(api/map {(api/keyword :node) (api/key-fn :node) + ;; (api/keyword :context) (api/key-fn :context) + ;; (api/keyword :expanded) (api/keyword :expand)}) + ;; (api/symbol 'graph-func-single)])]) + ;; (api/string "")]) ])) (defncall 'graph-focused '-> @@ -3170,8 +3196,8 @@ (api/keyword :pointer-events) (api/string "all")})})]) (api/vector [(api/keyword :g)])]) (api/vector [(api/keyword :circle) - (api/map {(api/keyword :id) (api/key-fn :id) - (api/keyword :class) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'pipe-id)]) + (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)]) + (api/keyword :data-name) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'pipe-id)]) (api/keyword :cx) (api/integer 50) (api/keyword :cy) (api/integer 50) (api/keyword :r) (api/integer 50) @@ -3244,12 +3270,12 @@ (defncall 'is-incoming '-> (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) - (api/fn-call (api/symbol '->) [(api/key-fn :edge) (api/key-fn :to)])])) + (api/fn-call (api/symbol 'str) [(api/fn-call (api/symbol '->) [(api/key-fn :edge) (api/key-fn :to)])])])) (defncall 'is-outgoing '-> (api/fn-call (api/symbol 'and) [(api/key-fn :edge) (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) - (api/fn-call (api/symbol '->) [(api/key-fn :edge) (api/key-fn :from)])])])) + (api/fn-call (api/symbol 'str) [(api/fn-call (api/symbol '->) [(api/key-fn :edge) (api/key-fn :from)])])])])) (defncall 'get-edge-color '-> (api/fn-call (api/symbol 'incase) [(api/symbol 'is-incoming) @@ -3307,7 +3333,7 @@ (defncall 'graph-module-stub '-> (api/vector [(api/keyword :g) (api/vector [(api/keyword :rect) - (api/map {(api/keyword :id) (api/symbol 'func-id) + (api/map {(api/keyword :id) (api/fn-call (api/symbol 'str) [(api/string "m/") (api/symbol 'func-id)]) (api/keyword :fill-opacity) (api/float 0.4) (api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :module-bg) (api/symbol 'get-color)]) @@ -3320,8 +3346,8 @@ (api/keyword :height) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :height)])})]) (api/vector [(api/keyword :text) (api/map {;; (api/keyword :transform) (api/string "rotate(90 50 50)") - (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) - (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) + ;; (api/keyword :x) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :x)]) + ;; (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) (api/keyword :dy) (api/integer 14) (api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :node-name-stroke) (api/symbol 'get-color)]) (api/keyword :text-anchor) (api/keyword :middle) @@ -3381,7 +3407,7 @@ (defncall 'graph-module '-> (api/vector [(api/keyword :g) - (api/map {(api/keyword :id) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)]) + (api/map {(api/keyword :id) (api/fn-call (api/symbol 'str) [(api/string "mod/") (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)])]) (api/keyword :transform) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'translate-str)])}) (api/symbol 'graph-module-stub) (api/symbol 'graph-module-ports) @@ -3433,14 +3459,15 @@ (api/fn-call (api/symbol 'map) [(api/symbol 'graph-node) (api/symbol '_)]) (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "nodes")})]) (api/symbol '_)])) + + (defncall 'graph '-> ;; (api/fn-call (api/symbol 'spy) [(api/string "graph")]) - (api/map {(api/keyword :layout) (api/key-fn :layout) + (api/map {(api/keyword :layout) (api/key-fn :layout) ;;(api/symbol 'prep-layout) (api/keyword :view) (api/key-fn :view) (api/keyword :context) (api/symbol 'build-context)}) (api/map {(api/keyword :graph) (api/vector [(api/keyword :g) - (api/map {(api/keyword :transform) (api/fn-call (api/symbol '->) [(api/key-fn :view) (api/symbol 'translate-graph)])}) (api/symbol 'graph-background) (api/symbol 'graph-connections) (api/symbol 'graph-nodes)])})) @@ -3537,7 +3564,8 @@ (api/keyword :action-menu) (api/vector [(api/keyword :g)]) (api/keyword :graph-drag) (api/vector [(api/keyword :g)]) (api/keyword :graph-dialog) (api/vector [(api/keyword :g)]) - (api/keyword :resize) (api/map {})})) + (api/keyword :resize) (api/map {}) + (api/keyword :view) (api/map {})})) ;; render elements to hiccup @@ -3629,7 +3657,10 @@ (api/keyword :viewBox) (api/fn-call (api/symbol 'str) [(api/string "0 0 ") (api/symbol 'get-width) (api/string " ") (api/symbol 'get-height)]) }) (api/symbol 'svg-defs) - (api/key-fn :graph) + (api/vector [(api/keyword :g) + (api/map {(api/keyword :id) (api/string "view") + (api/keyword :transform) (api/fn-call (api/symbol '->) [(api/key-fn :view) (api/symbol 'translate-graph)])}) + (api/key-fn :graph)]) (api/key-fn :graph-focused) (api/key-fn :source-menu) (api/key-fn :sink-menu) @@ -3641,11 +3672,14 @@ (api/defmodule 'oasis-render (api/map {(api/keyword :sources) (api/map {(api/keyword :state) (api/symbol 'oasis-render-in) (api/keyword :mouse) (api/symbol 'oasis-render-mouse-in) + (api/keyword :kb) (api/symbol 'oasis-render-kb-in) + (api/keyword :kb-out) (api/symbol 'oasis-render-kb-out) (api/keyword :init) (api/symbol 'oasis-render-init) (api/keyword :svg-elems) (api/symbol 'oasis-render-out) (api/keyword :drag) (api/symbol 'oasis-render-drag-out) (api/keyword :hover) (api/symbol 'oasis-render-hover-out)}) (api/keyword :sinks) (api/map {(api/keyword :svg-elems) (api/symbol 'oasis-render-out) + (api/keyword :kb) (api/symbol 'oasis-render-kb-out) (api/keyword :drag) (api/symbol 'oasis-render-drag-out) (api/keyword :hover) (api/symbol 'oasis-render-hover-out)})})) ]) @@ -3655,7 +3689,6 @@ (pipe 'oasis-render-in 'state-reduce) (pipe 'state-reduce 'condensed-state) - ;; (pipe 'oasis-render-mouse-in 'log-mouse2) ;; (pipe 'oasis-render-mouse-in 'oasis-render-mouse-out) ;; mouse handling @@ -3663,23 +3696,32 @@ (pipe 'mouse-reduce 'mouse-state) (pipe 'mouse-state 'filter-drag 'drag-events) - ;; (pipe 'drag-events 'filter-drag-end-or-start 'oasis-render-drag-out) ;; FIXME reduce + ;; (pipe 'drag-events 'log-mouse2) + + (pipe 'drag-events 'state-reduce) + (pipe 'drag-events 'filter-drag-end-or-start 'oasis-render-drag-out) ;; FIXME reduce (pipe 'mouse-state 'filter-scroll 'scroll-state) (pipe 'oasis-render-mouse-in 'target-reduce) (pipe 'target-reduce 'target-events) (pipe 'target-events 'only-different 'hover-events) - ;; (pipe 'hover-events 'tag-hover 'oasis-render-hover-out) + (pipe 'hover-events 'tag-hover 'hover-out) + (pipe 'hover-out 'oasis-render-hover-out) + ;; (pipe 'hover-out 'log-hov) ;; keyboard handling + ;; (pipe 'oasis-render-kb-in 'log-mouse2) + (pipe 'oasis-render-kb-in 'oasis-render-kb-out) + + (pipe 'oasis-render-kb-in 'filter-view 'view-commands) ;; view handling (pipe 'view-commands 'make-zoom) (pipe 'make-zoom 'zoom-events) - ;; (pipe 'zoom-events 'view-events) - ;; (pipe 'view-commands 'view-deltas) ;; FIXME + (pipe 'zoom-events 'view-events) + (pipe 'view-commands 'view-deltas) (pipe 'scroll-state 'construct-view 'view-deltas) (pipe 'view-deltas 'view-delta) @@ -3688,7 +3730,8 @@ (pipe 'view-reduce 'view-raw) (pipe 'view-raw 'tag-view 'view-state) ;; (pipe 'view-state 'log-view) - (pipe 'view-state 'state-reduce) + ;; (pipe 'view-state 'state-reduce) + (pipe 'view-state 'svg-elements-reduce) (pipe 'oasis-render-init 'init-view 'view-events) @@ -3712,7 +3755,7 @@ (def oasis-ui-defs [ - ;; (api/defexp 'ui-mod (api/fn-call (api/symbol 'modules/ui) [(api/integer 2)])) + ;; (api/defexp 'ui-mod (api/fn-call (api/symbol 'modules/ui) [])) ;; (api/defexp 'm-ui (api/fn-call (api/symbol 'ui-mod) [])) ;; (defncall 'm-ui-kb '-> @@ -3725,6 +3768,11 @@ ;; (api/key-fn :sources) ;; (api/key-fn :mouse)) ;; (defncall 'oasis-ui-mod-mouse 'm-ui-mouse) + ;; (defncall 'm-ui-events '-> + ;; (api/symbol 'm-ui) + ;; (api/key-fn :sources) + ;; (api/key-fn :events)) + ;; (defncall 'oasis-ui-mod-events 'm-ui-events) ;; (defncall 'm-ui-render '-> ;; (api/symbol 'm-ui) ;; (api/key-fn :sinks) @@ -3733,9 +3781,11 @@ (defncall 'oasis-ui-render 'pipes/ui (api/integer 2)) (defncall 'oasis-ui-events 'pipes/events (api/integer 2)) - (defncall 'oasis-ev 'pipes/debug) (defncall 'oasis-ui-mouse 'pipes/mouse) (defncall 'oasis-ui-kb 'pipes/keyboard) + (defncall 'oasis-ev 'pipes/debug) + (defncall 'oasis-ui-mouse-out 'pipes/debug) + (defncall 'oasis-ui-kb-out 'pipes/debug) (defncall 'oasis-ui-in 'pipes/debug) (defncall 'render 'pipes/debug ;; (api/keyword :oasis.spec/render) ) @@ -3758,15 +3808,18 @@ ;; (api/keyword :m-ui) (api/symbol 'm-ui) ;; (api/keyword :ui-mod) (api/symbol 'ui-mod) ;; (api/keyword :m-ui-kb) (api/symbol 'm-ui-kb) + ;;(api/keyword :mod-kb) (api/symbol 'oasis-ui-mod-kb) + ;;(api/keyword :mod-mouse) (api/symbol 'oasis-ui-mod-mouse) (api/keyword :kb) (api/symbol 'oasis-ui-kb) (api/keyword :mouse) (api/symbol 'oasis-ui-mouse) - ;; (api/keyword :m-ui-mouse) (api/symbol 'm-ui-mouse) - ;; (api/keyword :m-ui-render) (api/symbol 'm-ui-render) - ;; (api/keyword :oasis-ui-out) (api/symbol 'oasis-ui-out) + ;;(api/keyword :m-ui-mouse) (api/symbol 'm-ui-mouse) + ;;(api/keyword :m-ui-render) (api/symbol 'm-ui-render) + ;;(api/keyword :oasis-ui-out) (api/symbol 'oasis-ui-out) (api/keyword :events) (api/symbol 'oasis-ui-events) + ;;(api/keyword :events-mod) (api/symbol 'oasis-ui-mod-events) }) - (api/keyword :sinks) (api/map {(api/keyword :mouse) (api/symbol 'oasis-ui-mouse) - (api/keyword :kb) (api/symbol 'oasis-ui-kb) + (api/keyword :sinks) (api/map {(api/keyword :mouse) (api/symbol 'oasis-ui-mouse-out) + (api/keyword :kb) (api/symbol 'oasis-ui-kb-out) (api/keyword :events) (api/symbol 'oasis-ev) }) ;; (api/keyword :tests) (api/map {(api/keyword :t1) (api/map {(api/keyword :when) (api/map {(api/string "oasis-ui-in") (api/vector [(api/map {(api/keyword :header) @@ -3783,15 +3836,26 @@ ]) (def oasis-ui-net - [(pipe 'oasis-ui-in 'render) - ;; (pipe 'oasis-ui-in 'log-render2) + [ + (pipe 'oasis-ui-in 'render) (pipe 'render 'elements-reduce) (pipe 'elements-reduce 'reducer) (pipe 'reducer 'render-elements 'oasis-ui-render) (pipe 'oasis-ui-events 'oasis-ev) - (pipe 'oasis-ui-events 'log-render2) - ;; (pipe 'reducer 'render-elements 'log-render2) + + (pipe 'oasis-ui-mouse 'oasis-ui-mouse-out) + (pipe 'oasis-ui-kb 'oasis-ui-kb-out) + + ;; (pipe 'oasis-ui-in 'render) + ;; (pipe 'render 'elements-reduce) + ;; (pipe 'elements-reduce 'reducer) + + ;; (pipe 'reducer 'render-elements 'oasis-ui-render) + ;; (pipe 'oasis-ui-events 'oasis-ev) + ;; (pipe 'oasis-ui-events 'log-render2) + ;; ;; (pipe 'oasis-ui-render 'log-render2) + ;; ;; (pipe 'reducer 'render-elements 'log-render2) ]) (def oasis-module-defs @@ -3836,6 +3900,11 @@ (api/key-fn :sources) (api/key-fn :mouse)) (defncall 'render-mouse-in 'm-r-mouse-fn) + (defncall 'm-r-kb-fn '-> + (api/symbol 'm-render) + (api/key-fn :sources) + (api/key-fn :kb)) + (defncall 'render-kb-in 'm-r-kb-fn) (defncall 'm-elems-fn '-> (api/symbol 'm-render) (api/key-fn :sinks) @@ -3851,6 +3920,11 @@ (api/key-fn :sinks) (api/key-fn :drag)) (defncall 'render-drag-out 'm-ro-drag-fn) + (defncall 'm-ro-kb-fn '-> + (api/symbol 'm-render) + (api/key-fn :sinks) + (api/key-fn :kb)) + (defncall 'render-kb-out 'm-ro-kb-fn) (defncall 'm-core-mod 'oasis-core) (defncall 'm-core 'm-core-mod) @@ -3907,10 +3981,12 @@ ;(api/keyword :module-core-kb-in) (api/symbol 'core-kb-in) ;(api/keyword :module-core-drag-in) (api/symbol 'core-drag-in) ;(api/keyword :module-core-scroll-in) (api/symbol 'core-scroll-in) - ;(api/keyword :module-core-hover-in) (api/symbol 'core-hover-in) + (api/keyword :module-core-hover-in) (api/symbol 'core-hover-in) (api/keyword :module-render-state) (api/symbol 'render-state) (api/keyword :module-render-init) (api/symbol 'render-init) (api/keyword :module-render-mouse-in) (api/symbol 'render-mouse-in) + (api/keyword :module-render-kb-in) (api/symbol 'render-kb-in) + (api/keyword :module-render-kb-out) (api/symbol 'render-kb-out) (api/keyword :module-render-drag-out) (api/symbol 'render-drag-out) (api/keyword :module-render-hover-out) (api/symbol 'render-hover-out) (api/keyword :module-render-out) (api/symbol 'render-elems) @@ -3948,13 +4024,12 @@ ;; (pipe 'render-elems 'log-render) (pipe 'render-elems 'ui-render) - (pipe 'oasis-keyboard 'core-kb-in) + (pipe 'oasis-keyboard 'render-kb-in) + (pipe 'render-kb-out 'core-kb-in) (pipe 'oasis-bug 'render-mouse-in) (pipe 'render-drag-out 'core-drag-in) (pipe 'render-hover-out 'core-hover-in) ;; (pipe 'render-drag-out 'log-foo) - ;; (pipe 'render-hover-out 'log-foo) - ;; (pipe 'render-mouse-out 'log-foo) (pipe 'oasis-events 'core-events-in) (pipe 'oasis-events 'log-state) ]) diff --git a/ui_src/samak/ui_stdlib.cljs b/ui_src/samak/ui_stdlib.cljs index 3159406..9d36f54 100644 --- a/ui_src/samak/ui_stdlib.cljs +++ b/ui_src/samak/ui_stdlib.cljs @@ -84,9 +84,9 @@ (defn events [n] (let [c (chan) + init (atom true) elem (if n (js/document.getElementById (str "samak" n)) (.-body js/document)) bound (.getBoundingClientRect elem)] - (println "foobar: " n) (set! (.-onresize js/window) (fn [e] (do (println "rez: " n) (put-meta! c (let [event (js->clj e :keywordize-keys true)] @@ -98,8 +98,31 @@ ::view) (println "EVS: " n) false))) + (when @init + (reset! init false) + (put-meta! c + {:data :resize + :width (.-clientWidth (.-documentElement js/document)) + :height (.-clientHeight (.-documentElement js/document))} + ::view)) (pipes/source c))) +(def content (atom nil)) + +(defn render-cb + "" + [node] + (r/render @content node) + (reset! content nil)) + +(defn render + "" + [node x events c] + (if (not @content) + (helpers/debounce #(render-cb node))) + (reset! content (if events (transform-element x c) x))) + + (defn ui ([n] (ui n false)) ;;FIXME @@ -114,7 +137,7 @@ (if true ;; (s/valid? ::hiccup x) (when-let [node (js/document.getElementById (str "samak" n))] ;; (when n (.warn js/console (str "render " n " - " x))) - (r/render (if events (transform-element x ui-out) x) node)) + (render node x events ui-out)) (.warn js/console (str "invalid " n " - " (expound/expound-str ::hiccup x) "for" x)))) (when @init (reset! init false) @@ -124,15 +147,15 @@ :height (.-clientHeight (.-documentElement js/document))} ::view)) (recur))) - (set! (.-onresize js/window) - (fn [e] (do (put-meta! ui-out (let [event (js->clj e :keywordize-keys true)] - {:data :resize - :width (.-clientWidth (.-documentElement js/document)) - :height (.-clientHeight (.-documentElement js/document)) - :samak.view/target (.-id (.-target event))} - ) - ::view) - false))) + ;; (set! (.-onresize js/window) + ;; (fn [e] (do (println "uires")(put-meta! ui-out (let [event (js->clj e :keywordize-keys true)] + ;; {:data :resize + ;; :width (.-clientWidth (.-documentElement js/document)) + ;; :height (.-clientHeight (.-documentElement js/document)) + ;; :samak.view/target (.-id (.-target event))} + ;; ) + ;; ::view) + ;; false))) (pipes/pipe ui-in ui-out)))) (defn translate-coords @@ -216,12 +239,12 @@ (pipes/source c))) (defn ui-module - [id] + [] (println "init ui") (fn [] (let [xid 2 - render (ui id true) - m (mouse id)] + render (ui xid true) + m (mouse xid)] (println "start ui:" m) {:sources {:events render :mouse m diff --git a/ui_src/samak/worker.cljc b/ui_src/samak/worker.cljc index 5c5f745..e6e00e9 100644 --- a/ui_src/samak/worker.cljc +++ b/ui_src/samak/worker.cljc @@ -99,7 +99,7 @@ (when (= :samak.runtime/paket (:samak.runtime/type p)) (when-let [pipe (get-named-pipe-memo rt (:samak.runtime/target p))] (pipes/fire-raw! pipe content)) - (trace/trace ::render-in + (trace/trace ::worker-in (helpers/duration before (helpers/now)) content))) (recur))) From e14349b22385b2e84802cbb592e2e41f27d43c35 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Tue, 6 Oct 2020 22:06:34 +0200 Subject: [PATCH 07/12] repair create sink & hover --- ui_src/samak/caravan.cljc | 53 +++++++++--------- ui_src/samak/oasis.cljc | 111 +++++++++++++++++++++++++++----------- 2 files changed, 105 insertions(+), 59 deletions(-) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 8586c41..1c82b49 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -222,6 +222,7 @@ :caravan/id sym :caravan/name (:samak.nodes/name fn) :caravan/ast ast}}))) + (defn add-node "" [sym fn] @@ -540,16 +541,16 @@ (defn create-sink "" - [] - (fn [x] - (println "create sink: " x) - (let [pipe-name (:name x) - sym (str pipe-name "-" (rand-int 1000000000)) - exp (api/defexp (symbol sym) (api/fn-call (api/symbol (symbol (str "pipes/" pipe-name))) nil)) - ast (single! exp)] - (println (str "res: " ast)) - ;; (notify-source ev (add-node (symbol sym) ast)) ;; FIXME - :okay))) + [cmd ev x] + (println "create sink: " x) + (let [pipe-name (:name x) + sym (str pipe-name "-" (rand-int 1000000000)) + exp (api/defexp (symbol sym) (api/fn-call (api/symbol (symbol (str "pipes/" pipe-name))) nil)) + ast (single! exp)] + (println (str "res: " ast)) + (notify-source ev (add-node (:db/id ast) ast)) ;; FIXME + (println (str "res: " ast)) + ::okay)) (defn disconnect "" @@ -571,17 +572,16 @@ (defn link "" - [] - (fn [{:keys [:source :sink] :as x}] - (println "connect: " x) - (let [connector (str "c-" source "-" sink) - pipe-key (make-pipe-key source connector sink) - existing (contains? @net pipe-key)] - (when (and sink source (not= sink source) ) - (if existing - (disconnect) - ;; (connect ev source connector sink) ;; FIXME - ))))) + [ev cmd {:keys [:source :sink] :as x}] + (println "connect: " x) + (let [connector (str "c-" source "-" sink) + pipe-key (make-pipe-key source connector sink) + existing (contains? @net pipe-key)] + (when (and sink source (not= sink source) ) + (if existing + (disconnect) + (connect ev source connector sink) + )))) (defn link-pipes "" @@ -926,17 +926,18 @@ caravan-eval (chan)] (go-loop [] (when-let [x ( (api/key-fn :name) (api/map {(api/keyword :command) (api/keyword :create-sink) + (api/keyword :type) (api/keyword :immediate) (api/keyword :data) (api/map {(api/keyword :name) (api/symbol '_)})})) (defncall 'is-source '-> @@ -675,15 +676,15 @@ (defncall 'handle-mouse-connect '-> (api/map {(api/keyword :command) (api/keyword :connect) + (api/keyword :type) (api/keyword :immediate) (api/keyword :data) (api/map {(api/keyword :source) (api/fn-call (api/symbol '->) [(api/key-fn :source) (api/symbol 'get-pipe-name)]) (api/keyword :sink) (api/fn-call (api/symbol '->) [(api/key-fn :target) (api/symbol 'get-pipe-name)])})})) (defncall 'is-pipe '-> - (api/fn-call (api/symbol 'str-index) [(api/string "pipe/") (api/symbol '_)]) + (api/fn-call (api/symbol 'str-index) [(api/string "d/") (api/symbol '_)]) ;;d/pipe? (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 0)])) (defncall 'is-source-source '-> - (api/fn-call (api/symbol 'spy) [(api/string "source")]) (api/key-fn :source) (api/symbol 'is-pipe)) @@ -811,8 +812,7 @@ (defncall 'handle-create-sink '-> (api/key-fn :data) - (api/fn-call (api/symbol 'create-sink) []) - (api/map {(api/keyword :result) (api/symbol '_)})) + (api/map {(api/keyword :create-sink) (api/symbol '_)})) (defncall 'is-connect '-> (api/key-fn :command) @@ -820,8 +820,8 @@ (defncall 'handle-connect '-> (api/key-fn :data) - (api/fn-call (api/symbol 'connect) []) - (api/map {(api/keyword :result) (api/symbol '_) + (api/map {(api/keyword :connect) (api/symbol '_) + (api/keyword :type) (api/keyword :immediate) (api/keyword :mode) (api/keyword :back)})) (defncall 'is-select '-> @@ -1001,6 +1001,7 @@ (api/key-fn :caravan/id)) (defncall 'detect-pipe-node '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "detect")]) (api/key-fn :caravan/type) (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/sink)])) @@ -1477,16 +1478,16 @@ (api/fn-call (api/symbol 'spy) [(api/string "fscope")]) ) - ;; (defncall 'merge-defs '-> - ;; (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) - ;; (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) + (defncall 'merge-defs '-> + (api/map {(api/keyword :def) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) + (api/keyword :context) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})) - ;; (defncall 'format-defs '-> - ;; (api/fn-call (api/symbol 'myzip) [(api/key-fn :defs) - ;; (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :defs)]) - ;; (api/key-fn :context)])]) - ;; (api/fn-call (api/symbol 'map) [(api/symbol 'merge-defs) (api/symbol '_)]) - ;; (api/fn-call (api/symbol 'map) [(api/symbol 'format-def) (api/symbol '_)])) + (defncall 'format-defs '-> + (api/fn-call (api/symbol 'myzip) [(api/key-fn :defs) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol 'count) [(api/key-fn :defs)]) + (api/key-fn :context)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-defs) (api/symbol '_)]) + (api/fn-call (api/symbol 'map) [(api/symbol 'format-def) (api/symbol '_)])) ;; (defncall 'format-pipes '-> ;; (api/fn-call (api/symbol 'spy) [(api/string "freepipe")]) @@ -1506,7 +1507,7 @@ ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) (api/map {(api/keyword :id) (api/string "root") (api/keyword :layoutOptions) (api/map {(api/string "elk.algorithm") (api/string "layered")}) - (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules)]) + (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules) (api/symbol 'format-defs)]) ;; (api/keyword :edges) (api/symbol 'format-pipes) })) @@ -1658,6 +1659,32 @@ (api/keyword :arguments) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :load)])})})})) + (defncall 'should-create '-> + (api/key-fn :next) + (api/key-fn :command) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :create-sink)])) + + (defncall 'create '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/map {(api/keyword :call) + (api/map {(api/keyword :action) + (api/keyword :create-sink) + (api/keyword :arguments) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})) + + (defncall 'should-connect '-> + (api/key-fn :next) + (api/key-fn :command) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :connect)])) + + (defncall 'link '-> + (api/map {(api/keyword :state) (api/key-fn :state) + (api/keyword :next) (api/map {(api/keyword :call) + (api/map {(api/keyword :action) + (api/keyword :link) + (api/keyword :arguments) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})) + (defncall 'should-test '-> (api/key-fn :next) (api/key-fn :data) @@ -1749,6 +1776,12 @@ (api/fn-call (api/symbol 'incase) [(api/symbol 'should-load) (api/symbol 'load)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'should-create) + (api/symbol 'create)]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'should-connect) + (api/symbol 'link)]) + ;; (api/fn-call (api/symbol 'incase) [(api/symbol 'should-load) + ;; (api/symbol 'load)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'should-test) (api/symbol 'test)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'should-trace) @@ -1963,7 +1996,7 @@ ;; (pipe 'select-events 'editor-commands) - ;; (pipe 'caravan-eval 'log-caravan-ev) + (pipe 'caravan-eval 'log-caravan-ev) (pipe 'caravan-eval 'eval-events) ;; (pipe 'eval-events 'log-events) @@ -2310,12 +2343,19 @@ (defncall 'filter-scroll 'only (api/fn-call (api/symbol 'and) [(api/symbol 'is-scroll) (api/symbol 'is-drag-or-end)])) - (defncall 'make-target-hover '-> + (defncall 'split-target-hover '-> (api/fn-call (api/symbol 'str-split) [(api/symbol '_) (api/string "/")]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-valid-target) (api/map {(api/keyword :type) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 0)]) (api/keyword :name) (api/fn-call (api/symbol 'nth) [(api/symbol '_) (api/integer 1)])})])) + (defncall 'make-target-hover '-> + (api/map {(api/keyword :split) (api/symbol 'split-target-hover) + (api/keyword :orig) (api/symbol '_)}) + (api/map {(api/keyword :type) (api/fn-call (api/symbol '->) [(api/key-fn :split) (api/key-fn :type)]) + (api/keyword :name) (api/fn-call (api/symbol '->) [(api/key-fn :split) (api/key-fn :name)]) + (api/keyword :id) (api/key-fn :orig)})) + (defncall 'target-reduce 'pipes/reductions (api/fn-call (api/symbol '->) [ @@ -2326,9 +2366,11 @@ (api/key-fn :samak.mouse/target) (api/symbol 'make-target-hover)])})]) (api/map {(api/keyword :current) (api/map {(api/keyword :type) (api/string "none") - (api/keyword :name) (api/string "none")}) + (api/keyword :name) (api/string "none") + (api/keyword :id) (api/string "none")}) (api/keyword :prev) (api/map {(api/keyword :type) (api/string "none") - (api/keyword :name) (api/string "none")})})) + (api/keyword :name) (api/string "none") + (api/keyword :id) (api/string "none")})})) (defncall 'target-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) ) @@ -2556,7 +2598,7 @@ (api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hover) (api/key-fn :current) - (api/vector [(api/key-fn :type) (api/key-fn :name)])])]) + (api/vector [(api/key-fn :type) (api/key-fn :id)])])]) (api/fn-call (api/symbol '->) [(api/fn-call (api/symbol 'distinct) [(api/symbol '_)]) (api/fn-call (api/symbol 'count) [(api/symbol '_)]) (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])) @@ -2795,6 +2837,7 @@ (api/symbol 'is-same)) (defncall 'is-hovered '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "hovered")]) (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])]) (api/symbol 'is-same)) @@ -3137,13 +3180,13 @@ (api/keyword :expanded) (api/fn-call (api/symbol '>) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :view) (api/key-fn :zoom)]) (api/integer 1)])}) (api/symbol 'graph-func-single)])]) - ;; (api/fn-call (api/symbol 'incase) [(api/symbol 'is-hovered) (api/vector [(api/keyword :g) - ;; (api/map {(api/keyword :filter) (api/string "url(#blur)") - ;; (api/keyword :opacity) (api/string "0.6") - ;; (api/keyword :transform) - ;; (api/fn-call (api/symbol '->) [(api/key-fn :node) - ;; (api/symbol 'translate-blur)])}) - ;; (api/symbol 'graph-func-single)])]) + (api/fn-call (api/symbol 'incase) [(api/symbol 'is-hovered) (api/vector [(api/keyword :g) + (api/map {(api/keyword :filter) (api/string "url(#blur)") + (api/keyword :opacity) (api/string "0.6") + (api/keyword :transform) + (api/fn-call (api/symbol '->) [(api/key-fn :node) + (api/symbol 'translate-blur)])}) + (api/symbol 'graph-func-single)])]) ;; (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol 'and) [(api/symbol 'is-hovered) ;; (api/fn-call (api/symbol '->) [(api/key-fn :context) ;; (api/symbol 'is-change-navigate)])]) @@ -3228,6 +3271,7 @@ (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])])) (defncall 'is-dragging '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "dragging")]) (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :editor) (api/key-fn :mode)]) (api/keyword :navigate)]) (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :editor) (api/key-fn :activity)]) @@ -3243,10 +3287,11 @@ (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/sink)])) (defncall 'is-pipe-hovered '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "hover")]) (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :type)]) - (api/string "pipe")]) - (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])])) + (api/string "d")]) + (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :id)]) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)])])])) (defncall 'graph-pipe '-> (api/map {(api/keyword :node) (api/key-fn :node) @@ -3363,7 +3408,8 @@ (defncall 'is-pipe-node '-> (api/key-fn :node) (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")])) + (api/fn-call (api/symbol 'or) [(api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")]) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/sink)])])) (defncall 'is-func-node '-> (api/key-fn :node) @@ -3543,6 +3589,7 @@ (defncall 'graph-drag '-> + ;; (api/fn-call (api/symbol 'spy) [(api/string "drag")]) (api/map {(api/keyword :graph-drag) (api/fn-call (api/symbol 'if) [(api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :editor) (api/key-fn :activity)]) (api/keyword :dragging)]) From 8bd058d75e0a57d7eaf2e1ca1474f00a61451bf3 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Wed, 14 Oct 2020 23:27:34 +0200 Subject: [PATCH 08/12] base module; linking & adding sinks to module --- src/samak/api.cljc | 4 + src/samak/code_db.cljc | 2 - src/samak/helpers.cljc | 4 + src/samak/scheduler.cljc | 17 ++-- ui_src/samak/caravan.cljc | 164 ++++++++++++++++++++++++++------------ ui_src/samak/oasis.cljc | 15 ++-- 6 files changed, 145 insertions(+), 61 deletions(-) diff --git a/src/samak/api.cljc b/src/samak/api.cljc index a7542cd..260f1b9 100644 --- a/src/samak/api.cljc +++ b/src/samak/api.cljc @@ -20,6 +20,10 @@ #:samak.nodes{:type :samak.nodes/fn-ref :fn [:samak.nodes/name identifier]}) +(defn id-ref [identifier] + #:samak.nodes{:type :samak.nodes/fn-ref + :fn {:db/id identifier}}) + (defn pipe ([from to] #:samak.nodes {:type :samak.nodes/pipe diff --git a/src/samak/code_db.cljc b/src/samak/code_db.cljc index 7a5319e..4f5158a 100644 --- a/src/samak/code_db.cljc +++ b/src/samak/code_db.cljc @@ -147,8 +147,6 @@ "loads a network given a source entity id from the database" [db id loaded] (if (contains? loaded id) - ;; (println "!!!!!!!!!!!!!!!!!!!!!") - ;; FIXME {} (let [ast (load-by-id db id) subs (mapv :db/id (find-links-from db id)) diff --git a/src/samak/helpers.cljc b/src/samak/helpers.cljc index 8ec1511..21d8524 100644 --- a/src/samak/helpers.cljc +++ b/src/samak/helpers.cljc @@ -113,3 +113,7 @@ [f] #?(:cljs (goog.async.nextTick f) :clj (f))) + +(defn str-to-int [s] + #?(:clj (try (Integer/parseInt s) (catch Exception e nil)) + :cljs (js/parseInt s))) diff --git a/src/samak/scheduler.cljc b/src/samak/scheduler.cljc index 11b0270..813fb7b 100644 --- a/src/samak/scheduler.cljc +++ b/src/samak/scheduler.cljc @@ -59,18 +59,25 @@ ) -(defn load-bundle +(defn load-bundle-by-id "" - [rt sym] - (let [_ (print " V" "Fetching bundle from DB:" sym) - bundle-id (run/resolve-name rt sym) - _ (print " V" "Bundle id:" bundle-id) + [rt bundle-id] + (let [_ (print " V" "Bundle id:" bundle-id) bundle (get (run/load-bundle rt bundle-id) bundle-id) _ (println "bundle: " bundle) deps (load-deps rt [bundle-id bundle])] deps )) +(defn load-bundle + "" + [rt sym] + (let [_ (print " V" "Fetching bundle from DB:" sym) + bundle-id (run/resolve-name rt sym) + deps (load-bundle-by-id rt bundle-id)] + deps + )) + (defn eval-module "" [rt conf module root] diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 1c82b49..fc9b788 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -539,49 +539,6 @@ (notify-source ev (add-node (symbol sym) exp)) :done))))))) -(defn create-sink - "" - [cmd ev x] - (println "create sink: " x) - (let [pipe-name (:name x) - sym (str pipe-name "-" (rand-int 1000000000)) - exp (api/defexp (symbol sym) (api/fn-call (api/symbol (symbol (str "pipes/" pipe-name))) nil)) - ast (single! exp)] - (println (str "res: " ast)) - (notify-source ev (add-node (:db/id ast) ast)) ;; FIXME - (println (str "res: " ast)) - ::okay)) - -(defn disconnect - "" - [] - (println "disconnect")) - -(defn connect - "" - [ev source connector sink] - ;; (println (str "connect " source " with " connector " to " sink)) - (let [fn (api/defexp (symbol connector) (api/symbol '_)) - fn-ast (single! fn) - pipe (api/pipe (api/symbol (symbol source)) - (api/symbol (symbol connector)) - (api/symbol (symbol sink)))] - (notify-source ev (add-node (symbol connector) fn-ast)) - (notify-source ev (add-pipe pipe)))) - - -(defn link - "" - [ev cmd {:keys [:source :sink] :as x}] - (println "connect: " x) - (let [connector (str "c-" source "-" sink) - pipe-key (make-pipe-key source connector sink) - existing (contains? @net pipe-key)] - (when (and sink source (not= sink source) ) - (if existing - (disconnect) - (connect ev source connector sink) - )))) (defn link-pipes "" @@ -726,8 +683,8 @@ (defn eval-bundle "" - [sym] - (let [bundle (sched/load-bundle @rt-conn sym) + [id] + (let [bundle (sched/load-bundle-by-id @rt-conn id) _ (println "ev b" bundle) roots (:roots bundle) deps (handle-deps (:deps bundle)) @@ -740,6 +697,7 @@ (assoc a1 :id (:id bundle)) )) + (defn test-bundle "" [sym test] @@ -827,8 +785,8 @@ (defn load-lib "" - [cmd ev sym] - (let [bundle (eval-bundle sym)] + [cmd ev bundle-id] + (let [bundle (eval-bundle bundle-id)] ;; (println (str "count: " cnt)) (doall (map #(notify-source ev %) (:modules bundle))) (doall (map #(notify-source ev %) (:nodes bundle))) @@ -838,11 +796,18 @@ {::state ::done} #(a/put! cmd (pipes/make-paket {::event ::load ::status ::done ::percent 100 ::id (:id bundle)} ::caravan))))) +(defn load-bundle + "" + [cmd ev sym] + (let [bundle-id (rt/resolve-name @rt-conn sym)] + (load-lib cmd ev bundle-id))) + + (defn load-net "" [cmd ev prog sym] (persist-net prog) - (helpers/debounce #(load-lib cmd ev sym))) + (helpers/debounce #(load-bundle cmd ev sym))) (defn test-net "" @@ -862,6 +827,25 @@ (load-net cmd ev test-programs/test-nested-modules-test 'baz) ) + +(def base-module + [ + "(def in (pipes/debug))" + "(def out (pipes/debug))" + "(def foo (pipes/debug))" + "(defmodule base {:sinks {:in in} + :sources {:in in :out out :foo foo}})" + "(| in out)" + "(def base-mod (base))" + ]) + + +(defn load-base + "" + [cmd ev] + (load-net cmd ev base-module 'base) + ) + (defn test-chuck "" [c] @@ -881,10 +865,92 @@ "" [cmd ev arg] (case arg - :load (load-test cmd ev) + :test (load-test cmd ev) + :base (load-base cmd ev) :self (load-oasis cmd ev) (tools/log "load unknown: " arg))) +(defn disconnect + "" + [] + (println "disconnect")) + +(defn connect + "" + [ev source connector sink] + ;; (println (str "connect " source " with " connector " to " sink)) + (let [fn (api/defexp (symbol connector) (api/symbol '_)) + fn-ast (single! fn) + pipe (api/pipe (api/id-ref (helpers/str-to-int source)) + (api/symbol (symbol connector)) + (api/id-ref (helpers/str-to-int sink))) + pipe-ast (single! pipe)] + (notify-source ev (add-node (symbol connector) fn-ast)) + (notify-source ev (add-pipe pipe-ast)))) + +(defn get-smap-key + "" + [key e] + (do + (println "lu" key (:samak.nodes/value (:samak.nodes/mapkey e))) + (= key (:samak.nodes/value (:samak.nodes/mapkey e))))) + + +(defn get-in-smap + "" + [smap key] + (println "get" smap key) + (let [mv (:samak.nodes/mapkv-pairs smap)] + (println "mv" mv) + (first (filter #(get-smap-key key %) mv)))) + + +(defn smap-find + "" + [smap keys] + (println "smapu" smap keys) + (let [val (get-in-smap smap (first keys)) + more (next keys)] + (if more + (smap-find val more) + val))) + + +(defn create-sink + "" + [cmd ev {scope :scope {pipe-name :name} :args :as x}] + (println "create sink: " x) + (let [sym (str pipe-name "-" (rand-int 1000000000)) + exp (api/defexp (symbol sym) (api/fn-call (api/symbol (symbol (str "pipes/" pipe-name))) nil)) + ast (single! exp) + mod (load-ast @rt-conn scope) + _ (println (str "mod: " mod)) + bucket (:samak.nodes/mapvalue (smap-find (:samak.nodes/definition mod) [:sources])) + _ (println (str "bucket: " bucket)) + modded (update bucket :samak.nodes/mapkv-pairs conj {:samak.nodes/mapkey (api/keyword (keyword pipe-name)) + :samak.nodes/mapvalue (api/symbol (symbol sym))}) + _ (println (str "modded: " modded)) + mod-alt (persist! @rt-conn [modded])] + (println (str "res: " ast)) + (notify-source ev (add-node (:db/id ast) ast)) ;; FIXME + (println (str "res: " ast)) + (load-lib cmd ev (helpers/str-to-int scope)) + )) + + +(defn link + "" + [cmd ev {scope :scope {:keys [:source :sink]} :args :as x}] + (println "connect: " x) + (let [connector (str "c-" source "-" sink) + pipe-key (make-pipe-key source connector sink) + existing (contains? @net pipe-key)] + (when (and sink source (not= sink source) ) + (if existing + (disconnect) + (connect ev source connector sink)) + (load-lib cmd ev (helpers/str-to-int scope))))) + (defn oasis-hook "" diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index eb2ae13..c4b5d00 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -555,7 +555,7 @@ (api/map {(api/keyword :command) (api/keyword :load) (api/keyword :type) (api/keyword :immediate) (api/keyword :data) (api/keyword :load) - (api/keyword :load) (api/keyword :load)})) + (api/keyword :load) (api/keyword :base)})) (defncall 'is-kb-self '-> (api/key-fn :key) @@ -1507,7 +1507,8 @@ ;; (api/fn-call (api/symbol 'spy) [(api/string "fmod")]) (api/map {(api/keyword :id) (api/string "root") (api/keyword :layoutOptions) (api/map {(api/string "elk.algorithm") (api/string "layered")}) - (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules) (api/symbol 'format-defs)]) + (api/keyword :children) (api/fn-call (api/symbol 'into) [(api/symbol 'format-modules) ;; (api/symbol 'format-defs) + ]) ;; (api/keyword :edges) (api/symbol 'format-pipes) })) @@ -1670,7 +1671,8 @@ (api/map {(api/keyword :action) (api/keyword :create-sink) (api/keyword :arguments) - (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})) + (api/map {(api/keyword :scope) (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mode) (api/key-fn :scope)]) + (api/keyword :args) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})})) (defncall 'should-connect '-> (api/key-fn :next) @@ -1678,12 +1680,15 @@ (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :connect)])) (defncall 'link '-> + (api/fn-call (api/symbol 'spy) [(api/string "link")]) (api/map {(api/keyword :state) (api/key-fn :state) (api/keyword :next) (api/map {(api/keyword :call) (api/map {(api/keyword :action) (api/keyword :link) - (api/keyword :arguments) - (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})) + (api/keyword :arguments) (api/map {(api/keyword :scope) + (api/fn-call (api/symbol '->) [(api/key-fn :state) (api/key-fn :mode) (api/key-fn :scope)]) + (api/keyword :args) + (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :data)])})})})})) (defncall 'should-test '-> (api/key-fn :next) From 05da93c3a57c43f65d1f4c7cbca286e841646d71 Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Sun, 18 Oct 2020 19:48:38 +0200 Subject: [PATCH 09/12] fix highlight --- ui_src/samak/caravan.cljc | 2 +- ui_src/samak/oasis.cljc | 40 +++++++++++++++++++++------------------ 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index fc9b788..fbb2946 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -854,7 +854,7 @@ (defn load-oasis "" [cmd ev] - (helpers/debounce #(load-lib cmd ev 'oasis))) + (helpers/debounce #(load-bundle cmd ev 'oasis))) (defn test-oasis "" diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index c4b5d00..fe76f72 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -636,7 +636,7 @@ (defncall 'is-func '-> (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "func")])) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "d")])) ;;FIXME? (defncall 'handle-func '-> (api/key-fn :name) @@ -644,6 +644,7 @@ (api/keyword :data) (api/fn-call (api/symbol 'str) [(api/string "func/")(api/symbol '_)])})) (defncall 'handle-mouse-click '-> + (api/fn-call (api/symbol 'spy) [(api/string "lmb")]) (api/key-fn :source) (api/symbol 'make-target) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-source) @@ -1072,7 +1073,7 @@ (defncall 'process-scope '-> (api/map {(api/keyword :state) (api/key-fn :state) - (api/keyword :next) (api/map {(api/keyword :mode) (api/keyword :back) + (api/keyword :next) (api/map {(api/keyword :mode) (api/keyword :navigate) (api/keyword :scope) (api/fn-call (api/symbol '->) [(api/key-fn :next) (api/key-fn :scope)])})}) (api/fn-call (api/symbol 'spy) [(api/string "scope")]) ) @@ -2130,6 +2131,7 @@ (api/keyword :pipe-stroke) (api/string "#a6a28c") (api/keyword :pipe-drag) (api/string "#b65611") (api/keyword :module-bg) (api/string "#6684e1") + (api/keyword :module-border) (api/string "#1fad83") (api/keyword :edge-in) (api/string "#6684e1") (api/keyword :edge-out) (api/string "#b65611") (api/keyword :edge-neutral) (api/string "#a6a28c") @@ -2842,9 +2844,8 @@ (api/symbol 'is-same)) (defncall 'is-hovered '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "hovered")]) - (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :name)]) - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])]) + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :id)]) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)])]) (api/symbol 'is-same)) (defncall 'cell-y '-> @@ -3276,23 +3277,24 @@ (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :name)])])])) (defncall 'is-dragging '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "dragging")]) - (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :editor) (api/key-fn :mode)]) + (api/key-fn :context) + (api/key-fn :editor) + (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/key-fn :mode) (api/keyword :navigate)]) - (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :editor) (api/key-fn :activity)]) + (api/fn-call (api/symbol '=) [(api/key-fn :activity) (api/keyword :dragging)])])) (defncall 'is-pipe-drag-begin '-> - (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :mouse) (api/key-fn :drag) (api/key-fn :source)]) - (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/symbol 'pipe-id)])])) + (api/vector [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :mouse) (api/key-fn :drag) (api/key-fn :source)]) + (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :id)])]) + (api/symbol 'is-same)) (defncall 'is-pipe-target '-> (api/key-fn :node) (api/key-fn :type) - (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :caravan/sink)])) + (api/fn-call (api/symbol '=) [(api/symbol '_) (api/string "sink")])) (defncall 'is-pipe-hovered '-> - ;; (api/fn-call (api/symbol 'spy) [(api/string "hover")]) (api/fn-call (api/symbol 'and) [(api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :type)]) (api/string "d")]) (api/fn-call (api/symbol '=) [(api/fn-call (api/symbol '->) [(api/key-fn :context) (api/key-fn :hovered) (api/key-fn :id)]) @@ -3387,8 +3389,7 @@ (api/keyword :fill-opacity) (api/float 0.4) (api/keyword :style) (api/map {(api/keyword :fill) (api/fn-call (api/symbol '->) [(api/keyword :module-bg) (api/symbol 'get-color)]) - (api/keyword :stroke) (api/symbol 'get-func-stroke) - (api/keyword :filter) (api/string "url(#shadow)") + (api/keyword :stroke) (api/fn-call (api/symbol '->) [(api/keyword :module-border) (api/symbol 'get-color)]) (api/keyword :pointer-events) (api/string "all")}) (api/keyword :rx) (api/integer 10) ;; (api/keyword :y) (api/fn-call (api/symbol '->) [(api/key-fn :node) (api/key-fn :y)]) @@ -3421,7 +3422,6 @@ (api/key-fn :value)) (defncall 'graph-inner '-> - (api/map {(api/keyword :node) (api/symbol '_)}) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-module) (api/symbol 'graph-module-stub)]) (api/fn-call (api/symbol 'incase) [(api/symbol 'is-pipe-node) @@ -3429,10 +3429,14 @@ (api/fn-call (api/symbol 'incase) [(api/symbol 'is-func-node) (api/symbol 'graph-func)])) - (defncall 'graph-module-elems '-> - (api/key-fn :node) - (api/key-fn :children) + (api/fn-call (api/symbol 'myzip) [(api/fn-call (api/symbol '->) [(api/key-fn :node) + (api/key-fn :children)]) + (api/fn-call (api/symbol 'repeat) [(api/fn-call (api/symbol '->) [(api/key-fn :node) + (api/key-fn :children) + (api/fn-call (api/symbol 'count) [(api/symbol '_)])]) + (api/key-fn :context)])]) + (api/fn-call (api/symbol 'map) [(api/symbol 'merge-node) (api/symbol '_)]) (api/fn-call (api/symbol 'map) [(api/symbol 'graph-inner) (api/symbol '_)]) (api/fn-call (api/symbol 'into) [(api/vector [(api/keyword :g) (api/map {(api/keyword :id) (api/string "inner")})]) (api/symbol '_)]) ) From 70be65cb006cba5f41c1e2bd9d16851cc2f7d5dc Mon Sep 17 00:00:00 2001 From: FossiFoo Date: Tue, 20 Oct 2020 21:25:09 +0200 Subject: [PATCH 10/12] try async promise-chan for storage --- dev_src/dev/core.cljs | 17 +-- dev_src/dev/render.cljc | 96 +++++++------- dev_src/dev/worker.cljs | 13 +- project.clj | 1 + src/samak/helpers.cljc | 19 +++ src/samak/pipes.cljc | 3 - src/samak/repl.cljc | 6 +- src/samak/runtime.cljc | 168 +++++++++++++------------ src/samak/runtime/servers.cljc | 1 - src/samak/runtime/stores.cljc | 143 +++++++++++++++++++-- src/samak/scheduler.cljc | 92 +++++++------- src/samak/stdlib.cljc | 18 --- src/samak/trace.cljc | 28 +++-- ui_src/samak/caravan.cljc | 223 ++++++++++++++++----------------- ui_src/samak/worker.cljc | 62 +++++---- 15 files changed, 528 insertions(+), 362 deletions(-) diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index 0d6213b..ee38f78 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -3,6 +3,7 @@ [clojure.core.async :as a :refer [! chan close! put!]] [cognitect.transit :as t] [metosin.transit.dates :as d] + [promesa.core :as p] [dev.render :as render] [samak.runtime :as run] [samak.helpers :as helpers] @@ -53,26 +54,28 @@ (def json-reader (t/reader :json {:handlers d/readers})) (defn make-handler "" - [load in] + [load in out] (fn [event] (let [data (t/read json-reader (.-data event))] ;; (println "recv from w" data) (condp = (:target data) + :bootstrap (put! out :init) :load (put! load (:data data)) (put! in data))))) + (defn init "" [] - (println "start") - (let [in (chan) - out (chan)] - (let [w (js/Worker. "/js/oasis-worker.js") + (p/let [in (chan) + out (chan) loading (chan)] - (handle-update loading #(start-main loading in out)) - (aset w "onmessage" (make-handler loading in)) + (render/start-render-runtime loading in out) + (let [w (js/Worker. "/js/oasis-worker.js")] (handle-send w out) + (aset w "onmessage" (make-handler loading in out)) + (handle-update loading #(render/start-main loading)) ) )) diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index fa80093..8d13f77 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -5,6 +5,7 @@ [clojure.string :as str] [clojure.edn :as edn] [clojure.core.async :as a :refer [! chan go go-loop close! put! pipe]] + [promesa.core :as prom] [samak.api :as api] [samak.helpers :as helpers] [samak.builtins :as builtins] @@ -22,6 +23,7 @@ [clojure.string :as str] [cljs.reader :as edn] [clojure.core.async :as a :refer [! chan close! put! pipe]] + [promesa.core :as prom] [samak.api :as api] [samak.helpers :as helpers] [samak.lisparser :as p] @@ -53,16 +55,17 @@ :url "/api/v2/"}}) (def tracer (atom {})) -(def main-conf {"oasis-core" {:depends {} - :sinks {:state (sched/make-pipe-id {:module :lone :type :sinks :name :state})} - :sources { - :init (sched/make-pipe-id {:module :lone :type :sources :name :init}) - :kb (sched/make-pipe-id {:module :lone :type :sources :name :kb}) - :drag (sched/make-pipe-id {:module :lone :type :sources :name :drag}) - :hover (sched/make-pipe-id {:module :lone :type :sources :name :hover}) - :events (sched/make-pipe-id {:module :lone :type :sources :name :events}) - } - }}) +(def main-conf {:id "rt-main" + :modules {"oasis-core" {:depends {} + :sinks {:state (sched/make-pipe-id {:module :lone :type :sinks :name :state})} + :sources { + :init (sched/make-pipe-id {:module :lone :type :sources :name :init}) + :kb (sched/make-pipe-id {:module :lone :type :sources :name :kb}) + :drag (sched/make-pipe-id {:module :lone :type :sources :name :drag}) + :hover (sched/make-pipe-id {:module :lone :type :sources :name :hover}) + :events (sched/make-pipe-id {:module :lone :type :sources :name :events}) + } + }}}) (defn handle-update @@ -75,24 +78,13 @@ (println msg p)) (recur)))) -(defn scheduler - [id] - (fn [broadcast] - (println "sched" id) - (let [to-rt (pipes/pipe (chan))] - ;; (handle-update (str id " out:") broadcast) - ;; (handle-update (str id " in:") to-rt) - to-rt))) - - -(defn fire-event-into-named-pipe - [rt pipe-name event] - (let [pipe (run/get-definition-by-name rt (symbol pipe-name))] - (if (pipes/pipe? pipe) - (do (let [arg (edn/read-string event)] - (pipes/fire! pipe arg pipe-name)) - {}) - (println (str "could not find pipe " pipe-name))))) +(def scheduler + (let [broadcast (pipes/pipe (chan)) + to-rt (pipes/pipe (chan) "worker-scheduler")] + (println "sched") + ;; (handle-update "out" broadcast) + ;; (handle-update "in" to-rt) + (fn [] [to-rt broadcast]))) (defn eval-test "" @@ -100,23 +92,19 @@ (let [code (str/join " " test-programs/tw) parsed (p/parse-all code)] (swap! rt #(reduce run/eval-expression! % (:value parsed))) - (fire-event-into-named-pipe @rt "in" "5"))) + (run/fire-into-named-pipe @rt 'in "5" 0))) (defn run-oasis "" - [rt] - (fire-event-into-named-pipe rt "oasis-init" "1") - (println "oasis started") + [] + + (prom/let [res (run/fire-into-named-pipe @rt 'oasis-init "1" 0)] + (println "oasis started: " res)) ;; (let [parsed [(api/defexp 'start (api/fn-call (api/symbol 'pipes/debug) []))]] ;; (doseq [expression parsed] ;; (caravan/repl-eval expression))) ) -(defn eval-oasis - [rt conf cb] - (let [net (sched/load-bundle @rt 'oasis)] - (helpers/debounce #(sched/eval-module rt conf net nil)))) - (defn get-named-pipe [rt pipe-name] (let [mod-name (sched/module-id (:module pipe-name)) @@ -151,25 +139,31 @@ (defn start-oasis "" [load] - (eval-oasis rt main-conf load) - (println "renderer started oasis") - (helpers/debounce #(run-oasis @rt))) - -(defn init-oasis + (println "loading oasis") + (prom/let [net (sched/load-bundle @rt 'oasis)] + (helpers/debounce + (fn [] + (prom/do! + (println "evaluating oasis") + (sched/eval-module rt main-conf net nil) + (println "renderer loaded oasis") + (helpers/debounce run-oasis)))))) + +(defn start-main "" [load] - (oasis/store (:store @rt)) (helpers/debounce #(start-oasis load))) (defn start-render-runtime "" [load in out] - (reset! rt (run/make-runtime renderer-symbols (scheduler "main") main-conf)) - (reset! tracer (trace/init-tracer @rt (:tracer config))) - (println "renderer started runtime" (:id @rt) @rt) - (helpers/debounce #(init-oasis load)) - - (pipes/link! (:broadcast @rt) (pipes/sink out)) - (pipes/link! (pipes/source in) (:scheduler @rt)) - ) + (prom/let [rt-inst (run/make-runtime renderer-symbols scheduler main-conf)] + (reset! rt rt-inst) + (println "persisting oasis") + (oasis/store (:store @rt)) + (println "persist done") + (pipes/link! (:broadcast @rt) (pipes/sink out)) + (pipes/link! (pipes/source in) (:scheduler @rt)) + (reset! tracer (trace/init-tracer @rt (:tracer config))) + (println "renderer started runtime" (:id @rt)))) diff --git a/dev_src/dev/worker.cljs b/dev_src/dev/worker.cljs index 1bdbed1..9ef3f64 100644 --- a/dev_src/dev/worker.cljs +++ b/dev_src/dev/worker.cljs @@ -24,6 +24,7 @@ (go-loop [] (let [p (! chan go go-loop close! put!]] + [promesa.core :as prom] [samak.lisparser :as p] [samak.oasis :as oasis] [samak.pipes :as pipes] @@ -23,6 +24,7 @@ [cljs.reader :as edn] [clojure.string :as str] [clojure.core.async :as a :refer [! chan close! put!]] + [promesa.core :as prom] [samak.lisparser :as p] [samak.oasis :as oasis] [samak.pipes :as pipes] @@ -65,8 +67,8 @@ (defn fire-event-into-named-pipe [pipe-name event] - (let [arg (edn/read-string event) - res (run/fire-into-named-pipe @rt (symbol pipe-name) arg *default-timeout*)] + (prom/let [arg (edn/read-string event) + res (run/fire-into-named-pipe @rt (symbol pipe-name) arg *default-timeout*)] (if (:error res) (println (:error res))))) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index ee3cefc..1c60002 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -3,7 +3,7 @@ (:clj [(:require [clojure.core.async :as a :refer [! chan go go-loop close! put!]] - [clojure.walk :as w] + [promesa.core :as p] [samak.runtime.stores :as stores] [samak.runtime.servers :as servers] [samak.helpers :as helpers] @@ -17,7 +17,7 @@ :cljs [(:require [clojure.core.async :as a :refer [! chan close! put!]] - [clojure.walk :as w] + [promesa.core :as p] [samak.runtime.stores :as stores] [samak.runtime.servers :as servers] [samak.helpers :as helpers] @@ -41,6 +41,8 @@ (servers/eval-ast server form)) server forms)) +(defn resolve-name [runtime sym] + (-> runtime :store (stores/resolve-name sym))) (defn load-by-id "" @@ -50,13 +52,12 @@ (defn load-ast "loads an ast given by its entity id from the database" [rt id] - (w/postwalk (fn [form] - (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) - (:db/id form))] - (load-by-id rt sub-id) - form)) - (load-by-id rt id))) - + (helpers/ppostwalk (fn [form] + (if-let [sub-id (when (and (map? form) (= (keys form) [:db/id])) + (:db/id form))] + (load-by-id rt sub-id) + form)) + (load-by-id rt id))) (defn cancel? "" @@ -156,37 +157,46 @@ ;; (println (str "used module: " module "->" evaled)) evaled))))) +(defn make-store-internal + "" + [conf inbound broadcast builtins] + (if conf + (stores/make-piped-store inbound broadcast) + (let [store (stores/make-local-store)] + (stores/load-builtins! store (keys builtins)) + (stores/serve-store store inbound broadcast)))) + + (defn make-runtime-internal "" - [scheduler conf] - (let [c (pipes/pipe (chan))] - {:id (str "rt-" (helpers/uuid)) - :store (stores/make-local-store) - :server (servers/make-local-server {:config conf + [scheduler conf builtins] + (let [[inbound broadcast] (scheduler)] + {:id (or (:id conf) (str "rt-" (helpers/uuid))) + :store (make-store-internal (:store conf) inbound broadcast builtins) + :server (servers/make-local-server {:config (:modules conf) :resolve resolve-fn :link link-fn :cancel? cancel? :module instanciate-module}) - :broadcast c - :scheduler (when scheduler (scheduler c))})) + :broadcast broadcast + :scheduler inbound})) (defn make-runtime ([] - (make-runtime nil nil)) + (make-runtime nil)) ([builtins] - (make-runtime builtins nil)) + (make-runtime builtins #([(pipes/pipe (chan)) (pipes/pipe (chan))]))) ([builtins scheduler] (make-runtime builtins scheduler {})) ([builtins scheduler conf] - (let [runtime (-> (make-runtime-internal scheduler conf) - (update :store stores/load-builtins! (keys builtins)) - (update :server servers/load-builtins! builtins)) - rt2 (->> (keys builtins) - (map (partial stores/resolve-name (:store runtime))) - (map (partial load-by-id runtime)) - (update runtime :server eval-all))] - (reset! resolver rt2) - rt2))) + (println "runtime") + (p/let [prep (make-runtime-internal scheduler conf builtins) + runtime (update prep :server servers/load-builtins! builtins) + build-in-names (p/all (map (partial resolve-name runtime) (keys builtins))) + asts (p/all (map (partial load-by-id runtime) build-in-names)) + rt2 (update runtime :server eval-all asts)] + (println "rt done") + (reset! resolver rt2)))) (defn link-storage "" @@ -212,30 +222,29 @@ ;; Evaluation - Dumb and without dependency resolution for now -(defn persist-to-ids! [store tx-records] - (-> (stores/persist-tree! store tx-records) - :tempids - (dissoc :db/current-tx) - vals)) +(defn persist-to-ids! + "" + [store tx-records] + (stores/persist-tree! store tx-records)) + (defn store! [store tx-records] - (->> tx-records - (persist-to-ids! store) - (map (partial stores/load-by-id store)))) + (p/let [ids (persist-to-ids! store tx-records)] + (p/all (map (partial stores/load-by-id store) ids)))) (defn store-and-eval! [{store :store server :server :as rt} tx-records] (reset! resolver rt) - (->> tx-records - (store! store) - (eval-all server))) + (p/let [asts (store! store tx-records)] + (eval-all server asts))) (defn load-by-sym "" - [{store :store :as rt} sym] - (when-let [ref (stores/resolve-name store sym)] - (load-by-id rt ref))) + [rt sym] + (p/let [ref (resolve-name rt sym)] + (when ref + (load-by-id rt ref)))) (defn load-network "loads the given network from storage" @@ -261,30 +270,31 @@ (defn load-def-from-bundle "" [rt id defns] - (let [defs (if (= (:samak.nodes/type defns) :samak.nodes/def) - (:samak.nodes/rhs defns) - (:samak.nodes/definition defns)) - ;; _ (println "id" id "- defns" defns) - kvs (:samak.nodes/mapkv-pairs defs) - ;; _ (println "kvs" kvs) - sources (get-ids-from-source-def kvs #{:sources}) - source-ids (apply sorted-set (map get-id-from-source-val sources)) - _ (println "source-ids:" source-ids) - sinks (get-ids-from-source-def kvs #{:sinks}) - sink-ids (apply sorted-set (map get-id-from-source-val sinks)) - _ (println "sink-ids:" sink-ids) - deps (get-ids-from-source-def kvs #{:depends}) - dep-ids (mapv get-id-from-source-val deps) - _ (println "dep-ids" dep-ids) - deps-source-ids (mapv (fn [dep] - (println "dep" dep) - (load-def-from-bundle rt dep (load-by-id rt dep))) - dep-ids) - _ (println "dep-s-id" deps-source-ids) - def {id {:depends dep-ids - :dependencies deps-source-ids - :sinks sink-ids - :roots source-ids}}] + (p/let [defs (if (= (:samak.nodes/type defns) :samak.nodes/def) + (:samak.nodes/rhs defns) + (:samak.nodes/definition defns)) + ;; _ (println "id" id "- defns" defns) + kvs (:samak.nodes/mapkv-pairs defs) + ;; _ (println "kvs" kvs) + sources (get-ids-from-source-def kvs #{:sources}) + source-ids (apply sorted-set (map get-id-from-source-val sources)) + _ (println "source-ids:" source-ids) + sinks (get-ids-from-source-def kvs #{:sinks}) + sink-ids (apply sorted-set (map get-id-from-source-val sinks)) + _ (println "sink-ids:" sink-ids) + deps (get-ids-from-source-def kvs #{:depends}) + dep-ids (mapv get-id-from-source-val deps) + _ (println "dep-ids" dep-ids) + deps-source-ids (p/all (map (fn [dep] + (println "dep" dep) + (p/let [ast (load-by-id rt dep)] + (load-def-from-bundle rt dep ast))) + dep-ids)) + _ (println "dep-s-id" deps-source-ids) + def {id {:depends dep-ids + :dependencies deps-source-ids + :sinks sink-ids + :roots source-ids}}] (println "def: " def) def)) @@ -292,35 +302,33 @@ (defn load-bundle "loads the definition of a bundle by the given id" [rt id] - (let [defns (load-by-id rt id)] + (p/let [defns (load-by-id rt id)] (load-def-from-bundle rt id defns))) (defn eval-expression! [{:keys [store server] :as rt} form] - (let [new-server (store-and-eval! rt (rewrite-expression "user" form))] + (p/let [new-server (store-and-eval! rt (rewrite-expression "user" form))] (assoc rt :server new-server))) -(defn resolve-name [runtime sym] - (-> runtime :store (stores/resolve-name sym))) - (defn get-definition-by-id [runtime id] (when id (-> runtime :server servers/get-defined (get id)))) (defn get-definition-by-name [runtime sym] - (let [id (-> runtime :store (stores/resolve-name sym))] + (p/let [id (resolve-name runtime sym)] (get-definition-by-id runtime id))) (defn fire-into-named-pipe "" [rt pipe-name data timeout] - (let [pipe (get-definition-by-name rt pipe-name)] - (if (pipes/pipe? pipe) - (let [paket (pipes/make-paket data ::fire) - cancel-id (:samak.pipes/cancel (:samak.pipes/meta paket))] - (when (> timeout 0) - (set-cancellation-condition cancel-id {:timeout (helpers/future-ms timeout)})) - (trace/trace ::fire 0 paket) - (pipes/fire-raw! pipe paket)) - {:error (str "could not find pipe " pipe-name)}))) + (println "firing" pipe-name) + (p/let [pipe (get-definition-by-name rt pipe-name)] + (do (println (:id rt) "pipeis" pipe) (if (pipes/pipe? pipe) + (let [paket (pipes/make-paket data ::fire) + cancel-id (:samak.pipes/cancel (:samak.pipes/meta paket))] + (when (> timeout 0) + (set-cancellation-condition cancel-id {:timeout (helpers/future-ms timeout)})) + (trace/trace ::fire 0 paket) + (pipes/fire-raw! pipe paket)) + (ex-info "could not find pipe" {:pipe-name pipe-name}))))) diff --git a/src/samak/runtime/servers.cljc b/src/samak/runtime/servers.cljc index 957b4ed..43754ef 100644 --- a/src/samak/runtime/servers.cljc +++ b/src/samak/runtime/servers.cljc @@ -8,7 +8,6 @@ :cljs [(:require [clojure.core.async :as a] [cljs.reader :as edn] - [samak.protocols :as p] [samak.pipes :as pipes] [samak.nodes :as n])])) diff --git a/src/samak/runtime/stores.cljc b/src/samak/runtime/stores.cljc index de87d23..36c9592 100644 --- a/src/samak/runtime/stores.cljc +++ b/src/samak/runtime/stores.cljc @@ -1,6 +1,21 @@ (ns samak.runtime.stores - (:require [samak.code-db :as db] - [samak.api :as api])) + #?@ + (:clj + [(:require [promesa.core :as p] + [clojure.core.async :as a :refer [! put! chan go go-loop close!]] + [clojure.edn :as edn] + [samak.code-db :as db] + [samak.api :as api] + [samak.pipes :as pipes] + [clojure.core.async :as a])] + :cljs + [(:require [promesa.core :as p] + [clojure.core.async :as a :refer [! put! chan close!]] + [cljs.reader :as edn] + [samak.code-db :as db] + [samak.api :as api] + [samak.pipes :as pipes]) + (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) (defprotocol SamakStore (persist-tree! [this tree]) @@ -11,17 +26,129 @@ (defrecord LocalSamakStore [db] SamakStore (persist-tree! [_ tree] - (db/parse-tree->db! db tree)) + (p/resolved + (-> (db/parse-tree->db! db tree) + :tempids + (dissoc :db/current-tx) + vals))) (load-by-id [_ id] - (db/load-recurse db id)) + (p/resolved (db/load-recurse db id))) (load-network [_ id] - (db/load-network db id)) + (p/resolved (db/load-network db id))) (resolve-name [_ db-name] - (db/resolve-name db db-name))) + (p/resolved (db/resolve-name db db-name)))) + +(def resolve-cache (atom {})) + +(defrecord RemoteSamakStore [db in out counter] + SamakStore + + (persist-tree! [_ tree] + (let [prom (p/deferred) + id (swap! counter inc) + c (chan)] + (a/tap (pipes/out-port in) c) + ;; (println "req persist" id "-" tree) + (put! (pipes/in-port out) {:samak.runtime/type :samak.runtime/store :cmd :persist-tree :args {:id id :tree tree}}) + (go-loop [] ;;FIXME timeouts leak + (when-let [i (! chan go go-loop close! put! pipe]] + [promesa.core :as p] [samak.api :as api] [samak.helpers :as helpers] - [samak.lisparser :as p] [samak.builtins :as builtins] [samak.stdlib :as std] [samak.pipes :as pipes] @@ -15,6 +15,7 @@ [(:require [clojure.string :as str] [clojure.core.async :as a :refer [! chan close! put! pipe]] + [promesa.core :as p] [samak.api :as api] [samak.helpers :as helpers] [samak.pipes :as pipes] @@ -34,15 +35,15 @@ (defn load-module "" [rt mod] - (let [sources (map #(run/load-network rt %) (:roots mod)) - net (reduce (fn [a, v] - (let [val (vals v)] - {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) - :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) - })) - {:nodes (into [] (:roots mod)) - :pipes []} - sources)] + (p/let [sources (p/all (map #(run/load-network rt %) (:roots mod))) + net (reduce (fn [a, v] + (let [val (vals v)] + {:nodes (into (:nodes a) (flatten [(map :xf val) (map :ends val)])) + :pipes (into (:pipes a) (map :db/id (flatten (map :pipes val)))) + })) + {:nodes (into [] (:roots mod)) + :pipes []} + sources)] {:nodes (distinct (:nodes net)) :pipes (distinct (:pipes net))})) @@ -50,51 +51,50 @@ "" [rt [id mod]] (println "load-deps" id mod) - (let [deps (:dependencies mod)] + (p/let [deps (p/all (mapv (fn [m] (load-deps rt (first m))) (:dependencies mod))) + roots (load-module rt mod)] {:id id - :deps (mapv (fn [m] (load-deps rt (first m))) deps) + :deps deps :sinks (:sinks mod) :sources (:roots mod) - :roots (load-module rt mod)}) - ) + :roots roots})) (defn load-bundle-by-id "" [rt bundle-id] - (let [_ (print " V" "Bundle id:" bundle-id) - bundle (get (run/load-bundle rt bundle-id) bundle-id) - _ (println "bundle: " bundle) - deps (load-deps rt [bundle-id bundle])] - deps -)) + (p/let [_ (print " V" "Bundle id:" bundle-id) + ast (run/load-bundle rt bundle-id) + bundle (get ast bundle-id) + _ (println "bundle: " bundle) + deps (load-deps rt [bundle-id bundle])] + deps)) (defn load-bundle "" [rt sym] - (let [_ (print " V" "Fetching bundle from DB:" sym) - bundle-id (run/resolve-name rt sym) - deps (load-bundle-by-id rt bundle-id)] - deps - )) + (p/let [_ (print " V" "Fetching bundle from DB:" sym) + bundle-id (run/resolve-name rt sym) + deps (load-bundle-by-id rt bundle-id)] + deps)) (defn eval-module "" [rt conf module root] (if (contains? conf (:id module)) (println "skipping" (:id module)) - (do - ;; (println "eval" (:id module) "->" module) - (doall (map #(eval-module rt conf % (:id %)) (:deps module))) - (println "loading" (:id module)) - (let [roots (:roots module) - base (if root [root] []) - root-ids (into (into base (:nodes roots)) (:pipes roots)) - ;; _ (println "[" (:id module) "] roots" root-ids) - asts (doall (map #(run/load-ast @rt %) root-ids))] - ;; (println "evaling" (:id module)) - (reset! rt (update @rt :server run/eval-all asts)) - (println "done" (:id module)))))) + (p/do! + ;; (println "eval" (:id module) "->" module) + (p/all (map #(eval-module rt conf % (:id %)) (:deps module))) + (println "loading" (:id module)) + (p/let [roots (:roots module) + base (if root [root] []) + root-ids (into (into base (:nodes roots)) (:pipes roots)) + ;; _ (println "[" (:id module) "] roots" root-ids) + asts (p/all (map #(run/load-ast @rt %) root-ids))] + ;; (println "evaling" (:id module)) + (reset! rt (update @rt :server run/eval-all asts)) + (println "done" (:id module)))))) (defn run-module "" @@ -118,13 +118,19 @@ (doall (map (partial setup-out rt) (:sinks mod)))) -(defn start-module - [rt conf sym] - (let [net (load-bundle @rt sym) - mod-name (module-id 'lone)] +(defn eval-run-module + "" + [rt conf net sym] + (p/let [mod-name (module-id 'lone)] (eval-module rt conf net (:id net)) - (println "module" sym "done \\o/" rt) + (println (:id @rt) "module" sym "done \\o/") (run-module rt (:id net) mod-name) (let [mod (run/resolve-fn @rt mod-name)] - (println "mod" mod) + (println (:id @rt) "mod" mod-name mod) (setup-outs rt mod)))) + + +(defn start-module + [rt conf sym] + (p/let [net (load-bundle @rt sym)] + (eval-run-module rt conf net sym))) diff --git a/src/samak/stdlib.cljc b/src/samak/stdlib.cljc index 5a733f2..dd9591f 100644 --- a/src/samak/stdlib.cljc +++ b/src/samak/stdlib.cljc @@ -73,24 +73,6 @@ (pipes/async-pipe http-call nil nil)) -;; DB TODO: Don't think this belongs here - -;; (defn db-init [args] -;; (db/create-empty-db)) - -;; (defn query-call -;; [db query] -;; (fn [input out] -;; (let [ast (or (db/load-by-id input) :not-found)] -;; (put! out ast)))) - -;; (defn db-persist [db args] -;; (db/parse-tree->db! db args)) - -;; (defn db-query [db query] -;; (pipes/async-pipe (query-call db query) nil nil)) - - ;; Runtime (def notify-chan (chan 1)) diff --git a/src/samak/trace.cljc b/src/samak/trace.cljc index 5a09806..9062308 100644 --- a/src/samak/trace.cljc +++ b/src/samak/trace.cljc @@ -2,19 +2,22 @@ #?(:clj (:require [clojure.spec.alpha :as s] [clojure.walk :as w] + [promesa.core :as prom] [samak.zipkin :as tracing] [samak.trace-db :as db] [samak.helpers :as helper] [samak.tools :as tools] [samak.api :as api] - [samak.runtime.stores :as store]) + ;; [samak.runtime.stores :as store] + ) :cljs (:require [cljs.spec.alpha :as s] [clojure.walk :as w] + [promesa.core :as prom] [samak.zipkin :as tracing] [samak.trace-db :as db] [samak.helpers :as helper] - [samak.runtime.stores :as store] + ;; [samak.runtime.stores :as store] [samak.api :as api] [samak.tools :as tools]))) @@ -42,14 +45,16 @@ (defn node-as-str "" [node] - (if (number? node) - (let [ast (store/load-by-id (:store @rt) node)] - (if (api/is-def? ast) - (str "(" node ") " (:samak.nodes/name ast)) - (if (api/is-def? (:samak.nodes/fn ast)) - (str "(" node ") " (:samak.nodes/name (:samak.nodes/fn ast))) - (str ast)))) - node)) + ;; (if (number? node) ;; split into own ns + ;; (prom/let [ast (store/load-by-id (:store @rt) node)] + ;; (if (api/is-def? ast) + ;; (str "(" node ") " (:samak.nodes/name ast)) + ;; (if (api/is-def? (:samak.nodes/fn ast)) + ;; (str "(" node ") " (:samak.nodes/name (:samak.nodes/fn ast))) + ;; (str ast)))) + ;; node) + node + ) (defn make-trace "" @@ -73,7 +78,8 @@ "" [db-id duration event] (if-not (:samak.pipes/uuid (:samak.pipes/meta event)) - (println "assert failed:" event)) + (when event + (println "no traceable event:" event))) (when @tracer (let [data (make-trace db-id duration event)] (reset! tracer ((:trace-fn @tracer) @tracer (to-tracer data))))) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index fbb2946..559429a 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -4,6 +4,7 @@ [(:require [clojure.string :as s] [clojure.walk :as w] [clojure.core.async :as a :refer [! put! chan go go-loop close!]] + [promesa.core :as prom] [samak.test-programs :as test-programs] [samak.api :as api] [samak.helpers :as helpers] @@ -25,6 +26,7 @@ [(:require [clojure.string :as s] [clojure.walk :as w] [clojure.core.async :as a :refer [! put! chan close!]] + [promesa.core :as prom] [samak.test-programs :as test-programs] [samak.api :as api] [samak.helpers :as helpers] @@ -200,16 +202,16 @@ is-stdlib (not is-reductions)))) -(defn reset-rt - "" - [rt] - (reset! rt (rt/make-runtime (merge builtins/samak-symbols - symbols - std/pipe-symbols))) - (reset! rt (reduce rt/eval-expression! @rt (vals @net))) - (let [p (rt/get-definition-by-name @rt (symbol "start")) - r (when p (pipes/fire! p 1 ::init))] - (println (str "fire2! " p " - " r)))) +;; (defn reset-rt +;; "" +;; [rt] +;; (reset! rt (rt/make-runtime (merge builtins/samak-symbols +;; symbols +;; std/pipe-symbols))) +;; (reset! rt (reduce rt/eval-expression! @rt (vals @net))) +;; (let [p (rt/get-definition-by-name @rt (symbol "start")) +;; r (when p (pipes/fire! p 1 ::init))] +;; (println (str "fire2! " p " - " r)))) (defn format-node "" @@ -281,7 +283,7 @@ (when (and source func sink) ;; (swap! net assoc key pipe) ;; (swap! rt-preview rt/link-storage (:store @rt-conn)) - (swap! rt-conn rt/eval-expression! pipe) + (swap! rt-conn #(update % :server rt/eval-all [pipe])) ;; (reset-rt rt-preview) (format-pipe pipe)))) @@ -308,8 +310,9 @@ (defn single! "" [exp] - (let [loaded (persist! @rt-conn [(assoc exp :db/id -1)]) - ast (load-ast @rt-conn (:db/id (first loaded)))] + (prom/let [loaded (persist! @rt-conn [(assoc exp :db/id -1)]) + _ (println "single" loaded) + ast (load-ast @rt-conn (:db/id (first loaded)))] ast)) (defn repl-eval @@ -416,8 +419,8 @@ updated (if (is-mapish cell) (add-map (if (is-map-node cell) cell par) (- idx 1 par-idx) content) (add-list (if (is-listy-node cell) cell par) content))] - (let [write (persist! @rt-conn [updated]) - exp (load-ast @rt-conn root-id)] + (prom/let [write (persist! @rt-conn [updated]) + exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) (notify-source ev (add-node (symbol sym) exp)) :done))))) @@ -442,8 +445,8 @@ (let [[cell par] (add-cell-internal src idx) root-id (:db/id src) updated (value-from-type cell value)] - (let [write (persist! @rt-conn [updated]) - exp (load-ast @rt-conn root-id)] + (prom/let [write (persist! @rt-conn [updated]) + exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) (notify-source ev (add-node (symbol sym) exp))))))) @@ -470,8 +473,8 @@ sorted-args (vec (sort-by :order (get par (get-child-key par)))) ;; need to make a copy because sort-by is inplace sometimes changed (change-order sorted-args arg-source-idx arg-target-idx) node (assoc par (get-child-key par) changed)] - (let [write (persist! @rt-conn [node]) - exp (load-ast @rt-conn root-id)] + (prom/let [write (persist! @rt-conn [node]) + exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) (notify-source ev (add-node (symbol sym) exp))) )))) @@ -500,8 +503,8 @@ updated (assoc par (get-child-key par) removed-args) target-node (some #(when (= (:order %) arg-idx) %) (get par (get-child-key par))) retract [:db/retract (:db/id par) (get-child-key par) (:db/id target-node)]] - (let [write (persist! @rt-conn [updated retract]) - exp (load-ast @rt-conn root-id)] + (prom/let [write (persist! @rt-conn [updated retract]) + exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) (notify-source ev (add-node (symbol sym) exp)) :done))))) @@ -533,8 +536,8 @@ retract [:db/retract (:db/id par) (get-child-key par) (:db/id own-arg)] ;; _ (println (str "retract: " retract)) ] - (let [write (persist! @rt-conn [insertion fixup retract]) - exp (load-ast @rt-conn root-id)] + (prom/let [write (persist! @rt-conn [insertion fixup retract]) + exp (load-ast @rt-conn root-id)] (println (str "res: " exp)) (notify-source ev (add-node (symbol sym) exp)) :done))))))) @@ -553,13 +556,13 @@ [conf] (println "conf " conf) (when conf - (let [is-module (= (:samak.nodes/type conf) :samak.nodes/module) - sym (if is-module (symbol (str "test-" (:samak.nodes/name conf))) (symbol (:samak.nodes/name conf))) - conf (if is-module - (api/defexp sym (api/fn-call conf [])) - conf) - rt2 (update @rt-conn :server #(rt/eval-all % [conf])) - evaled (rt/get-definition-by-name rt2 sym)] + (prom/let [is-module (= (:samak.nodes/type conf) :samak.nodes/module) + sym (if is-module (symbol (str "test-" (:samak.nodes/name conf))) (symbol (:samak.nodes/name conf))) + conf (if is-module + (api/defexp sym (api/fn-call conf [])) + conf) + rt2 (update @rt-conn :server #(rt/eval-all % [conf])) + evaled (rt/get-definition-by-name rt2 sym)] (println "evaled " evaled) ;; (println "evaled " (:samak.nodes/definition evaled)) (:tests evaled)))) @@ -567,12 +570,12 @@ (defn attach-assert "" [verify source-pipe xf-fn test-fn] - (let [assert-name (str "assert-" (rand-int 1000000)) - assert-exp (api/defexp (symbol assert-name) (api/fn-call (api/symbol 'pipes/debug) [])) - assert-ast (single! assert-exp)] + (prom/let [assert-name (str "assert-" (rand-int 1000000)) + assert-exp (api/defexp (symbol assert-name) (api/fn-call (api/symbol 'pipes/debug) [])) + assert-ast (single! assert-exp)] (add-node (symbol assert-name) assert-ast) - (let [assert-pipe (rt/get-definition-by-name @rt-conn (symbol assert-name)) - verify-pipe (rt/get-definition-by-name @rt-conn (symbol verify))] + (prom/let [assert-pipe (rt/get-definition-by-name @rt-conn (symbol assert-name)) + verify-pipe (rt/get-definition-by-name @rt-conn (symbol verify))] (link-pipes source-pipe assert-pipe xf-fn) (link-pipes assert-pipe verify-pipe test-fn)))) @@ -583,7 +586,7 @@ (rt/get-definition-by-name @rt-conn (get-in exp [:samak.nodes/fn :samak.nodes/name])) (do (println exp) - (let [ast (load-ast @rt-conn (:db/id exp))] + (prom/let [ast (load-ast @rt-conn (:db/id exp))] (println "loaded" ast) (swap! rt-conn #(update % :server rt/eval-all [ast]))) (println "evaled" exp) @@ -596,16 +599,16 @@ (defn add-pipe-net "" [verify config ast] - (let [source (resolve-sym-or-fn (:samak.nodes/from ast)) - source-name (get-in ast [:samak.nodes/from :samak.nodes/fn :samak.nodes/name]) - xf (get-in ast [:samak.nodes/xf :samak.nodes/fn]) - sink (resolve-sym-or-fn (:samak.nodes/to ast)) - sink-name (get-in ast [:samak.nodes/to :samak.nodes/fn :samak.nodes/name]) - test-ref (get config (str sink-name))] + (prom/let [source (resolve-sym-or-fn (:samak.nodes/from ast)) + source-name (get-in ast [:samak.nodes/from :samak.nodes/fn :samak.nodes/name]) + xf (get-in ast [:samak.nodes/xf :samak.nodes/fn]) + sink (resolve-sym-or-fn (:samak.nodes/to ast)) + sink-name (get-in ast [:samak.nodes/to :samak.nodes/fn :samak.nodes/name]) + test-ref (get config (str sink-name))] (println " V" "Adding pipe:" source-name "with" (if xf - (str "[" (:db/id xf) "] " (:samak.nodes/name xf)) - "~none~") + (str "[" (:db/id xf) "] " (:samak.nodes/name xf)) + "~none~") "to" sink-name) (let [xf-pipe (get (servers/get-defined (:server @rt-conn)) (:db/id xf))] (when test-ref @@ -618,9 +621,9 @@ "" [] (println " V" "Set up result collection") - (let [verify-name (symbol (str "verify-" (rand-int 1000000))) - verify-exp (api/defexp verify-name (api/fn-call (api/symbol 'pipes/debug) [])) - verify-ast (single! verify-exp)] + (prom/let [verify-name (symbol (str "verify-" (rand-int 1000000))) + verify-exp (api/defexp verify-name (api/fn-call (api/symbol 'pipes/debug) [])) + verify-ast (single! verify-exp)] (add-node verify-name verify-ast) verify-name)) @@ -628,15 +631,15 @@ (defn handle-source "" [source eval?] - (let [nodes (:nodes source) - _ (println " V" "Loading asts: " (s/join ", " nodes)) - asts (map #(load-ast @rt-conn %1) nodes) - _ (println " V" "Adding nodes: " (s/join ", " (map #(str (:samak.nodes/name %) "(" (:db/id %) ")") asts))) - adder (if eval? add-node format-node) - node-notify (doall (map #(adder (:db/id %) %) asts)) - pipes (:pipes source) - _ (println " V" "Adding pipes: " (s/join ", " pipes)) - pipe-asts (doall (map #(load-ast @rt-conn %1) pipes))] + (prom/let [nodes (:nodes source) + _ (println " V" "Loading asts: " (s/join ", " nodes)) + asts (prom/all (map #(load-ast @rt-conn %1) nodes)) + _ (println " V" "Adding nodes: " (s/join ", " (map #(str (:samak.nodes/name %) "(" (:db/id %) ")") asts))) + adder (if eval? add-node format-node) + node-notify (doall (map #(adder (:db/id %) %) asts)) + pipes (:pipes source) + _ (println " V" "Adding pipes: " (s/join ", " pipes)) + pipe-asts (prom/all (map #(load-ast @rt-conn %1) pipes))] [node-notify pipe-asts])) (defn handle-mod @@ -656,15 +659,15 @@ "" [net config verify] ;; (println "Loading source: " (str sym)) - (let [[_ pipe-asts] (handle-source net true)] - (doall (map #(add-pipe-net verify (:then config) %) pipe-asts)))) + (prom/let [[_ pipe-asts] (handle-source net true)] + (prom/all (map #(add-pipe-net verify (:then config) %) pipe-asts)))) (defn database-net "" [net] - (let [[node-notify pipe-asts] (handle-source net false) - pipe-notify (map format-pipe pipe-asts)] + (prom/let [[node-notify pipe-asts] (handle-source net false) + pipe-notify (map format-pipe pipe-asts)] {:nodes node-notify :pipes pipe-notify})) @@ -684,16 +687,17 @@ (defn eval-bundle "" [id] - (let [bundle (sched/load-bundle-by-id @rt-conn id) - _ (println "ev b" bundle) - roots (:roots bundle) - deps (handle-deps (:deps bundle)) - _ (println "deps" deps) - rootnotify (assoc (database-net roots) :modules [(handle-mod bundle)]) - ;; rootnotify (database-net roots) - _ (println "root" rootnotify) - a1 (merge-with into rootnotify deps) - _ (println "ev n" a1)] + (prom/let [bundle (sched/load-bundle-by-id @rt-conn id) + _ (println "ev b" bundle) + roots (:roots bundle) + deps (handle-deps (:deps bundle)) + _ (println "deps" deps) + net (database-net roots) + rootnotify (assoc net :modules [(handle-mod bundle)]) + ;; rootnotify (database-net roots) + _ (println "root" rootnotify) + a1 (merge-with into rootnotify deps) + _ (println "ev n" a1)] (assoc a1 :id (:id bundle)) )) @@ -701,9 +705,9 @@ (defn test-bundle "" [sym test] - (let [verify (setup-verify) - bundle (:roots (sched/load-bundle @rt-conn sym))] - (runtime-net bundle test verify) + (prom/let [verify (setup-verify) + bundle (sched/load-bundle @rt-conn sym)] + (runtime-net (:roots bundle) test verify) verify)) (defn trace-dump @@ -716,9 +720,8 @@ (defn persist-net "" [code] - (let [parsed (p/parse-all (s/join " " code)) - _ (rt/persist-to-ids! (:store @rt-conn) (:value parsed)) - ] + (prom/let [parsed (p/parse-all (s/join " " code)) + _ (rt/persist-to-ids! (:store @rt-conn) (:value parsed))] :done)) @@ -739,8 +742,8 @@ (println (str "test " name " - " tst)) (let [verify (test-bundle sym tst)] - (go (let [pipe (rt/get-definition-by-name @rt-conn verify) - listener (chan 1)] + (go (prom/let [pipe (rt/get-definition-by-name @rt-conn verify) + listener (chan 1)] (a/tap (.-out pipe) listener) ;; TODO: FIX protocol? (loop [results []] (let [msg (! chan go go-loop close! put! pipe]] + [promesa.core :as p] [samak.api :as api] [samak.helpers :as helpers] [samak.runtime :as run] @@ -20,6 +21,7 @@ [clojure.string :as str] [cljs.reader :as edn] [clojure.core.async :as a :refer [! chan close! put! pipe]] + [promesa.core :as p] [samak.api :as api] [samak.helpers :as helpers] [samak.runtime :as run] @@ -58,13 +60,13 @@ (println "got" msg p)) (recur)))) -(def sched - (fn [broadcast] +(def scheduler + (let [broadcast (pipes/pipe (chan)) + to-rt (pipes/pipe (chan) "worker-scheduler")] (println "sched") - (let [to-rt (pipes/pipe (chan))] - ;; (handle-update "out" broadcast) - ;; (handle-update "in" to-rt) - to-rt))) + ;; (handle-update "out" broadcast) + ;; (handle-update "in" to-rt) + (fn [] [to-rt broadcast]))) (def rt (atom {})) @@ -72,6 +74,9 @@ :url "/api/v2/"}}) (def tracer (atom {})) +(def progress (atom {})) +(def out (atom {})) + (defn trace [src duration msg] (trace/trace src duration msg)) @@ -80,7 +85,7 @@ (defn get-named-pipe [rt pipe-name] (let [mod-name (sched/module-id (:module pipe-name)) - mod (run/resolve-fn rt mod-name) + mod (run/resolve-fn @rt mod-name) pipe (get-in mod [(:type pipe-name) (:name pipe-name)])] (if (pipes/pipe? pipe) pipe @@ -88,6 +93,15 @@ (def get-named-pipe-memo (memoize get-named-pipe)) +(defn start-oasis + "" + [] + (println "worker oasis") + ;; (pipes/link! (pipes/source in) (:scheduler @rt)) + (p/do! (sched/start-module rt {} 'oasis-core) + (caravan/init @rt) + (println "worker started core"))) + (defn handle-input "" [rt c] @@ -95,7 +109,7 @@ (let [p ( Date: Sat, 31 Oct 2020 21:35:24 +0100 Subject: [PATCH 11/12] WIP: refactor runtime communication --- dev_src/dev/core.cljs | 37 ++-- dev_src/dev/render.cljc | 26 ++- dev_src/dev/worker.cljs | 2 +- resources/public/index_oasis.html | 2 +- src/samak/runtime.cljc | 89 +++++----- src/samak/runtime/servers.cljc | 9 +- src/samak/scheduler.cljc | 4 +- test/samak/caravan_test.cljc | 146 ++++++++-------- test/samak/oasis_test.cljc | 32 ++-- test/samak/pipes_test.cljc | 2 +- test/samak/runtime_test.cljc | 58 ++++--- test/samak/utils.cljc | 12 +- ui_src/samak/caravan.cljc | 12 +- ui_src/samak/oasis.cljc | 271 +++++++++++++++--------------- ui_src/samak/ui_stdlib.cljs | 21 +-- ui_src/samak/worker.cljc | 2 +- 16 files changed, 378 insertions(+), 347 deletions(-) diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index ee38f78..769c279 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -10,11 +10,6 @@ [samak.builtins :as builtins]) (:require-macros [cljs.core.async.macros :refer [go go-loop]])) -(defn start-main - [load in out] - (render/start-render-runtime load in out)) - - (defn update-bar "" [a] @@ -44,7 +39,7 @@ (go-loop [] (let [p ( -
+
diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index 1c60002..717a216 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -31,12 +31,10 @@ (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) -(def resolver (atom {})) (def cancel-conditions (atom {})) (defn eval-all [server forms] (reduce (fn [server form] - (swap! resolver #(assoc % :server server)) ;; (println "form" (:db/id form) "->" form) (servers/eval-ast server form)) server forms)) @@ -75,18 +73,8 @@ (defn resolve-fn - ([id] - (resolve-fn @resolver id)) ([rt id] - (let [defs (servers/get-defined (:server rt)) - fn (get defs id)] - fn - ;; (if fn - ;; (do - ;; ;; (println "resolved " id "-> " fn) - ;; fn) - ;; (println "not evaluated: " id " -> " (stores/load-by-id (:store rt) id))) - ))) + (get (servers/get-defined (:server rt)) id))) (defn wrap-out "" @@ -111,32 +99,31 @@ (defn replace-piped "" - [{target :target :as pipe}] + [{target :target :as pipe} id broadcast inbound] (if (not= target :pipe) pipe (do - ;; (println "replacing " pipe) - (let [from-scheduler (:scheduler @resolver) - trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe (:id @resolver))) (remove #(= % ::ignore)))) - to-world (:broadcast @resolver) - trans-out (pipes/transduction-pipe (map (wrap-out pipe (:id @resolver)))) - in-mapped (pipes/link! from-scheduler trans-in) - out-mapped (pipes/link! trans-out to-world)] + (println "replacing " pipe) + (let [trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe id)) (remove #(= % ::ignore)))) + trans-out (pipes/transduction-pipe (map (wrap-out pipe id))) + in-mapped (pipes/link! inbound trans-in) + out-mapped (pipes/link! trans-out broadcast)] (pipes/composite-pipe out-mapped in-mapped))))) (defn link-fn "" - [from to xf] - ;; (println "linking" from to) - (let [a (replace-piped from) - c (replace-piped to)] - (when (not (pipes/pipe? a)) - (fail "cant link from " from)) - (when (not (pipes/pipe? c)) - (fail "cant link to " to)) - (if xf - (pipes/link! (pipes/link! a xf) c) - (pipes/link! a c)))) + [id broadcast inbound] + (fn [from to xf] + (println "linking" from to) + (let [a (replace-piped from id broadcast inbound) + c (replace-piped to id broadcast inbound)] + (when (not (pipes/pipe? a)) + (fail "cant link from " from)) + (when (not (pipes/pipe? c)) + (fail "cant link to " to)) + (if xf + (pipes/link! (pipes/link! a xf) c) + (pipes/link! a c))))) (defn instanciate-module "" @@ -152,9 +139,9 @@ ;; needs to prep resolve magic when instanciating pipes, to select same runtime ;; maybe simply do so explicitly ;; (if (:config man)) - ;; (println (str "about to eval module: " module)) + (println (str "about to eval module: " module)) (let [evaled (n/eval-env man nil definition (:db/id module))] - ;; (println (str "used module: " module "->" evaled)) + (println (str "used module: " module "->" evaled)) evaled))))) (defn make-store-internal @@ -170,33 +157,38 @@ (defn make-runtime-internal "" [scheduler conf builtins] - (let [[inbound broadcast] (scheduler)] - {:id (or (:id conf) (str "rt-" (helpers/uuid))) - :store (make-store-internal (:store conf) inbound broadcast builtins) - :server (servers/make-local-server {:config (:modules conf) - :resolve resolve-fn - :link link-fn - :cancel? cancel? - :module instanciate-module}) - :broadcast broadcast - :scheduler inbound})) + (let [[inbound broadcast] (scheduler) + id (or (:id conf) (str "rt-" (helpers/uuid)))] + (println "rt-in") + {:id id + :store (make-store-internal (:store conf) inbound broadcast builtins) + :server (servers/make-local-server {:config (:modules conf) + :link (link-fn id broadcast inbound) + :cancel? cancel? + :module instanciate-module}) + :broadcast broadcast + :scheduler inbound})) (defn make-runtime ([] (make-runtime nil)) ([builtins] - (make-runtime builtins #([(pipes/pipe (chan)) (pipes/pipe (chan))]))) + (make-runtime builtins (fn [] [(pipes/pipe (chan)) (pipes/pipe (chan))]))) ([builtins scheduler] (make-runtime builtins scheduler {})) ([builtins scheduler conf] - (println "runtime") + (println "rt") (p/let [prep (make-runtime-internal scheduler conf builtins) + _ (println "1a") runtime (update prep :server servers/load-builtins! builtins) + _ (println "2") build-in-names (p/all (map (partial resolve-name runtime) (keys builtins))) + _ (println "3") asts (p/all (map (partial load-by-id runtime) build-in-names)) - rt2 (update runtime :server eval-all asts)] + _ (println "4") + rt (update runtime :server eval-all asts)] (println "rt done") - (reset! resolver rt2)))) + rt))) (defn link-storage "" @@ -235,7 +227,6 @@ (defn store-and-eval! [{store :store server :server :as rt} tx-records] - (reset! resolver rt) (p/let [asts (store! store tx-records)] (eval-all server asts))) diff --git a/src/samak/runtime/servers.cljc b/src/samak/runtime/servers.cljc index 43754ef..3b6ae83 100644 --- a/src/samak/runtime/servers.cljc +++ b/src/samak/runtime/servers.cljc @@ -12,7 +12,6 @@ [samak.nodes :as n])])) (defprotocol SamakServer - (add-manager [this man]) (eval-ast [this ast]) (get-defined [this]) (load-builtins [this builtins]) @@ -22,9 +21,10 @@ (defrecord LocalSamakServer [defined-ids builtins manager] SamakServer (eval-ast [this {:keys [db/id] :as ast}] - (update this :defined-ids assoc id (n/eval-env (get this :manager) builtins ast id))) - (get-defined [_] - defined-ids) + (let [man (assoc (get this :manager) :resolve #(get defined-ids %))] + (update this :defined-ids assoc id (n/eval-env man builtins ast id)))) + (get-defined [this] + (get this :defined-ids)) (load-builtins [this builtins] (update this :builtins merge builtins)) (unload [this ids] @@ -45,6 +45,7 @@ (defn load-builtins! "" [server builtins] + (println "load-builtins" server builtins) (load-builtins server builtins)) (defn make-local-server [manager] diff --git a/src/samak/scheduler.cljc b/src/samak/scheduler.cljc index c74d635..8661a86 100644 --- a/src/samak/scheduler.cljc +++ b/src/samak/scheduler.cljc @@ -90,9 +90,9 @@ (p/let [roots (:roots module) base (if root [root] []) root-ids (into (into base (:nodes roots)) (:pipes roots)) - ;; _ (println "[" (:id module) "] roots" root-ids) + _ (println "[" (:id module) "] roots" root-ids) asts (p/all (map #(run/load-ast @rt %) root-ids))] - ;; (println "evaling" (:id module)) + (println "evaling" (:id module)) (reset! rt (update @rt :server run/eval-all asts)) (println "done" (:id module)))))) diff --git a/test/samak/caravan_test.cljc b/test/samak/caravan_test.cljc index 128be22..31bf22b 100644 --- a/test/samak/caravan_test.cljc +++ b/test/samak/caravan_test.cljc @@ -164,76 +164,76 @@ #(is (= 2 (count (keys (sut/load-oasis))))))) ) -(deftest should-run-tests - (let [syms (merge {'pipes/ui pipes/debug - 'pipes/http pipes/debug} - core/samak-symbols) - c (chan 1) - rt (rt/make-runtime syms) - _ (sut/init rt) - _ (sut/test-net c test-programs/tl6 'tl)] - (utils/test-async - (go - (let [val ( r - (sut/eval-expression! def-node) - :store - (stores/resolve-name 'quux))] + (p/let [init (sut/make-runtime) + rt (sut/eval-expression! init def-node) + k (stores/resolve-name (:store rt) 'quux)] (is (number? k)))) @@ -40,10 +40,10 @@ :arguments []}}) (deftest should-eval-pipe-node - (let [r (sut/make-runtime {'pipes/debug std/debug - 'pipes/log std/log}) - new-state (sut/eval-expression! r pipe-node) - defined-things (-> new-state :server servers/get-defined vals)] + (p/let [r (sut/make-runtime {'pipes/debug std/debug + 'pipes/log std/log}) + new-state (sut/eval-expression! r pipe-node) + defined-things (-> new-state :server servers/get-defined vals)] (is (some samak.pipes/pipe? defined-things)))) (def other-def-node @@ -53,10 +53,10 @@ :value "foo"}}) (deftest should-keep-existing-symbols - (let [r (-> (sut/make-runtime) - (sut/eval-expression! def-node) - (sut/eval-expression! other-def-node)) - vs (-> r :server servers/get-defined vals)] + (p/let [r (-> (sut/make-runtime) + (p/then #(sut/eval-expression! % def-node)) + (p/then #(sut/eval-expression! % other-def-node))) + vs (-> r :server servers/get-defined vals)] (is (= (set vs) #{"quux" "foo"})))) (def referring-node @@ -65,23 +65,29 @@ :rhs [:samak.nodes/name 'quux]}) (deftest should-resolve-symbols - (let [vs (-> (sut/make-runtime) - (sut/eval-expression! def-node) - (sut/eval-expression! referring-node) - :server - servers/get-defined - vals)] +(p/let [rt (-> (sut/make-runtime) + (sut/eval-expression! def-node) + (sut/eval-expression! referring-node)) + vs (-> rt + :server + servers/get-defined + vals)] (is (= 2 (count vs))) (is (apply = vs)))) (deftest should-retrieve-definitions-by-name - (let [r (-> (sut/make-runtime) - (sut/eval-expression! other-def-node))] - (is (= 1 (stores/resolve-name (:store r) 'foo))))) + (p/let [init (sut/make-runtime) + rt (sut/eval-expression! init other-def-node) + n (stores/resolve-name (:store rt) 'foo)] + (is (= 1 n)))) (deftest should-persist-builtins - (is (= inc (-> (sut/make-runtime {'inc inc 'dec dec}) - :server - servers/get-defined - (get 1))))) + (utils/test-promise (p/then (sut/make-runtime {'inc inc 'dec dec}) + #(do (println "?") + (is (= + inc + (-> % + :server + servers/get-defined + (get 1)))))))) diff --git a/test/samak/utils.cljc b/test/samak/utils.cljc index b971d74..31559a7 100644 --- a/test/samak/utils.cljc +++ b/test/samak/utils.cljc @@ -2,7 +2,8 @@ (:require #?(:clj [clojure.core.async :as a :refer [ - (api/symbol 'm-oasis-ui) - (api/key-fn :sinks) - (api/key-fn :mouse)) - (defncall 'oasis-bug 'm-mouse-fn) - (defncall 'm-kb-fn '-> - (api/symbol 'm-oasis-ui) - (api/key-fn :sinks) - (api/key-fn :kb)) - (defncall 'oasis-keyboard 'm-kb-fn) - (defncall 'm-events-fn '-> - (api/symbol 'm-oasis-ui) - (api/key-fn :sinks) - (api/key-fn :events)) - (defncall 'oasis-events 'm-events-fn) - - (defncall 'm-render-mod 'oasis-render) - (defncall 'm-render 'm-render-mod) - (defncall 'm-state-fn '-> - (api/symbol 'm-render) - (api/key-fn :sources) - (api/key-fn :state)) - (defncall 'render-state 'm-state-fn) - (defncall 'm-ro-init-fn '-> - (api/symbol 'm-render) - (api/key-fn :sources) - (api/key-fn :init)) - (defncall 'render-init 'm-ro-init-fn) - (defncall 'm-r-mouse-fn '-> - (api/symbol 'm-render) - (api/key-fn :sources) - (api/key-fn :mouse)) - (defncall 'render-mouse-in 'm-r-mouse-fn) - (defncall 'm-r-kb-fn '-> - (api/symbol 'm-render) - (api/key-fn :sources) - (api/key-fn :kb)) - (defncall 'render-kb-in 'm-r-kb-fn) - (defncall 'm-elems-fn '-> - (api/symbol 'm-render) - (api/key-fn :sinks) - (api/key-fn :svg-elems)) - (defncall 'render-elems 'm-elems-fn) - (defncall 'm-ro-hover-fn '-> - (api/symbol 'm-render) - (api/key-fn :sinks) - (api/key-fn :hover)) - (defncall 'render-hover-out 'm-ro-hover-fn) - (defncall 'm-ro-drag-fn '-> - (api/symbol 'm-render) - (api/key-fn :sinks) - (api/key-fn :drag)) - (defncall 'render-drag-out 'm-ro-drag-fn) - (defncall 'm-ro-kb-fn '-> - (api/symbol 'm-render) - (api/key-fn :sinks) - (api/key-fn :kb)) - (defncall 'render-kb-out 'm-ro-kb-fn) - - (defncall 'm-core-mod 'oasis-core) - (defncall 'm-core 'm-core-mod) - (defncall 'm-state-out-fn '-> - (api/symbol 'm-core) - (api/key-fn :sinks) - (api/key-fn :state)) - (defncall 'core-state 'm-state-out-fn) - (defncall 'm-init-fn '-> - (api/symbol 'm-core) - (api/key-fn :sources) - (api/key-fn :init)) - (defncall 'core-init 'm-init-fn) - (defncall 'm-core-kb-fn '-> - (api/symbol 'm-core) - (api/key-fn :sources) - (api/key-fn :kb)) - (defncall 'core-kb-in 'm-core-kb-fn) - (defncall 'm-core-drag-fn '-> - (api/symbol 'm-core) - (api/key-fn :sources) - (api/key-fn :drag)) - (defncall 'core-drag-in 'm-core-drag-fn) - (defncall 'm-core-hover-fn '-> - (api/symbol 'm-core) - (api/key-fn :sources) - (api/key-fn :hover)) - (defncall 'core-hover-in 'm-core-hover-fn) - (defncall 'm-core-events-fn '-> - (api/symbol 'm-core) - (api/key-fn :sources) - (api/key-fn :events)) - (defncall 'core-events-in 'm-core-events-fn) + ;; (defncall 'm-mouse-fn '-> + ;; (api/symbol 'm-oasis-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :mouse)) + ;; (defncall 'oasis-bug 'm-mouse-fn) + ;; (defncall 'm-kb-fn '-> + ;; (api/symbol 'm-oasis-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :kb)) + ;; (defncall 'oasis-keyboard 'm-kb-fn) + ;; (defncall 'm-events-fn '-> + ;; (api/symbol 'm-oasis-ui) + ;; (api/key-fn :sinks) + ;; (api/key-fn :events)) + ;; (defncall 'oasis-events 'm-events-fn) + + ;; (defncall 'm-render-mod 'oasis-render) + ;; (defncall 'm-render 'm-render-mod) + ;; (defncall 'm-state-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sources) + ;; (api/key-fn :state)) + ;; (defncall 'render-state 'm-state-fn) + ;; (defncall 'm-ro-init-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sources) + ;; (api/key-fn :init)) + ;; (defncall 'render-init 'm-ro-init-fn) + ;; (defncall 'm-r-mouse-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sources) + ;; (api/key-fn :mouse)) + ;; (defncall 'render-mouse-in 'm-r-mouse-fn) + ;; (defncall 'm-r-kb-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sources) + ;; (api/key-fn :kb)) + ;; (defncall 'render-kb-in 'm-r-kb-fn) + ;; (defncall 'm-elems-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sinks) + ;; (api/key-fn :svg-elems)) + ;; (defncall 'render-elems 'm-elems-fn) + ;; (defncall 'm-ro-hover-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sinks) + ;; (api/key-fn :hover)) + ;; (defncall 'render-hover-out 'm-ro-hover-fn) + ;; (defncall 'm-ro-drag-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sinks) + ;; (api/key-fn :drag)) + ;; (defncall 'render-drag-out 'm-ro-drag-fn) + ;; (defncall 'm-ro-kb-fn '-> + ;; (api/symbol 'm-render) + ;; (api/key-fn :sinks) + ;; (api/key-fn :kb)) + ;; (defncall 'render-kb-out 'm-ro-kb-fn) + + ;; (defncall 'm-core-mod 'oasis-core) + ;; (defncall 'm-core 'm-core-mod) + ;; (defncall 'm-state-out-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sinks) + ;; (api/key-fn :state)) + ;; (defncall 'core-state 'm-state-out-fn) + ;; (defncall 'm-init-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sources) + ;; (api/key-fn :init)) + ;; (defncall 'core-init 'm-init-fn) + ;; (defncall 'm-core-kb-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sources) + ;; (api/key-fn :kb)) + ;; (defncall 'core-kb-in 'm-core-kb-fn) + ;; (defncall 'm-core-drag-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sources) + ;; (api/key-fn :drag)) + ;; (defncall 'core-drag-in 'm-core-drag-fn) + ;; (defncall 'm-core-hover-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sources) + ;; (api/key-fn :hover)) + ;; (defncall 'core-hover-in 'm-core-hover-fn) + ;; (defncall 'm-core-events-fn '-> + ;; (api/symbol 'm-core) + ;; (api/key-fn :sources) + ;; (api/key-fn :events)) + ;; (defncall 'core-events-in 'm-core-events-fn) (defncall 'log-state 'pipes/log (api/string "log-state: ")) (defncall 'log-render 'pipes/log (api/string "render: ")) @@ -4028,28 +4029,28 @@ (api/string "사막 Oasis")])})})) (defncall 'oasis-init 'pipes/debug) - (api/defmodule 'oasis (api/map {(api/keyword :depends) (api/map {(api/keyword :oasis-core) (api/symbol 'oasis-core) + (api/defmodule 'oasis (api/map {(api/keyword :depends) (api/map {;; (api/keyword :oasis-core) (api/symbol 'oasis-core) - (api/keyword :oasis-render) (api/symbol 'oasis-render) + ;; (api/keyword :oasis-render) (api/symbol 'oasis-render) (api/keyword :oasis-ui) (api/symbol 'oasis-ui) }) - (api/keyword :sources) (api/map {(api/keyword :module-core-out) (api/symbol 'core-state) + (api/keyword :sources) (api/map {;; (api/keyword :module-core-out) (api/symbol 'core-state) ;(api/keyword :module-core-kb-in) (api/symbol 'core-kb-in) ;(api/keyword :module-core-drag-in) (api/symbol 'core-drag-in) ;(api/keyword :module-core-scroll-in) (api/symbol 'core-scroll-in) - (api/keyword :module-core-hover-in) (api/symbol 'core-hover-in) - (api/keyword :module-render-state) (api/symbol 'render-state) - (api/keyword :module-render-init) (api/symbol 'render-init) - (api/keyword :module-render-mouse-in) (api/symbol 'render-mouse-in) - (api/keyword :module-render-kb-in) (api/symbol 'render-kb-in) - (api/keyword :module-render-kb-out) (api/symbol 'render-kb-out) - (api/keyword :module-render-drag-out) (api/symbol 'render-drag-out) - (api/keyword :module-render-hover-out) (api/symbol 'render-hover-out) - (api/keyword :module-render-out) (api/symbol 'render-elems) - (api/keyword :kb) (api/symbol 'oasis-keyboard) - (api/keyword :mouse) (api/symbol 'oasis-bug) - (api/keyword :events) (api/symbol 'oasis-events) - (api/keyword :main-inst-fn) (api/symbol 'core-init) + ;; (api/keyword :module-core-hover-in) (api/symbol 'core-hover-in) + ;; (api/keyword :module-render-state) (api/symbol 'render-state) + ;; (api/keyword :module-render-init) (api/symbol 'render-init) + ;; (api/keyword :module-render-mouse-in) (api/symbol 'render-mouse-in) + ;; (api/keyword :module-render-kb-in) (api/symbol 'render-kb-in) + ;; (api/keyword :module-render-kb-out) (api/symbol 'render-kb-out) + ;; (api/keyword :module-render-drag-out) (api/symbol 'render-drag-out) + ;; (api/keyword :module-render-hover-out) (api/symbol 'render-hover-out) + ;; (api/keyword :module-render-out) (api/symbol 'render-elems) + ;; (api/keyword :kb) (api/symbol 'oasis-keyboard) + ;; (api/keyword :mouse) (api/symbol 'oasis-bug) + ;; (api/keyword :events) (api/symbol 'oasis-events) + ;; (api/keyword :main-inst-fn) (api/symbol 'core-init) (api/keyword :main) (api/symbol 'oasis-init) (api/keyword :ui-r) (api/symbol 'ui-render) ;(api/keyword :ui-m-r) (api/symbol 'm-render-fn) @@ -4072,22 +4073,22 @@ (def oasis-module-net [ (pipe 'oasis-init 'header 'ui-render) - ;; (pipe 'oasis-init 'header 'log-render) - (pipe 'oasis-init 'core-init) - (pipe 'oasis-init 'render-init) + (pipe 'oasis-init 'header 'log-render) + ;; (pipe 'oasis-init 'core-init) + ;; (pipe 'oasis-init 'render-init) ;; (pipe 'core-state 'log-state) - (pipe 'core-state 'render-state) + ;; (pipe 'core-state 'render-state) ;; (pipe 'render-elems 'log-render) - (pipe 'render-elems 'ui-render) - - (pipe 'oasis-keyboard 'render-kb-in) - (pipe 'render-kb-out 'core-kb-in) - (pipe 'oasis-bug 'render-mouse-in) - (pipe 'render-drag-out 'core-drag-in) - (pipe 'render-hover-out 'core-hover-in) - ;; (pipe 'render-drag-out 'log-foo) - (pipe 'oasis-events 'core-events-in) - (pipe 'oasis-events 'log-state) + ;; (pipe 'render-elems 'ui-render) + + ;; (pipe 'oasis-keyboard 'render-kb-in) + ;; (pipe 'render-kb-out 'core-kb-in) + ;; (pipe 'oasis-bug 'render-mouse-in) + ;; (pipe 'render-drag-out 'core-drag-in) + ;; (pipe 'render-hover-out 'core-hover-in) + ;; ;; (pipe 'render-drag-out 'log-foo) + ;; (pipe 'oasis-events 'core-events-in) + ;; (pipe 'oasis-events 'log-state) ]) diff --git a/ui_src/samak/ui_stdlib.cljs b/ui_src/samak/ui_stdlib.cljs index 9d36f54..17090ba 100644 --- a/ui_src/samak/ui_stdlib.cljs +++ b/ui_src/samak/ui_stdlib.cljs @@ -107,20 +107,20 @@ ::view)) (pipes/source c))) -(def content (atom nil)) +(def content (atom {})) (defn render-cb "" - [node] - (r/render @content node) - (reset! content nil)) + [n node] + (r/render (get @content n) node) + (swap! content dissoc n)) (defn render "" - [node x events c] - (if (not @content) - (helpers/debounce #(render-cb node))) - (reset! content (if events (transform-element x c) x))) + [n node x events c] + (if (not (get @content n)) + (helpers/debounce #(render-cb n node))) + (swap! content assoc n (if events (transform-element x c) x))) (defn ui @@ -136,8 +136,9 @@ (let [x (or (:samak.pipes/content i) i)] (if true ;; (s/valid? ::hiccup x) (when-let [node (js/document.getElementById (str "samak" n))] - ;; (when n (.warn js/console (str "render " n " - " x))) - (render node x events ui-out)) + ;; (when (= 1 n)) + (.warn js/console (str "render " n " - ") x) + (render n node x events ui-out)) (.warn js/console (str "invalid " n " - " (expound/expound-str ::hiccup x) "for" x)))) (when @init (reset! init false) diff --git a/ui_src/samak/worker.cljc b/ui_src/samak/worker.cljc index d07e380..d25e791 100644 --- a/ui_src/samak/worker.cljc +++ b/ui_src/samak/worker.cljc @@ -109,7 +109,7 @@ (let [p ( Date: Fri, 20 Nov 2020 23:26:02 +0100 Subject: [PATCH 12/12] refactor and test --- dev_src/dev/core.cljs | 1 - dev_src/dev/render.cljc | 9 +- dev_src/dev/worker.cljs | 2 +- src/samak/nodes.cljc | 10 +- src/samak/pipes.cljc | 75 ++++++++++---- src/samak/repl.cljc | 32 +++--- src/samak/runtime.cljc | 72 +++++++------- src/samak/runtime/servers.cljc | 12 ++- src/samak/runtime/stores.cljc | 11 +-- src/samak/scheduler.cljc | 22 ++--- src/samak/stdlib.cljc | 66 +++---------- src/samak/test_programs.cljc | 87 ++++++++++++----- test/samak/caravan_test.cljc | 139 +++++++++++++------------- test/samak/oasis_test.cljc | 2 +- test/samak/pipes_test.cljc | 6 +- test/samak/repl_test.clj | 54 ++++++++--- test/samak/runtime_test.cljc | 33 ++++--- test/samak/scheduler_test.cljc | 25 +++++ ui_src/samak/caravan.cljc | 172 +++++++++++++++++---------------- ui_src/samak/oasis.cljc | 144 +++++++++++++-------------- ui_src/samak/ui_stdlib.cljs | 9 +- ui_src/samak/worker.cljc | 4 +- ui_src/ui/styles.clj | 2 +- 23 files changed, 543 insertions(+), 446 deletions(-) create mode 100644 test/samak/scheduler_test.cljc diff --git a/dev_src/dev/core.cljs b/dev_src/dev/core.cljs index 769c279..1da8e87 100644 --- a/dev_src/dev/core.cljs +++ b/dev_src/dev/core.cljs @@ -74,7 +74,6 @@ (let [w (js/Worker. "/js/oasis-worker.js")] (handle-send w in-worker) (aset w "onmessage" (make-handler loading in-main in-worker)) - (render/start-main loading) (handle-update loading (fn [] (p/do! ;; (a/tap out-mult in-preview) ;; (render/start-preview-runtime in-preview in-main) diff --git a/dev_src/dev/render.cljc b/dev_src/dev/render.cljc index 30696a1..ba84b4a 100644 --- a/dev_src/dev/render.cljc +++ b/dev_src/dev/render.cljc @@ -78,16 +78,16 @@ (recur)))) (def scheduler - (let [broadcast (pipes/pipe (chan)) - to-rt (pipes/pipe (chan) "worker-scheduler")] + (let [broadcast (pipes/pipe (chan) ::main-broadcast) + to-rt (pipes/pipe (chan) ::main-scheduler)] (println "sched") ;; (handle-update "out" broadcast) ;; (handle-update "in" to-rt) (fn [] [to-rt broadcast]))) (def scheduler2 - (let [broadcast (pipes/pipe (chan)) - to-rt (pipes/pipe (chan) "preview-scheduler")] + (let [broadcast (pipes/pipe (chan) ::preview-broadcast) + to-rt (pipes/pipe (chan) ::preview-scheduler)] (println "sched2") (handle-update "out2" broadcast) (handle-update "in2" to-rt) @@ -158,6 +158,7 @@ (defn start-main "" [load] + (println "start-main") (helpers/debounce #(start-oasis load))) (defn start-preview-runtime diff --git a/dev_src/dev/worker.cljs b/dev_src/dev/worker.cljs index dc7648b..9ef3f64 100644 --- a/dev_src/dev/worker.cljs +++ b/dev_src/dev/worker.cljs @@ -56,7 +56,7 @@ out (chan)] (handle-update loading) (handle-request out) - ;; (aset js/self "onmessage" (make-handler in #(worker/start-rt loading in out))) + (aset js/self "onmessage" (make-handler in #(worker/start-rt loading in out))) (put! out {:target :bootstrap}) )) diff --git a/src/samak/nodes.cljc b/src/samak/nodes.cljc index e9aee11..b1a1152 100644 --- a/src/samak/nodes.cljc +++ b/src/samak/nodes.cljc @@ -60,18 +60,22 @@ (defmethod eval-node ::float [{:keys [::value]}] value) (defmethod eval-node ::builtin [{:keys [::value]}] (get *builtins* value)) -(defmethod eval-node ::def [{:keys [::rhs]}] (eval-node rhs)) +(defmethod eval-node ::def [{:keys [::rhs] :as fn}] + (let [res (eval-node rhs) + id (:db/id fn)] + ((:register *manager*) id res) + res)) (defmethod eval-node ::pipe [{:keys [::from ::to ::xf] :as p}] (let [a (eval-node from) + c (eval-node to) b (when xf (let [db-id (:db/id xf)] (binding [*db-id* db-id] (-> xf eval-node ((partial pipes/instrument db-id (:cancel? *manager*))) - pipes/transduction-pipe)))) - c (eval-node to)] + (#(pipes/transduction-pipe % (str (pipes/uuid a) "-" db-id "-" (pipes/uuid c))))))))] ((:link *manager*) a c b))) (defmethod eval-node ::fn-ref [{:keys [::fn] :as f}] diff --git a/src/samak/pipes.cljc b/src/samak/pipes.cljc index 7ba4d42..aec0068 100644 --- a/src/samak/pipes.cljc +++ b/src/samak/pipes.cljc @@ -1,24 +1,48 @@ (ns samak.pipes (:refer-clojure :exclude [uuid]) - #? + #?@ (:clj - (:require - [clojure.core.async :as a :refer [chan put!]] + [(:require + [clojure.core.async :as a :refer [chan put! > lines @@ -145,5 +138,4 @@ [(str/join " " lines)]))))) (defn eval-lines [lines] - (doseq [line (group-repl-cmds lines)] - (eval-line line))) + (prom/all (map eval-line (group-repl-cmds lines)))) diff --git a/src/samak/runtime.cljc b/src/samak/runtime.cljc index 717a216..281dab8 100644 --- a/src/samak/runtime.cljc +++ b/src/samak/runtime.cljc @@ -32,6 +32,7 @@ (def cancel-conditions (atom {})) +(def pipe-links (atom {})) (defn eval-all [server forms] (reduce (fn [server form] @@ -74,6 +75,7 @@ (defn resolve-fn ([rt id] + (println "resolve" (:uuid rt) id) (get (servers/get-defined (:server rt)) id))) (defn wrap-out @@ -103,9 +105,9 @@ (if (not= target :pipe) pipe (do - (println "replacing " pipe) - (let [trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe id)) (remove #(= % ::ignore)))) - trans-out (pipes/transduction-pipe (map (wrap-out pipe id))) + (println "### replacing " pipe) + (let [trans-in (pipes/transduction-pipe (comp (map (wrap-in pipe id)) (remove #(= % ::ignore))) (str "trans-in-" pipe)) + trans-out (pipes/transduction-pipe (map (wrap-out pipe id)) (str "trans-out-" pipe)) in-mapped (pipes/link! inbound trans-in) out-mapped (pipes/link! trans-out broadcast)] (pipes/composite-pipe out-mapped in-mapped))))) @@ -114,16 +116,18 @@ "" [id broadcast inbound] (fn [from to xf] - (println "linking" from to) + (println "### linking" (:uuid from) (:uuid to)) (let [a (replace-piped from id broadcast inbound) - c (replace-piped to id broadcast inbound)] - (when (not (pipes/pipe? a)) - (fail "cant link from " from)) - (when (not (pipes/pipe? c)) - (fail "cant link to " to)) - (if xf - (pipes/link! (pipes/link! a xf) c) - (pipes/link! a c))))) + c (replace-piped to id broadcast inbound) + _ (when (not (pipes/pipe? a)) + (fail "cant link from " from)) + _ (when (not (pipes/pipe? c)) + (fail "cant link to " to)) + l (if xf + (pipes/link! (pipes/link! a xf) c) + (pipes/link! a c))] + (swap! pipe-links assoc (str (pipes/uuid from) "-" (pipes/uuid to)) id) + l))) (defn instanciate-module "" @@ -139,9 +143,9 @@ ;; needs to prep resolve magic when instanciating pipes, to select same runtime ;; maybe simply do so explicitly ;; (if (:config man)) - (println (str "about to eval module: " module)) + (println (str "### about to eval module: " module)) (let [evaled (n/eval-env man nil definition (:db/id module))] - (println (str "used module: " module "->" evaled)) + (println (str "### used module: " module "->" evaled)) evaled))))) (defn make-store-internal @@ -158,14 +162,15 @@ "" [scheduler conf builtins] (let [[inbound broadcast] (scheduler) - id (or (:id conf) (str "rt-" (helpers/uuid)))] - (println "rt-in") + id (or (:id conf) (str "rt-" (helpers/uuid))) + manager {:config (:modules conf) + :link (link-fn id broadcast inbound) + :cancel? cancel? + :module instanciate-module}] {:id id :store (make-store-internal (:store conf) inbound broadcast builtins) - :server (servers/make-local-server {:config (:modules conf) - :link (link-fn id broadcast inbound) - :cancel? cancel? - :module instanciate-module}) + :manager manager + :server (servers/make-local-server manager) :broadcast broadcast :scheduler inbound})) @@ -173,22 +178,15 @@ ([] (make-runtime nil)) ([builtins] - (make-runtime builtins (fn [] [(pipes/pipe (chan)) (pipes/pipe (chan))]))) + (make-runtime builtins (fn [] [(pipes/pipe (chan) ::broken) (pipes/pipe (chan) ::broken)]))) ([builtins scheduler] (make-runtime builtins scheduler {})) ([builtins scheduler conf] - (println "rt") (p/let [prep (make-runtime-internal scheduler conf builtins) - _ (println "1a") runtime (update prep :server servers/load-builtins! builtins) - _ (println "2") build-in-names (p/all (map (partial resolve-name runtime) (keys builtins))) - _ (println "3") - asts (p/all (map (partial load-by-id runtime) build-in-names)) - _ (println "4") - rt (update runtime :server eval-all asts)] - (println "rt done") - rt))) + asts (p/all (map (partial load-by-id runtime) build-in-names))] + (update runtime :server eval-all asts)))) (defn link-storage "" @@ -264,29 +262,27 @@ (p/let [defs (if (= (:samak.nodes/type defns) :samak.nodes/def) (:samak.nodes/rhs defns) (:samak.nodes/definition defns)) - ;; _ (println "id" id "- defns" defns) kvs (:samak.nodes/mapkv-pairs defs) - ;; _ (println "kvs" kvs) sources (get-ids-from-source-def kvs #{:sources}) source-ids (apply sorted-set (map get-id-from-source-val sources)) - _ (println "source-ids:" source-ids) + _ (println "### source-ids:" source-ids) sinks (get-ids-from-source-def kvs #{:sinks}) sink-ids (apply sorted-set (map get-id-from-source-val sinks)) - _ (println "sink-ids:" sink-ids) + _ (println "### sink-ids:" sink-ids) deps (get-ids-from-source-def kvs #{:depends}) dep-ids (mapv get-id-from-source-val deps) - _ (println "dep-ids" dep-ids) + _ (println "### dep-ids" dep-ids) deps-source-ids (p/all (map (fn [dep] - (println "dep" dep) + (println "### dep" dep) (p/let [ast (load-by-id rt dep)] (load-def-from-bundle rt dep ast))) dep-ids)) - _ (println "dep-s-id" deps-source-ids) + _ (println "### dep-s-id" deps-source-ids) def {id {:depends dep-ids :dependencies deps-source-ids :sinks sink-ids :roots source-ids}}] - (println "def: " def) + (println "### def: " def) def)) diff --git a/src/samak/runtime/servers.cljc b/src/samak/runtime/servers.cljc index 3b6ae83..46e26a1 100644 --- a/src/samak/runtime/servers.cljc +++ b/src/samak/runtime/servers.cljc @@ -21,8 +21,15 @@ (defrecord LocalSamakServer [defined-ids builtins manager] SamakServer (eval-ast [this {:keys [db/id] :as ast}] - (let [man (assoc (get this :manager) :resolve #(get defined-ids %))] - (update this :defined-ids assoc id (n/eval-env man builtins ast id)))) + ;; (println "eval <-" id ast) + (let [defs (atom (get-defined this)) + man (merge (get this :manager) + {:resolve (fn [x] (get @defs x)) + :register (fn [did def] (swap! defs assoc did def))}) + def (n/eval-env man builtins ast id)] + (swap! defs assoc id def) + ;; (println "eval ->" id def) + (assoc this :defined-ids @defs))) (get-defined [this] (get this :defined-ids)) (load-builtins [this builtins] @@ -45,7 +52,6 @@ (defn load-builtins! "" [server builtins] - (println "load-builtins" server builtins) (load-builtins server builtins)) (defn make-local-server [manager] diff --git a/src/samak/runtime/stores.cljc b/src/samak/runtime/stores.cljc index 36c9592..368ccfa 100644 --- a/src/samak/runtime/stores.cljc +++ b/src/samak/runtime/stores.cljc @@ -52,9 +52,11 @@ (put! (pipes/in-port out) {:samak.runtime/type :samak.runtime/store :cmd :persist-tree :args {:id id :tree tree}}) (go-loop [] ;;FIXME timeouts leak (when-let [i (" module) (p/all (map #(eval-module rt conf % (:id %)) (:deps module))) - (println "loading" (:id module)) + (println "### loading" (:id module)) (p/let [roots (:roots module) base (if root [root] []) root-ids (into (into base (:nodes roots)) (:pipes roots)) _ (println "[" (:id module) "] roots" root-ids) asts (p/all (map #(run/load-ast @rt %) root-ids))] - (println "evaling" (:id module)) + (println "### evaling" (:id module)) (reset! rt (update @rt :server run/eval-all asts)) - (println "done" (:id module)))))) + (println "### done" (:id module)))))) (defn run-module "" @@ -106,8 +106,8 @@ (defn setup-out "" [rt [key pipe]] - (println (:id @rt) "setup out" key) - (let [wrap (pipes/transduction-pipe (map (run/wrap-out {:named key} :setup)))] + (println (:id @rt) "### setup out" key) + (let [wrap (pipes/transduction-pipe (map (run/wrap-out {:named key} :setup)) (str "scheduler-out-" key))] (pipes/link! pipe wrap) (pipes/link! wrap (:broadcast @rt)))) @@ -123,7 +123,7 @@ [rt conf net sym] (p/let [mod-name (module-id 'lone)] (eval-module rt conf net (:id net)) - (println (:id @rt) "module" sym "done \\o/") + (println (:id @rt) "### module" sym "done \\o/") (run-module rt (:id net) mod-name) (let [mod (run/resolve-fn @rt mod-name)] (println (:id @rt) "mod" mod-name mod) diff --git a/src/samak/stdlib.cljc b/src/samak/stdlib.cljc index dd9591f..d89e50d 100644 --- a/src/samak/stdlib.cljc +++ b/src/samak/stdlib.cljc @@ -31,12 +31,17 @@ (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) + + ;; Utility helper (defn debug - ([] (pipes/pipe (chan))) - ([spec] (debug spec (helpers/uuid))) - ([spec id] (pipes/checked-pipe (debug) spec spec id))) + ([] (debug (helpers/uuid))) + ([id] (debug id nil)) + ([id spec] + (if spec + (pipes/checked-pipe (debug) spec spec id) + (pipes/pipe (pipes/pipe-chan id nil) id)))) (defn log-through ([] @@ -45,20 +50,21 @@ (pipes/transduction-pipe (map (if prefix (fn [x] (tools/log prefix x) x) - (fn [x] (tools/log x) x)))))) + (fn [x] (tools/log x) x))) + (str "logthrough-" prefix)))) (defn log ([] (log (rand-int 100000))) ([prefix] - (let [log-chan (chan)] + (let [log-chan (pipes/pipe-chan prefix nil)] (go-loop [] (when-let [x ( f p/eval-as-fn wrap-samak-reducer) (tt/re-wrap (pipes/make-meta {:samak.pipes/source ::reductions}) - init)))) + init)) + (str "reductions-" (helpers/uuid)))) (def pipe-symbols @@ -146,8 +114,4 @@ 'pipes/log-through log-through 'pipes/debug debug 'pipes/http http - 'pipes/eval-notify eval-notify - - ;; 'pipes/eval-line eval-line - 'pipes/reductions reductions*}) diff --git a/src/samak/test_programs.cljc b/src/samak/test_programs.cljc index d7bd627..4dc5e1b 100644 --- a/src/samak/test_programs.cljc +++ b/src/samak/test_programs.cljc @@ -72,15 +72,15 @@ "(def out (pipes/log))" "(def out2 (pipes/log))" "(def incinc (-> (inc _) (inc _)))" - "(| in incinc out2)" "(| in incinc out)" - "(def tl {:source {:main in} - :tests {:test {:when {\"in\" [1]} - :then {\"out\" [(-> (incase (= 3 _) :success))] - \"out2\" [(-> (incase (= 3 _) :success))]}} - :test2 {:when {\"in\" [3]} - :then {\"out\" [(-> (incase (= 5 _) :success))]}} + "(| in incinc out2)" + "(defmodule tl {:sources {:main in :out out :out2 out2} :sinks {:out out :out2 out2} + :tests {:test {:when {\"in\" [1]} + :then {\"out\" [(-> (incase (= 3 _) :success))] + \"out2\" [(-> (incase (= 3 _) :success))]}} }})"]) + ;; :test2 {:when {\"in\" [3]} + ;; :then {\"out\" [(-> (incase (= 5 _) :success))]}} (def test-local-modules [ @@ -93,38 +93,54 @@ (def test-builtin-modules ["(def in (pipes/debug))" - "(def mod (modules/caravan))" - "(def a (-> mod :-sinks :-actions))" - "(| in (a 42))" - "!f in \"!!!\"" + "(def out (pipes/log))" + "(def mod ((modules/caravan)))" + "(def a ((-> mod :-sinks :-actions) 42))" + "(def b ((-> mod :-sources :-commands) 42))" + "(| in a)" + "(| b out)" + "!f in {:ping 1}" ]) (def test-local-modules-test - [ - "(def in (pipes/debug))" + ["(def in (pipes/debug))" "(def out (pipes/debug))" "(| in (inc _) out)" "(defmodule bar {:sources {:in in} :sinks {:out out} :tests {:t1 {:when {\"in\" [1]} - :then {\"out\" [(incase 2 :success)]}}} + :then {\"out\" [(incase (= 2 _) :success)]}}} })" ]) + (def test-builtin-modules-test ["(def in (pipes/debug))" "(def out (pipes/debug))" - "(def mod ((modules/caravan) 42))" - "(def a ((-> mod :-sinks :-actions) 42))" - "(def b ((-> mod :-sources :-commands) 42))" + "(def mod ((modules/caravan)))" + "(def act (-> mod :-sinks :-actions))" + "(def cmd (-> mod :-sources :-commands))" + "(def a (act 42))" + "(def b (cmd 42))" "(| in a)" "(| b out)" - "(def bar {:sources {:in in :fake b} - :tests {:test {:when {\"in\" [{:ping :me}]} - :then {\"out\" [(incase (:-pong _) :success)]}}}})" - ;; "!f in \"!!!\"" + "(defmodule bar {:sources {:in in :b b} + :sinks {:out out} + :tests {:t1 {:when {\"in\" [:ping]} + :then {\"out\" [(-> (spy \"pong\") (incase (= :pong :-event) :success))]}}} + })" ]) +(def test-local-modules-multi-test + ["(def in (pipes/debug))" + "(def out (pipes/debug))" + "(| in (inc _) out)" + "(defmodule bar {:sources {:in in} + :sinks {:out out} + :tests {:t1 {:when {\"in\" [1]} + :then {\"out\" [(incase (= 2 _) :success)]}}} + })" + ]) (def test-nested-modules-test ["(def in (pipes/debug))" @@ -138,7 +154,7 @@ :sources {:in in :b b :mod mod} :sinks {:out out} :tests {:t1 {:when {\"in\" [1]} - :then {\"out\" [(incase 2 :success)]}}}})" + :then {\"out\" [(incase (= 2 _) :success)]}}}})" "(def s (pipes/debug))" "(def t (pipes/debug))" "(| s t)" @@ -154,6 +170,7 @@ "(def barin ((-> barmod :-sources :-in) 42))" "(def barout ((-> barmod :-sinks :-out) 42))" "(| x quuxin)" + "(| x barin)" "(defmodule baz {:depends {:bar bar :quux quux} :sources {:x x :barmod barmod} :tests {:t1 {:when {\"in\" [1]} @@ -161,6 +178,32 @@ ;; "!f in \"!!!\"" ]) +(def test-nested-modules-multi-test + ["(def in (pipes/debug))" + "(def out (pipes/debug))" + "(def red (pipes/reductions (+ :-next :-state) 0))" + "(| in red)" + "(| red out)" + "(defmodule bar {:sources {:in in :b b :mod mod} + :sinks {:out out} + :tests {:t1 {:when {\"in\" [1]} + :then {\"out\" [(incase (= 2 _) :success)]}}}})" + "(def x (pipes/debug))" + "(def barmod (bar))" + "(def barin ((-> barmod :-sources :-in) 42))" + "(def barout ((-> barmod :-sinks :-out) 42))" + "(def barmod2 (bar))" + "(def barin2 ((-> barmod2 :-sources :-in) 42))" + "(def barout2 ((-> barmod2 :-sinks :-out) 42))" + "(| x barin)" + "(| x barin2)" + "(defmodule baz {:depends {:bar bar} + :sources {:x x :barmod barmod :barmod2 barmod2} + :tests {:t1 {:when {\"x\" [1]} + :then {\"barin\" [(incase false :success)]}}}})" + ;; "!f in \"!!!\"" + ]) + (def chuck ["(def in (pipes/debug)) diff --git a/test/samak/caravan_test.cljc b/test/samak/caravan_test.cljc index 31bf22b..d4c12b2 100644 --- a/test/samak/caravan_test.cljc +++ b/test/samak/caravan_test.cljc @@ -5,10 +5,12 @@ [samak.oasis :as oasis] [samak.core :as core] [samak.runtime :as rt] - [samak.test-programs :as test-programs] + [samak.test-programs :as test-programs] [samak.code-db :as db] [samak.utils :as utils] [samak.trace :as trace] + [samak.scheduler :as sched] + [promesa.core :as p] #?(:clj [clojure.core.async :as a :refer [ (sut/make-runtime) - (sut/eval-expression! def-node) - (sut/eval-expression! referring-node)) - vs (-> rt - :server - servers/get-defined - vals)] + (p/let [rt (-> (sut/make-runtime) + (sut/eval-expression! def-node) + (sut/eval-expression! referring-node)) + vs (-> rt + :server + servers/get-defined + vals)] (is (= 2 (count vs))) (is (apply = vs)))) @@ -84,10 +86,19 @@ (deftest should-persist-builtins (utils/test-promise (p/then (sut/make-runtime {'inc inc 'dec dec}) - #(do (println "?") - (is (= + #(is (= inc (-> % :server servers/get-defined - (get 1)))))))) + (get 1))))))) + + +(deftest should-load-def-from-bundle + (utils/test-promise + (p/let [code [(api/defmodule 'test (api/map {(api/keyword :sources) (api/map {(api/keyword :test1) (api/symbol 'inc)})}))] + rt (sut/make-runtime core/samak-symbols) + _ (sut/persist-to-ids! (:store rt) code) + defns (sut/load-by-sym rt 'test) + def (sut/load-def-from-bundle rt 'test defns)] + (is (= {'test {:depends [], :dependencies [], :sinks #{}, :roots #{151}}} def))))) diff --git a/test/samak/scheduler_test.cljc b/test/samak/scheduler_test.cljc new file mode 100644 index 0000000..c794727 --- /dev/null +++ b/test/samak/scheduler_test.cljc @@ -0,0 +1,25 @@ +(ns samak.scheduler-test + (:require [samak.scheduler :as sut] + #?(:clj [clojure.test :as t] + :cljs [cljs.test :as t :include-macros true]) + [clojure.string :as s] + [promesa.core :as prom] + [samak.core :as core] + [samak.lisparser :as p] + [samak.runtime :as rt] + [samak.test-programs :as test-programs] + [samak.utils :as utils])) + +(t/deftest should-load-module + (utils/test-promise + (prom/then (prom/let [rt (rt/make-runtime core/samak-symbols) + parsed (p/parse-all (s/join " " test-programs/tl6)) + _ (rt/persist-to-ids! (:store rt) (:value parsed)) + bundle-id (rt/resolve-name rt 'tl)] + (sut/load-bundle-by-id rt bundle-id)) + #(t/is (= {:id 227, + :deps [], + :sinks #{200 203}, + :sources #{197 200 203}, + :roots {:nodes '(197 200 203 206), :pipes '(219 223)}} + %))))) diff --git a/ui_src/samak/caravan.cljc b/ui_src/samak/caravan.cljc index 7b24174..613b1b2 100644 --- a/ui_src/samak/caravan.cljc +++ b/ui_src/samak/caravan.cljc @@ -44,7 +44,9 @@ (:require-macros [cljs.core.async.macros :refer [go go-loop]])])) (def rt-conn (atom {:state :uninited})) -(def rt-preview (atom {})) + +(def rt-link-fn (atom nil)) + (def fns (atom {})) (def net (atom {})) @@ -231,8 +233,6 @@ ;; (println (str "function cache: " (keys @fns))) (swap! fns assoc sym fn) (swap! rt-conn #(update % :server rt/eval-all [fn])) - ;; (swap! rt-preview rt/link-storage (:store @rt-conn)) - ;; (reset-rt rt-preview) (format-node sym fn)) (defn name-of-node @@ -282,9 +282,7 @@ (println (str "adding pipe from " source " with " func " to " sink)) (when (and source func sink) ;; (swap! net assoc key pipe) - ;; (swap! rt-preview rt/link-storage (:store @rt-conn)) (swap! rt-conn #(update % :server rt/eval-all [pipe])) - ;; (reset-rt rt-preview) (format-pipe pipe)))) @@ -311,7 +309,7 @@ "" [exp] (prom/let [loaded (persist! @rt-conn [(assoc exp :db/id -1)]) - _ (println "single" loaded) + _ (println "### single" loaded) ast (load-ast @rt-conn (:db/id (first loaded)))] ast)) @@ -407,7 +405,7 @@ (defn add-cell "" [ev {:keys [sym cell type] :as x}] - (println (str "adding: " x)) + (println (str "### adding: " x)) (let [src (get @fns (symbol sym)) idx (dec cell)] (when (and sym src idx type) @@ -542,42 +540,45 @@ (notify-source ev (add-node (symbol sym) exp)) :done))))))) - (defn link-pipes "" [from to xf] - (rt/link-fn from - to - (when xf (pipes/transduction-pipe (pipes/instrument :caravan/adhoc nil xf))))) + ((:link (:manager @rt-conn)) + from + to + (when xf (pipes/transduction-pipe (pipes/instrument :caravan/adhoc nil xf) (str (pipes/uuid from) "-" (pipes/uuid to)))))) (defn find-tests "" [conf] - (println "conf " conf) + (println "### conf " conf) (when conf (prom/let [is-module (= (:samak.nodes/type conf) :samak.nodes/module) - sym (if is-module (symbol (str "test-" (:samak.nodes/name conf))) (symbol (:samak.nodes/name conf))) - conf (if is-module - (api/defexp sym (api/fn-call conf [])) - conf) - rt2 (update @rt-conn :server #(rt/eval-all % [conf])) - evaled (rt/get-definition-by-name rt2 sym)] - (println "evaled " evaled) + sym (if is-module (symbol (str "test-" (:samak.nodes/name conf))) (symbol (:samak.nodes/name conf))) + conf (if is-module + (assoc (api/defexp sym (api/fn-call conf [])) :db/id sym) + conf) + rt2 (update @rt-conn :server #(rt/eval-all % [conf])) + evaled (if is-module + (rt/get-definition-by-id rt2 sym) + (rt/get-definition-by-name rt2 sym))] ;; (println "evaled " (:samak.nodes/definition evaled)) (:tests evaled)))) (defn attach-assert "" [verify source-pipe xf-fn test-fn] - (prom/let [assert-name (str "assert-" (rand-int 1000000)) - assert-exp (api/defexp (symbol assert-name) (api/fn-call (api/symbol 'pipes/debug) [])) + (prom/let [assert-name (symbol (str "assert-" (rand-int 1000000))) + assert-exp (api/defexp assert-name (api/fn-call (api/symbol 'pipes/debug) [])) assert-ast (single! assert-exp)] - (add-node (symbol assert-name) assert-ast) - (prom/let [assert-pipe (rt/get-definition-by-name @rt-conn (symbol assert-name)) - verify-pipe (rt/get-definition-by-name @rt-conn (symbol verify))] - (link-pipes source-pipe assert-pipe xf-fn) - (link-pipes assert-pipe verify-pipe test-fn)))) + (prom/do! + (add-node assert-name assert-ast) + (prom/let [assert-pipe (rt/get-definition-by-id @rt-conn (:db/id assert-ast)) + verify-pipe (rt/get-definition-by-id @rt-conn verify)] + (prom/do! + (link-pipes source-pipe assert-pipe xf-fn) + (link-pipes assert-pipe verify-pipe test-fn)))))) (defn resolve-sym-or-fn "" @@ -587,11 +588,11 @@ (do (println exp) (prom/let [ast (load-ast @rt-conn (:db/id exp))] - (println "loaded" ast) + (println "### loaded" ast) (swap! rt-conn #(update % :server rt/eval-all [ast]))) - (println "evaled" exp) + (println "### evaled" exp) (let [r (rt/resolve-fn @rt-conn (:db/id exp))] - (println "resolved " r) + (println "### resolved " r) r) ))) @@ -610,11 +611,12 @@ (str "[" (:db/id xf) "] " (:samak.nodes/name xf)) "~none~") "to" sink-name) - (let [xf-pipe (get (servers/get-defined (:server @rt-conn)) (:db/id xf))] - (when test-ref - (println " V" "Verifying pipe:" sink-name "with" test-ref) - (attach-assert verify source xf-pipe (first test-ref))) - (link-pipes source sink xf-pipe)))) + (prom/let [xf-pipe (get (servers/get-defined (:server @rt-conn)) (:db/id xf))] + (prom/do! + (when test-ref + (println " V" "Verifying pipe:" sink-name "with" test-ref) + (attach-assert verify source xf-pipe (first test-ref))) + (link-pipes source sink xf-pipe))))) (defn setup-verify @@ -625,7 +627,7 @@ verify-exp (api/defexp verify-name (api/fn-call (api/symbol 'pipes/debug) [])) verify-ast (single! verify-exp)] (add-node verify-name verify-ast) - verify-name)) + (:db/id verify-ast))) (defn handle-source @@ -645,7 +647,7 @@ (defn handle-mod "" [module] - (println "mod" module) + (println "### mod" module) (let [id (:id module) root (:roots module)] {id {:caravan/type :caravan/module @@ -674,30 +676,31 @@ (defn handle-deps "" [deps] - (reduce (fn [acc x] - (let [roots (database-net (:roots x))] - {:nodes (into [] (concat (:nodes acc) (:nodes roots))) - :pipes (into [] (concat (:pipes acc) (:pipes roots))) - :modules (conj (:modules acc) (handle-mod x))})) - {:nodes [] - :pipes [] - :modules []} - deps)) + (prom/let [init (prom/resolved {:nodes [] + :pipes [] + :modules []})] + (reduce (fn [promise x] (prom/handle promise + (fn [acc _] + (prom/let [roots (database-net (:roots x))] + {:nodes (into [] (concat (:nodes acc) (:nodes roots))) + :pipes (into [] (concat (:pipes acc) (:pipes roots))) + :modules (conj (:modules acc) (handle-mod x))})))) + init + deps))) (defn eval-bundle "" - [rt id] - (prom/let [bundle (sched/load-bundle-by-id @rt id) - _ (println "ev b" bundle) + [bundle] + (prom/let [_ (println "### ev b" bundle) roots (:roots bundle) deps (handle-deps (:deps bundle)) - _ (println "deps" deps) + _ (println "### deps" deps) net (database-net roots) rootnotify (assoc net :modules [(handle-mod bundle)]) ;; rootnotify (database-net roots) - _ (println "root" rootnotify) + _ (println "### root" rootnotify) a1 (merge-with into rootnotify deps) - _ (println "ev n" a1)] + _ (println "### ev n" a1)] (assoc a1 :id (:id bundle)) )) @@ -707,8 +710,9 @@ [sym test] (prom/let [verify (setup-verify) bundle (sched/load-bundle @rt-conn sym)] - (runtime-net (:roots bundle) test verify) - verify)) + (prom/do! + (runtime-net (:roots bundle) test verify) + verify))) (defn trace-dump "" @@ -741,21 +745,20 @@ [c sym [name tst]] (println (str "test " name " - " tst)) - (let [verify (test-bundle sym tst)] - (go (prom/let [pipe (rt/get-definition-by-name @rt-conn verify) - listener (chan 1)] - (a/tap (.-out pipe) listener) ;; TODO: FIX protocol? - (loop [results []] - (let [msg (! c (or (some #(when (not= :success (:samak.pipes/content %)) %) results) :success)) - (recur results)))))) + (prom/let [verify (test-bundle sym tst) + pipe (rt/get-definition-by-id @rt-conn verify) + listener (pipes/pipe-chan ::listener 100)] + (go-loop [results []] + (let [msg (! c (or (some #(when (not= :success (:samak.pipes/content %)) %) results) :success)) + (recur results)))) + (a/tap (.-out pipe) listener) (doall (map (fn [[pipe-name values]] - (println (str "pipe " (str pipe-name) " values: " values)) (prom/let [pipe (rt/get-definition-by-name @rt-conn (symbol pipe-name))] + (println (str "### pipe [" (str pipe-name) "] " pipe " values: " values)) (if (nil? pipe) (println "no such pipe: " pipe-name) (doall (map #(run-event pipe pipe-name %) values))))) @@ -772,7 +775,7 @@ _ (println "Loading test definitions") tests (find-tests net) test-num (count tests) - test-results-chan (chan 1)] + test-results-chan (pipes/pipe-chan ::result 100)] (if (zero? test-num) (a/put! c :no-tests) (go-loop [results [] @@ -789,7 +792,8 @@ (defn load-lib "" [cmd ev bundle-id] - (prom/let [bundle (eval-bundle rt-conn bundle-id)] + (prom/let [bundle-code (sched/load-bundle-by-id @rt-conn bundle-id) + bundle (eval-bundle bundle-code)] ;; (println (str "count: " cnt)) (doall (map #(notify-source ev %) (:modules bundle))) (doall (map #(notify-source ev %) (:nodes bundle))) @@ -815,8 +819,8 @@ (defn test-net "" [c prog sym] - (persist-net prog) - (run-testsuite c sym {:timeout 3000})) + (prom/do! (persist-net prog) + (run-testsuite c sym {:timeout 10000}))) (defn load-chuck "" @@ -970,8 +974,7 @@ (defn pong "" [caravan-out x] - (tools/log "ponging: " x caravan-out) - (a/put! caravan-out (pipes/make-paket {::event ::pong} ::caravan))) + (a/put! caravan-out (pipes/make-paket {:event :pong} ::caravan))) (defn caravan-module @@ -979,18 +982,22 @@ [] (println "def caravan") (fn [] - (println "init caravan") - (let [caravan-in (chan) - caravan-cmd (chan) - caravan-eval (chan)] + (let [inst (helpers/uuid) + caravan-in (pipes/pipe-chan ::in nil) + caravan-cmd (pipes/pipe-chan ::cmd nil) + caravan-eval (pipes/pipe-chan ::eval nil) + caravan-in-pipe (pipes/sink caravan-in) + caravan-cmd-pipe (pipes/source caravan-cmd) + caravan-eval-pipe (pipes/source caravan-eval)] + (println "init caravan" inst) (go-loop [] (when-let [x (" foo) foo)))) diff --git a/ui_src/samak/oasis.cljc b/ui_src/samak/oasis.cljc index 0243f90..b50a3d2 100644 --- a/ui_src/samak/oasis.cljc +++ b/ui_src/samak/oasis.cljc @@ -149,9 +149,9 @@ (api/key-fn :button) (api/fn-call (api/symbol '=) [(api/symbol '_) (api/keyword :primary)])])])) - (defncall 'raw-events 'pipes/debug) - (defncall 'reduced-events 'pipes/debug) - (defncall 'events 'pipes/debug) + (defncall 'raw-events 'pipes/debug (api/string "raw-events")) + (defncall 'reduced-events 'pipes/debug (api/string "reduced-events")) + (defncall 'events 'pipes/debug (api/string "events")) (defncall 'merge-state '-> (api/vector [(api/key-fn :state) (api/key-fn :next)]) @@ -267,7 +267,7 @@ (api/key-fn :which) (api/fn-call (api/symbol '>) [(api/integer 31) (api/symbol '_)])) - (defncall 'keyboard-filtered 'pipes/debug) + (defncall 'keyboard-filtered 'pipes/debug (api/string "keyboard-filtered")) (defncall 'filter-key-input 'except (api/fn-call (api/symbol 'and) [(api/symbol 'is-target-input) (api/symbol 'is-key-common)])) @@ -754,7 +754,7 @@ (api/vector [(api/vector [(api/symbol 'eval-id) (api/symbol '_)])]) (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])) - (defncall 'eval-events 'pipes/debug ;; (api/keyword :oasis.spec/eval-state) + (defncall 'eval-events 'pipes/debug (api/string "eval-events") ;; (api/keyword :oasis.spec/eval-state) ) ;; (defncall 'extract-eval '-> @@ -770,32 +770,32 @@ (api/fn-call (api/symbol 'into) [(api/map {}) (api/symbol '_)])]) (api/map {})) - (defncall 'eval-raw 'pipes/debug ;; (api/keyword :oasis.spec/eval-state) + (defncall 'eval-raw 'pipes/debug (api/string "eval-raw") ;; (api/keyword :oasis.spec/eval-state) ) (defncall 'tag-eval '-> ;; (api/fn-call (api/symbol 'spy) [(api/string "evaled")]) (api/map {(api/keyword :eval) (api/symbol '_)})) - (defncall 'eval-state 'pipes/debug ;; (api/keyword :oasis.spec/eval-state) + (defncall 'eval-state 'pipes/debug (api/string "eval-state") ;; (api/keyword :oasis.spec/eval-state) )]) (def oasis2 [ ;; commands - (defncall 'editor-commands 'pipes/debug) - (defncall 'editor-events 'pipes/debug) - (defncall 'editor-cooked 'pipes/debug) - (defncall 'editor-immediate 'pipes/debug) - (defncall 'editor-actions 'pipes/debug) - (defncall 'editor-state 'pipes/debug) - (defncall 'select-events 'pipes/debug) + (defncall 'editor-commands 'pipes/debug (api/string "editor-commands")) + (defncall 'editor-events 'pipes/debug (api/string "editor-events")) + (defncall 'editor-cooked 'pipes/debug (api/string "editor-cooked")) + (defncall 'editor-immediate 'pipes/debug (api/string "editor-immediate")) + (defncall 'editor-actions 'pipes/debug (api/string "editor-actions")) + (defncall 'editor-state 'pipes/debug (api/string "editor-state")) + (defncall 'select-events 'pipes/debug (api/string "select-events")) - (defncall 'be-commands 'pipes/debug) + (defncall 'be-commands 'pipes/debug (api/string "be-commands")) (defncall 'filter-call 'only (api/key-fn :call)) - (defncall 'mode-state 'pipes/debug) - (defncall 'mode-raw 'pipes/debug) + (defncall 'mode-state 'pipes/debug (api/string "mode-state")) + (defncall 'mode-raw 'pipes/debug (api/string "mode-raw")) (defncall 'is-immediate-command '-> (api/key-fn :type) @@ -1193,10 +1193,10 @@ (api/keyword :hovered) (api/map {}) (api/keyword :hover) (api/vector [])})) - (defncall 'source-menu 'pipes/debug) - (defncall 'source-menu-items 'pipes/debug) - (defncall 'source-menu-events 'pipes/debug) - (defncall 'source-menu-state 'pipes/debug) + (defncall 'source-menu 'pipes/debug (api/string "source-menu")) + (defncall 'source-menu-items 'pipes/debug (api/string "source-menu-items")) + (defncall 'source-menu-events 'pipes/debug (api/string "source-menu-events")) + (defncall 'source-menu-state 'pipes/debug (api/string "source-menu-state")) (defncall 'source-menu-const '-> @@ -1205,10 +1205,10 @@ (api/string "http")]) (api/symbol 'many)) - (defncall 'sink-menu 'pipes/debug) - (defncall 'sink-menu-items 'pipes/debug) - (defncall 'sink-menu-events 'pipes/debug) - (defncall 'sink-menu-state 'pipes/debug) + (defncall 'sink-menu 'pipes/debug (api/string "sink-menu")) + (defncall 'sink-menu-items 'pipes/debug (api/string "sink-menu-items")) + (defncall 'sink-menu-events 'pipes/debug (api/string "sink-menu-events")) + (defncall 'sink-menu-state 'pipes/debug (api/string "sink-menu-state")) (defncall 'sink-menu-const '-> (api/vector [(api/string "debug") @@ -1297,9 +1297,9 @@ ;; global state - (defncall 'load-state 'pipes/debug ;; (api/keyword :oasis.spec/state) + (defncall 'load-state 'pipes/debug (api/string "load-state") ;; (api/keyword :oasis.spec/state) ) - (defncall 'loaded-state 'pipes/debug ;; (api/keyword :oasis.spec/state) + (defncall 'loaded-state 'pipes/debug (api/string "loaded-state") ;; (api/keyword :oasis.spec/state) ) (defncall 'load-reduce 'pipes/reductions @@ -1317,7 +1317,7 @@ (defncall 'tag-layout '-> (api/map {(api/keyword :layout) (api/key-fn :success)})) - (defncall 'layout-state 'pipes/debug ;; (api/keyword :oasis.spec/state) + (defncall 'layout-state 'pipes/debug (api/string "layout-state") ;; (api/keyword :oasis.spec/state) ) @@ -1514,7 +1514,7 @@ })) - (defncall 'lay-in 'pipes/debug) + (defncall 'lay-in 'pipes/debug (api/string "lay-in")) (defncall 'edit-information '-> @@ -1947,14 +1947,14 @@ ]) (def oasis-core-defs - [(defncall 'oasis-core-init 'pipes/debug) - (defncall 'oasis-kb 'pipes/debug) - (defncall 'oasis-hover-state 'pipes/debug) - (defncall 'oasis-hover-in 'pipes/debug) - (defncall 'oasis-scroll-state 'pipes/debug) - (defncall 'oasis-drag-state 'pipes/debug) - (defncall 'oasis-core-events 'pipes/debug) - (defncall 'oasis-core-out 'pipes/debug) + [(defncall 'oasis-core-init 'pipes/debug (api/string "oasis-core-init")) + (defncall 'oasis-kb 'pipes/debug (api/string "oasis-kb")) + (defncall 'oasis-hover-state 'pipes/debug (api/string "oasis-hover-state")) + (defncall 'oasis-hover-in 'pipes/debug (api/string "oasis-hover-in")) + (defncall 'oasis-scroll-state 'pipes/debug (api/string "oasis-scroll-state")) + (defncall 'oasis-drag-state 'pipes/debug (api/string "oasis-drag-state")) + (defncall 'oasis-core-events 'pipes/debug (api/string "oasis-core-events")) + (defncall 'oasis-core-out 'pipes/debug (api/string "oasis-core-out")) (defncall 'log-drag 'pipes/log (api/string "drag: ")) (defncall 'log-hover 'pipes/log (api/string "hover: ")) @@ -2095,15 +2095,15 @@ (def oasis-render-defs [ - (defncall 'oasis-render-in 'pipes/debug) - (defncall 'oasis-render-init 'pipes/debug) - (defncall 'oasis-render-mouse-in 'pipes/debug) - (defncall 'oasis-render-kb-in 'pipes/debug) - (defncall 'oasis-render-kb-out 'pipes/debug) - (defncall 'oasis-render-drag-out 'pipes/debug) - (defncall 'oasis-render-hover-out 'pipes/debug) - (defncall 'oasis-render-out 'pipes/debug) - (defncall 'scroll-state 'pipes/debug) + (defncall 'oasis-render-in 'pipes/debug (api/string "oasis-render-in")) + (defncall 'oasis-render-init 'pipes/debug (api/string "oasis-render-init")) + (defncall 'oasis-render-mouse-in 'pipes/debug (api/string "oasis-render-mouse-in")) + (defncall 'oasis-render-kb-in 'pipes/debug (api/string "oasis-render-kb-in")) + (defncall 'oasis-render-kb-out 'pipes/debug (api/string "oasis-render-kb-out")) + (defncall 'oasis-render-drag-out 'pipes/debug (api/string "oasis-render-drag-out")) + (defncall 'oasis-render-hover-out 'pipes/debug (api/string "oasis-render-hover-out")) + (defncall 'oasis-render-out 'pipes/debug (api/string "oasis-render-out")) + (defncall 'scroll-state 'pipes/debug (api/string "scroll-state")) (defncall 'log-view 'pipes/log (api/string "view: ")) (defncall 'log-mouse2 'pipes/log (api/string "mouse2: ")) (defncall 'log-hov 'pipes/log (api/string "hov: ")) @@ -2168,15 +2168,15 @@ ;; View handling - (defncall 'view-raw 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'view-raw 'pipes/debug (api/string "view-raw") ;; (api/keyword :oasis.spec/mouse-state) ) - (defncall 'view-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'view-state 'pipes/debug (api/string "view-state") ;; (api/keyword :oasis.spec/mouse-state) ) - (defncall 'view-deltas 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'view-deltas 'pipes/debug (api/string "view-deltas") ;; (api/keyword :oasis.spec/mouse-state) ) - (defncall 'view-commands 'pipes/debug) - (defncall 'view-events 'pipes/debug) - (defncall 'zoom-events 'pipes/debug) + (defncall 'view-commands 'pipes/debug (api/string "view-commands")) + (defncall 'view-events 'pipes/debug (api/string "view-events")) + (defncall 'zoom-events 'pipes/debug (api/string "zoom-events")) (defncall 'init-view '-> (api/map {(api/keyword :zoom) (api/integer 1) @@ -2235,7 +2235,7 @@ ;; Mouse handling - (defncall 'drag-events 'pipes/debug) + (defncall 'drag-events 'pipes/debug (api/string "drag-events")) (defncall 'is-mouse-move '-> (api/key-fn :next) @@ -2309,7 +2309,7 @@ (api/map {(api/keyword :mouse) (api/symbol '_)})]) (api/map {(api/keyword :mouse) (api/map {})})) - (defncall 'mouse-state 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'mouse-state 'pipes/debug (api/string "mouse-state") ;; (api/keyword :oasis.spec/mouse-state) ) (defncall 'is-drag '-> @@ -2379,7 +2379,7 @@ (api/keyword :name) (api/string "none") (api/keyword :id) (api/string "none")})})) - (defncall 'target-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'target-events 'pipes/debug (api/string "target-events") ;; (api/keyword :oasis.spec/mouse-state) ) (defncall 'only-different '-> @@ -2388,9 +2388,9 @@ (api/fn-call (api/symbol 'count) [(api/symbol '_)]) (api/fn-call (api/symbol '=) [(api/symbol '_) (api/integer 1)])])])) - (defncall 'hover-events 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'hover-events 'pipes/debug (api/string "hover-events") ;; (api/keyword :oasis.spec/mouse-state) ) - (defncall 'hover-out 'pipes/debug ;; (api/keyword :oasis.spec/mouse-state) + (defncall 'hover-out 'pipes/debug (api/string "hover-out") ;; (api/keyword :oasis.spec/mouse-state) ) (defncall 'tag-hover '-> (api/map {(api/keyword :hover) (api/symbol '_)})) @@ -2820,7 +2820,7 @@ (api/fn-call (api/symbol '->) [(api/fn-call (api/symbol 'spy) [(api/string "DROP")]) (api/symbol 'ignore)])])) - (defncall 'condensed-state 'pipes/debug ;; (api/keyword :oasis.spec/state) + (defncall 'condensed-state 'pipes/debug (api/string "condensed-state") ;; (api/keyword :oasis.spec/state) ) (defncall 'only-resize '-> @@ -3625,7 +3625,7 @@ ;; render elements to hiccup - (defncall 'svg-reduced 'pipes/debug ;; (api/keyword :oasis.spec/render) + (defncall 'svg-reduced 'pipes/debug (api/string "svg-reduced") ;; (api/keyword :oasis.spec/render) ) (defncall 'svg-defs '-> @@ -3702,7 +3702,7 @@ ;; render SVG components - (defncall 'svg-render 'pipes/debug) + (defncall 'svg-render 'pipes/debug (api/string "svg-render")) (defncall 'render-svg '-> (api/map {(api/keyword :svg) (api/map {(api/keyword :oasis.gui/order) @@ -3839,13 +3839,13 @@ (defncall 'oasis-ui-events 'pipes/events (api/integer 2)) (defncall 'oasis-ui-mouse 'pipes/mouse) (defncall 'oasis-ui-kb 'pipes/keyboard) - (defncall 'oasis-ev 'pipes/debug) - (defncall 'oasis-ui-mouse-out 'pipes/debug) - (defncall 'oasis-ui-kb-out 'pipes/debug) - (defncall 'oasis-ui-in 'pipes/debug) - (defncall 'render 'pipes/debug ;; (api/keyword :oasis.spec/render) + (defncall 'oasis-ev 'pipes/debug (api/string "oasis-ev")) + (defncall 'oasis-ui-mouse-out 'pipes/debug (api/string "oasis-ui-mouse-out")) + (defncall 'oasis-ui-kb-out 'pipes/debug (api/string "oasis-ui-kb-out")) + (defncall 'oasis-ui-in 'pipes/debug (api/string "oasis-ui-in")) + (defncall 'render 'pipes/debug (api/string "render") ;; (api/keyword :oasis.spec/render) ) - (defncall 'reducer 'pipes/debug ;; (api/keyword :oasis.spec/gui) + (defncall 'reducer 'pipes/debug (api/string "reducer") ;; (api/keyword :oasis.spec/gui) ) (defncall 'elements-reduce 'pipes/reductions (api/fn-call (api/symbol 'into) [(api/key-fn :state) (api/key-fn :next)]) @@ -3893,12 +3893,12 @@ (def oasis-ui-net [ - ;; (pipe 'oasis-ui-in 'render) + (pipe 'oasis-ui-in 'render) (pipe 'oasis-ui-in 'log-render2) - ;; (pipe 'render 'elements-reduce) - ;; (pipe 'elements-reduce 'reducer) + (pipe 'render 'elements-reduce) + (pipe 'elements-reduce 'reducer) - ;; (pipe 'reducer 'render-elements 'oasis-ui-render) + (pipe 'reducer 'render-elements 'oasis-ui-render) ;; (pipe 'oasis-ui-events 'oasis-ev) ;; (pipe 'oasis-ui-mouse 'oasis-ui-mouse-out) @@ -4028,7 +4028,7 @@ (api/vector [(api/keyword :h1) (api/string "사막 Oasis")])})})) - (defncall 'oasis-init 'pipes/debug) + (defncall 'oasis-init 'pipes/debug (api/string "oasis-init")) (api/defmodule 'oasis (api/map {(api/keyword :depends) (api/map {;; (api/keyword :oasis-core) (api/symbol 'oasis-core) ;; (api/keyword :oasis-render) (api/symbol 'oasis-render) @@ -4063,7 +4063,7 @@ ;; (api/keyword :layout) (api/symbol 'oasis-layout) ;; }) ;; ;; (api/keyword :sink) (api/vector [(api/symbol 'oasisp)]) - ;; (api/keyword :tests) (api/map {(api/keyword ::test) + ;; (api/keyword :tests) (api/map {(api/keyword (api/string "test) ;; (api/map {(api/keyword :when) (api/map {(api/string "init") ;; (api/vector [(api/integer 1)])}) ;; (api/keyword :then) (api/map {(api/string "oasis-ui-out") diff --git a/ui_src/samak/ui_stdlib.cljs b/ui_src/samak/ui_stdlib.cljs index 17090ba..9212326 100644 --- a/ui_src/samak/ui_stdlib.cljs +++ b/ui_src/samak/ui_stdlib.cljs @@ -83,7 +83,7 @@ x)) (defn events [n] - (let [c (chan) + (let [c (pipes/pipe-chan ::events nil) init (atom true) elem (if n (js/document.getElementById (str "samak" n)) (.-body js/document)) bound (.getBoundingClientRect elem)] @@ -132,6 +132,7 @@ init (atom true)] (go-loop [] (when-some [i (clj e :keywordize-keys true)] (put-meta! c (convert-key-event event :press) ::keyboard) diff --git a/ui_src/samak/worker.cljc b/ui_src/samak/worker.cljc index d25e791..46389e9 100644 --- a/ui_src/samak/worker.cljc +++ b/ui_src/samak/worker.cljc @@ -61,8 +61,8 @@ (recur)))) (def scheduler - (let [broadcast (pipes/pipe (chan)) - to-rt (pipes/pipe (chan) "worker-scheduler")] + (let [broadcast (pipes/pipe (chan) ::worker-broadcast) + to-rt (pipes/pipe (chan) ::worker-scheduler)] (println "sched") ;; (handle-update "out" broadcast) ;; (handle-update "in" to-rt) diff --git a/ui_src/ui/styles.clj b/ui_src/ui/styles.clj index f4f05ef..eda1124 100644 --- a/ui_src/ui/styles.clj +++ b/ui_src/ui/styles.clj @@ -3,6 +3,6 @@ (defstyles style [:body {:background "#ddd"}] - [:h1 {:color "#f00"}] + [:h1 {:color "#ddd"}] [:p {:font "18px \"Century Gothic\", Futura, sans-serif"}] [:.my-class {:font-size "20px" :background "#ddf"}])