From 704854c80fb094f6cd39d6826ac6cabdd6d9857f Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Thu, 7 Aug 2025 12:20:57 +0100 Subject: [PATCH] use concurrency for rebuilding search list after deletion so we don't block main thread on very, very large files --- fcore/app-update.sml | 113 +++++++++++++------- fcore/finish.sml | 7 +- fcore/move.sml | 4 +- fcore/text-builder.sml | 183 ++++++++++++++++++--------------- message-types/input-msg.sml | 8 +- message-types/mailbox-type.sml | 3 +- shell/search-thread.sml | 14 +++ shell/shell.sml | 5 +- shell/update-thread.sml | 19 ++-- shf.mlb | 1 + 10 files changed, 220 insertions(+), 137 deletions(-) create mode 100644 shell/search-thread.sml diff --git a/fcore/app-update.sml b/fcore/app-update.sml index 7c9a552..76834e2 100644 --- a/fcore/app-update.sml +++ b/fcore/app-update.sml @@ -9,6 +9,14 @@ struct fun clearMode app = AppWith.mode (app, NORMAL_MODE "", []) + fun withSearchList (app: app_type, searchList) = + let + val {buffer, searchString, cursorIdx, ...} = app + val app = AppWith.searchList (app, searchList, buffer, searchString) + in + Finish.buildTextAndClear (app, buffer, cursorIdx, searchList, []) + end + fun resizeText (app: app_type, newWidth, newHeight) = let val @@ -33,6 +41,7 @@ struct , newHeight , searchList , searchString + , [] ) in AppWith.bufferAndSize @@ -44,7 +53,8 @@ struct * where the cursor may possibly jump off window by a wide marigin. * Since the cursor may move away a lot, it is best to recenter. * *) - fun buildTextAndClearAfterChr (app: app_type, buffer, cursorIdx, searchList) = + fun buildTextAndClearAfterChr + (app: app_type, buffer, cursorIdx, searchList, initialMsg) = let val {windowWidth, windowHeight, startLine, searchString, ...} = app @@ -68,6 +78,7 @@ struct , windowHeight , searchList , searchString + , [] ) val mode = NORMAL_MODE "" @@ -104,6 +115,7 @@ struct , windowHeight , searchList , searchString + , [] ) in AppWith.bufferAndCursorIdx @@ -129,6 +141,7 @@ struct , windowHeight , searchList , searchString + , [] ) val mode = NORMAL_MODE "" @@ -169,6 +182,7 @@ struct , windowHeight , searchList , searchString + , [] ) val mode = NORMAL_MODE "" @@ -211,6 +225,7 @@ struct , windowHeight , searchList , searchString + , [] ) val mode = NORMAL_MODE "" @@ -253,6 +268,7 @@ struct , windowHeight , searchList , searchString + , [] ) in AppWith.bufferAndCursorIdx @@ -283,6 +299,7 @@ struct , windowHeight , searchList , searchString + , [] ) in AppWith.bufferAndCursorIdx @@ -309,12 +326,12 @@ struct val buffer = LineGap.goToIdx (cursorIdx, buffer) val cursorIdx = Cursor.firstNonSpaceChr (buffer, cursorIdx) in - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app) + Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) end fun helpMoveToChr (app: app_type, buffer, cursorIdx, count, fMove, chr) = if count = 0 then - buildTextAndClearAfterChr (app, buffer, cursorIdx, #searchList app) + buildTextAndClearAfterChr (app, buffer, cursorIdx, #searchList app, []) else let (* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *) @@ -335,6 +352,7 @@ struct CHAR_EVENT chr => moveToChr (app, count, fMove, chr) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) fun handleGo (count, app, newCmd) = case newCmd of @@ -346,12 +364,19 @@ struct | _ => clearMode app) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) (* text-delete functions *) (** equivalent of vi's 'x' command **) - fun helpRemoveChr (app: app_type, buffer, searchList, cursorIdx, count) = + fun helpRemoveChr (app: app_type, buffer, cursorIdx, count) = if count = 0 then - Finish.buildTextAndClear (app, buffer, cursorIdx, searchList) + let + val buffer = LineGap.goToEnd buffer + val initialMsg = [SEARCH (buffer, #searchString app)] + in + Finish.buildTextAndClear + (app, buffer, cursorIdx, SearchList.empty, initialMsg) + end else let val buffer = LineGap.goToIdx (cursorIdx, buffer) @@ -374,9 +399,9 @@ struct (* vi simply doesn't do anything on 'x' command * when cursor is at start of line, and next chr is line break * so skip to end of loop by passing count of 0 *) - helpRemoveChr (app, buffer, searchList, cursorIdx, 0) + helpRemoveChr (app, buffer, cursorIdx, 0) else if cursorIsStart then - helpRemoveChr (app, buffer, searchList, cursorIdx, 0) + helpRemoveChr (app, buffer, cursorIdx, 0) else if nextIsEnd then let (* delete char at cursor and then decrement cursorIdx by 1 @@ -384,8 +409,6 @@ struct val searchString = #searchString app val buffer = LineGap.delete (cursorIdx, 1, buffer) - val (buffer, searchList) = SearchList.build (buffer, searchString) - val cursorIdx = if Cursor.isPrevChrStartOfLine (buffer, cursorIdx) @@ -393,21 +416,19 @@ struct then cursorIdx else cursorIdx - 1 in - helpRemoveChr (app, buffer, searchList, cursorIdx, count - 1) + helpRemoveChr (app, buffer, cursorIdx, count - 1) end else let val searchString = #searchString app val buffer = LineGap.delete (cursorIdx, 1, buffer) - - val (buffer, searchList) = SearchList.build (buffer, searchString) in - helpRemoveChr (app, buffer, searchList, cursorIdx, count - 1) + helpRemoveChr (app, buffer, cursorIdx, count - 1) end end fun removeChr (app: app_type, count) = - helpRemoveChr (app, #buffer app, #searchList app, #cursorIdx app, count) + helpRemoveChr (app, #buffer app, #cursorIdx app, count) fun helpDelete (app: app_type, buffer, cursorIdx, otherIdx, count, fMove) = (* As a small optimisation to reduce allocations, @@ -426,8 +447,9 @@ struct val buffer = LineGap.delete (low, length, buffer) + val buffer = LineGap.goToEnd buffer val searchString = #searchString app - val (buffer, searchList) = SearchList.build (buffer, searchString) + val initialMsg = [SEARCH (buffer, searchString)] (* If we have deleted from the buffer so that cursorIdx * is no longer a valid idx, @@ -435,7 +457,8 @@ struct val buffer = LineGap.goToIdx (low, buffer) val cursorIdx = Cursor.clipIdx (buffer, low) in - Finish.buildTextAndClear (app, buffer, cursorIdx, searchList) + Finish.buildTextAndClear + (app, buffer, cursorIdx, SearchList.empty, initialMsg) end else let @@ -463,11 +486,12 @@ struct val buffer = LineGap.delete (low, length, buffer) - val (buffer, searchList) = SearchList.build (buffer, searchString) + val buffer = LineGap.goToEnd buffer + val initialMsg = [SEARCH (buffer, searchString)] val buffer = LineGap.goToIdx (low, buffer) in - Finish.buildTextAndClear (app, buffer, low, searchList) + Finish.buildTextAndClear (app, buffer, low, SearchList.empty, initialMsg) end fun deleteToEndOfLine (app: app_type) = @@ -489,12 +513,8 @@ struct val lastChr = Cursor.viDlr (buffer, cursorIdx, 1) val length = lastChr - cursorIdx val buffer = LineGap.delete (cursorIdx, length, buffer) - - (* delete from searchList and map *) - val searchString = #searchString app - val (buffer, searchList) = SearchList.build (buffer, searchString) in - helpRemoveChr (app, buffer, searchList, cursorIdx, 1) + helpRemoveChr (app, buffer, cursorIdx, 1) end end @@ -509,11 +529,13 @@ struct val length = finishIdx - startIdx val buffer = LineGap.delete (startIdx, length, buffer) - val (buffer, searchList) = SearchList.build (buffer, searchString) + val buffer = LineGap.goToEnd buffer + val initialMsg = [SEARCH (buffer, searchString)] val buffer = LineGap.goToIdx (startIdx, buffer) in - Finish.buildTextAndClear (app, buffer, startIdx, searchList) + Finish.buildTextAndClear + (app, buffer, startIdx, SearchList.empty, initialMsg) end fun helpDeleteLineBack (app, buffer, low, high, count) = @@ -523,12 +545,14 @@ struct val length = high - low val buffer = LineGap.delete (low, length, buffer) + val buffer = LineGap.goToEnd buffer val searchString = #searchString app - val (buffer, searchList) = SearchList.build (buffer, searchString) + val initialMsg = [SEARCH (buffer, searchString)] val buffer = LineGap.goToIdx (low, buffer) in - Finish.buildTextAndClear (app, buffer, low, searchList) + Finish.buildTextAndClear + (app, buffer, low, SearchList.empty, initialMsg) end else let @@ -575,9 +599,11 @@ struct val length = high - low val buffer = LineGap.delete (low, length, buffer) - val (buffer, searchList) = SearchList.build (buffer, searchString) + + val buffer = LineGap.goToEnd buffer + val initialMsg = [SEARCH (buffer, searchString)] in - Finish.buildTextAndClear (app, buffer, low, searchList) + Finish.buildTextAndClear (app, buffer, low, SearchList.empty, initialMsg) end fun helpDeleteToChr @@ -589,10 +615,12 @@ struct val length = high - low val buffer = LineGap.delete (low, length, buffer) + val buffer = LineGap.goToEnd buffer val searchString = #searchString app - val (buffer, searchList) = SearchList.build (buffer, searchString) + val initialMsg = [SEARCH (buffer, searchString)] in - buildTextAndClearAfterChr (app, buffer, low, searchList) + buildTextAndClearAfterChr + (app, buffer, low, SearchList.empty, initialMsg) end else let @@ -625,6 +653,9 @@ struct val buffer = LineGap.delete (0, cursorIdx, buffer) val (buffer, searchList) = SearchList.build (buffer, searchString) + val buffer = LineGap.goToEnd buffer + val initialMsg = [SEARCH (buffer, #searchString app)] + val cursorIdx = 0 val startLine = 0 val buffer = LineGap.goToIdx (cursorIdx, buffer) @@ -637,6 +668,7 @@ struct , windowHeight , searchList , searchString + , initialMsg ) val mode = NORMAL_MODE "" @@ -767,6 +799,7 @@ struct | _ => clearMode app) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) else (* have to continue parsing string *) case String.sub (str, strPos + 1) of @@ -776,27 +809,31 @@ struct CHAR_EVENT chr => deleteToChr (app, 1, Cursor.tillNextChr, op+, chr) | KEY_ESC => clearMode app - | RESIZE_EVENT (width, height) => resizeText (app, width, height)) + | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList)) | #"T" => (* delete till chr, backwards *) (case newCmd of CHAR_EVENT chr => deleteToChr (app, 1, Cursor.tillPrevChr, op-, chr) | KEY_ESC => clearMode app - | RESIZE_EVENT (width, height) => resizeText (app, width, height)) + | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList)) | #"f" => (case newCmd of CHAR_EVENT chr => deleteToChr (app, count, Cursor.toNextChr, op+, chr) | KEY_ESC => clearMode app - | RESIZE_EVENT (width, height) => resizeText (app, width, height)) + | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList)) | #"F" => (* delete to chr, backwards *) (case newCmd of CHAR_EVENT chr => deleteToChr (app, count, Cursor.toPrevChr, op-, chr) | KEY_ESC => clearMode app - | RESIZE_EVENT (width, height) => resizeText (app, width, height)) + | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList)) | #"g" => (* same events as handleGo *) (case newCmd of @@ -807,7 +844,8 @@ struct | #"g" => deleteToStart app | _ => clearMode app) | KEY_ESC => clearMode app - | RESIZE_EVENT (width, height) => resizeText (app, width, height)) + | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList)) | _ => clearMode app (* useful reference as list of non-terminal commands *) @@ -849,6 +887,7 @@ struct CHAR_EVENT chr => handleChr (app, 1, chr, str) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) else if String.size str = 1 then case newCmd of CHAR_EVENT chr => @@ -857,6 +896,7 @@ struct | NONE => parseAfterCount (0, str, 1, app, newCmd)) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) else let val numLength = getNumLength (0, str) @@ -872,6 +912,7 @@ struct CHAR_EVENT chr => handleChr (app, count, chr, str) | KEY_ESC => clearMode app | RESIZE_EVENT (width, height) => resizeText (app, width, height) + | WITH_SEARCH_LIST searchList => withSearchList (app, searchList) else (* continue parsing. *) parseAfterCount (numLength, str, count, app, newCmd) diff --git a/fcore/finish.sml b/fcore/finish.sml index f952d79..2084f8a 100644 --- a/fcore/finish.sml +++ b/fcore/finish.sml @@ -2,7 +2,7 @@ structure Finish = struct open AppType - fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList) = + fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList, msgs) = let val {windowWidth, windowHeight, startLine, searchString, ...} = app @@ -18,7 +18,7 @@ struct val buffer = LineGap.goToLine (startLine, buffer) val lineIdx = TextBuilder.getLineAbsIdx (startLine, buffer) - val drawMsg = TextBuilder.build + val msgs = TextBuilder.build ( startLine , cursorIdx , buffer @@ -26,11 +26,12 @@ struct , windowHeight , searchList , searchString + , msgs ) val mode = NORMAL_MODE "" in AppWith.bufferAndCursorIdx - (app, buffer, cursorIdx, mode, startLine, searchList, drawMsg) + (app, buffer, cursorIdx, mode, startLine, searchList, msgs) end end diff --git a/fcore/move.sml b/fcore/move.sml index 95db467..adc83d1 100644 --- a/fcore/move.sml +++ b/fcore/move.sml @@ -12,7 +12,7 @@ functor MakeMove(Fn: MOVE): MAKE_MOVE = struct fun helpMove (app: AppType.app_type, buffer, cursorIdx, count) = if count = 0 then - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app) + Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) else (* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *) let @@ -62,7 +62,7 @@ struct val buffer = LineGap.goToIdx (cursorIdx, buffer) val cursorIdx = Fn.fMove (buffer, cursorIdx, count) in - Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app) + Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, []) end end diff --git a/fcore/text-builder.sml b/fcore/text-builder.sml index d77b39c..15bd67b 100644 --- a/fcore/text-builder.sml +++ b/fcore/text-builder.sml @@ -4,43 +4,22 @@ sig val getLineAbsIdx: int * LineGap.t -> int (* Prerequisites: LineGap is moved to requested line first. *) - val build: int * int * LineGap.t * int * int * SearchList.t * string - -> MailboxType.t list + val build: + int + * int + * LineGap.t + * int + * int + * SearchList.t + * string + * MailboxType.t list + -> MailboxType.t list end structure TextBuilder :> TEXT_BUILDER = struct open TextConstants - fun accToDrawMsg (textAcc, cursorAcc, bgAcc) = - let - open MailboxType - open DrawMsg - - val textAcc = Vector.concat textAcc - val bgAcc = Vector.concat bgAcc - - val textMsg = REDRAW_TEXT textAcc - val cursorMsg = REDRAW_CURSOR cursorAcc - val bgMsg = REDRAW_BG bgAcc - in - [DRAW bgMsg, DRAW textMsg, DRAW cursorMsg] - end - - (* builds text from a string with char-wrap. - * char-wrap is a similar concept to word-wrap, - * but it breaks on character in the middle of a word. - * - * Will likely want multiple versions of these two mutually recursive - * functions for each selection and cursor type: - * cursor over an individual character, - * range selection where multiple characters are selected, etc. - * - * Todo: - * - Possibly add visual horizontal indentation when char-wrap occurs - * on an indented line *) - (* same as buildTextStringAfterCursor, except this keeps track of absolute - * index and cursor pos too *) type env_data = { r: Real32.real , g: Real32.real @@ -57,8 +36,40 @@ struct (* fw/fh = float window width and float window height *) , fw: Real32.real , fh: Real32.real + , msgs: MailboxType.t list } + fun accToDrawMsg (textAcc, cursorAcc, bgAcc, env: env_data) = + let + open MailboxType + open DrawMsg + + val msgs = #msgs env + + val textAcc = Vector.concat textAcc + val bgAcc = Vector.concat bgAcc + + val textMsg = REDRAW_TEXT textAcc + val cursorMsg = REDRAW_CURSOR cursorAcc + val bgMsg = REDRAW_BG bgAcc + in + DRAW bgMsg :: DRAW textMsg :: DRAW cursorMsg :: msgs + end + + (* builds text from a string with char-wrap. + * char-wrap is a similar concept to word-wrap, + * but it breaks on character in the middle of a word. + * + * Will likely want multiple versions of these two mutually recursive + * functions for each selection and cursor type: + * cursor over an individual character, + * range selection where multiple characters are selected, etc. + * + * Todo: + * - Possibly add visual horizontal indentation when char-wrap occurs + * on an indented line *) + (* same as buildTextStringAfterCursor, except this keeps track of absolute + * index and cursor pos too *) fun buildTextString ( pos , str @@ -159,7 +170,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) | chr => let val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) @@ -213,7 +224,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) else (* equal to cursor *) let @@ -278,7 +289,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) end end else @@ -299,7 +310,7 @@ struct , bgAcc , env ) - | [] => accToDrawMsg (acc, cursorAcc, bgAcc) + | [] => accToDrawMsg (acc, cursorAcc, bgAcc, env) fun isInSearchRange (absIdx, searchPos, searchHd, searchLen) = let val searchIdx = Vector.sub (searchHd, searchPos) @@ -329,21 +340,21 @@ struct , searchLen ) = if searchPos = Vector.length searchHd then - (* exhausted search list so call normal build function *) - buildTextString - ( pos - , str - , acc - , posX - , posY - , startX - , tl - , absIdx - , cursorPos - , cursorAcc - , bgAcc - , env - ) + (* exhausted search list so call normal build function *) + buildTextString + ( pos + , str + , acc + , posX + , posY + , startX + , tl + , absIdx + , cursorPos + , cursorAcc + , bgAcc + , env + ) else if pos < String.size str then case String.sub (str, pos) of #" " => @@ -474,7 +485,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) | chr => let val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) @@ -582,7 +593,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) else (* equal to cursor *) let @@ -652,7 +663,7 @@ struct ) end else - accToDrawMsg (acc, cursorAcc, bgAcc) + accToDrawMsg (acc, cursorAcc, bgAcc, env) end end else @@ -676,7 +687,7 @@ struct , searchPos , searchLen ) - | [] => accToDrawMsg (acc, cursorAcc, bgAcc) + | [] => accToDrawMsg (acc, cursorAcc, bgAcc, env) (* gets line start idx, relative to right hd *) fun helpGetLineStartIdx (startLine, curLine, rLnHd) = @@ -718,6 +729,7 @@ struct , windowHeight , searchList: SearchList.t , searchString + , msgs ) = let val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = @@ -742,44 +754,45 @@ struct , hr = 0.211 , hg = 0.219 , hb = 0.25 + , msgs = msgs } val cursorAcc = Vector.fromList [] val searchPos = BinSearch.equalOrMore (absIdx, searchList) in if searchPos < Vector.length searchList then - buildTextStringSearch - ( startIdx - , rStrHd - , [] - , 5 - , 5 - , 5 - , rStrTl - , absIdx - , cursorPos - , cursorAcc - , [] - , env - , searchList - , searchPos - , String.size searchString - ) + buildTextStringSearch + ( startIdx + , rStrHd + , [] + , 5 + , 5 + , 5 + , rStrTl + , absIdx + , cursorPos + , cursorAcc + , [] + , env + , searchList + , searchPos + , String.size searchString + ) else - buildTextString - ( startIdx - , rStrHd - , [] - , 5 - , 5 - , 5 - , rStrTl - , absIdx - , cursorPos - , cursorAcc - , [] - , env - ) + buildTextString + ( startIdx + , rStrHd + , [] + , 5 + , 5 + , 5 + , rStrTl + , absIdx + , cursorPos + , cursorAcc + , [] + , env + ) end | (_, _) => (* requested line goes beyond the buffer, diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index a9690b8..1bfe038 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -1,2 +1,8 @@ structure InputMsg = -struct datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int end +struct + datatype t = + CHAR_EVENT of char + | KEY_ESC + | RESIZE_EVENT of int * int + | WITH_SEARCH_LIST of int vector +end diff --git a/message-types/mailbox-type.sml b/message-types/mailbox-type.sml index c7f5749..f08bd9d 100644 --- a/message-types/mailbox-type.sml +++ b/message-types/mailbox-type.sml @@ -1 +1,2 @@ -structure MailboxType = struct datatype t = DRAW of DrawMsg.t end +structure MailboxType = +struct datatype t = DRAW of DrawMsg.t | SEARCH of LineGap.t * string end diff --git a/shell/search-thread.sml b/shell/search-thread.sml new file mode 100644 index 0000000..1abd7a3 --- /dev/null +++ b/shell/search-thread.sml @@ -0,0 +1,14 @@ +structure SearchThread = +struct + open CML + + (* Prerequisite to sending message: move buffer to end. *) + fun loop (searchMailbox, inputMailbox) = + let + val (buffer, searchString) = Mailbox.recv searchMailbox + val (_, searchList) = SearchList.build (buffer, searchString) + val () = Mailbox.send (inputMailbox, InputMsg.WITH_SEARCH_LIST searchList) + in + loop (searchMailbox, inputMailbox) + end +end diff --git a/shell/shell.sml b/shell/shell.sml index f6c325b..a14fa0f 100644 --- a/shell/shell.sml +++ b/shell/shell.sml @@ -6,6 +6,7 @@ struct (* 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)) @@ -79,7 +80,9 @@ struct val _ = CML.spawn (fn () => GlDraw.loop (drawMailbox, window)) val _ = CML.spawn (fn () => - UpdateThread.loop (app, inputMailbox, drawMailbox)) + UpdateThread.loop (app, inputMailbox, drawMailbox, searchMailbox)) + val _ = CML.spawn (fn () => + SearchThread.loop (searchMailbox, inputMailbox)) in () end diff --git a/shell/update-thread.sml b/shell/update-thread.sml index 1dfdb20..313f5d3 100644 --- a/shell/update-thread.sml +++ b/shell/update-thread.sml @@ -4,18 +4,21 @@ struct open MailboxType open InputMsg - fun sendMsg (msg, drawMailbox) = - case msg of DRAW msg => Mailbox.send (drawMailbox, msg) + fun sendMsg (msg, drawMailbox, searchMailbox) = + case msg of + DRAW msg => Mailbox.send (drawMailbox, msg) + | SEARCH (buffer, searchString) => + Mailbox.send (searchMailbox, (buffer, searchString)) - fun sendMsgs (msgList, drawMailbox) = + fun sendMsgs (msgList, drawMailbox, searchMailbox) = case msgList of hd :: tl => - let val _ = sendMsg (hd, drawMailbox) - in sendMsgs (tl, drawMailbox) + let val _ = sendMsg (hd, drawMailbox, searchMailbox) + in sendMsgs (tl, drawMailbox, searchMailbox) end | [] => () - fun loop (app: AppType.app_type, inputMailbox, drawMailbox) = + fun loop (app: AppType.app_type, inputMailbox, drawMailbox, searchMailbox) = let val inputMsg = Mailbox.recv inputMailbox val () = @@ -33,8 +36,8 @@ struct val app = AppUpdate.update (app, inputMsg) handle e => ExceptionLogger.log e - val () = sendMsgs (#msgs app, drawMailbox) + val () = sendMsgs (#msgs app, drawMailbox, searchMailbox) in - loop (app, inputMailbox, drawMailbox) + loop (app, inputMailbox, drawMailbox, searchMailbox) end end diff --git a/shf.mlb b/shf.mlb index 9ffb928..5cc8018 100644 --- a/shf.mlb +++ b/shf.mlb @@ -47,6 +47,7 @@ in end shell/exception-logger.sml +shell/search-thread.sml shell/update-thread.sml shell/gl-shaders.sml shell/gl-draw.sml