diff --git a/fcore/persistent-vector.sml b/fcore/persistent-vector.sml new file mode 100644 index 0000000..e8af0ed --- /dev/null +++ b/fcore/persistent-vector.sml @@ -0,0 +1,82 @@ +structure PersistentVector = +struct + (* Clojure-style persistent vector, + * as intermediary data structure + * for building search list *) + datatype t = + BRANCH of t vector + | LEAF of int vector + + val maxSize = 32 + + val empty = LEAF #[] + + datatype append_result = APPEND of t | UPDATE of t + + fun helpAppend (key, tree) = + case tree of + BRANCH nodes => + let + val lastNode = Vector.sub (nodes, Vector.length nodes - 1) + in + case helpAppend (key, lastNode) of + UPDATE newLast => + let + val newNode = Vector.update + (nodes, Vector.length nodes - 1, newLast) + val newNode = BRANCH newNode + in + UPDATE newNode + end + | APPEND newVec => + if Vector.length nodes + 1 > maxSize then + let val newNode = BRANCH #[newVec] + in APPEND newNode + end + else + let + val newNodes = Vector.concat [nodes, #[newVec]] + val newNodes = BRANCH newNodes + in + UPDATE newNodes + end + end + | LEAF vec => + if Vector.length vec + 1 > maxSize then + let val newNode = LEAF #[key] + in APPEND newNode + end + else + let + val newNode = Vector.concat [vec, #[key]] + val newNode = LEAF newNode + in + UPDATE newNode + end + + fun append (key, tree) = + case helpAppend (key, tree) of + UPDATE t => t + | APPEND newNode => BRANCH #[tree, newNode] + + fun branchToList (pos, nodes, acc) = + if pos < 0 then + acc + else + let + val node = Vector.sub (nodes, pos) + val acc = helpToVector (node, acc) + in + branchToList (pos - 1, nodes, acc) + end + + and helpToVector (tree, acc) = + case tree of + BRANCH nodes => branchToList (Vector.length nodes - 1, nodes, acc) + | LEAF vec => vec :: acc + + fun toVector tree = + let val lst = helpToVector (tree, []) + in Vector.concat lst + end +end diff --git a/fcore/search-list.sml b/fcore/search-list.sml index 0a4d4da..8658719 100644 --- a/fcore/search-list.sml +++ b/fcore/search-list.sml @@ -2,162 +2,12 @@ structure SearchList = struct type t = int vector - structure PersistentVector = - struct - (* Clojure-style persistent vector, - * as intermediary data structure - * for building search list *) - datatype t = - BRANCH of t vector - | LEAF of int vector - - val maxSize = 32 - - val empty = LEAF (Vector.fromList []) - - datatype append_result = APPEND of t | UPDATE of t - - fun helpAppend (key, tree) = - case tree of - BRANCH nodes => - let - val lastNode = Vector.sub (nodes, Vector.length nodes - 1) - in - case helpAppend (key, lastNode) of - UPDATE newLast => - let - val newNode = Vector.update - (nodes, Vector.length nodes - 1, newLast) - val newNode = BRANCH newNode - in - UPDATE newNode - end - | APPEND newVec => - if Vector.length nodes + 1 > maxSize then - let val newNode = BRANCH #[newVec] - in APPEND newNode - end - else - let - val newNodes = Vector.concat [nodes, #[newVec]] - val newNodes = BRANCH newNodes - in - UPDATE newNodes - end - end - | LEAF vec => - if Vector.length vec + 1 > maxSize then - let val newNode = LEAF #[key] - in APPEND newNode - end - else - let - val newNode = Vector.concat [vec, #[key]] - val newNode = LEAF newNode - in - UPDATE newNode - end - - fun append (key, tree) = - case helpAppend (key, tree) of - UPDATE t => t - | APPEND newNode => BRANCH #[tree, newNode] - - fun branchToList (pos, nodes, acc) = - if pos < 0 then - acc - else - let - val node = Vector.sub (nodes, pos) - val acc = helpToVector (node, acc) - in - branchToList (pos - 1, nodes, acc) - end - - and helpToVector (tree, acc) = - case tree of - BRANCH nodes => branchToList (Vector.length nodes - 1, nodes, acc) - | LEAF vec => vec :: acc - - fun toVector tree = helpToVector (tree, []) - end - val empty = Vector.fromList [] - (* - * There is some slightly-unintuitive behaviour in most text - * search functionality, including in Firefox, Vim and kwrite. - * Say we have the text "abbabba" and we want to search for - * "abba". - * It looks like the search should highlight both - * "[abba]bba" and "abb[abba]" - * However, only the first of these two results is matched. - * This is not a bug, and the behaviour is consistent across - * different programs. - * - * In principle, we could match both, but we want to stick to the - * same behaviour found in other programs. - * Our search functionality here is implemented from back to - * front, from the last index of the buffer/string to index 0. - * So we can't avoid consing the second match. - * However, what we can do is filter the second match: - * if the foundIdx we wish to cons is a "first match" - * in this edge case, then we can remove the hd of the list - * and this will give us equivalent behaviour. - * - * This 'cons' function handles that edge case and abstracts over it. - * - * Todo: Handle another edge case: - * When we have a string like "abbabbabba" and search for "abba", - * there should be two results: "[abba]bb[abba]". - * However, the last result gets filtered out. - * *) - fun cons (foundIdx, searchStringSize, acc, lastFilteredIdx) = - case acc of - hd :: tl => - if foundIdx + searchStringSize >= hd then - case lastFilteredIdx of - ~1 => (foundIdx :: tl, hd) - | _ => - if hd + searchStringSize >= lastFilteredIdx then - (foundIdx :: lastFilteredIdx :: tl, hd) - else - (foundIdx :: tl, hd) - else - (foundIdx :: acc, lastFilteredIdx) - | [] => (foundIdx :: acc, lastFilteredIdx) - - fun searchStep - (pos, hd, absIdx, tl, acc, searchPos, searchString, lastFilteredIdx) = - if searchPos < 0 then - let - val (acc, lastFilteredIdx) = - cons (absIdx + 1, String.size searchString, acc, lastFilteredIdx) - in - searchStep - ( pos + 1 - , hd - , absIdx + 1 - , tl - , acc - , String.size searchString - 1 - , searchString - , lastFilteredIdx - ) - end - else if pos < 0 then + fun loopSearch (pos, hd, absIdx, tl, acc, searchPos, searchString) = + if pos = String.size hd then case tl of - hd :: tl => - searchStep - ( String.size hd - 1 - , hd - , absIdx - , tl - , acc - , searchPos - , searchString - , lastFilteredIdx - ) + hd :: tl => loopSearch (0, hd, absIdx, tl, acc, searchPos, searchString) | [] => acc else let @@ -165,54 +15,33 @@ struct val searchChr = String.sub (searchString, searchPos) in if bufferChr = searchChr then - searchStep - ( pos - 1 - , hd - , absIdx - 1 - , tl - , acc - , searchPos - 1 - , searchString - , lastFilteredIdx - ) + if searchPos + 1 = String.size searchString then + (* we fully matched the search string *) + let + val foundIdx = absIdx - String.size searchString + 1 + val acc = PersistentVector.append (foundIdx, acc) + in + loopSearch (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString) + end + else + loopSearch + (pos + 1, hd, absIdx + 1, tl, acc, searchPos + 1, searchString) + else if searchPos = 0 then + loopSearch (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString) else - searchStep - ( pos - 1 - , hd - , absIdx - 1 - , tl - , acc - , String.size searchString - 1 - , searchString - , lastFilteredIdx - ) + loopSearch (pos, hd, absIdx, tl, acc, 0, searchString) end - fun loopSearch (pos, hd, absIdx, tl, acc, searchString) = - let - val acc = searchStep - ( pos - , hd - , absIdx - , tl - , acc - , String.size searchString - 1 - , searchString - , ~1 - ) - in - Vector.fromList acc - end - - fun search (buffer: LineGap.t, searchString) = - let - val {leftStrings, idx = absIdx, ...} = buffer - in - case leftStrings of - hd :: tl => - loopSearch (String.size hd - 1, hd, absIdx - 1, tl, [], searchString) - | [] => empty - end + fun search ({rightStrings, leftStrings, ...}: LineGap.t, searchString) = + case rightStrings of + hd :: tl => + let + val result = loopSearch + (0, hd, 0, tl, PersistentVector.empty, 0, searchString) + in + PersistentVector.toVector result + end + | [] => empty (* Prerequisite: move buffer/LineGap to end *) fun build (buffer, searchString) = diff --git a/shell/shell.sml b/shell/shell.sml index ac4c8ac..4bc14dd 100644 --- a/shell/shell.sml +++ b/shell/shell.sml @@ -68,7 +68,7 @@ struct val app = let val buffer = #buffer app - val buffer = LineGap.goToEnd buffer + val buffer = LineGap.goToStart buffer val searchString = "abba" val searchList = SearchList.build (buffer, searchString) val buffer = LineGap.goToStart buffer diff --git a/shf.mlb b/shf.mlb index 145fce2..a4e7713 100644 --- a/shf.mlb +++ b/shf.mlb @@ -10,13 +10,15 @@ message-types/input-msg.sml message-types/draw-msg.sml message-types/mailbox-type.sml -fcore/bin-search.sml ann "allowVectorExps true" in - fcore/search-list.sml + fcore/persistent-vector.sml end +fcore/bin-search.sml +fcore/search-list.sml + fcore/app-type.sml fcore/app-with.sml diff --git a/temp.txt b/temp.txt index 858f89a..35f2bf3 100644 --- a/temp.txt +++ b/temp.txt @@ -1,543 +1 @@ -abbabbabbabba -signature TEXT_BUILDER = -aaron baron carrot durian - (* Prerequisite: LineGap is moved to requested line first. *) - val build: int * int * LineGap.t * int * int - -> MailboxType.t list -end - - - -structure TextBuilder :> TEXT_BUILDER = -struct - val xSpace = 13 - val xSpace3 = xSpace * 3 - val ySpace = 25 - val fontSize = 30.0 - - fun accToDrawMsg (textAcc, cursorAcc) = - let - open MailboxType - open DrawMsg - - val textAcc = Vector.concat textAcc - val cursorAcc = Vector.concat cursorAcc - - val textMsg = REDRAW_TEXT textAcc - val cursorMsg = REDRAW_CURSOR cursorAcc - in - [DRAW textMsg, DRAW cursorMsg] - end - - fun buildCursor (posX, posY, fWindowWidth, fWindowHeight, r, g, b) = - let - val left = posX + 9 - val left = Real32.fromInt left - val right = left + 12.0 - - val top = Real32.fromInt posY - val bottom = top + fontSize + 2.0 - - val halfHeight = fWindowHeight / 2.0 - val top = (~(top - halfHeight)) / halfHeight - val bottom = (~(bottom - halfHeight)) / halfHeight - - val halfWidth = fWindowWidth / 2.0 - val left = (left - halfWidth) / halfWidth - val right = (right - halfWidth) / halfWidth - - val vec = - #[ left, top, r, g, b - , right, top, r, g, b - , left, bottom, r, g, b - - , left, bottom, r, g, b - , right, bottom, r, g, b - , right, top, r, g, b - ] - in - [vec] - 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 *) - fun buildTextStringAfterCursor - ( pos, str, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) = - if pos < String.size str then - case String.sub (str, pos) of - #" " => - (* if space, then proceed forward one char - * without adding to acc *) - buildTextStringAfterCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - | #"\t" => - (* if tab, proceed forward one char, - * and jump visually forwards three chars *) - buildTextStringAfterCursor - ( pos + 1, str, acc, posX + xSpace3, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - | #"\n" => - (* if \n, move down vertically, and move to start horizontally - * assuming we have not exceeded the window's height. - * If we have exceeded the window's height, just return acc. *) - if posY + ySpace < windowHeight then - buildTextStringAfterCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - else - (* return if there is no more vertical space after line break *) - accToDrawMsg (acc, cursorAcc) - | #"\r" => - (* same as \n, except we also check if we are in a \r\n pair, - * and proceed two characters forward if so *) - if posY + ySpace < windowHeight then - if - pos < String.size str - 1 - andalso String.sub (str, pos + 1) = #"\n" - then - buildTextStringAfterCursor - ( pos + 2, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - else - buildTextStringAfterCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - else - (* return if there is no more vertical space after line break *) - accToDrawMsg (acc, cursorAcc) - | chr => - (* for any other character, add it to acc if there is space, - * and proceed forward one character in the string *) - let - val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) - in - if posX + xSpace < windowWidth then - (* if there is horizontal space, place char on the right *) - let - val chrVec = chrFun - (posX, posY, fontSize, fontSize, fWindowWidth, fWindowHeight, r, g, b) - val acc = chrVec :: acc - in - buildTextStringAfterCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - else if posY + ySpace < windowHeight then - (* if there is vertical space, place char down below at startX *) - let - val chrVec = chrFun - ( startX, posY + ySpace, fontSize, fontSize - , fWindowWidth, fWindowHeight - , r, g, b - ) - val acc = chrVec :: acc - in - buildTextStringAfterCursor - ( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - else - (* return if no space horizontally or vertically *) - accToDrawMsg (acc, cursorAcc) - end - else - (* if we reached the end of the string, - * call function to build next string *) - continueBuildTextLineGapAfterCursor - ( tl, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, cursorAcc - ) - - and continueBuildTextLineGapAfterCursor - ( strList, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, cursorAcc - ) = - case strList of - hd :: tl => - buildTextStringAfterCursor - ( 0, hd, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - | [] => accToDrawMsg (acc, cursorAcc) - - (* same as buildTextStringAfterCursor, except this keeps track of absolute - * index and cursor pos too *) - fun buildTextStringBeforeCursor - ( pos, str, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx, cursorPos, hr, hg, hb - ) = - if pos < String.size str then - case String.sub (str, pos) of - #" " => - buildTextStringBeforeCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - | #"\t" => - buildTextStringBeforeCursor - ( pos + 1, str, acc, posX + xSpace3, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - | #"\n" => - if posY + ySpace < windowHeight then - buildTextStringBeforeCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - else - accToDrawMsg (acc, []) - | #"\r" => - if posY + ySpace < windowHeight then - if - pos < String.size str - 1 - andalso String.sub (str, pos + 1) = #"\n" - then - buildTextStringBeforeCursor - ( pos + 2, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 2, cursorPos, hr, hg, hb - ) - else - buildTextStringBeforeCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - else - accToDrawMsg (acc, []) - | chr => - let - val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) - in - if posX + xSpace < windowWidth then - let - val chrVec = chrFun - (posX, posY, fontSize, fontSize, fWindowWidth, fWindowHeight, r, g, b) - val acc = chrVec :: acc - in - buildTextStringBeforeCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - end - else if posY + ySpace < windowHeight then - let - val chrVec = chrFun - ( startX, posY + ySpace, fontSize, fontSize - , fWindowWidth, fWindowHeight - , r, g, b - ) - val acc = chrVec :: acc - in - buildTextStringBeforeCursor - ( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, hr, hg, hb - ) - end - else - accToDrawMsg (acc, []) - end - else - continueBuildTextLineGapBeforeCursor - ( tl, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, absIdx, cursorPos, hr, hg, hb - ) - - and buildTextStringWithinCursor - ( pos, str, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx, cursorPos, cursorAcc, hr, hg, hb - ) = - if pos < String.size str then - case String.sub (str, pos) of - #" " => - (* if inside cursor, then create cursorAcc; - * else, just skip as usual *) - if absIdx <> cursorPos then - (* not in cursur *) - buildTextStringWithinCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - else - (* in cursor *) - let - val cursorAcc = buildCursor (posX, posY, fWindowWidth, fWindowHeight, r, g ,b) - in - buildTextStringAfterCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - | #"\t" => - (* todo: draw cursor if cursor is on tab - * but this is not a priority right now *) - buildTextStringWithinCursor - ( pos + 1, str, acc, posX + xSpace3, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - | #"\n" => - if posY + ySpace < windowHeight then - if absIdx <> cursorPos then - (* not in cursor position, so iterate like normal *) - buildTextStringWithinCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - else - (* in cursor position, so build cursorAcc - * and call AfterCursor function *) - if pos = String.size str - 1 andalso tl = [] then - (* if we are at end of lineGap, we want to build cursorAcc - * at different coordinates than usual *) - let - val cursorAcc = - buildCursor (startX, posY + ySpace, fWindowWidth, fWindowHeight, r, g, b) - in - accToDrawMsg (acc, cursorAcc) - end - else - let - val cursorAcc = buildCursor (posX, posY, fWindowWidth, fWindowHeight, r, g ,b) - in - buildTextStringAfterCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - else - accToDrawMsg (acc, cursorAcc) - | #"\r" => - if posY + ySpace < windowHeight then - if - pos < String.size str - 1 - andalso String.sub (str, pos + 1) = #"\n" - then - buildTextStringWithinCursor - ( pos + 2, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 2, cursorPos, cursorAcc, hr, hg, hb - ) - else - buildTextStringWithinCursor - ( pos + 1, str, acc, startX, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - else - accToDrawMsg (acc, cursorAcc) - | chr => - let - val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) - in - if absIdx <> cursorPos then - (* not equal to cursor *) - if posX + xSpace < windowWidth then - let - val chrVec = chrFun - (posX, posY, fontSize, fontSize, fWindowWidth, fWindowHeight, r, g, b) - val acc = chrVec :: acc - in - buildTextStringWithinCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - end - else if posY + ySpace < windowHeight then - let - val chrVec = chrFun - ( startX, posY + ySpace, fontSize, fontSize - , fWindowWidth, fWindowHeight - , r, g, b - ) - val acc = chrVec :: acc - in - buildTextStringWithinCursor - ( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx + 1, cursorPos, cursorAcc, hr, hg, hb - ) - end - else - accToDrawMsg (acc, cursorAcc) - else - (* equal to cursor *) - let - val cursorAcc = buildCursor (posX, posY, fWindowWidth, fWindowHeight, r, g ,b) - in - if posX + xSpace < windowWidth then - let - val chrVec = chrFun - ( posX, posY, fontSize, fontSize - , fWindowWidth, fWindowHeight - , hr, hg, hb - ) - val acc = chrVec :: acc - in - (* can start building after cursor now, - * since cursor was built *) - buildTextStringAfterCursor - ( pos + 1, str, acc, posX + xSpace, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - else if posY + ySpace < windowHeight then - let - val chrVec = chrFun - ( startX, posY + ySpace, fontSize, fontSize - , fWindowWidth, fWindowHeight - , hr, hg, hb - ) - val acc = chrVec :: acc - in - (* can start building after cursor now, - * since cursor was built *) - buildTextStringAfterCursor - ( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, cursorAcc - ) - end - else - accToDrawMsg (acc, cursorAcc) - end - end - - else - (* we have built cursor now, so can call after-cursor function - * to build rest of text *) - continueBuildTextLineGapAfterCursor - ( tl, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, cursorAcc - ) - - and continueBuildTextLineGapBeforeCursor - ( strList, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, absIdx, cursorPos, hr, hg, hb - ) = - case strList of - hd :: tl => - if cursorPos >= absIdx + cursorPos then - (* if end of string is before cursor *) - buildTextStringBeforeCursor - ( 0, hd, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx, cursorPos, hr, hg, hb - ) - else - (* if within cursor *) - buildTextStringWithinCursor - ( 0, hd, acc, posX, posY, startX - , windowWidth, windowHeight, fWindowWidth, fWindowHeight - , r, g, b, tl, absIdx, cursorPos, [], hr, hg, hb - ) - | [] => accToDrawMsg (acc, []) - - fun build - (startLine, cursorPos, lineGap: LineGap.t, windowWidth, windowHeight) = - let - val lineGap = LineGap.goToLine (startLine, lineGap) - val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = lineGap - in - case (rightStrings, rightLines) of - (rStrHd :: rStrTl, rLnHd :: _) => - let - (* get index of line to start building from *) - val startIdx = - if startLine > curLine then - let - val lnPos = startLine - curLine - 1 - val startIdx = Vector.sub (rLnHd, lnPos) - in - 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 - end - else - 0 - - val absIdx = curIdx + startIdx - - in - if cursorPos < curIdx + String.size rStrHd then - (* if cursor is within string *) - buildTextStringWithinCursor - ( startIdx, rStrHd, [] - , 5, 5, 5 - , windowWidth, windowHeight - , Real32.fromInt windowWidth, Real32.fromInt windowHeight - , 0.67, 0.51, 0.83 - , rStrTl, absIdx, cursorPos, [] - , 0.211, 0.219, 0.25 - ) - else - (* if cursor is after string *) - buildTextStringBeforeCursor - ( startIdx, rStrHd, [] - , 5, 5, 5 - , windowWidth, windowHeight - , Real32.fromInt windowWidth, Real32.fromInt windowHeight - , 0.67, 0.51, 0.83 - , rStrTl, absIdx, cursorPos - , 0.211, 0.219, 0.25 - ) - end - | (_, _) => - (* requested line goes beyond the buffer, - * so just return empty list as there is nothig - * else we can do. *) - [] - end -end +abbabbabbabbabba