raycasting_shaders.sc

inline gamma->linear (...)
    va-map
        inline (c)
            if (c <= 0.04045)
                c / 12.92
            else
                ((c + 0.055) / 1.055) ** 2.4
    ...

inline tile@ (level width height p)
    let p = (floor p)
    let x y = (p.x as i32) (p.y as i32)
    if (or
        (x >= width)
        (x < 0)
        (y >= height)
        (y < 0))
        0:u32
    else
        deref (level @ ((y * width) + x))

let sky-color = (vec4 (vec3 (gamma->linear 0 0.498039 1)) 1)
let ground-color = (vec4 (vec3 (gamma->linear 0.498039 0.498039 0.498039)) 1)
let fb-width = 1024:u32
let fb-height = 768:u32
let level-width = 9
let level-height = 9
let level-data =
    arrayof u32
        \ 0 0 0 0 1 0 0 0 0
        \ 0 1 1 1 1 1 1 0 1
        \ 0 1 0 0 0 0 0 0 1
        \ 0 1 0 1 0 0 0 0 1
        \ 1 1 0 1 0 0 0 0 1
        \ 0 1 0 1 0 0 1 0 1
        \ 0 1 0 1 0 0 0 0 1
        \ 0 1 0 0 0 0 0 0 1
        \ 0 1 1 1 1 1 1 1 1

run-stage;

struct VertexAttributes plain
    position : vec2
    texcoord : vec2
    color    : vec4

struct RCData plain
    position : vec2
    orientation : f32

define-scope shaders
    using import glsl
    using math
    fn vertex ()
        buffer attributes : (tuple (array VertexAttributes))
            set = 0
            binding = 0
        out vtexcoord : vec2
            location = 0
        out vcolor : vec4
            location = 1

        attr := (extractvalue attributes 0) @ gl_VertexIndex

        gl_Position = (vec4 attr.position 0 1)
        vcolor = attr.color
        vtexcoord = attr.texcoord

    fn textured-quad-fragment ()
        in vtexcoord : vec2
            location = 0
        out fcolor : vec4
            location = 0

        uniform diffuse-t : texture2D
            set = 1
            binding = 0
        uniform diffuse-s : sampler
            set = 1
            binding = 1

        fcolor = (texture (sampler2D diffuse-t diffuse-s) vtexcoord)

    fn fb-fragment ()
        in vtexcoord : vec2
            location = 0
        out fcolor : vec4
            location = 0

        uniform distance-map : texture1D
            set = 1
            binding = 0
        uniform tex-sampler : sampler
            set = 1
            binding = 1

        let wall-distance =
            texelFetch (sampler1D distance-map tex-sampler) ((vtexcoord.x * fb-width) as i32) 0
        let column-height = (1 / wall-distance.r)
        let top = (0.5 + (column-height / 2))
        let bottom = (0.5 - (column-height / 2))


        let wall-color = (vec4 (vec3 column-height) 1)
        let rowh = (1 / fb-height)
        y := vtexcoord.y
        if (y < 0.5)
            let t =
                smoothstep (bottom - (rowh / 2)) (bottom  + (rowh / 2)) y
            fcolor = (mix ground-color wall-color t)
        else
            let t =
                smoothstep (top - (rowh / 2)) (top  + (rowh / 2)) y
            fcolor = (mix wall-color sky-color t)

    fn rays-fragment ()
        uniform rcdata : RCData
            set = 1
            binding = 0
        in vtexcoord : vec2
            location = 0
        out fdistance : f32
            location = 0

        local level-data = level-data
        # Each level quadrant has a unit of 1 meter.
        let MAX_ITERATIONS = 100
        inline raycast (origin angle)
            loop (cur-hit iter = (deref origin) 0)
                if (iter >= MAX_ITERATIONS)
                    break Inf
                if ((tile@ level-data level-width level-height cur-hit) > 0)
                    break (distance cur-hit origin)

                let ss = (sign (sin angle))
                let cs = (sign (cos angle))

                # first intersection with an 'horizontal' tile boundary
                vvv bind hy
                if (ss > 0)
                    ceil cur-hit.y
                elseif (ss < 0)
                    floor cur-hit.y
                else
                    repeat
                        vec2
                            ? (cs > 0) (ceil cur-hit.x) (floor cur-hit.x)
                            cur-hit.y
                        iter + 1

                # idem for vertical boundary
                vvv bind vx
                if (cs > 0)
                    ceil cur-hit.x
                elseif (cs < 0)
                    floor cur-hit.x
                else
                    repeat
                        vec2
                            ? (ss > 0) (ceil cur-hit.y) (floor cur-hit.y)
                            cur-hit.y
                        iter + 1

                # FIXME: confusing names
                dx := (hy - cur-hit.y) / (tan angle)
                dy := (vx - cur-hit.x) * (tan angle)
                hx := cur-hit.x + dx
                vy := cur-hit.y + dy
                let iv = (vec2 vx vy)
                let ih = (vec2 hx hy)

                inline offset-intersection (i)
                    vec2
                        i.x + (0.0001 * (cos angle))
                        i.y + (0.0001 * (sin angle))


                let distv = (distance iv cur-hit)
                let disth = (distance ih cur-hit)
                let hit =
                    if (distv < disth)
                        offset-intersection iv
                    else
                        offset-intersection ih
                _ hit (iter + 1)

        let FOV = (pi / 3)
        let position = rcdata.position
        let orientation = rcdata.orientation
        let aoffset = (gl_FragCoord.x * (FOV / fb-width))

        #  /
        # / +
        # -----
        # \ -
        #  \
        let rangle =
            orientation + (FOV / 2) - aoffset

        let hitlen = (raycast position rangle)
        # correct distortion caused by angled rays being longer
        fdistance = (max 0.0001 (hitlen * (cos (rangle - orientation))))

    fn minimap-fragment ()
        uniform rcdata : RCData
            set = 1
            binding = 0
        in vtexcoord : vec2
            location = 0
        out fcolor : vec4
            location = 0

        using math

        local level-data = level-data
        angle := rcdata.orientation
        position := rcdata.position
        # the minimap area is 4x4 units
        # tbh I don't get why I have to invert the x axis here
        vtexcoord := vtexcoord * (vec2 -1 1) + (vec2 1 0)
        let tile-samplep =
            + position
                2drotate
                    ((vtexcoord - (vec2 0.5 0.5)) * 6)
                    (angle + (pi / 2))

        let t = (tile@ level-data level-width level-height tile-samplep)
        if ((distance vtexcoord (vec2 0.5)) < 0.025)
            fcolor = (vec4 1 0 0 1)
        else
            fcolor = (mix ground-color (vec4 1) t)