structure InputCallbacks = struct open CML open InputMessage 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.PRESS () then Mailbox.send (mailbox, MOUSE_LEFT_CLICK) else Mailbox.send (mailbox, MOUSE_LEFT_RELEASE) else () fun framebufferSizeCallback mailbox (width, height) = let val _ = Gles3.viewport (width, height) 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 () then if mods = 0x0002 then (* ctrl-z *) Mailbox.send (mailbox, UNDO_ACTION) else if mods = 0x0003 then (* ctrl-shift-z *) Mailbox.send (mailbox, REDO_ACTION) else (* no action recognised *) () else if (* ctrl-y *) key = Input.KEY_Y () andalso action <> Input.RELEASE () andalso mods = 0x0002 then Mailbox.send (mailbox, REDO_ACTION) else if key = Input.KEY_R () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_R) else if key = Input.KEY_G () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_G) else if key = Input.KEY_B () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_B) else if key = Input.KEY_T () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_T) else if (* ctrl-s *) key = Input.KEY_S () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_S) else if key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_L) else if (* ctrl-l *) key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_L) else if (* ctrl-e *) key = Input.KEY_E () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_E) else if (* ctrl-c *) key = Input.KEY_C () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_C) else if key = Input.KEY_A () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_A) else if key = Input.KEY_W () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_W) else if key = Input.KEY_H () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_H) else if key = Input.KEY_C () andalso action = Input.PRESS () andalso mods = 0x000 then Mailbox.send (mailbox, KEY_C) else if key = Input.KEY_UP () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, ARROW_UP) else if key = Input.KEY_LEFT () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, ARROW_LEFT) else if key = Input.KEY_RIGHT () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, ARROW_RIGHT) else if key = Input.KEY_DOWN () andalso action <> Input.RELEASE () andalso mods = 0x0 then Mailbox.send (mailbox, ARROW_DOWN) else if key = Input.KEY_BACKSPACE () andalso action = Input.PRESS () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_BACKSPACE) else if key = Input.KEY_ENTER () andalso action = Input.PRESS () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_ENTER) else if key = Input.KEY_SPACE () andalso action = Input.PRESS () andalso mods = 0x0 then Mailbox.send (mailbox, KEY_SPACE) else if key = Input.KEY_0 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 0) else if key = Input.KEY_1 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 1) else if key = Input.KEY_2 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 2) else if key = Input.KEY_3 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 3) else if key = Input.KEY_4 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 4) else if key = Input.KEY_5 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 5) else if key = Input.KEY_6 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 6) else if key = Input.KEY_7 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 7) else if key = Input.KEY_8 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 8) else if key = Input.KEY_9 () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, NUM 9) else if key = Input.KEY_ESC () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_ESC) else if key = Input.KEY_M () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_M) else if key = Input.KEY_F () andalso action = Input.PRESS () andalso mods = 0 then Mailbox.send (mailbox, KEY_F) else () fun registerCallbacks (window, inputMailbox) = let val mouseMoveCallback = mouseMoveCallback inputMailbox val _ = Input.exportMouseMoveCallback mouseMoveCallback val _ = Input.setMouseMoveCallback window val mouseClickCallback = mouseClickCallback inputMailbox val _ = Input.exportMouseClickCallback mouseClickCallback val _ = Input.setMouseClickCallback window 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 end