done merging draw thread with update thread

message-types/mailbox-type.sml

@@ -1,2 +1,2 @@
 structure MailboxType =
-struct datatype t = DRAW of DrawMsg.t | SEARCH of LineGap.t * string * Time.time end
+struct datatype t = DRAW of DrawMsg.t | SEARCH of SearchMsg.t end

message-types/search-msg.sml

@@ -0,0 +1 @@
+structure SearchMsg = struct type t = LineGap.t * string * Time.time end

shell/gl-draw.sml

@@ -21,7 +21,6 @@ struct
     , bgProgram: Word32.word
     , bgDrawLength: int
 
-    , drawMailbox: DrawMsg.t Mailbox.mbox
     , window: MLton.Pointer.t
     }
 
@@ -44,7 +43,7 @@ struct
       program
     end
 
-  fun create (drawMailbox, window) =
+  fun create window =
     let
       (* create vertex buffer, program, etc. for text. *)
       val textVertexBuffer = Gles3.createBuffer ()
@@ -80,7 +79,6 @@ struct
       , bgProgram = bgProgram
       , bgDrawLength = 0
 
-      , drawMailbox = drawMailbox
       , window = window
       }
     end
@@ -98,7 +96,6 @@ struct
         , bgProgram
         , bgDrawLength
         , window
-        , drawMailbox
         } = shellState
 
       val _ = Gles3.bindBuffer textVertexBuffer
@@ -114,7 +111,6 @@ struct
       , bgVertexBuffer = bgVertexBuffer
       , bgProgram = bgProgram
       , bgDrawLength = bgDrawLength
-      , drawMailbox = drawMailbox
       , window = window
       }
     end
@@ -132,7 +128,6 @@ struct
         , bgProgram
         , bgDrawLength
         , window
-        , drawMailbox
         } = shellState
 
       val _ = Gles3.bindBuffer cursorVertexBuffer
@@ -148,7 +143,6 @@ struct
       , bgVertexBuffer = bgVertexBuffer
       , bgProgram = bgProgram
       , bgDrawLength = bgDrawLength
-      , drawMailbox = drawMailbox
       , window = window
       }
     end
@@ -166,7 +160,6 @@ struct
         , bgProgram
         , bgDrawLength = _
         , window
-        , drawMailbox
         } = shellState
 
       val _ = Gles3.bindBuffer bgVertexBuffer
@@ -182,7 +175,6 @@ struct
       , bgVertexBuffer = bgVertexBuffer
       , bgProgram = bgProgram
       , bgDrawLength = newBgDrawLength
-      , drawMailbox = drawMailbox
       , window = window
       }
     end
@@ -240,14 +232,8 @@ struct
 
   fun consumeDrawEvent (shellState, msg) =
     let
-      val
+      val {textVertexBuffer, textProgram, window, textDrawLength = _, ...} =
-        { textVertexBuffer
+        shellState
-        , textProgram
-        , window
-        , drawMailbox
-        , textDrawLength = _
-        , ...
-        } = shellState
     in
       case msg of
         REDRAW_TEXT textVec => uploadText (shellState, textVec)
@@ -256,15 +242,39 @@ struct
       | YANK str => yank (shellState, str)
     end
 
-  fun consumeDrawEvents (shellState as {drawMailbox, ...}: t) =
+  local
-    case Mailbox.recvPoll drawMailbox of
+    fun loop (pos, msgVec, shellState) =
-      NONE => shellState
+      if pos = Vector.length msgVec then
-    | SOME msg =>
+        shellState
-        let val shellState = consumeDrawEvent (shellState, msg)
+      else
-        in consumeDrawEvents shellState
+        let
+          val msg = Vector.sub (msgVec, pos)
+          val shellState = consumeDrawEvent (shellState, msg)
+        in
+          loop (pos + 1, msgVec, shellState)
+        end
+  in
+    fun consumeDrawEvents shellState =
+      loop (0, DrawMailbox.getMessagesAndClear (), shellState)
   end
 
-  fun helpLoop (shellState as {window, ...}: t) =
+  local
+    fun updateLoop (pos, msgVec, app) =
+      if pos = Vector.length msgVec then
+        app
+      else
+        let
+          val msg = Vector.sub (msgVec, pos)
+          val app = UpdateThread.update (app, msg)
+        in
+          updateLoop (pos + 1, msgVec, app)
+        end
+  in
+    fun update app =
+      updateLoop (0, InputMailbox.getMessagesAndClear (), app)
+  end
+
+  fun helpLoop (app, shellState as {window, ...}: t) =
     case Glfw.windowShouldClose window of
       false =>
         let
@@ -273,17 +283,18 @@ struct
           val _ = Gles3.clearColor (0.087, 0.095, 0.13, 1.0)
           val _ = Gles3.clear ()
 
+          val app = update app
           val _ = draw shellState
 
           val _ = Glfw.swapBuffers window
           val _ = Glfw.waitEvents ()
         in
-          helpLoop shellState
+          helpLoop (app, shellState)
         end
     | true => Glfw.terminate ()
 
-  fun loop (drawMailbox, window) =
+  fun loop (app, window) =
-    let val shellState = create (drawMailbox, window)
+    let val shellState = create window
-    in helpLoop shellState
+    in helpLoop (app, shellState)
     end
 end

shell/search-mailbox.sml

@@ -0,0 +1,2 @@
+structure SearchMailbox =
+struct open CML val mailbox: SearchMsg.t Mailbox.mbox = Mailbox.mailbox () end

shell/search-thread.sml

@@ -3,13 +3,13 @@ struct
   open CML
 
   (* Prerequisite to sending message: move buffer to end. *)
-  fun loop (searchMailbox, inputMailbox) =
+  fun loop () =
     let
-      val (buffer, searchString, time) = Mailbox.recv searchMailbox
+      val (buffer, searchString, time) = Mailbox.recv SearchMailbox.mailbox
       val searchList = SearchList.build (buffer, searchString)
       val msg = InputMsg.WITH_SEARCH_LIST (searchList, time)
-      val () = Mailbox.send (inputMailbox, msg)
+      val () = InputMailbox.append msg
     in
-      loop (searchMailbox, inputMailbox)
+      loop ()
     end
 end

shell/shell.sml

@@ -1,22 +1,16 @@
 structure Shell =
 struct
-  open CML
   open InputMsg
 
-  (* create mailboxes for CML communication *)
-  val inputMailbox = Mailbox.mailbox ()
-  val drawMailbox = Mailbox.mailbox ()
-  val searchMailbox = Mailbox.mailbox ()
-
   fun frameBufferSizeCallback (width, height) =
-    Mailbox.send (inputMailbox, RESIZE_EVENT (width, height))
+    InputMailbox.append (RESIZE_EVENT (width, height))
 
   fun charCallback word =
     let
       val word = Word32.toInt word
       val chr = Char.chr word
     in
-      Mailbox.send (inputMailbox, CHAR_EVENT chr)
+      InputMailbox.append (CHAR_EVENT chr)
     end
 
   fun keyCallback (key, scancode, action, mods) =
@@ -24,19 +18,19 @@ struct
       open Input
     in
       if key = KEY_ESC andalso action = PRESS andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.KEY_ESC)
+        InputMailbox.append (InputMsg.KEY_ESC)
       else if key = KEY_ENTER andalso action = PRESS andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.KEY_ENTER)
+        InputMailbox.append (InputMsg.KEY_ENTER)
       else if key = KEY_BACKSPACE andalso action <> RELEASE andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.KEY_BACKSPACE)
+        InputMailbox.append (InputMsg.KEY_BACKSPACE)
       else if key = KEY_ARROW_LEFT andalso action <> RELEASE andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.ARROW_LEFT)
+        InputMailbox.append (InputMsg.ARROW_LEFT)
       else if key = KEY_ARROW_RIGHT andalso action <> RELEASE andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.ARROW_RIGHT)
+        InputMailbox.append (InputMsg.ARROW_RIGHT)
       else if key = KEY_ARROW_UP andalso action <> RELEASE andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.ARROW_UP)
+        InputMailbox.append (InputMsg.ARROW_UP)
       else if key = KEY_ARROW_DOWN andalso action <> RELEASE andalso mods = 0 then
-        Mailbox.send (inputMailbox, InputMsg.ARROW_DOWN)
+        InputMailbox.append (InputMsg.ARROW_DOWN)
       else
         ()
     end
@@ -76,26 +70,10 @@ struct
       val _ = TextIO.closeIn io
       val app = AppType.init (lineGap, 1920, 1080, Time.now ())
 
-      (* todo: remove temp line below which tests search list *)
-      val app =
-        let
-          val buffer = #buffer app
-          val buffer = LineGap.goToStart buffer
-          val searchString = "val "
-          val searchList = SearchList.build (buffer, searchString)
-          val buffer = LineGap.goToStart buffer
-        in
-          NormalModeWith.searchList
-            (app, searchList, buffer, searchString, Time.now ())
-        end
-
       val () = registerCallbacks window
 
-      val _ = CML.spawn (fn () => GlDraw.loop (drawMailbox, window))
+      val _ = CML.spawn (fn () => GlDraw.loop (app, window))
-      val _ = CML.spawn (fn () =>
+      val _ = CML.spawn SearchThread.loop
-        UpdateThread.loop (app, inputMailbox, drawMailbox, searchMailbox))
-      val _ = CML.spawn (fn () =>
-        SearchThread.loop (searchMailbox, inputMailbox))
     in
       ()
     end

shell/update-thread.sml

@@ -4,32 +4,28 @@ struct
   open MailboxType
   open InputMsg
 
-  fun sendMsg (msg, drawMailbox, searchMailbox) =
+  fun sendMsg msg =
     case msg of
-      DRAW msg => Mailbox.send (drawMailbox, msg)
+      DRAW msg => DrawMailbox.append msg
     | SEARCH (buffer, searchString, time) =>
-        Mailbox.send (searchMailbox, (buffer, searchString, time))
+        Mailbox.send (SearchMailbox.mailbox, (buffer, searchString, time))
 
-  fun sendMsgs (msgList, drawMailbox, searchMailbox) =
+  fun sendMsgs msgList =
     case msgList of
-      hd :: tl =>
+      hd :: tl => let val () = sendMsg hd in sendMsgs tl end
-        let val _ = sendMsg (hd, drawMailbox, searchMailbox)
-        in sendMsgs (tl, drawMailbox, searchMailbox)
-        end
     | [] => ()
 
-  fun loop (app: AppType.app_type, inputMailbox, drawMailbox, searchMailbox) =
+  fun update (app: AppType.app_type, inputMsg) =
     let
       val time = Time.now ()
-      val inputMsg = Mailbox.recv inputMailbox
 
       val () = ExceptionLogger.addCommand inputMsg
 
       val app = AppUpdate.update (app, inputMsg, time)
                 handle e => ExceptionLogger.log e
 
-      val () = sendMsgs (#msgs app, drawMailbox, searchMailbox)
+      val () = sendMsgs (#msgs app)
     in
-      loop (app, inputMailbox, drawMailbox, searchMailbox)
+      app
     end
 end

shf.mlb

@@ -8,6 +8,7 @@ lib/cozette-sml/fonts/cozette-ascii.mlb
 (* FUNCTIONAL CORE *)
 message-types/input-msg.sml
 message-types/draw-msg.sml
+message-types/search-msg.sml
 message-types/mailbox-type.sml
 
 ann
@@ -73,6 +74,7 @@ in
 end
 shell/input-mailbox.sml
 shell/draw-mailbox.sml
+shell/search-mailbox.sml
 
 shell/exception-logger.sml
 shell/search-thread.sml