From: Javier Sancho Date: Mon, 4 May 2020 07:33:30 +0000 (+0200) Subject: Use pointers directly from guile to C and viceversa X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=commitdiff_plain;h=564416a9178fd8cef21364c2d921af6c8166115d Use pointers directly from guile to C and viceversa --- diff --git a/irrlicht.scm b/irrlicht.scm index 307cbdf..b08f2f7 100644 --- a/irrlicht.scm +++ b/irrlicht.scm @@ -20,4 +20,5 @@ (define-module (irrlicht) #:use-module (irrlicht irr) - #:re-export (create-device)) + #:re-export (create-device + set-window-caption!)) diff --git a/irrlicht/base.scm b/irrlicht/base.scm index bb04442..4f08eef 100644 --- a/irrlicht/base.scm +++ b/irrlicht/base.scm @@ -22,14 +22,7 @@ #:use-module (oop goops) #:use-module (system foreign) #:export ( - wrapped-obj)) + irr-pointer)) (define-class () - (irr-ptr #:init-value %null-pointer #:accessor irrlicht-pointer #:init-keyword #:ptr) - (irr-class #:init-value "irrlicht-base" #:getter irrlicht-class) - (wrapped-obj #:accessor wrapped-obj #:allocation #:virtual - #:slot-ref (lambda (obj) - (cons (slot-ref obj 'irr-class) - (slot-ref obj 'irr-ptr))) - #:slot-set! (lambda (obj wrapped) - (slot-set! obj 'irr-ptr (cdr wrapped))))) + (irr-pointer #:init-value %null-pointer #:accessor irr-pointer #:init-keyword #:irr-pointer)) diff --git a/irrlicht/irr.scm b/irrlicht/irr.scm index 8704c15..8eeae76 100644 --- a/irrlicht/irr.scm +++ b/irrlicht/irr.scm @@ -24,22 +24,20 @@ #:use-module (irrlicht foreign) #:export ( - create-device)) + create-device + set-window-caption!)) ;; IReferenceCounted -(define-class () - (irr-class #:init-value "irr::IReferenceCounted" #:getter irrlicht-class)) +(define-class ()) ;; IEventReceiver -(define-class () - (irr-class #:init-value "irr::IEventReceiver" #:getter irrlicht-class)) +(define-class ()) ;; IrrlichtDevice -(define-class () - (irr-class #:init-value "irr::IrrlichtDevice" #:getter irrlicht-class)) +(define-class ()) (define* (create-device #:key (device-type 'software) @@ -55,11 +53,17 @@ receiver)) (make - #:ptr - (irr_createDevice device-type - window-size - bits - fullscreen - stencilbuffer - vsync - (wrapped-obj receiver)))) + #:irr-pointer + (irr_createDevice + device-type + window-size + bits + fullscreen + stencilbuffer + vsync + (irr-pointer receiver)))) + +(define-method (set-window-caption! (device ) text) + (irr_IrrlichtDevice_setWindowCaption + (irr-pointer device) + text)) diff --git a/src/device.cpp b/src/device.cpp index 0ecb694..195ff5d 100644 --- a/src/device.cpp +++ b/src/device.cpp @@ -31,6 +31,8 @@ #include "wchar.h" #include "wrapped.h" +using namespace irr; + extern "C" { void @@ -38,12 +40,13 @@ extern "C" { { init_device_type (); DEFINE_GSUBR ("irr_createDevice", 7, 0, 0, irr_createDevice); + DEFINE_GSUBR ("irr_IrrlichtDevice_setWindowCaption", 2, 0, 0, + irr_IrrlichtDevice_setWindowCaption); DEFINE_GSUBR ("get-timer", 1, 0, 0, irr_getTimer); DEFINE_GSUBR ("is-window-active?", 1, 0, 0, irr_isWindowActive); DEFINE_GSUBR ("run", 1, 0, 0, irr_run); DEFINE_GSUBR ("set-event-receiver!", 2, 0, 0, irr_setEventReceiver); DEFINE_GSUBR ("set-resizable!", 2, 0, 0, irr_setResizable); - DEFINE_GSUBR ("set-window-caption!", 2, 0, 0, irr_setWindowCaption); DEFINE_GSUBR ("yield", 1, 0, 0, irr_yield); } @@ -60,17 +63,24 @@ extern "C" { SCM vsync, SCM receiver) { - UNWRAP (receiver); - - irr::IrrlichtDevice* device = - irr::createDevice (scm_to_driver_type (device_type), - scm_to_dimension2d_u32 (window_size), - scm_to_uint32 (bits), - scm_to_bool (fullscreen), - scm_to_bool (stencilbuffer), - scm_to_bool (vsync), - UNWRAPPED (receiver)); - return scm_from_pointer (device, NULL); + IrrlichtDevice* device = + createDevice (scm_to_driver_type (device_type), + scm_to_dimension2d_u32 (window_size), + scm_to_uint32 (bits), + scm_to_bool (fullscreen), + scm_to_bool (stencilbuffer), + scm_to_bool (vsync), + (IEventReceiver*)scm_to_pointer (receiver)); + return scm_from_pointer ((void*)device, NULL); + } + + SCM + irr_IrrlichtDevice_setWindowCaption (SCM device, + SCM text) + { + ((IrrlichtDevice*)scm_to_pointer (device))-> + setWindowCaption (scm_to_wide_char_string (text)); + return SCM_UNSPECIFIED; } SCM @@ -112,15 +122,6 @@ extern "C" { return SCM_UNSPECIFIED; } - SCM - irr_setWindowCaption (SCM wrapped_device, - SCM text) - { - irr::IrrlichtDevice* device = unwrap_device (wrapped_device); - device->setWindowCaption (scm_to_wide_char_string (text)); - return SCM_UNSPECIFIED; - } - SCM irr_yield (SCM wrapped_device) { diff --git a/src/device.h b/src/device.h index 158e51d..8bfb217 100644 --- a/src/device.h +++ b/src/device.h @@ -43,6 +43,10 @@ extern "C" { SCM vsync, SCM receiver); + SCM + irr_IrrlichtDevice_setWindowCaption (SCM wrapped_device, + SCM text); + SCM irr_getTimer (SCM wrapped_device); @@ -60,10 +64,6 @@ extern "C" { irr_setResizable (SCM wrapped_device, SCM resize); - SCM - irr_setWindowCaption (SCM wrapped_device, - SCM text); - SCM irr_yield (SCM wrapped_device); diff --git a/src/wrapped.h b/src/wrapped.h index 4514fa6..daaaa25 100644 --- a/src/wrapped.h +++ b/src/wrapped.h @@ -74,13 +74,4 @@ return SCM_IS_A_P (wrapped_obj, wrapped_##INIT); \ } - -#define UNWRAP(OBJ) \ - char* OBJ##_class = scm_to_utf8_stringn (scm_car (OBJ), NULL); \ - void* OBJ##_pointer = scm_to_pointer (scm_cdr (OBJ)); - - -#define UNWRAPPED(OBJ) \ - (!strcmp (OBJ##_class, "irr::IEventReceiver") ? (irr::IEventReceiver*)OBJ##_pointer : 0) - #endif