diff --git a/dotscape b/dotscape index b9477e1..dd3e33a 100755 Binary files a/dotscape and b/dotscape differ diff --git a/ffi/export.h b/ffi/export.h index a697dec..5864c66 100644 --- a/ffi/export.h +++ b/ffi/export.h @@ -160,6 +160,7 @@ extern "C" { MLLIB_PUBLIC(void mltonMouseMoveCallback (Real32 x0, Real32 x1);) MLLIB_PUBLIC(void mltonMouseClickCallback (Int32 x0, Int32 x1);) MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Int32 x0, Int32 x1);) +MLLIB_PUBLIC(void mltonKeyCallback (Int32 x0, Int32 x1, Int32 x2, Int32 x3);) #undef MLLIB_PRIVATE #undef MLLIB_PUBLIC diff --git a/ffi/glfw-input.c b/ffi/glfw-input.c index b42ab21..c16f0ea 100644 --- a/ffi/glfw-input.c +++ b/ffi/glfw-input.c @@ -1,9 +1,10 @@ #include "export.h" #include -int MOUSE_PRESSED = GLFW_PRESS; -int MOUSE_RELEASED = GLFW_RELEASE; +int PRESS = GLFW_PRESS; +int RELEASE = GLFW_RELEASE; int LEFT_MOUSE_BUTTON = GLFW_MOUSE_BUTTON_1; +int KEY_Z = GLFW_KEY_Z; // Calls function exported from SML void mouseMoveCallback(GLFWwindow *window, double xpos, double ypos) { @@ -28,3 +29,10 @@ void framebufferSizeCallback(GLFWwindow *window, int width, int height) { void setFramebufferSizeCallback(GLFWwindow *window, int width, int height) { glfwSetFramebufferSizeCallback(window, framebufferSizeCallback); } + +void keyCallback(GLFWwindow *window, int key, int scancode, int action, int mods) { + mltonKeyCallback(key, scancode, action, mods); +} +void setKeyCallback(GLFWwindow *window) { + glfwSetKeyCallback(window, keyCallback); +} diff --git a/ffi/glfw-input.sml b/ffi/glfw-input.sml index 72ddb5e..340243e 100644 --- a/ffi/glfw-input.sml +++ b/ffi/glfw-input.sml @@ -19,10 +19,18 @@ struct _import "setFramebufferSizeCallback" 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 (PRESS, _) = + _symbol "PRESS" public : ( unit -> int ) * ( int -> unit ); + val (RELEASE, _) = + _symbol "RELEASE" public : ( unit -> int ) * ( int -> unit ); val (LEFT_MOUSE_BUTTON, _) = _symbol "LEFT_MOUSE_BUTTON" public : ( unit -> int ) * ( int -> unit ); + + (* Key input *) + val exportKeyCallback = + _export "mltonKeyCallback" public : (int * int * int * int -> unit) -> unit; + val setKeyCallback = _import "setKeyCallback" public reentrant : window -> unit; + + val (KEY_Z, _) = + _symbol "KEY_Z" public : ( unit -> int ) * ( int -> unit ); end diff --git a/functional-core/app-init.sml b/functional-core/app-init.sml index c762cb6..c6046e1 100644 --- a/functional-core/app-init.sml +++ b/functional-core/app-init.sml @@ -23,6 +23,7 @@ struct , xClickPoints = xClickPoints , yClickPoints = yClickPoints , graphLines = graphLines + , undo = [] } end diff --git a/functional-core/app-type.sml b/functional-core/app-type.sml index b7c69b5..59282ec 100644 --- a/functional-core/app-type.sml +++ b/functional-core/app-type.sml @@ -23,6 +23,7 @@ sig , xClickPoints: Real32.real vector , yClickPoints: Real32.real vector , graphLines: Real32.real vector + , undo: (int * int) list } end @@ -59,5 +60,6 @@ struct , xClickPoints: Real32.real vector , yClickPoints: Real32.real vector , graphLines: Real32.real vector + , undo: (int * int) list } end diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 49cfd41..5d54789 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -103,4 +103,10 @@ struct | MOUSE_LEFT_CLICK => mouseLeftClick (model, mouseX, mouseY) | RESIZE_WINDOW {width, height} => resizeWindow (model, mouseX, mouseY, width, height) + | UNDO_ACTION => + let + val _ = print "undo action\n" + in + (model, NO_DRAW, mouseX, mouseY) + end end diff --git a/functional-core/app-with.sml b/functional-core/app-with.sml index 11706c6..f1e56ca 100644 --- a/functional-core/app-with.sml +++ b/functional-core/app-with.sml @@ -28,6 +28,7 @@ struct , windowWidth , windowHeight , graphLines + , undo } = app in { triangleStage = newTriangleStage @@ -37,6 +38,7 @@ struct , windowWidth = windowWidth , windowHeight = windowHeight , graphLines = graphLines + , undo = undo } end @@ -50,6 +52,7 @@ struct , windowWidth , windowHeight , graphLines + , undo } = app val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} @@ -62,6 +65,7 @@ struct , windowWidth = windowWidth , windowHeight = windowHeight , graphLines = graphLines + , undo = undo } end @@ -77,6 +81,7 @@ struct , graphLines = _ , triangles , triangleStage + , undo } = app val xClickPoints = ClickPoints.generate (wStart, wFinish) val yClickPoints = ClickPoints.generate (hStart, hFinish) @@ -91,6 +96,7 @@ struct , triangleStage = triangleStage , windowWidth = windowWidth , windowHeight = windowHeight + , undo = undo } end diff --git a/imperative-shell/input-callbacks.sml b/imperative-shell/input-callbacks.sml index d516970..04ef7b7 100644 --- a/imperative-shell/input-callbacks.sml +++ b/imperative-shell/input-callbacks.sml @@ -8,10 +8,8 @@ struct 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) + if action = Input.PRESS () then Mailbox.send (mailbox, MOUSE_LEFT_CLICK) + else Mailbox.send (mailbox, MOUSE_LEFT_RELEASE) else () @@ -20,6 +18,13 @@ struct in Mailbox.send (mailbox, RESIZE_WINDOW {width = width, height = height}) end + fun keyActionCallback mailbox (key, scancode, action, mods) = + if + key = Input.KEY_Z () andalso action <> Input.RELEASE () + andalso mods = 0x0002 + then Mailbox.send (mailbox, UNDO_ACTION) + else () + fun registerCallbacks (window, inputMailbox) = let val mouseMoveCallback = mouseMoveCallback inputMailbox @@ -33,6 +38,10 @@ struct val resizeCallback = framebufferSizeCallback inputMailbox val _ = Input.exportFramebufferSizeCallback resizeCallback val _ = Input.setFramebufferSizeCallback window + + val keyCallback = keyActionCallback inputMailbox + val _ = Input.exportKeyCallback keyCallback + val _ = Input.setKeyCallback window in () end diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index a73eaef..3f2ce1a 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -5,6 +5,7 @@ sig | MOUSE_LEFT_CLICK | MOUSE_LEFT_RELEASE | RESIZE_WINDOW of {width: int, height: int} + | UNDO_ACTION end structure InputMessage :> INPUT_MESSAGE = @@ -14,4 +15,5 @@ struct | MOUSE_LEFT_CLICK | MOUSE_LEFT_RELEASE | RESIZE_WINDOW of {width: int, height: int} + | UNDO_ACTION end