~nasser/8fl

17d6ad4fef446630f64d27c705e8b80897f9f46e — Ramsey Nasser 6 months ago 78fc329
WIP major refactor
10 files changed, 427 insertions(+), 484 deletions(-)

M api-macros.fnl
M api.fnl
A common.fnl
M core.fnl
M main.lua
D patterns.fnl
M renoise.fnl
M scales.fnl
A seq-renoise.fnl
M seq.fnl
M api-macros.fnl => api-macros.fnl +27 -24
@@ 4,40 4,43 @@
      0 nil
      1
      `(do
        (when (not (. _CYCLES ,name#))
          (tset _CYCLES ,name# (cycle ,...)))
        ((. _CYCLES ,name#)))
         (when (not (. _CYCLES ,name#))
           (tset _CYCLES ,name# (cycle ,...)))
         ((. _CYCLES ,name#)))
      _
      `(do
        (when (not (. _CYCLES ,name#))
          (tset _CYCLES ,name# (cycle [,...])))
        ((. _CYCLES ,name#))))))
         (when (not (. _CYCLES ,name#))
           (tset _CYCLES ,name# (cycle [,...])))
         ((. _CYCLES ,name#))))))

(fn <rle> [...]
  (let [name# (tostring (gensym :cycle))]
    `(do
      (when (not (. _CYCLES ,name#))
        (tset _CYCLES ,name# (cycle (& ,...))))
      ((. _CYCLES ,name#)))))
       (when (not (. _CYCLES ,name#))
         (tset _CYCLES ,name# (cycle (& ,...))))
       ((. _CYCLES ,name#)))))

(fn <?> [...]
  (let [name# (tostring (gensym :cycle))]
    `(do
      (when (not (. _CYCLES ,name#))
        (tset _CYCLES ,name# (choice-of [,...])))
      ((. _CYCLES ,name#)))))
       (when (not (. _CYCLES ,name#))
         (tset _CYCLES ,name# (choice-of [,...])))
       ((. _CYCLES ,name#)))))

(fn $> [...]
    (match (# [...])
        0 nil
        1 `(onpattern
            (fn [] (do ,...)))
        _ `(onpattern
            (fn [p#]
                (let [args# [,...]]
                    ;; renoise must be in scope for this to work
                    ;; the env.use("renoise") in main.lua/useStandardLibrary
                    ;; accomplishes this
                    (balance-and-render! p# args#))))))
  (match (# [...])
    0 nil
    1 `(onpattern
        (fn [] (do ,...)))
    _ `(onpattern
        (fn [p#]
          (let [args# [,...]]
            ;; renoise must be in scope for this to work
            ;; the env.use("renoise") in main.lua/useStandardLibrary
            ;; accomplishes this
            (balance-and-render! p# args#))))))

(fn doc [target]
  `(print (fennel.doc ,target ,(tostring target))))

{ : <> : <rle> : <?> : $> }
\ No newline at end of file
{ : <> : <rle> : <?> : $> : doc }

M api.fnl => api.fnl +21 -31
@@ 1,7 1,7 @@
(local core (require :core))
(local seq (require :seq))
(local seq-renoise (require :seq-renoise))
(local rn (require :renoise))
(local patterns (require :patterns))

(fn $>!! [...]
  (onpattern nil)


@@ 16,40 16,30 @@
(fn $>1 [...]
  (let [args [...]]
    (onpattern
      (fn [p]
        (rn.balance-and-render! p args)
        (onpattern nil)))))
     (fn [p]
       (rn.balance-and-render! p args)
       (onpattern nil)))))

(fn samp [ins frag n]
  (let [n (or n 1)]
    (seq.nth (core.samples ins frag) n)))

(fn same [x] x)

{ : $>! : $>!! : $>1 : same 
  :fxfmt core.fxfmt
  :euc patterns.make-euclid
{ : $>! : $>!! : $>1
  :samp core.sample
  :samps core.samples
  :cyc seq.cycle
  :cat seq.concat
  :rot patterns.rotate
  :rep seq.repeat
  :rev seq.reverse
  :ling seq.linger
  :fstep patterns.fill-steps
  :frand patterns.fill-random
  :fnote patterns.fill-notes
  :frest patterns.fill-rests
  :spr patterns.spread
  :fxfmt core.fxfmt
  :ins core.instrument 
  :vol core.volume
  :pan core.pan
  :dly core.delay
  :fx core.fx
  :fol patterns.follow
  :bef patterns.before
  :pick patterns.pick
  :samp samp
  :ryth patterns.rhythm
  :++ seq.concat }
  
  :cyc seq.cycle
  :cat seq.concat
  :rot seq.rotate
  :rep seq.repeat
  :rev seq.reverse
  :ling seq.linger
  :spr seq-renoise.spread
  :fol seq-renoise.follow
  :bef seq-renoise.before
  :pick seq-renoise.pick
  :b seq-renoise.beat
  :euc seq-renoise.euclidean
  :ryth seq-renoise.rhythm }


A common.fnl => common.fnl +9 -0
@@ 0,0 1,9 @@
;; common functions

(fn clamp [x min max]
  (math.min max (math.max x min)))

(fn contains [haystack needle]
  (string.find (string.lower haystack) (string.lower needle)))

{ : clamp : contains }
\ No newline at end of file

M core.fnl => core.fnl +88 -112
@@ 27,19 27,15 @@
    :number (. note-map.values note)))

(fn scale [intervals root]
  (let [root (or root :c-4)
        root (string.lower root)
        out (match (type root)
              :number get-note-value
              :string get-note-name)]
  (let [root (-> root (or :c-4) string.lower)]
    (resumable
     (var root (get-note-value root))
     (coroutine.yield (out root))
     (coroutine.yield (get-note-name root))
     (each [x (seq.cycle intervals)]
       (set root (+ root x))
       (if (< root 128)
         (coroutine.yield (out root))
         (lua "return"))))))
           (coroutine.yield (get-note-name root))
           (lua "return"))))))

(fn contains [haystack needle]
  (string.find (string.lower haystack) (string.lower needle)))


@@ 49,7 45,7 @@
  (let [name (if (= 1 (string.find name :-)) (string.sub name 2) name)]
    (each [i track (ipairs (. (renoise.song) :tracks))]
      (if (contains track.name name)
        (lua "return i")))))
          (lua "return i")))))

(fn track-lookup [idx]
  (match (type idx)


@@ 60,7 56,7 @@
(fn instrument-lookup-name [name]
  (each [i instr (ipairs (. (renoise.song) :instruments))]
    (if (contains instr.name name)
      (lua "return (i-1)"))))
        (lua "return (i-1)"))))

(fn instrument-lookup [idx]
  (match (type idx)


@@ 76,58 72,62 @@
     (each [_ sample (pairs instrument.samples)]
       (if (or (not fragment)
               (and fragment (contains sample.name fragment)))
         (let [note (get-note-name (. sample.sample_mapping.note_range 1))]
           (coroutine.yield
            (string.format "%s%02X" note instrument-number))))))))
           (let [note (get-note-name (. sample.sample_mapping.note_range 1))]
             (coroutine.yield
              (string.format "%s%02X" note instrument-number))))))))

(fn sample [ins frag n]
  (let [n (or n 1)]
    (seq.nth (samples ins frag) n)))

(fn slices [instrument fragment]
    (-> (samples instrument fragment) (seq.drop 1)))
  (-> (samples instrument fragment) (seq.drop 1)))

; (tset _G :_CC_VALUES {})
                                        ; (tset _G :_CC_VALUES {})

;; cached devices to avoid garbage collection
; (tset _G :_CC_DEVICES {})
                                        ; (tset _G :_CC_DEVICES {})

;; TODO cache
; (fn maybe-install-device [name]
;     (when (= nil (. _G._CC_VALUES name))
;       (each [_ device (ipairs (renoise.Midi.available_input_devices))]
;             (when (contains device name)
;               (let [m {}]
;                    (tset _G._CC_VALUES name m)
;                    (tset _G._CC_VALUES device m)
;                    (let [dev (renoise.Midi.create_input_device
;                               device
;                               (fn [[s cc value]]
;                                   (when (= s 176)
;                                     (status (.. "MIDI CC " device " " cc " " value))
;                                     (tset m cc value))))]
;                      (tset _G._CC_DEVICES device dev)))))))
                                        ; (fn maybe-install-device [name]
                                        ;     (when (= nil (. _G._CC_VALUES name))
                                        ;       (each [_ device (ipairs (renoise.Midi.available_input_devices))]
                                        ;             (when (contains device name)
                                        ;               (let [m {}]
                                        ;                    (tset _G._CC_VALUES name m)
                                        ;                    (tset _G._CC_VALUES device m)
                                        ;                    (let [dev (renoise.Midi.create_input_device
                                        ;                               device
                                        ;                               (fn [[s cc value]]
                                        ;                                   (when (= s 176)
                                        ;                                     (status (.. "MIDI CC " device " " cc " " value))
                                        ;                                     (tset m cc value))))]
                                        ;                      (tset _G._CC_DEVICES device dev)))))))


(fn cc [device cc]
    (maybeInstallMidiDevice device)
    (if cc
        (or (. _G._CC_VALUES device cc) 0)
        #(or (. _G._CC_VALUES device $) 0)))
  (maybeInstallMidiDevice device)
  (if cc
      (or (. _G._CC_VALUES device cc) 0)
      #(or (. _G._CC_VALUES device $) 0)))

(fn cc% [device cc]
    (maybeInstallMidiDevice device)
    (if cc
        (let [v (. _G._CC_VALUES device cc)] (if v (/ v 127) 0))
        #(let [v (. _G._CC_VALUES device $)] (if v (/ v 127) 0))))
  (maybeInstallMidiDevice device)
  (if cc
      (let [v (. _G._CC_VALUES device cc)] (if v (/ v 127) 0))
      #(let [v (. _G._CC_VALUES device $)] (if v (/ v 127) 0))))

(fn cc%1- [device cc]
    (maybeInstallMidiDevice device)
    (if cc
        (let [v (. _G._CC_VALUES device cc)] (- 1 (if v (/ v 127) 0)))
        #(let [v (. _G._CC_VALUES device $)] (- 1 (if v (/ v 127) 0)))))
  (maybeInstallMidiDevice device)
  (if cc
      (let [v (. _G._CC_VALUES device cc)] (- 1 (if v (/ v 127) 0)))
      #(let [v (. _G._CC_VALUES device $)] (- 1 (if v (/ v 127) 0)))))

(fn cc? [device cc]
    (maybeInstallMidiDevice device)
    (if cc
        (let [v (. _G._CC_VALUES device cc)] (if v (> v 0) false))
        #(let [v (. _G._CC_VALUES device $)] (if v (> v 0) false))))
  (maybeInstallMidiDevice device)
  (if cc
      (let [v (. _G._CC_VALUES device cc)] (if v (> v 0) false))
      #(let [v (. _G._CC_VALUES device $)] (if v (> v 0) false))))

(fn or-default [s d]
  (match (# s)


@@ 137,15 137,15 @@
(fn str-sub-or-default [in from to default]
  (let [s (string.sub in from to)]
    (match (# s)
        0 default
        _ s)))
      0 default
      _ s)))

(fn sub-or-default [in from to default]
  (match (type in)
    :string (str-sub-or-default in from to default)
    _ (resumable
        (each [i (seq.iter in)]
          (str-sub-or-default i from to default)))))
       (each [i (seq.iter in)]
         (str-sub-or-default i from to default)))))

(fn splice [s i new len]
  (let [new (if len (string.sub new 1 len) new)


@@ 168,16 168,16 @@
     (each [line (seq.iter lines)]
       (coroutine.yield (splice-line line i (new) len))))))

; (instrument :c-402)   ;; -> 2
; (instrument :c-402 9) ;; -> :c-409
; (instrument seq 9)    ;; -> (... 09 09 09 ...)
                                        ; (instrument :c-402)   ;; -> 2
                                        ; (instrument :c-402 9) ;; -> :c-409
                                        ; (instrument seq 9)    ;; -> (... 09 09 09 ...)

(fn note [in new]
  (if new
    (splice-lines in 1 new 3)
    (or-default (string.sub in 1 3) "---")
    ; (sub-or-default in 1 3 "---")
    ))
      (splice-lines in 1 new 3)
      (or-default (string.sub in 1 3) "---")
                                        ; (sub-or-default in 1 3 "---")
      ))

(fn desugar-instrument [val]
  (match (type val)


@@ 196,49 196,38 @@

(fn instrument [line new]
  (if new
    (splice-lines line 4 (seq.map new desugar-instrument) 2)
    (or-default (string.sub line 4 5) "..")))
      (splice-lines line 4 (seq.map new desugar-instrument) 2)
      (or-default (string.sub line 4 5) "..")))

(fn volume [line new]
  (if new
    (splice-lines line 6 (seq.map new desugar-value) 2)
    (or-default (string.sub line 6 7) "..")))
      (splice-lines line 6 (seq.map new desugar-value) 2)
      (or-default (string.sub line 6 7) "..")))

(fn pan [line new]
  (if new
    (splice-lines line 8 (seq.map new desugar-value) 2)
    (or-default (string.sub line 8 9) "..")))
      (splice-lines line 8 (seq.map new desugar-value) 2)
      (or-default (string.sub line 8 9) "..")))

(fn delay [line new]
  (if new 
    (splice-lines line 10 (seq.map new desugar-value) 2)
    (or-default (string.sub line 10 11) "..")))
      (splice-lines line 10 (seq.map new desugar-value) 2)
      (or-default (string.sub line 10 11) "..")))

(fn fx [line new]
  (if new
    (splice-lines line 12 new 4)
    (or-default (string.sub line 12 16) "....")))
      (splice-lines line 12 new 4)
      (or-default (string.sub line 12 16) "....")))

(fn fxn [line new]
  (if new
    (splice-lines line 12 new 2)
    (or-default (string.sub line 12 13) "..")))
      (splice-lines line 12 new 2)
      (or-default (string.sub line 12 13) "..")))

(fn fxa [line new]
  (if new
    (splice-lines line 14 new 2)
    (or-default (string.sub line 14 15) "..")))

(fn rest? [s]
  (match (type s)
    :string (= 1 (s:find "^-*$"))
    _ false))

(fn off? [s]
  (= 1 (: (string.upper s) :find "^OFF")))

(fn note? [s]
  (and (not (off? s)) (not (rest? s))))
      (splice-lines line 14 new 2)
      (or-default (string.sub line 14 15) "..")))

(fn balance [columns]
  (let [columns* []]


@@ 254,38 243,25 @@
      (each [i column (ipairs columns)]
        (when (not= (# (. columns* i)) longest)
          (each [x (-> column (seq.take (- 511 longest)))]
              (table.insert (. columns* i) x))))
        ;; compute new longest
        (each [_ c (ipairs columns*)]
          (let [len (# c)]
            (when (> len longest)
              (set longest len))))
        ;; balance columns
        (set balanced true)
        (each [_ c (ipairs columns*)]
          (when (not= longest (# c))
            (set balanced false)
            (lua :break))))
            (table.insert (. columns* i) x))))
      ;; compute new longest
      (each [_ c (ipairs columns*)]
        (let [len (# c)]
          (when (> len longest)
            (set longest len))))
      ;; balance columns
      (set balanced true)
      (each [_ c (ipairs columns*)]
        (when (not= longest (# c))
          (set balanced false)
          (lua :break))))
    columns*))

(fn rle [...]
    (let [in (seq.iter [...])]
         (resumable
          (while true
            (var count (in))
            (if (= nil count)
                (lua :break)
                (let [value (in)]
                     (while (> count 0)
                       (coroutine.yield value)
                       (set count (- count 1)))))))))

{ : get-note-value : get-note-name : scale : or-default : str-sub-or-default
{ : get-note-value : get-note-name : or-default : str-sub-or-default
  : sub-or-default : splice : expand : splice-line : splice-lines : note
  : instrument : volume : pan : delay : fx : fxn : fxa : rest? : off? : balance
  : instrument : volume : pan : delay : fx : fxn : fxa : balance
  : fxfmt
  : track-lookup : instrument-lookup : note?
  : track-lookup : instrument-lookup
  : desugar-instrument
  : samples : slices
  : cc : cc% : cc%1- : cc?
  : rle }
\ No newline at end of file
  : samples : sample : slices
  : cc : cc% : cc%1- : cc? }

M main.lua => main.lua +43 -8
@@ 4,11 4,13 @@
-- This file sets up the REPL, session management bookkeeping, and other bits of
-- supporting infrastructure. Most of 8FL is implemented in Fennel.

local _8FL_VERSION = "0.4"
local _8FL_VERSION = "0.5"
local fennel = require("fennel")
local fv = require("fennelview")
table.insert(package.loaders or package.searchers, fennel.makeSearcher({useMetadata=true}))

_G._8fl_server = nil

-- Reload a library in place. Useful for development.
-- Taken from https://technomancy.us/189
function reload(lib)


@@ 185,7 187,7 @@ function useStandardLibrary(env)
    env.use("seq")
    env.use("core")
    env.use("scales")
    env.use("patterns")
    env.use("seq-renoise")
    env.use("renoise")
    env.use("api")
end


@@ 246,7 248,7 @@ if err then
    -- give up if we couldn't start the server
    print(err)
else
    _G["8fl_server"] = server -- keep server from getting GC'd
    _G._8fl_server = server -- keep server from getting GC'd
    status("listening " .. server.local_address .. ":" .. server.local_port)
    server:run({
            socket_error = function(error_message)


@@ 304,13 306,46 @@ function renderPattern(patternNumber)
    end
end

-- ;; to support <> macro
_G["_CYCLES"] = {}
-- TODO this is duplicated from core.fnl
function contains(haystack, needle)
    return string.find(string.lower(haystack), string.lower(needle))
end

-- to support <> macro
_G._CYCLES = {}

-- support for cc functions
_G._CC_VALUES = {}
_G._CC_DEVICES = {}
function maybeInstallMidiDevice(name)
    if _G._CC_VALUES[name] == nil then
        for _, full_name in ipairs(renoise.Midi.available_input_devices()) do
            if contains(full_name, name) then
                local m = {}
                _G._CC_VALUES[name] = m
                local device = renoise.Midi.create_input_device(
                    full_name,
                    function(message)
                        local s = message[1]
                        if s == 176 then
                            local cc = message[2]
                            local value = message[3]
                            m[cc] = value
                            -- force re-render of pattern
                            lastPatternNumber = nil
                        end
                    end
                )
                _G._CC_DEVICES[full_name] = device
            end
        end
    end
end

-- Schedule function to run at start of new pattern
-- used by API
function onpattern(f)
    _G["_CYCLES"] = {}
    _G._CYCLES = {}
    collectgarbage("collect") -- TODO is this too defensive?
    lastPatternNumber = nil
    _new_pattern_func = f


@@ 323,9 358,9 @@ function onpattern(f)
end

renoise.tool().tool_will_unload_observable:add_notifier(function ()
    if _G["8fl_server"] then
    if _G._8fl_server then
        status("tool unloading, shutting down server")
        _G["8fl_server"]:close()
        _G._8fl_server:close()
    end
end)


D patterns.fnl => patterns.fnl +0 -208
@@ 1,208 0,0 @@
(local core (require :core))
(local seq (require :seq))

(require-macros :core-macros)

(fn rests [n]
  "A vector of n rests"
  (-> :--- (seq.repeat n) seq.vec))

(fn or-rests [in]
  (match (type in)
    :number (rests in)
    _ in))

(fn fill-steps [in n xs]
  (resumable
   (let [in (or-rests in)
         xs (seq.iter xs)]
     (var k n)
     (each [i (seq.iter in)]
       (if (= k 1)
           (do 
             (set k n)
             (let [x (xs)]
               (if (= :function (type x))
                   (coroutine.yield (x i))
                   (coroutine.yield x))))
           (do
             (set k (- k 1))
             (coroutine.yield i)))))))

(fn fill-notes [in xs]
  (let [xs (seq.cycle xs)]
    (resumable
     (let [in (or-rests in)]
       (each [i (seq.iter in)]
         (if (core.rest? i)
             (coroutine.yield i)
             (let [x (xs)]
               (if (= :function (type x))
                   (coroutine.yield (x i))
                   (coroutine.yield x)))))))))

(fn fill-rests [in xs]
  (resumable
    (let [in (or-rests in)
          xs (seq.iter xs)]
      (each [i (seq.iter in)]
        (if (core.rest? i)
          (let [x (xs)]
             (if (= :function (type x))
               (coroutine.yield (x i))
               (coroutine.yield x)))
          (coroutine.yield i))))))

(fn fill-random [in xs density]
  (resumable
    (let [density (or density 0.5)
          in (or-rests in)
          xs (seq.cycle xs)]
      (each [i (seq.iter in)]
        (let [x (xs)]
          (if (< (math.random) density)
              (if (= :function (type x))
                  (coroutine.yield (x i))
                  (coroutine.yield x))
              (coroutine.yield i)))))))

(fn filter-notes [xs]
  (resumable
    (each [x (seq.iter xs)]
      (if (and (not (core.off? x)) (not (core.rest? x)))
        (coroutine.yield x)))))

;; TODO make this work without vec, if possible
(fn invert [xs]
  (resumable
    (let [xs (seq.vec xs)
          notes (seq.cycle (filter-notes xs))]
      (each [x (seq.iter xs)]
        (if (core.rest? x)
          (coroutine.yield (notes))
          (coroutine.yield :---))))))

;; https://codepen.io/Dafuseder/pen/WEqOVw
;; TODO falls into loop when xs < #pulses
(fn fill-euclid [xs in pulses]
  ""
  (let [xs (seq.cycle xs)]
    (resumable
      (let [in (seq.vec (or-rests in))
            steps (# in)
            in (seq.iter in)] 
        (var prev nil)
        (for [i 0 (- steps 1)]
          (let [x (math.floor (* i (/ pulses steps)))]
            (coroutine.yield (if (= x prev) (in) (xs)))
            (set prev x)))))))

(fn make-euclid [in pulses]
  (let [xs (seq.cycle :x)]
    (resumable
      (let [in (seq.vec (or-rests in))
            steps (# in)
            in (seq.iter in)] 
        (var prev nil)
        (for [i 0 (- steps 1)]
          (let [x (math.floor (* i (/ pulses steps)))]
            (coroutine.yield (if (= x prev) (in) (xs)))
            (set prev x)))))))

;; TODO move to seq
(fn rotate [in rotation]
  (resumable
    (let [_seq (seq.vec in)]
      (for [_ 1 rotation]
        (table.insert _seq 1 (table.remove _seq (# _seq))))
      (each [s (seq.iter _seq)]
        (coroutine.yield s)))))

(fn rhythm [xs rhs]
  (let [xs (seq.cycle xs)]
    (resumable
      (each [r (seq.iter rhs)]
        (if (core.rest? r)
          (coroutine.yield r)
          (coroutine.yield (xs)))))))

;; TODO rename in to xs
(fn fit [in n]
  (let [in (seq.vec (or-rests in))
        in-count (# in)
        m (math.max 1 (math.floor (/ n in-count)))
        rem (- n (* m in-count))
        m-1 (- m 1)]
    (resumable
      (var n n)
      (each [line (seq.iter in)]
        (match (type line)
               :function (do (coroutine.yield (line)) (for [i 1 (math.min n m-1)] (coroutine.yield :---)))
               :table    (each [x (seq.iter (fit line m))] (coroutine.yield x))
               _         (do (coroutine.yield line) (for [i 1 (math.min n m-1)] (coroutine.yield :---))))
        (set n (- n m))
        (if (<= n 0) (lua :break)))
      (for [i 1 rem] (coroutine.yield :---))
      )))

(fn spread [xs n]
  (let [n (- n 1)]
    (resumable
      (each [x (seq.iter xs)]
        (coroutine.yield x)
        (for [i 1 n] (coroutine.yield :---))))))

(fn choice [xs]
  (. xs (math.random (# xs))))

(fn choice-of [xs] "choose a random element from xs" #(choice (seq.vec xs)))

(fn sum [...]
  (local coros (-> [...] (seq.map seq.iter) seq.vec))
  (resumable
   (while true
     (var val nil)
     (each [_ c (ipairs coros)]
       (match (c)
         (where x (= nil x)) (lua :return)
         (where x (= nil val) (core.rest? x)) (set val x)
         (where x (not (core.rest? x))) (set val x)))
     (coroutine.yield val))))

(fn follow [in xs]
  (let [xs (seq.cycle xs)
        in (seq.iter in)]
    (resumable
     (var was-note false)
     (each [i in]
       (if was-note
         (do (coroutine.yield (xs))
             (set was-note false))
         (do (coroutine.yield i)
             (when (core.note? i)
               (set was-note true))))))))

(fn before [in xs]
  (let [xs (seq.cycle xs)
        in (seq.iter in)]
    (resumable
     (var last nil)
     (each [i in]
       (if last
         (if (core.note? i)
           (coroutine.yield (xs))
           (coroutine.yield last)))
       (set last i))
     (coroutine.yield last))))

(fn pick [xs pat]
  (let [pat (seq.vec pat)
        max (math.max (unpack pat))
        vs (-> (seq.cycle xs) (seq.take max) seq.vec)]
    (resumable
     (each [p (seq.iter pat)]
      (coroutine.yield (seq.nth vs (math.fmod p (+ 1 (# vs)))))))))

{ : rests : or-rests : fill-steps : fill-notes : fill-rests : fill-random
  : filter-notes : invert : fill-euclid : make-euclid : rotate : rhythm : fit : choice : spread
  : choice-of : sum : follow : before : pick }

M renoise.fnl => renoise.fnl +31 -32
@@ 1,21 1,20 @@
(local core (require :core))
(local seq (require :seq))
(local patterns (require :patterns))

;; TODO figure out macro modules
(require-macros :core-macros)

;; TODO rename to write-note
(fn write [value pattern track line column]
    (let [value (core.splice-line value 1 value (math.max (# value) 3))
          col (-> (renoise.song) (: :pattern pattern) (: :track track) (: :line line) (: :note_column column))]
      (tset col :note_string (string.upper (core.note value)))
      (tset col :instrument_string (string.upper (core.instrument value)))
      (tset col :volume_string (string.upper (core.volume value)))
      (tset col :delay_string (string.upper (core.delay value)))
      (tset col :panning_string (string.upper (core.pan value)))
      (tset col :effect_number_string (string.upper (core.fxn value)))
      (tset col :effect_amount_string (string.upper (core.fxa value)))))
  (let [value (core.splice-line value 1 value (math.max (# value) 3))
        col (-> (renoise.song) (: :pattern pattern) (: :track track) (: :line line) (: :note_column column))]
    (tset col :note_string (string.upper (core.note value)))
    (tset col :instrument_string (string.upper (core.instrument value)))
    (tset col :volume_string (string.upper (core.volume value)))
    (tset col :delay_string (string.upper (core.delay value)))
    (tset col :panning_string (string.upper (core.pan value)))
    (tset col :effect_number_string (string.upper (core.fxn value)))
    (tset col :effect_amount_string (string.upper (core.fxa value)))))

(fn fx-rest [v] (string.gsub v "-" "."))



@@ 23,10 22,10 @@
(fn fxfxa [value] (fx-rest (string.sub value 3 4)))

(fn write-fx [value pattern track line column]
    (let [value (core.splice-line "...." 1 (fx-rest value) 4)
          col (-> (renoise.song) (: :pattern pattern) (: :track track) (: :line line) (: :effect_column column))]
      (tset col :number_string (string.upper (fxfxn value)))
      (tset col :amount_string (string.upper (fxfxa value)))))
  (let [value (core.splice-line "...." 1 (fx-rest value) 4)
        col (-> (renoise.song) (: :pattern pattern) (: :track track) (: :line line) (: :effect_column column))]
    (tset col :number_string (string.upper (fxfxn value)))
    (tset col :amount_string (string.upper (fxfxa value)))))

(fn parse-fx [value]
  (var value value)


@@ 49,15 48,15 @@
(fn ensure-columns-note [track-idx columns]
  (let [track (: (renoise.song) :track track-idx)
        visible-columns (. track :visible_note_columns)]
      (when (> columns visible-columns)
        (tset track :visible_note_columns columns))))
  
    (when (> columns visible-columns)
      (tset track :visible_note_columns columns))))


(fn ensure-columns-fx [track-idx columns]
  (let [track (: (renoise.song) :track track-idx)
        visible-columns (. track :visible_effect_columns)]
      (when (> columns visible-columns)
        (tset track :visible_effect_columns columns))))
    (when (> columns visible-columns)
      (tset track :visible_effect_columns columns))))

(fn clear-and-silence [pattern]
  (pattern:clear)


@@ 94,11 93,11 @@
            column-idx (if old-column-idx (+ 1 old-column-idx) 1)]
        (tset column-idxs-table track-idx column-idx)
        (if fx?
          (ensure-columns-fx track-idx column-idx)
          (ensure-columns-note track-idx column-idx))
            (ensure-columns-fx track-idx column-idx)
            (ensure-columns-note track-idx column-idx))
        (if fx?
          (render-track-fx pattern-idx track-idx column-idx column)
          (render-track-notes pattern-idx track-idx column-idx column))))))
            (render-track-fx pattern-idx track-idx column-idx column)
            (render-track-notes pattern-idx track-idx column-idx column))))))

(fn balance-and-render! [idx data]
  (let [columns []


@@ 119,24 118,24 @@
  (let [song (renoise.song)]
    (while (< 1 (# (. song :sequencer :pattern_sequence)))
      (: (. song :sequencer) :delete_sequence_at
        (# (. song :sequencer :pattern_sequence))))
         (# (. song :sequencer :pattern_sequence))))
    (: (. song :patterns 1) :clear)))

(fn read-column [pattern-idx track-idx column-idx]
  (let [song (renoise.song)
        track (if track-idx
                (-> (song:pattern pattern-idx) (: :track track-idx))
                song.selected_pattern_track)
                  (-> (song:pattern pattern-idx) (: :track track-idx))
                  song.selected_pattern_track)
        column-idx (or column-idx song.selected_note_column_index)]
    (resumable
      (each [i line (ipairs track.lines)]
        (coroutine.yield (-> (line:note_column column-idx) tostring))))))
     (each [i line (ipairs track.lines)]
       (coroutine.yield (-> (line:note_column column-idx) tostring))))))

(fn read-notes [pattern-idx track-idx column-idx]
  (-> (read-column pattern-idx track-idx column-idx)
      (patterns.filter-notes)))
                                        ; (fn read-notes [pattern-idx track-idx column-idx]
                                        ;   (-> (read-column pattern-idx track-idx column-idx)
                                        ;       (patterns.filter-notes)))

{ : write : parse-fx : fxfxn : fxfxa : render-track-notes
  : ensure-columns-note : ensure-columns-fx : render-pattern
  : balance-and-render! : clear-song!
  : read-column : read-notes }
\ No newline at end of file
  : read-column }

M scales.fnl => scales.fnl +2 -1
@@ 43,6 43,7 @@
(local oriental [1 3 1 1 3 1 2])
(local minor-romanian [2 1 3 1 2 1 2])
(local spanish-phrygian [1 3 1 2 1 2 2])
(local phrygian [1 2 2 2 1 2 2])
(local whole-tone [2 2 2 2 2 2])
(local yo [2 3 2 2 3])



@@ 53,5 54,5 @@
 : eight-tone : major-enigmatic : minor-enigmatic : geez : hawaiian : hindu
 : hirajoshi : hungarian : major-hungarian : iwato : in-sen : overtone
 : minor-neapolitan : major-neapolitan : octatonic-half-whole
 : octatonic-whole-half : oriental : minor-romanian : spanish-phrygian
 : octatonic-whole-half : oriental : minor-romanian : phrygian : spanish-phrygian
 : whole-tone : yo}
\ No newline at end of file

A seq-renoise.fnl => seq-renoise.fnl +123 -0
@@ 0,0 1,123 @@
;;; renoise-specific sequence library
;;; generally functions here are aware of the difference between rests and notes

;;; TODO bring back polyend inspired functions
;;; TODO bring back tidal inspired functions

(local seq (require :seq))
(require-macros :core-macros)

;; TODO this should go into line.fnl
(fn rest? [s]
  (match (type s)
    :string (= 1 (s:find "^-*$"))
    _ false))

;; TODO this should go into line.fnl
(fn off? [s]
  (= 1 (: (string.upper s) :find "^OFF")))

;; TODO this should go into line.fnl
(fn note? [s]
  (and (not (off? s)) (not (rest? s))))

(fn char-beat [xs]
  (resumable
   (each [c (string.gmatch xs ".")]
     (coroutine.yield c))))

(local hex-beat-lookup
       { :0 :----
         :1 :---x
         :2 :--x-
         :3 :--xx
         :4 :-x--
         :5 :-x-x
         :6 :-xx-
         :7 :-xxx
         :8 :x---
         :9 :x--x
         :a :x-x-
         :b :x-xx
         :c :xx--
         :d :xx-x
         :e :xxx-
         :f :xxxx})

(fn hex-beat [n]
  (resumable
   (let [s (string.format "%x" n)]
     (each [c (string.gmatch s ".")]
       (let [b (. hex-beat-lookup c)]
         (each [x (string.gmatch b ".")]
           (coroutine.yield x)))))))


(fn beat [n]
  (match (type n)
    :string (char-beat n)
    :number (hex-beat n)
    _ n))

(fn euclidean [steps pulses]
  (let [xs (seq.cycle :x)
        rests (seq.cycle :-)]
    (resumable
     (var prev nil)
     (for [i 0 (- steps 1)]
       (let [x (math.floor (* i (/ pulses steps)))]
         (coroutine.yield (if (= x prev) (rests) (xs)))
         (set prev x))))))

(fn rhythm [xs rhs]
  (let [xs (seq.cycle xs)]
    (resumable
     (each [r (-> rhs beat seq.iter)]
       (if (rest? r)
           (coroutine.yield r)
           (coroutine.yield (xs)))))))

(fn spread [xs n]
  (let [n (- n 1)]
    (resumable
     (each [x (seq.iter xs)]
       (coroutine.yield x)
       (for [i 1 n] (coroutine.yield :-))))))

(fn follow [in xs]
  (let [xs (seq.cycle xs)
        in (seq.iter in)]
    (resumable
     (var was-note false)
     (each [i in]
       (if was-note
           (do (coroutine.yield (xs))
               (set was-note false))
           (do (coroutine.yield i)
               (when (note? i)
                 (set was-note true))))))))

(fn before [in xs]
  (let [xs (seq.cycle xs)
        in (seq.iter in)]
    (resumable
     (var last nil)
     (each [i in]
       (if last
           (if (note? i)
               (coroutine.yield (xs))
               (coroutine.yield last)))
       (set last i))
     (coroutine.yield last))))

(fn pick [xs pat]
  (let [pat (seq.vec pat)
        max (math.max (unpack pat))
        vs (-> (seq.cycle xs) (seq.take max) seq.vec)]
    (resumable
     (each [p (seq.iter pat)]
       (coroutine.yield (seq.nth vs (math.fmod p (+ 1 (# vs)))))))))

{ : euclidean : rhythm : spread
  : follow : before : pick 
  : beat : char-beat : hex-beat }

M seq.fnl => seq.fnl +83 -68
@@ 1,24 1,20 @@
;; TODO figure out macro modules
(require-macros :core-macros)
;;; generic coroutine-based sequence library, inspired by clojure

(fn is-seq-sugar? [x]
    (string.match x ":$"))
(require-macros :core-macros)

;; TODO should (iter :foo) -> (forever :foo) ?
;; TODO should we spacial case strings as char-beat and numbers as hex-beat?
;; how important is the base case of (iter "foo") -> ["foo"] ?
(fn iter [xs]
  "turns xs, expected to be either a function or an array, into an iterator.
  
   an iterator is a function that, when invoked, returns the next element in the
   sequence"
  (match (type xs)
         :function xs
         :table (resumable
                  (each [_ x (ipairs xs)]
                    (coroutine.yield x)))
         :string (if (is-seq-sugar? xs)
                     (string.gmatch (string.sub xs 1 -2) ".")
                     (resumable (coroutine.yield xs)))
         _ (resumable (coroutine.yield xs))))
    :function xs
    :table (resumable
            (each [_ x (ipairs xs)]
              (coroutine.yield x)))
    _ (resumable (coroutine.yield xs))))

(fn vec [xs]
  "turns xs, expected to be either a function or an array, into an vector.


@@ 29,7 25,7 @@
    _
    (let [ret []]
      (each [x (iter xs)]
            (table.insert ret x))
        (table.insert ret x))
      ret)))

(fn first [xs]


@@ 49,22 45,22 @@
  (each [x (iter xs)]
    (set n (- n 1))
    (if (= n 0)
      (lua "return x")))
        (lua "return x")))
  nil)

(fn range [from to step]
  (resumable
    (var from* (if to from 1))
    (var to* (+ 1 (if to to from)))
    (var step* (if step step (if (< from to) 1 -1)))
    (while (< from* to*)
      (coroutine.yield from*)
      (set from* (+ from* step*)))))
   (var from* (if to from 1))
   (var to* (+ 1 (if to to from)))
   (var step* (if step step (if (< from to) 1 -1)))
   (while (< from* to*)
     (coroutine.yield from*)
     (set from* (+ from* step*)))))

(fn map [xs f]
  (resumable
    (each [x (iter xs)]
      (coroutine.yield (f x)))))
   (each [x (iter xs)]
     (coroutine.yield (f x)))))

(fn map-cat [xs f]
  (resumable


@@ 79,20 75,20 @@
  (resumable
   (each [x (iter xs)]
     (if (pred x)
       (coroutine.yield (f x)) 
       (coroutine.yield x)))))
         (coroutine.yield (f x)) 
         (coroutine.yield x)))))

(fn filter [xs f]
  (resumable
    (each [x (iter xs)]
      (when (f x)
        (coroutine.yield x)))))
   (each [x (iter xs)]
     (when (f x)
       (coroutine.yield x)))))

(fn remove [xs f]
  (resumable
    (each [x (iter xs)]
      (when (not (f x))
        (coroutine.yield x)))))
   (each [x (iter xs)]
     (when (not (f x))
       (coroutine.yield x)))))

(fn keep [xs f]
  (resumable


@@ 103,20 99,20 @@

(fn take [xs n]
  (resumable
    (var n n)
    (each [x (iter xs)]
      (coroutine.yield x)
      (set n (- n 1))
      (when (= n 0)
        (lua :return)))))
   (var n n)
   (each [x (iter xs)]
     (coroutine.yield x)
     (set n (- n 1))
     (when (= n 0)
       (lua :return)))))

(fn drop [xs n]
  (resumable
   (var n n)
   (each [x (iter xs)]
     (if (> n 0)
       (set n (- n 1))
       (coroutine.yield x)))
         (set n (- n 1))
         (coroutine.yield x)))
   (coroutine.yield nil)))

(fn drop-while [xs f]


@@ 124,14 120,14 @@
   (var dropping true)
   (each [x (iter xs)]
     (if dropping
       (set dropping (f x)))
         (set dropping (f x)))
     (if (not dropping)
       (coroutine.yield x)))))
         (coroutine.yield x)))))

(fn cycle [xs]
  (local cache [])
  (coroutine.wrap
    #(do
   #(do
      (each [x (iter xs)]
        (table.insert cache x)
        (coroutine.yield x))


@@ 144,31 140,31 @@
  (each [i c (ipairs coros)]
    (tset coros i (iter c)))
  (resumable
    (while true
      (each [_ c (ipairs coros)]
        (match (c)
            nil (lua :return)
            v (coroutine.yield v))))))
   (while true
     (each [_ c (ipairs coros)]
       (match (c)
         nil (lua :return)
         v (coroutine.yield v))))))

(fn forever [v]
  (coroutine.wrap
    #(while true
   #(while true
      (coroutine.yield v))))

(fn repeat [xs n]
  (resumable
    (var n n)
    (while (> n 0)
      (each [x (iter xs)]
        (coroutine.yield x))
      (set n (- n 1)))))
   (var n n)
   (while (> n 0)
     (each [x (iter xs)]
       (coroutine.yield x))
     (set n (- n 1)))))

(fn concat [...]
  (local vals [...])
  (resumable
    (each [_ xs (ipairs vals)]
      (each [x (iter xs)]
        (coroutine.yield x)))))
   (each [_ xs (ipairs vals)]
     (each [x (iter xs)]
       (coroutine.yield x)))))

(fn reduce [xs f init]
  (var ret init)


@@ 178,27 174,46 @@

(fn reverse [xs]
  (resumable
    (let [v (vec xs)
          len (# v)]
      (for [i 0 len]
        (coroutine.yield (. v (- len i)))))))
   (let [v (vec xs)
         len (# v)]
     (for [i 0 len]
       (coroutine.yield (. v (- len i)))))))

(fn distinct [xs]
  (resumable
   (var vals {})
   (each [x (iter xs)]
    (when (not (. vals x))
      (tset vals x true)
      (coroutine.yield x)))))
     (when (not (. vals x))
       (tset vals x true)
       (coroutine.yield x)))))

;; TODO maybe move to patterns?
(fn linger [xs n]
  (let [n (cycle (or n 1))]
    (resumable
      (each [x (iter xs)]
        (for [_ 1 (n)]
          (coroutine.yield x))))))
     (each [x (iter xs)]
       (for [_ 1 (n)]
         (coroutine.yield x))))))

(fn rotate [in rotation]
  (resumable
   (let [_seq (vec in)]
     (for [_ 1 rotation]
       (table.insert _seq 1 (table.remove _seq (# _seq))))
     (each [s (iter _seq)]
       (coroutine.yield s)))))

(fn rle [...]
  (let [in (seq.iter [...])]
    (resumable
     (while true
       (var count (in))
       (if (= nil count)
           (lua :break)
           (let [value (in)]
             (while (> count 0)
               (coroutine.yield value)
               (set count (- count 1)))))))))

{: iter : vec : first : range : map : mapv : filter : take : drop : cycle
 : interleave : forever : repeat : concat : reduce : reverse : map-if : keep
 : distinct   : map-cat : drop-while : last : nth : linger }
 : distinct   : map-cat : drop-while : last : nth : linger : rotate : rle }