]> git.jsancho.org Git - guile-irrlicht.git/commitdiff
add-static-text!
authorJavier Sancho <jsf@jsancho.org>
Tue, 5 May 2020 09:55:30 +0000 (11:55 +0200)
committerJavier Sancho <jsf@jsancho.org>
Tue, 5 May 2020 09:55:30 +0000 (11:55 +0200)
Makefile.am
irrlicht.scm
irrlicht/device.scm [new file with mode: 0644]
irrlicht/gui.scm
irrlicht/io.scm [new file with mode: 0644]
irrlicht/irr.scm
irrlicht/scene.scm
src/gui-environment.cpp
src/gui-environment.h

index 463dccb8a31e264470660e3cd02f03dcfb8b0d89..65f3f944847168123f3613dd665faebba166ac59 100644 (file)
@@ -104,8 +104,10 @@ godir = @GUILE_SITE_CCACHE@
 SOURCES = \
   irrlicht.scm \
   irrlicht/base.scm \
+  irrlicht/device.scm \
   irrlicht/foreign.scm \
   irrlicht/gui.scm \
+  irrlicht/io.scm \
   irrlicht/irr.scm \
   irrlicht/scene.scm \
   irrlicht/video.scm
index f43707d959c185c751480b5d4f7216669b45b7cb..d6c4b90afe35c7e5fb7527ac32ed71c5e15694a8 100644 (file)
 
 
 (define-module (irrlicht)
-  #:use-module (irrlicht irr)
-  #:re-export (create-device
+  #:use-module (irrlicht device)
+  #:use-module (irrlicht gui)
+  #:re-export (add-static-text!
+               create-device
                get-gui-environment
                get-scene-manager
                get-video-driver
diff --git a/irrlicht/device.scm b/irrlicht/device.scm
new file mode 100644 (file)
index 0000000..6049016
--- /dev/null
@@ -0,0 +1,73 @@
+;;; 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 device)
+  #:use-module (oop goops)
+  #:use-module (irrlicht base)
+  #:use-module (irrlicht foreign)
+  #:use-module (irrlicht irr)
+  #:use-module (irrlicht gui)
+  #:use-module (irrlicht scene)
+  #:use-module (irrlicht video))
+
+
+;; IrrlichtDevice
+(define-class <irrlicht-device> (<reference-counted>))
+
+(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>
+    #:irr-pointer
+    (irr_createDevice
+     device-type
+     window-size
+     bits
+     fullscreen
+     stencilbuffer
+     vsync
+     (irr-pointer receiver))))
+
+(define-method (get-gui-environment (device <irrlicht-device>))
+  (make <gui-environment>
+    #:irr-pointer (irr_IrrlichtDevice_getGUIEnvironment (irr-pointer device))))
+
+(define-method (get-scene-manager (device <irrlicht-device>))
+  (make <scene-manager>
+    #:irr-pointer (irr_IrrlichtDevice_getSceneManager (irr-pointer device))))
+
+(define-method (get-video-driver (device <irrlicht-device>))
+  (make <video-driver>
+    #:irr-pointer (irr_IrrlichtDevice_getVideoDriver (irr-pointer device))))
+
+(define-method (set-window-caption! (device <irrlicht-device>) text)
+  (irr_IrrlichtDevice_setWindowCaption (irr-pointer device) text))
+
+(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!)
index 70a2f97db51895c86135db6f6515d77e00e6939c..e6e4ab3135320e1a9b925fe1f4172d4b50beed08 100644 (file)
 
 (define-module (irrlicht gui)
   #:use-module (oop goops)
+  #:use-module (ice-9 optargs)
   #:use-module (irrlicht base)
-  #:use-module (irrlicht foreign))
+  #:use-module (irrlicht foreign)
+  #:use-module (irrlicht io)
+  #:use-module (irrlicht irr))
 
 
-;; IVideoDriver
-(define-class <gui-environment> (<irrlicht-base>))
+;; IGUIElement
+(define-class <gui-element> (<attribute-exchanging-object> <event-receiver>))
 
-(export <gui-environment>)
+(export <gui-element>)
+
+
+;; IGUIEnvironment
+(define-class <gui-environment> (<reference-counted>))
+
+(define-method (add-static-text! (gui-environment <gui-environment>) text rectangle . rest)
+  (let-keywords rest #f
+        ((border #f)
+         (word-wrap #t)
+         (parent (make <gui-element>))
+         (id -1)
+         (fill-background #f))
+    (make <gui-static-text>
+      #:irr-pointer
+      (irr_gui_IGUIEnvironment_addStaticText (irr-pointer gui-environment)
+                                             text
+                                             rectangle
+                                             border
+                                             word-wrap
+                                             (irr-pointer parent)
+                                             id
+                                             fill-background))))
+
+(export <gui-environment> add-static-text!)
+
+
+;; IGUIStaticText
+(define-class <gui-static-text> (<gui-element>))
+
+(export <gui-static-text>)
diff --git a/irrlicht/io.scm b/irrlicht/io.scm
new file mode 100644 (file)
index 0000000..73961bb
--- /dev/null
@@ -0,0 +1,30 @@
+;;; 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 io)
+  #:use-module (oop goops)
+  #:use-module (irrlicht foreign)
+  #:use-module (irrlicht irr))
+
+
+;; IAttributeExchangingObject
+(define-class <attribute-exchanging-object> (<reference-counted>))
+
+(export <attribute-exchanging-object>)
index f69701c278842ea306e13948f05d8dd0a7a73490..07e506acdeaefc9ff62518fceb042382b35ea52d 100644 (file)
 (define-module (irrlicht irr)
   #:use-module (oop goops)
   #:use-module (irrlicht base)
-  #:use-module (irrlicht foreign)
-  #:use-module (irrlicht gui)
-  #:use-module (irrlicht scene)
-  #:use-module (irrlicht video))
+  #:use-module (irrlicht foreign))
 
 
 ;; IReferenceCounted
 (define-class <event-receiver> (<irrlicht-base>))
 
 (export <event-receiver>)
-
-
-;; IrrlichtDevice
-(define-class <irrlicht-device> (<reference-counted>))
-
-(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>
-    #:irr-pointer
-    (irr_createDevice
-     device-type
-     window-size
-     bits
-     fullscreen
-     stencilbuffer
-     vsync
-     (irr-pointer receiver))))
-
-(define-method (get-gui-environment (device <irrlicht-device>))
-  (make <gui-environment>
-    #:irr-pointer (irr_IrrlichtDevice_getGUIEnvironment (irr-pointer device))))
-
-(define-method (get-scene-manager (device <irrlicht-device>))
-  (make <scene-manager>
-    #:irr-pointer (irr_IrrlichtDevice_getSceneManager (irr-pointer device))))
-
-(define-method (get-video-driver (device <irrlicht-device>))
-  (make <video-driver>
-    #:irr-pointer (irr_IrrlichtDevice_getVideoDriver (irr-pointer device))))
-
-(define-method (set-window-caption! (device <irrlicht-device>) text)
-  (irr_IrrlichtDevice_setWindowCaption (irr-pointer device) text))
-
-(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!)
index 44a52334f9dd304c1033e0967172425748975b52..27f89465e4ae8c88ce54c9c93fbe7c0a248dfc81 100644 (file)
 
 (define-module (irrlicht scene)
   #:use-module (oop goops)
-  #:use-module (irrlicht base)
-  #:use-module (irrlicht foreign))
+  #:use-module (irrlicht foreign)
+  #:use-module (irrlicht irr))
 
 
-;; IVideoDriver
-(define-class <scene-manager> (<irrlicht-base>))
+;; ISceneManager
+(define-class <scene-manager> (<reference-counted>))
 
 (export <scene-manager>)
index df43fc63d5359ef1b4ca5aef614cf8fbc2886a9f..431216af070c0b2fffd432109d56263d04539c17 100644 (file)
 #include "wchar.h"
 #include "wrapped.h"
 
+using namespace irr;
+
 extern "C" {
 
   void
   init_gui_environment (void)
   {
     init_gui_environment_type ();
+    DEFINE_GSUBR ("irr_gui_IGUIEnvironment_addStaticText", 8, 0, 0,
+                  irr_gui_IGUIEnvironment_addStaticText);
     DEFINE_GSUBR ("add-image!", 3, 0, 1, irr_gui_addImage);
     DEFINE_GSUBR ("add-editbox!", 3, 0, 1, irr_gui_addEditBox);
     DEFINE_GSUBR ("add-listbox!", 2, 0, 1, irr_gui_addListBox);
     DEFINE_GSUBR ("add-scrollbar!", 3, 0, 1, irr_gui_addScrollBar);
-    DEFINE_GSUBR ("add-static-text!", 3, 0, 1, irr_gui_addStaticText);
     DEFINE_GSUBR ("add-window!", 2, 0, 1, irr_gui_addWindow);
     DEFINE_GSUBR ("get-built-in-font", 1, 0, 0, irr_gui_getBuiltInFont);
     DEFINE_GSUBR ("get-skin", 1, 0, 0, irr_gui_getSkin);
@@ -61,6 +64,28 @@ extern "C" {
                        init_gui_environment_type, gui_environment_p,
                        wrap_gui_environment, unwrap_gui_environment);
 
+  SCM
+  irr_gui_IGUIEnvironment_addStaticText (SCM gui_environment,
+                                         SCM text,
+                                         SCM rectangle,
+                                         SCM border,
+                                         SCM word_wrap,
+                                         SCM parent,
+                                         SCM id,
+                                         SCM fill_background)
+  {
+    gui::IGUIStaticText* static_text =
+      ((gui::IGUIEnvironment*)scm_to_pointer (gui_environment))->
+      addStaticText (scm_to_wide_char_string (text),
+                     scm_to_rect_s32 (rectangle),
+                     scm_to_bool (border),
+                     scm_to_bool (word_wrap),
+                     (gui::IGUIElement*)scm_to_pointer (parent),
+                     scm_to_int32 (id),
+                     scm_to_bool (fill_background));
+    return scm_from_pointer ((void*)static_text, NULL);
+  }
+
   SCM
   irr_gui_addImage (SCM wrapped_gui_environment,
                     SCM image,
@@ -163,38 +188,6 @@ extern "C" {
     return wrap_gui_scrollbar (scrollbar);
   }
 
-  SCM
-  irr_gui_addStaticText (SCM wrapped_gui_environment,
-                         SCM text,
-                         SCM rectangle,
-                         SCM rest)
-  {
-    SCM border = SCM_BOOL_F;
-    SCM word_wrap = SCM_BOOL_T;
-    SCM parent = SCM_UNDEFINED;
-    SCM id = scm_from_int32 (-1);
-    SCM fill_background = SCM_BOOL_F;
-
-    scm_c_bind_keyword_arguments ("add-static-text!", rest, (scm_t_keyword_arguments_flags)0,
-                                  scm_from_utf8_keyword ("border"), &border,
-                                  scm_from_utf8_keyword ("word-wrap"), &word_wrap,
-                                  scm_from_utf8_keyword ("parent"), &parent,
-                                  scm_from_utf8_keyword ("id"), &id,
-                                  scm_from_utf8_keyword ("fill-background"), &fill_background,
-                                  SCM_UNDEFINED);
-
-    irr::gui::IGUIEnvironment* guienv = unwrap_gui_environment (wrapped_gui_environment);
-    irr::gui::IGUIStaticText* staticText =
-      guienv->addStaticText (scm_to_wide_char_string (text),
-                             scm_to_rect_s32 (rectangle),
-                             scm_to_bool (border),
-                             scm_to_bool (word_wrap),
-                             parent == SCM_UNDEFINED ? 0 : unwrap_gui_element (parent),
-                             scm_to_int32 (id),
-                             scm_to_bool (fill_background));
-    return wrap_gui_static_text (staticText);
-  }
-
   SCM
   irr_gui_addWindow (SCM wrapped_gui_environment,
                      SCM rectangle,
index b26f542e6b344d53526a379987008caa87fe7c62..bf896c8595636fc8deaaed8aa91f3dcd46aa2a04 100644 (file)
@@ -34,6 +34,16 @@ extern "C" {
   DECLARE_WRAPPED_TYPE (irr::gui::IGUIEnvironment*, init_gui_environment_type,
                         gui_environment_p, wrap_gui_environment, unwrap_gui_environment);
 
+  SCM
+  irr_gui_IGUIEnvironment_addStaticText (SCM gui_environment,
+                                         SCM text,
+                                         SCM rectangle,
+                                         SCM border,
+                                         SCM word_wrap,
+                                         SCM parent,
+                                         SCM id,
+                                         SCM fill_background);
+
   SCM
   irr_gui_addImage (SCM wrapped_gui_environment,
                     SCM image,
@@ -57,12 +67,6 @@ extern "C" {
                         SCM rectangle,
                         SCM rest);
 
-  SCM
-  irr_gui_addStaticText (SCM wrapped_gui_environment,
-                         SCM text,
-                         SCM rectangle,
-                         SCM rest);
-
   SCM
   irr_gui_addWindow (SCM wrapped_gui_environment,
                      SCM rectangle,