172dd15df4b7 — Leonard Ritter 20 days ago
* audio support, various language improvements
M lib/tukan/audio.sc +4 -4
@@ 29,7 29,7 @@ fn init (opts...)
     device =
         SDL_OpenAudioDevice null 0 (& want) (& have) SDL_AUDIO_ALLOW_FORMAT_CHANGE
     if (device == 0)
-        print "Failed to open audio: " (SDL_GetError)
+        print "Failed to open audio: " (string (SDL_GetError))
     else
         if (have.format != want.format)
             print "No Float32 audio format available"

          
@@ 48,7 48,7 @@ fn queued-bytes ()
 
 fn queued ()
     "uint <- ()"
-    (queued-bytes) / (2:u32 * (sizeof f32))
+    (queued-bytes) // (2:u32 * (sizeof f32))
 
 fn queue-empty? ()
     "bool <- ()"

          
@@ 74,8 74,8 @@ fn sampletime~ ()
 if main-module?
     SDL_Init SDL_INIT_AUDIO
     init;
-    print "samplerate: " samplerate
-    print "buffersize: " buffersize
+    print "samplerate: " (deref samplerate)
+    print "buffersize: " (deref buffersize)
     let SAMPLESIZE = 44100
     local time : u32
     inline queue_audio ()

          
M lib/tukan/uvm.sc +21 -7
@@ 1133,7 1133,8 @@ type+ Atom
         static-if (T == Value) from-value
 
     fn kind-from-digest (digest)
-        (((digest @ 3) >> 60) & 0xf:u64) as i32 as Kind
+        #(((digest @ 3) >> 60) & 0xf:u64) as i32 as Kind
+        ((digest @ 0) & 0xf:u64) as i32 as Kind
 
     fn uhash (self)
         let ptr = (topointer self)

          
@@ 1154,11 1155,18 @@ type+ Atom
             default
                 nullof SHA256.DigestType
         # embed kind bits into most significant bits of digest
-        let kindmask = (0xf:u64 << 60)
-        let kindbits = (kind as integer as u64 << 60)
-        insertvalue digest
-            ((digest @ 3) & (~ kindmask)) | kindbits
-            3
+        #do
+            let kindmask = (0xf:u64 << 60)
+            let kindbits = (kind as integer as u64 << 60)
+            insertvalue digest
+                ((digest @ 3) & (~ kindmask)) | kindbits
+                3
+        do
+            let kindmask = 0xf:u64
+            let kindbits = (kind as integer as u64)
+            insertvalue digest
+                ((digest @ 0) & (~ kindmask)) | kindbits
+                0
 
     fn hashbits (self)
         local digest = (uhash self)

          
@@ 1373,7 1381,7 @@ let builtins global-env =
     fold (scope env = (Scope) (Cell)) for name in
         sugar-quote + - * / // % & | ^ fn quote set get nextindex < <= > >= == !=
             \ not all any dump totext .. cond setmeta getmeta macro eval maptext
-            \ tou32 floor sqrt fold do cell sin cos map kindof
+            \ tou32 tof32 floor sqrt fold do cell sin cos map kindof
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1894,6 1902,12 @@ struct CachedEval
                         local val = (x as Number as i32)
                         Atom (String (&val as rawstring) 4)
                     else (Atom)
+                case builtins.tof32
+                    let x = ('get-index args 0)
+                    if (all-kinds? Atom.Kind.Number x)
+                        local val = (x as Number as real as f32)
+                        Atom (String (&val as rawstring) 4)
+                    else (Atom)
                 case builtins.not (eval-not)
                 # (set table key value)
                 case builtins.set (eval-set)

          
M testing/test_audio.sc +3 -2
@@ 3,8 3,9 @@ using import itertools
 using import glm
 using import .testaudio
 using import Capture
-using import ..tukan.dsp.utils
-import ..tukan.dsp.svf
+import ..lib.tukan.use
+using import tukan.dsp.utils
+import tukan.dsp.svf
 let svf = tukan.dsp.svf
 
 fn seq (t s)

          
A => testing/test_audio.tuk +12 -0
@@ 0,0 1,12 @@ 
+let t (any state 0)
+= state
+    + t samplecount
+= sound
+    map samplecount
+        fn (i)
+            let t (/ (+ t i) samplerate)
+            let s (sin (* t 2764.601563))
+            cell s s
+= stdout
+    cond (== (% iteration 1000) 0)
+        .. (totext t) "\n"

          
M testing/test_compiler.tuk +43 -3
@@ 106,14 106,54 @@ fn topowalk (user root edgef visitf)
                                         self
                                 set self 'stack (pop stack)
     get self 'user
-dump # prints (a b c d (c d) e f (a b (c d) d e (c d) f))
+fn stackvm (user f)
+    fn get-stacksize (self)
+        countof (get self 'stack)
+    fn pop (self)
+        last stack
+        set self 'stack (pop stack)        
+    fn push (self f)
+        set self 'stack
+            append (get self 'stack) f
+    let self
+        fold
+            do
+                = stack (cell f)
+                = user user
+                = push push
+            65536
+            fn (self i)
+                let stack (get self 'stack)
+                let done? (empty? stack)
+                cond (not done?)
+                    do
+                        let f (last stack)
+                        let self (set self 'stack (pop stack))
+                        f self
+    get self 'user
+#fn fib-rec (f n)
+            cond (< n 2) n
+                +
+                    f f (- n 1)
+                    f f (- n 2)
+        fib-rec fib-rec 10
+fn fib (stack n)
+    cond (< n 2) n
+        push stack
+            fn (stack)
+
+dump
+    stackvm (cell)
+        fn (stack)
+            fib stack n
+#dump # prints (a b c d (c d) e f (a b (c d) d e (c d) f))
     topowalk (cell)
         quote (a b (c d) d e (c d) f)
-        fn (self v push-vertex)
+        fn (self v queue)
             cond (== (kindof v) 'cell)
                 fold self (countof v)
                     fn (self i)
-                        push-vertex self (get v i)
+                        queue self (get v i)
                 self
         append
 = stdout

          
M testing/test_fold.tuk +9 -9
@@ 10,14 10,15 @@ dump
 dump
     do
         # fibonacci, tail recursive
-        fold
-            do 0 1 10
-            100
-            fn (s i)
-                let@ a b n s
-                cond (> n 0)
-                    do b (+ a b) (- n 1)
-                a
+        get
+            fold
+                do 0 1 10
+                100
+                fn (s i)
+                    let@ a b n s
+                    cond (> n 0)
+                        do b (+ a b) (- n 1)
+            0
 dump
     do
         let vec (cell 1 2 3 4)

          
@@ 28,7 29,6 @@ dump
                 all element
                     set s i
                         * element 2
-                s
 dump
     do
         let vec (cell 1 2 3 4)

          
M testing/test_native.tuk +19 -3
@@ 2,16 2,31 @@ 
 let program
     quote
         fn (ins outs)
+            if ((ins.flags & InputFlags.Setup) != 0)
+                print "setup stage"
             let required-flags =
-                | InputFlags.ScreenSize InputFlags.Iteration
+                | InputFlags.ScreenSize InputFlags.Iteration InputFlags.SampleRate
+                    InputFlags.SampleCount
             if ((ins.flags & required-flags) != required-flags)
+                print "error: missing flags"
                 return;
+            outs.flags |= OutputFlags.Sound
+            'resize outs.sound (ins.samplecount * (sizeof f32) * 2)
+            let s = outs.sound
+            let ptr = ((& (s @ 0)) as (mutable @f32))
+            global time = 0
+            for i in (range ins.samplecount)
+                let t = ((time + i) / (ins.samplerate as u32))
+                let s = (sin (440.0 * pi * 2.0 * t))
+                ptr @ (i * 2) = s
+                ptr @ (i * 2 + 1) = s
+            time += ins.samplecount
             let ssz = ins.screen-size
             let w h = (unpack ssz)
             let w = (w // 1)
             let h = (h // 1)
-            outs.flags = OutputFlags.Screen
-            'resize outs.screen (w * h * 4)
+            outs.flags |= OutputFlags.Screen
+            'resize outs.screen (w * h * (sizeof u32))
             let s = outs.screen
             let ptr = ((& (s @ 0)) as (mutable @u32))
             if ((ins.iteration & 1) == 0)

          
@@ 22,4 37,5 @@ let program
                 for y in (range h)
                     for x in (range w)
                         ptr @ (y * w + x) = 0xff0000ff as u32
+= sound "\x00\x00\x00\x00\x00\x00\x00\x00"
 = native-program (all setup program)

          
M testing/test_screen.tuk +2 -10
@@ 3,14 3,6 @@ fn clamp (x mn mx)
         cond (> x mx) mx x
 fn abs (x)
     cond (< x 0) (- 0 x) x
-fn rgba (r g b a)
-    tou32
-        |
-            |
-                | (floor (* (clamp r 0 1) 255))
-                    * (floor (* (clamp g 0 1) 255)) 256
-                * (floor (* (clamp b 0 1) 255)) 65536
-            * (floor (* (clamp a 0 1) 255)) 16777216
 = title
     .. "test_screen "
         ..

          
@@ 35,5 27,5 @@ fn rgba (r g b a)
                         + 0.5
                             * 0.4 (sin (* 0.01 iteration))
                 * h 0.5
-        rgba d d d 0
-    maptext (* w h) shader
+        cell d d d 1
+    map (* w h) shader

          
M testing/tuk_interpreter.sc +102 -10
@@ 10,6 10,7 @@ using import Option
 using import Rc
 
 import ..lib.tukan.use
+using import tukan.sdl
 using import tukan.uvm
 using import tukan.module
 using import tukan.pickle

          
@@ 17,6 18,49 @@ using import tukan.File
 using import tukan.gl
 using import tukan.GLMain
 using import tukan.Screen
+let audio =
+    import tukan.audio
+
+let AUDIO_BUFFERSIZE = 4096
+let AUDIO_NUMBUFFERS = 3
+
+fn vec4array->string (dest s)
+    s := s as Cell
+    count := ('next-index s)
+    'clear dest
+    ES := (4 * (sizeof u8))
+    'resize dest (count * ES)
+    for i in (range count)
+        elem := ('get-index s i) as Cell
+        let col =
+            vec4
+                ('get-index elem 0) as Number as real as f32
+                ('get-index elem 1) as Number as real as f32
+                ('get-index elem 2) as Number as real as f32
+                ('get-index elem 3) as Number as real as f32
+        col := (clamp col (vec4 0) (vec4 1)) * 255.0
+        va-map
+            inline (k)
+                dest @ (i * ES + k) = ((col @ k) as u8 as i8)
+            va-range 4
+
+fn vec2array->string (dest s)
+    s := s as Cell
+    count := ('next-index s)
+    'clear dest
+    ES := (2 * (sizeof f32))
+    'resize dest (count * ES)
+    for i in (range count)
+        elem := ('get-index s i) as Cell
+        local col =
+            vec2
+                ('get-index elem 0) as Number as real as f32
+                ('get-index elem 1) as Number as real as f32
+        col := (bitcast (& col) rawstring)
+        va-map
+            inline (k)
+                dest @ (i * ES + k) = (col @ k)
+            va-range ((sizeof vec2) as i32)
 
 ##############################################################################
 

          
@@ 39,6 83,9 @@ global KEY_NATIVE_PROGRAM = (Atom 'nativ
 global KEY_PROMPT = (Atom 'prompt)
 global KEY_EXIT = (Atom 'exit)
 global KEY_READLINE = (Atom 'readline)
+global KEY_SAMPLERATE = (Atom 'samplerate)
+global KEY_SAMPLECOUNT = (Atom 'samplecount)
+global KEY_SOUND = (Atom 'sound)
 
 fn run (argc argv program opts)
     #

          
@@ 140,6 187,8 @@ fn run (argc argv program opts)
         Break = (1 << 4)
         Close = (1 << 5)
         Readline = (1 << 6)
+        SampleRate = (1 << 7)
+        SampleCount = (1 << 8)
 
     enum OutputFlags : u64
         State = (1 << 0)

          
@@ 151,6 200,7 @@ fn run (argc argv program opts)
         NativeProgram = (1 << 6)
         Prompt = (1 << 7)
         Exit = (1 << 8)
+        Sound = (1 << 9)
 
     struct InputVars
         flags : u64

          
@@ 158,6 208,8 @@ fn run (argc argv program opts)
         state : Atom
         screen-size : ivec2
         iteration : u32
+        samplerate : u32
+        samplecount : u32
 
     struct OutputVars
         flags : u64

          
@@ 165,6 217,7 @@ fn run (argc argv program opts)
         prompt : String
         screen : String
         title : String
+        sound : String
         state : Atom
         native-program : Atom
         exit : i32

          
@@ 190,6 243,7 @@ fn run (argc argv program opts)
     struct System
         break? = false
         close? = false
+        audio_running = false
         gfx : (Option Graphics)
         screensize = (ivec2 640 360)
         title : String = "UVM"

          
@@ 240,6 294,12 @@ fn run (argc argv program opts)
         let io =
             if (flags & InputFlags.Iteration) ('set io KEY_ITERATION inp.iteration)
             else io
+        let io =
+            if (flags & InputFlags.SampleRate) ('set io KEY_SAMPLERATE inp.samplerate)
+            else io
+        let io =
+            if (flags & InputFlags.SampleCount) ('set io KEY_SAMPLECOUNT inp.samplecount)
+            else io
         io
 
     fn cell->outputs (cell outs)

          
@@ 250,22 310,26 @@ fn run (argc argv program opts)
             if (not ('none? val))
                 flags |= flag
                 static-if (not (none? member))
-                    (getattr outs member) =
-                        do
-                            static-if (none? fconvert) val
-                            else (fconvert val)
+                    field := (getattr outs member)
+                    do
+                        static-if (none? fconvert)
+                            field = val
+                        else (fconvert field val)
 
-        inline ->string (s)
-            copy (s as String)
-        inline ->i32 (s)
-            copy (s as Number as i32)
+        inline ->string (dest s)
+            dest =
+                copy (s as String)
+        inline ->i32 (dest s)
+            dest =
+                copy (s as Number as i32)
 
         transfer KEY_BLOCKBREAK OutputFlags.BlockBreak
         transfer KEY_BLOCKCLOSE OutputFlags.BlockClose
         transfer KEY_STDOUT OutputFlags.Stdout 'stdout ->string
         transfer KEY_PROMPT OutputFlags.Prompt 'prompt ->string
-        transfer KEY_SCREEN OutputFlags.Screen 'screen ->string
+        transfer KEY_SCREEN OutputFlags.Screen 'screen vec4array->string
         transfer KEY_TITLE OutputFlags.Title 'title ->string
+        transfer KEY_SOUND OutputFlags.Sound 'sound vec2array->string
         transfer KEY_STATE OutputFlags.State 'state
         transfer KEY_NATIVE_PROGRAM OutputFlags.NativeProgram 'native-program
         transfer KEY_EXIT OutputFlags.Exit 'exit ->i32

          
@@ 273,8 337,12 @@ fn run (argc argv program opts)
     do
         ins.flags =
             | InputFlags.Setup InputFlags.ScreenSize InputFlags.Iteration
+        ins.flags |= InputFlags.SampleRate
+        ins.flags |= InputFlags.SampleCount
         ins.screen-size = sys.screensize
         ins.iteration = sys.iteration
+        ins.samplerate = 0
+        ins.samplecount = 1
         if (sc_is_file opts.statepath)
             debugprint "loading state from" opts.statepath
             let file =

          
@@ 367,10 435,30 @@ fn run (argc argv program opts)
             if (not continue?)
                 sys.close? = true
                 inflags |= InputFlags.Close
+        if (flags & OutputFlags.Sound)
+            let soundbuffer = (bitcast (& (outs.sound @ 0)) @f32)
+            let numsamples = ((countof outs.sound) // (2 * (sizeof f32)))
+            if (not sys.audio_running)
+                if (not sys.gfx)
+                    SDL_Init SDL_INIT_AUDIO
+                sys.audio_running = true
+                audio.init (AUDIO_BUFFERSIZE * AUDIO_NUMBUFFERS)
+                if numsamples
+                    audio.queue soundbuffer numsamples
+                audio.play true
+            else
+                if numsamples
+                    audio.queue soundbuffer numsamples
+            (deref audio.samplerate)
         if (flags & OutputFlags.Exit)
             break (copy outs.exit)
         local repeat? : bool =
-            sys.gfx | ((flags & OutputFlags.State) != 0)
+            sys.gfx | sys.audio_running | ((flags & OutputFlags.State) != 0)
+        ins.flags |= InputFlags.SampleRate
+        ins.flags |= InputFlags.SampleCount            
+        if sys.audio_running
+            ins.samplerate = audio.samplerate as u32
+            ins.samplecount = (max 0 (AUDIO_BUFFERSIZE - (audio.queued) as i32)) as u32
         if (flags & OutputFlags.NativeProgram)
             repeat? = true
             let expr = ('to-value outs.native-program)

          
@@ 401,6 489,7 @@ fn run (argc argv program opts)
         sys.iteration += 1
         ins.iteration = sys.iteration
         if (sys.native_function != null)
+            outs.flags = 0
             sys.native_function ins outs
         else
             #debugprint "IO ->" ('tostring (Atom (copy io)))

          
@@ 425,6 514,9 @@ fn run (argc argv program opts)
             debugprint "saving state to" opts.statepath
             pickle file ins.state
             drop file
+    if sys.audio_running
+        audio.play-until-empty;
+        audio.exit;
     debugprint "exiting with code" result
     debugprint "cache stats:" ce.hits "hits," ce.misses "misses"
     return result