ADDED   ostinata/alg.janet
Index: ostinata/alg.janet
==================================================================
--- ostinata/alg.janet
+++ ostinata/alg.janet
@@ -0,0 +1,82 @@
+# [ʞ] alg.janet
+#  ~ lexi hale <lexi@hale.su>
+#  🄯 AGPLv3
+#  ? basic algorithms inexplicably missing from std
+
+(defn vect ``
+	vectorize primitive operations
+
+		`(vect + [1 2 3] [3 2 1]) #→ [4 4 4]`
+
+		`(vect * [1 2  ] [2 2 5]) #→ [2 4 5]`
+	`` [op & vecs]
+
+	(def a @[])
+	(var col 0)
+	(forever 
+		# theoretically this should be as simple as ;(map idx v)
+		# but we want to handle missing columns sanely, which is
+		# more complicated.
+		(def args
+			(mapcat (fn [v]
+						(if (>= col (length v)) []
+							[(get v col)]))
+					vecs))
+		(when (empty? args) (break))
+		(put a col (apply op args))
+		(++ col))
+	(freeze a))
+
+(defn clamp [v &opt m x]
+	(min (or x 1) (max (or m 0) v)))
+
+(defn xlerp [t a b]
+	  (+ (* a (- 1 t))
+		 (* b      t)))
+
+(defn lerp [t a b]
+	(xlerp (clamp t) a b))
+
+(defn sel "return a record filtered by a key predicate"
+	[rec p]
+	(def r @{})
+	(eachp (k v) rec
+		(when (p k) (put r k v)))
+	(if (table? rec) r (freeze r)))
+
+(defn qrec "query a record by key names, returning a matching sub-record"
+	[rec & ks]
+	(def r @{})
+	(each k ks
+		(put r k (get rec k)))
+	(if (table? rec) r (freeze r)))
+
+(defn llut "get the lerp halves for a linear lookup table"
+	[t lut]
+	(def t (clamp t))
+	(case t
+		0 [0 (first lut) (first lut)]
+		1 [1 (last  lut) (last  lut)]
+		(do (def q (- (length lut) 1))
+			(def n (* q t))
+			(def idx (math/trunc n))
+			(def frac (- n idx))
+			[frac
+			 (lut      idx)
+			 (lut (+ 1 idx))])))
+
+(defn ilut "interpolate a linear lookup table"
+	[t lut]
+	(lerp ;(llut t lut)))
+
+(defn vlut "interpolate a linear vector lookup table"
+	[t lut]
+	(def [fac a b] (llut t lut))
+	(vect |(lerp fac ;$&) a b))
+
+(defn lut-bake "bake a lut from a function"
+	[res f]
+	(def t (array/ensure @[] res 1))
+	(loop [i :range [0 res] :let [fac (/ i res)]]
+		(put t i (f fac)))
+	t)

ADDED   ostinata/ostinata.janet
Index: ostinata/ostinata.janet
==================================================================
--- ostinata/ostinata.janet
+++ ostinata/ostinata.janet
@@ -0,0 +1,648 @@
+# [ʞ] ostinata.janet
+#  ~ lexi hale <lexi@hale.su>
+#  🄯 AGPLv3
+#  ? a TUI mini-garageband that uses csound as
+#    a backend synthesizer. to add a new instrument,
+#    write it in ['ostinata.orc], then add it to
+#    [$orchestra] here
+
+(import /tui)
+(import /alg)
+
+(def terminate (gensym))
+(def teardown (gensym))
+
+(def grammar (peg/compile ~{
+	:qlit (* `"` (% (any (+ (* `\"` (constant `"`))
+	                        (* (not `"`) '1))))
+	         `"`)
+	:idchar (* (not :s) '1)
+	:term (% (some (+ :qlit :idchar)))
+	:seq (* :s* :term (? (* :s+ :seq)) :s*)
+	:main :seq
+}))
+
+(defmacro putfn [tbl id & dfn]
+	~(put ,tbl ,(keyword id) (fn ,(symbol tbl ":" id) ,;dfn)))
+
+(def modes @{})
+
+(def *trace?* (gensym))
+(setdyn *trace?* true)
+
+(def failure (gensym))
+(defn fail! [code & arg]
+	(as-> (string/format ;arg) msg
+		  (if-not (dyn *trace?*) msg
+			  (debug/stacktrace (fiber/root) msg ""))
+		  (return failure [code msg])))
+
+(defn guard* [thunk fail]
+	(def [code result] (prompt failure
+			(def r (thunk))
+			[nil r]))
+	(if code (fail code result)
+		result))
+
+(defmacro guard [body & conds]
+	(def $code (gensym))
+	~(,guard* (fn guard-thunk [] ,body)
+				  (fn guard-catch [,$code msg]
+					  (match ,$code
+						  ;conds
+						  # fail upward if not caught
+						  _ (return failure [code msg])))))
+
+(defn score-marshal [score]
+	(marshal [:application/x.vt.ostinata 0
+			  {:score score}]))
+
+(defn score-unmarshal [bin]
+	(match (unmarshal bin)
+		[:application/x.vt.ostinata vers {:score score}]
+			score
+		_ (fail! :parse "not a valid score file")))
+
+(defmacro enum [& vals]
+	(var idx 0)
+	(tabseq [:after (++ idx)
+			 v :in vals]
+			v idx))
+
+(def default-note-keys
+	# second col is half-tones
+	["a" "z"
+	 "s" "x"
+	 "d" "c"
+	 "f" "v"
+	 "g" "b"
+	 "h" "n"
+	 "j" "m"
+	 "k" ","
+	 "l"])
+
+(def note-map {
+	:continuum (fn note-map:continuum [me f]
+	   (seq [i :range [0 (me :n)]
+				:let [ncode ((get-in me [:keys i]) 0)
+					  ncap  (string/format "%c" ncode)
+					  prog  (/ i (me :n))]]
+			   (f prog ncap ncode)))
+})
+
+(defn note-map-for [env chan]
+	(def km (or (chan :keymap)
+				(env :keymap)
+				default-note-keys))
+	(def nkeys (length km))
+	(def note-key-indices
+		(tabseq [i :range [0 nkeys]] ((km i) 0) i))
+	(struct/with-proto note-map
+		:keys km
+		:n nkeys
+		:key->index note-key-indices))
+
+(def <instr>
+	{:start (fn <instr>start [me env note time]
+				[:i (:ident-note me note) time -1
+					   ;(:note me env note)])
+	 :stop (fn <instr>stop [me env note time]
+			   [:i (string (:ident-note me note)) time
+				(get-in me [:cfg :dwell] .2)])
+	 :cfg {}
+	 :for-chan (fn <instr>for-chan [me env chan]
+				   (def cfg (merge (me :cfg) (chan :cfg)))
+				   (def intermediate
+					   (struct/with-proto me
+						  :cfg cfg
+						  :ampl (chan :ampl)))
+				   (struct/with-proto me
+					  ;(kvs intermediate)
+					  ;(kvs (:setup intermediate env chan))))
+	 :setup (fn <instr>setup [me env chan]
+				{:note-map (note-map-for env chan)})
+	 :ident-note (fn <instr>ident-note [me n]
+		 (def frac (reverse (string (n :id)))) # not a joke
+		 (string (me :name) "." frac))})
+
+(defn lerp [t a b]
+	(+ (* (- 1 t) a)
+	   (*      t  b)))
+
+(defn freq-spread-notes [me env chan]
+	(def super ((<instr> :setup) me env chan))
+	(defn cv [x &opt dflt] (get-in me [:cfg x] dflt))
+	(merge super
+		   {:notes (:continuum (super :note-map)
+					   (fn [p cap code]
+						   (lerp p  (cv :base)
+								 (+ (cv :base) (cv :span)))))}))
+(def orchestra {
+	:sine (struct/with-proto <instr>
+				:name "sine"
+				:cfg {:base 800 :span 600 :chime 1}
+				:setup freq-spread-notes
+				:note (fn sine:note [me env n]
+					(def freq (get-in me [:notes (n :index)]))
+					[(* (me :ampl) (n :vel)) freq (get-in me [:cfg :chime])]))
+	:string (struct/with-proto <instr>
+				:name "string"
+				:cfg {:base 500 # shortest frequency
+					  :span 300 # range of frequencies
+					  :decay 0}
+				:setup freq-spread-notes
+				:note (fn drum:note [me env n]
+					(def freq (get-in me [:notes (n :index)]))
+					(def c (me :cfg))
+					[(* (me :ampl) (n :vel)) freq (- 1 (* .1 (c :decay)))]))
+})
+
+
+(defn timecode→string [t]
+	(def μs             (%    t        1))
+	(def  s (math/floor (%    t        60)))
+	(def  m (math/floor (% (/ t 60)    60)))
+	(def  h (math/floor (% (/ t 60) (* 60 60))))
+	(string/format "%02u:%02u:%02u.%02u" h m s
+				   (math/floor (* μs 100))))
+
+(defn cmd→string [cmd]
+	(defn txl [val]
+		(cond (keyword? val) (string val)
+			:else (string/format "%q" val)))
+	(def str (string/join (map txl cmd) " ")))
+
+(defn sort-score [env]
+	(sort-by |($ :at) (env :score)))
+
+(defn over-score ``
+	iterates a score's notes, respecting mute flags
+	and the the current isolation mode
+	`` [env f]
+	(each n (env :score)
+		(def chan-id (n :chan))
+		(def chan (get-in env [:chans chan-id]))
+		(when (and (not (chan :mute))
+				   (or (empty?     (env :iso))
+					   (has-value? (env :iso) chan-id)))
+			(f n))))
+
+(defn write-score [env]
+	(def cmds @[])
+	(sort-score env)
+	(over-score env (fn [n]
+		(def chan (get-in env [:chans (n :chan)]))
+		(def ins (:instr-for-chan env chan))
+		(defn ins-cmd [method & args]
+			((ins method) ins env ;args))
+		(def cl [(ins-cmd :start n (n :at))
+				 (ins-cmd :stop n (+ (n :at) (n :len)))])
+		(each c cl (array/push cmds c))))
+	(def score-text
+		(string/join (map |(string (cmd→string $) "\n") cmds)))
+	score-text)
+
+(defn player [env]
+	(sort-score env)
+	(def chan-instrs
+		(tabseq [[chid chan] :pairs (env :chans)]
+				chid (:instr-for-chan env chan)))
+	(var last-time (env :time))
+	(protect (over-score env (fn [e]
+		(unless (< (e :at) last-time) #TODO cache last note id in play mode?
+			# (def chan (get-in env [:chans (e :chan)]))
+			(def ins (in chan-instrs (e :chan)))
+			(defn ins-cmd [method & args]
+				((ins method) ins env ;args))
+
+			# skip over notes we've already passed
+			(def t (e :at))
+			(ev/sleep (- t last-time))
+			(set last-time t)
+
+			#haack
+			(:send env ;(ins-cmd :start e 0))
+			(:send env ;(ins-cmd :stop e (e :len))))))))
+
+(putfn modes play [env]
+	(defn ticks []
+		(os/clock :monotonic))
+	(var rec false)
+	(var cur-id (if (empty? (env :score)) 0
+					(+ 1 (extreme > (map |($ :id) (env :score))))))
+	(def start-time (env :time))
+
+	(var held @{})
+	(var last-time (ticks))
+	(def chan (get-in env [:chans (env :chan)]))
+	(var loud 1)
+	(def ins (:instr-for-chan env chan))
+	(defn note-key? [k]
+		(not (nil? (get-in ins [:note-map :key->index k]))))
+	(defn draw-stat-line [timecode]
+		(def sustain @[])
+		(defn clr [& r] (:color (env :tty) ;r))
+		# (defn vbar [& r] (:vbar (env :tty) ;r))
+		(each n (get-in ins [:note-map :keys])
+			(when-let [k (get held n nil)]
+				(def k (string/format "%c" n))
+				(array/push sustain k)))
+		(:msg env "\r\e[2K%s\r"
+			  (string
+				  (if rec "\e[91m⏺"
+					      "\e[94m⏹") "\e[m"
+				  (clr [.9 .95 1] [0.1 0.2 0.4]
+					  (string " " (timecode→string timecode) " "))
+				  (:vol-bar env (/ loud 11))
+				  # (vbar (/ loud 11)
+					# 	[.5 1 .25]
+					# 	[1.0 1.0 0.25]
+					# 	[.8 0 0])
+				  " " (chan :instr) "\e[96m@" (env :chan) "\e[m"
+				  " \e[1m" (if rec "record" "play") "\e[m"
+				  (string/join sustain))))
+
+	(def timewarp (get-in chan [:cfg :timewarp] 1.0))
+
+	(defn advance-clock [res]
+		(protect (forever
+			(def cur-time (ticks))
+			(draw-stat-line (+ (env :time)
+							   (* (- cur-time last-time)
+								  timewarp)))
+			(ev/sleep res))))
+
+	(var clock-fiber nil)
+	(var player-fiber nil)
+	(defn start-clock []
+		(set clock-fiber  (fiber/new |(advance-clock 0.01)))
+		(set player-fiber (fiber/new |(player env)))
+		(ev/go clock-fiber)
+		(ev/go player-fiber))
+	(defn stop-clock []
+		(when clock-fiber
+			(ev/cancel clock-fiber nil)
+			(set clock-fiber nil))
+		(when player-fiber
+			(ev/cancel player-fiber nil)
+			(set player-fiber nil)))
+
+	(defn ins-cmd [method & args]
+		((ins method) ins env ;args))
+	(defn stop-all-notes []
+		(eachp [k v] held
+			(:send env ;(ins-cmd :stop v 0))))
+	(defn cleanup []
+		(stop-all-notes)
+		(stop-clock))
+	(def score-staging @[])
+
+
+	(defer (cleanup) (prompt teardown (forever
+		(draw-stat-line (env :time))
+		(def event (yield))
+
+		# get precise time unaffected by clock refresh rate
+		(def cur-time (ticks))
+		(def advance (- cur-time last-time))
+		(set last-time cur-time)
+
+		(when rec (+= (env :time) (* advance timewarp)))
+		(def next-id cur-id)
+		(++ cur-id)
+
+		(defn store-note [b]
+			(def stored (alg/qrec b
+			  :at :mods :vel :id :index :chan))
+			
+			(def len (- cur-time (b :t)))
+			(array/push score-staging
+						(merge stored {:chan (env :chan)
+									   :len len})))
+
+		(defn commit-score []
+			(unless (empty? score-staging)
+				(array/concat (env :score) score-staging)
+				(array/clear score-staging)
+				(sort-score env)))
+
+		(defn commit-unless-shift []
+			(unless (string/check-set (event :mods) :s)
+				(commit-score)))
+		
+		(match event
+			{:how :press :key (@ (comptime ("q" 0)))}
+				(do (stop-all-notes)
+					(:set-mode env :cmd)
+					(commit-unless-shift))
+			{:how :press :key (@ (comptime ("r" 0)))}
+				(do (stop-all-notes)
+					(toggle rec)
+					(if rec (start-clock) (stop-clock))
+					(commit-unless-shift))
+			{:how :press   :key :shift-l} (+= loud 1)
+			{:how :release :key :shift-l} (-= loud 1)
+			{:how :press   :key :shift-r} (-= loud .5)
+			{:how :release :key :shift-r} (+= loud .5)
+			{:how :press   :key :tab}
+				(do (put env :time start-time)
+					(stop-clock) (start-clock))
+			({:how :press :key n}
+				 (<= 0x31 n 0x39))
+				(set loud (- n 0x30))
+			({:how :press :key k}
+				 (note-key? k)
+				 (nil? (held k)))
+				(do (def note {:id cur-id  :vel loud
+							   :t cur-time :at (env :time)
+							   :index (get-in ins [:note-map :key->index k])
+							   :mods (get event :mods :)})
+					(put held k note)
+					(:send env ;(ins-cmd :start note 0)))
+			({:how :release :key k} (note-key? k))
+				(when (has-key? held k)
+					(def b (held k))
+					(:send env ;(ins-cmd :stop b 0))
+
+					(when rec (store-note b))
+					
+					(put held k nil)
+					)
+
+			)))))
+
+(putfn modes ev [env]
+	   (prompt teardown (forever
+			(def event (yield))
+			(match event
+				{:how :press :text "q"}
+					(:set-mode env :cmd) 
+				_ (:msg env "event packet: %P\r\n"
+						(struct/proto-flatten event))
+
+				))))
+
+(defn mk-channel []
+	@{:instr :sine
+	  :ampl 1
+	  :cfg @{}
+	  :mute false})
+
+(defn present-file [env text]
+	(def lines (string/split "\n" text))
+	(defn c [& r] (:color (env :tty) ;r))
+	(var idx 0)
+	(def out-lines @[])
+	(each line lines (++ idx)
+		(array/push out-lines
+			(string (c [.6 .2 .3] nil
+					   (string/format "% 04d" idx))
+					" " line "\n")))
+	(string/join out-lines))
+
+(defn do-cmd [str env]
+	(def argv (peg/match grammar str))
+	(defn say [fmt & args]
+		(:write (env :tty) (string/format fmt ;args)))
+	(def chan (get-in env [:chans (env :chan)]))
+	(defn bad-cmd []
+		(:msg env "bad command\n"))
+	(match argv
+		@["q"] (return terminate)
+		@["t" time] (put env :time (scan-number time))
+		@["f" path] (put env :file path)
+		@["t"] (:msg env "time is %f\n" (env :time))
+		@["f"] (if (= "" (env :file))
+				   (:msg env "no file\n")
+				   (:msg env "file is %s\n" (env :file)))
+
+		@["ch" "ls"] (do (defn c [& r] (:color (env :tty) ;r))
+						 (def tpl (string
+									  (c [.8 .3 .4] nil
+										 "% 3i ") #idx
+
+									  "%s%s " #iso-state volume
+									  (c [.5 .5 1] [0 0 .1] " %s ") #name
+									  (c [1 .5 .5] [.1 0 0] " %s ") #instr
+									  "\n"))
+						 (def max-ampl (extreme >
+							(map (fn [(_ ch)] (ch :ampl))
+								 (pairs (env :chans)))))
+						 (defn iso-state [id ch]
+							 (def colors {:iso   [.2 1 .1]
+										  :uniso [1 .2 .1]
+										  :mute  [.1 .4 1]
+										  :on    [1 1 1]
+										  :blank [0 0 0]})
+							 (def states @[])
+							 (when (ch :mute) (array/push states :mute))
+							 (unless (empty? (env :iso))
+								 (array/push states
+									 (if (has-value? (env :iso) id)
+										 :iso :uniso)))
+							 (def leds (string
+								(if (ch :mute)                 "m" " ")
+								(if (has-value? states :iso)   "i" " ")))
+							 # (unless (or (ch :mute)
+								# 		 (has-value? states :uniso))
+								#  (array/push states :on))
+							 (when (empty? states)
+								 (array/push states :blank))
+							 
+							 (def base (let [n (/ 1 (length states))]
+								 (alg/vect * [n n n]
+								   (alg/vect + ;(map |(colors $) states)))))
+							 (defn vlerp [t a b]
+								 (alg/vect |(lerp t $ $1) a b))
+							 (c (vlerp 0.5 base [1 1 1])
+								(vlerp 0.5 base [0 0 0])
+								leds))
+
+						 (var idx 0)
+						 (each [id ch] (pairs (env :chans))
+							 (++ idx)
+							 (:msg env tpl
+								   idx
+								   (iso-state id ch)
+								   (:vol-bar env (/ (ch :ampl) max-ampl))
+								   id (ch :instr))
+							 (unless (empty? (ch :cfg))
+								 (:msg env "         %s\n" (string/join
+								 (map |(string/format
+										   (string (c [.2 .4 1] nil "\e[1m%s")
+												   "="
+												   (c [.6 .3 1] nil "%q"))
+										   ;$)
+									  (pairs (ch :cfg))) " ")))))
+		(@["ch" "mv" f op t]
+				(has-value? ["to" "clobber" "merge"] op))
+			(do (def (from to) (map keyword [f t]))
+				(cond
+					(and (not= op "clobber") (has-key? (env :chans) to))
+						(:msg env "cannot clobber existing channel")
+					(and (= op "merge") (has-key? (env :chans) to))
+						(put-in env [:chans from] nil)
+					:else # valid move
+					(do (put-in env [:chans to  ] (get-in env [:chans from]))
+						(put-in env [:chans from] nil)))
+
+				(when (= (env :chan) from)
+					(put env :chan to))
+				(each s (env :score)
+					(when (= from (s :chan))
+						(put s :chan to))))
+
+		@["ch" "set" c] (let [kc (keyword c)]
+					  (put env :chan kc)
+					  (unless (has-key? (env :chans) kc)
+						  (put-in env [:chans kc] (mk-channel))))
+		@["ch" _] (bad-cmd)
+		@["ch"] (:msg env "current channel is %s\n" (env :chan))
+
+		@["perf"] (:msg env "performing score\n"
+						(ev/write (get-in env [:cs-in 1])
+								  (write-score env)))
+		@["iso" "set" & chans] (put env :iso (map keyword chans))
+		@["iso" "add" & chans] (array/concat (env :iso) (map keyword chans))
+		@["iso" "del" & chans]
+			(put env :iso (filter |(not (has-value? chans (string $)))
+								  (env :iso)))
+		@["iso" "off"] (array/clear (env :iso))
+		@["iso" _] (bad-cmd)
+		@["iso"] (:msg env "isolating channels %s\n"
+					   (string/join (map string (env :iso)) " "))
+
+		@["amp" x] (put chan :ampl (scan-number x))
+		@["amp"] (:msg env "channel %s amp is %f\n" (env :chan) (chan :ampl))
+
+		@["mute" "on"] (put chan :mute true)
+		@["mute" "off"] (put chan :mute false)
+		@["mute"] (do (toggle (chan :mute))
+					  (:msg env "%s channel %s\n"
+							(if (chan :mute) "muting" "unmuting")
+							(env :chan)))
+
+		@["cfg" key val] (put-in chan [:cfg (keyword key)]
+								 (scan-number val))
+		@["cfg" key] (:msg env "%s = %s\n" key
+						   (string (get-in chan [:cfg (keyword key)] 
+										   "\e[3m<unset>\e[m")))
+		@["cfg"] (each [k v] (pairs (chan :cfg))
+					 (:msg env "\e[1m%s\e[m = %s\n" k (string v)))
+		@["sc" "from" t] (:msg env "printing score from %f\n" (env :time))
+		@["sc" "to" t] (:msg env "printing score to %f\n" (env :time))
+		@["sc" "erase" "all"] (array/clear (env :score))
+		@["sc" "erase"] nil
+		@["sc" "comp" path] (do (:msg env "writing score to %s\n" path)
+								(spit path (write-score env)))
+		@["sc" "comp"] (:msg env "composing score\n%s\n"
+							 (present-file env (write-score env)))
+		@["sc"] (:msg env "printing score\n%P\n" (env :score))
+
+		@["pl"] (:set-mode env :play) 
+		@["in" inst] (let [ik (keyword inst)]
+						 (if (has-key? orchestra ik) (put chan :instr ik)
+							 (:msg env "no such instrument %s\n" inst)))
+		@["in"] (:msg env "instrument is %s\n" (chan :instr))
+		@["st" "pid"] (:msg env "csound process is pid %i\n"
+							(get-in env [:cs-proc :pid]))
+		@["st" "ev"] (:set-mode env :ev)
+		(x (or (nil? x) (empty? x))) nil
+		(:msg env "bad cmd\n")))
+
+(putfn modes cmd [env]
+	(var cmd-line @"")
+	(def history @[])
+	(var histidx nil)
+	(prompt teardown (forever
+		(:msg env "\r\e[2K\e[1m:%s\e[m" cmd-line)
+		(def event (yield))
+		(defn go-history [n]
+			(def lastidx (- (length history) 1))
+			(label give-up
+					(cond (empty? history) (return give-up)
+						(and (nil? histidx)
+							   (< n 0)) (set histidx (+ n (length history)))
+						(nil? histidx) (return give-up)
+						(> (+ n histidx) lastidx)
+							 (do (set histidx nil)
+								 (set cmd-line @"")
+								 (return give-up))
+						(<= (+ n histidx) lastidx)
+							(set histidx (max 0 (+ n histidx)))
+						:else (return give-up))
+					(set cmd-line (buffer (history histidx)))))
+		(when (or (= (event :how) :press)
+				  (= (event :how) :repeat))
+			(match event
+				{:key :bksp} (buffer/popn cmd-line 1)
+				{:key :tab} (do)
+				{:key :up} (go-history -1)
+				{:key :dn} (go-history  1)
+				{:key :enter} (do
+					(:msg env "\r\n")
+					(set histidx nil)
+					(do-cmd cmd-line env)
+					(array/push history (string cmd-line))
+					(buffer/clear cmd-line))
+				{:text t} (buffer/push cmd-line t)
+				)))))
+
+(defn task-cmd [env]
+	"command input handling"
+	(def {:tty tty} env)
+	(var mode nil)
+
+	(defn new-mode [x & args]
+		(def m (fiber/new x :yi))
+		(resume m env ;args)
+		(fn resume-mode [& args] (resume m ;args)))
+
+	(put env :set-mode (fn env:set-mode [_ x & args]
+						   (set mode (new-mode (modes x) ;args))
+						   (return teardown)
+						   ))
+
+	# this is silly
+	(prompt teardown (:set-mode env :cmd))
+
+	(prompt terminate
+		(loop [e :iterate (:await tty)
+				 :while mode]
+			(mode e)))
+
+	(os/proc-kill (env :cs-proc) true :term))
+
+(defn main [& argv]
+	(def cs-in  (os/pipe :R))
+	(def cs-out (os/pipe :W))
+	(def cs (os/spawn ["csound" "-Lstdin" "--orc" "ostinata.orc" "-odac"] :p
+					  {:in (cs-in 0) :out (cs-out 1) :err (cs-out 1)}))
+	(def tty (tui/init (os/open "/dev/tty" :rw)))
+	(def doc @{})
+	(def env @{:tty tty
+			   :score @[]
+			   :chans @{:root (mk-channel)}
+			   :iso []
+			   :chan :root
+			   :file ""
+			   :pause false
+			   :time 0.0
+			   :cs-proc cs
+			   :cs-in cs-in
+			   :cs-out cs-out
+			   :vol-bar (fn [me fac] (:vbar (me :tty) fac
+											[.5 1 .25]
+											[1.0 1.0 0.25]
+											[1 .2 .1]))
+			   :instr-for-chan (fn [me c]
+								   (:for-chan (orchestra (c :instr)) me c))
+			   :send (fn env:send [me & args]
+						 (def cmd (cmd→string args))
+						 # (print "cmd = " cmd)
+						 (ev/write (cs-in 1) (string cmd "\n")))
+			   :msg (fn env:msg [me fmt & args]
+					   (:write (me :tty) (string/format fmt ;args)))
+			  })
+		(ev/call |(do (defer (:close tty)
+						  (task-cmd env)))))

ADDED   ostinata/ostinata.orc
Index: ostinata/ostinata.orc
==================================================================
--- ostinata/ostinata.orc
+++ ostinata/ostinata.orc
@@ -0,0 +1,56 @@
+0dbfs = 100
+nchnls = 2
+sr = 44100
+
+; p2 when
+; p3 dur
+; p4 vol
+; p5 freq
+
+givol ftgen 1, 0, 10000, 25, \
+	500, 60, \
+	1000, 20, \
+	7000, 3, \
+	10000, 5
+
+instr sine
+	tigoto skipinit
+	kt init 0
+	al init 1.0
+	ifreq = p5
+	ichime = p6
+
+	ivol = 30 * p4 * table(ifreq, givol)
+
+	aw oscils ivol, ifreq, 0
+	af oscils ivol, ifreq * ichime, 0
+	skipinit:
+	kt = kt + (1/kr)
+	kv bpf kt, 0,0, 0.5,0.8, .1,1, 1,.6
+	at linseg 0, p3, 1
+
+	if p3 >= 0 then
+		aw = aw * (1 - at)
+		aw = aw + (af * at)
+		aw = aw * (1-at)
+	endif
+
+	out aw*al
+endin
+
+instr string
+	tigoto skipinit
+	; initialize
+	ivol = 30*p4
+	ifreq = p5
+
+	aw pluck ivol, ifreq, ifreq, 0, 3, p6
+	skipinit:
+	at linseg 1, p3, 0
+
+	if p3 >= 0 then
+		aw = aw * at
+	endif
+	out aw
+endin
+

ADDED   ostinata/tui.janet
Index: ostinata/tui.janet
==================================================================
--- ostinata/tui.janet
+++ ostinata/tui.janet
@@ -0,0 +1,295 @@
+# [ʞ] tui.janet
+#  ~ lexi hale <lexi@hale.su>
+#  🄯 AGPLv3
+#  ? quick and extremely dirty rawterm interface
+
+(use /alg)
+
+# FIXME use ffi to directly munge termios where feasible
+(defn raw [fd] 
+	(os/execute ["stty" "raw" "-echo" "opost"] :p))
+
+(defn unraw [fd]
+	(os/execute ["stty" "-raw" "echo"] :p))
+
+(defmacro use-raw [fd]
+	~(upscope
+		 (,raw ,fd)
+		 (,defer ,unraw ,fd)))
+
+(defmacro with-raw [fd & x]
+	~(do (,raw ,fd)
+		 ,;x
+		 (,unraw ,fd)))
+
+(def- capq-resp (peg/compile ~{
+	:lst (* '(+ (some (range "09"))
+				(constant "0"))
+			  (? (* ";" :lst)))
+	:resp "\e[?"
+	:seq (* :resp (group :lst))
+	:tc (* :seq "c")
+	:pg (* :resp (number (any (range "09"))) "u")
+	:main (* (+ :pg (constant false))
+			  :tc)
+}))
+(def- pg-flags {0x01 :E # disambig events
+			    0x02 :e # report evt types
+			    0x04 :k # keycode alts
+			    0x08 :K # all keys as alts
+			    0x16 :t}) # text
+(defn release [env]
+	(defn send [& x] (ev/write (env :fd) (string ;x)))
+	(when (string/check-set (env :caps) :p)
+		(send "\e[<1u"))
+	(unraw (env :fd))
+	(:close (env :fd)))
+
+(defn- read-until [pred fd]
+	(def buf @"")
+	(label matched
+		   (forever
+			   # (ev/write fd (string/format "buf: %j\r\n" buf))
+			   (ev/read fd 1 buf)
+			   (spit "dbgkeys" buf)
+			   (def p (pred buf))
+			   (when p (return matched p)))))
+
+(defn- text-key [c & args]
+	(struct :text c
+			:key ((string/ascii-lower c) 0)
+			:case (c 0)
+			:base (c 0)
+			:how :press
+			;args))
+
+(def- event-code-ptn (peg/compile ~{
+	:csi "\e["
+	:ss3 "\e\x4f"
+	:cs3 (+ :csi :ss3)
+	:key-basic (cmt (* :csi :keycode :keyev "~" )
+				,(fn [kc ks kb mods how]
+					(def basis
+						(case kc
+						   2 :ins
+						   3 :del
+						   5 :pgup
+						   6 :pgdn
+						   7 :home
+						   8 :end
+						   (cond (<= 11 kc 24) (keyword :f (- kc 11))
+							     :else :unknown)))
+					 {:key  basis
+					  :mods mods
+					  :how how}))
+	:key-magic (cmt (* :csi "1" :keyev '(+ (range "AF") "H" "P" "Q" "S"))
+					,(fn [mods how cue]
+						{:mods mods
+						 :how how
+						 :key (case cue
+								  "A" :up "C" :rt
+								  "B" :dn "D" :lf
+								  "H" :home "F" :end
+								  "E" :kp-begin )}))
+	:legacy-ctl (cmt '(range "\x01\x07" "\x0b\x0c" "\x0e\x1a")
+			        ,(fn [ccode]
+						(def code (+ 0x60 (ccode 0)))
+						(def lc (string/format "%c" code))
+						{ :text lc
+						  :key code
+						  :case code
+						  :base code
+						  :how :press
+						  :mods :c }))
+	:key (+ (* "\x0D"            (constant {:key :enter :how :press}))
+	        (* (+ "\x7F" "\x08") (constant {:key :bksp  :how :press}))
+			(* "\x09"            (constant ,(text-key "\t" :key :tab)))
+			(* "\x00"            (constant ,(text-key " "  :key :sp :mods :c)))
+			:legacy-ctl
+	        (* :cs3 "A"          (constant {:key :up :how :press}))
+	        (* :cs3 "B"          (constant {:key :dn :how :press}))
+	        (* :cs3 "C"          (constant {:key :rt :how :press}))
+	        (* :cs3 "D"          (constant {:key :lf :how :press}))
+	        (* :cs3 "E"          (constant {:key :kp-begin :how :press}))
+			(+ (* :csi :keyspec "u")
+			   (* "\e"  (cmt :legacy-ctl
+						,(fn [c] (struct/with-proto c
+									:mods (keyword (get c :mods :) :a)))))
+			   (* "\e" (not "[") (cmt '1 ,|(text-key $ :mods :a)))
+			   (*     (not "\e") (cmt '1 ,|(text-key $)))))
+	:ctl (cmt :num0 ,(fn [c]
+			(defn b [n k]
+				(if (not= 0 (band (- c 1) n)) k :))
+			(keyword (b 0x01 :s) (b 0x10 :H)
+			         (b 0x02 :a) (b 0x20 :m)
+			         (b 0x04 :c) (b 0x40 :C)
+			         (b 0x08 :S) (b 0x80 :N))))
+	:keyev (+ (* ";" :ctl
+	             (+ (* ":1" (constant :press))
+	                (* ":2" (constant :repeat))
+	                (* ":3" (constant :release))
+	                (constant :press)))
+			   (* ";" (constant :) (constant :press))
+	           (* (constant :) (constant :press)))
+	:text (+ (cmt (group (some (* ";" :num0)))
+				 ,(fn [chars] #FIXME
+					(string ;(map |(string/format "%c" $) chars))))
+			 (constant false))
+	:keycode (+ (* :num0 ":" :num0 ":" :num0)
+	            (* :num0 ":" :num0 (constant false))
+	            (* :num0 (constant false) (constant false)))
+	:keyspec (cmt (* :keycode :keyev :text)
+				,(fn keyspec-translate [kc ks kb mods how t]
+					(def basis
+						(case kc
+						   9 {:key :tab }
+						   13 {:key :enter }
+						   127 {:key :bksp }
+
+						   57358 {:key :lock-caps }
+						   57360 {:key :lock-num }
+						   57414 {:key :kp-enter }
+						   57413 {:key :kp-plus  :text "+"}
+						   57412 {:key :kp-minus :text "-"}
+						   57411 {:key :kp-mul   :text "*"}
+						   57410 {:key :kp-div   :text "/"}
+						   43    {:key :add :text "+"}
+						   8722  {:key :sub :text "−"}
+						   215   {:key :mul :text "×" }
+						   243   {:key :div :text "÷" }
+						   57441 {:key :shift-l} 57447 {:key :shift-r}
+						   57443 {:key :alt-l}   57449 {:key :alt-r}
+						   57444 {:key :super-l} 57450 {:key :super-r}
+						   57445 {:key :hyper-l} 57451 {:key :hyper-r}
+						   57442 {:key :ctl-l}   57448 {:key :ctl-r}
+						   57453 {:key :lvl3}
+						   57454 {:key :lvl5}
+						   (cond (<= 57376 kc 57398) {:key (keyword :f (- kc 57363))}
+								:else {:key kc
+									   :text (or t (string/format "%c" (or ks kc)))})))
+					 {:text (get basis :text nil)
+					  :key  (get basis :key nil)
+					  :case (or ks kc)
+					  :base (or kb kc)
+					  :mods mods
+					  :how how}))
+	:main (* (+ :key-basic :key-magic :key) -1)
+
+	:num (some (range "09"))
+	:num0 (+ (number :num)
+	         (constant 0))
+}))
+
+(def- color-cmd
+	(do (def env (os/environ))
+		(def ct (env "COLORTERM"))
+		(def term (env "TERM"))
+		(defn mode-char [mode]
+			(case mode :fg    "3" :bg    "4"
+				       :fg-br "9" :bg-br "10"
+				(error "bad mode")))
+
+		(cond (or (= ct "truecolor")
+				  (= term "xterm")) # modern xterm supports tc
+				(fn colorize-tc [mode rgb]
+					(as-> rgb v
+						(map |(math/floor (* 255 (clamp $))) v)
+						(string/join (map string v) ";")
+						(string "\e[" (mode-char mode) "8;2;" v "m")))
+
+			(or (string/has-suffix? "256color" term)
+				(not (nil? ct)))
+				(fn colorize-256 [mode rgb]
+					(def code (math/floor
+						(cond (= 0 ;rgb) 0
+						      (=   ;rgb) (lerp (rgb 0) 232 255)
+						      :else      (+ 16 ;(vect * [36 6 1]
+													  (map clamp rgb))))))
+					(string "\e[" (mode-char mode) "8;5;" code "m"))
+
+			:else
+				(fn colorize-8 [mode rgb] "")))) #FIXME
+
+(defn- vbar [tty f & grad]
+	(def c [ " " "▁" "▂" "▃" "▄" "▅" "▆" "▇" "█" ])
+	# (def fg (vect |(lerp f ;$&) bright dim))
+	(def fg (vlut f grad))
+	(def bg (vect |(lerp .5 ;$&) fg [0 0 0]))
+	(def idx (math/floor (* (max 0 (min 1 f))
+							(dec (length c)))))
+	(:color tty fg bg (c idx)))
+
+(def- <env> {:close release
+			 :write |(ev/write ($ :fd) $1)
+			 :read  |(ev/read  ($ :fd) $1)
+			 :color (fn tui:color [me fg bg str]
+				(as-> str cmd
+					(if fg (string (color-cmd :fg fg) cmd) cmd)
+					(if bg (string (color-cmd :bg bg) cmd) cmd)
+					(if (or fg bg) (string cmd "\e[m"))))
+			 :vbar vbar
+			 :await (fn tui:await [me]
+			 # (print "awaiting")
+				(def [evt] (read-until |(peg/match event-code-ptn $) (me :fd)))
+				evt)})
+
+# (def- chord-pat (peg/compile ~{
+# 	:wd (some (* (not "-") wd))
+# }))
+
+(defn- subset [a b]
+	(var matches true)
+	(loop [[k v] :pairs a :while matches]
+		(when (not= v (get b k nil))
+			(set matches false)))
+	matches)
+(defn chord [& fm]
+	(def ksym (last fm))
+	(def mods (keyword ;(slice fm 0 -2)))
+	(merge {:mods mods
+		    :how :press}
+		(cond
+			(keyword? ksym) {:key ksym}
+			(string?  ksym)
+				{#:text ksym
+				 :key (in (string/ascii-lower ksym) 0)
+				 :case (in ksym 0)})))
+(defn event<chord? [evt & fm]
+	(subset evt (chord ;fm)))
+
+(defn init [fd]
+	(raw fd)
+	(defn send [& x] (ev/write fd (string ;x)))
+	(defn recv [n &opt buf] (string (ev/read fd n buf)))
+	(var caps :)
+	(send "\e[?u\e[c") # query caps
+	(def lists (label done
+					  (def buf @"")
+					  (forever
+						  (recv 1 buf)
+						  (def m (peg/match capq-resp buf))
+						  (when m
+							  (return done m)))))
+	(defn set-caps! [which tbl]
+		(each e which
+			(when (has-key? tbl e)
+				(set caps (keyword caps (tbl e))))))
+	(set-caps! (lists 1) {
+	   "4" :6 # sixel
+	})
+
+	(when (lists 0)
+		(set caps (keyword caps :p))
+		(each [c f] (pairs pg-flags)
+			(when (not= 0 (band c (lists 0)))
+				(set caps (keyword caps f)))))
+
+	(when (string/check-set caps :p)
+		(def fmap (invert pg-flags))
+		(def f (bor (lists 0) (fmap :k) (fmap :e) (fmap :K)))
+		(send "\e[>" (string (inc f) "u")))
+
+	(struct/with-proto <env>
+					   :fd fd
+					   :caps caps))
+