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

refactor text builder a bit (I should probably functorise buffer/lineGap iteration code out at some point)

Browse Source
This commit is contained in:
Humza Shahid
2025-08-04 12:57:22 +01:00
parent a4ac1b9ae0
commit 7dbd37a65b
1 changed files with 727 additions and 460 deletions
Download Patch File Download Diff File Expand all files Collapse all files

667
fcore/text-builder.sml
View File

@@ -41,26 +41,37 @@ struct
* on an indented line *)
(* same as buildTextStringAfterCursor, except this keeps track of absolute
* index and cursor pos too *)
type colour_data =
type env_data =
{ r: Real32.real
, g: Real32.real
, b: Real32.real
(* hr/hg/hb = highlight red/green/blue *)
, hr: Real32.real
, hg: Real32.real
, hb: Real32.real
}
type window_data =
{ w: int
, w: int
, h: int
(* fw/fh = float window width and float window height *)
, fw: Real32.real
, fh: Real32.real
}
fun buildTextString
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData: window_data, colourData: colour_data
( pos
, str
, acc
, posX
, posY
, startX
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env: env_data
) =
if pos < String.size str then
case String.sub (str, pos) of
@@ -70,47 +81,81 @@ struct
if absIdx <> cursorPos then
(* not in cursur *)
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
else
(* in cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {r, g, b, fw, fh, ...} = env
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
| #"\n" =>
if posY + ySpace < #h windowData then
if posY + ySpace < #h env then
if absIdx <> cursorPos then
(* not in cursor position, so iterate like normal *)
buildTextString
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, startX
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
else
(* in cursor position, so build cursorAcc *)
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {r, g, b, fw, fh, ...} = env
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
buildTextString
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, startX
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
@@ -121,36 +166,50 @@ struct
in
if absIdx <> cursorPos then
(* not equal to cursor *)
if posX + xSpace < #w windowData then
if posX + xSpace < #w env then
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {r, g, b, fw, fh, ...} = env
val chrVec = chrFun
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val acc = chrVec :: acc
in
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else if posY + ySpace < #h windowData then
else if posY + ySpace < #h env then
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {r, g, b, fw, fh, ...} = env
val chrVec = chrFun
( startX, posY + ySpace, fontSize, fontSize
, fw, fh, r, g, b
)
(startX, posY + ySpace, fontSize, fontSize, fw, fh, r, g, b)
val acc = chrVec :: acc
in
buildTextString
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, startX + xSpace
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
@@ -158,41 +217,64 @@ struct
else
(* equal to cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, hr, hg, hb} = colourData
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val {fw, fh, r, g, b, hr, hg, hb, ...} = env
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
if posX + xSpace < #w windowData then
if posX + xSpace < #w env then
let
val chrVec = chrFun
( posX, posY, fontSize, fontSize
, fw, fh , hr, hg, hb
)
(posX, posY, fontSize, fontSize, 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, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else if posY + ySpace < #h windowData then
else if posY + ySpace < #h env then
let
val chrVec = chrFun
( startX, posY + ySpace, fontSize, fontSize
, fw, fh, hr, hg, hb
( startX
, posY + ySpace
, fontSize
, fontSize
, 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 + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( pos + 1
, str
, acc
, startX + xSpace
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
)
end
else
@@ -204,49 +286,86 @@ struct
case tl of
hd :: tl =>
buildTextString
( 0, hd, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( 0
, hd
, acc
, posX
, posY
, startX
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env
)
| [] =>
accToDrawMsg (acc, cursorAcc, bgAcc)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc)
fun isInSearchRange (absIdx, searchPos, searchHd, searchLen) =
let
val searchIdx = Vector.sub (searchHd, searchPos)
in
absIdx >= searchIdx andalso absIdx < searchIdx + searchLen
let val searchIdx = Vector.sub (searchHd, searchPos)
in absIdx >= searchIdx andalso absIdx < searchIdx + searchLen
end
fun isAfterSearchRange (absIdx, searchPos, searchHd, searchLen) =
let
val searchIdx = Vector.sub (searchHd, searchPos)
in
absIdx >= searchIdx + searchLen
let val searchIdx = Vector.sub (searchHd, searchPos)
in absIdx >= searchIdx + searchLen
end
fun buildTextStringSearch
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData: window_data, colourData: colour_data
, searchHd, searchTl, searchPos, searchLen
( pos
, str
, acc
, posX
, posY
, startX
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env: env_data
, searchHd
, searchTl
, searchPos
, searchLen
) =
if searchPos = Vector.length searchHd then
case searchTl of
searchHd :: searchTl =>
(* go to next search hd/tl *)
buildTextStringSearch
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, 0, searchLen
( pos
, str
, acc
, posX
, posY
, startX
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, 0
, searchLen
)
| [] =>
(* exhausted search hd/tl so calll normal build function *)
(* exhausted search hd/tl so call normal build function *)
buildTextString
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
( 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
@@ -262,66 +381,124 @@ struct
val r: Real32.real = 0.3
val g: Real32.real = 0.1
val b: Real32.real = 0.1
val {fw, fh, ...} = windowData
val {fw, fh, ...} = env
val space =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val space = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val bgAcc = space :: bgAcc
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
else
(* in cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {fw, fh, r, g, b, ...} = env
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
| #"\n" =>
if posY + ySpace < #h windowData then
if posY + ySpace < #h env then
if absIdx <> cursorPos then
(* not in cursor position, so iterate like normal *)
buildTextStringSearch
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, startX
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
else
(* in cursor position, so build cursorAcc *)
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {fw, fh, r, g, b, ...} = env
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
buildTextStringSearch
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, startX
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else
@@ -332,10 +509,10 @@ struct
in
if absIdx <> cursorPos then
(* not equal to cursor *)
if posX + xSpace < #w windowData then
if posX + xSpace < #w env then
if isInSearchRange (absIdx, searchPos, searchHd, searchLen) then
let
val {fw, fh, ...} = windowData
val {fw, fh, ...} = env
(* todo: temp colours *)
val r: Real32.real = 0.7
@@ -343,8 +520,8 @@ struct
val b: Real32.real = 0.7
(* build char vec *)
val chrVec =
chrFun (posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val chrVec = chrFun
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val acc = chrVec :: acc
(* build cursor (behind text) vec *)
@@ -352,53 +529,87 @@ struct
val g: Real32.real = 0.1
val b: Real32.real = 0.1
val space =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val space = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val bgAcc = space :: bgAcc
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {fw, fh, r, g, b, ...} = env
val chrVec =
chrFun (posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val chrVec = chrFun
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
val acc = chrVec :: acc
val searchPos =
if isAfterSearchRange (absIdx, searchPos, searchHd, searchLen)
if
isAfterSearchRange
(absIdx, searchPos, searchHd, searchLen)
then searchPos + 1
else searchPos
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else if posY + ySpace < #h windowData then
else if posY + ySpace < #h env then
let
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val {fw, fh, r, g, b, ...} = env
val chrVec = chrFun
( startX, posY + ySpace, fontSize, fontSize
, fw, fh, r, g, b
)
(startX, posY + ySpace, fontSize, fontSize, fw, fh, r, g, b)
val acc = chrVec :: acc
in
buildTextStringSearch
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, startX + xSpace
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else
@@ -406,43 +617,71 @@ struct
else
(* equal to cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, hr, hg, hb} = colourData
val cursorAcc =
Rect.lerp (posX, posY, fontSize, fontSize, fw, fh, r, g ,b)
val {fw, fh, r, g, b, hr, hg, hb, ...} = env
val cursorAcc = Rect.lerp
(posX, posY, fontSize, fontSize, fw, fh, r, g, b)
in
if posX + xSpace < #w windowData then
if posX + xSpace < #w env then
let
val chrVec = chrFun
( posX, posY, fontSize, fontSize
, fw, fh , hr, hg, hb
)
(posX, posY, fontSize, fontSize, fw, fh, hr, hg, hb)
val acc = chrVec :: acc
in
(* can start building after cursor now,
* since cursor was built *)
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, posX + xSpace
, posY
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else if posY + ySpace < #h windowData then
else if posY + ySpace < #h env then
let
val chrVec = chrFun
( startX, posY + ySpace, fontSize, fontSize
, fw, fh, hr, hg, hb
( startX
, posY + ySpace
, fontSize
, fontSize
, fw
, fh
, hr
, hg
, hb
)
val acc = chrVec :: acc
in
(* can start building after cursor now,
* since cursor was built *)
buildTextStringSearch
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( pos + 1
, str
, acc
, startX + xSpace
, posY + ySpace
, startX
, tl
, absIdx + 1
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
end
else
@@ -454,21 +693,30 @@ struct
case tl of
hd :: tl =>
buildTextStringSearch
( 0, hd, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
( 0
, hd
, acc
, posX
, posY
, startX
, tl
, absIdx
, cursorPos
, cursorAcc
, bgAcc
, env
, searchHd
, searchTl
, searchPos
, searchLen
)
| [] =>
accToDrawMsg (acc, cursorAcc, bgAcc)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc)
(* gets line start idx, relative to right hd *)
fun helpGetLineStartIdx (startLine, curLine, rLnHd) =
if startLine > curLine then
let
val lnPos = startLine - curLine - 1
in
Vector.sub (rLnHd, lnPos) + 1
let val lnPos = startLine - curLine - 1
in Vector.sub (rLnHd, lnPos) + 1
end
else
0
@@ -478,10 +726,8 @@ struct
let
val startIdx =
if startLine > curLine then
let
val lnPos = startLine - curLine - 1
in
Vector.sub (rLnHd, lnPos) + 1
let val lnPos = startLine - curLine - 1
in Vector.sub (rLnHd, lnPos) + 1
end
else
0
@@ -494,20 +740,22 @@ struct
val {rightLines, line = curLine, idx = curIdx, ...} = lineGap
in
case rightLines of
rLnHd :: _ =>
helpGetLineAbsIdx (curIdx, startLine, curLine, rLnHd)
| [] =>
(* should never happen *)
0
rLnHd :: _ => helpGetLineAbsIdx (curIdx, startLine, curLine, rLnHd)
| [] => (* should never happen *) 0
end
fun build
( startLine, cursorPos, lineGap: LineGap.t
, windowWidth, windowHeight
, searchList: SearchList.t, searchString
( startLine
, cursorPos
, lineGap: LineGap.t
, windowWidth
, windowHeight
, searchList: SearchList.t
, searchString
) =
let
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = lineGap
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} =
lineGap
in
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: _) =>
@@ -517,21 +765,19 @@ struct
(* get absolute idx of line *)
val absIdx = curIdx + startIdx
val windowData =
val env =
{ w = windowWidth
, h = windowHeight
, fw = Real32.fromInt windowWidth
, fh = Real32.fromInt windowHeight
}
val colourData =
{ r = 0.67
, r = 0.67
, g = 0.51
, b = 0.83
, hr = 0.211
, hg = 0.219
, hb = 0.25
}
val cursorAcc = Vector.fromList []
in
(case #right searchList of
@@ -540,17 +786,38 @@ struct
val searchPos = BinSearch.equalOrMore (absIdx, searchHd)
in
buildTextStringSearch
( startIdx, rStrHd, [], 5, 5, 5
, rStrTl, absIdx, cursorPos, cursorAcc, []
, windowData, colourData
, searchHd, searchTl, searchPos, String.size searchString
( startIdx
, rStrHd
, []
, 5
, 5
, 5
, rStrTl
, absIdx
, cursorPos
, cursorAcc
, []
, env
, searchHd
, searchTl
, searchPos
, String.size searchString
)
end
| [] =>
buildTextString
( startIdx, rStrHd, [], 5, 5, 5
, rStrTl, absIdx, cursorPos, cursorAcc, []
, windowData, colourData
( startIdx
, rStrHd
, []
, 5
, 5
, 5
, rStrTl
, absIdx
, cursorPos
, cursorAcc
, []
, env
))
end
| (_, _) =>