diff --git a/fcore/app-type.sml b/fcore/app-type.sml index 3baa991..d50c444 100644 --- a/fcore/app-type.sml +++ b/fcore/app-type.sml @@ -1,8 +1,12 @@ structure AppType = struct type app_type = - {buffer: LineGap.t, windowWidth: int, windowHeight: int} + {buffer: LineGap.t, windowWidth: int, windowHeight: int, startLine: int} - fun init (buffer, windowWidth, windowHeight): app_type = - {buffer = buffer, windowWidth = windowWidth, windowHeight = windowHeight} + fun init (buffer, windowWidth, windowHeight) : app_type = + { buffer = buffer + , windowWidth = windowWidth + , windowHeight = windowHeight + , startLine = 0 + } end diff --git a/fcore/app-update.sml b/fcore/app-update.sml index cb5cf55..c8f42ae 100644 --- a/fcore/app-update.sml +++ b/fcore/app-update.sml @@ -8,12 +8,13 @@ struct fun resizeText (app: app_type, newWidth, newHeight) = let - val {buffer, windowWidth, windowHeight} = app - val (textVec, newBuffer) = - TextBuilder.build (0, buffer, newWidth, newHeight) + val {buffer, windowWidth, windowHeight, startLine} = app - val newApp = - {buffer = newBuffer, windowWidth = newWidth, windowHeight = newHeight} + val newBuffer = LineGap.goToLine (startLine, buffer) + val textVec = + TextBuilder.build (startLine, newBuffer, newWidth, newHeight) + + val newApp = AppWith.bufferAndSize (app, newBuffer, newWidth, newHeight) val msg = REDRAW_TEXT textVec in (newApp, [DRAW msg]) diff --git a/fcore/app-with.sml b/fcore/app-with.sml new file mode 100644 index 0000000..dbd4051 --- /dev/null +++ b/fcore/app-with.sml @@ -0,0 +1,15 @@ +structure AppWith = +struct + open AppType + + fun bufferAndSize (app: app_type, newBuffer, newWidth, newHeight) = + let + val {buffer = _, windowWidth = _, windowHeight = _, startLine} = app + in + { buffer = newBuffer + , windowWidth = newWidth + , windowHeight = newHeight + , startLine = startLine + } + end +end diff --git a/fcore/text-builder.sml b/fcore/text-builder.sml index 712fc3e..f205972 100644 --- a/fcore/text-builder.sml +++ b/fcore/text-builder.sml @@ -1,14 +1,16 @@ signature TEXT_BUILDER = sig + (* Prerequisite: LineGap is moved to requested line first. *) val build: int * LineGap.t * int * int - -> Real32.real vector * LineGap.t + -> Real32.real vector end structure TextBuilder :> TEXT_BUILDER = struct - val xSpace = 12 + val xSpace = 13 val xSpace3 = xSpace * 3 - val ySpace = 23 + val ySpace = 25 + val fontSize = 30.0 (* builds text from a string with char-wrap. * char-wrap is a similar concept to word-wrap, @@ -84,7 +86,7 @@ struct (* if there is horizontal space, place char on the right *) let val chrVec = chrFun - (posX, posY, 25.0, 25.0, fWindowWidth, fWindowHeight, r, g, b) + (posX, posY, fontSize, fontSize, fWindowWidth, fWindowHeight, r, g, b) val acc = chrVec :: acc in buildTextString @@ -97,7 +99,7 @@ struct (* if there is vertical space, place char down below at startX *) let val chrVec = chrFun - ( startX, posY + 25, 25.0, 25.0 + ( startX, posY + ySpace, fontSize, fontSize , fWindowWidth, fWindowHeight , r, g, b ) @@ -147,15 +149,23 @@ struct (rStrHd :: rStrTl, rLnHd :: _) => let (* get index of line to start building from *) - val lnPos = startLine - curLine - val startIdx = Vector.sub (rLnHd, lnPos) val startIdx = - if - String.sub (rStrHd, startIdx) = #"\r" - andalso startIdx < String.size rStrHd - 1 - andalso String.sub (rStrHd, startIdx + 1) = #"\n" - then (* handle \r\n pair *) startIdx + 2 - else startIdx + 1 + if startLine > curLine then + let + val lnPos = startLine - curLine - 1 + val startIdx = Vector.sub (rLnHd, lnPos) + in + if + String.sub (rStrHd, startIdx) = #"\r" + andalso startIdx < String.size rStrHd - 1 + andalso String.sub (rStrHd, startIdx + 1) = #"\n" + then + (* handle \r\n pair *) + startIdx + 2 + else startIdx + 1 + end + else + 0 in buildTextString ( startIdx, rStrHd, [] @@ -172,6 +182,6 @@ struct * else we can do. *) [] in - (Vector.concat acc, lineGap) + Vector.concat acc end end diff --git a/shf b/shf index fa65b5c..f335bb8 100755 Binary files a/shf and b/shf differ diff --git a/shf.mlb b/shf.mlb index 824ef3b..0f47832 100644 --- a/shf.mlb +++ b/shf.mlb @@ -10,6 +10,7 @@ message-types/draw-msg.sml message-types/mailbox-type.sml fcore/app-type.sml +fcore/app-with.sml fcore/text-builder.sml fcore/app-update.sml