abc7b23f4c9d — Leonard Ritter 27 days ago
* UVM: initial support for graphics
4 files changed, 210 insertions(+), 17 deletions(-)

M lib/tukan/GLMain.sc
M lib/tukan/uvm.sc
A => testing/test_screen.tuk
M testing/tuk_interpreter.sc
M lib/tukan/GLMain.sc +14 -8
@@ 126,17 126,23 @@ struct GLMain
         _shutdown self.window self.glcontext
         stage.on-shutdown;
 
+    inline step (self)
+        if (handle-events self)
+            return false
+        let w h = (size self)
+        on-draw
+            time = 0.0
+            size = (ivec2 w h)
+            glmain = self
+        _swap self.window
+        true
+
     inline run (self)
         loop ()
-            if (handle-events self)
+            if (step self)
+                repeat;
+            else
                 break;
-            let w h = (size self)
-            on-draw
-                time = 0.0
-                size = (ivec2 w h)
-                glmain = self
-            _swap self.window
-            repeat;
 
 do
     let GLMain

          
M lib/tukan/uvm.sc +43 -2
@@ 1306,8 1306,9 @@ sugar uquote (expr...)
 
 let builtins global-env =
     fold (scope env = (Scope) (Cell)) for name in
-        sugar-quote + - * / // let fn quote set get nextindex _ < <= > >= == !=
-            \ not all any dump totext .. cond setmeta getmeta macro eval
+        sugar-quote + - * / // % & | ^ let fn quote set get nextindex _ < <= > >= == !=
+            \ not all any dump totext .. cond setmeta getmeta macro eval maptext
+            \ tou32 floor
         sym := (Atom (name as Symbol))
         code := ('hashbits sym)
         _

          
@@ 1389,6 1390,9 @@ fn... ueval (env : Atom, expr : Atom)
     case Atom.Kind.Symbol
         return ('get envtable expr)
     case Atom.Kind.Cell
+        if (not ('none? ('get-meta (expr as Cell))))
+            # don't evaluate cells with metatables
+            return (copy expr)
         let head =
             ueval env ('get-index (expr as Cell) 0)
         switch ('kind head)

          
@@ 1516,6 1520,15 @@ fn... ueval (env : Atom, expr : Atom)
                         result & (('kind v) == K)
                     x...
 
+            inline unop (f)
+                let a = ('get-index args 0)
+                if (all-kinds? Atom.Kind.Number a)
+                    return (Atom (f (a as Number)))
+                else
+                    if (not (any-none? a))
+                        errormsg "number expected, got " (kindstrs a)
+                    return (Atom)
+
             inline binop (f)
                 let a = ('get-index args 0)
                 let b = ('get-index args 1)

          
@@ 1592,6 1605,11 @@ fn... ueval (env : Atom, expr : Atom)
             case builtins.* (binop *)
             case builtins./ (binop /)
             case builtins.// (binop //)
+            case builtins.% (binop %)
+            case builtins.& (binop &)
+            case builtins.| (binop |)
+            case builtins.^ (binop ^)
+            case builtins.floor (unop 'floor)
             case builtins.< (binop <)
             case builtins.<= (binop <=)
             case builtins.> (binop >)

          
@@ 1632,6 1650,12 @@ fn... ueval (env : Atom, expr : Atom)
             case builtins.totext
                 let x = ('get-index args 0)
                 'totext x
+            case builtins.tou32
+                let x = ('get-index args 0)
+                if (all-kinds? Atom.Kind.Number x)
+                    local val = (x as Number as i32)
+                    Atom (String (&val as rawstring) 4)
+                else (Atom)
             case builtins.not (eval-not)
             # (set table key value)
             case builtins.set (eval-set)

          
@@ 1664,6 1688,23 @@ fn... ueval (env : Atom, expr : Atom)
             case builtins.nextindex (eval-countof)
             case builtins._
                 return (Atom args)
+            # (maptext size f)
+            case builtins.maptext
+                let size = ('get-index args 0)
+                let func = ('get-index args 1)
+                if (all-kinds? Atom.Kind.Number size)
+                    let sz = (size as Number as integer)
+                    local str : String
+                    for i in (range sz)
+                        let expr = (Cell.new (copy func) (Atom i))
+                        let result = (ueval env expr)
+                        if (('kind result) == Atom.Kind.Text)
+                            'append str (result as String)
+                    return (Atom str)
+                else
+                    if (not (any-none? size))
+                        errormsg "number expected, got " (kindstrs size)
+                    return (Atom)
             default
                 print "syntax error:" ('tostring expr)
                 return (Atom)

          
A => testing/test_screen.tuk +15 -0
@@ 0,0 1,15 @@ 
+: w
+    // (get (get io 'screen-size) 0) 4
+: h
+    // (get (get io 'screen-size) 1) 4
+_
+    : screen
+        maptext (* w h)
+            fn (i)
+                let
+                    : x (/ (% i w) w)
+                    : y (/ (// i w) h)
+                    tou32
+                        | (floor (* x 255))
+                            * (floor (* y 255)) 256
+

          
M testing/tuk_interpreter.sc +138 -7
@@ 1,9 1,12 @@ 
 using import struct
 using import enum
+using import glm
+using import glsl
 using import Map
 using import Set
 using import Array
 using import String
+using import Option
 using import Rc
 
 import ..lib.tukan.use

          
@@ 11,6 14,9 @@ using import tukan.uvm
 using import tukan.module
 using import tukan.pickle
 using import tukan.File
+using import tukan.gl
+using import tukan.GLMain
+using import tukan.Screen
 
 ##############################################################################
 

          
@@ 64,10 70,25 @@ fn run (argc argv program opts)
         Graphics
         ========
 
+        inputs:
+            screen-size : (number number)
+                width and height of `screen`.
+            close : ?
+                sent when the user requests to close the window. if the program
+                doesn't subsequently set `block-close`, the program ends with
+                error code 0.
+
         outputs:
-            screen : cell
-
-
+            screen : blob
+                a 32-bit per pixel sRGB image that must have the dimensions of
+                `screen-size` (width * height * 4).
+            screen-size : (number number)
+                if sent, requests a different width and height than what the
+                system provides. the system may or may not honor the request,
+                or provide a smaller `screen-size` than what was requested.
+            block-close : ?
+                if set in a frame where `close` is set, prevents it from having
+                any effect.
 
     let env = ((global-environment) as Cell)
 

          
@@ 77,9 98,52 @@ fn run (argc argv program opts)
         if opts.debug
             print ...
 
+    struct Graphics
+        glmain : GLMain
+        shader : GL.Program
+        screen : Screen
+        tx_screen = (GL.Texture2D)
+
+    inout uv : vec2 (location = 0)
+    out out_Color : vec4
+    uniform smp : sampler2D
+        location = 1
+
+    fn vertex-program ()
+        uv.out =
+            ((Screen.set-vertex-position) * 0.5) + 0.5
+        return;
+
+    fn fragment-program ()
+        out_Color = (texture smp (deref uv.in))
+        return;
+
+    struct System
+        break? = false
+        close? = false
+        gfx : (Option Graphics)
+        screensize = (ivec2 640 360)
+        title = (Atom "UVM")
+        screen = (Atom)
+    local sys : System
+
+    @@ 'on GLMain.on-draw
+    inline (time size glmain)
+        let gfx = ('force-unwrap sys.gfx)
+        GL.UseProgram gfx.shader
+        GL.BindTextureUnit 0 gfx.tx_screen
+        GL.Uniform smp 0
+        'draw gfx.screen
+        GL.UseProgram 0
+
+    fn ivec2->cell (v)
+        let x y = (unpack v)
+        Atom (Cell.new (Atom x) (Atom y))
+
     vvv bind init
     do
         let io = ('set io 'setup true)
+        let io = ('set io 'screen-size (ivec2->cell sys.screensize))
         let io =
             if (sc_is_file opts.statepath)
                 debugprint "loading state from" opts.statepath

          
@@ 92,12 156,15 @@ fn run (argc argv program opts)
             else io
         let env = ('set env 'io io)
         ueval env program
-    struct System
-        break? = false
+    #
+            global glmain =
+        GLMain
+            title = "OpenGL Compute"
+            hidden = true
+
     if ('none? init)
         print "error: setup unhandled"
         return 255
-    local sys : System
     vvv bind result state
     loop (state = init)
         if (('kind state) != Atom.Kind.Cell)

          
@@ 112,9 179,72 @@ fn run (argc argv program opts)
             if ('none? blockbreak)
                 debugprint "breaking"
                 break 255 stateval
+        if sys.close?
+            sys.close? = false
+            let blockclose = ('get cstate 'block-close)
+            if ('none? blockclose)
+                debugprint "closing"
+                break 0 stateval
         let stdoutval = ('get cstate 'stdout)
         if (not ('none? stdoutval))
             io-write! (stdoutval as String as string)
+        #let screensize = ('get cstate 'screen-size)
+        let screen = ('get cstate 'screen)
+        let io = (copy io)
+        let io =
+            if (not ('none? screen))
+                # ensure GL subsystem is running
+                let titleval = ('get cstate 'title)
+                if (not sys.gfx)
+                    if (not ('none? titleval))
+                        if (('kind titleval) == Atom.Kind.Text)
+                            sys.title = (copy titleval)
+                    debugprint "starting graphics system"
+                    sys.gfx =
+                        Graphics
+                            glmain =
+                                GLMain
+                                    title = (sys.title as String)
+                                    width = sys.screensize.x
+                                    height = sys.screensize.y
+                            shader =
+                                do
+                                    let pg = (GL.Program)
+                                    call
+                                        attach-shaders pg
+                                            vertex = vertex-program
+                                            fragment = fragment-program
+                                    pg
+                let gfx = ('force-unwrap sys.gfx)
+                let glmain = gfx.glmain
+                if (not ('none? titleval))
+                    if (('kind titleval) == Atom.Kind.Text)
+                        glmain.title = (titleval as String)
+                    sys.title = titleval
+                if (('kind screen) == Atom.Kind.Text)
+                    let w h = (unpack sys.screensize)
+                    let bufferdata = (screen as String)
+                    let buffersize = (countof bufferdata)
+                    for scale in (range 1 5)
+                        let requiredsize = (w * h * 4 // (scale * scale))
+                        if (buffersize == requiredsize)
+                            GL.BindTexture GL.TEXTURE_2D gfx.tx_screen
+                            GL.TexImage2D GL.TEXTURE_2D 0 GL.RGBA8 (w // scale) (h // scale) 0 GL.RGBA \
+                                GL.UNSIGNED_BYTE (& (bufferdata @ 0))
+                            GL.TexParameteri GL.TEXTURE_2D GL.TEXTURE_WRAP_S GL.CLAMP_TO_EDGE
+                            GL.TexParameteri GL.TEXTURE_2D GL.TEXTURE_WRAP_T GL.CLAMP_TO_EDGE
+                            GL.TexParameteri GL.TEXTURE_2D GL.TEXTURE_MIN_FILTER GL.LINEAR
+                            GL.TexParameteri GL.TEXTURE_2D GL.TEXTURE_MAG_FILTER GL.NEAREST
+                            GL.BindTexture GL.TEXTURE_2D 0
+                            break;
+                    else
+                        debugprint "screen buffersize mismatch" buffersize "!=" (w * h * 4)
+                let continue? = ('step glmain)
+                if continue? io
+                else
+                    sys.close? = true
+                    'set io 'close true
+            else io
         let exitval = ('get cstate 'exit)
         if (not ('none? exitval))
             break (exitval as Number as integer) stateval

          
@@ 127,7 257,8 @@ fn run (argc argv program opts)
                 else
                     sys.break? = true
                     'set io 'break true
-            else (copy io)
+            else io
+        let io = ('set io 'screen-size (ivec2->cell sys.screensize))
         let io = ('set io 'state stateval)
         debugprint "IO ->" ('tostring (Atom (copy io)))
         let env = ('set (copy env) 'io io)