~nasser/8fl

8fl/renoise.fnl -rw-r--r-- 5.4 KiB
2934f9e8Ramsey Nasser Use negative track numbers for fx columns a month ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
(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)))))

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

(fn fxfxn [value] (fx-rest (string.sub value 1 2)))
(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)))))

(fn parse-fx [value]
  (var value value)
  (let [columns []]
    (while (>= (# value) 4)
      (table.insert columns (string.sub value 1 4))
      (set value (string.sub value 5)))
    columns))

;; assumes balanced columns!
(fn render-track-notes [pattern-idx track-idx column-idx column]
  (each [line-idx value (ipairs column)]
    (write value pattern-idx track-idx line-idx column-idx)))

;; assumes balanced columns!
(fn render-track-fx [pattern-idx track-idx column-idx column]
  (each [line-idx value (ipairs column)]
    (write-fx value pattern-idx track-idx line-idx column-idx)))

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

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

(fn clear-and-silence [pattern]
  (pattern:clear)
  (let [song (renoise.song)]
    (each [i track (ipairs (. pattern :tracks))]
      (let [line (: track :line 1)
            visible_columns (. (: song :track i) :visible_note_columns)]
        (for [column 1 visible_columns]
          (tset (: line :note_column column) :note_string :OFF))))))

(fn is-fx? [col]
  (match (type col)
    :number (< col 0)
    :string (= 1 (string.find col :-))
    _ false))

;; pattern-idx -> number
;; columns -> [ iter ...]
;; track-idxs -> [ number | string ...]
;; (= (# columns) (# track-idxs))
(fn render-pattern [pattern-idx columns track-idxs]
  (let [column-idxs-note {} ;; track-idx -> column-idx
        column-idxs-fx {}   ;; track-idx -> column-idx
        columns (core.balance columns)
        len (# (. columns 1))
        pattern (. (renoise.song) :patterns pattern-idx)]
    (clear-and-silence pattern)
    (tset pattern :number_of_lines len)
    (each [i column (ipairs columns)]
      (let [fx? (is-fx? (. track-idxs i))
            track-idx (core.track-lookup (. track-idxs i))
            column-idxs-table (if fx? column-idxs-fx column-idxs-note)
            old-column-idx (. column-idxs-table track-idx)
            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))
        (if fx?
          (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 []
        tracks []
        data (seq.iter data)]
    (var track (data))
    (var column nil)
    (while track
      (set column (data))
      ;; track might be an iterator
      (each [t (seq.iter track)]
        (table.insert tracks t)
        (table.insert columns column))
      (set track (data)))
    (render-pattern idx columns tracks)))

(fn clear-song! []
  (let [song (renoise.song)]
    (while (< 1 (# (. song :sequencer :pattern_sequence)))
      (: (. song :sequencer) :delete_sequence_at
        (# (. 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)
        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))))))

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