diff --git a/ffi/export.h b/ffi/export.h index 31022f1..f09f8a4 100644 --- a/ffi/export.h +++ b/ffi/export.h @@ -159,6 +159,7 @@ extern "C" { MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Int32 x0, Int32 x1);) MLLIB_PUBLIC(void mltonCharCallback (Word32 x0);) +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 ab99bdd..5d5f7dc 100644 --- a/ffi/glfw-input.c +++ b/ffi/glfw-input.c @@ -6,6 +6,7 @@ int PRESS = GLFW_PRESS; int REPEAT = GLFW_REPEAT; int RELEASE = GLFW_RELEASE; +int KEY_ESC = GLFW_KEY_ESCAPE; void framebufferSizeCallback(GLFWwindow* window, int width, int height) { glViewport(0, 0, width, height); @@ -24,3 +25,11 @@ void setCharCallback(GLFWwindow* window) { glfwSetCharCallback(window, charCallback); } +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 4e73e9d..cf437dd 100644 --- a/ffi/glfw-input.sml +++ b/ffi/glfw-input.sml @@ -24,4 +24,13 @@ struct _export "mltonCharCallback" public : (Word32.word -> unit) -> unit; val setCharCallback = _import "setCharCallback" public : window -> unit; + + val exportKeyCallback = + _export "mltonKeyCallback" public : (int * int * int * int -> unit) -> unit; + val setKeyCallback = + _import "setKeyCallback" public : window -> unit; + + val (KEY_ESC, _) = + _symbol "KEY_ESC" public : ( unit -> int ) * ( int -> unit ); + val KEY_ESC = KEY_ESC () end diff --git a/shell/shell.sml b/shell/shell.sml index 80cc9ba..c35de5f 100644 --- a/shell/shell.sml +++ b/shell/shell.sml @@ -14,6 +14,16 @@ struct Mailbox.send (inputMailbox, CHAR_EVENT chr) end + fun keyCallback inputMailbox (key, scancode, action, mods) = + let + open Input + in + if key = KEY_ESC andalso action = PRESS andalso mods = 0 then + Mailbox.send (inputMailbox, InputMsg.KEY_ESC) + else + () + end + fun registerCallbacks (inputMailbox, window) = let val resizeCallback = frameBufferSizeCallback inputMailbox @@ -23,6 +33,10 @@ struct val charCallback = charCallback inputMailbox val () = Input.exportCharCallback charCallback val () = Input.setCharCallback window + + val keyCallback = keyCallback inputMailbox + val () = Input.exportKeyCallback keyCallback + val () = Input.setKeyCallback window in () end diff --git a/shf b/shf index e2b4549..6b77591 100755 Binary files a/shf and b/shf differ