From 2532ec193354090d2bd34fb8380beb798b4e451e Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Wed, 20 May 2020 09:24:50 +0200
Subject: [PATCH] make-event-receiver get-event-type

---
 irrlicht.scm           |  2 ++
 irrlicht/irr.scm       | 17 ++++++++++++++++-
 src/event-receiver.cpp |  9 +++++----
 src/wrapped.cpp        | 10 ++++++++++
 src/wrapped.h          |  3 +++
 5 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/irrlicht.scm b/irrlicht.scm
index c9bbd68..3c54b18 100644
--- a/irrlicht.scm
+++ b/irrlicht.scm
@@ -46,6 +46,7 @@
                end-scene
                get-absolute-transformation
                get-cursor-control
+               get-event-type
                get-file-system
                get-fps
                get-gui-environment
@@ -58,6 +59,7 @@
                get-video-driver
                is-window-active?
                make-box3d
+               make-event-receiver
                make-material
                make-vertex3d
                reset-box3d!
diff --git a/irrlicht/irr.scm b/irrlicht/irr.scm
index 2c88358..56bc6fa 100644
--- a/irrlicht/irr.scm
+++ b/irrlicht/irr.scm
@@ -35,11 +35,26 @@
 (export <reference-counted> drop!)
 
 
+;; SEvent
+(define-class <event> (<irrlicht-base>)
+  (irr-class #:init-value "SEvent"))
+
+(define-method (get-event-type (event <event>))
+  (let ((SEvent_EventType (get-irrlicht-proc "EventType" event)))
+    (SEvent_EventType event)))
+
+(export <event> get-event-type)
+
+
 ;; IEventReceiver
 (define-class <event-receiver> (<irrlicht-base>)
   (irr-class #:init-value "IEventReceiver"))
 
-(export <event-receiver>)
+(define (make-event-receiver proc-on-event)
+  (let ((IEventReceiver_make (get-irrlicht-proc "IEventReceiver_make")))
+    (IEventReceiver_make proc-on-event)))
+
+(export <event-receiver> make-event-receiver)
 
 
 ;; SKeyMap
diff --git a/src/event-receiver.cpp b/src/event-receiver.cpp
index 12ff718..f8f8a55 100644
--- a/src/event-receiver.cpp
+++ b/src/event-receiver.cpp
@@ -29,7 +29,7 @@
 using namespace irr;
 
 SCM
-IEventRecevier_make (SCM proc_on_event)
+IEventReceiver_make (SCM proc_on_event)
 {
   class CustomReceiver : public IEventReceiver
   {
@@ -43,12 +43,13 @@ IEventRecevier_make (SCM proc_on_event)
 
     virtual bool OnEvent (const SEvent& event)
     {
-      return scm_to_bool (scm_call_1 (scm_on_event, scm_from_pointer ((void*)&event, NULL)));
+      SCM wrapped_event = scm_from_irr_pointer ("irrlicht irr", "<event>", (void*) &event);
+      return scm_to_bool (scm_call_1 (scm_on_event, wrapped_event));
     }
   };
 
   CustomReceiver* receiver = new CustomReceiver (proc_on_event);
-  return scm_from_pointer ((void*)receiver, NULL);
+  return scm_from_irr_pointer ("irrlicht irr", "<event-receiver>", (void*) receiver);
 }
 
 SCM
@@ -90,7 +91,7 @@ SEvent_SKeyInput_PressedDown (SCM event)
 void
 init_event_receiver (void)
 {
-  DEFINE_GSUBR ("IEventRecevier_make", 1, 0, 0, IEventRecevier_make);
+  DEFINE_GSUBR ("IEventReceiver_make", 1, 0, 0, IEventReceiver_make);
   DEFINE_GSUBR ("SEvent_EventType", 1, 0, 0, SEvent_EventType);
   DEFINE_GSUBR ("SEvent_SGUIEvent_Caller", 1, 0, 0, SEvent_SGUIEvent_Caller);
   DEFINE_GSUBR ("SEvent_SGUIEvent_EventType", 1, 0, 0, SEvent_SGUIEvent_EventType);
diff --git a/src/wrapped.cpp b/src/wrapped.cpp
index 81d4130..6da7adf 100644
--- a/src/wrapped.cpp
+++ b/src/wrapped.cpp
@@ -22,6 +22,16 @@
 #include <libguile.h>
 #include "wrapped.h"
 
+/* Make a GOOPS instance from a C++ object pointer */
+SCM
+scm_from_irr_pointer (const char* module, const char* class_name, void* pointer)
+{
+  SCM scm_class = scm_variable_ref (scm_c_public_lookup (module, class_name));
+  SCM k_pointer = scm_from_utf8_keyword ("irr-pointer");
+  SCM scm_pointer = scm_from_pointer (pointer, NULL);
+  return scm_make (scm_list_3 (scm_class, k_pointer, scm_pointer));
+}
+
 /* Extract C++ irrlicht object pointer from Guile object */
 void*
 scm_to_irr_pointer (SCM obj)
diff --git a/src/wrapped.h b/src/wrapped.h
index 136a6cd..21f080e 100644
--- a/src/wrapped.h
+++ b/src/wrapped.h
@@ -24,6 +24,9 @@
 
 #include <libguile.h>
 
+SCM
+scm_from_irr_pointer (const char* module, const char* class_name, void* pointer);
+
 void*
 scm_to_irr_pointer (SCM obj);
 
-- 
2.39.2