humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

create text builder with highlight

Browse Source
This commit is contained in:
Humza Shahid
2025-09-12 10:42:13 +01:00
parent b6de188f7d
commit 9254fa9f5c
4 changed files with 317 additions and 234 deletions
Download Patch File Download Diff File Expand all files Collapse all files

233
fcore/text-builder.sml
View File

@@ -3,238 +3,6 @@ struct
structure TC = TextConstants structure TC = TextConstants
structure Utils = TextBuilderUtils structure Utils = TextBuilderUtils
fun buildTextString
( pos
, str
, acc
, posX
, posY
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env: Utils.env_data
) =
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 *)
buildTextString
( pos + 1
, str
, acc
, posX + xSpace
, posY
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
else
(* in cursor *)
let
val {r, g, b, fw, fh, ...} = env
val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b)
in
buildTextString
( pos + 1
, str
, acc
, posX + xSpace
, posY
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
| #"\n" =>
if posY + ySpace < #h env then
if absIdx <> cursorPos then
(* not in cursor position, so iterate like normal *)
buildTextString
( pos + 1
, str
, acc
, #startX env
, posY + ySpace
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
else
(* in cursor position, so build cursorAcc *)
let
val {r, g, b, fw, fh, ...} = env
val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b)
in
buildTextString
( pos + 1
, str
, acc
, #startX env
, posY + ySpace
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc, env)
| chr =>
let in
if absIdx <> cursorPos then
(* not equal to cursor *)
if posX + xSpace < #w env then
let
val {r, g, b, fw, fh, ...} = env
val chrVec = makeChr (chr, posX, posY, fw, fh, r, g, b)
val acc = chrVec :: acc
in
buildTextString
( pos + 1
, str
, acc
, posX + xSpace
, posY
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else if posY + ySpace < #h env then
let
val {r, g, b, fw, fh, ...} = env
val chrVec = makeChr
(chr, #startX env, posY + ySpace, fw, fh, r, g, b)
val acc = chrVec :: acc
in
buildTextString
( pos + 1
, str
, acc
, #startX env + xSpace
, posY + ySpace
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc, env)
else
(* equal to cursor *)
let
val {fw, fh, r, g, b, hr, hg, hb, ...} = env
val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b)
in
if posX + xSpace < #w env then
let
val chrVec = makeChr (chr, posX, posY, fw, fh, hr, hg, hb)
val acc = chrVec :: acc
in
(* can start building after cursor now,
* since cursor was built *)
buildTextString
( pos + 1
, str
, acc
, posX + xSpace
, posY
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else if posY + ySpace < #h env then
let
val chrVec = makeChr
(chr, #startX env, posY + ySpace, fw, fh, hr, hg, hb)
val acc = chrVec :: acc
in
(* can start building after cursor now,
* since cursor was built *)
buildTextString
( pos + 1
, str
, acc
, #startX env + xSpace
, posY + ySpace
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc, env)
end
end
else
(* change to searching in string's tl *)
case tl of
hd :: tl =>
buildTextString
( 0
, hd
, acc
, posX
, posY
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env
)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc, env)
fun isInSearchRange (absIdx, searchPos, searchList, searchLen) =
let val searchIdx = Vector.sub (searchList, searchPos)
in absIdx >= searchIdx andalso absIdx < searchIdx + searchLen
end
fun isAfterSearchRange (absIdx, searchPos, searchList, searchLen) =
let val searchIdx = Vector.sub (searchList, searchPos)
in absIdx >= searchIdx + searchLen
end
fun advanceSearchPos (absIdx, searchPos, searchList, searchLen) =
if isAfterSearchRange (absIdx, searchPos, searchList, searchLen) then
searchPos + 1
else
searchPos
local local
fun loop fun loop
(pos, str, posX, posY, endX, acc, floatWindowWidth, floatWindowHeight) = (pos, str, posX, posY, endX, acc, floatWindowWidth, floatWindowHeight) =
@@ -340,7 +108,6 @@ struct
, bgAcc , bgAcc
, env , env
) )
else if pos < String.size str then else if pos < String.size str then
case String.sub (str, pos) of case String.sub (str, pos) of
#" " => #" " =>

18
fcore/text-builder/text-builder-utils.sml
View File

@@ -34,7 +34,7 @@ struct
(* fw/fh = float window width and float window height *) (* fw/fh = float window width and float window height *)
, fw: Real32.real , fw: Real32.real
, fh: Real32.real , fh: Real32.real
, msgs: MailboxType.t list
, searchList: int vector , searchList: int vector
, searchLen: int , searchLen: int
} }
@@ -93,4 +93,20 @@ struct
, #cursorOnCharG env , #cursorOnCharG env
, #cursorOnCharB env , #cursorOnCharB env
) )
fun isInSearchRange
(absIdx, searchPos, {searchList, searchLen, ...}: env_data) =
let val searchIdx = Vector.sub (searchList, searchPos)
in absIdx >= searchIdx andalso absIdx < searchIdx + searchLen
end
fun isAfterSearchRange
(absIdx, searchPos, {searchList, searchLen, ...}: env_data) =
let val searchIdx = Vector.sub (searchList, searchPos)
in absIdx >= searchIdx + searchLen
end
fun advanceSearchPos (absIdx, searchPos, env) =
if isAfterSearchRange (absIdx, searchPos, env) then searchPos + 1
else searchPos
end end

299
fcore/text-builder/text-builder-with-highlight.sml Normal file
View File

@@ -0,0 +1,299 @@
structure TextBuilderWithHighlight =
struct
structure TC = TextConstants
structure Utils = TextBuilderUtils
fun goToFirstLineAfter
(stl, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc, searchPos) =
case (stl, ltl) of
(shd :: stl, lhd :: ltl) =>
if Vector.length lhd > 0 then
let
val lineOffset = Vector.sub (lhd, 0)
val strPos = lineOffset + 1
val absIdx = absIdx + strPos
val posY = posY + TC.ySpace
val lineNumber = lineNumber + 1
in
build
( strPos
, shd
, stl
, lhd
, ltl
, #startX env
, posY
, 0
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
)
end
else
(* keep looping until we find a linebreak *)
goToFirstLineAfter
( stl
, ltl
, posY
, lineNumber
, absIdx + String.size shd
, cursorIdx
, env
, acc
, searchPos
)
| (_, _) => acc
and skipToColumnStart
( pos
, str
, stl
, line
, ltl
, posY
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
) =
if Vector.length line = 0 then
let
(* get index of buffer after this string *)
val absIdx = absIdx - pos
val absIdx = absIdx + String.size str
in
goToFirstLineAfter
(stl, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc, searchPos)
end
else
(* bin search lines *)
let
val searchPos = BinSearch.equalOrMore (pos + 1, #searchList env)
in
if searchPos = Vector.length line then
(* next line is not in this node *)
let
val absIdx = absIdx - pos
val absIdx = absIdx + String.size str
in
goToFirstLineAfter
( stl
, ltl
, posY
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
)
end
else
let
val lineOffset = Vector.sub (line, searchPos)
val newStrPos = lineOffset + 1
val absIdx = absIdx - pos + newStrPos
val posY = posY + TC.ySpace
val lineNumber = lineNumber + 1
in
build
( newStrPos
, str
, stl
, line
, ltl
, #startX env
, posY
, 0
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
)
end
end
and build
( pos
, str
, stl
, line
, ltl
, posX
, posY
, column
, lineNumber
, absIdx
, cursorIdx
, env: Utils.env_data
, acc
, searchPos
) =
if searchPos = Vector.length (#searchList env) then
(* exhausted search list; call normal text-builder function *)
TextBuilderWithCursor.build
( pos
, str
, stl
, line
, ltl
, posX
, posY
, column
, lineNumber
, absIdx
, cursorIdx
, env
, acc
)
else if pos = String.size str then
case (stl, ltl) of
(str :: stl, line :: ltl) =>
build
( 0
, str
, stl
, line
, ltl
, posX
, posY
, column
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
)
| (_, _) => acc
else if column < #scrollColumnStart env then
skipToColumnStart
( pos
, str
, stl
, line
, ltl
, posY
, lineNumber
, absIdx
, cursorIdx
, env
, acc
, searchPos
)
else
let
val searchPos = Utils.advanceSearchPos (absIdx, searchPos, env)
in
if searchPos = Vector.length (#searchList env) then
(* another check to see if we exhausted the searchList *)
TextBuilderWithCursor.build
( pos
, str
, stl
, line
, ltl
, posX
, posY
, column
, lineNumber
, absIdx
, cursorIdx
, env
, acc
)
else
case String.sub (str, pos) of
#" " =>
let
val acc =
if absIdx = cursorIdx then
Utils.makeCursor (posX, posY, env) :: acc
else
acc
val acc =
if Utils.isInSearchRange (absIdx, searchPos, env) then
Utils.makeHighlight (posX, posY, env) :: acc
else
acc
in
build
( pos + 1
, str
, stl
, line
, ltl
, posX + TC.xSpace
, posY
, column + 1
, lineNumber
, absIdx + 1
, cursorIdx
, env
, acc
, searchPos
)
end
| #"\n" =>
let
val acc =
if absIdx = cursorIdx then
Utils.makeCursor (posX, posY, env) :: acc
else
acc
in
build
( pos + 1
, str
, stl
, line
, ltl
, #startX env
, posY + TC.ySpace
, 0
, lineNumber + 1
, absIdx + 1
, cursorIdx
, env
, acc
, searchPos
)
end
| chr =>
let
val acc =
if absIdx = cursorIdx then
Utils.makeCursor (posX, posY, env)
:: Utils.makeCursorOnChr (chr, posX, posY, env) :: acc
else if Utils.isInSearchRange (absIdx, searchPos, env) then
Utils.makeCursorOnChr (chr, posX, posY, env)
:: Utils.makeHighlight (posX, posY, env) :: acc
else
acc
in
build
( pos + 1
, str
, stl
, line
, ltl
, posX + TC.xSpace
, posY
, column + 1
, lineNumber
, absIdx + 1
, cursorIdx
, env
, acc
, searchPos
)
end
end
end

1
shf.mlb
View File

@@ -34,6 +34,7 @@ in
fcore/pipe-cursor.sml fcore/pipe-cursor.sml
fcore/text-builder/text-builder-utils.sml fcore/text-builder/text-builder-utils.sml
fcore/text-builder/text-builder-with-cursor.sml fcore/text-builder/text-builder-with-cursor.sml
fcore/text-builder/text-builder-with-highlight.sml
fcore/text-builder.sml fcore/text-builder.sml
fcore/cursor-dfa/make-dfa-loop.sml fcore/cursor-dfa/make-dfa-loop.sml
fcore/cursor-dfa/vi-word-dfa.sml fcore/cursor-dfa/vi-word-dfa.sml