src/event-receiver.cpp

   1 /* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
   2
   3    Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
   4
   5    This file is part of guile-irrlicht.
   6
   7    guile-irrlicht is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU Lesser General Public License as
   9    published by the Free Software Foundation; either version 3 of the
  10    License, or (at your option) any later version.
  11
  12    guile-irrlicht is distributed in the hope that it will be useful, but
  13    WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15    General Public License for more details.
  16
  17    You should have received a copy of the GNU Lesser General Public
  18    License along with guile-irrlicht. If not, see
  19    <http://www.gnu.org/licenses/>.
  20 */
  21
  22 #include <irrlicht/irrlicht.h>
  23 #include <libguile.h>
  24
  25 #include "event-receiver.h"
  26 #include "gsubr.h"
  27 #include "keycodes.h"
  28 #include "wrapped.h"
  29
  30 extern "C" {
  31
  32   void
  33   init_event_receiver (void)
  34   {
  35     init_event_receiver_type ();
  36     init_event_type ();
  37     DEFINE_GSUBR ("event-key-input-key", 1, 0, 0, event_key_input_key);
  38     DEFINE_GSUBR ("event-key-input-pressed", 1, 0, 0, event_key_input_pressed);
  39     DEFINE_GSUBR ("event-type", 1, 0, 0, event_type);
  40     DEFINE_GSUBR ("make-event-receiver", 1, 0, 0, make_event_receiver);
  41   }
  42
  43   DEFINE_WRAPPED_TYPE (irr::IEventReceiver*, "event-receiver",
  44                        init_event_receiver_type, event_receiver_p,
  45                        wrap_event_receiver, unwrap_event_receiver);
  46
  47   DEFINE_WRAPPED_TYPE (irr::SEvent*, "event",
  48                        init_event_type, event_p,
  49                        wrap_event, unwrap_event);
  50
  51   SCM
  52   event_key_input_key (SCM event)
  53   {
  54     return scm_from_key_code (unwrap_event (event)->KeyInput.Key);
  55   }
  56
  57   SCM
  58   event_key_input_pressed (SCM event)
  59   {
  60     return scm_from_bool (unwrap_event (event)->KeyInput.PressedDown);
  61   }
  62
  63   SCM
  64   event_type (SCM event)
  65   {
  66     return scm_from_event_type (unwrap_event (event)->EventType);
  67   }
  68
  69   SCM
  70   make_event_receiver (SCM proc_on_event)
  71   {
  72     class CustomReceiver : public irr::IEventReceiver
  73     {
  74       SCM scm_on_event;
  75
  76     public:
  77       CustomReceiver (SCM on_event)
  78       {
  79         scm_on_event = on_event;
  80       }
  81
  82       virtual bool OnEvent (const irr::SEvent& event)
  83       {
  84         return scm_to_bool (scm_call_1 (scm_on_event, wrap_event ((irr::SEvent*)&event)));
  85       }
  86     };
  87
  88     CustomReceiver* receiver = new CustomReceiver (proc_on_event);
  89     return wrap_event_receiver (receiver);
  90   }
  91
  92   SCM
  93   scm_from_event_type (irr::EEVENT_TYPE event_type)
  94   {
  95     switch (event_type)
  96       {
  97       case irr::EET_GUI_EVENT:
  98         return scm_from_utf8_symbol ("gui-event");
  99         break;
 100
 101       case irr::EET_MOUSE_INPUT_EVENT:
 102         return scm_from_utf8_symbol ("mouse-input-event");
 103         break;
 104
 105       case irr::EET_KEY_INPUT_EVENT:
 106         return scm_from_utf8_symbol ("key-input-event");
 107         break;
 108
 109       case irr::EET_JOYSTICK_INPUT_EVENT:
 110         return scm_from_utf8_symbol ("joystick-input-event");
 111         break;
 112
 113       case irr::EET_LOG_TEXT_EVENT:
 114         return scm_from_utf8_symbol ("log-text-event");
 115         break;
 116
 117       case irr::EET_USER_EVENT:
 118         return scm_from_utf8_symbol ("user-event");
 119         break;
 120
 121       default:
 122         SCM type = scm_from_uint (event_type);
 123         scm_error (scm_arg_type_key, NULL, "Wrong event type: ~S",
 124                    scm_list_1 (type), scm_list_1 (type));
 125       }
 126   }
 127
 128 }