From: Javier Sancho <jsf@jsancho.org>
Date: Thu, 14 May 2020 07:10:39 +0000 (+0200)
Subject: add-file-archive! get-file-system get-name
X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=commitdiff_plain;h=09e9ed196aadab0f77e831c134fce8bdb58b772b

add-file-archive! get-file-system get-name
---

diff --git a/irrlicht.scm b/irrlicht.scm
index a51b60c..c1e52c2 100644
--- a/irrlicht.scm
+++ b/irrlicht.scm
@@ -23,19 +23,23 @@
   #:use-module (irrlicht base)
   #:use-module (irrlicht device)
   #:use-module (irrlicht gui)
+  #:use-module (irrlicht io)
   #:use-module (irrlicht irr)
   #:use-module (irrlicht scene)
   #:use-module (irrlicht video)
   #:duplicates (merge-generics)
   #:re-export (add-animated-mesh-scene-node!
                add-camera-scene-node!
+               add-file-archive!
                add-static-text!
                begin-scene
                create-device
                drop!
                end-scene
+               get-file-system
                get-gui-environment
                get-mesh
+               get-name
                get-scene-manager
                get-texture
                get-video-driver
diff --git a/irrlicht/device.scm b/irrlicht/device.scm
index 97e2bba..6e9dfcc 100644
--- a/irrlicht/device.scm
+++ b/irrlicht/device.scm
@@ -22,6 +22,7 @@
   #:use-module (oop goops)
   #:use-module (irrlicht base)
   #:use-module (irrlicht foreign)
+  #:use-module (irrlicht io)
   #:use-module (irrlicht irr)
   #:use-module (irrlicht gui)
   #:use-module (irrlicht scene)
@@ -56,6 +57,11 @@
      vsync
      receiver)))
 
+(define-method (get-file-system (device <irrlicht-device>))
+  (let ((getFileSystem (get-irrlicht-proc "getFileSystem" device)))
+    (make <file-system>
+      #:irr-pointer (getFileSystem device))))
+
 (define-method (get-gui-environment (device <irrlicht-device>))
   (let ((getGUIEnvironment (get-irrlicht-proc "getGUIEnvironment" device)))
     (make <gui-environment>
@@ -76,5 +82,5 @@
   ((get-irrlicht-proc "setWindowCaption" device)
    device text))
 
-(export create-device get-gui-environment get-scene-manager get-video-driver run
+(export create-device get-file-system get-gui-environment get-scene-manager get-video-driver run
         set-window-caption!)
diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm
index f6e2036..aaac04f 100644
--- a/irrlicht/foreign.scm
+++ b/irrlicht/foreign.scm
@@ -28,6 +28,8 @@
 (define remote-proc-table (make-hash-table))
 
 (define (get-irrlicht-proc proc-name . objects)
+  (format #t "Objects: ~a ~a~%" objects irr-class)
+  (format #t "Classes: ~a~%" (map irr-class objects))
   (let* ((name (if (null? objects)
                    proc-name
                    (let ((classes (map irr-class objects)))
diff --git a/irrlicht/io.scm b/irrlicht/io.scm
index 0229ac3..1e94c5d 100644
--- a/irrlicht/io.scm
+++ b/irrlicht/io.scm
@@ -20,6 +20,7 @@
 
 (define-module (irrlicht io)
   #:use-module (oop goops)
+  #:use-module (ice-9 optargs)
   #:use-module (irrlicht foreign)
   #:use-module (irrlicht irr))
 
@@ -29,3 +30,28 @@
   (irr-class #:init-value "IAttributeExchangingObject" #:getter irr-class))
 
 (export <attribute-exchanging-object>)
+
+
+;;IFileArchive
+(define-class <file-archive> (<reference-counted>)
+  (irr-class #:init-value "IFileArchive" #:getter irr-class))
+
+(export <file-archive>)
+
+
+;;IFileSystem
+(define-class <file-system> (<reference-counted>)
+  (irr-class #:init-value "IFileSystem" #:getter irr-class))
+
+(define-method (add-file-archive! (file-system <file-system>) filename . rest)
+  (let-keywords rest #f
+        ((ignore-case #t)
+         (ignore-paths #t)
+         (archive-type 'unknown)
+         (password "")
+         (ret-archive (make <file-archive>)))
+    (let ((addFileArchive (get-irrlicht-proc "addFileArchive" file-system)))
+      (addFileArchive
+       file-system filename ignore-case ignore-paths archive-type password ret-archive))))
+
+(export <file-system> add-file-archive!)
diff --git a/irrlicht/video.scm b/irrlicht/video.scm
index ee1f767..5659276 100644
--- a/irrlicht/video.scm
+++ b/irrlicht/video.scm
@@ -55,6 +55,10 @@
   ((get-irrlicht-proc "endScene" video-driver)
    video-driver))
 
+(define-method (get-name (video-driver <video-driver>))
+  (let ((getName (get-irrlicht-proc "getName" video-driver)))
+    (getName video-driver)))
+
 (define-method (get-texture (video-driver <video-driver>) filename)
   (make <texture>
     #:irr-pointer
@@ -62,4 +66,4 @@
      video-driver
      filename)))
 
-(export <video-driver> begin-scene end-scene get-texture)
+(export <video-driver> begin-scene end-scene get-name get-texture)
diff --git a/src/video-driver.cpp b/src/video-driver.cpp
index 45e8358..dd663e7 100644
--- a/src/video-driver.cpp
+++ b/src/video-driver.cpp
@@ -28,6 +28,7 @@
 #include "rect.h"
 #include "vertex3d.h"
 #include "video-driver.h"
+#include "wchar.h"
 #include "wrapped.h"
 
 using namespace irr;
@@ -114,6 +115,13 @@ IVideoDriver_getFPS (SCM video_driver)
   return scm_from_int32 (driver->getFPS ());
 }
 
+SCM
+IVideoDriver_getName (SCM video_driver)
+{
+  video::IVideoDriver* driver = (video::IVideoDriver*) scm_to_irr_pointer (video_driver);
+  return scm_from_wide_char_string (driver->getName ());
+}
+
 SCM
 IVideoDriver_getTexture (SCM video_driver,
                          SCM filename)
@@ -152,6 +160,7 @@ init_video_driver (void)
                 IVideoDriver_drawVertexPrimitiveList);
   DEFINE_GSUBR ("IVideoDriver_endScene", 1, 0, 0, IVideoDriver_endScene);
   DEFINE_GSUBR ("IVideoDriver_getFPS", 1, 0, 0, IVideoDriver_getFPS);
+  DEFINE_GSUBR ("IVideoDriver_getName", 1, 0, 0, IVideoDriver_getName);
   DEFINE_GSUBR ("IVideoDriver_getTexture", 2, 0, 0, IVideoDriver_getTexture);
   DEFINE_GSUBR ("IVideoDriver_setMaterial", 2, 0, 0, IVideoDriver_setMaterial);
   DEFINE_GSUBR ("IVideoDriver_setTransform", 3, 0, 0, IVideoDriver_setTransform);