bug fix when yanking or deleting inside a word (we should not clip 'high' value, and we should search for end of word strictly); this handles cases like when we only have one character in the buffer, or an empty buffer

This commit is contained in:
2025-09-06 01:12:59 +01:00
parent b9332bcd94
commit 73ec4e7578
5 changed files with 249 additions and 730 deletions

View File

@@ -619,6 +619,7 @@ struct
(* equivalent of vi's `e` command *)
val endOfWord = ViWordDfa.endOfCurrentWord
val endOfWordForDelete = ViWordDfa.endOfCurrentWordForDelete
val endOfWordStrict = ViWordDfa.endOfCurrentWordStrict
(* equivalent of vi's `E` command *)
val endOfWORD = ViCapsWordDfa.endOfCurrentWORD

View File

@@ -388,16 +388,23 @@ struct
helpDeleteToMatch (app, newCursorIdx, cursorIdx, time)
end
(* check if we are trying to delete from an empty buffer
* or a buffer which consists of only one character which is \n *)
fun canDeleteInsideOrAround (buffer, low, length) =
not (length = 1 andalso LineGap.substring (low, 1, buffer) = "\n")
fun deleteInsideWord (app: app_type, time) =
let
val {buffer, cursorIdx, searchString, ...} = app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val low = Cursor.prevWordStrict (buffer, cursorIdx, 1)
val high = Cursor.endOfWordForDelete (buffer, cursorIdx, 1)
val high = Cursor.endOfWordStrict (buffer, cursorIdx, 1) + 1
val buffer = LineGap.goToIdx (high, buffer)
val length = high - low
in
if low = high then
app
else
if canDeleteInsideOrAround (buffer, low, length) then
let
val length = high - low
val buffer = LineGap.delete (low, length, buffer)
@@ -414,20 +421,23 @@ struct
NormalFinish.buildTextAndClear
(app, buffer, low, searchList, initialMsg, time)
end
else
app
end
fun deleteInsideWORD (app: app_type, time) =
let
val {buffer, cursorIdx, searchString, ...} = app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val low = Cursor.prevWORDStrict (buffer, cursorIdx, 1)
val high = Cursor.endOfWORDForDelete (buffer, cursorIdx, 1)
val low = Cursor.prevWordStrict (buffer, cursorIdx, 1)
val high = Cursor.endOfWordStrict (buffer, cursorIdx, 1) + 1
val buffer = LineGap.goToIdx (high, buffer)
val length = high - low
in
if low = high then
app
else
if canDeleteInsideOrAround (buffer, low, length) then
let
val length = high - low
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
@@ -442,6 +452,8 @@ struct
NormalFinish.buildTextAndClear
(app, buffer, low, searchList, initialMsg, time)
end
else
app
end
fun finishAfterDeleteInside (app: app_type, origLow, high, time) =

View File

@@ -107,201 +107,229 @@ struct
NormalModeWith.mode (app, mode, [])
end
fun parseDeleteInside (app, chr, time) =
case chr of
#"w" => NormalDelete.deleteInsideWord (app, time)
| #"W" => NormalDelete.deleteInsideWORD (app, time)
| #"(" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"[" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"{" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"<" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #")" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #"]" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #"}" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #">" => NormalDelete.deleteInsideChrClose (app, chr, time)
| _ => NormalFinish.clearMode app
fun parseDeleteAround (app, chr, time) =
case chr of
#"(" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"[" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"{" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"<" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #")" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #"]" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #"}" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #">" => NormalDelete.deleteAroundChrClose (app, chr, time)
| _ => NormalFinish.clearMode app
fun parseDeleteTerminal (str, count, app, chrCmd, time) =
case chrCmd of
(* terminal commands: require no input after *)
#"h" => NormalDelete.delete (app, count, Cursor.viH, time)
| #"l" => NormalDelete.delete (app, count, Cursor.viL, time)
(* vi's 'j' and 'k' commands move up or down a column
* but 'dj' or 'dk' delete whole lines
* so their implementation differs from
* other cursor motions *)
| #"j" => NormalDelete.deleteLine (app, count + 1, time)
| #"k" => NormalDelete.deleteLineBack (app, count, time)
| #"w" => NormalDelete.deleteByDfa (app, count, Cursor.nextWord, time)
| #"W" => NormalDelete.deleteByDfa (app, count, Cursor.nextWORD, time)
| #"b" => NormalDelete.deleteByDfa (app, count, Cursor.prevWord, time)
| #"B" => NormalDelete.deleteByDfa (app, count, Cursor.prevWORD, time)
| #"e" =>
NormalDelete.deleteByDfa (app, count, Cursor.endOfWordForDelete, time)
| #"E" =>
NormalDelete.deleteByDfa (app, count, Cursor.endOfWORDForDelete, time)
| #"0" => NormalDelete.delete (app, 1, Cursor.vi0, time)
| #"$" => NormalDelete.deleteToEndOfLine (app, time)
| #"^" => NormalDelete.deleteToFirstNonSpaceChr (app, time)
| #"d" => NormalDelete.deleteLine (app, count, time)
| #"n" => NormalDelete.deleteToNextMatch (app, count, time)
| #"N" => NormalDelete.deleteToPrevMatch (app, count, time)
| #"%" => NormalDelete.deletePair (app, time)
(* non-terminal commands which require appending chr *)
| #"t" => appendChr (app, chrCmd, str)
| #"T" => appendChr (app, chrCmd, str)
| #"f" => appendChr (app, chrCmd, str)
| #"F" => appendChr (app, chrCmd, str)
| #"g" => appendChr (app, chrCmd, str)
| #"i" => appendChr (app, chrCmd, str)
| #"a" => appendChr (app, chrCmd, str)
(* invalid command: reset mode *)
| _ => NormalFinish.clearMode app
fun parseDeleteGo (app, count, chrCmd, time) =
case chrCmd of
#"e" => NormalDelete.deleteToEndOfPrevWord (app, count, time)
| #"E" => NormalDelete.deleteToEndOfPrevWORD (app, count, time)
| #"g" => NormalDelete.deleteToStart (app, time)
| _ => NormalFinish.clearMode app
fun parseDelete (strPos, str, count, app, chrCmd, time) =
if strPos = String.size str - 1 then
parseDeleteTerminal (str, count, app, chrCmd, time)
else
(* have to continue parsing string *)
case String.sub (str, strPos + 1) of
#"t" =>
NormalDelete.deleteToChr
(app, 1, Cursor.tillNextChr, op+, chrCmd, time)
| #"T" =>
NormalDelete.deleteToChr
(app, 1, Cursor.tillPrevChr, op-, chrCmd, time)
| #"f" =>
NormalDelete.deleteToChr
(app, count, Cursor.toNextChr, op+, chrCmd, time)
| #"F" =>
NormalDelete.deleteToChr
(app, count, Cursor.toPrevChr, op-, chrCmd, time)
| #"g" => parseDeleteGo (app, count, chrCmd, time)
| #"i" => parseDeleteInside (app, chrCmd, time)
| #"a" => parseDeleteAround (app, chrCmd, time)
structure ParseDelete =
struct
fun parseDeleteInside (app, chr, time) =
case chr of
#"w" => NormalDelete.deleteInsideWord (app, time)
| #"W" => NormalDelete.deleteInsideWORD (app, time)
| #"(" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"[" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"{" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"<" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #")" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #"]" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #"}" => NormalDelete.deleteInsideChrClose (app, chr, time)
| #">" => NormalDelete.deleteInsideChrClose (app, chr, time)
| _ => NormalFinish.clearMode app
fun yankWhenMovingBack (app: app_type, fMove, count) =
let
open DrawMsg
open MailboxType
fun parseDeleteAround (app, chr, time) =
case chr of
#"(" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"[" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"{" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #"<" => NormalDelete.deleteInsideChrOpen (app, chr, time)
| #")" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #"]" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #"}" => NormalDelete.deleteAroundChrClose (app, chr, time)
| #">" => NormalDelete.deleteAroundChrClose (app, chr, time)
| _ => NormalFinish.clearMode app
val {buffer, cursorIdx, ...} = app
fun parseDeleteTerminal (str, count, app, chrCmd, time) =
case chrCmd of
(* terminal commands: require no input after *)
#"h" => NormalDelete.delete (app, count, Cursor.viH, time)
| #"l" => NormalDelete.delete (app, count, Cursor.viL, time)
(* vi's 'j' and 'k' commands move up or down a column
* but 'dj' or 'dk' delete whole lines
* so their implementation differs from
* other cursor motions *)
| #"j" => NormalDelete.deleteLine (app, count + 1, time)
| #"k" => NormalDelete.deleteLineBack (app, count, time)
| #"w" => NormalDelete.deleteByDfa (app, count, Cursor.nextWord, time)
| #"W" => NormalDelete.deleteByDfa (app, count, Cursor.nextWORD, time)
| #"b" => NormalDelete.deleteByDfa (app, count, Cursor.prevWord, time)
| #"B" => NormalDelete.deleteByDfa (app, count, Cursor.prevWORD, time)
| #"e" =>
NormalDelete.deleteByDfa (app, count, Cursor.endOfWordForDelete, time)
| #"E" =>
NormalDelete.deleteByDfa (app, count, Cursor.endOfWORDForDelete, time)
| #"0" => NormalDelete.delete (app, 1, Cursor.vi0, time)
| #"$" => NormalDelete.deleteToEndOfLine (app, time)
| #"^" => NormalDelete.deleteToFirstNonSpaceChr (app, time)
| #"d" => NormalDelete.deleteLine (app, count, time)
| #"n" => NormalDelete.deleteToNextMatch (app, count, time)
| #"N" => NormalDelete.deleteToPrevMatch (app, count, time)
| #"%" => NormalDelete.deletePair (app, time)
(* non-terminal commands which require appending chr *)
| #"t" => appendChr (app, chrCmd, str)
| #"T" => appendChr (app, chrCmd, str)
| #"f" => appendChr (app, chrCmd, str)
| #"F" => appendChr (app, chrCmd, str)
| #"g" => appendChr (app, chrCmd, str)
| #"i" => appendChr (app, chrCmd, str)
| #"a" => appendChr (app, chrCmd, str)
(* invalid command: reset mode *)
| _ => NormalFinish.clearMode app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val low = fMove (buffer, cursorIdx, count)
fun parseDeleteGo (app, count, chrCmd, time) =
case chrCmd of
#"e" => NormalDelete.deleteToEndOfPrevWord (app, count, time)
| #"E" => NormalDelete.deleteToEndOfPrevWORD (app, count, time)
| #"g" => NormalDelete.deleteToStart (app, time)
| _ => NormalFinish.clearMode app
val length = cursorIdx - low
val str = LineGap.substring (low, length, buffer)
fun parseDelete (strPos, str, count, app, chrCmd, time) =
if strPos = String.size str - 1 then
parseDeleteTerminal (str, count, app, chrCmd, time)
else
(* have to continue parsing string *)
case String.sub (str, strPos + 1) of
#"t" =>
NormalDelete.deleteToChr
(app, 1, Cursor.tillNextChr, op+, chrCmd, time)
| #"T" =>
NormalDelete.deleteToChr
(app, 1, Cursor.tillPrevChr, op-, chrCmd, time)
| #"f" =>
NormalDelete.deleteToChr
(app, count, Cursor.toNextChr, op+, chrCmd, time)
| #"F" =>
NormalDelete.deleteToChr
(app, count, Cursor.toPrevChr, op-, chrCmd, time)
| #"g" => parseDeleteGo (app, count, chrCmd, time)
| #"i" => parseDeleteInside (app, chrCmd, time)
| #"a" => parseDeleteAround (app, chrCmd, time)
| _ => NormalFinish.clearMode app
end
val msg = YANK str
val mode = NORMAL_MODE ""
in
NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
structure ParseYank =
struct
fun yankWhenMovingBack (app: app_type, fMove, count) =
let
open DrawMsg
open MailboxType
fun yankWhenMovingForward (app: app_type, fMove, count) =
let
open DrawMsg
open MailboxType
val {buffer, cursorIdx, ...} = app
val {buffer, cursorIdx, ...} = app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val low = fMove (buffer, cursorIdx, count)
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val high = fMove (buffer, cursorIdx, count)
val length = cursorIdx - low
val str = LineGap.substring (low, length, buffer)
val buffer = LineGap.goToIdx (high, buffer)
val length = high - cursorIdx
val str = LineGap.substring (cursorIdx, length, buffer)
val msg = YANK str
val mode = NORMAL_MODE ""
in
NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
val msg = YANK str
val mode = NORMAL_MODE ""
in
NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
fun yankWhenMovingForward (app: app_type, fMove, count) =
let
open DrawMsg
open MailboxType
fun parseYankTerminal (str, count, app, chrCmd, time) =
case chrCmd of
(* motions like yh / yj / yk / yl are not really needed.
* Vim supports them, but I never use them.
* I also don't need yx (yank a character and then remove it)
* because I never do that. *)
#"y" => NormalYank.yankLine (app, count)
| #"0" => NormalYank.yankToStartOfLine app
| #"w" => NormalYank.yankWhenMovingForward (app, Cursor.nextWord, count)
| #"W" => NormalYank.yankWhenMovingForward (app, Cursor.nextWORD, count)
| #"b" => NormalYank.yankWhenMovingBack (app, Cursor.prevWord, count)
| #"B" => NormalYank.yankWhenMovingBack (app, Cursor.prevWORD, count)
| #"e" =>
NormalYank.yankWhenMovingForward (app, Cursor.endOfWordForDelete, count)
| #"E" =>
NormalYank.yankWhenMovingForward (app, Cursor.endOfWORDForDelete, count)
| #"$" => NormalYank.yankWhenMovingForward (app, Cursor.viDlr, 1)
| #"^" => NormalYank.yankToFirstNonSpaceChr app
| #"G" => NormalYank.yankToEndOfText app
| #"%" => NormalYank.yankToMatchingPair app
| #"n" => NormalYank.yankToNextMatch (app, count)
| #"N" => NormalYank.yankToPrevMatch (app, count)
(* append non-terminal characters to string *)
| #"d" =>
let (* 'yd' motion, like 'ydw'; meant to be 'yank then delete' *)
in appendChr (app, chrCmd, str)
end
| #"t" => appendChr (app, chrCmd, str)
| #"T" => appendChr (app, chrCmd, str)
| #"f" => appendChr (app, chrCmd, str)
| #"F" => appendChr (app, chrCmd, str)
| #"g" => appendChr (app, chrCmd, str)
| #"i" => appendChr (app, chrCmd, str)
| #"a" => appendChr (app, chrCmd, str)
| _ => NormalFinish.clearMode app
val {buffer, cursorIdx, ...} = app
fun parseYankGo (count, app, chrCmd) =
case chrCmd of
#"e" =>
NormalYank.yankWhenMovingBackPlusOne (app, Cursor.endOfPrevWord, count)
| #"E" =>
NormalYank.yankWhenMovingBackPlusOne (app, Cursor.endOfPrevWORD, count)
| #"g" => NormalYank.yankToStart app
| _ => NormalFinish.clearMode app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val high = fMove (buffer, cursorIdx, count)
fun parseYank (strPos, str, count, app, chrCmd, time) =
if strPos = String.size str - 1 then
parseYankTerminal (str, count, app, chrCmd, time)
else
(* todo: handle non-terminal characters *)
case String.sub (str, strPos + 1) of
#"t" => NormalYank.yankToChr (app, 1, Cursor.tillNextChr, op+, chrCmd)
| #"T" => NormalYank.yankToChr (app, 1, Cursor.tillPrevChr, op-, chrCmd)
| #"f" => NormalYank.yankToChr (app, count, Cursor.toNextChr, op+, chrCmd)
| #"F" => NormalYank.yankToChr (app, count, Cursor.toPrevChr, op-, chrCmd)
| #"g" => parseYankGo (count, app, chrCmd)
val buffer = LineGap.goToIdx (high, buffer)
val length = high - cursorIdx
val str = LineGap.substring (cursorIdx, length, buffer)
val msg = YANK str
val mode = NORMAL_MODE ""
in
NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
fun parseYankTerminal (str, count, app, chrCmd, time) =
case chrCmd of
(* motions like yh / yj / yk / yl are not really needed.
* Vim supports them, but I never use them.
* I also don't need yx (yank a character and then remove it)
* because I never do that. *)
#"y" => NormalYank.yankLine (app, count)
| #"0" => NormalYank.yankToStartOfLine app
| #"w" => NormalYank.yankWhenMovingForward (app, Cursor.nextWord, count)
| #"W" => NormalYank.yankWhenMovingForward (app, Cursor.nextWORD, count)
| #"b" => NormalYank.yankWhenMovingBack (app, Cursor.prevWord, count)
| #"B" => NormalYank.yankWhenMovingBack (app, Cursor.prevWORD, count)
| #"e" =>
NormalYank.yankWhenMovingForward
(app, Cursor.endOfWordForDelete, count)
| #"E" =>
NormalYank.yankWhenMovingForward
(app, Cursor.endOfWORDForDelete, count)
| #"$" => NormalYank.yankWhenMovingForward (app, Cursor.viDlr, 1)
| #"^" => NormalYank.yankToFirstNonSpaceChr app
| #"G" => NormalYank.yankToEndOfText app
| #"%" => NormalYank.yankToMatchingPair app
| #"n" => NormalYank.yankToNextMatch (app, count)
| #"N" => NormalYank.yankToPrevMatch (app, count)
(* append non-terminal characters to string *)
| #"d" =>
let (* 'yd' motion, like 'ydw'; meant to be 'yank then delete' *)
in appendChr (app, chrCmd, str)
end
| #"t" => appendChr (app, chrCmd, str)
| #"T" => appendChr (app, chrCmd, str)
| #"f" => appendChr (app, chrCmd, str)
| #"F" => appendChr (app, chrCmd, str)
| #"g" => appendChr (app, chrCmd, str)
| #"i" => appendChr (app, chrCmd, str)
| #"a" => appendChr (app, chrCmd, str)
| _ => NormalFinish.clearMode app
fun parseYankGo (count, app, chrCmd) =
case chrCmd of
#"e" =>
NormalYank.yankWhenMovingBackPlusOne
(app, Cursor.endOfPrevWord, count)
| #"E" =>
NormalYank.yankWhenMovingBackPlusOne
(app, Cursor.endOfPrevWORD, count)
| #"g" => NormalYank.yankToStart app
| _ => NormalFinish.clearMode app
fun parseYankInside (app, chr) =
case chr of
#"w" => NormalYank.yankInsideWord app
(*
| #"i" =>
| #"a" =>
| #"d" =>
| #"W" => NormalDelete.deleteInsideWORD app
| #"(" => NormalDelete.deleteInsideChrOpen (app, chr)
| #"[" => NormalDelete.deleteInsideChrOpen (app, chr)
| #"{" => NormalDelete.deleteInsideChrOpen (app, chr)
| #"<" => NormalDelete.deleteInsideChrOpen (app, chr)
| #")" => NormalDelete.deleteInsideChrClose (app, chr)
| #"]" => NormalDelete.deleteInsideChrClose (app, chr)
| #"}" => NormalDelete.deleteInsideChrClose (app, chr)
| #">" => NormalDelete.deleteInsideChrClose (app, chr)
*)
| _ => NormalFinish.clearMode app
fun parseYank (strPos, str, count, app, chrCmd, time) =
if strPos = String.size str - 1 then
parseYankTerminal (str, count, app, chrCmd, time)
else
(* todo: handle non-terminal characters *)
case String.sub (str, strPos + 1) of
#"t" => NormalYank.yankToChr (app, 1, Cursor.tillNextChr, op+, chrCmd)
| #"T" => NormalYank.yankToChr (app, 1, Cursor.tillPrevChr, op-, chrCmd)
| #"f" =>
NormalYank.yankToChr (app, count, Cursor.toNextChr, op+, chrCmd)
| #"F" =>
NormalYank.yankToChr (app, count, Cursor.toPrevChr, op-, chrCmd)
| #"g" => parseYankGo (count, app, chrCmd)
| #"i" => parseYankInside (app, chrCmd)
(*
| #"a" =>
| #"d" =>
*)
| _ => NormalFinish.clearMode app
end
(* useful reference as list of non-terminal commands *)
fun parseAfterCount (strPos, str, count, app, chrCmd, time) =
(* we are trying to parse multi-char but non-terminal strings here.
@@ -320,8 +348,8 @@ struct
| #"T" =>
(* to just before chr, backward *)
parseMoveToChr (1, app, Cursor.tillPrevChr, chrCmd)
| #"y" => (* yank *) parseYank (strPos, str, count, app, chrCmd, time)
| #"d" => (* delete *) parseDelete (strPos, str, count, app, chrCmd, time)
| #"y" => ParseYank.parseYank (strPos, str, count, app, chrCmd, time)
| #"d" => ParseDelete.parseDelete (strPos, str, count, app, chrCmd, time)
| #"f" =>
(* to chr, forward *)
parseMoveToChr (count, app, Cursor.toNextChr, chrCmd)

View File

@@ -257,4 +257,23 @@ struct
in
NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
fun yankInsideWord (app: app_type) =
let
val {buffer, cursorIdx, searchString, ...} = app
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val low = Cursor.prevWordStrict (buffer, cursorIdx, 1)
val high = Cursor.endOfWordStrict (buffer, cursorIdx, 1)
val high = high + 1
val buffer = LineGap.goToIdx (high, buffer)
val length = high - low
val str = LineGap.substring (low, length, buffer)
val msg = YANK str
val mode = NORMAL_MODE ""
in
if str = "\n" then app
else NormalModeWith.modeAndBuffer (app, buffer, mode, [DRAW msg])
end
end

541
temp.txt
View File

@@ -1,542 +1 @@
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