diff --git a/dot-to-dot b/dot-to-dot index 1cec769..84ecf9d 100755 Binary files a/dot-to-dot and b/dot-to-dot differ diff --git a/dot-to-dot.mlb b/dot-to-dot.mlb index 8b2a57d..f91b646 100644 --- a/dot-to-dot.mlb +++ b/dot-to-dot.mlb @@ -27,9 +27,5 @@ in end imperative-shell/input-callbacks.sml - -ann - "allowVectorExps true" -in - imperative-shell/shell.sml -end +imperative-shell/event-loop.sml +imperative-shell/shell.sml diff --git a/imperative-shell/app-draw.sml b/imperative-shell/app-draw.sml index 466a556..c6c07b7 100644 --- a/imperative-shell/app-draw.sml +++ b/imperative-shell/app-draw.sml @@ -93,7 +93,7 @@ struct () end - fun drawButton (buttonDrawObject: draw_object, vec) = + fun drawButton (buttonDrawObject: draw_object, buttonDrawLength) = let val {vertexBuffer, program, ...} = buttonDrawObject val _ = Gles3.bindBuffer vertexBuffer @@ -102,7 +102,7 @@ struct val _ = Gles3.vertexAttribPointer (1, 3, 5, 8) val _ = Gles3.enableVertexAttribArray 1 val _ = Gles3.useProgram program - val _ = Gles3.drawArrays (Gles3.TRIANGLES (), 0, Vector.length vec div 5) + val _ = Gles3.drawArrays (Gles3.TRIANGLES (), 0, buttonDrawLength) in () end diff --git a/imperative-shell/event-loop.sml b/imperative-shell/event-loop.sml new file mode 100644 index 0000000..81d0257 --- /dev/null +++ b/imperative-shell/event-loop.sml @@ -0,0 +1,35 @@ +structure EventLoop = +struct + open CML + open InputMessage + + fun update inputMailbox = + let + val _ = + case Mailbox.recv inputMailbox of + MOUSE_MOVE {x, y} => + print (String.concat + ["x pos: ", Int.toString x, ", y pos: ", Int.toString y, "\n"]) + | MOUSE_LEFT_CLICK => print "clicked mouse\n" + | MOUSE_LEFT_RELEASE => print "released mouse\n" + in + update inputMailbox + end + + fun draw (window, graphDrawObject, buttonDrawObject, buttonDrawLength) = + if not (Glfw.windowShouldClose window) then + let + val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0) + val _ = Gles3.clear () + + val _ = AppDraw.drawGraphLines graphDrawObject + val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength) + + val _ = Glfw.pollEvents () + val _ = Glfw.swapBuffers window + in + draw (window, graphDrawObject, buttonDrawObject, buttonDrawLength) + end + else + Glfw.terminate () +end diff --git a/imperative-shell/shell.sml b/imperative-shell/shell.sml index 0077ece..9cda3f9 100644 --- a/imperative-shell/shell.sml +++ b/imperative-shell/shell.sml @@ -2,37 +2,6 @@ structure Shell = struct open CML - fun callbackListener mailbox = - let - open InputMessage - val _ = - case Mailbox.recv mailbox of - MOUSE_MOVE {x, y} => - print (String.concat - ["x pos: ", Int.toString x, ", y pos: ", Int.toString y, "\n"]) - | MOUSE_LEFT_CLICK => print "clicked mouse\n" - | MOUSE_LEFT_RELEASE => print "released mouse\n" - in - callbackListener mailbox - end - - fun loop (window, graphDrawObject, buttonDrawObject) = - if not (Glfw.windowShouldClose window) then - let - val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0) - val _ = Gles3.clear () - - val _ = AppDraw.drawGraphLines graphDrawObject - val _ = AppDraw.drawButton (buttonDrawObject, #[]) - - val _ = Glfw.pollEvents () - val _ = Glfw.swapBuffers window - in - loop (window, graphDrawObject, buttonDrawObject) - end - else - Glfw.terminate () - fun main () = let (* Set up GLFW. *) @@ -63,9 +32,9 @@ struct () end) (* Set callback listener *) - val _ = CML.spawn (fn () => callbackListener inputMailbox) + val _ = CML.spawn (fn () => EventLoop.update inputMailbox) in - loop (window, graphDrawObject, buttonDrawObject) + EventLoop.draw (window, graphDrawObject, buttonDrawObject, 0) end end