c5c109416358 — Leonard Ritter a month ago
* cube rendering
4 files changed, 221 insertions(+), 47 deletions(-)

M lib/tukan/CADAG/init.sc
M lib/tukan/FIR.sc
M testing/BDD.sc
M testing/tukdag.sc
M lib/tukan/CADAG/init.sc +2 -1
@@ 1019,7 1019,8 @@ type+ CADAG
                     _ oldid oldid
                 else
                     let parentid = (bitcast (copy md.id) oldcls.AnyId)
-                    let enter? newid = (on-enter-param self oldmodule parentid (copy md.refindex) oldid)
+                    let enter? newid = (on-enter-param self oldmodule parentid
+                        (copy md.refindex) oldid)
                     static-assert ((typeof newid) == cls.AnyId)
                     md.refindex += 1
                     if enter?

          
M lib/tukan/FIR.sc +109 -30
@@ 177,8 177,16 @@ enum PrimitiveMode : u32
     Triangle
     TriangleStrip
     TriangleFan
+enum CullMode : u32
+    None = 0
+    Back = 1
+    Front = 2
+    Both = 3
 define-type "rasterize"   (RIFF "RAST") (tuple
-    (mode = PrimitiveMode) (size = AnyId) (vertex = AnyId) (fragment = AnyId)
+    (size = AnyId) (vertex = AnyId)
+    (mode = PrimitiveMode)
+    (cull = CullMode)
+    (fragment = AnyId)
     (viewport = AnyId) (target = AnyId))
     stringcolor...
 define-type "fragparams"  (RIFF "FRGA") (tuple)

          
@@ 272,6 280,7 @@ define-type "block"         (RIFF "BLOK"
 define-type "draw"          (RIFF "DRAI")
     struct Draw plain
         mode : PrimitiveMode
+        cull : CullMode
         count : AnyId
         instancecount : AnyId
         viewport : AnyId # viewport rect

          
@@ 288,9 297,11 @@ define-type "fn"        (RIFF "FN  ") (t
     funccolor...
 define-type "params"    (RIFF "PARA") (tuple (level = u32) (count = u32))
     funccolor...
-define-type "tuple"     (RIFF "TUPL") (tuple (values = (array AnyId)))
+define-type "tupleof"   (RIFF "TUPL") (tuple (values = (array AnyId)))
     funccolor...
-define-type "at"        (RIFF "AT  ") (tuple (index = u32) (value = AnyId))
+define-type "arrayof"   (RIFF "ARRY") (tuple (type = AnyId) (values = (array AnyId)))
+    funccolor...
+define-type "arrayat"   (RIFF "ARAT") (tuple (index = AnyId) (value = AnyId))
     funccolor...
 define-type "vargs"     (RIFF "ARGS") (tuple (args = (array AnyId)))
     funccolor...

          
@@ 418,6 429,8 @@ define-type "vatype"    (RIFF "VA T") (t
     typecolor...
 define-type "tupletype" (RIFF "TUPT") (tuple (types = (array AnyId)))
     typecolor...
+define-type "arraytype" (RIFF "ARRT") (tuple (type = AnyId) (count = u32))
+    typecolor...
 enum ExecModel : u32
     None = 0        # this value is accessible nowhere
     Generic = 1     # this value is accessible on the host (CPU)

          
@@ 433,6 446,12 @@ enum ExecModel : u32
             inline (a b)
                 bitcast ((storagecast a) & (storagecast b)) this-type
 
+    @@ memo
+    inline __| (cls T)
+        static-if (cls == T)
+            inline (a b)
+                bitcast ((storagecast a) | (storagecast b)) this-type
+
 # execution model qualifier
 define-type "execmodel" (RIFF "QPlT") (tuple (type = AnyId) (model = ExecModel))
     typecolor...

          
@@ 576,7 595,7 @@ struct FIRTyper
 
     fn type-value (ctx module id)
         from (methodsof module.builder) let uvec fvec vectype execmodel
-            \ tupletype vatype
+            \ tupletype vatype arraytype
         #report "typing" ('repr module id)
         inline get (id)
             try (copy ('get ctx.types id))

          
@@ 633,15 652,19 @@ struct FIRTyper
                 'commit module
         case comp (self)
             let tid = (get self.value)
-            let element =
-                dispatch ('handleof module (typevectype module tid))
-                case vectype (vt)
-                    vt.element
-                default
-                    trap;
-            let vect = (vectype element 1)
-            execmodel vect
-                typeexecmodel module tid
+            if (tid == NoId)
+                NoId
+            else
+                let element =
+                    dispatch ('handleof module (typevectype module tid))
+                    case vectype (vt)
+                        vt.element
+                    default
+                        error
+                            .. "vector type expected, not " ('repr module tid)
+                let vect = (vectype element 1)
+                execmodel vect
+                    typeexecmodel module tid
         case vargs (self)
             let vacount = ('vacount handle)
             let mrv =

          
@@ 662,6 685,15 @@ struct FIRTyper
                 else
                     copy (self.types @ index)
             default tid
+        case arrayof (self)
+            arraytype (get self.type) ('vacount handle)
+        case arrayat (self)
+            let tid = (get self.value)
+            dispatch ('handleof module tid)
+            case arraytype (self)
+                copy self.type
+            default
+                error "array type expected"
         default
             let typeid = ('typeidof module id)
             switch typeid

          
@@ 679,8 711,7 @@ struct FIRTyper
             case TypeId.typeid_fragcoord
                 execmodel (uvec 4) ExecModel.Fragment
 
-            case TypeId.typeid_fragparams
-                execmodel NoId ExecModel.Fragment
+            case TypeId.typeid_fragparams NoId
 
             # constants
             pass TypeId.typeid_fconst

          
@@ 695,6 726,7 @@ struct FIRTyper
             pass TypeId.typeid_fmul
             pass TypeId.typeid_fdiv
             pass TypeId.typeid_sin
+            pass TypeId.typeid_cos
             pass TypeId.typeid_add
             pass TypeId.typeid_sub
             pass TypeId.typeid_mul

          
@@ 702,6 734,9 @@ struct FIRTyper
             pass TypeId.typeid_sdiv
             pass TypeId.typeid_urem
             pass TypeId.typeid_srem
+            pass TypeId.typeid_shl
+            pass TypeId.typeid_ushr
+            pass TypeId.typeid_sshr
             pass TypeId.typeid_and
             pass TypeId.typeid_or
             pass TypeId.typeid_xor

          
@@ 734,6 769,7 @@ struct FIRTyper
                     pass TypeId.typeid_fmul
                     pass TypeId.typeid_fdiv
                     pass TypeId.typeid_sin
+                    pass TypeId.typeid_cos
                     pass TypeId.typeid_fvec2
                     pass TypeId.typeid_fvec3
                     pass TypeId.typeid_fvec4

          
@@ 745,6 781,9 @@ struct FIRTyper
                     pass TypeId.typeid_sdiv
                     pass TypeId.typeid_urem
                     pass TypeId.typeid_srem
+                    pass TypeId.typeid_shl
+                    pass TypeId.typeid_ushr
+                    pass TypeId.typeid_sshr
                     pass TypeId.typeid_and
                     pass TypeId.typeid_or
                     pass TypeId.typeid_xor

          
@@ 760,7 799,7 @@ struct FIRTyper
                     fold (em = ExecModel.All) for i in (range count)
                         let nextem =
                             typeexecmodel module (get (bitcast (data @ i) AnyId))
-                        em & nextem
+                        em | nextem
                 execmodel (vectype vte dcount) em
             pass TypeId.typeid_outputs
             pass TypeId.typeid_output

          
@@ 881,12 920,12 @@ fn generate-IL (module rootid)
             self.ctx-size += 1
             sc_expression_append self.setup-body
                 spice-quote
-                    let ptr = [(getglprogram self.setup-ctx offset)]
                     let pg = (Program)
                     call
                         attach-shaders pg
                             compute = main
                             debug = true
+                    let ptr = [(getglprogram self.setup-ctx offset)]
                     assign pg ptr
                     lose ptr
             sc_expression_append self.drop-body

          
@@ 903,13 942,13 @@ fn generate-IL (module rootid)
             self.ctx-size += 1
             sc_expression_append self.setup-body
                 spice-quote
-                    let ptr = [(getglprogram self.setup-ctx offset)]
                     let pg = (Program)
                     call
                         attach-shaders pg
                             vertex = vertex-main
                             fragment = fragment-main
                             debug = true
+                    let ptr = [(getglprogram self.setup-ctx offset)]
                     assign pg ptr
                     lose ptr
             sc_expression_append self.drop-body

          
@@ 1600,8 1639,10 @@ fn generate-IL (module rootid)
         case uniform (self)
             let T = ((get self.type) as type)
             let flags = 0
-            let glob = (sc_global_new 'u T flags 'UniformConstant)
-            sc_global_set_location glob (self.location as i32)
+            let loc = (self.location as i32)
+            let name = (.. "u" (tostring loc))
+            let glob = (sc_global_new (Symbol name) T flags 'UniformConstant)
+            sc_global_set_location glob loc
             `glob
         case rattr (self)
             let T = ((get self.type) as type)

          
@@ 1683,7 1724,8 @@ fn generate-IL (module rootid)
             let bindings = self.bindings
 
             from GL let UseProgram BindFramebuffer Viewport DrawArraysInstanced
-                \ BindVertexArray
+                \ BindVertexArray Enable Disable CullFace CULL_FACE FRONT
+                \ BACK FRONT_AND_BACK
 
             let mode =
                 switch self.mode

          
@@ 1696,6 1738,7 @@ fn generate-IL (module rootid)
                 case PrimitiveMode.TriangleFan GL.TRIANGLE_FAN
                 default
                     error "unsupported primitive mode"
+
             #let mode = mode
             let drawcmd =
                 `(DrawArraysInstanced mode 0 count instancecount)

          
@@ 1713,7 1756,20 @@ fn generate-IL (module rootid)
 
             sc_expression_append body `(Viewport (unpack (ivec4 vp)))
 
+            let culling = self.cull
+            if (culling == CullMode.None)
+                sc_expression_append body `(Disable CULL_FACE)
+            else
+                sc_expression_append body `(Enable CULL_FACE)
+                let mode =
+                    switch culling
+                    case CullMode.Back BACK
+                    case CullMode.Front FRONT
+                    default FRONT_AND_BACK
+                sc_expression_append body `(CullFace mode)
+
             sc_expression_append body drawcmd
+            sc_expression_append body `(Disable CULL_FACE)
             sc_expression_append body `(UseProgram 0)
             sc_expression_append body `(BindVertexArray 0)
             append-body body

          
@@ 1733,6 1789,16 @@ fn generate-IL (module rootid)
             let index = (self.index as i32)
             let value = (get self.value)
             `(va@ index value)
+        case arrayof (self)
+            let values = self.values
+            let args =
+                sc_argument_list_map_new (vacount as i32)
+                    inline (i)
+                        get (values @ i)
+            let T = ((get self.type) as type)
+            `(local x = (arrayof T args))
+        case arrayat (self)
+            `([(get self.value)] @ [(get self.index)])
         case dispatch (self)
             let pgoffset = (get self.func)
             let pg = (getgluint ctx.drive-ctx pgoffset)

          
@@ 2168,8 2234,7 @@ fn lower-FIR (module rootid)
         let imgtype = (imagetype tid ImageDim.2D imgformat ImageFlags.none)
         _ (texturetype imgtype cx cy cz 1 0) imgtype imgformat met
 
-    fn collect-bindings (ctx module source aliases bindings)
-        local next_uniform_id = 0:u32
+    fn collect-bindings (ctx module source aliases bindings next_uniform_id)
         # replace generic values with uniforms
         'translate module module source
             aliases = (view aliases)

          
@@ 2221,8 2286,9 @@ fn lower-FIR (module rootid)
                 error "size argument must be of size 1 or 2"
         local aliases : (Map u32 AnyId)
         local bindings : (Array AnyId)
+        local next_uniform_id = 0:u32
         let vertexsource =
-            collect-bindings ctx module rasterize.vertex aliases bindings
+            collect-bindings ctx module rasterize.vertex aliases bindings next_uniform_id
         let rtypehandle = ('handleof module ('typeof ctx.typer module vertexsource))
         let fparams = (fragparams)
         let vertexsource =

          
@@ 2238,13 2304,13 @@ fn lower-FIR (module rootid)
                     let inattr = (rattr vt i InterpolationMode.Undefined)
                     if (i == 0)
                         'append outargs
-                            store (va i vertexsource) (position)
+                            store (va 0 vertexsource) (position)
                         'append inargs (fragcoord)
                     else
                         'append outargs
-                            store (va i vertexsource) (wattr vt i)
+                            store (va i vertexsource) (wattr vt (i - 1))
                         'append inargs
-                            load (rattr vt i InterpolationMode.Undefined)
+                            load (rattr vt (i - 1) InterpolationMode.Undefined)
                 let outargcount = ((countof outargs) as u32)
                 let ptr = ('alloc module TypeId.typeid_block outargcount)
                 let body = ptr.body

          
@@ 2259,12 2325,15 @@ fn lower-FIR (module rootid)
                     targs @ i = arg
                 let vargs = ('commit module)
                 'set aliases fparams vargs
+                'set ctx.typer.types fparams ('typeof ctx.typer module vargs)
                 vertexsource
             default
-                'set aliases fparams (fragcoord)
+                let arg = (fragcoord)
+                'set aliases fparams arg
+                'set ctx.typer.types fparams ('typeof ctx.typer module arg)
                 store vertexsource (position)
         let fragmentsource =
-            collect-bindings ctx module rasterize.fragment aliases bindings
+            collect-bindings ctx module rasterize.fragment aliases bindings next_uniform_id
         let fragtype = ('typeof ctx.typer module fragmentsource)
         let rtypehandle = ('handleof module fragtype)
         let fragmentsource =

          
@@ 2296,6 2365,7 @@ fn lower-FIR (module rootid)
         let drawptr =
             'alloc module TypeId.typeid_draw bcount
         drawptr.mode = rasterize.mode
+        drawptr.cull = rasterize.cull
         drawptr.count = count
         drawptr.instancecount = instance
         drawptr.viewport = rasterize.viewport

          
@@ 2315,8 2385,9 @@ fn lower-FIR (module rootid)
         let lx ly lz = (unpack met.localsize)
         local aliases : (Map u32 AnyId)
         local bindings : (Array AnyId)
+        local next_uniform_id = 0:u32
         let source =
-            collect-bindings ctx module source aliases bindings
+            collect-bindings ctx module source aliases bindings next_uniform_id
         from (methodsof module.builder) let dispatch computefn
             \ wimage imagewrite load undef uvec2 comp unpack-comp rbind wbind
             \ globalid

          
@@ 2487,6 2558,13 @@ type+ FIR
         pass TypeId.typeid_fconst
         pass TypeId.typeid_uconst
         do true
+        case TypeId.typeid_arrayof
+            for i id in (enumerate ('sources handle))
+                if (i == 0) # skip type
+                    continue;
+                if (not (this-function self id))
+                    return false
+            else true
         pass TypeId.typeid_fvec2
         pass TypeId.typeid_fvec3
         pass TypeId.typeid_fvec4

          
@@ 2544,4 2622,5 @@ sugar FIRfn (name (args...) body...)
 do
     let FIR NoId AnyId SystemKey ImageDim ImageFormat ImageFlags TypeId
         \ PrimitiveMode InterpolationMode DepthTestType FIRTyper FIRfn
+        \ CullMode
     locals;

          
M testing/BDD.sc +52 -0
@@ 301,6 301,58 @@ print
             & b3 b2 b1
             & b3 b2 b1 b0
 
+
+# cube triangle strip
+
+let b0 b1 b2 b3 = (T 'b0) (T 'b1) (T 'b2) (T 'b3)
+let n0 n1 n2 n3 = (~ b0) (~ b1) (~ b2) (~ b3)
+
+#
+  0 1 2 3    out
+
+  0 0 0 0   0 0 0
+  0 0 0 1   0 1 0
+  0 0 1 0   1 0 0
+  0 0 1 1   1 1 0
+  0 1 0 0   1 1 1
+  0 1 0 1   0 1 0
+  0 1 1 0   0 1 1
+  0 1 1 1   0 0 1
+  1 0 0 0   1 1 1
+  1 0 0 1   1 0 1
+  1 0 1 0   1 0 0
+  1 0 1 1   0 0 1
+  1 1 0 0   0 0 0
+  1 1 0 1   0 1 0
+  1 1 1 0   1 0 0
+  1 1 1 1   1 1 0
+
+inline rev& (a b c d)
+    & b d a c
+
+print
+    T.bool-repr
+        #|
+            rev& n0 n1 b2 n3
+            rev& n0 n1 b2 b3
+            rev& n0 b1 n2 n3
+            rev& b0 n1 n2 n3
+            rev& b0 n1 n2 b3
+            rev& b0 n1 b2 n3
+            #rev& b0 b1 b2 n3
+            #rev& b0 b1 b2 b3
+
+        |
+            rev& n0 b1 n2 n3
+            rev& n0 b1 b2 n3
+            rev& n0 b1 b2 b3
+            rev& b0 n1 n2 n3
+            rev& b0 n1 n2 b3
+            rev& b0 n1 b2 b3
+            #rev& b0 b1 b2 n3
+            #rev& b0 b1 b2 b3
+
+
 #
     if a
         if b

          
M testing/tukdag.sc +58 -16
@@ 147,33 147,75 @@ inline gen-level1-test ()
 
 inline gen-level2-test-geometry ()
     from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
-        \ fconst comp and xor utof sin cos fadd fmul fdiv sample fsub
+        \ fconst comp and xor utof sin cos fadd fmul fdiv sample fsub ushr
         \ outputs sub unpack-comp udiv urem primitive fragment selectfragment
         \ clear depthtest overlay rasterize uvec2 vertexid instanceid vargs va
-        \ fragparams uvec4
+        \ fragparams uvec4 tuple arrayof arrayat compute globalid
 
-    let w h =
+    let sw sh =
         unpack-comp (input SystemKey.ScreenSize) 2
-    #outputs
-        output SystemKey.Screen
-            clear (input SystemKey.ScreenSize)
-                fvec3 (fconst 0) (fconst 0) (fconst 1)
+    let inpit = (input SystemKey.Iteration)
+
+    let TS = (uconst 16)
+    let cube_texture =
+        compute (uvec2 TS TS)
+            do
+                let x y =
+                    unpack-comp (globalid) 2
+                utof (xor (and x (uconst 1)) (and y (uconst 1)))
+
+    inline rotate (x y r)
+        let c = (cos r)
+        let s = (sin r)
+        _
+            fadd (fmul c x) (fmul s y)
+            fsub (fmul c y) (fmul s x)
+    let indices =
+        arrayof (uvec 1)
+            uconst 0; uconst 2; uconst 4; uconst 6; uconst 7; uconst 2; uconst 3
+            uconst 1; uconst 7; uconst 5; uconst 4; uconst 1; uconst 0; uconst 2
     outputs
         output SystemKey.Screen
-            rasterize PrimitiveMode.TriangleStrip
-                #uvec2 (uconst 4) (uconst 1)
-                (uconst 4)
+            rasterize
+                (uconst 14)
                 do
-                    let u = (utof (urem (vertexid) (uconst 2)))
-                    let v = (utof (udiv (vertexid) (uconst 2)))
+                    let vx = (arrayat (vertexid) indices)
+
+                    let u = (utof (and vx (uconst 1)))
+                    let v = (utof (and (ushr vx (uconst 1)) (uconst 1)))
+                    let w = (utof (and (ushr vx (uconst 2)) (uconst 1)))
+
                     let x = (fsub u (fconst 0.5))
                     let y = (fsub v (fconst 0.5))
+                    let z = (fsub w (fconst 0.5))
+
+                    let it = (fdiv (utof inpit) (fconst 60.0))
+                    let x y = (rotate x y it)
+                    let x z = (rotate x z (fmul it (fconst 0.318)))
+
+                    let z = (fadd z (fconst 2.0))
+                    let aspect = (fdiv (utof sh) (utof sw))
+                    let x = (fmul x aspect)
+
+                    let u2 = (utof (and (vertexid) (uconst 1)))
+                    let v2 = (utof (and (ushr (vertexid) (uconst 1)) (uconst 1)))
+
                     vargs
-                        fvec4 x y (fconst 0) (fconst 1)
-                        fvec3 u v (fconst 0)
+                        fvec4 x y (fconst 1) z
+                        fvec3 u v w
+                        fvec2 u2 v2
+                PrimitiveMode.TriangleStrip
+                CullMode.Back
                 do
-                    va 1 (fragparams)
-                uvec4 (uconst 0) (uconst 0) w h
+                    let r g b = (unpack-comp (va 1 (fragparams)) 3)
+                    let u v = (unpack-comp (va 2 (fragparams)) 2)
+                    let tex =
+                        sample cube_texture (fvec2 u v)
+                    let r = (fmul r tex)
+                    let g = (fmul g tex)
+                    let b = (fmul b tex)
+                    fvec3 r g b
+                uvec4 (uconst 0) (uconst 0) sw sh
                 clear (input SystemKey.ScreenSize)
                     fvec3 (fconst 0) (fconst 0) (fconst 1)