create text builder with highlight
This commit is contained in:
@@ -3,238 +3,6 @@ struct
|
||||
structure TC = TextConstants
|
||||
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
|
||||
fun loop
|
||||
(pos, str, posX, posY, endX, acc, floatWindowWidth, floatWindowHeight) =
|
||||
@@ -340,7 +108,6 @@ struct
|
||||
, bgAcc
|
||||
, env
|
||||
)
|
||||
|
||||
else if pos < String.size str then
|
||||
case String.sub (str, pos) of
|
||||
#" " =>
|
||||
|
||||
@@ -34,7 +34,7 @@ struct
|
||||
(* fw/fh = float window width and float window height *)
|
||||
, fw: Real32.real
|
||||
, fh: Real32.real
|
||||
, msgs: MailboxType.t list
|
||||
|
||||
, searchList: int vector
|
||||
, searchLen: int
|
||||
}
|
||||
@@ -93,4 +93,20 @@ struct
|
||||
, #cursorOnCharG 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
|
||||
|
||||
299
fcore/text-builder/text-builder-with-highlight.sml
Normal file
299
fcore/text-builder/text-builder-with-highlight.sml
Normal 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
|
||||
Reference in New Issue
Block a user