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

a bit of refactoring to allow addition of more tests

Browse Source
This commit is contained in:
Humza Shahid
2025-03-22 05:18:25 +00:00
parent deb24c2063
commit 649bcb66e1
9 changed files with 2912 additions and 2709 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
fcore/build-search-list.sml
View File

@@ -108,10 +108,8 @@ struct
else
let
val searchList =
if SearchList.exists (matchedIdx, searchList) then
searchList
else
SearchList.insert (matchedIdx, searchList)
if SearchList.exists (matchedIdx, searchList) then searchList
else SearchList.insert (matchedIdx, searchList)
in
helpFromRange
( origIdx

817
fcore/cursor.sml
View File

File diff suppressed because it is too large Load Diff

295
fcore/text-window.sml
View File

@@ -8,10 +8,8 @@ struct
hd :: tl =>
getStartLineBefore
(String.size hd - 1, hd, lineNum, absIdx, cursorIdx, tl)
| [] =>
0
else
if absIdx = cursorIdx then
| [] => 0
else if absIdx = cursorIdx then
Int.max (lineNum - 1, 0)
else
let
@@ -26,63 +24,120 @@ struct
end
fun getStartLineAfter
( sIdx, shd, lineNum, absIdx, cursorIdx, stl
, maxWidth, maxHeight, curWidth, curHeight
( sIdx
, shd
, lineNum
, absIdx
, cursorIdx
, stl
, maxWidth
, maxHeight
, curWidth
, curHeight
, origLine
) =
if sIdx = String.size shd then
case stl of
hd :: tl =>
getStartLineAfter
( 0, hd, lineNum, absIdx, cursorIdx, tl
, maxWidth, maxHeight, curWidth, curHeight
( 0
, hd
, lineNum
, absIdx
, cursorIdx
, tl
, maxWidth
, maxHeight
, curWidth
, curHeight
, origLine
)
| [] =>
origLine
else
if absIdx = cursorIdx then
| [] => origLine
else if absIdx = cursorIdx then
origLine
else
let
val chr = String.sub (shd, sIdx)
in
if chr = #"\n" then
if
chr = #"\n"
then
if curHeight + (ySpace * 3) >= maxHeight then
getStartLineAfter
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, 0, curHeight + ySpace
( sIdx + 1
, shd
, lineNum + 1
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, 0
, curHeight + ySpace
, origLine + 1
)
else
getStartLineAfter
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, 0, curHeight + ySpace
( sIdx + 1
, shd
, lineNum + 1
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, 0
, curHeight + ySpace
, origLine
)
else
if curWidth + xSpace <= maxWidth then
else if
curWidth + xSpace <= maxWidth
then
let
val curWidth = curWidth + xSpace
in
getStartLineAfter
( sIdx + 1, shd, lineNum, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, curWidth, curHeight
( sIdx + 1
, shd
, lineNum
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, curWidth
, curHeight
, origLine
)
end
else
(* have to create visual line break *)
if curHeight + (ySpace * 3) >= maxHeight then
else (* have to create visual line break *) if
curHeight + (ySpace * 3) >= maxHeight
then
getStartLineAfter
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, 0, curHeight + ySpace
( sIdx + 1
, shd
, lineNum + 1
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, 0
, curHeight + ySpace
, origLine + 1
)
else
getStartLineAfter
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, 0, curHeight + ySpace
( sIdx + 1
, shd
, lineNum + 1
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, 0
, curHeight + ySpace
, origLine
)
end
@@ -90,7 +145,14 @@ struct
(* Prerequisite: LineGap is moved to oldLine first. *)
fun getStartLine (lineGap: LineGap.t, oldLine, cursorIdx, maxWidth, maxHeight) =
let
val {rightStrings, rightLines, line = curLine, idx = curIdx, leftStrings, ...} = lineGap
val
{ rightStrings
, rightLines
, line = curLine
, idx = curIdx
, leftStrings
, ...
} = lineGap
in
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: _) =>
@@ -115,20 +177,33 @@ struct
else if cursorIdx = absIdx + 1 then
(* double linebreak *)
getStartLineBefore
(startIdx + 1, rStrHd, oldLine, absIdx + 1, cursorIdx, leftStrings)
( startIdx + 1
, rStrHd
, oldLine
, absIdx + 1
, cursorIdx
, leftStrings
)
else if cursorIdx > absIdx then
(* possibly move downwards *)
getStartLineAfter
( startIdx, rStrHd, oldLine, absIdx, cursorIdx, rStrTl
, maxWidth, maxHeight, 0, 0
( startIdx
, rStrHd
, oldLine
, absIdx
, cursorIdx
, rStrTl
, maxWidth
, maxHeight
, 0
, 0
, oldLine
)
else
(* keep current line *)
Int.max (oldLine - 1, 0)
end
| (_, _) =>
oldLine
| (_, _) => oldLine
end
fun helpCentreCursor (strPos, str, lineNum, stl, maxW, halfH, curW, curH) =
@@ -137,42 +212,37 @@ struct
hd :: tl =>
helpCentreCursor
(String.size hd - 1, hd, lineNum, tl, maxW, halfH, curW, curH)
| [] =>
(* return 0 for start of buffer *)
0
| [] => (* return 0 for start of buffer *) 0
else
let
val chr = String.sub (str, strPos)
in
if chr = #"\n" then
if
chr = #"\n"
then
if curH + (ySpace * 3) >= halfH then
(* if we exceeded half the screen *)
lineNum
else
helpCentreCursor
( strPos - 1, str, lineNum - 1, stl, maxW, halfH
, 0, curH + ySpace
)
else
if curW + xSpace <= maxW then
(strPos - 1, str, lineNum - 1, stl, maxW, halfH, 0, curH + ySpace)
else if
curW + xSpace <= maxW
then
let
val curW = curW + xSpace
in
helpCentreCursor
( strPos - 1, str, lineNum, stl, maxW, halfH
, curW + xSpace, curH
)
(strPos - 1, str, lineNum, stl, maxW, halfH, curW + xSpace, curH)
end
else
(* have to create visual line break *)
if curH + (ySpace * 3) >= halfH then
else (* have to create visual line break *) if
curH + (ySpace * 3) >= halfH
then
(* if at limit, return current line lineNum *)
lineNum
else
helpCentreCursor
( strPos - 1, str, lineNum - 1, stl, maxW, halfH
, 0, curH + ySpace
)
(strPos - 1, str, lineNum - 1, stl, maxW, halfH, 0, curH + ySpace)
end
(* search for prev \n, and once found,
@@ -181,10 +251,8 @@ struct
if strPos < 0 then
case stl of
hd :: tl =>
getCursorStartLine
(String.size hd - 1, hd, lineNum, tl, maxW, halfH)
| [] =>
0
getCursorStartLine (String.size hd - 1, hd, lineNum, tl, maxW, halfH)
| [] => 0
else
let
val chr = String.sub (str, strPos)
@@ -194,21 +262,15 @@ struct
helpCentreCursor
(strPos - 1, str, lineNum - 1, stl, maxW, halfH, xSpace, ySpace)
else
getCursorStartLine
(strPos - 1, str, lineNum, stl, maxW, halfH)
getCursorStartLine (strPos - 1, str, lineNum, stl, maxW, halfH)
end
fun getLineNum (strIdx, lhd, bufferLine) =
if Vector.length lhd = 0 then
bufferLine
else if Vector.length lhd = 1 then
let
val lineIdx = Vector.sub (lhd, 0)
in
if lineIdx < strIdx then
bufferLine + 1
else
bufferLine
let val lineIdx = Vector.sub (lhd, 0)
in if lineIdx < strIdx then bufferLine + 1 else bufferLine
end
else
let
@@ -226,7 +288,14 @@ struct
fun getStartLineWithCursorCentered
(lineGap: LineGap.t, cursorIdx, origLine, maxWidth, maxHeight) =
let
val {rightStrings, rightLines, idx = bufferIdx, line = bufferLine, leftStrings, ...} = lineGap
val
{ rightStrings
, rightLines
, idx = bufferIdx
, line = bufferLine
, leftStrings
, ...
} = lineGap
in
case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) =>
@@ -255,11 +324,9 @@ struct
getCursorStartLine
(strIdx, stlhd, lineNum, leftStrings, maxWidth, maxHeight)
end
| (_, _) =>
origLine
| (_, _) => origLine
end
| (_, _) =>
origLine
| (_, _) => origLine
end
fun helpIsCursorVisible
@@ -269,45 +336,66 @@ struct
hd :: tl =>
helpIsCursorVisible
(0, hd, tl, absIdx, maxW, maxH, curW, curH, newCursorIdx)
| [] =>
true
else
if absIdx = newCursorIdx then
| [] => true
else if absIdx = newCursorIdx then
true
else
let
val chr = String.sub (str, strPos)
in
if chr = #"\n" then
if
chr = #"\n"
then
if curH + (ySpace * 3) >= maxH then
false
else
helpIsCursorVisible
( strPos + 1, str, stl, absIdx + 1
, maxW, maxH, 0, curH + ySpace, newCursorIdx
( strPos + 1
, str
, stl
, absIdx + 1
, maxW
, maxH
, 0
, curH + ySpace
, newCursorIdx
)
else
if curW + xSpace <= maxW then
else if
curW + xSpace <= maxW
then
helpIsCursorVisible
( strPos + 1, str, stl, absIdx + 1
, maxW, maxH, curW + xSpace, curH, newCursorIdx
( strPos + 1
, str
, stl
, absIdx + 1
, maxW
, maxH
, curW + xSpace
, curH
, newCursorIdx
)
else
(* have to create visual line break *)
if curH + (ySpace * 3) >= maxH then
else (* have to create visual line break *) if
curH + (ySpace * 3) >= maxH
then
false
else
helpIsCursorVisible
( strPos + 1, str, stl, absIdx + 1
, maxW, maxH, 0, curH + ySpace, newCursorIdx
( strPos + 1
, str
, stl
, absIdx + 1
, maxW
, maxH
, 0
, curH + ySpace
, newCursorIdx
)
end
fun startIsCursorVisible
(curIdx, shd, stl, lhd, startLine, curLine, maxW, maxH, newCursorIdx) =
if startLine = curLine then
helpIsCursorVisible
(0, shd, stl, curIdx, maxW, maxH, 0, 0, newCursorIdx)
helpIsCursorVisible (0, shd, stl, curIdx, maxW, maxH, 0, 0, newCursorIdx)
else
let
val relativeLine = (curLine + Vector.length lhd) - startLine
@@ -321,27 +409,40 @@ struct
(* Prerequisite: move LineGap.t to startLine *)
fun isCursorVisible (lineGap: LineGap.t, newCursorIdx, startLine, maxW, maxH) =
let
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = lineGap
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} =
lineGap
in
case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) =>
if startLine < curLine + Vector.length lhd then
(* startLine in this node *)
startIsCursorVisible
( curIdx, shd, stl, lhd, startLine, curLine
, maxW, maxH, newCursorIdx
( curIdx
, shd
, stl
, lhd
, startLine
, curLine
, maxW
, maxH
, newCursorIdx
)
else
(* startLine is in stl *)
(case (stl, ltl) of
(stlhd :: stltl, ltlhd :: ltltl) =>
startIsCursorVisible
( curIdx, stlhd, stltl, ltlhd, startLine, curLine
, maxW, maxH, newCursorIdx
( curIdx
, stlhd
, stltl
, ltlhd
, startLine
, curLine
, maxW
, maxH
, newCursorIdx
)
| (_, _) =>
true)
| (_, _) =>
true
| (_, _) => true)
| (_, _) => true
end
end

12
message-types/input-msg.sml
View File

@@ -1,15 +1,7 @@
signature INPUT_MSG =
sig
datatype t =
CHAR_EVENT of char
| KEY_ESC
| RESIZE_EVENT of int * int
datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int
end
structure InputMsg :> INPUT_MSG =
struct
datatype t =
CHAR_EVENT of char
| KEY_ESC
| RESIZE_EVENT of int * int
end
struct datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int end

8
message-types/mailbox-type.sml
View File

@@ -1,11 +1,7 @@
signature MAILBOX_TYPE =
sig
datatype t =
DRAW of DrawMsg.t
datatype t = DRAW of DrawMsg.t
end
structure MailboxType :> MAILBOX_TYPE =
struct
datatype t =
DRAW of DrawMsg.t
end
struct datatype t = DRAW of DrawMsg.t end

3
shf-tests.mlb
View File

@@ -29,7 +29,8 @@ fcore/text-window.sml
fcore/finish.sml
fcore/move.sml
fcore/app-update.sml
(* TEST FILES *)
(* TEST FILES *)
test/Railroad/src/railroad.mlb
test/normal-move.sml
test/test.sml

1825
test/normal-move.sml Normal file
View File

File diff suppressed because it is too large Load Diff

1811
test/test.sml
View File

File diff suppressed because it is too large Load Diff