From c9c098c6a9363eb59f435eb195a4bc5b9098b1dd Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Fri, 1 May 2020 13:41:56 +0200 Subject: [PATCH] GOOPS and POC with create-device --- Makefile.am | 6 +++- irrlicht.scm | 8 +++--- irrlicht/base.scm | 35 ++++++++++++++++++++++++ irrlicht/foreign.scm | 23 ++++++++++++++++ irrlicht/irr.scm | 65 ++++++++++++++++++++++++++++++++++++++++++++ src/device.cpp | 33 ++++++++-------------- src/device.h | 8 +++++- src/wrapped.h | 9 ++++++ 8 files changed, 159 insertions(+), 28 deletions(-) create mode 100644 irrlicht/base.scm create mode 100644 irrlicht/foreign.scm create mode 100644 irrlicht/irr.scm diff --git a/Makefile.am b/Makefile.am index 4b8303b..fa12476 100644 --- a/Makefile.am +++ b/Makefile.am @@ -101,4 +101,8 @@ SUFFIXES = .scm .go moddir = @GUILE_SITE@ godir = @GUILE_SITE_CCACHE@ -SOURCES = irrlicht.scm +SOURCES = \ + irrlicht.scm \ + irrlicht/base.scm \ + irrlicht/foreign.scm \ + irrlicht/irr.scm diff --git a/irrlicht.scm b/irrlicht.scm index 14e4457..307cbdf 100644 --- a/irrlicht.scm +++ b/irrlicht.scm @@ -1,5 +1,5 @@ ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine -;;; Copyright (C) 2019 Javier Sancho +;;; Copyright (C) 2020 Javier Sancho ;;; ;;; This file is part of guile-irrlicht. ;;; @@ -18,6 +18,6 @@ ;;; . -(define-module (irrlicht)) - -(load-extension "libguile-irrlicht" "init_guile_irrlicht") +(define-module (irrlicht) + #:use-module (irrlicht irr) + #:re-export (create-device)) diff --git a/irrlicht/base.scm b/irrlicht/base.scm new file mode 100644 index 0000000..bb04442 --- /dev/null +++ b/irrlicht/base.scm @@ -0,0 +1,35 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2020 Javier Sancho +;;; +;;; 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 +;;; . + + +(define-module (irrlicht base) + #:use-module (oop goops) + #:use-module (system foreign) + #:export ( + wrapped-obj)) + +(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))))) diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm new file mode 100644 index 0000000..ff46223 --- /dev/null +++ b/irrlicht/foreign.scm @@ -0,0 +1,23 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2020 Javier Sancho +;;; +;;; 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 +;;; . + + +(define-module (irrlicht foreign)) + +(load-extension "libguile-irrlicht" "init_guile_irrlicht") diff --git a/irrlicht/irr.scm b/irrlicht/irr.scm new file mode 100644 index 0000000..8704c15 --- /dev/null +++ b/irrlicht/irr.scm @@ -0,0 +1,65 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2020 Javier Sancho +;;; +;;; 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 +;;; . + + +(define-module (irrlicht irr) + #:use-module (oop goops) + #:use-module (irrlicht base) + #:use-module (irrlicht foreign) + #:export ( + + create-device)) + + +;; IReferenceCounted +(define-class () + (irr-class #:init-value "irr::IReferenceCounted" #:getter irrlicht-class)) + + +;; IEventReceiver +(define-class () + (irr-class #:init-value "irr::IEventReceiver" #:getter irrlicht-class)) + + +;; IrrlichtDevice +(define-class () + (irr-class #:init-value "irr::IrrlichtDevice" #:getter irrlicht-class)) + +(define* (create-device #:key + (device-type 'software) + (window-size '(640 480)) + (bits 16) + (fullscreen #f) + (stencilbuffer #f) + (vsync #f) + (receiver (make ))) + (if (not (is-a? receiver )) + (error + "In procedure create-device: Wrong type argument (expecting ):" + receiver)) + + (make + #:ptr + (irr_createDevice device-type + window-size + bits + fullscreen + stencilbuffer + vsync + (wrapped-obj receiver)))) diff --git a/src/device.cpp b/src/device.cpp index 3b4dc10..0ecb694 100644 --- a/src/device.cpp +++ b/src/device.cpp @@ -37,7 +37,7 @@ extern "C" { init_device (void) { init_device_type (); - DEFINE_GSUBR ("create-device", 0, 0, 1, irr_createDevice); + DEFINE_GSUBR ("irr_createDevice", 7, 0, 0, irr_createDevice); 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); @@ -52,26 +52,15 @@ extern "C" { wrap_device, unwrap_device); SCM - irr_createDevice (SCM rest) + irr_createDevice (SCM device_type, + SCM window_size, + SCM bits, + SCM fullscreen, + SCM stencilbuffer, + SCM vsync, + SCM receiver) { - SCM device_type = scm_from_utf8_symbol ("software"); - SCM window_size = scm_list_2 (scm_from_uint32 (640), - scm_from_uint32 (480)); - SCM bits = scm_from_uint32 (16); - SCM fullscreen = SCM_BOOL_F; - SCM stencilbuffer = SCM_BOOL_F; - SCM vsync = SCM_BOOL_F; - SCM receiver = SCM_UNDEFINED; - - scm_c_bind_keyword_arguments ("create-device", rest, (scm_t_keyword_arguments_flags)0, - scm_from_utf8_keyword ("device-type"), &device_type, - scm_from_utf8_keyword ("window-size"), &window_size, - scm_from_utf8_keyword ("bits"), &bits, - scm_from_utf8_keyword ("fullscreen"), &fullscreen, - scm_from_utf8_keyword ("stencilbuffer"), &stencilbuffer, - scm_from_utf8_keyword ("vsync"), &vsync, - scm_from_utf8_keyword ("receiver"), &receiver, - SCM_UNDEFINED); + UNWRAP (receiver); irr::IrrlichtDevice* device = irr::createDevice (scm_to_driver_type (device_type), @@ -80,8 +69,8 @@ extern "C" { scm_to_bool (fullscreen), scm_to_bool (stencilbuffer), scm_to_bool (vsync), - receiver == SCM_UNDEFINED ? 0 : unwrap_event_receiver (receiver)); - return wrap_device (device); + UNWRAPPED (receiver)); + return scm_from_pointer (device, NULL); } SCM diff --git a/src/device.h b/src/device.h index ccf6482..158e51d 100644 --- a/src/device.h +++ b/src/device.h @@ -35,7 +35,13 @@ extern "C" { device_p, wrap_device, unwrap_device); SCM - irr_createDevice (SCM rest); + irr_createDevice (SCM device_type, + SCM window_size, + SCM bits, + SCM fullscreen, + SCM stencilbuffer, + SCM vsync, + SCM receiver); SCM irr_getTimer (SCM wrapped_device); diff --git a/src/wrapped.h b/src/wrapped.h index daaaa25..4514fa6 100644 --- a/src/wrapped.h +++ b/src/wrapped.h @@ -74,4 +74,13 @@ 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 -- 2.39.2