From 32d4067d4c588913bbd5ec4450f2f859af789942 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Mon, 25 May 2020 09:26:17 +0200 Subject: [PATCH] Cast to the proper wrapped object when a gui event is raised --- irrlicht/foreign.scm | 22 ++++++++++++++++++++-- irrlicht/gui.scm | 32 +++++++++++++++++++------------- irrlicht/irr.scm | 2 +- src/gui-element.cpp | 11 +++++++++-- 4 files changed, 49 insertions(+), 18 deletions(-) diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm index 9b55633..96cec83 100644 --- a/irrlicht/foreign.scm +++ b/irrlicht/foreign.scm @@ -22,7 +22,9 @@ #:use-module (system foreign) #:use-module (irrlicht base) #:export (get-irrlicht-proc - null-object?)) + null-object? + remember-wrapped + mem-wrapped)) ;; We use a hash table to store foreign irrlicht methods related with their ;; classes @@ -44,4 +46,20 @@ proc)))) (define (null-object? object) - (eq? (irr-pointer object) %null-pointer)) + (null-pointer? (irr-pointer object))) + +;; Table for storing foreign irrlicht wrapped objects by its pointer address +;; We can recover them later, when we have an address without knowing its type, like in +;; events case +(define wrapped-obj-table (make-hash-table)) + +(define (remember-wrapped object) + (or (hash-ref wrapped-obj-table + (pointer-address (irr-pointer object))) + object)) + +(define (mem-wrapped object) + (hash-set! wrapped-obj-table + (pointer-address (irr-pointer object)) + object) + object) diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index d7dd335..597032a 100644 --- a/irrlicht/gui.scm +++ b/irrlicht/gui.scm @@ -59,16 +59,18 @@ (id -1) (text "") (tooltiptext "")) - (let ((addButton (get-irrlicht-proc "addButton" gui-environment parent))) - (addButton gui-environment rectangle parent id text tooltiptext)))) + (let* ((addButton (get-irrlicht-proc "addButton" gui-environment parent)) + (button (addButton gui-environment rectangle parent id text tooltiptext))) + (mem-wrapped button)))) (define-method (add-editbox! (gui-environment ) text rectangle . rest) (let-keywords rest #f ((border #t) (parent (make )) (id -1)) - (let ((addEditBox (get-irrlicht-proc "addEditBox" gui-environment parent))) - (addEditBox gui-environment text rectangle border parent id)))) + (let* ((addEditBox (get-irrlicht-proc "addEditBox" gui-environment parent)) + (editbox (addEditBox gui-environment text rectangle border parent id))) + (mem-wrapped editbox)))) (define-method (add-image! (gui-environment ) image pos . rest) (let-keywords rest #f @@ -76,23 +78,26 @@ (parent (make )) (id -1) (text "")) - (let ((addImage (get-irrlicht-proc "addImage" gui-environment parent))) - (addImage gui-environment image pos use-alpha-channel parent id text)))) + (let* ((addImage (get-irrlicht-proc "addImage" gui-environment parent)) + (img (addImage gui-environment image pos use-alpha-channel parent id text))) + (mem-wrapped img)))) (define-method (add-listbox! (gui-environment ) rectangle . rest) (let-keywords rest #f ((parent (make )) (id -1) (draw-background #f)) - (let ((addListBox (get-irrlicht-proc "addListBox" gui-environment parent))) - (addListBox gui-environment rectangle parent id draw-background)))) + (let* ((addListBox (get-irrlicht-proc "addListBox" gui-environment parent)) + (listbox (addListBox gui-environment rectangle parent id draw-background))) + (mem-wrapped listbox)))) (define-method (add-scrollbar! (gui-environment ) horizontal rectangle . rest) (let-keywords rest #f ((parent (make )) (id -1)) - (let ((addScrollBar (get-irrlicht-proc "addScrollBar" gui-environment parent))) - (addScrollBar gui-environment horizontal rectangle parent id)))) + (let* ((addScrollBar (get-irrlicht-proc "addScrollBar" gui-environment parent)) + (scrollbar (addScrollBar gui-environment horizontal rectangle parent id))) + (mem-wrapped scrollbar)))) (define-method (add-static-text! (gui-environment ) text rectangle . rest) (let-keywords rest #f @@ -101,9 +106,10 @@ (parent (make )) (id -1) (fill-background #f)) - (let ((addStaticText (get-irrlicht-proc "addStaticText" gui-environment parent))) - (addStaticText gui-environment text rectangle border word-wrap parent - id fill-background)))) + (let* ((addStaticText (get-irrlicht-proc "addStaticText" gui-environment parent)) + (static-text (addStaticText gui-environment text rectangle border word-wrap parent + id fill-background))) + (mem-wrapped static-text)))) (define-method (draw-all (gui-environment )) ((get-irrlicht-proc "drawAll" gui-environment) diff --git a/irrlicht/irr.scm b/irrlicht/irr.scm index 2a1f788..f220cdf 100644 --- a/irrlicht/irr.scm +++ b/irrlicht/irr.scm @@ -41,7 +41,7 @@ (define-method (get-event-gui-caller (event )) (let ((SGUIEvent_Caller (get-irrlicht-proc "SGUIEvent_Caller" event))) - (SGUIEvent_Caller event))) + (remember-wrapped (SGUIEvent_Caller event)))) (define-method (get-event-gui-type (event )) (let ((SGUIEvent_EventType (get-irrlicht-proc "SGUIEvent_EventType" event))) diff --git a/src/gui-element.cpp b/src/gui-element.cpp index 39d3a41..6ee3dcc 100644 --- a/src/gui-element.cpp +++ b/src/gui-element.cpp @@ -27,15 +27,22 @@ using namespace irr; +template SCM IGUIElement_getID (SCM gui_element) { - gui::IGUIElement* element = (gui::IGUIElement*) scm_to_irr_pointer (gui_element); + T element = (T) scm_to_irr_pointer (gui_element); return scm_from_int32 (element->getID ()); } void init_gui_element (void) { - DEFINE_GSUBR ("IGUIElement_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIButton_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIEditBox_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIElement_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIImage_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIListBox_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIScrollBar_getID", 1, 0, 0, IGUIElement_getID); + DEFINE_GSUBR ("IGUIStaticText_getID", 1, 0, 0, IGUIElement_getID); } -- 2.39.2