diff --git a/build-unix.sh b/build-unix.sh index a356099..acd95e3 100755 --- a/build-unix.sh +++ b/build-unix.sh @@ -5,4 +5,4 @@ mlton -link-opt "$(pkg-config --cflags glfw3) $(pkg-config --static --libs glfw3 ffi/glad.c \ ffi/glfw-export.c \ ffi/gles3-export.c \ - ffi/glfw-key-input.c + ffi/glfw-input.c diff --git a/dot-to-dot b/dot-to-dot index f392f5b..ba4ff47 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 56c2ac2..89bb2e5 100644 --- a/dot-to-dot.mlb +++ b/dot-to-dot.mlb @@ -7,10 +7,12 @@ ann in ffi/gles3-import.sml ffi/glfw-import.sml - ffi/glfw-key-input.sml + ffi/glfw-input.sml end functional-core/app-type.sml +functional-core/msg.sml +functional-core/app-update.sml ann "allowVectorExps true" @@ -19,4 +21,5 @@ in end imperative-shell/app-draw.sml +imperative-shell/input-callbacks.sml imperative-shell/shell.sml diff --git a/ffi/export.h b/ffi/export.h index 9dadc6d..2ae940a 100644 --- a/ffi/export.h +++ b/ffi/export.h @@ -157,7 +157,8 @@ typedef Pointer Objptr; extern "C" { #endif -MLLIB_PUBLIC(void printFromMLton (Int32 x0, Int32 x1, Int32 x2, Int32 x3);) +MLLIB_PUBLIC(void mltonMouseMoveCallback (Int32 x0, Int32 x1);) +MLLIB_PUBLIC(void mltonMouseClickCallback (Int32 x0, Int32 x1);) #undef MLLIB_PRIVATE #undef MLLIB_PUBLIC diff --git a/ffi/glfw-input.c b/ffi/glfw-input.c new file mode 100644 index 0000000..bb3ba30 --- /dev/null +++ b/ffi/glfw-input.c @@ -0,0 +1,25 @@ +#include "export.h" +#include + +int MOUSE_PRESSED = GLFW_PRESS; +int MOUSE_RELEASED = GLFW_RELEASE; +int LEFT_MOUSE_BUTTON = GLFW_MOUSE_BUTTON_1; + +// Calls function exported from SML +void mouseMoveCallback(GLFWwindow *window, double xpos, double ypos) { + mltonMouseMoveCallback((int)xpos, (int)ypos); +} + +void mouseClickCallback(GLFWwindow *window, int button, int action, int mods) { + mltonMouseClickCallback(button, action); +} + +// Call this from MLton to register key callback with GLFW. +void setMouseMoveCallback(GLFWwindow *window) { + glfwSetCursorPosCallback(window, mouseMoveCallback); +} + +void setMouseClickCallback(GLFWwindow *window) { + glfwSetMouseButtonCallback(window, mouseClickCallback); +} + diff --git a/ffi/glfw-input.sml b/ffi/glfw-input.sml new file mode 100644 index 0000000..608fc64 --- /dev/null +++ b/ffi/glfw-input.sml @@ -0,0 +1,24 @@ +structure Input = +struct + type window = MLton.Pointer.t + + (* Export function to C. *) + val exportMouseMoveCallback = + _export "mltonMouseMoveCallback" public : (int * int -> unit) -> unit; + + (* Import function to set callback for GLFW. *) + val setMouseMoveCallback = _import "setMouseMoveCallback" public reentrant : window -> unit; + + val exportMouseClickCallback = + _export "mltonMouseClickCallback" public : (int * int -> unit) -> unit; + + val setMouseClickCallback = _import "setMouseClickCallback" public reentrant : window -> unit; + + (* Constants for mouse input. *) + val (MOUSE_PRESSED, _) = + _symbol "MOUSE_PRESSED" public : ( unit -> int ) * ( int -> unit ); + val (MOUSE_RELEASED, _) = + _symbol "MOUSE_RELEASED" public : ( unit -> int ) * ( int -> unit ); + val (LEFT_MOUSE_BUTTON, _) = + _symbol "LEFT_MOUSE_BUTTON" public : ( unit -> int ) * ( int -> unit ); +end diff --git a/ffi/glfw-key-input.c b/ffi/glfw-key-input.c deleted file mode 100644 index b6b63bf..0000000 --- a/ffi/glfw-key-input.c +++ /dev/null @@ -1,14 +0,0 @@ -#include "export.h" -#include -#include - -// Calls function exported from SML -void keyCallback(GLFWwindow *window, int key, int scancode, int action, int mods) { - printFromMLton(key, scancode, action, mods); -} - -// Call this from MLton to register key callback with GLFW. -void setKeyCallback(GLFWwindow *window) { - glfwSetKeyCallback(window, keyCallback); -} - diff --git a/ffi/glfw-key-input.sml b/ffi/glfw-key-input.sml deleted file mode 100644 index e762f84..0000000 --- a/ffi/glfw-key-input.sml +++ /dev/null @@ -1,11 +0,0 @@ -structure Key = -struct - type window = MLton.Pointer.t - - (* Export function to C. *) - val export = - _export "printFromMLton" public : (int * int * int * int -> unit) -> unit; - - (* Import function to set callback for GLFW. *) - val setCallback = _import "setKeyCallback" public reentrant : window -> unit; -end diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml new file mode 100644 index 0000000..365cecd --- /dev/null +++ b/functional-core/app-update.sml @@ -0,0 +1 @@ +structure AppUpdate = struct end diff --git a/functional-core/msg.sml b/functional-core/msg.sml new file mode 100644 index 0000000..9eb30a7 --- /dev/null +++ b/functional-core/msg.sml @@ -0,0 +1,15 @@ +signature MSG = +sig + datatype t = + MOUSE_MOVE of {x: int, y: int} + | MOUSE_LEFT_CLICK + | MOUSE_LEFT_RELEASE +end + +structure Msg :> MSG = +struct + datatype t = + MOUSE_MOVE of {x: int, y: int} + | MOUSE_LEFT_CLICK + | MOUSE_LEFT_RELEASE +end diff --git a/imperative-shell/input-callbacks.sml b/imperative-shell/input-callbacks.sml new file mode 100644 index 0000000..99eb570 --- /dev/null +++ b/imperative-shell/input-callbacks.sml @@ -0,0 +1,17 @@ +structure InputCallbacks = +struct + open CML + open Msg + + fun mouseMoveCallback mailbox (x, y) = + Mailbox.send (mailbox, (MOUSE_MOVE {x = x, y = y})) + + fun mouseClickCallback mailbox (button, action) = + if button = Input.LEFT_MOUSE_BUTTON () then + if action = Input.MOUSE_PRESSED () then + Mailbox.send (mailbox, MOUSE_LEFT_CLICK) + else + Mailbox.send (mailbox, MOUSE_LEFT_RELEASE) + else + () +end diff --git a/imperative-shell/shell.sml b/imperative-shell/shell.sml index 17edf32..225fba3 100644 --- a/imperative-shell/shell.sml +++ b/imperative-shell/shell.sml @@ -2,29 +2,16 @@ structure Shell = struct open CML - datatype msg = KEY of int * int * int * int - - fun keyCallback mailbox (key, scancode, action, mode) = - ( print "hello\n" - ; Mailbox.send (mailbox, (KEY (key, scancode, action, mode))) - ) - fun callbackListener mailbox = let + open Msg val _ = case Mailbox.recv mailbox of - KEY (key, scancode, action, mode) => + MOUSE_MOVE {x, y} => print (String.concat - [ "key: " - , Int.toString key - , " scancode: " - , Int.toString scancode - , " action: " - , Int.toString action - , " mode: " - , Int.toString mode - , "\n" - ]) + ["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 @@ -62,9 +49,14 @@ struct (* Set callback sender *) val _ = CML.spawn (fn () => let - val kbCallback = keyCallback inputMailbox - val _ = Key.export kbCallback - val _ = Key.setCallback window + val mouseMoveCallback = InputCallbacks.mouseMoveCallback inputMailbox + val _ = Input.exportMouseMoveCallback mouseMoveCallback + val _ = Input.setMouseMoveCallback window + + val mouseClickCallback = + InputCallbacks.mouseClickCallback inputMailbox + val _ = Input.exportMouseClickCallback mouseClickCallback + val _ = Input.setMouseClickCallback window in () end)