envelopes

13 files changed, 164 insertions, 30 deletions

diff --git a/copilot.moon b/copilot.moon
index 3e07dc7..fb88378 100644
--- a/copilot.moon
+++ b/copilot.moon
@@ -1,5 +1,5 @@
 lfs = require 'lfs'
-import program from require 'parsing'
+import parse from require 'core'
 
 slurp = (file) ->
   file = io.open file, 'r'
@@ -20,7 +20,7 @@ class Copilot
       error "not a file: #{@file}"
 
   patch: =>
-    ast = program\match slurp @file
+    ast = parse slurp @file
 
     if not ast
       L\error "error parsing"
diff --git a/core/const.moon b/core/const.moon
index b356f49..45c44eb 100644
--- a/core/const.moon
+++ b/core/const.moon
@@ -15,6 +15,7 @@ class Const
     sym: true
     str: true
     num: true
+    bool: true
     scope: true
     op: true
     opdef: true
@@ -53,7 +54,9 @@ class Const
 
   stringify: => @raw
 
-  clone: (prefix) => Const @type, @value, @raw
+  clone: (prefix) => @
+  -- in case of doubt:
+  -- clone: (prefix) => Const @type, @value, @raw
 
 -- static
   __tostring: =>
@@ -74,6 +77,7 @@ class Const
   @num: (num) -> Const 'num', num, tostring num
   @str: (str) -> Const 'str', str, "'#{str}'"
   @sym: (sym) -> Const 'sym', sym, sym
+  @bool: (bool) -> Const 'bool', bool, tostring bool
   @empty: -> Const 'str', '', "''"
 
   @wrap: (val, name='(unknown)') ->
diff --git a/core/init.moon b/core/init.moon
index f0456c2..c91f0e4 100644
--- a/core/init.moon
+++ b/core/init.moon
@@ -7,9 +7,29 @@ import Scope from require 'core.scope'
 load_!
 
 import Cell, RootCell from require 'core.cell'
+import cell, program from require 'core.parsing'
 
 {
   :Const, :Cell, :RootCell
   :Op, :Action, :FnDef
   :Scope
+
+  parse: program\match
+  eval: do
+    class BuiltinRegistry
+      new: =>
+        @last = 1
+
+      register: (thing, tag) =>
+        with tag or Const.sym "builtin.#{@last}"
+          @last += 1
+
+    registry = BuiltinRegistry!
+
+    (str, inject) ->
+      scope = Scope.from_table require 'lib.builtin'
+      scope\use inject if inject
+
+      ast = assert (cell\match str), "failed to parse: #{str}"
+      Const.wrap ast\eval scope, registry
 }
diff --git a/parsing.moon b/core/parsing.moon
index 91ad260..5186cb8 100644
--- a/parsing.moon
+++ b/core/parsing.moon
@@ -1,4 +1,5 @@
-import Const, Cell, RootCell from require 'core'
+import Const from require 'core.const'
+import Cell, RootCell from require 'core.cell'
 import R, S, P, V, C, Ct from require 'lpeg'
 
 -- whitespace
diff --git a/core/scope.moon b/core/scope.moon
index a840ba7..ed4d67d 100644
--- a/core/scope.moon
+++ b/core/scope.moon
@@ -15,7 +15,7 @@ class Scope
       L\trace "found #{val} in #{@}"
       return val
 
-    start, rest = key\match '^(.-)/(.*)'
+    start, rest = key\match '^(.-)/(.+)'
 
     if not start
       return @parent and L\push -> @parent\get key
@@ -25,6 +25,7 @@ class Scope
     scope\getc!\get rest, "#{prefix}#{start}/"
 
   use: (other) =>
+    L\trace "using defs from #{other} in #{@}"
     for k, v in pairs other.values
       @values[k] = v
 
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
 }
diff --git a/logger.moon b/logger.moon
index c1ac02d..5175ad4 100644
--- a/logger.moon
+++ b/logger.moon
@@ -20,7 +20,7 @@ class Logger
       @[name] = (first, ...) =>
         return unless @level <= level
 
-        where = debug.traceback nil, 2
+        where = debug.traceback '', 2
         line = where\match '^.-\n%s+([%w:/%.]+): '
         line = line\match '[%./]*(.*)'
         line ..= string.rep ' ', 20-#line
diff --git a/main.lua b/main.lua
index 173eca1..49f8444 100644
--- a/main.lua
+++ b/main.lua
@@ -1,2 +1,3 @@
+package.path = package.path .. ';./?/init.lua'
 require 'moonscript'
 require 'lib.gui'
diff --git a/spec/parsing_spec.moon b/spec/parsing_spec.moon
index c405245..445c2c9 100644
--- a/spec/parsing_spec.moon
+++ b/spec/parsing_spec.moon
@@ -1,4 +1,4 @@
-import space, atom, expr, explist, cell, program, comment from require 'parsing'
+import space, atom, expr, explist, cell, program, comment from require 'core.parsing'
 import Const from require 'core'
 import Logger from require 'logger'
 Logger.init 'silent'