done scaffolding cml and adding resize functionality

fcore/app-type.sml

@@ -2,4 +2,7 @@ structure AppType =
 struct
   type app_type =
     {buffer: LineGap.t, windowWidth: int, windowHeight: int}
+
+  fun init (buffer, windowWidth, windowHeight): app_type =
+    {buffer = buffer, windowWidth = windowWidth, windowHeight = windowHeight}
 end

ffi/glfw-input.c

@@ -1,4 +1,5 @@
 #include "export.h"
+#include "glad.h"
 #define GLFW_INCLUDE_NONE
 #include <GLFW/glfw3.h>
 
@@ -6,3 +7,12 @@ int PRESS = GLFW_PRESS;
 int REPEAT = GLFW_REPEAT;
 int RELEASE = GLFW_RELEASE;
 
+void framebufferSizeCallback(GLFWwindow* window, int width, int height) {
+  glViewport(0, 0, width, height);
+  mltonFramebufferSizeCallback(width, height);
+}
+
+void setFramebufferSizeCallback(GLFWwindow* window) {
+  glfwSetFramebufferSizeCallback(window, framebufferSizeCallback);
+}
+

ffi/glfw-input.sml

@@ -17,4 +17,6 @@ struct
 
   val exportFramebufferSizeCallback =
     _export "mltonFramebufferSizeCallback" public : (int * int -> unit) -> unit;
+  val setFramebufferSizeCallback =
+    _import "setFramebufferSizeCallback" public : window -> unit;
 end

message-types/draw-msg.sml

@@ -1,4 +1,10 @@
-structure DrawMsg =
+signature DRAW_MSG =
+sig
+  datatype t =
+    REDRAW_TEXT of Real32.real vector
+end
+
+structure DrawMsg :> DRAW_MSG =
 struct
   datatype t =
     REDRAW_TEXT of Real32.real vector

message-types/input-msg.sml

@@ -1,4 +1,10 @@
-structure InputMsg = 
+signature INPUT_MSG =
+sig
+  datatype t = 
+    RESIZE_EVENT of int * int 
+end
+
+structure InputMsg :> INPUT_MSG = 
 struct 
   datatype t = 
     RESIZE_EVENT of int * int 

message-types/mailbox-type.sml

@@ -1,4 +1,10 @@
-structure MailboxType =
+signature MAILBOX_TYPE =
+sig
+  datatype t =
+    DRAW of DrawMsg.t
+end
+
+structure MailboxType :> MAILBOX_TYPE =
 struct
   datatype t =
     DRAW of DrawMsg.t

shell/gl-draw.sml

@@ -1,5 +1,7 @@
 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
@@ -10,6 +12,7 @@ struct
     { textVertexBuffer: Word32.word
     , textProgram: Word32.word
     , textDrawLength: int
+    , drawMailbox: DrawMsg.t Mailbox.mbox
     , window: MLton.Pointer.t
     }
 
@@ -32,7 +35,7 @@ struct
       program
     end
 
-  fun create window =
+  fun create (drawMailbox, window) =
     let
       (* create vertex buffer, program, etc. for text. *)
       val textVertexBuffer = Gles3.createBuffer ()
@@ -51,19 +54,24 @@ struct
       { textVertexBuffer = textVertexBuffer
       , textProgram = textProgram
       , textDrawLength = 0
+      , drawMailbox = drawMailbox
       , window = window
       }
     end
 
-  fun uploadText
+  fun uploadText (shellState: t, vec) =
-    ({textVertexBuffer, textProgram, window, textDrawLength = _}: 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
       }
@@ -93,10 +101,30 @@ struct
     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 (1.0, 1.0, 1.0, 1.0)
           val _ = Gles3.clear ()
 
@@ -109,8 +137,8 @@ struct
         end
     | true => Glfw.terminate ()
 
-  fun loop window =
+  fun loop (drawMailbox, window) =
-    let val shellState = create window
+    let val shellState = create (drawMailbox, window)
     in helpLoop shellState
     end
 end

shell/shell.sml

@@ -1,6 +1,19 @@
 structure Shell =
 struct
   open CML
+  open InputMsg
+
+  fun frameBufferSizeCallback inputMailbox (width, height) =
+    Mailbox.send (inputMailbox, RESIZE_EVENT (width, height))
+
+  fun registerCallbacks (inputMailbox, window) =
+    let
+      val resizeCallback = frameBufferSizeCallback inputMailbox
+      val () = Input.exportFramebufferSizeCallback resizeCallback
+      val () = Input.setFramebufferSizeCallback window
+    in
+      ()
+    end
 
   fun ioToLineGap (io, acc) =
     case TextIO.inputLine io of
@@ -18,16 +31,21 @@ struct
       val _ = Glfw.makeContextCurrent window
       val _ = Gles3.loadGlad ()
 
-      (* upload text vector *)
+      (* load file intol gap buffer and create initial app *)
       val io = TextIO.openIn "fcore/text-builder.sml"
       val lineGap = ioToLineGap (io, LineGap.empty)
       val _ = TextIO.closeIn io
+      val app = AppType.init (lineGap, 1920, 1080)
 
-      val (textVec, _) = TextBuilder.build (0, lineGap, 1920, 1080)
+      (* create mailboxes for CML communication *)
-      val shellState = GlDraw.create window
+      val inputMailbox = Mailbox.mailbox ()
-      val shellState = GlDraw.uploadText (shellState, textVec)
+      val drawMailbox = Mailbox.mailbox ()
 
-      val _ = GlDraw.helpLoop shellState
+      val () = registerCallbacks (inputMailbox, window)
+
+      val _ = CML.spawn (fn () => GlDraw.loop (drawMailbox, window))
+      val _ = CML.spawn (fn () =>
+        UpdateThread.loop (app, inputMailbox, drawMailbox))
     in
       ()
     end