Add 'shf/' from commit 'b6c5a95b664aeb861d7b33ffc9eefe447ba99dd7'
git-subtree-dir: shf git-subtree-mainline:401408448fgit-subtree-split:b6c5a95b66
This commit is contained in:
142
shf/fcore/text-builder/normal-mode-text-builder.sml
Normal file
142
shf/fcore/text-builder/normal-mode-text-builder.sml
Normal file
@@ -0,0 +1,142 @@
|
||||
structure NormalModeTextBuilder =
|
||||
struct
|
||||
structure Utils = TextBuilderUtils
|
||||
|
||||
(* Prerequisite to all functions in this structure:
|
||||
* - Move buffer to startLine before calling any function. *)
|
||||
|
||||
fun startBuild
|
||||
( startLine
|
||||
, cursorPos
|
||||
, buffer: LineGap.t
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, acc
|
||||
) =
|
||||
let
|
||||
val
|
||||
{ rightStrings
|
||||
, rightLines
|
||||
, line = curLine
|
||||
, idx = curIdx
|
||||
, textLength
|
||||
, ...
|
||||
} = buffer
|
||||
|
||||
val env = Utils.initEnv
|
||||
( 0
|
||||
, 0
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, startLine
|
||||
)
|
||||
val {startX, startY, ...} = env
|
||||
in
|
||||
if textLength = 1 then
|
||||
(* empty string, so there is nothing we can draw
|
||||
* except a cursor at the line start.
|
||||
* An empty string is usually thought of to have a length of 0
|
||||
* and this is true, but we always have a \n at the end of the buffer
|
||||
* to respect Unix-style file endings, which we always uphold.
|
||||
* So, for us, an empty string has a length of 1. *)
|
||||
[Utils.makeCursor (startX, startY, env)]
|
||||
else
|
||||
case (rightStrings, rightLines) of
|
||||
(shd :: stl, lhd :: ltl) =>
|
||||
let
|
||||
(* get relative index of line to start building from *)
|
||||
val strPos =
|
||||
Utils.getRelativeLineStartFromRightHead
|
||||
(startLine, curLine, lhd)
|
||||
(* get absolute idx of line *)
|
||||
val absIdx = curIdx + strPos
|
||||
in
|
||||
if PersistentVector.isEmpty searchList then
|
||||
TextBuilderWithCursor.build
|
||||
( strPos
|
||||
, shd
|
||||
, stl
|
||||
, lhd
|
||||
, ltl
|
||||
, startX
|
||||
, startY
|
||||
, 0
|
||||
, startLine
|
||||
, absIdx
|
||||
, cursorPos
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
else
|
||||
TextBuilderWithHighlight.build
|
||||
( strPos
|
||||
, shd
|
||||
, stl
|
||||
, lhd
|
||||
, ltl
|
||||
, startX
|
||||
, startY
|
||||
, 0
|
||||
, startLine
|
||||
, absIdx
|
||||
, cursorPos
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
end
|
||||
| (_, _) => acc
|
||||
end
|
||||
|
||||
fun buildWithExisting
|
||||
( startLine
|
||||
, cursorPos
|
||||
, buffer: LineGap.t
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, acc
|
||||
) =
|
||||
startBuild
|
||||
( startLine
|
||||
, cursorPos
|
||||
, buffer
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, Real32.fromInt windowWidth
|
||||
, Real32.fromInt windowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, []
|
||||
)
|
||||
|
||||
fun build
|
||||
( startLine
|
||||
, cursorPos
|
||||
, buffer: LineGap.t
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
) =
|
||||
startBuild
|
||||
( startLine
|
||||
, cursorPos
|
||||
, buffer
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, Real32.fromInt windowWidth
|
||||
, Real32.fromInt windowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, []
|
||||
)
|
||||
end
|
||||
131
shf/fcore/text-builder/search-bar.sml
Normal file
131
shf/fcore/text-builder/search-bar.sml
Normal file
@@ -0,0 +1,131 @@
|
||||
structure SearchBar =
|
||||
struct
|
||||
structure TC = TextConstants
|
||||
structure Utils = TextBuilderUtils
|
||||
|
||||
fun loop
|
||||
(pos, str, posX, posY, endX, acc, floatWindowWidth, floatWindowHeight) =
|
||||
if pos = String.size str then
|
||||
acc
|
||||
else if posX >= endX then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, pos)
|
||||
val r: Real32.real = 0.01
|
||||
val g: Real32.real = 0.01
|
||||
val b: Real32.real = 0.01
|
||||
val fPosX = Real32.fromInt posX
|
||||
val fPosY = Real32.fromInt posY
|
||||
val z: Real32.real = 0.1
|
||||
|
||||
val chr = CozetteAscii.make
|
||||
( chr
|
||||
, fPosX
|
||||
, fPosY
|
||||
, z
|
||||
, TC.scale
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
)
|
||||
|
||||
val acc = chr :: acc
|
||||
val nextPosX = posX + TC.xSpace
|
||||
in
|
||||
loop
|
||||
( pos + 1
|
||||
, str
|
||||
, nextPosX
|
||||
, posY
|
||||
, endX
|
||||
, acc
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
)
|
||||
end
|
||||
|
||||
(* builds a single text line from a string.
|
||||
* Used for getting Real32.real vector representing search input.
|
||||
* Todo: add scrolling, so that text scrolls horizontally when greater than width. *)
|
||||
fun build
|
||||
( str
|
||||
, startX
|
||||
, startY
|
||||
, endX
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, searchCursorIdx
|
||||
, searchScrollColumn
|
||||
, caseSensitive
|
||||
) =
|
||||
let
|
||||
val r: Real32.real = 0.1
|
||||
val g: Real32.real = 0.1
|
||||
val b: Real32.real = 0.1
|
||||
val z: Real32.real = 0.1
|
||||
|
||||
val width = endX - startX
|
||||
val (startX, endX) =
|
||||
if TC.textLineWidth > width then
|
||||
(startX, endX)
|
||||
else
|
||||
let
|
||||
val startX = (width - TC.textLineWidth) div 2
|
||||
val endX = startX + TC.textLineWidth
|
||||
in
|
||||
(startX, endX)
|
||||
end
|
||||
|
||||
val fPosX = Real32.fromInt startX
|
||||
val fPosY = Real32.fromInt startY
|
||||
|
||||
val searchSymbol = CozetteAscii.make
|
||||
( if caseSensitive then #"?" else #"/"
|
||||
, fPosX
|
||||
, fPosY
|
||||
, z
|
||||
, TC.scale
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
)
|
||||
|
||||
val cursor =
|
||||
let
|
||||
val xpos = (searchCursorIdx + 1) - searchScrollColumn
|
||||
val xpos = TextConstants.xSpace * xpos + startX
|
||||
val xpos = Int.min (endX, xpos)
|
||||
val x = Real32.fromInt xpos
|
||||
in
|
||||
PipeCursor.lerp
|
||||
( x
|
||||
, fPosY
|
||||
, 0.01
|
||||
, TC.scale
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
)
|
||||
end
|
||||
|
||||
val posX = startX + TC.xSpace
|
||||
in
|
||||
loop
|
||||
( searchScrollColumn
|
||||
, str
|
||||
, posX
|
||||
, startY
|
||||
, endX
|
||||
, [cursor, searchSymbol]
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
)
|
||||
end
|
||||
end
|
||||
250
shf/fcore/text-builder/text-builder-utils.sml
Normal file
250
shf/fcore/text-builder/text-builder-utils.sml
Normal file
@@ -0,0 +1,250 @@
|
||||
structure TextBuilderUtils =
|
||||
struct
|
||||
structure TC = TextConstants
|
||||
|
||||
type env_data =
|
||||
{ charR: Real32.real
|
||||
, charG: Real32.real
|
||||
, charB: Real32.real
|
||||
|
||||
, cursorR: Real32.real
|
||||
, cursorG: Real32.real
|
||||
, cursorB: Real32.real
|
||||
|
||||
, searchHighlightR: Real32.real
|
||||
, searchHighlightG: Real32.real
|
||||
, searchHighlightB: Real32.real
|
||||
|
||||
(* different colours for char when cursor is on char *)
|
||||
, cursorHighlightedCharR: Real32.real
|
||||
, cursorHighlightedCharG: Real32.real
|
||||
, cursorHighlightedCharB: Real32.real
|
||||
|
||||
, searchHighlightedCharR: Real32.real
|
||||
, searchHighlightedCharG: Real32.real
|
||||
, searchHighlightedCharB: Real32.real
|
||||
|
||||
, charZ: Real32.real
|
||||
, cursorZ: Real32.real
|
||||
, searchHighlightZ: Real32.real
|
||||
|
||||
, startX: int
|
||||
, startY: int
|
||||
|
||||
, scrollColumnStart: int
|
||||
, scrollColumnEnd: int
|
||||
, lastLineNumber: int
|
||||
|
||||
(* fw/fh = float window width and float window height *)
|
||||
, fw: Real32.real
|
||||
, fh: Real32.real
|
||||
|
||||
, searchList: PersistentVector.t
|
||||
}
|
||||
|
||||
fun initEnv
|
||||
( startX
|
||||
, startY
|
||||
, endX
|
||||
, endY
|
||||
, floatWindowWidth
|
||||
, floatWindowHeight
|
||||
, searchList
|
||||
, visualScrollColumn
|
||||
, startLine
|
||||
) : env_data =
|
||||
let
|
||||
val width = endX - startX
|
||||
val lastLineNumber =
|
||||
let
|
||||
val height = endY - startY
|
||||
val howManyLines = height div TC.ySpace
|
||||
in
|
||||
startLine + howManyLines
|
||||
end
|
||||
in
|
||||
if TC.textLineWidth > width then
|
||||
{ charR = 0.0
|
||||
, charG = 0.0
|
||||
, charB = 0.0
|
||||
|
||||
, searchHighlightR = 0.41
|
||||
, searchHighlightG = 0.05
|
||||
, searchHighlightB = 0.67
|
||||
|
||||
, cursorR = 0.0
|
||||
, cursorG = 0.0
|
||||
, cursorB = 0.0
|
||||
|
||||
, searchHighlightedCharR = 0.89
|
||||
, searchHighlightedCharG = 0.89
|
||||
, searchHighlightedCharB = 0.89
|
||||
|
||||
, cursorHighlightedCharR = 0.89
|
||||
, cursorHighlightedCharG = 0.89
|
||||
, cursorHighlightedCharB = 0.89
|
||||
|
||||
, charZ = 0.01
|
||||
, cursorZ = 0.03
|
||||
, searchHighlightZ = 0.05
|
||||
|
||||
, startX = startX
|
||||
, startY = startX
|
||||
|
||||
, scrollColumnStart = visualScrollColumn
|
||||
, scrollColumnEnd = width div TC.xSpace + visualScrollColumn
|
||||
, lastLineNumber = lastLineNumber
|
||||
|
||||
, fw = floatWindowWidth
|
||||
, fh = floatWindowHeight
|
||||
|
||||
, searchList = searchList
|
||||
}
|
||||
else
|
||||
let
|
||||
val startX = (width - TC.textLineWidth) div 2
|
||||
in
|
||||
{ charR = 0.0
|
||||
, charG = 0.0
|
||||
, charB = 0.0
|
||||
|
||||
, searchHighlightR = 0.41
|
||||
, searchHighlightG = 0.05
|
||||
, searchHighlightB = 0.67
|
||||
|
||||
, cursorR = 0.0
|
||||
, cursorG = 0.0
|
||||
, cursorB = 0.0
|
||||
|
||||
, searchHighlightedCharR = 0.89
|
||||
, searchHighlightedCharG = 0.89
|
||||
, searchHighlightedCharB = 0.89
|
||||
|
||||
, cursorHighlightedCharR = 0.89
|
||||
, cursorHighlightedCharG = 0.89
|
||||
, cursorHighlightedCharB = 0.89
|
||||
|
||||
, charZ = 0.01
|
||||
, cursorZ = 0.03
|
||||
, searchHighlightZ = 0.05
|
||||
|
||||
, startX = startX
|
||||
, startY = startY
|
||||
|
||||
, scrollColumnStart = visualScrollColumn
|
||||
, scrollColumnEnd = visualScrollColumn + TC.textLineCount
|
||||
, lastLineNumber = lastLineNumber
|
||||
|
||||
, fw = floatWindowWidth
|
||||
, fh = floatWindowHeight
|
||||
|
||||
, searchList = searchList
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
(* different functions to make vectors of different things we want to draw. *)
|
||||
fun makeCursor (posX, posY, env: env_data) =
|
||||
Rect.lerp
|
||||
( Real32.fromInt (posX - 2)
|
||||
, Real32.fromInt posY
|
||||
, #cursorZ env
|
||||
, TC.scale
|
||||
, #fw env
|
||||
, #fh env
|
||||
, #cursorR env
|
||||
, #cursorG env
|
||||
, #cursorB env
|
||||
)
|
||||
|
||||
fun makeSearchHighlight (posX, posY, env: env_data) =
|
||||
Rect.lerp
|
||||
( Real32.fromInt (posX - 2)
|
||||
, Real32.fromInt posY
|
||||
, #searchHighlightZ env
|
||||
, TC.scale
|
||||
, #fw env
|
||||
, #fh env
|
||||
, #searchHighlightR env
|
||||
, #searchHighlightG env
|
||||
, #searchHighlightB env
|
||||
)
|
||||
|
||||
fun makeChr (chr, posX, posY, env: env_data) =
|
||||
CozetteAscii.make
|
||||
( chr
|
||||
, Real32.fromInt posX
|
||||
, Real32.fromInt posY
|
||||
, #charZ env
|
||||
, TC.scale
|
||||
, #fw env
|
||||
, #fh env
|
||||
, #charR env
|
||||
, #charG env
|
||||
, #charB env
|
||||
)
|
||||
|
||||
fun makeCursorHighlightedChr (chr, posX, posY, env: env_data) =
|
||||
CozetteAscii.make
|
||||
( chr
|
||||
, Real32.fromInt posX
|
||||
, Real32.fromInt posY
|
||||
, #charZ env
|
||||
, TC.scale
|
||||
, #fw env
|
||||
, #fh env
|
||||
, #cursorHighlightedCharR env
|
||||
, #cursorHighlightedCharG env
|
||||
, #cursorHighlightedCharB env
|
||||
)
|
||||
|
||||
fun makeSearchHighlightedChr (chr, posX, posY, env: env_data) =
|
||||
CozetteAscii.make
|
||||
( chr
|
||||
, Real32.fromInt posX
|
||||
, Real32.fromInt posY
|
||||
, #charZ env
|
||||
, TC.scale
|
||||
, #fw env
|
||||
, #fh env
|
||||
, #searchHighlightedCharR env
|
||||
, #searchHighlightedCharG env
|
||||
, #searchHighlightedCharB env
|
||||
)
|
||||
|
||||
(* gets line start idx, relative to right hd *)
|
||||
fun getRelativeLineStartFromRightHead (startLine, curLine, rLnHd) =
|
||||
if startLine > curLine then
|
||||
let val lnPos = startLine - curLine - 1
|
||||
in Vector.sub (rLnHd, lnPos) + 1
|
||||
end
|
||||
else
|
||||
0
|
||||
|
||||
(* gets line start idx, absolute *)
|
||||
fun getAbsoluteLineStartFromRightHead (curIdx, startLine, curLine, rLnHd) =
|
||||
let
|
||||
val startIdx =
|
||||
if startLine > curLine then
|
||||
let val lnPos = startLine - curLine - 1
|
||||
in Vector.sub (rLnHd, lnPos) + 1
|
||||
end
|
||||
else
|
||||
0
|
||||
in
|
||||
curIdx + startIdx
|
||||
end
|
||||
|
||||
fun getLineAbsIdxFromBuffer (startLine, buffer: LineGap.t) =
|
||||
let
|
||||
val {rightLines, line = curLine, idx = curIdx, ...} = buffer
|
||||
in
|
||||
case rightLines of
|
||||
rLnHd :: _ =>
|
||||
getAbsoluteLineStartFromRightHead (curIdx, startLine, curLine, rLnHd)
|
||||
| [] =>
|
||||
raise Fail
|
||||
"text-builder-utils.sml 268:\
|
||||
\should never call function when at end of buffer"
|
||||
end
|
||||
end
|
||||
253
shf/fcore/text-builder/text-builder-with-cursor.sml
Normal file
253
shf/fcore/text-builder/text-builder-with-cursor.sml
Normal file
@@ -0,0 +1,253 @@
|
||||
structure TextBuilderWithCursor =
|
||||
struct
|
||||
structure TC = TextConstants
|
||||
structure Utils = TextBuilderUtils
|
||||
|
||||
fun goToFirstLineAfter
|
||||
(stl, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc) =
|
||||
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
|
||||
)
|
||||
end
|
||||
else
|
||||
(* keep looping until we find a linebreak *)
|
||||
goToFirstLineAfter
|
||||
( stl
|
||||
, ltl
|
||||
, posY
|
||||
, lineNumber
|
||||
, absIdx + String.size shd
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
| (_, _) => acc
|
||||
|
||||
and skipToNextLine
|
||||
(pos, str, stl, line, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc) =
|
||||
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)
|
||||
end
|
||||
else
|
||||
(* bin search lines *)
|
||||
let
|
||||
val linePos = BinSearch.equalOrMore (pos + 1, line)
|
||||
in
|
||||
if linePos = ~1 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)
|
||||
end
|
||||
else
|
||||
let
|
||||
val lineOffset = Vector.sub (line, linePos)
|
||||
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
|
||||
)
|
||||
end
|
||||
end
|
||||
|
||||
and build
|
||||
( pos
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX
|
||||
, posY
|
||||
, column
|
||||
, lineNumber
|
||||
, absIdx
|
||||
, cursorIdx
|
||||
, env: Utils.env_data
|
||||
, acc
|
||||
) =
|
||||
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
|
||||
)
|
||||
| (_, _) => acc
|
||||
else
|
||||
case String.sub (str, pos) of
|
||||
#"\n" =>
|
||||
if lineNumber + 1 > #lastLineNumber env then
|
||||
acc
|
||||
else
|
||||
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
|
||||
)
|
||||
end
|
||||
| #" " =>
|
||||
let
|
||||
val acc =
|
||||
if absIdx = cursorIdx then
|
||||
Utils.makeCursor (posX, posY, env) :: acc
|
||||
else
|
||||
acc
|
||||
val posX =
|
||||
if column < #scrollColumnStart env then
|
||||
(* if we are prior to the start column,
|
||||
* we want to set the x position to be at the start
|
||||
* in preparation for when we are at the start column *)
|
||||
#startX env
|
||||
else
|
||||
posX + TC.xSpace
|
||||
in
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
end
|
||||
| chr =>
|
||||
if column < #scrollColumnStart env then
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, #startX env
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
else if column > #scrollColumnEnd env then
|
||||
skipToNextLine
|
||||
( pos
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posY
|
||||
, lineNumber
|
||||
, absIdx
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
else
|
||||
let
|
||||
val acc =
|
||||
if absIdx = cursorIdx then
|
||||
let
|
||||
val acc = Utils.makeCursor (posX, posY, env) :: acc
|
||||
in
|
||||
Utils.makeCursorHighlightedChr (chr, posX, posY, env) :: acc
|
||||
end
|
||||
else
|
||||
Utils.makeChr (chr, posX, posY, env) :: acc
|
||||
in
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX + TC.xSpace
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
end
|
||||
end
|
||||
258
shf/fcore/text-builder/text-builder-with-highlight.sml
Normal file
258
shf/fcore/text-builder/text-builder-with-highlight.sml
Normal file
@@ -0,0 +1,258 @@
|
||||
structure TextBuilderWithHighlight =
|
||||
struct
|
||||
structure TC = TextConstants
|
||||
structure Utils = TextBuilderUtils
|
||||
|
||||
fun isSecondLastChr (pos, str, tl) =
|
||||
case tl of
|
||||
[] => pos = String.size str - 2
|
||||
| _ => false
|
||||
|
||||
fun goToFirstLineAfter
|
||||
(stl, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc) =
|
||||
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
|
||||
)
|
||||
end
|
||||
else
|
||||
(* keep looping until we find a linebreak *)
|
||||
goToFirstLineAfter
|
||||
( stl
|
||||
, ltl
|
||||
, posY
|
||||
, lineNumber
|
||||
, absIdx + String.size shd
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
| (_, _) => acc
|
||||
|
||||
and skipToNextLine
|
||||
(pos, str, stl, line, ltl, posY, lineNumber, absIdx, cursorIdx, env, acc) =
|
||||
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)
|
||||
end
|
||||
else
|
||||
(* bin search lines *)
|
||||
let
|
||||
val linePos = BinSearch.equalOrMore (pos + 1, line)
|
||||
in
|
||||
if linePos = ~1 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)
|
||||
end
|
||||
else
|
||||
let
|
||||
val lineOffset = Vector.sub (line, linePos)
|
||||
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
|
||||
)
|
||||
end
|
||||
end
|
||||
|
||||
and build
|
||||
( pos
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX
|
||||
, posY
|
||||
, column
|
||||
, lineNumber
|
||||
, absIdx
|
||||
, cursorIdx
|
||||
, env: Utils.env_data
|
||||
, acc
|
||||
) =
|
||||
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
|
||||
)
|
||||
| (_, _) => 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 PersistentVector.isInRange (absIdx, #searchList env) then
|
||||
Utils.makeSearchHighlight (posX, posY, env) :: acc
|
||||
else
|
||||
acc
|
||||
val posX =
|
||||
if column < #scrollColumnStart env then #startX env
|
||||
else posX + TC.xSpace
|
||||
in
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
end
|
||||
| #"\n" =>
|
||||
if lineNumber + 1 > #lastLineNumber env then
|
||||
acc
|
||||
else
|
||||
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
|
||||
)
|
||||
end
|
||||
| chr =>
|
||||
if column < #scrollColumnStart env then
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, #startX env
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
else if column > #scrollColumnEnd env then
|
||||
skipToNextLine
|
||||
( pos
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posY
|
||||
, lineNumber
|
||||
, absIdx
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
else
|
||||
let
|
||||
val acc =
|
||||
if absIdx = cursorIdx then
|
||||
Utils.makeCursorHighlightedChr (chr, posX, posY, env)
|
||||
:: Utils.makeCursor (posX, posY, env) :: acc
|
||||
else if PersistentVector.isInRange (absIdx, #searchList env) then
|
||||
Utils.makeSearchHighlightedChr (chr, posX, posY, env)
|
||||
:: Utils.makeSearchHighlight (posX, posY, env) :: acc
|
||||
else
|
||||
Utils.makeChr (chr, posX, posY, env) :: acc
|
||||
in
|
||||
build
|
||||
( pos + 1
|
||||
, str
|
||||
, stl
|
||||
, line
|
||||
, ltl
|
||||
, posX + TC.xSpace
|
||||
, posY
|
||||
, column + 1
|
||||
, lineNumber
|
||||
, absIdx + 1
|
||||
, cursorIdx
|
||||
, env
|
||||
, acc
|
||||
)
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user