a4c9c024ec5d — Leonard Ritter a month ago
* low level support for rasterization
3 files changed, 524 insertions(+), 111 deletions(-)

M lib/tukan/FIR.sc
M lib/tukan/gl.sc
M testing/tukdag.sc
M lib/tukan/FIR.sc +441 -99
@@ 4,6 4,7 @@ using import struct
 using import Capture
 using import Map
 using import Array
+using import Option
 using import glm
 
 using import .CADAG

          
@@ 160,6 161,35 @@ let
 
 define-type "range"     (RIFF "RANG") (tuple (dims = (array AnyId)))
     stringcolor...
+enum PrimitiveType : u32
+    Point
+    Line
+    LineStrip
+    LineLoop
+    Triangle
+    TriangleStrip
+    TriangleFan
+define-type "primitive" (RIFF "PRIM") (tuple (mode = PrimitiveType) (vertexcount = AnyId) (instances = AnyId))
+    stringcolor...
+enum FragmentType : u32
+    Undefined
+    Flat
+    Smooth
+define-type "fragment"    (RIFF "FRAG") (tuple (kind = FragmentType) (value = AnyId))
+    stringcolor...
+enum DepthTestType : u32
+    False
+    True
+    Equal
+    NotEqual
+    GreaterThan
+    GreaterEqual
+    LessThan
+    LessEqual
+define-type "depthtest" (RIFF "ZTST") (tuple (depthfunc = DepthTestType) (value = AnyId) (default = AnyId))
+define-type "overlay"  (RIFF "NOZT") (tuple (value = AnyId))
+define-type "selectfragment" (RIFF "SLFR") (tuple (test = AnyId) (value = AnyId) (default = AnyId))
+    stringcolor...
 
 # FIR Level 1
 ################################################################################

          
@@ 212,7 242,33 @@ define-type "store"         (RIFF "STOR"
     instrcolor...
 define-type "bufferstorage" (RIFF "BFST") (tuple (size = u32))
     funccolor...
-define-type "idispatch"     (RIFF "IDSP") (tuple (callee = AnyId) (size = AnyId) (sources = AnyId) (sinks = AnyId))
+define-type "idispatch"     (RIFF "IDSP") (tuple (func = AnyId) (size = AnyId) (sources = AnyId) (sinks = AnyId))
+    instrcolor...
+define-type "clear"         (RIFF "CLRS") (tuple (value = AnyId) (storage = AnyId))
+define-type "vertexid"      (RIFF "VXID") (tuple)
+    funccolor...
+define-type "instanceid"    (RIFF "ISID") (tuple)
+    funccolor...
+define-type "rattr"         (RIFF "RATR") (tuple (type = AnyId) (location = u32) (kind = FragmentType))
+    funccolor...
+define-type "wattr"         (RIFF "WATR") (tuple (type = AnyId) (location = u32))
+    funccolor...
+define-type "position"      (RIFF "POSI") (tuple)
+    funccolor...
+define-type "shaderfn"      (RIFF "SHFN") (tuple (vertex = AnyId) (fragment = AnyId))
+    funccolor...
+define-type "block"         (RIFF "BLOK") (tuple (body = (array AnyId)))
+    instrcolor...
+define-type "draw"          (RIFF "DRAI")
+    struct Draw plain
+        func : AnyId
+        x : AnyId; y : AnyId # viewport size
+        depthtest : DepthTestType
+        mode : PrimitiveType
+        count : AnyId
+        instancecount : AnyId
+        sources : AnyId
+        sinks : AnyId
     instrcolor...
 
 # FIR Level 0

          
@@ 349,8 405,10 @@ fn generate-IL (module)
         drive-body : Value
         drop-ctx : Value
         drop-body : Value
+        has-nop-vao? : bool = false
+        nop-vao : (tuple Value Value)
 
-        fn alloc-program (self main)
+        fn alloc-compute (self main)
             let PT = GL.Program
             let UT = (mutable @GL.uint)
             let T = (mutable @GL.Program)

          
@@ 380,6 438,37 @@ fn generate-IL (module)
             sc_expression_append self.drive-body ptr
             ptr
 
+        fn alloc-shader (self vertex-main fragment-main)
+            let PT = GL.Program
+            let UT = (mutable @GL.uint)
+            let T = (mutable @GL.Program)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+            inline gethandleT (src offset T)
+                bitcast (& (src @ offset)) T
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    let pg = (PT)
+                    call
+                        attach-shaders pg
+                            vertex = vertex-main
+                            fragment = fragment-main
+                            debug = true
+                    store pg ptr
+                    lose ptr
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (@ (gethandle [(copy self.drop-ctx)] offset))
+                    __drop (view ptr)
+                    lose ptr
+            let ptr = `(@ (gethandleT [(copy self.drive-ctx)] offset UT))
+            sc_expression_append self.drive-body ptr
+            ptr
+
         fn alloc-texture (self target)
             let T = (mutable @GL.uint)
             inline gethandle (src offset)

          
@@ 400,6 489,55 @@ fn generate-IL (module)
             sc_expression_append self.drive-body drive-ptr
             _ setup-ptr drive-ptr
 
+        fn alloc-framebuffer (self)
+            let T = (mutable @GL.uint)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    GL.CreateFramebuffers 1 ptr
+            let setup-ptr = `(load ptr)
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.drop-ctx)] offset)
+                    GL.DeleteFramebuffers 1 ptr
+            let drive-ptr = `(load (gethandle [(copy self.drive-ctx)] offset))
+            sc_expression_append self.drive-body drive-ptr
+            _ setup-ptr drive-ptr
+
+        fn get-nop-vao (self)
+            if (not self.has-nop-vao?)
+                self.has-nop-vao? = true
+                self.nop-vao = (tupleof ('alloc-vao self))
+            let a b = (unpack self.nop-vao)
+            return (copy a) (copy b)
+
+        fn alloc-vao (self)
+            let T = (mutable @GL.uint)
+            inline gethandle (src offset)
+                bitcast (& (src @ offset)) T
+
+            from GL let CreateVertexArrays DeleteVertexArrays
+
+            let offset = (deref self.ctx-size)
+            self.ctx-size += (sizeof GL.uint)
+            sc_expression_append self.setup-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.setup-ctx)] offset)
+                    CreateVertexArrays 1 ptr
+            let setup-ptr = `(load ptr)
+            sc_expression_append self.drop-body
+                spice-quote
+                    let ptr = (gethandle [(copy self.drop-ctx)] offset)
+                    DeleteVertexArrays 1 ptr
+            let drive-ptr = `(load (gethandle [(copy self.drive-ctx)] offset))
+            sc_expression_append self.drive-body drive-ptr
+            _ setup-ptr drive-ptr
+
         fn alloc-buffer (self)
             let T = (mutable @GL.uint)
             inline gethandle (src offset)

          
@@ 676,7 814,218 @@ fn generate-IL (module)
                 TextureBuffer
             default
                 unreachable;
-        drive-ptr
+        _ drive-ptr setup-ptr
+
+    fn assign-bindings (ctx module body retargs sources sinks)
+        inline get (id...)
+            va-map
+                inline (id)
+                    try (copy ('get ctx.values id))
+                    else
+                        error "could not resolve cached value"
+                        #trap;
+                id...
+
+        # bind values from function body instructions
+        do
+            let handle = ('handleof module sources)
+            let numsources = ('vacount handle)
+            let sources =
+                dispatch handle
+                case bindings (self) self.entries
+                default
+                    error "sources must be bindings"
+            local next_texture_unit = 0
+            for i in (range numsources)
+                let v k = (unpack (sources @ i))
+                let khandle = ('handleof module k)
+                dispatch khandle
+                case uniform (self)
+                    let k = (get k)
+                    let v = (get v)
+                    let loc = (sc_global_location k)
+                    if (loc < 0)
+                        error "uniformattr has no binding"
+                    dispatch ('handleof module self.type)
+                    case sampler (smpty)
+                        from GL let BindTextureUnit Uniform1i
+                        let tu = (deref next_texture_unit)
+                        next_texture_unit += 1
+                        sc_expression_append body
+                            spice-quote
+                                BindTextureUnit tu v
+                                Uniform1i loc tu
+                    default
+                        from GL let Uniform
+                        sc_expression_append body `(Uniform (ptrtoref k) v)
+                #case Op.SSBOATTR
+                    let b = (sc_global_binding k)
+                    assert (b >= 0)
+                    from GL let BindBufferBase SHADER_STORAGE_BUFFER
+                    sc_expression_append body
+                        spice-quote
+                            BindBufferBase SHADER_STORAGE_BUFFER b v
+                default
+                    error
+                        .. "invalid binding type: " (string khandle.typeid.name)
+        do
+            let handle = ('handleof module sinks)
+            let numsinks = ('vacount handle)
+            let sinks =
+                dispatch handle
+                case bindings (self) self.entries
+                default
+                    error "sources must be bindings"
+
+            local fbo : (Option (tuple Value Value))
+            local drawbuffers : (Array i32)
+            local next_attachment_index = 0
+
+            for i in (range numsinks)
+                let v k = (unpack (sinks @ i))
+                let khandle = ('handleof module k)
+                dispatch khandle
+                case wattr (self)
+                    let vhandle = ('handleof module v)
+                    let imgstor clearval =
+                        dispatch vhandle
+                        case imagestorage (self)
+                            _ self NoId
+                        case clear (self)
+                            let value = self.value
+                            let vhandle = ('handleof module self.storage)
+                            dispatch vhandle
+                            case imagestorage (self)
+                                _ self (copy value)
+                            default
+                                error
+                                    .. "invalid binding source for image: " (string vhandle.typeid.name)
+                        default
+                            error
+                                .. "invalid binding source for image: " (string vhandle.typeid.name)
+                    let imgtype =
+                        dispatch ('handleof module imgstor.type)
+                        case image (self) self
+                        default
+                            error "invalid type for image"
+                    let loc = (sc_global_location (get k))
+                    from GL let NamedFramebufferTexture BindFramebuffer
+                        \ FRAMEBUFFER COLOR_ATTACHMENT0 ClearNamedFramebufferiv
+                        \ ClearNamedFramebufferfv ClearNamedFramebufferuiv
+                        \ COLOR
+                    if (not fbo)
+                        let setup-ptr drive-ptr = ('alloc-framebuffer ctx)
+                        sc_expression_append body
+                            spice-quote
+                                BindFramebuffer FRAMEBUFFER drive-ptr
+                        fbo = (tupleof setup-ptr drive-ptr)
+                        ;
+                    let setup-ptr drive-ptr = ('force-unwrap fbo)
+                    if clearval
+                        report "clearval!"
+                        let value = (get clearval)
+                        let value =
+                            spice-quote
+                                local value = value
+                        switch ('format imgtype.format)
+                        case ImageFormat.U
+                            sc_expression_append body
+                                spice-quote
+                                    ClearNamedFramebufferuiv drive-ptr COLOR
+                                        \ loc (bitcast (& value) @u32)
+                        case ImageFormat.S
+                            sc_expression_append body
+                                spice-quote
+                                    ClearNamedFramebufferiv drive-ptr COLOR
+                                        \ loc (bitcast (& value) @i32)
+                        pass ImageFormat.UNORM
+                        pass ImageFormat.SNORM
+                        pass ImageFormat.F
+                        do
+                            sc_expression_append body
+                                spice-quote
+                                    ClearNamedFramebufferfv drive-ptr COLOR
+                                        \ loc (bitcast (& value) @f32)
+                        default
+                            error "unsupported clear format"
+
+                    let vptr svptr = (gentexstorage module imgstor ctx)
+                    'append retargs vptr
+                    let attachment = (COLOR_ATTACHMENT0 + next_attachment_index)
+                    next_attachment_index += 1
+                    while ((countof drawbuffers) <= loc)
+                        'append drawbuffers GL.NONE
+                    assert (loc >= 0)
+                    drawbuffers @ loc = attachment
+                    sc_expression_append ctx.setup-body
+                        spice-quote
+                            NamedFramebufferTexture setup-ptr attachment svptr 0
+
+
+                case wimage (self)
+                    let vhandle = ('handleof module v)
+                    dispatch vhandle
+                    case imagestorage (self)
+                        let v = (gentexstorage module self ctx)
+                        #define-type "imagestorage"  (RIFF "IMST") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
+                        'append retargs v
+                        let imgfmt =
+                            dispatch ('handleof module self.type)
+                            case image (self)
+                                imageformat->GL self.format
+                            default
+                                error "invalid type for image"
+                        let b = (sc_global_binding (get k))
+                        assert (b >= 0)
+                        from GL let FALSE WRITE_ONLY BindImageTexture
+                        sc_expression_append body
+                            spice-quote
+                                BindImageTexture b v
+                                    0 # level
+                                    FALSE # layered
+                                    0 # layer
+                                    WRITE_ONLY # access
+                                    imgfmt
+                    default
+                        error
+                            .. "invalid binding source for image: " (string vhandle.typeid.name)
+                default
+                    error
+                        .. "invalid binding type: " (string khandle.typeid.name)
+
+            if fbo
+                let setup-ptr drive-ptr = ('force-unwrap fbo)
+                from GL let NamedFramebufferDrawBuffers CheckNamedFramebufferStatus
+                    \ FRAMEBUFFER FRAMEBUFFER_COMPLETE
+                let GLenum = GL.enum
+                let drawbuffercount = (countof drawbuffers)
+                sc_expression_append ctx.setup-body
+                    let buffertargets = (alloca-array GLenum drawbuffercount)
+                for i target in (enumerate drawbuffers)
+                    sc_expression_append ctx.setup-body `(buffertargets @ i = target)
+                sc_expression_append ctx.setup-body
+                    spice-quote
+                        NamedFramebufferDrawBuffers
+                            \ setup-ptr drawbuffercount buffertargets
+
+                sc_expression_append ctx.setup-body
+                    spice-quote
+                        let status = (CheckNamedFramebufferStatus
+                            setup-ptr FRAMEBUFFER)
+                        assert (status == FRAMEBUFFER_COMPLETE)
+                            .. "Framebuffer incomplete: " (framebuffer-status status)
+
+                #
+                    v as:= Id
+                    assert ((opof v) == Op.BUFSTORAGE)
+                    let v = (genbufstorage module v ctx)
+                    'append retargs v
+                    let b = (sc_global_binding k)
+                    assert (b >= 0)
+                    from GL let BindBufferBase SHADER_STORAGE_BUFFER
+                    sc_expression_append body
+                        spice-quote
+                            BindBufferBase SHADER_STORAGE_BUFFER b v
 
     fn visit (module id ctx)
         if ('in? ctx.values id)

          
@@ 803,8 1152,22 @@ fn generate-IL (module)
                 error "unsupported vector size"
         case globalid (self)
             `(deref gl_GlobalInvocationID)
+        case vertexid (self)
+            `((deref gl_VertexID) as u32)
+        case instanceid (self)
+            `((deref gl_InstanceID) as u32)
+        case position (self)
+            `(reftoptr gl_Position)
         case load (self)
             `(load [(get self.pointer)])
+        case store (self)
+            `(store [(get self.value)] [(get self.pointer)])
+        case block (self)
+            let body = self.body
+            let expr = (sc_expression_new)
+            for i in (range vacount)
+                sc_expression_append expr (get (body @ i))
+            expr
         case getelementptr (self)
             let call = (sc_call_new `getelementptr)
             sc_call_append_argument call (get self.value)

          
@@ 829,12 1192,28 @@ fn generate-IL (module)
                 (sc_image_type T dim 0 arrayed? multisampled? 1 'Unknown unnamed))]
         case bindings (self) `none
         case imagestorage (self) `none
+        case clear (self) `none
         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)
             `glob
+        case rattr (self)
+            let T = ((get self.type) as type)
+            let flags =
+                switch self.kind
+                case FragmentType.Flat global-flag-flat
+                default 0:u32
+            let glob = (sc_global_new 'ra T flags 'Input)
+            sc_global_set_location glob (self.location as i32)
+            `glob
+        case wattr (self)
+            let T = ((get self.type) as type)
+            let flags = 0
+            let glob = (sc_global_new 'wa T flags 'Output)
+            sc_global_set_location glob (self.location as i32)
+            `glob
         case wimage (self)
             let T = ((get self.type) as type)
             let flags =

          
@@ 879,7 1258,63 @@ fn generate-IL (module)
                     local_size x y z
                     body
                     return;
-            'alloc-program ctx main
+            'alloc-compute ctx main
+        case shaderfn (self)
+            from self let vertex fragment
+            let vertex = (get vertex)
+            let fragment = (get fragment)
+            spice-quote
+                fn vertex-main ()
+                    vertex
+                    return;
+            spice-quote
+                fn fragment-main ()
+                    fragment
+                    return;
+            'alloc-shader ctx vertex-main fragment-main
+        case draw (self)
+            let pg = (get self.func)
+            let x y = (get self.x self.y)
+            let count instancecount = (get self.count self.instancecount)
+            let sources sinks = self.sources self.sinks
+
+            from GL let UseProgram BindFramebuffer Viewport DrawArraysInstanced
+                \ BindVertexArray
+
+            let mode =
+                switch self.mode
+                case PrimitiveType.Point GL.POINTS
+                case PrimitiveType.Line GL.LINES
+                case PrimitiveType.LineStrip GL.LINE_STRIP
+                case PrimitiveType.LineLoop GL.LINE_LOOP
+                case PrimitiveType.Triangle GL.TRIANGLES
+                case PrimitiveType.TriangleStrip GL.TRIANGLE_STRIP
+                case PrimitiveType.TriangleFan GL.TRIANGLE_FAN
+                default
+                    error "unsupported primitive mode"
+            #let mode = mode
+            let drawcmd =
+                `(DrawArraysInstanced mode 0 count instancecount)
+
+            let body = (sc_expression_new)
+            sc_expression_append body `(UseProgram pg)
+
+            let vao-setup-ptr vao-drive-ptr = ('get-nop-vao ctx)
+            sc_expression_append body `(BindVertexArray vao-drive-ptr)
+
+            local retargs : (Array Value)
+
+            assign-bindings ctx module body retargs sources sinks
+
+            sc_expression_append body `(Viewport 0 0 (x as i32) (y as i32))
+
+            sc_expression_append body drawcmd
+            sc_expression_append body `(UseProgram 0)
+            sc_expression_append body `(BindVertexArray 0)
+            sc_expression_append ctx.drive-body body
+            if (empty? retargs) `()
+            else
+                sc_argument_list_new ((countof retargs) as i32) (& (retargs @ 0))
         case dispatch (self)
             let pg = (get self.func)
             let x y z = (get self.x self.y self.z)

          
@@ 899,101 1334,7 @@ fn generate-IL (module)
 
             local retargs : (Array Value)
 
-            # bind values from function body instructions
-            do
-                let handle = ('handleof module sources)
-                let numsources = ('vacount handle)
-                let sources =
-                    dispatch handle
-                    case bindings (self) self.entries
-                    default
-                        error "sources must be bindings"
-                local next_texture_unit = 0
-                for i in (range numsources)
-                    let v k = (unpack (sources @ i))
-                    let khandle = ('handleof module k)
-                    dispatch khandle
-                    case uniform (self)
-                        let k = (get k)
-                        let v = (get v)
-                        let loc = (sc_global_location k)
-                        if (loc < 0)
-                            error "uniformattr has no binding"
-                        dispatch ('handleof module self.type)
-                        case sampler (smpty)
-                            from GL let BindTextureUnit Uniform1i
-                            let tu = (deref next_texture_unit)
-                            next_texture_unit += 1
-                            sc_expression_append body
-                                spice-quote
-                                    BindTextureUnit tu v
-                                    Uniform1i loc tu
-                        default
-                            from GL let Uniform
-                            sc_expression_append body `(Uniform (ptrtoref k) v)
-                    #case Op.SSBOATTR
-                        let b = (sc_global_binding k)
-                        assert (b >= 0)
-                        from GL let BindBufferBase SHADER_STORAGE_BUFFER
-                        sc_expression_append body
-                            spice-quote
-                                BindBufferBase SHADER_STORAGE_BUFFER b v
-                    default
-                        error
-                            .. "invalid binding type: " (string khandle.typeid.name)
-            do
-                let handle = ('handleof module sinks)
-                let numsinks = ('vacount handle)
-                let sinks =
-                    dispatch handle
-                    case bindings (self) self.entries
-                    default
-                        error "sources must be bindings"
-                for i in (range numsinks)
-                    let v k = (unpack (sinks @ i))
-                    let khandle = ('handleof module k)
-                    dispatch khandle
-                    case wimage (self)
-                        let vhandle = ('handleof module v)
-                        dispatch vhandle
-                        case imagestorage (self)
-                            let v = (gentexstorage module self ctx)
-                            #define-type "imagestorage"  (RIFF "IMST") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
-                            'append retargs v
-                            let imgfmt =
-                                dispatch ('handleof module self.type)
-                                case image (self)
-                                    imageformat->GL self.format
-                                default
-                                    error "invalid type for image"
-                            let b = (sc_global_binding (get k))
-                            assert (b >= 0)
-                            from GL let FALSE WRITE_ONLY BindImageTexture
-                            sc_expression_append body
-                                spice-quote
-                                    BindImageTexture b v
-                                        0 # level
-                                        FALSE # layered
-                                        0 # layer
-                                        WRITE_ONLY # access
-                                        imgfmt
-                        default
-                            error
-                                .. "invalid binding source for image: " (string vhandle.typeid.name)
-                    default
-                        error
-                            .. "invalid binding type: " (string khandle.typeid.name)
-                    #
-                        v as:= Id
-                        assert ((opof v) == Op.BUFSTORAGE)
-                        let v = (genbufstorage module v ctx)
-                        'append retargs v
-                        let b = (sc_global_binding k)
-                        assert (b >= 0)
-                        from GL let BindBufferBase SHADER_STORAGE_BUFFER
-                        sc_expression_append body
-                            spice-quote
-                                BindBufferBase SHADER_STORAGE_BUFFER b v
+            assign-bindings ctx module body retargs sources sinks
 
             sc_expression_append body dispatchcmd
             sc_expression_append body `(UseProgram 0)

          
@@ 1569,4 1910,5 @@ type+ FIR.BuilderType
 
 do
     let FIR NoId AnyId SystemKey ImageDim ImageFormat ImageFlags TypeId
+        \ PrimitiveType FragmentType DepthTestType
     locals;
  No newline at end of file

          
M lib/tukan/gl.sc +2 -1
@@ 969,7 969,8 @@ let GL = ('bind GL 'GetInteger64 gl-get-
 
 do
     let print-gl-info hook-gl-debug setup-ubo attach-shaders bind-ubo \
-        setup-framebuffer setup-ssbo bind-ssbo GL setup-renderbuffer
+        setup-framebuffer setup-ssbo bind-ssbo GL setup-renderbuffer \
+        framebuffer-status
     let GLAPI
 
     locals;

          
M testing/tukdag.sc +81 -11
@@ 21,7 21,8 @@ inline gen-level1-test ()
     from (methodsof module.builder) let input uniform uvec wimage dispatch
         \ bindings computefn imagestorage imagewrite globalid load fdiv
         \ fconst comp utof fadd fmul sin fvec2 fvec4 udiv add uconst image
-        \ outputs output uvec2 fvec
+        \ outputs output uvec2 fvec draw shaderfn position vertexid
+        \ rattr wattr block fsub urem store clear cos instanceid
 
     let inpss = (input SystemKey.ScreenSize)
     let inpit = (input SystemKey.Iteration)

          
@@ 32,6 33,7 @@ inline gen-level1-test ()
     let imgtype = (image ImageDim.2D ImageFormat.RGBA8UNORM ImageFlags.none)
     let img = (wimage imgtype 0)
     let z = (fadd (fmul (sin (fdiv (utof inpit) (fconst 60.0))) (fconst 0.5)) (fconst 0.5))
+    let angle = (fdiv (utof inpit) (fconst 60.0))
     let func =
         computefn 8 8 1
             do

          
@@ 51,8 53,54 @@ inline gen-level1-test ()
                     fvec4 u v z (fconst 1)
                     uvec2 x y
                     load img
+
+    let colorattr_out = (wattr (fvec 4) 0)
+    let colorattr_in = (rattr (fvec 4) 0 FragmentType.Smooth)
+    let colorattr_frag = (wattr (fvec 4) 0)
     outputs
         output SystemKey.Screen
+            draw
+                shaderfn
+                    do
+                        let vid = (vertexid)
+                        let iid = (instanceid)
+                        let it = (fadd (load u_it) (fmul (utof iid) (fconst 0.1)))
+                        let cs = (cos it)
+                        let ss = (sin it)
+                        let u = (utof (urem vid (uconst 2)))
+                        let v = (utof (udiv vid (uconst 2)))
+                        let x = (fsub u (fconst 0.5))
+                        let y = (fsub v (fconst 0.5))
+                        let x y =
+                            fadd (fmul cs x) (fmul ss y)
+                            fsub (fmul cs y) (fmul ss x)
+                        block
+                            store
+                                fvec4 u v (fconst 0) (fconst 1)
+                                colorattr_out
+                            store
+                                fvec4 x y (fconst 0) (fconst 1)
+                                position;
+                    do
+                        store
+                            load colorattr_in
+                            colorattr_frag
+                comp 0 inpss
+                comp 1 inpss
+                DepthTestType.True
+                PrimitiveType.TriangleStrip
+                uconst 4
+                uconst 10
+                bindings
+                    tupleof angle u_it
+                bindings
+                    tupleof
+                        clear
+                            fvec4 (uconst 0) (uconst 0) (uconst 1) (uconst 1)
+                            imagestorage imgtype 4096 4096 1 1 0
+                        colorattr_frag
+    #outputs
+        output SystemKey.Screen
             # indirect dispatch
             dispatch func
                 udiv (add (comp 0 inpss) (uconst 7)) (uconst 8)

          
@@ 69,10 117,10 @@ inline gen-level1-test ()
 
 inline gen-level2-test ()
     from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst
-        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample
-        \ outputs sub unpack-comp
+        \ fconst range comp and xor utof sin cos fadd fmul fdiv sample fsub
+        \ outputs sub unpack-comp udiv urem primitive fragment selectfragment
+        \ clear depthtest overlay
 
-    let inpss = (input SystemKey.ScreenSize)
     let inpit = (input SystemKey.Iteration)
 
     let TS = (uconst 32)

          
@@ 91,6 139,31 @@ inline gen-level2-test ()
                 unpack-comp pos 2
             utof (xor (and x (uconst 1)) (and y (uconst 1)))
 
+    let w h =
+        unpack-comp (input SystemKey.ScreenSize) 2
+    let screenrange = (range w h)
+
+    let prim = (primitive PrimitiveType.TriangleStrip (uconst 4) (uconst 1))
+    let vertexid = (comp 0 prim)
+    let u = (utof (urem vertexid (uconst 2)))
+    let v = (utof (udiv vertexid (uconst 2)))
+
+    let quadvertex =
+        do
+            let x = (fsub u (fconst 0.5))
+            let y = (fsub v (fconst 0.5))
+            fvec4 x y (fconst 0) (fconst 1)
+    let vertexcolor =
+        fragment FragmentType.Smooth
+            fvec3 u v (fconst 0)
+    outputs
+        output SystemKey.Screen
+            selectfragment
+                overlay quadvertex
+                vertexcolor
+                clear screenrange
+                    fvec3 (uconst 0) (uconst 0) (uconst 1)
+
     outputs
         output SystemKey.Screen
             do

          
@@ 98,11 171,8 @@ inline gen-level2-test ()
                 let it = (fdiv (utof inpit) (fconst 60.0))
                 let itsin = (fadd (fmul (sin it) (fconst 0.5)) (fconst 0.5))
                 # screen size
-                let w h =
-                    unpack-comp inpss 2
-                let pos = (range w h)
                 let x y =
-                    unpack-comp pos 2
+                    unpack-comp screenrange 2
                 let u = (fdiv (utof x) (utof w))
                 let v = (fdiv (utof y) (utof h))
                 let q0 = (sample checkers_texture1 (fvec2 (fadd u itsin) v))

          
@@ 131,8 201,8 @@ inline graphviz ()
         'showdot module ('rootid module)
             module-dir .. "/tukdag"
 
-#gen-level1-test;
-do
+gen-level1-test;
+#do
     gen-level2-test;
     cleanup;
     'dump module

          
@@ 142,7 212,7 @@ print;
 cleanup;
 'dump-scope module
 #graphviz;
-#run;
+run;
 
 drop module
 unlet module