moddir = @GUILE_SITE@
godir = @GUILE_SITE_CCACHE@
-SOURCES = irrlicht.scm
+SOURCES = \
+ irrlicht.scm \
+ irrlicht/base.scm \
+ irrlicht/foreign.scm \
+ irrlicht/irr.scm
;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
-;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
;;;
;;; This file is part of guile-irrlicht.
;;;
;;; <http://www.gnu.org/licenses/>.
-(define-module (irrlicht))
-
-(load-extension "libguile-irrlicht" "init_guile_irrlicht")
+(define-module (irrlicht)
+ #:use-module (irrlicht irr)
+ #:re-export (create-device))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht base)
+ #:use-module (oop goops)
+ #:use-module (system foreign)
+ #:export (<irrlicht-base>
+ wrapped-obj))
+
+(define-class <irrlicht-base> ()
+ (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)))))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht foreign))
+
+(load-extension "libguile-irrlicht" "init_guile_irrlicht")
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht irr)
+ #:use-module (oop goops)
+ #:use-module (irrlicht base)
+ #:use-module (irrlicht foreign)
+ #:export (<reference-counted>
+ <irrlicht-device>
+ create-device))
+
+
+;; IReferenceCounted
+(define-class <reference-counted> (<irrlicht-base>)
+ (irr-class #:init-value "irr::IReferenceCounted" #:getter irrlicht-class))
+
+
+;; IEventReceiver
+(define-class <event-receiver> (<irrlicht-base>)
+ (irr-class #:init-value "irr::IEventReceiver" #:getter irrlicht-class))
+
+
+;; IrrlichtDevice
+(define-class <irrlicht-device> (<reference-counted>)
+ (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 <event-receiver>)))
+ (if (not (is-a? receiver <event-receiver>))
+ (error
+ "In procedure create-device: Wrong type argument (expecting <event-receiver>):"
+ receiver))
+
+ (make <irrlicht-device>
+ #:ptr
+ (irr_createDevice device-type
+ window-size
+ bits
+ fullscreen
+ stencilbuffer
+ vsync
+ (wrapped-obj receiver))))
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);
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),
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
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);
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
projects / guile-irrlicht.git / commitdiff