envelopes

5 files changed, 130 insertions, 23 deletions

diff --git a/lib/builtin.moon b/lib/builtin.moon
index 02dbe15..8e97271 100644
--- a/lib/builtin.moon
+++ b/lib/builtin.moon
@@ -77,8 +77,7 @@ name-str has to be an eval-time constant."
     name = L\push tail[1]\eval, scope, @registry
 
     L\trace @, "loading module #{name}"
-    module = Scope.from_table require "lib.#{name\getc 'str'}"
-    Const 'scope', module
+    Const.wrap require "lib.#{name\getc 'str'}"
 
 class import_ extends Action
   @doc: "(import sym1 [sym2]...) - require and define modules
@@ -92,8 +91,7 @@ requires modules sym1, sym2, ... and defines them as sym1, sym2, ... in the curr
 
     for child in *tail
       name = (child\quote scope, @registry)\getc 'sym'
-      module = Scope.from_table require "lib.#{name}"
-      scope\set name, Const 'scope', module
+      scope\set name, Const.wrap require "lib.#{name}"
 
     nil
 
@@ -109,7 +107,7 @@ requires modules sym1, sym2, ... and merges them into the current scope"
 
     for child in *tail
       name = (child\quote scope, @registry)\getc 'sym'
-      scope\use Scope.from_table require "lib.#{name}"
+      scope\use (Const.wrap require "lib.#{name}")\getc 'scope'
 
     nil
 
@@ -159,29 +157,53 @@ class do_expr extends Action
 
 evaluates and continously updates expr1, expr2, ...
 the last expression's value is returned."
-  class DoWrapper
-    new: (@children) =>
 
-    update: (dt) =>
-      for child in *@children
-        L\push child\update, dt
+  eval: (scope, tail) =>
+    UpdateChildren [(expr\eval scope, @registry) or Const.empty! for expr in *tail]
 
-    get: => @children[#@children]\get!
-    getc: => @children[#@children]\getc!
+class if_ extends Action
+  @doc: "(if bool then-expr [else-xpr]) - make an eval-time const choice
 
-    __tostring: => '<dowrapper>'
+bool has to be an eval-time constant. If it is truthy, this expression is equivalent
+to then-expr, otherwise it is equivalent to else-xpr if given, or nil otherwise."
 
   eval: (scope, tail) =>
-    UpdateChildren [(expr\eval scope, @registry) or Const.empty! for expr in *tail]
+    L\trace "expanding #{@}"
+    assert #tail >= 2, "'if' needs at least two parameters"
+    assert #tail <= 3, "'if' needs at most three parameters"
+
+    { xif, xthen, xelse } = tail
+
+    xif = L\push xif\eval, scope, @registry
+    xif = xif\getc!
+
+    if xif
+      xthen\eval scope, @registry
+    elseif xelse
+      xelse\eval scope, @registry
+
+class trace extends Action
+  @doc: "(trace expr) - print an eval-time constant to the console"
+
+  eval: (scope, tail) =>
+    L\trace "expanding #{@}"
+    assert #tail == 1, "'trace' takes exactly one parameter"
+
+    with val = L\push tail[1]\eval, scope, @registry
+      L\print "trace:", val
 
 {
-  :doc
+  :doc, :trace
 
   :def, :use
   require: require_
   import: import_
   'import*': import_star
 
+  true: Const.bool true
+  false: Const.bool false
+
   :fn, :defn
   'do': do_expr
+  if: if_
 }
diff --git a/lib/envelope.moon b/lib/envelope.moon
new file mode 100644
index 0000000..0129eb4
--- /dev/null
+++ b/lib/envelope.moon
@@ -0,0 +1,29 @@
+import Const, Op, Scope, eval from require 'core'
+
+class ar_core extends Op
+  @doc: "(ar-core attack release gate)
+((ar attack release) gate) - AR envelope
+
+goes from 0 to 1 in attack seconds, holds while gate is on, then goes back to 0 in release seconds."
+
+  new: (...) =>
+    super ...
+    @value = 0
+
+  setup: (@a, @r, @gate) =>
+    assert @a, "ar requires an attack value"
+    assert @r, "ar requires a release value"
+    assert @gate, "ar requires a gate value"
+
+  update: (dt) =>
+    @a\update dt
+    @r\update dt
+    @gate\update dt
+
+    slope = if @gate\get! then @a\getc! else -@r\getc!
+
+    @value = math.min 1, math.max 0, @value + dt / slope
+
+scope = Scope.from_table { 'ar-core': ar_core }
+scope\set 'ar', eval '(fn (a r) (fn (gate) (ar-core a r gate)))', scope
+scope
diff --git a/lib/gui.moon b/lib/gui.moon
index 32f23f7..5ec7883 100644
--- a/lib/gui.moon
+++ b/lib/gui.moon
@@ -1,7 +1,10 @@
-{ graphics: lg } = love
+assert love, "this module only works from within love2d!"
+{ graphics: lg, keyboard: lk } = love
+
 import Op from require 'core'
 import Registry from require 'registry'
 import Copilot from require 'copilot'
+import Logger from require 'logger'
 
 class out extends Op
   @doc: "(out name-str value) - show the output
@@ -37,8 +40,30 @@ display value as a bar"
       lg.print name, x, MARGIN + HEIGHT + MARGIN
       x += WIDTH + MARGIN
 
+class key extends Op
+  @doc: "(key name-str) - gate from keypress"
+
+  setup: (@key) =>
+    assert @key
+
+  update: (dt) =>
+    @value = lk.isDown @key\get!
+
+arguments, k = {}
+for a in *arg
+  if match = a\match '^%-%-(.*)'
+    k = match
+    arguments[k] = true
+  elseif k
+    arguments[k] = a
+    k = nil
+  else
+    table.insert arguments, a
+
+Logger.init arguments.log
+
 env = Registry!
-copilot = Copilot arg[#arg], env
+copilot = Copilot arguments[#arguments], env
 
 love.update = (dt) ->
   copilot\poll!
@@ -49,4 +74,5 @@ love.draw = ->
 
 {
   :out
+  :key
 }
diff --git a/lib/time.moon b/lib/time.moon
index dac5063..89f947e 100644
--- a/lib/time.moon
+++ b/lib/time.moon
@@ -16,6 +16,7 @@ wave selects the wave shape from the following (default sin):
 
   default_wave = Const 'str', 'sin'
   setup: (@freq, @wave=default_wave) =>
+    assert @freq, "lfo requires a frequency value"
     L\trace "setup #{@}, freq=#{@freq}, wave=#{@wave}"
 
   update: (dt) =>
@@ -29,23 +30,52 @@ wave selects the wave shape from the following (default sin):
       when 'tri' then math.abs (2*@phase % 2) - 1
       else error "unknown wave type"
 
+class ramp extends Op
+  @doc: "(ramp period [max]) - sawtooth lfo
+
+ramps from 0 to max (default same as ramp) once every period seconds"
+
+  new: (...) =>
+    super ...
+    @phase = 0
+
+  setup: (@period, @max) =>
+    assert @period, "tick requires a period value"
+
+  update: (dt) =>
+    @period\update dt
+    max = if @max
+      @max\update dt
+      @max\get!
+    else
+      @period\get!
+
+    @phase += dt / @period\get!
+
+    if @phase >= 1
+      @phase -= 1
+
+    @value = @phase * max
+
 class tick extends Op
-  @doc: "(tick freq) - count ticks
+  @doc: "(tick period) - count ticks
 
-counts upwards at freq and returns the number of completed ticks."
+counts upwards every period seconds and returns the number of completed ticks."
   new: (...) =>
     super ...
     @phase = 0
 
-  setup: (@freq) =>
+  setup: (@period) =>
+    assert @period, "tick requires a period value"
 
   update: (dt) =>
-    @freq\update dt
+    @period\update dt
 
-    @phase += dt / @freq\get!
+    @phase += dt / @period\get!
     @value = math.floor @phase
 
 {
   :lfo
+  :ramp
   :tick
 }
diff --git a/lib/util.moon b/lib/util.moon
index 0f36e02..849466c 100644
--- a/lib/util.moon
+++ b/lib/util.moon
@@ -66,6 +66,6 @@ always reproduces the last non-nil value the input produced"
 
 {
   'switch': switch_
-  'switch-', switch_pause
+  'switch-': switch_pause
   :keep
 }