Render Monad WIP

gistfile1.txt

set drawcall (0)
-set shader:Unified (1)
--set color:red (2)
---set shape:box (3)
---unset shape:box (3)
---set drawcall (4)
----set attrib (5)
----unset attrib (5)
---unset drawcall (4)
---set uniform (6)
----set fullsreen (7)
----unset fullsreen (7)
----set attrib (8)
-----set shape:circle (9)
-----unset shape:circle (9)
----unset attrib (8)
---unset uniform (6)
--unset color:red (2)
-unset shader:Unified (1)
unset drawcall (0)

gistfile2.fs

module RenderState

type Computation = (unit -> unit) -> unit
type State = State of Computation

let draw s =
    let (State compute) = s
    compute (fun () -> ())

let bind f s =
    let (State a) = s
    let (State b) = f a
    State (fun f -> a (fun f -> b (fun f -> f)))

let combine a b =
    let (State a) = a
    let (State b) = b
    let a = (fun f -> a (fun f -> f))
    let b = (fun f -> b (fun f -> f))
    State (fun f -> a f; b f)

let empty = State (fun f -> f ())

type RenderStateBuilder () = 
  member inline x.Return v = empty
  member inline x.ReturnFrom v = v
  member inline x.Bind (s, f) = bind f s
  member inline x.Combine (a, b) = combine a b
  member inline x.Delay f = f ()

let render = RenderStateBuilder ()

module DebugRenderer =

    let mutable depth = 0
    let mutable id = 0

    let debugState label =
        let label = label + " (" + (id.ToString()) + ")"
        id <- id + 1
        State (fun func ->
            printfn "%sset %s" (String.replicate depth "-") label
            depth <- depth + 1
            func ()
            depth <- depth - 1
            printfn "%sunset %s" (String.replicate depth "-") label)

    let drawcall () = debugState "drawcall"
    let shader name = debugState ("shader:" + name)
    let color name = debugState ("color:" + name)
    let shape form = debugState ("shape:" + form)
    let fullscreen () = debugState "fullsreen"
    let uniform () = debugState "uniform"
    let attrib () = debugState "attrib"

open DebugRenderer

[<EntryPoint>]
let main argv = 

    let scene = render {

        let! dc = drawcall ()
        let! sh = shader "Unified"
        let! co = color "red"
        return! shape "box"

        return! render {
            let! dc = drawcall ()
            return! attrib ()
        }

        let! un = uniform ()
        return! fullscreen ()

        let! at = attrib ()
        return! shape "circle"
    }

    draw scene

    0