From: Javier Sancho <jsf@jsancho.org>
Date: Sun, 12 Apr 2020 17:28:18 +0000 (+0200)
Subject: event-key-input-key event-key-input-pressed
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=898d352f35f3f007dd4c1f49091f38bdeb012fd3;p=guile-irrlicht.git

event-key-input-key event-key-input-pressed
---

diff --git a/Makefile.am b/Makefile.am
index c47bdfc..c8a062c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -43,6 +43,7 @@ libguile_irrlicht_la_SOURCES = \
   src/gui-image.cpp \
   src/gui-static-text.cpp \
   src/guile-irrlicht.cpp \
+  src/keycodes.cpp \
   src/keymap.cpp \
   src/material.cpp \
   src/material-flags.cpp \
diff --git a/src/event-receiver.cpp b/src/event-receiver.cpp
index 64b3851..e97263e 100644
--- a/src/event-receiver.cpp
+++ b/src/event-receiver.cpp
@@ -21,8 +21,10 @@
 
 #include <irrlicht/irrlicht.h>
 #include <libguile.h>
+
 #include "event-receiver.h"
 #include "gsubr.h"
+#include "keycodes.h"
 #include "wrapped.h"
 
 extern "C" {
@@ -32,6 +34,8 @@ extern "C" {
   {
     init_event_receiver_type ();
     init_event_type ();
+    DEFINE_GSUBR ("event-key-input-key", 1, 0, 0, event_type);
+    DEFINE_GSUBR ("event-key-input-pressed", 1, 0, 0, event_type);
     DEFINE_GSUBR ("event-type", 1, 0, 0, event_type);
     DEFINE_GSUBR ("make-event-receiver", 1, 0, 0, make_event_receiver);
   }
@@ -44,6 +48,18 @@ extern "C" {
                        init_event_type, event_p,
                        wrap_event, unwrap_event);
 
+  SCM
+  event_key_input_key (SCM event)
+  {
+    return scm_from_key_code (unwrap_event (event)->KeyInput.Key);
+  }
+
+  SCM
+  event_key_input_pressed (SCM event)
+  {
+    return scm_from_bool (unwrap_event (event)->KeyInput.PressedDown);
+  }
+
   SCM
   event_type (SCM event)
   {
diff --git a/src/event-receiver.h b/src/event-receiver.h
index 3b1cd72..44dfc1a 100644
--- a/src/event-receiver.h
+++ b/src/event-receiver.h
@@ -37,6 +37,12 @@ extern "C" {
   DECLARE_WRAPPED_TYPE (irr::SEvent*, init_event_type,
                         event_p, wrap_event, unwrap_event);
 
+  SCM
+  event_key_input_key (SCM event);
+
+  SCM
+  event_key_input_pressed (SCM event);
+
   SCM
   event_type (SCM event);
 
diff --git a/src/keycodes.cpp b/src/keycodes.cpp
new file mode 100644
index 0000000..4cbe4a3
--- /dev/null
+++ b/src/keycodes.cpp
@@ -0,0 +1,639 @@
+/* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
+
+   Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
+
+   This file is part of guile-irrlicht.
+
+   guile-irrlicht is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as
+   published by the Free Software Foundation; either version 3 of the
+   License, or (at your option) any later version.
+
+   guile-irrlicht is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with guile-irrlicht. If not, see
+   <http://www.gnu.org/licenses/>.
+*/
+
+#include <irrlicht/irrlicht.h>
+#include <libguile.h>
+
+extern "C" {
+
+  SCM
+  scm_from_key_code (irr::EKEY_CODE key_code)
+  {
+    switch (key_code)
+      {
+      case irr::KEY_LBUTTON:
+        return scm_from_utf8_symbol ("lbutton");
+        break;
+
+      case irr::KEY_RBUTTON:
+        return scm_from_utf8_symbol ("rbutton");
+        break;
+
+      case irr::KEY_CANCEL:
+        return scm_from_utf8_symbol ("cancel");
+        break;
+
+      case irr::KEY_MBUTTON:
+        return scm_from_utf8_symbol ("mbutton");
+        break;
+
+      case irr::KEY_XBUTTON1:
+        return scm_from_utf8_symbol ("xbutton1");
+        break;
+
+      case irr::KEY_XBUTTON2:
+        return scm_from_utf8_symbol ("xbutton2");
+        break;
+
+      case irr::KEY_BACK:
+        return scm_from_utf8_symbol ("back");
+        break;
+
+      case irr::KEY_TAB:
+        return scm_from_utf8_symbol ("tab");
+        break;
+
+      case irr::KEY_CLEAR:
+        return scm_from_utf8_symbol ("clear");
+        break;
+
+      case irr::KEY_RETURN:
+        return scm_from_utf8_symbol ("return");
+        break;
+
+      case irr::KEY_SHIFT:
+        return scm_from_utf8_symbol ("shift");
+        break;
+
+      case irr::KEY_CONTROL:
+        return scm_from_utf8_symbol ("control");
+        break;
+
+      case irr::KEY_MENU:
+        return scm_from_utf8_symbol ("menu");
+        break;
+
+      case irr::KEY_PAUSE:
+        return scm_from_utf8_symbol ("pause");
+        break;
+
+      case irr::KEY_CAPITAL:
+        return scm_from_utf8_symbol ("capital");
+        break;
+
+      case irr::KEY_KANA:
+        return scm_from_utf8_symbol ("kana");
+        break;
+
+      case irr::KEY_JUNJA:
+        return scm_from_utf8_symbol ("junja");
+        break;
+
+      case irr::KEY_FINAL:
+        return scm_from_utf8_symbol ("final");
+        break;
+
+      case irr::KEY_HANJA:
+        return scm_from_utf8_symbol ("hanja");
+        break;
+
+      case irr::KEY_ESCAPE:
+        return scm_from_utf8_symbol ("escape");
+        break;
+
+      case irr::KEY_CONVERT:
+        return scm_from_utf8_symbol ("convert");
+        break;
+
+      case irr::KEY_NONCONVERT:
+        return scm_from_utf8_symbol ("nonconvert");
+        break;
+
+      case irr::KEY_ACCEPT:
+        return scm_from_utf8_symbol ("accept");
+        break;
+
+      case irr::KEY_MODECHANGE:
+        return scm_from_utf8_symbol ("modechange");
+        break;
+
+      case irr::KEY_SPACE:
+        return scm_from_utf8_symbol ("space");
+        break;
+
+      case irr::KEY_PRIOR:
+        return scm_from_utf8_symbol ("prior");
+        break;
+
+      case irr::KEY_NEXT:
+        return scm_from_utf8_symbol ("next");
+        break;
+
+      case irr::KEY_END:
+        return scm_from_utf8_symbol ("end");
+        break;
+
+      case irr::KEY_HOME:
+        return scm_from_utf8_symbol ("home");
+        break;
+
+      case irr::KEY_LEFT:
+        return scm_from_utf8_symbol ("left");
+        break;
+
+      case irr::KEY_UP:
+        return scm_from_utf8_symbol ("up");
+        break;
+
+      case irr::KEY_RIGHT:
+        return scm_from_utf8_symbol ("right");
+        break;
+
+      case irr::KEY_DOWN:
+        return scm_from_utf8_symbol ("down");
+        break;
+
+      case irr::KEY_SELECT:
+        return scm_from_utf8_symbol ("select");
+        break;
+
+      case irr::KEY_PRINT:
+        return scm_from_utf8_symbol ("print");
+        break;
+
+      case irr::KEY_EXECUT:
+        return scm_from_utf8_symbol ("execut");
+        break;
+
+      case irr::KEY_SNAPSHOT:
+        return scm_from_utf8_symbol ("snapshot");
+        break;
+
+      case irr::KEY_INSERT:
+        return scm_from_utf8_symbol ("insert");
+        break;
+
+      case irr::KEY_DELETE:
+        return scm_from_utf8_symbol ("delete");
+        break;
+
+      case irr::KEY_HELP:
+        return scm_from_utf8_symbol ("help");
+        break;
+
+      case irr::KEY_KEY_0:
+        return scm_from_utf8_symbol ("key-0");
+        break;
+
+      case irr::KEY_KEY_1:
+        return scm_from_utf8_symbol ("key-1");
+        break;
+
+      case irr::KEY_KEY_2:
+        return scm_from_utf8_symbol ("key-2");
+        break;
+
+      case irr::KEY_KEY_3:
+        return scm_from_utf8_symbol ("key-3");
+        break;
+
+      case irr::KEY_KEY_4:
+        return scm_from_utf8_symbol ("key-4");
+        break;
+
+      case irr::KEY_KEY_5:
+        return scm_from_utf8_symbol ("key-5");
+        break;
+
+      case irr::KEY_KEY_6:
+        return scm_from_utf8_symbol ("key-6");
+        break;
+
+      case irr::KEY_KEY_7:
+        return scm_from_utf8_symbol ("key-7");
+        break;
+
+      case irr::KEY_KEY_8:
+        return scm_from_utf8_symbol ("key-8");
+        break;
+
+      case irr::KEY_KEY_9:
+        return scm_from_utf8_symbol ("key-9");
+        break;
+
+      case irr::KEY_KEY_A:
+        return scm_from_utf8_symbol ("key-a");
+        break;
+
+      case irr::KEY_KEY_B:
+        return scm_from_utf8_symbol ("key-b");
+        break;
+
+      case irr::KEY_KEY_C:
+        return scm_from_utf8_symbol ("key-c");
+        break;
+
+      case irr::KEY_KEY_D:
+        return scm_from_utf8_symbol ("key-d");
+        break;
+
+      case irr::KEY_KEY_E:
+        return scm_from_utf8_symbol ("key-e");
+        break;
+
+      case irr::KEY_KEY_F:
+        return scm_from_utf8_symbol ("key-f");
+        break;
+
+      case irr::KEY_KEY_G:
+        return scm_from_utf8_symbol ("key-g");
+        break;
+
+      case irr::KEY_KEY_H:
+        return scm_from_utf8_symbol ("key-h");
+        break;
+
+      case irr::KEY_KEY_I:
+        return scm_from_utf8_symbol ("key-i");
+        break;
+
+      case irr::KEY_KEY_J:
+        return scm_from_utf8_symbol ("key-j");
+        break;
+
+      case irr::KEY_KEY_K:
+        return scm_from_utf8_symbol ("key-k");
+        break;
+
+      case irr::KEY_KEY_L:
+        return scm_from_utf8_symbol ("key-l");
+        break;
+
+      case irr::KEY_KEY_M:
+        return scm_from_utf8_symbol ("key-m");
+        break;
+
+      case irr::KEY_KEY_N:
+        return scm_from_utf8_symbol ("key-n");
+        break;
+
+      case irr::KEY_KEY_O:
+        return scm_from_utf8_symbol ("key-o");
+        break;
+
+      case irr::KEY_KEY_P:
+        return scm_from_utf8_symbol ("key-p");
+        break;
+
+      case irr::KEY_KEY_Q:
+        return scm_from_utf8_symbol ("key-q");
+        break;
+
+      case irr::KEY_KEY_R:
+        return scm_from_utf8_symbol ("key-r");
+        break;
+
+      case irr::KEY_KEY_S:
+        return scm_from_utf8_symbol ("key-s");
+        break;
+
+      case irr::KEY_KEY_T:
+        return scm_from_utf8_symbol ("key-t");
+        break;
+
+      case irr::KEY_KEY_U:
+        return scm_from_utf8_symbol ("key-u");
+        break;
+
+      case irr::KEY_KEY_V:
+        return scm_from_utf8_symbol ("key-v");
+        break;
+
+      case irr::KEY_KEY_W:
+        return scm_from_utf8_symbol ("key-w");
+        break;
+
+      case irr::KEY_KEY_X:
+        return scm_from_utf8_symbol ("key-x");
+        break;
+
+      case irr::KEY_KEY_Y:
+        return scm_from_utf8_symbol ("key-y");
+        break;
+
+      case irr::KEY_KEY_Z:
+        return scm_from_utf8_symbol ("key-z");
+        break;
+
+      case irr::KEY_LWIN:
+        return scm_from_utf8_symbol ("lwin");
+        break;
+
+      case irr::KEY_RWIN:
+        return scm_from_utf8_symbol ("rwin");
+        break;
+
+      case irr::KEY_APPS:
+        return scm_from_utf8_symbol ("apps");
+        break;
+
+      case irr::KEY_SLEEP:
+        return scm_from_utf8_symbol ("sleep");
+        break;
+
+      case irr::KEY_NUMPAD0:
+        return scm_from_utf8_symbol ("numpad0");
+        break;
+
+      case irr::KEY_NUMPAD1:
+        return scm_from_utf8_symbol ("numpad1");
+        break;
+
+      case irr::KEY_NUMPAD2:
+        return scm_from_utf8_symbol ("numpad2");
+        break;
+
+      case irr::KEY_NUMPAD3:
+        return scm_from_utf8_symbol ("numpad3");
+        break;
+
+      case irr::KEY_NUMPAD4:
+        return scm_from_utf8_symbol ("numpad4");
+        break;
+
+      case irr::KEY_NUMPAD5:
+        return scm_from_utf8_symbol ("numpad5");
+        break;
+
+      case irr::KEY_NUMPAD6:
+        return scm_from_utf8_symbol ("numpad6");
+        break;
+
+      case irr::KEY_NUMPAD7:
+        return scm_from_utf8_symbol ("numpad7");
+        break;
+
+      case irr::KEY_NUMPAD8:
+        return scm_from_utf8_symbol ("numpad8");
+        break;
+
+      case irr::KEY_NUMPAD9:
+        return scm_from_utf8_symbol ("numpad9");
+        break;
+
+      case irr::KEY_MULTIPLY:
+        return scm_from_utf8_symbol ("multiply");
+        break;
+
+      case irr::KEY_ADD:
+        return scm_from_utf8_symbol ("add");
+        break;
+
+      case irr::KEY_SEPARATOR:
+        return scm_from_utf8_symbol ("separator");
+        break;
+
+      case irr::KEY_SUBTRACT:
+        return scm_from_utf8_symbol ("subtract");
+        break;
+
+      case irr::KEY_DECIMAL:
+        return scm_from_utf8_symbol ("decimal");
+        break;
+
+      case irr::KEY_DIVIDE:
+        return scm_from_utf8_symbol ("divide");
+        break;
+
+      case irr::KEY_F1:
+        return scm_from_utf8_symbol ("f1");
+        break;
+
+      case irr::KEY_F2:
+        return scm_from_utf8_symbol ("f2");
+        break;
+
+      case irr::KEY_F3:
+        return scm_from_utf8_symbol ("f3");
+        break;
+
+      case irr::KEY_F4:
+        return scm_from_utf8_symbol ("f4");
+        break;
+
+      case irr::KEY_F5:
+        return scm_from_utf8_symbol ("f5");
+        break;
+
+      case irr::KEY_F6:
+        return scm_from_utf8_symbol ("f6");
+        break;
+
+      case irr::KEY_F7:
+        return scm_from_utf8_symbol ("f7");
+        break;
+
+      case irr::KEY_F8:
+        return scm_from_utf8_symbol ("f8");
+        break;
+
+      case irr::KEY_F9:
+        return scm_from_utf8_symbol ("f9");
+        break;
+
+      case irr::KEY_F10:
+        return scm_from_utf8_symbol ("f10");
+        break;
+
+      case irr::KEY_F11:
+        return scm_from_utf8_symbol ("f11");
+        break;
+
+      case irr::KEY_F12:
+        return scm_from_utf8_symbol ("f12");
+        break;
+
+      case irr::KEY_F13:
+        return scm_from_utf8_symbol ("f13");
+        break;
+
+      case irr::KEY_F14:
+        return scm_from_utf8_symbol ("f14");
+        break;
+
+      case irr::KEY_F15:
+        return scm_from_utf8_symbol ("f15");
+        break;
+
+      case irr::KEY_F16:
+        return scm_from_utf8_symbol ("f16");
+        break;
+
+      case irr::KEY_F17:
+        return scm_from_utf8_symbol ("f17");
+        break;
+
+      case irr::KEY_F18:
+        return scm_from_utf8_symbol ("f18");
+        break;
+
+      case irr::KEY_F19:
+        return scm_from_utf8_symbol ("f19");
+        break;
+
+      case irr::KEY_F20:
+        return scm_from_utf8_symbol ("f20");
+        break;
+
+      case irr::KEY_F21:
+        return scm_from_utf8_symbol ("f21");
+        break;
+
+      case irr::KEY_F22:
+        return scm_from_utf8_symbol ("f22");
+        break;
+
+      case irr::KEY_F23:
+        return scm_from_utf8_symbol ("f23");
+        break;
+
+      case irr::KEY_F24:
+        return scm_from_utf8_symbol ("f24");
+        break;
+
+      case irr::KEY_NUMLOCK:
+        return scm_from_utf8_symbol ("numlock");
+        break;
+
+      case irr::KEY_SCROLL:
+        return scm_from_utf8_symbol ("scroll");
+        break;
+
+      case irr::KEY_LSHIFT:
+        return scm_from_utf8_symbol ("lshift");
+        break;
+
+      case irr::KEY_RSHIFT:
+        return scm_from_utf8_symbol ("rshift");
+        break;
+
+      case irr::KEY_LCONTROL:
+        return scm_from_utf8_symbol ("lcontrol");
+        break;
+
+      case irr::KEY_RCONTROL:
+        return scm_from_utf8_symbol ("rcontrol");
+        break;
+
+      case irr::KEY_LMENU:
+        return scm_from_utf8_symbol ("lmenu");
+        break;
+
+      case irr::KEY_RMENU:
+        return scm_from_utf8_symbol ("rmenu");
+        break;
+
+      case irr::KEY_OEM_1:
+        return scm_from_utf8_symbol ("oem-1");
+        break;
+
+      case irr::KEY_PLUS:
+        return scm_from_utf8_symbol ("plus");
+        break;
+
+      case irr::KEY_COMMA:
+        return scm_from_utf8_symbol ("comma");
+        break;
+
+      case irr::KEY_MINUS:
+        return scm_from_utf8_symbol ("minus");
+        break;
+
+      case irr::KEY_PERIOD:
+        return scm_from_utf8_symbol ("period");
+        break;
+
+      case irr::KEY_OEM_2:
+        return scm_from_utf8_symbol ("oem-2");
+        break;
+
+      case irr::KEY_OEM_3:
+        return scm_from_utf8_symbol ("oem-3");
+        break;
+
+      case irr::KEY_OEM_4:
+        return scm_from_utf8_symbol ("oem-4");
+        break;
+
+      case irr::KEY_OEM_5:
+        return scm_from_utf8_symbol ("oem-5");
+        break;
+
+      case irr::KEY_OEM_6:
+        return scm_from_utf8_symbol ("oem-6");
+        break;
+
+      case irr::KEY_OEM_7:
+        return scm_from_utf8_symbol ("oem-7");
+        break;
+
+      case irr::KEY_OEM_8:
+        return scm_from_utf8_symbol ("oem-8");
+        break;
+
+      case irr::KEY_OEM_AX:
+        return scm_from_utf8_symbol ("oem-ax");
+        break;
+
+      case irr::KEY_OEM_102:
+        return scm_from_utf8_symbol ("oem-102");
+        break;
+
+      case irr::KEY_ATTN:
+        return scm_from_utf8_symbol ("attn");
+        break;
+
+      case irr::KEY_CRSEL:
+        return scm_from_utf8_symbol ("crsel");
+        break;
+
+      case irr::KEY_EXSEL:
+        return scm_from_utf8_symbol ("exsel");
+        break;
+
+      case irr::KEY_EREOF:
+        return scm_from_utf8_symbol ("ereof");
+        break;
+
+      case irr::KEY_PLAY:
+        return scm_from_utf8_symbol ("play");
+        break;
+
+      case irr::KEY_ZOOM:
+        return scm_from_utf8_symbol ("zoom");
+        break;
+
+      case irr::KEY_PA1:
+        return scm_from_utf8_symbol ("pa1");
+        break;
+
+      case irr::KEY_OEM_CLEAR:
+        return scm_from_utf8_symbol ("oem-clear");
+        break;
+
+      default:
+        SCM code = scm_from_uint (key_code);
+        scm_error (scm_arg_type_key, NULL, "Wrong key code: ~S",
+                   scm_list_1 (code), scm_list_1 (code));
+      }
+  }
+
+}
diff --git a/src/keycodes.h b/src/keycodes.h
new file mode 100644
index 0000000..550a6e7
--- /dev/null
+++ b/src/keycodes.h
@@ -0,0 +1,35 @@
+/* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
+
+   Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
+
+   This file is part of guile-irrlicht.
+
+   guile-irrlicht is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as
+   published by the Free Software Foundation; either version 3 of the
+   License, or (at your option) any later version.
+
+   guile-irrlicht is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with guile-irrlicht. If not, see
+   <http://www.gnu.org/licenses/>.
+*/
+
+#ifndef __GUILE_IRRLICHT_KEYCODES_H_INCLUDED__
+#define __GUILE_IRRLICHT_KEYCODES_H_INCLUDED__
+
+#include <irrlicht/irrlicht.h>
+#include <libguile.h>
+
+extern "C" {
+
+  SCM
+  scm_from_key_code (irr::EKEY_CODE key_code);
+
+}
+
+#endif