scaffolding for concurrent ml

fcore/app-type.sml

@@ -1,4 +1,5 @@
 structure AppType =
 struct
-
+  type app_type =
+    {buffer: LineGap.t, windowWidth: int, windowHeight: int}
 end

fcore/app-update.sml

@@ -0,0 +1,24 @@
+structure AppUpdate =
+struct
+  open AppType
+
+  open MailboxType
+  open DrawMsg
+  open InputMsg
+
+  fun resizeText (app: app_type, newWidth, newHeight) =
+    let
+      val {buffer, windowWidth, windowHeight} = app
+      val (textVec, newBuffer) =
+        TextBuilder.build (0, buffer, newWidth, newHeight)
+
+      val newApp =
+        {buffer = newBuffer, windowWidth = newWidth, windowHeight = newHeight}
+      val msg = REDRAW_TEXT textVec
+    in
+      (newApp, [DRAW msg])
+    end
+
+  fun update (app, msg) =
+    case msg of RESIZE_EVENT (width, height) => resizeText (app, width, height)
+end

fcore/text-builder.sml

@@ -136,45 +136,6 @@ struct
           )
     | [] => acc
 
-  (* todo: 
-   * before calling continueBuildTextLineGap, 
-   * find start position inside LineGap 
-   * to start building from *)
-  fun startBuildTextLineGap (startLine, lineGap: LineGap.t, windowWidth, windowHeight) =
-    let
-      val lineGap = LineGap.goToLine (startLine, lineGap)
-      val {rightStrings, rightLines, line = curLine, ...} = lineGap
-
-      val acc = case (rightStrings, rightLines) of
-                     (rStrHd::rStrTl, rLnHd::_) =>
-                     let
-                       (* get index of line to start building from *)
-                       val lnPos = startLine - curLine
-                       val startIdx = Vector.sub (rLnHd, lnPos)
-                       val startIdx =
-                       if String.sub (rStrHd, startIdx) = #"\r" andalso startIdx
-                       < String.size rStrHd - 1 andalso String.sub (rStrHd,
-                       startIdx + 1) = #"\n"
-                       then
-                         (* handle \r\n pair *)
-                         startIdx + 2
-                      else startIdx + 1
-                     in
-buildTextString ( startIdx, rStrHd, [], 5, 5, 5
-    , windowWidth, windowHeight, 
-    Real32.fromInt windowWidth, Real32.fromInt windowHeight
-    , 0.0, 0.0, 0.0, rStrTl
-    )
-                     end
-                           | (_, _) =>
-                               (* requested line goes beyond the buffer,
-                                * so just return empty list as there is nothig
-                                * else we can do. *)
-                                []
-    in
-      Vector.concat acc
-    end
-
   fun build
     (startLine, lineGap: LineGap.t, windowWidth, windowHeight) =
     let

message-types/draw-msg.sml

@@ -0,0 +1,5 @@
+structure DrawMsg =
+struct
+  datatype t =
+    REDRAW_TEXT of Real32.real vector
+end

message-types/input-msg.sml

@@ -0,0 +1,5 @@
+structure InputMsg = 
+struct 
+  datatype t = 
+    RESIZE_EVENT of int * int 
+end

message-types/mailbox-type.sml

@@ -0,0 +1,5 @@
+structure MailboxType =
+struct
+  datatype t =
+    DRAW of DrawMsg.t
+end

shell/update-thread.sml

@@ -0,0 +1,25 @@
+structure UpdateThread =
+struct
+  open CML
+  open MailboxType
+
+  fun sendMsg (msg, drawMailbox) =
+    case msg of DRAW msg => Mailbox.send (drawMailbox, msg)
+
+  fun sendMsgs (msgList, drawMailbox) =
+    case msgList of
+      hd :: tl =>
+        let val _ = sendMsg (hd, drawMailbox)
+        in sendMsgs (tl, drawMailbox)
+        end
+    | [] => ()
+
+  fun loop (app: AppType.app_type, inputMailbox, drawMailbox) =
+    let
+      val inputMsg = Mailbox.recv inputMailbox
+      val (app, msgList) = AppUpdate.update (app, inputMsg)
+      val _ = sendMsgs (msgList, drawMailbox)
+    in
+      loop (app, inputMailbox, drawMailbox)
+    end
+end

shf.mlb

@@ -5,7 +5,13 @@ lib/brolib-sml/src/line_gap.sml
 lib/cozette-sml/fonts/cozette-ascii.mlb
 
 (* FUNCTIONAL CORE *)
+message-types/input-msg.sml
+message-types/draw-msg.sml
+message-types/mailbox-type.sml
+
+fcore/app-type.sml
 fcore/text-builder.sml
+fcore/app-update.sml
 
 (* IMPERATIVE SHELL *)
 $(SML_LIB)/basis/mlton.mlb
@@ -19,6 +25,7 @@ in
   ffi/glfw-input.sml
 end
 
+shell/update-thread.sml
 shell/gl-shaders.sml
 shell/gl-draw.sml
 shell/shell.sml