145 lines
4.1 KiB
Standard ML
145 lines
4.1 KiB
Standard ML
structure GlDraw =
|
|
struct
|
|
open CML
|
|
open DrawMsg
|
|
(* The name doesn't make it clear, but this structure
|
|
* couples GLFW and OpenGL.
|
|
* I'm not sure if I will use native windowing systems
|
|
* or other graphics APIs at a later stage,
|
|
* but the current priority is GLFW + OpenGL.
|
|
* *)
|
|
type t =
|
|
{ textVertexBuffer: Word32.word
|
|
, textProgram: Word32.word
|
|
, textDrawLength: int
|
|
, drawMailbox: DrawMsg.t Mailbox.mbox
|
|
, window: MLton.Pointer.t
|
|
}
|
|
|
|
fun createShader (shaderType, shaderString) =
|
|
let
|
|
val shader = Gles3.createShader shaderType
|
|
val _ = Gles3.shaderSource (shader, shaderString)
|
|
val _ = Gles3.compileShader shader
|
|
in
|
|
shader
|
|
end
|
|
|
|
fun createProgram (vertexShader, fragmentShader) =
|
|
let
|
|
val program = Gles3.createProgram ()
|
|
val _ = Gles3.attachShader (program, vertexShader)
|
|
val _ = Gles3.attachShader (program, fragmentShader)
|
|
val _ = Gles3.linkProgram program
|
|
in
|
|
program
|
|
end
|
|
|
|
fun create (drawMailbox, window) =
|
|
let
|
|
(* create vertex buffer, program, etc. for text. *)
|
|
val textVertexBuffer = Gles3.createBuffer ()
|
|
val xyrgbVertexShader = createShader
|
|
(Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
|
|
|
|
val rgbFragmentShader = createShader
|
|
(Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
|
|
|
|
val textProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
|
|
|
|
(* clean up shaders which are no longer needed once progran is linked. *)
|
|
val _ = Gles3.deleteShader xyrgbVertexShader
|
|
val _ = Gles3.deleteShader rgbFragmentShader
|
|
in
|
|
{ textVertexBuffer = textVertexBuffer
|
|
, textProgram = textProgram
|
|
, textDrawLength = 0
|
|
, drawMailbox = drawMailbox
|
|
, window = window
|
|
}
|
|
end
|
|
|
|
fun uploadText (shellState: t, vec) =
|
|
let
|
|
val
|
|
{textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} =
|
|
shellState
|
|
|
|
val _ = Gles3.bindBuffer textVertexBuffer
|
|
val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
|
|
val newTextDrawLength = Vector.length vec div 5
|
|
in
|
|
{ textVertexBuffer = textVertexBuffer
|
|
, textProgram = textProgram
|
|
, drawMailbox = drawMailbox
|
|
, window = window
|
|
, textDrawLength = newTextDrawLength
|
|
}
|
|
end
|
|
|
|
fun drawText ({textVertexBuffer, textProgram, textDrawLength, ...}: t) =
|
|
if textDrawLength > 0 then
|
|
let
|
|
val _ = Gles3.bindBuffer textVertexBuffer
|
|
(* enable xy component from uploaded array *)
|
|
val _ = Gles3.vertexAttribPointer (0, 2, 5, 0)
|
|
val _ = Gles3.enableVertexAttribArray 0
|
|
(* enable rgb component from uploaded array *)
|
|
val _ = Gles3.vertexAttribPointer (1, 3, 5, 8)
|
|
val _ = Gles3.enableVertexAttribArray 1
|
|
|
|
val _ = Gles3.useProgram textProgram
|
|
val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, textDrawLength)
|
|
in
|
|
()
|
|
end
|
|
else
|
|
()
|
|
|
|
fun draw (drawObject: t) =
|
|
let val _ = drawText drawObject
|
|
in ()
|
|
end
|
|
|
|
|
|
fun consumeDrawEvent (shellState, msg) =
|
|
let
|
|
val
|
|
{textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} =
|
|
shellState
|
|
in
|
|
case msg of REDRAW_TEXT textVec => uploadText (shellState, textVec)
|
|
end
|
|
|
|
fun consumeDrawEvents (shellState as {drawMailbox, ...}: t) =
|
|
case Mailbox.recvPoll drawMailbox of
|
|
NONE => shellState
|
|
| SOME msg =>
|
|
let val shellState = consumeDrawEvent (shellState, msg)
|
|
in consumeDrawEvents shellState
|
|
end
|
|
|
|
fun helpLoop (shellState as {window, ...}: t) =
|
|
case Glfw.windowShouldClose window of
|
|
false =>
|
|
let
|
|
val shellState = consumeDrawEvents shellState
|
|
|
|
val _ = Gles3.clearColor (0.087, 0.095, 0.13, 1.0)
|
|
val _ = Gles3.clear ()
|
|
|
|
val _ = draw shellState
|
|
|
|
val _ = Glfw.swapBuffers window
|
|
val _ = Glfw.waitEvents ()
|
|
in
|
|
helpLoop shellState
|
|
end
|
|
| true => Glfw.terminate ()
|
|
|
|
fun loop (drawMailbox, window) =
|
|
let val shellState = create (drawMailbox, window)
|
|
in helpLoop shellState
|
|
end
|
|
end
|