add callbacks for mouse movement and mouse clicking

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

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

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

ffi/glfw-input.c

@@ -0,0 +1,25 @@
+#include "export.h"
+#include <GLFW/glfw3.h>
+
+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);
+}
+

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

ffi/glfw-key-input.c

@@ -1,14 +0,0 @@
-#include "export.h"
-#include <GLFW/glfw3.h>
-#include <stdbool.h>
-
-// 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);
-}
-

ffi/glfw-key-input.sml

@@ -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

functional-core/app-update.sml

@@ -0,0 +1 @@
+structure AppUpdate = struct end

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

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

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)