219 lines
5.1 KiB
Clojure
219 lines
5.1 KiB
Clojure
(ns frpong.helpers
|
|
(:require [cljs.core.async :as async
|
|
:refer [<! >! chan put! close! sliding-buffer dropping-buffer timeout]]
|
|
[domina :as dom :refer [log]]
|
|
[domina.events :as ev])
|
|
(:require-macros [cljs.core.async.macros :as m :refer [go]]
|
|
[frpong.core :refer (go-loop)]))
|
|
|
|
(defn now []
|
|
(.valueOf (js/Date.)))
|
|
|
|
(defn put-all! [cs x]
|
|
(doseq [c cs]
|
|
(put! c x)))
|
|
|
|
(defn cconj [v c1]
|
|
(let [c2 (chan)]
|
|
(go
|
|
(>! c2 v)
|
|
(while true
|
|
(>! c2 (<! c1))))
|
|
c2))
|
|
|
|
(defn probe [ch probe-name]
|
|
(let [c (chan)]
|
|
(go-loop
|
|
(let [v (<! ch)]
|
|
(log (str (now) " " probe-name ": " v))
|
|
(>! c v)))
|
|
c))
|
|
|
|
(defn multiplex [in cs-or-n]
|
|
(let [cs (if (number? cs-or-n)
|
|
(repeatedly cs-or-n chan)
|
|
cs-or-n)]
|
|
(go (loop []
|
|
(let [x (<! in)]
|
|
(if-not (nil? x)
|
|
(do
|
|
(put-all! cs x)
|
|
(recur))
|
|
:done))))
|
|
cs))
|
|
|
|
(defn copy-chan
|
|
([c]
|
|
(first (multiplex c 1)))
|
|
([out c]
|
|
(first (multiplex c [out]))))
|
|
|
|
(defn dup-chan [c]
|
|
(multiplex c 2))
|
|
|
|
(defn map-chan
|
|
([f source] (map-chan (chan) f source))
|
|
([c f source]
|
|
(go-loop
|
|
(>! c (f (<! source))))
|
|
c))
|
|
|
|
(defn filter-chan
|
|
([f source] (filter-chan (chan) f source))
|
|
([c f source]
|
|
(go-loop
|
|
(let [v (<! source)]
|
|
(when (f v)
|
|
(>! c v))))
|
|
c))
|
|
|
|
(defn interval-chan
|
|
([msecs]
|
|
(interval-chan msecs :leading))
|
|
([msecs type]
|
|
(interval-chan (chan (dropping-buffer 1)) msecs type))
|
|
([c msecs type]
|
|
(condp = type
|
|
:leading (go-loop
|
|
(>! c (now))
|
|
(<! (timeout msecs)))
|
|
:falling (go-loop
|
|
(<! (timeout msecs))
|
|
(>! c (now))))
|
|
c))
|
|
|
|
(defn throttle
|
|
([source control]
|
|
(throttle (chan) source control))
|
|
([c source control]
|
|
(go
|
|
(loop [state ::init last nil]
|
|
(let [[v sc] (alts! [source control])]
|
|
(condp = sc
|
|
source (condp = state
|
|
::init (do (>! c v)
|
|
(recur ::throttling last))
|
|
::throttling (recur state v))
|
|
control (if last
|
|
(do (>! c last)
|
|
(recur state nil))
|
|
(recur ::init last))))))
|
|
c))
|
|
|
|
(defn sustain
|
|
([source control]
|
|
(sustain (chan) source control))
|
|
([c source control]
|
|
(go
|
|
(loop [last nil]
|
|
(let [[v ch] (alts! [source control] :priority true)]
|
|
(condp = ch
|
|
source (do (>! c v) (recur v))
|
|
control (do (when last (>! c last)) (recur last))))))
|
|
c))
|
|
|
|
(defn debounce
|
|
([source msecs]
|
|
(debounce (chan) source msecs))
|
|
([c source msecs]
|
|
(go
|
|
(loop [state ::init cs [source]]
|
|
(let [[_ threshold] cs]
|
|
(let [[v sc] (alts! cs)]
|
|
(condp = sc
|
|
source (condp = state
|
|
::init
|
|
(do (>! c v)
|
|
(recur ::debouncing
|
|
(conj cs (timeout msecs))))
|
|
::debouncing
|
|
(recur state
|
|
(conj (pop cs) (timeout msecs))))
|
|
threshold (recur ::init (pop cs)))))))
|
|
c))
|
|
|
|
(defn after-last
|
|
([source msecs]
|
|
(after-last (chan) source msecs))
|
|
([c source msecs]
|
|
(go
|
|
(loop [cs [source]]
|
|
(let [[_ toc] cs]
|
|
(let [[v sc] (alts! cs :priority true)]
|
|
(recur
|
|
(condp = sc
|
|
source (conj (if toc (pop cs) cs)
|
|
(timeout msecs))
|
|
toc (do (>! c (now)) (pop cs))))))))
|
|
c))
|
|
|
|
(defn fan-in
|
|
([ins] (fan-in (chan) ins))
|
|
([c ins]
|
|
(go (while true
|
|
(let [[x] (alts! ins)]
|
|
(>! c x))))
|
|
c))
|
|
|
|
(defn distinct-chan
|
|
([source] (distinct-chan (chan) source))
|
|
([c source]
|
|
(go
|
|
(loop [last ::init]
|
|
(let [v (<! source)]
|
|
(when-not (= last v)
|
|
(>! c v))
|
|
(recur v))))
|
|
c))
|
|
|
|
(defn event-chan [event-type]
|
|
(let [c (chan)]
|
|
(ev/listen! event-type #(put! c %))
|
|
c))
|
|
|
|
(defn key-chan [keycodes]
|
|
(let [source (event-chan :keydown)
|
|
c (chan)]
|
|
(go-loop
|
|
(let [kc (:keyCode (<! source))]
|
|
(when (contains? keycodes kc)
|
|
(>! c (keycodes kc)))))
|
|
c))
|
|
|
|
(defn frame-chan []
|
|
(let [c (chan (sliding-buffer 1000))
|
|
step (fn step [ts]
|
|
(let [req-id (.requestAnimationFrame js/window step)]
|
|
(put! c [ts req-id])))]
|
|
(.requestAnimationFrame js/window step)
|
|
c))
|
|
|
|
(defn counting-chan [source]
|
|
(let [c (chan)]
|
|
(go
|
|
(loop [count 0]
|
|
(<! source)
|
|
(>! c count)
|
|
(recur (inc count))))
|
|
c))
|
|
|
|
(defn diff-chan [source]
|
|
(let [c (chan)]
|
|
(go
|
|
(let [start (<! source)]
|
|
(loop [start start]
|
|
(let [ts (<! source)]
|
|
(>! c (- ts start))
|
|
(recur ts)))))
|
|
c))
|
|
|
|
(defn dropping-chan [source n]
|
|
(let [c (chan)]
|
|
(go
|
|
(loop [count 0]
|
|
(if (= count 0)
|
|
(>! c (<! source))
|
|
(<! source))
|
|
(recur (rem (inc count) n))))
|
|
c))
|