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 else
let let
val searchList = val searchList =
if SearchList.exists (matchedIdx, searchList) then if SearchList.exists (matchedIdx, searchList) then searchList
searchList else SearchList.insert (matchedIdx, searchList)
else
SearchList.insert (matchedIdx, searchList)
in in
helpFromRange helpFromRange
( origIdx ( origIdx

1315
fcore/cursor.sml
View File

File diff suppressed because it is too large Load Diff

2
fcore/text-constants.sml
View File

@@ -3,5 +3,5 @@ struct
val xSpace = 13 val xSpace = 13
val xSpace3 = xSpace * 3 val xSpace3 = xSpace * 3
val ySpace = 25 val ySpace = 25
val fontSize : Real32.real = 30.0 val fontSize: Real32.real = 30.0
end end

525
fcore/text-window.sml
View File

@@ -8,89 +8,151 @@ struct
hd :: tl => hd :: tl =>
getStartLineBefore getStartLineBefore
(String.size hd - 1, hd, lineNum, absIdx, cursorIdx, tl) (String.size hd - 1, hd, lineNum, absIdx, cursorIdx, tl)
| [] => | [] => 0
0 else if absIdx = cursorIdx then
Int.max (lineNum - 1, 0)
else else
if absIdx = cursorIdx then let
Int.max (lineNum - 1, 0) val chr = String.sub (shd, sIdx)
else in
let if chr = #"\n" then
val chr = String.sub (shd, sIdx) getStartLineBefore
in (sIdx - 1, shd, lineNum - 1, absIdx - 1, cursorIdx, stl)
if chr = #"\n" then else
getStartLineBefore getStartLineBefore
(sIdx - 1, shd, lineNum - 1, absIdx - 1, cursorIdx, stl) (sIdx - 1, shd, lineNum, absIdx - 1, cursorIdx, stl)
else
getStartLineBefore
(sIdx - 1, shd, lineNum, absIdx - 1, cursorIdx, stl)
end end
fun getStartLineAfter fun getStartLineAfter
( sIdx, shd, lineNum, absIdx, cursorIdx, stl ( sIdx
, maxWidth, maxHeight, curWidth, curHeight , shd
, origLine , lineNum
) = , absIdx
if sIdx = String.size shd then , cursorIdx
case stl of , stl
hd :: tl => , 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
, origLine
)
| [] => origLine
else if absIdx = cursorIdx then
origLine
else
let
val chr = String.sub (shd, sIdx)
in
if
chr = #"\n"
then
if curHeight + (ySpace * 3) >= maxHeight then
getStartLineAfter getStartLineAfter
( 0, hd, lineNum, absIdx, cursorIdx, tl ( sIdx + 1
, maxWidth, maxHeight, curWidth, curHeight , 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
, origLine , origLine
) )
| [] => else if
origLine curWidth + xSpace <= maxWidth
else then
if absIdx = cursorIdx then
origLine
else
let let
val chr = String.sub (shd, sIdx) val curWidth = curWidth + xSpace
in in
if chr = #"\n" then getStartLineAfter
if curHeight + (ySpace * 3) >= maxHeight then ( sIdx + 1
getStartLineAfter , shd
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl , lineNum
, maxWidth, maxHeight, 0, curHeight + ySpace , absIdx + 1
, origLine + 1 , cursorIdx
) , stl
else , maxWidth
getStartLineAfter , maxHeight
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl , curWidth
, maxWidth, maxHeight, 0, curHeight + ySpace , curHeight
, origLine , origLine
) )
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
, origLine
)
end
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
, origLine + 1
)
else
getStartLineAfter
( sIdx + 1, shd, lineNum + 1, absIdx + 1, cursorIdx, stl
, maxWidth, maxHeight, 0, curHeight + ySpace
, origLine
)
end end
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
, origLine + 1
)
else
getStartLineAfter
( sIdx + 1
, shd
, lineNum + 1
, absIdx + 1
, cursorIdx
, stl
, maxWidth
, maxHeight
, 0
, curHeight + ySpace
, origLine
)
end
(* Prerequisite: LineGap is moved to oldLine first. *) (* Prerequisite: LineGap is moved to oldLine first. *)
fun getStartLine (lineGap: LineGap.t, oldLine, cursorIdx, maxWidth, maxHeight) = fun getStartLine (lineGap: LineGap.t, oldLine, cursorIdx, maxWidth, maxHeight) =
let let
val {rightStrings, rightLines, line = curLine, idx = curIdx, leftStrings, ...} = lineGap val
{ rightStrings
, rightLines
, line = curLine
, idx = curIdx
, leftStrings
, ...
} = lineGap
in in
case (rightStrings, rightLines) of case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: _) => (rStrHd :: rStrTl, rLnHd :: _) =>
@@ -106,7 +168,7 @@ struct
end end
else else
0 0
val absIdx = curIdx + startIdx val absIdx = curIdx + startIdx
in in
if cursorIdx < absIdx then if cursorIdx < absIdx then
(* move upwards *) (* move upwards *)
@@ -115,20 +177,33 @@ struct
else if cursorIdx = absIdx + 1 then else if cursorIdx = absIdx + 1 then
(* double linebreak *) (* double linebreak *)
getStartLineBefore getStartLineBefore
(startIdx + 1, rStrHd, oldLine, absIdx + 1, cursorIdx, leftStrings) ( startIdx + 1
, rStrHd
, oldLine
, absIdx + 1
, cursorIdx
, leftStrings
)
else if cursorIdx > absIdx then else if cursorIdx > absIdx then
(* possibly move downwards *) (* possibly move downwards *)
getStartLineAfter getStartLineAfter
( startIdx, rStrHd, oldLine, absIdx, cursorIdx, rStrTl ( startIdx
, maxWidth, maxHeight, 0, 0 , rStrHd
, oldLine , oldLine
) , absIdx
, cursorIdx
, rStrTl
, maxWidth
, maxHeight
, 0
, 0
, oldLine
)
else else
(* keep current line *) (* keep current line *)
Int.max (oldLine - 1, 0) Int.max (oldLine - 1, 0)
end end
| (_, _) => | (_, _) => oldLine
oldLine
end end
fun helpCentreCursor (strPos, str, lineNum, stl, maxW, halfH, curW, curH) = fun helpCentreCursor (strPos, str, lineNum, stl, maxW, halfH, curW, curH) =
@@ -137,42 +212,37 @@ struct
hd :: tl => hd :: tl =>
helpCentreCursor helpCentreCursor
(String.size hd - 1, hd, lineNum, tl, maxW, halfH, curW, curH) (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 else
let let
val chr = String.sub (str, strPos) val chr = String.sub (str, strPos)
in in
if chr = #"\n" then if
chr = #"\n"
then
if curH + (ySpace * 3) >= halfH then if curH + (ySpace * 3) >= halfH then
(* if we exceeded half the screen *) (* if we exceeded half the screen *)
lineNum lineNum
else else
helpCentreCursor helpCentreCursor
( strPos - 1, str, lineNum - 1, stl, maxW, halfH (strPos - 1, str, lineNum - 1, stl, maxW, halfH, 0, curH + ySpace)
, 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)
end
else (* have to create visual line break *) if
curH + (ySpace * 3) >= halfH
then
(* if at limit, return current line lineNum *)
lineNum
else else
if curW + xSpace <= maxW then helpCentreCursor
let (strPos - 1, str, lineNum - 1, stl, maxW, halfH, 0, curH + ySpace)
val curW = curW + xSpace
in
helpCentreCursor
( strPos - 1, str, lineNum, stl, maxW, halfH
, curW + xSpace, curH
)
end
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
)
end end
(* search for prev \n, and once found, (* search for prev \n, and once found,
@@ -181,10 +251,8 @@ struct
if strPos < 0 then if strPos < 0 then
case stl of case stl of
hd :: tl => hd :: tl =>
getCursorStartLine getCursorStartLine (String.size hd - 1, hd, lineNum, tl, maxW, halfH)
(String.size hd - 1, hd, lineNum, tl, maxW, halfH) | [] => 0
| [] =>
0
else else
let let
val chr = String.sub (str, strPos) val chr = String.sub (str, strPos)
@@ -194,21 +262,15 @@ struct
helpCentreCursor helpCentreCursor
(strPos - 1, str, lineNum - 1, stl, maxW, halfH, xSpace, ySpace) (strPos - 1, str, lineNum - 1, stl, maxW, halfH, xSpace, ySpace)
else else
getCursorStartLine getCursorStartLine (strPos - 1, str, lineNum, stl, maxW, halfH)
(strPos - 1, str, lineNum, stl, maxW, halfH)
end end
fun getLineNum (strIdx, lhd, bufferLine) = fun getLineNum (strIdx, lhd, bufferLine) =
if Vector.length lhd = 0 then if Vector.length lhd = 0 then
bufferLine bufferLine
else if Vector.length lhd = 1 then else if Vector.length lhd = 1 then
let let val lineIdx = Vector.sub (lhd, 0)
val lineIdx = Vector.sub (lhd, 0) in if lineIdx < strIdx then bufferLine + 1 else bufferLine
in
if lineIdx < strIdx then
bufferLine + 1
else
bufferLine
end end
else else
let let
@@ -225,123 +287,162 @@ struct
(* Prerequisite: LineGap is moved to cursor *) (* Prerequisite: LineGap is moved to cursor *)
fun getStartLineWithCursorCentered fun getStartLineWithCursorCentered
(lineGap: LineGap.t, cursorIdx, origLine, maxWidth, maxHeight) = (lineGap: LineGap.t, cursorIdx, origLine, maxWidth, maxHeight) =
let let
val {rightStrings, rightLines, idx = bufferIdx, line = bufferLine, leftStrings, ...} = lineGap val
in { rightStrings
case (rightStrings, rightLines) of , rightLines
(shd :: stl, lhd :: ltl) => , idx = bufferIdx
let , line = bufferLine
(* convert absolute cursorIdx to idx relative to hd string *) , leftStrings
val strIdx = cursorIdx - bufferIdx , ...
in } = lineGap
if strIdx < String.size shd then in
(* strIdx is in hd *) case (rightStrings, rightLines) of
let (shd :: stl, lhd :: ltl) =>
val lineNum = getLineNum (strIdx, lhd, bufferLine) let
in (* convert absolute cursorIdx to idx relative to hd string *)
getCursorStartLine val strIdx = cursorIdx - bufferIdx
(strIdx, shd, lineNum, leftStrings, maxWidth, maxHeight) in
end if strIdx < String.size shd then
else (* strIdx is in hd *)
(* strIdx is in tl *) let
case (stl, ltl) of val lineNum = getLineNum (strIdx, lhd, bufferLine)
(stlhd :: stltl, ltlhd :: _) => in
let getCursorStartLine
val strIdx = strIdx - String.size shd (strIdx, shd, lineNum, leftStrings, maxWidth, maxHeight)
val bufferLine = bufferLine + Vector.length lhd end
val lineNum = getLineNum (strIdx, ltlhd, bufferLine) else
val leftStrings = shd :: leftStrings (* strIdx is in tl *)
in case (stl, ltl) of
getCursorStartLine (stlhd :: stltl, ltlhd :: _) =>
(strIdx, stlhd, lineNum, leftStrings, maxWidth, maxHeight) let
end val strIdx = strIdx - String.size shd
| (_, _) => val bufferLine = bufferLine + Vector.length lhd
origLine val lineNum = getLineNum (strIdx, ltlhd, bufferLine)
end val leftStrings = shd :: leftStrings
| (_, _) => in
origLine getCursorStartLine
end (strIdx, stlhd, lineNum, leftStrings, maxWidth, maxHeight)
end
| (_, _) => origLine
end
| (_, _) => origLine
end
fun helpIsCursorVisible fun helpIsCursorVisible
(strPos, str, stl, absIdx, maxW, maxH, curW, curH, newCursorIdx) = (strPos, str, stl, absIdx, maxW, maxH, curW, curH, newCursorIdx) =
if strPos = String.size str then if strPos = String.size str then
case stl of case stl of
hd :: tl => hd :: tl =>
helpIsCursorVisible helpIsCursorVisible
(0, hd, tl, absIdx, maxW, maxH, curW, curH, newCursorIdx) (0, hd, tl, absIdx, maxW, maxH, curW, curH, newCursorIdx)
| [] => | [] => true
true else if absIdx = newCursorIdx then
else true
if absIdx = newCursorIdx then else
true let
val chr = String.sub (str, strPos)
in
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
)
else if
curW + xSpace <= maxW
then
helpIsCursorVisible
( 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
false
else else
let helpIsCursorVisible
val chr = String.sub (str, strPos) ( strPos + 1
in , str
if chr = #"\n" then , stl
if curH + (ySpace * 3) >= maxH then , absIdx + 1
false , maxW
else , maxH
helpIsCursorVisible , 0
( strPos + 1, str, stl, absIdx + 1 , curH + ySpace
, maxW, maxH, 0, curH + ySpace, newCursorIdx , newCursorIdx
) )
else end
if curW + xSpace <= maxW then
helpIsCursorVisible
( 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
false
else
helpIsCursorVisible
( strPos + 1, str, stl, absIdx + 1
, maxW, maxH, 0, curH + ySpace, newCursorIdx
)
end
fun startIsCursorVisible fun startIsCursorVisible
(curIdx, shd, stl, lhd, startLine, curLine, maxW, maxH, newCursorIdx) = (curIdx, shd, stl, lhd, startLine, curLine, maxW, maxH, newCursorIdx) =
if startLine = curLine then if startLine = curLine then
helpIsCursorVisible (0, shd, stl, curIdx, maxW, maxH, 0, 0, newCursorIdx)
else
let
val relativeLine = (curLine + Vector.length lhd) - startLine
val lineIdx = Vector.sub (lhd, relativeLine)
val absIdx = curIdx + lineIdx
in
helpIsCursorVisible helpIsCursorVisible
(0, shd, stl, curIdx, maxW, maxH, 0, 0, newCursorIdx) (lineIdx, shd, stl, absIdx, maxW, maxH, 0, 0, newCursorIdx)
else end
let
val relativeLine = (curLine + Vector.length lhd) - startLine
val lineIdx = Vector.sub (lhd, relativeLine)
val absIdx = curIdx + lineIdx
in
helpIsCursorVisible
(lineIdx, shd, stl, absIdx, maxW, maxH, 0, 0, newCursorIdx)
end
(* Prerequisite: move LineGap.t to startLine *) (* Prerequisite: move LineGap.t to startLine *)
fun isCursorVisible (lineGap: LineGap.t, newCursorIdx, startLine, maxW, maxH) = fun isCursorVisible (lineGap: LineGap.t, newCursorIdx, startLine, maxW, maxH) =
let let
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = lineGap val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} =
lineGap
in in
case (rightStrings, rightLines) of case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) => (shd :: stl, lhd :: ltl) =>
if startLine < curLine + Vector.length lhd then if startLine < curLine + Vector.length lhd then
(* startLine in this node *) (* startLine in this node *)
startIsCursorVisible startIsCursorVisible
( curIdx, shd, stl, lhd, startLine, curLine ( curIdx
, maxW, maxH, newCursorIdx , shd
, stl
, lhd
, startLine
, curLine
, maxW
, maxH
, newCursorIdx
) )
else else
(* startLine is in stl *) (* startLine is in stl *)
(case (stl, ltl) of (case (stl, ltl) of
(stlhd :: stltl, ltlhd :: ltltl) => (stlhd :: stltl, ltlhd :: ltltl) =>
startIsCursorVisible startIsCursorVisible
( curIdx, stlhd, stltl, ltlhd, startLine, curLine ( curIdx
, maxW, maxH, newCursorIdx , stlhd
) , stltl
| (_, _) => , ltlhd
true) , startLine
| (_, _) => , curLine
true , maxW
, maxH
, newCursorIdx
)
| (_, _) => true)
| (_, _) => true
end end
end end

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

@@ -1,15 +1,7 @@
signature INPUT_MSG = signature INPUT_MSG =
sig sig
datatype t = datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int
CHAR_EVENT of char
| KEY_ESC
| RESIZE_EVENT of int * int
end end
structure InputMsg :> INPUT_MSG = structure InputMsg :> INPUT_MSG =
struct struct datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int end
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 = signature MAILBOX_TYPE =
sig sig
datatype t = datatype t = DRAW of DrawMsg.t
DRAW of DrawMsg.t
end end
structure MailboxType :> MAILBOX_TYPE = structure MailboxType :> MAILBOX_TYPE =
struct struct datatype t = DRAW of DrawMsg.t end
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/finish.sml
fcore/move.sml fcore/move.sml
fcore/app-update.sml fcore/app-update.sml
(* TEST FILES *)
(* TEST FILES *)
test/Railroad/src/railroad.mlb test/Railroad/src/railroad.mlb
test/normal-move.sml
test/test.sml test/test.sml

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

File diff suppressed because it is too large Load Diff

1815
test/test.sml
View File

File diff suppressed because it is too large Load Diff