aboutsummaryrefslogtreecommitdiff
path: root/guile/starlet/midi-control/faders.scm
blob: dde27606c83520b8ce7c9d832cfd9824ae9eb6e9 (plain)
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
143
(define-module (starlet midi-control faders)
  #:use-module (starlet midi-control base)
  #:use-module (starlet base)
  #:use-module (ice-9 receive)
  #:export (on-fader
            sel))


(define* (on-fader cc-number state
                   #:key (channel #f))
  (register-state!
   (lighting-state
    (state-for-each
     (lambda (fix attr val)
           (if (intensity? attr)

               ;; Intensity parameters get scaled according to the fader
               (at fix attr (lambda (time)
                              (let ((cc-val (get-cc-value cc-number
                                                          #:channel channel)))
                                (if cc-val
                                  (* 0.01 val (ccval->percent cc-val))
                                  0))))

               ;; Non-intensity parameters just get set in our new state
               (at fix attr val)))

     state))))


(define* (at-midi-jogwheel fix attr cc-number
                           #:key (led #f))

  (define (ccval->offset a)
    (if (eq? a 127)
        -1
        1))

  (when led
    (send-note-on led))

  (let ((old-val (current-value fix attr))
        (offset 0))
    (register-midi-cc-callback!
     #:cc-number cc-number
     #:func (lambda (prev-cc-val new-cc-value)
              (set! offset (+ offset (ccval->offset new-cc-value)))
              (set-attr! selection-state
                         fix
                         attr
                         (+ old-val offset))))))


(define (in-range a val1 val2)
  (or
   (and (>= a val1)
        (<= a val2))
   (and (>= a val2)
        (<= a val1))))


(define* (at-midi-fader fix
                        attr
                        cc-number
                        #:key
                        (led-incongruent #f)
                        (led #f))

  (let* ((congruent-val (percent->ccval (current-value fix attr)))

         (cc-val (get-cc-value cc-number))
         (congruent (and cc-val
                         (= cc-val congruent-val))))

    (if congruent
        (send-note-on led)
        (send-note-on led-incongruent))

    (register-midi-cc-callback!
     #:cc-number cc-number
     #:func (lambda (prev-cc-val new-cc-value)

              (when congruent
                (set-attr! selection-state
                           fix
                           attr
                           (ccval->percent new-cc-value)))

              (when (or (and (not prev-cc-val)
                             (= new-cc-value congruent-val))
                        (and prev-cc-val new-cc-value
                             (in-range congruent-val
                                       prev-cc-val
                                       new-cc-value)))
                (set! congruent #t)
                (send-note-on led))))))


(define (select-fixtures fixture)
  (values
   (list 98 124 125 84 85 86 120 121 122)
   (list
    (at-midi-jogwheel fixture 'intensity 21
                      #:led 98)
    (at-midi-jogwheel fixture 'pan 0
                      #:led 124)
    (at-midi-jogwheel fixture 'tilt 1
                      #:led 125)
    (at-midi-fader fixture 'r 4
                      #:led 120
                      #:led-incongruent 84)
    (at-midi-fader fixture 'g 5
                      #:led 121
                      #:led-incongruent 85)
    (at-midi-fader fixture 'b 6
                      #:led 122
                      #:led-incongruent 86))))


;; Stuff to clear up when we're done with selected fixtures
(define midi-callbacks '())
(define midi-leds '())


(define (sel fixture)

  (define (merge-rule-replace attr a b) b)

  (when selection-state
    (add-state-to-state! merge-rule-replace
                         selection-state
                         programmer-state)
    (clear-state! selection-state)
    (for-each remove-midi-callback! midi-callbacks)
    (for-each send-note-off midi-leds)
    (set! midi-callbacks '())
    (set! midi-leds '()))

  (when fixture
    (receive (leds callbacks)
      (select-fixtures fixture)
      (set! midi-callbacks callbacks)
      (set! midi-leds leds))))