diff --git a/fcore/app-type.sml b/fcore/app-type.sml index bacdcc4..3baa991 100644 --- a/fcore/app-type.sml +++ b/fcore/app-type.sml @@ -2,4 +2,7 @@ structure AppType = struct type app_type = {buffer: LineGap.t, windowWidth: int, windowHeight: int} + + fun init (buffer, windowWidth, windowHeight): app_type = + {buffer = buffer, windowWidth = windowWidth, windowHeight = windowHeight} end diff --git a/ffi/glfw-input.c b/ffi/glfw-input.c index d166824..252631a 100644 --- a/ffi/glfw-input.c +++ b/ffi/glfw-input.c @@ -1,4 +1,5 @@ #include "export.h" +#include "glad.h" #define GLFW_INCLUDE_NONE #include @@ -6,3 +7,12 @@ int PRESS = GLFW_PRESS; int REPEAT = GLFW_REPEAT; int RELEASE = GLFW_RELEASE; +void framebufferSizeCallback(GLFWwindow* window, int width, int height) { + glViewport(0, 0, width, height); + mltonFramebufferSizeCallback(width, height); +} + +void setFramebufferSizeCallback(GLFWwindow* window) { + glfwSetFramebufferSizeCallback(window, framebufferSizeCallback); +} + diff --git a/ffi/glfw-input.sml b/ffi/glfw-input.sml index bb8a843..424c982 100644 --- a/ffi/glfw-input.sml +++ b/ffi/glfw-input.sml @@ -17,4 +17,6 @@ struct val exportFramebufferSizeCallback = _export "mltonFramebufferSizeCallback" public : (int * int -> unit) -> unit; + val setFramebufferSizeCallback = + _import "setFramebufferSizeCallback" public : window -> unit; end diff --git a/message-types/draw-msg.sml b/message-types/draw-msg.sml index 848dee7..1b42205 100644 --- a/message-types/draw-msg.sml +++ b/message-types/draw-msg.sml @@ -1,4 +1,10 @@ -structure DrawMsg = +signature DRAW_MSG = +sig + datatype t = + REDRAW_TEXT of Real32.real vector +end + +structure DrawMsg :> DRAW_MSG = struct datatype t = REDRAW_TEXT of Real32.real vector diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index cdd80b2..18ed832 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -1,4 +1,10 @@ -structure InputMsg = +signature INPUT_MSG = +sig + datatype t = + RESIZE_EVENT of int * int +end + +structure InputMsg :> INPUT_MSG = struct datatype t = RESIZE_EVENT of int * int diff --git a/message-types/mailbox-type.sml b/message-types/mailbox-type.sml index 02941b1..8ce864d 100644 --- a/message-types/mailbox-type.sml +++ b/message-types/mailbox-type.sml @@ -1,4 +1,10 @@ -structure MailboxType = +signature MAILBOX_TYPE = +sig + datatype t = + DRAW of DrawMsg.t +end + +structure MailboxType :> MAILBOX_TYPE = struct datatype t = DRAW of DrawMsg.t diff --git a/shell/gl-draw.sml b/shell/gl-draw.sml index 55a2aaa..b8be1e3 100644 --- a/shell/gl-draw.sml +++ b/shell/gl-draw.sml @@ -1,5 +1,7 @@ structure GlDraw = struct + open CML + open DrawMsg (* The name doesn't make it clear, but this structure * couples GLFW and OpenGL. * I'm not sure if I will use native windowing systems @@ -10,6 +12,7 @@ struct { textVertexBuffer: Word32.word , textProgram: Word32.word , textDrawLength: int + , drawMailbox: DrawMsg.t Mailbox.mbox , window: MLton.Pointer.t } @@ -32,7 +35,7 @@ struct program end - fun create window = + fun create (drawMailbox, window) = let (* create vertex buffer, program, etc. for text. *) val textVertexBuffer = Gles3.createBuffer () @@ -51,19 +54,24 @@ struct { textVertexBuffer = textVertexBuffer , textProgram = textProgram , textDrawLength = 0 + , drawMailbox = drawMailbox , window = window } end - fun uploadText - ({textVertexBuffer, textProgram, window, textDrawLength = _}: t, vec) = + fun uploadText (shellState: t, vec) = let + val + {textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} = + shellState + val _ = Gles3.bindBuffer textVertexBuffer val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) val newTextDrawLength = Vector.length vec div 5 in { textVertexBuffer = textVertexBuffer , textProgram = textProgram + , drawMailbox = drawMailbox , window = window , textDrawLength = newTextDrawLength } @@ -93,10 +101,30 @@ struct in () end + + fun consumeDrawEvent (shellState, msg) = + let + val + {textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} = + shellState + in + case msg of REDRAW_TEXT textVec => uploadText (shellState, textVec) + end + + fun consumeDrawEvents (shellState as {drawMailbox, ...}: t) = + case Mailbox.recvPoll drawMailbox of + NONE => shellState + | SOME msg => + let val shellState = consumeDrawEvent (shellState, msg) + in consumeDrawEvents shellState + end + fun helpLoop (shellState as {window, ...}: t) = case Glfw.windowShouldClose window of false => let + val shellState = consumeDrawEvents shellState + val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0) val _ = Gles3.clear () @@ -109,8 +137,8 @@ struct end | true => Glfw.terminate () - fun loop window = - let val shellState = create window + fun loop (drawMailbox, window) = + let val shellState = create (drawMailbox, window) in helpLoop shellState end end diff --git a/shell/shell.sml b/shell/shell.sml index 9d6c94b..4526329 100644 --- a/shell/shell.sml +++ b/shell/shell.sml @@ -1,6 +1,19 @@ structure Shell = struct open CML + open InputMsg + + fun frameBufferSizeCallback inputMailbox (width, height) = + Mailbox.send (inputMailbox, RESIZE_EVENT (width, height)) + + fun registerCallbacks (inputMailbox, window) = + let + val resizeCallback = frameBufferSizeCallback inputMailbox + val () = Input.exportFramebufferSizeCallback resizeCallback + val () = Input.setFramebufferSizeCallback window + in + () + end fun ioToLineGap (io, acc) = case TextIO.inputLine io of @@ -18,16 +31,21 @@ struct val _ = Glfw.makeContextCurrent window val _ = Gles3.loadGlad () - (* upload text vector *) + (* load file intol gap buffer and create initial app *) val io = TextIO.openIn "fcore/text-builder.sml" val lineGap = ioToLineGap (io, LineGap.empty) val _ = TextIO.closeIn io + val app = AppType.init (lineGap, 1920, 1080) - val (textVec, _) = TextBuilder.build (0, lineGap, 1920, 1080) - val shellState = GlDraw.create window - val shellState = GlDraw.uploadText (shellState, textVec) + (* create mailboxes for CML communication *) + val inputMailbox = Mailbox.mailbox () + val drawMailbox = Mailbox.mailbox () - val _ = GlDraw.helpLoop shellState + val () = registerCallbacks (inputMailbox, window) + + val _ = CML.spawn (fn () => GlDraw.loop (drawMailbox, window)) + val _ = CML.spawn (fn () => + UpdateThread.loop (app, inputMailbox, drawMailbox)) in () end diff --git a/shf b/shf index 187e0b2..fa65b5c 100755 Binary files a/shf and b/shf differ