diff --git a/message-types/mailbox-type.sml b/message-types/mailbox-type.sml index 9d5619c..3e720b2 100644 --- a/message-types/mailbox-type.sml +++ b/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 diff --git a/message-types/search-msg.sml b/message-types/search-msg.sml new file mode 100644 index 0000000..4cc0316 --- /dev/null +++ b/message-types/search-msg.sml @@ -0,0 +1 @@ +structure SearchMsg = struct type t = LineGap.t * string * Time.time end diff --git a/shell/gl-draw.sml b/shell/gl-draw.sml index 95ae10b..017b919 100644 --- a/shell/gl-draw.sml +++ b/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 - { textVertexBuffer - , textProgram - , window - , drawMailbox - , textDrawLength = _ - , ... - } = shellState + val {textVertexBuffer, textProgram, window, 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) = - case Mailbox.recvPoll drawMailbox of - NONE => shellState - | SOME msg => - let val shellState = consumeDrawEvent (shellState, msg) - in consumeDrawEvents shellState + local + fun loop (pos, msgVec, shellState) = + if pos = Vector.length msgVec then + shellState + else + 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) = - let val shellState = create (drawMailbox, window) - in helpLoop shellState + fun loop (app, window) = + let val shellState = create window + in helpLoop (app, shellState) end end diff --git a/shell/search-mailbox.sml b/shell/search-mailbox.sml new file mode 100644 index 0000000..acad0e4 --- /dev/null +++ b/shell/search-mailbox.sml @@ -0,0 +1,2 @@ +structure SearchMailbox = +struct open CML val mailbox: SearchMsg.t Mailbox.mbox = Mailbox.mailbox () end diff --git a/shell/search-thread.sml b/shell/search-thread.sml index 945c211..f8b4f25 100644 --- a/shell/search-thread.sml +++ b/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 diff --git a/shell/shell.sml b/shell/shell.sml index e992cc6..17607d7 100644 --- a/shell/shell.sml +++ b/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 () => - UpdateThread.loop (app, inputMailbox, drawMailbox, searchMailbox)) - val _ = CML.spawn (fn () => - SearchThread.loop (searchMailbox, inputMailbox)) + val _ = CML.spawn (fn () => GlDraw.loop (app, window)) + val _ = CML.spawn SearchThread.loop in () end diff --git a/shell/update-thread.sml b/shell/update-thread.sml index a4550c7..4baf313 100644 --- a/shell/update-thread.sml +++ b/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 => - let val _ = sendMsg (hd, drawMailbox, searchMailbox) - in sendMsgs (tl, drawMailbox, searchMailbox) - end + hd :: tl => let val () = sendMsg hd in sendMsgs tl 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 diff --git a/shf.mlb b/shf.mlb index 0fd73e6..9de3ae1 100644 --- a/shf.mlb +++ b/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