glsl_shaderlang.scm

(none
; a prototype for a shader language in None, implemented on top of GLSL

(syntax-import "glsl")
(using (require "glsl"))

; Why?
; 
; the general idea is being that it will be possible to freely compose
; shaders on a per-function basis, use quasiquotation / programmable macros
; in shader code to generate permutations, and auto-generate static interfaces 
; to conveniently update program uniforms and uniform buffers.
;
; It removes many redundancies associated with shader programming
; and invites programmers to do more ad-hoc prototyping.

; the shader example described here is translated from a GLSL shader I use in 
; an actual game prototype;
; it reads triangle data from a buffer texture, generates triangles and
; shades these triangles according to their vertex and edge ID's using
; their barycentric coordinates.

; liminal's vector types also function in shader code
(require "liminal.vec")

; vertex
; ------------------------------------------------------------------------------

; built-in GLSL symbols reside in their own module
(import-from (require "glsl.builtin")
    gl_VertexID)

; written by vertex shader and read by geometry shader (where it is an array)
;
; for shared variables, the code generator figures out where the corresponding 
; in/out declarations go and reports invalid use.
;
; removing the explicit usage hinting frees the coder from having to revisit
; declarations when moving functions between shader stages.
;
; examples for valid use:
;       * vertex: R (= read)
;       * fragment: W (= write)
;       * vertex: W, geom: R
;       * geom: W, fragment: R
;
; examples for invalid use:
;       * vertex: W, geom: *, fragment: R (stages aren't neighbors)
;       * geom: R, fragment: W (wrong stage direction)
;       * vertex: W, geom: RW, fragment: R (although that sounds rather useful)
(shader shared face_index : int)

; declares a shader function
; any function with a (void <- ()) signature can be used as a main function
(shader vertex-main ()
    : (void <- ())
    ; shader function syntax is completely analog to None's static syntax,
    ; so it gets easier to move functions between CPU / GPU, or to provide
    ; implementations for both
    (face_index = gl_VertexID))

; geometry
; ------------------------------------------------------------------------------

; more built-in symbols
(import-from (require "glsl.builtin")
    ; use of uintBitsToFloat causes the code generator to auto-enable the
    ; GL_ARB_shader_bit_encoding extension
    uintBitsToFloat
    normalize
    usamplerBuffer
    texelFetch
    gl_Position
    EmitVertex
    EndPrimitive)

; CHALLENGE: import directly from GLSL files like from any other source file; 
; needs an introspection library that can parse GLSL files for declarations
; without compiling or linking.
(### 
    (import-from (require "hslhsv")
        hsl2rgb))
; Until then, we can only import bindings from other None modules, or
; declare them as externals, like this:
(shader extern hsl2rgb (color) : (vec3 <- (vec3)))

; shared between geometry and fragment stage
(shader shared col : vec3)
(shader shared vxid : vec3)

(shader uniform vertex_buffer : usamplerBuffer)
(shader uniform face_buffer : usamplerBuffer)

; this declaration also doubles as a corresponding static struct type 
; that can be used for interfacing with the shader program
(shader uniform WorldParams
    (camera_aim : mat3)
    (camera_origin : vec3)
    (mtx_proj : vec3)
    (time : float)
    )

(shader transform_vertex (p)
    : (vec4 <- (vec3))
    (p.xy = (p.xy - WorldParams.camera_origin.xy) * WorldParams.mtx_proj.xy)
    (vec4 p 1))
    
(shader scale_tri (p0 p1 p2 x)
    ; a referenced type is translated as out or inout argument, 
    ; depending on whether it is read in the function
    : (void <- (&vec3 &vec3 &vec3 float))
    (var c : vec3
        (0.25 * (+ p0 p1 p2)))
    (p0 = c + (p0 - c) * x)
    (p1 = c + (p1 - c) * x)
    (p2 = c + (p2 - c) * x))
    
(shader extrude_tri (p0 p1 p2 x)
    : (void <- (&vec3 &vec3 &vec3 float))
    (var c : vec3
        (0.25 * (+ p0 p1 p2)))
    (p0 = c + (normalize (p0 - c)) * x)
    (p1 = c + (normalize (p1 - c)) * x)
    (p2 = c + (normalize (p2 - c)) * x))

(shader emit_tri (p0 p1 p2)
    : (void <- (vec3 vec3 vec3))
    (vxid = (vec3 1 0 0))
    (gl_Position = (transform_vertex p0))
    (EmitVertex)
    
    (vxid = (vec3 0 1 0))
    (gl_Position = (transform_vertex p1))
    (EmitVertex)
    
    (vxid = (vec3 0 0 1))
    (gl_Position = (transform_vertex p2))
    (EmitVertex)
    
    (EndPrimitive))
    
(shader uread (smp index)
    : (uint <- (usamplerBuffer int))
    ((texelFetch smp index) . r))

(shader iread (smp index)
    : (int <- (usamplerBuffer int))
    (int (uread smp index)))

(shader fread (smp index)
    : (float <- (usamplerBuffer int))
    (uintBitsToFloat (uread smp index)))
    
(shader iread3 (smp index)
    : (ivec3 <- (usamplerBuffer int))
    (ivec3 
        (uread smp index) 
        (uread smp (index + 1))
        (uread smp (index + 2))))

(shader fread2 (smp index)
    : (vec2 <- (usamplerBuffer int))
    (vec2 
        (fread smp index) 
        (fread smp (index + 1))))
        
(shader read_vertex (index)
    : (vec3 <- (int))
    (vec3 (fread2 vertex_buffer (index * 5)) 0))

(shader geometry-main ()
    : (void <- ())
    (var face_offset : int (face_index # 0 * 7))
    (if ((uread face_buffer (face_offset + 6)) == 0)
        (do
            (col = 
                (hsl2rgb 
                    (vec3 
                        ((float (face_index # 0)) * 0.16667)
                        0.9 
                        0.9)))
            (var face_verts : ivec3
                (iread3 face_buffer face_offset))
            (emit_tri 
                (read_vertex (face_verts # 0)) 
                (read_vertex (face_verts # 1))
                (read_vertex (face_verts # 2))))))

; fragment
; ------------------------------------------------------------------------------

(import-from (require "glsl.builtin")
    fwidth smoothstep mix min max)

(shader shared color : vec4)

(shader min3 (v)
    : (float <- (vec3))
    (min v.x v.y v.z))
    
(shader max3 (v)
    : (float <- (vec3))
    (max v.x v.y v.z))
    
(shader fragment-main ()
    : (void <- ())
    (var d : vec3 (1.5 * (fwidth vxid)))
    (var a3 : vec3 (smoothstep (vec3 0) d vxid))
    (var ef : float (min3 a3))
    (var corners : vec3
        (smoothstep 
            (20 * d) 
            (vec3 0)
            (1 - vxid)))
    (var edges : vec3
        (smoothstep
            (5 * d)
            (vec3 0)
            vxid))
    (color =
        (ef * 
            (vec4 
                (mix 
                    (mix 
                        (vec3 1) 
                        edges 
                        (max3 edges))
                    corners
                    (max3 corners))
                1))))

(import-from (require "GLEW")
    glCreateProgram)

(function compile-program ()
    ; generates all required code, compiles shaders if necessary and links
    ; the program.
    (var pg (glCreateProgram))
    (shader-compile pg
        (table-do 
            ; sets the #version pragma for all shaders
            (var version 150)
            
            ; sets vertex-main as the vertex shader stage
            (var vertex-stage vertex-main)
            
            ; the geometry shader format has to be set in the compile flags
            ; geometry-in sets the input format for the geometry shader
            (shader (layout points) shared geometry-in)
            ; geometry-out sets the output format
            (shader (layout triangle_strip (max_vertices 6)) shared geometry-out)
            ;sets geometry-main as the geometry shader stage
            (var geometry-stage geometry-main)        
            
            ; sets fragment-main as the fragment shader stage
            (var fragment-stage fragment-main)
            
            ))
    pg)
            
(var sys (require "liminal.system"))
(var win (require "liminal.window"))
(var time (require "liminal.time"))
(sys.main
    (function ()
        (win.show
            (function()
                (win.create-gl-context)
                (try
                    (do
                        (compile-program)
                        )
                    except err
                    (do 
                        (print err)
                        (error err)))))))

nil
)