diff --git a/fcore/app-type.sml b/fcore/app-type.sml index 2be927f..bacdcc4 100644 --- a/fcore/app-type.sml +++ b/fcore/app-type.sml @@ -1,4 +1,5 @@ structure AppType = struct - + type app_type = + {buffer: LineGap.t, windowWidth: int, windowHeight: int} end diff --git a/fcore/app-update.sml b/fcore/app-update.sml new file mode 100644 index 0000000..cb5cf55 --- /dev/null +++ b/fcore/app-update.sml @@ -0,0 +1,24 @@ +structure AppUpdate = +struct + open AppType + + open MailboxType + open DrawMsg + open InputMsg + + fun resizeText (app: app_type, newWidth, newHeight) = + let + val {buffer, windowWidth, windowHeight} = app + val (textVec, newBuffer) = + TextBuilder.build (0, buffer, newWidth, newHeight) + + val newApp = + {buffer = newBuffer, windowWidth = newWidth, windowHeight = newHeight} + val msg = REDRAW_TEXT textVec + in + (newApp, [DRAW msg]) + end + + fun update (app, msg) = + case msg of RESIZE_EVENT (width, height) => resizeText (app, width, height) +end diff --git a/fcore/text-builder.sml b/fcore/text-builder.sml index fadb6ac..712fc3e 100644 --- a/fcore/text-builder.sml +++ b/fcore/text-builder.sml @@ -136,45 +136,6 @@ struct ) | [] => acc - (* todo: - * before calling continueBuildTextLineGap, - * find start position inside LineGap - * to start building from *) - fun startBuildTextLineGap (startLine, lineGap: LineGap.t, windowWidth, windowHeight) = - let - val lineGap = LineGap.goToLine (startLine, lineGap) - val {rightStrings, rightLines, line = curLine, ...} = lineGap - - val acc = case (rightStrings, rightLines) of - (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 - in -buildTextString ( startIdx, rStrHd, [], 5, 5, 5 - , windowWidth, windowHeight, - Real32.fromInt windowWidth, Real32.fromInt windowHeight - , 0.0, 0.0, 0.0, rStrTl - ) - end - | (_, _) => - (* requested line goes beyond the buffer, - * so just return empty list as there is nothig - * else we can do. *) - [] - in - Vector.concat acc - end - fun build (startLine, lineGap: LineGap.t, windowWidth, windowHeight) = let diff --git a/message-types/draw-msg.sml b/message-types/draw-msg.sml new file mode 100644 index 0000000..848dee7 --- /dev/null +++ b/message-types/draw-msg.sml @@ -0,0 +1,5 @@ +structure DrawMsg = +struct + datatype t = + REDRAW_TEXT of Real32.real vector +end diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml new file mode 100644 index 0000000..cdd80b2 --- /dev/null +++ b/message-types/input-msg.sml @@ -0,0 +1,5 @@ +structure InputMsg = +struct + datatype t = + RESIZE_EVENT of int * int +end diff --git a/message-types/mailbox-type.sml b/message-types/mailbox-type.sml new file mode 100644 index 0000000..02941b1 --- /dev/null +++ b/message-types/mailbox-type.sml @@ -0,0 +1,5 @@ +structure MailboxType = +struct + datatype t = + DRAW of DrawMsg.t +end diff --git a/shell/update-thread.sml b/shell/update-thread.sml new file mode 100644 index 0000000..44b58db --- /dev/null +++ b/shell/update-thread.sml @@ -0,0 +1,25 @@ +structure UpdateThread = +struct + open CML + open MailboxType + + fun sendMsg (msg, drawMailbox) = + case msg of DRAW msg => Mailbox.send (drawMailbox, msg) + + fun sendMsgs (msgList, drawMailbox) = + case msgList of + hd :: tl => + let val _ = sendMsg (hd, drawMailbox) + in sendMsgs (tl, drawMailbox) + end + | [] => () + + fun loop (app: AppType.app_type, inputMailbox, drawMailbox) = + let + val inputMsg = Mailbox.recv inputMailbox + val (app, msgList) = AppUpdate.update (app, inputMsg) + val _ = sendMsgs (msgList, drawMailbox) + in + loop (app, inputMailbox, drawMailbox) + end +end diff --git a/shf b/shf index 325237c..187e0b2 100755 Binary files a/shf and b/shf differ diff --git a/shf.mlb b/shf.mlb index f0ee053..824ef3b 100644 --- a/shf.mlb +++ b/shf.mlb @@ -5,7 +5,13 @@ lib/brolib-sml/src/line_gap.sml lib/cozette-sml/fonts/cozette-ascii.mlb (* FUNCTIONAL CORE *) +message-types/input-msg.sml +message-types/draw-msg.sml +message-types/mailbox-type.sml + +fcore/app-type.sml fcore/text-builder.sml +fcore/app-update.sml (* IMPERATIVE SHELL *) $(SML_LIB)/basis/mlton.mlb @@ -19,6 +25,7 @@ in ffi/glfw-input.sml end +shell/update-thread.sml shell/gl-shaders.sml shell/gl-draw.sml shell/shell.sml