-- Envelope generators for OAK.

#INCLUDE "oak.inc"
#USE "basic"

--{{{ INT FUNCTION cycles
INT FUNCTION cycles (VAL REAL32 time) IS INT ROUND (time * SAMPLE.RATE):
--}}}

--{{{ PROC envelope
--* Generates a constant-length envelope based on an array, starting on the rising edge of the trigger input.
PROC envelope (CHAN SIGNAL trigger?, VAL []INT length, VAL []REAL32 level, CHAN SIGNAL out!)
  INITIAL BOOL running IS FALSE:
  INITIAL INT pos IS 0:
  INITIAL INT count IS 0:
  INITIAL REAL32 last.s IS (-1.0):
  WHILE TRUE
    SIGNAL sig:
    SEQ
      trigger ? sig
      SEQ i = 0 FOR BLOCK.SIZE
        INITIAL REAL32 s IS sig[i]:
        SEQ
          IF
            s > last.s
              SEQ
                running := TRUE
                pos := 0
                count := 0
            TRUE
              SKIP
          last.s := s
          IF
            running
              SEQ
                IF
                  count >= length[pos]
                    SEQ
                      count := 0
                      pos := pos + 1
                  TRUE
                    SKIP
                IF
                  pos = (SIZE length)
                    SEQ
                      running := FALSE
                      sig[i] := 0.0
                  TRUE
                    REAL32 frac, next:
                    SEQ
                      IF
                        (pos + 1) >= (SIZE length)
                          next := 0.0
                        TRUE
                          next := level[pos + 1]
                      IF
                        length[pos] = 0
                          frac := 1.0
                        TRUE
                          frac := (REAL32 ROUND count) / (REAL32 ROUND length[pos])
                      VAL REAL32 diff IS next - level[pos]:
                      sig[i] := level[pos] + (diff * frac)
                count := count + 1
            TRUE
              sig[i] := 0.0
      out ! sig
:
--}}}

--{{{ PROC adsr (CHAN REAL32 trigger?, out!, VAL REAL32 attack, decay, sustain, release)
--* Generate an ADSR envelope. A, D, R in seconds; S is an output level.
--
--          ____________
--  in ____|            |____
--
--                              1.0
--            /\
-- out       /  \_______        _
--          /           \       | S
--    _____/             \____  _
--         A  B  C     D  E
--
--  (B-A) = attack
--  (C-B) = decay
--  S     = sustain
--  (E-D) = release
--  A is note on, D is note off
--
PROC adsr (CHAN SIGNAL trigger?, out!, VAL REAL32 attack, decay, sustain, release)
  INITIAL BUFFER buf.in IS new.buf ():
  INITIAL BUFFER buf.out IS new.buf ():
  VAL INT attack.c IS cycles (attack):
  VAL INT decay.c IS cycles (decay):
  VAL INT release.c IS cycles (release):
  INITIAL REAL32 i IS 0.0:
  INITIAL REAL32 level IS 0.0:
  WHILE TRUE
    INT n:
    SEQ
      --{{{ wait for rising edge
      WHILE i < 0.5
        SEQ
          level := 0.0
          PAR
            buf.input (buf.in, trigger?, i)
            buf.output (buf.out, out!, level)
      --}}}

      --{{{ attack
      n := 0
      INITIAL REAL32 attack.level IS level:
      WHILE (n < attack.c) AND (i >= 0.5)
        SEQ
          level := attack.level + ((1.0 - attack.level) * ((REAL32 ROUND n) / (REAL32 ROUND attack.c)))
          PAR
            buf.input (buf.in, trigger?, i)
            buf.output (buf.out, out!, level)
          n := n + 1
      --}}}

      --{{{ decay
      n := 0
      WHILE (n < decay.c) AND (i >= 0.5)
        SEQ
          VAL REAL32 scale IS (1.0 - sustain):
          level := 1.0 - (scale * ((REAL32 ROUND n) / (REAL32 ROUND decay.c)))
          PAR
            buf.input (buf.in, trigger?, i)
            buf.output (buf.out, out!, level)
          n := n + 1
      --}}}

      --{{{ sustain -- wait for trailing edge
      WHILE i >= 0.5
        SEQ
          level := sustain
          PAR
            buf.input (buf.in, trigger?, i)
            buf.output (buf.out, out!, level)
      --}}}

      --{{{ release
      n := 0
      INITIAL REAL32 release.level IS level:
      WHILE (n < release.c) AND (i < 0.5)
        SEQ
          level := release.level * (1.0 - ((REAL32 ROUND n) / (REAL32 ROUND release.c)))
          PAR
            buf.input (buf.in, trigger?, i)
            buf.output (buf.out, out!, level)
          n := n + 1
      --}}}
:
--}}}