From 8c5c5f5fc4aef51c5dfa515b3a8eee67de3b8e9b Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Tue, 5 May 2020 11:55:30 +0200 Subject: [PATCH] add-static-text! --- Makefile.am | 2 ++ irrlicht.scm | 6 ++-- irrlicht/device.scm | 73 +++++++++++++++++++++++++++++++++++++++++ irrlicht/gui.scm | 41 ++++++++++++++++++++--- irrlicht/io.scm | 30 +++++++++++++++++ irrlicht/irr.scm | 50 +--------------------------- irrlicht/scene.scm | 8 ++--- src/gui-environment.cpp | 59 +++++++++++++++------------------ src/gui-environment.h | 16 +++++---- 9 files changed, 187 insertions(+), 98 deletions(-) create mode 100644 irrlicht/device.scm create mode 100644 irrlicht/io.scm diff --git a/Makefile.am b/Makefile.am index 463dccb..65f3f94 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/irrlicht.scm b/irrlicht.scm index f43707d..d6c4b90 100644 --- a/irrlicht.scm +++ b/irrlicht.scm @@ -19,8 +19,10 @@ (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 index 0000000..6049016 --- /dev/null +++ b/irrlicht/device.scm @@ -0,0 +1,73 @@ +;;; 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 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 ()) + +(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 + #:irr-pointer + (irr_createDevice + device-type + window-size + bits + fullscreen + stencilbuffer + vsync + (irr-pointer receiver)))) + +(define-method (get-gui-environment (device )) + (make + #:irr-pointer (irr_IrrlichtDevice_getGUIEnvironment (irr-pointer device)))) + +(define-method (get-scene-manager (device )) + (make + #:irr-pointer (irr_IrrlichtDevice_getSceneManager (irr-pointer device)))) + +(define-method (get-video-driver (device )) + (make + #:irr-pointer (irr_IrrlichtDevice_getVideoDriver (irr-pointer device)))) + +(define-method (set-window-caption! (device ) text) + (irr_IrrlichtDevice_setWindowCaption (irr-pointer device) text)) + +(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!) diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index 70a2f97..e6e4ab3 100644 --- a/irrlicht/gui.scm +++ b/irrlicht/gui.scm @@ -20,11 +20,44 @@ (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 ()) +;; IGUIElement +(define-class ( )) -(export ) +(export ) + + +;; IGUIEnvironment +(define-class ()) + +(define-method (add-static-text! (gui-environment ) text rectangle . rest) + (let-keywords rest #f + ((border #f) + (word-wrap #t) + (parent (make )) + (id -1) + (fill-background #f)) + (make + #:irr-pointer + (irr_gui_IGUIEnvironment_addStaticText (irr-pointer gui-environment) + text + rectangle + border + word-wrap + (irr-pointer parent) + id + fill-background)))) + +(export add-static-text!) + + +;; IGUIStaticText +(define-class ()) + +(export ) diff --git a/irrlicht/io.scm b/irrlicht/io.scm new file mode 100644 index 0000000..73961bb --- /dev/null +++ b/irrlicht/io.scm @@ -0,0 +1,30 @@ +;;; 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 io) + #:use-module (oop goops) + #:use-module (irrlicht foreign) + #:use-module (irrlicht irr)) + + +;; IAttributeExchangingObject +(define-class ()) + +(export ) diff --git a/irrlicht/irr.scm b/irrlicht/irr.scm index f69701c..07e506a 100644 --- a/irrlicht/irr.scm +++ b/irrlicht/irr.scm @@ -21,10 +21,7 @@ (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 @@ -37,48 +34,3 @@ (define-class ()) (export ) - - -;; IrrlichtDevice -(define-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 - #:irr-pointer - (irr_createDevice - device-type - window-size - bits - fullscreen - stencilbuffer - vsync - (irr-pointer receiver)))) - -(define-method (get-gui-environment (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getGUIEnvironment (irr-pointer device)))) - -(define-method (get-scene-manager (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getSceneManager (irr-pointer device)))) - -(define-method (get-video-driver (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getVideoDriver (irr-pointer device)))) - -(define-method (set-window-caption! (device ) text) - (irr_IrrlichtDevice_setWindowCaption (irr-pointer device) text)) - -(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!) diff --git a/irrlicht/scene.scm b/irrlicht/scene.scm index 44a5233..27f8946 100644 --- a/irrlicht/scene.scm +++ b/irrlicht/scene.scm @@ -20,11 +20,11 @@ (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 ()) +;; ISceneManager +(define-class ()) (export ) diff --git a/src/gui-environment.cpp b/src/gui-environment.cpp index df43fc6..431216a 100644 --- a/src/gui-environment.cpp +++ b/src/gui-environment.cpp @@ -41,17 +41,20 @@ #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, diff --git a/src/gui-environment.h b/src/gui-environment.h index b26f542..bf896c8 100644 --- a/src/gui-environment.h +++ b/src/gui-environment.h @@ -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, -- 2.39.2