wrap Irrlicht objects in C++

diff --git a/irrlicht.scm b/irrlicht.scm
index 3c54b18e66a8f9bb4508a68be05ad624ef5b10fd..73ab60d3c505fd098b65b9301350f14dd8a6b820 100644 (file)
--- a/irrlicht.scm
+++ b/irrlicht.scm
@@ -29,7 +29,34 @@
   #:use-module (irrlicht scene)
   #:use-module (irrlicht video)
   #:duplicates (merge-generics)
   #:use-module (irrlicht scene)
   #:use-module (irrlicht video)
   #:duplicates (merge-generics)

-  #:re-export (add-animated-mesh-scene-node!
+  #:re-export (;; classes
+               <animated-mesh>
+               <animated-mesh-scene-node>
+               <attribute-exchanging-object>
+               <box3d>
+               <camera-scene-node>
+               <cursor-control>
+               <event>
+               <event-receiver>
+               <file-archive>
+               <file-system>
+               <gui-element>
+               <gui-environment>
+               <gui-static-text>
+               <irrlicht-device>
+               <key-map>
+               <material>
+               <mesh>
+               <mesh-scene-node>
+               <reference-counted>
+               <scene-manager>
+               <scene-node>
+               <scene-node-animator>
+               <texture>
+               <vertex3d>
+               <video-driver>
+               ;; methods
+               add-animated-mesh-scene-node!

                add-animator!
                add-camera-scene-node!
                add-camera-scene-node-fps!
                add-animator!
                add-camera-scene-node!
                add-camera-scene-node-fps!

diff --git a/irrlicht/core.scm b/irrlicht/core.scm
index 2b714727bd5ca4b342a7df72d35628f836ea465f..ab2d070335addcbb8f00f905714f15e3db05c399 100644 (file)
--- a/irrlicht/core.scm
+++ b/irrlicht/core.scm
@@ -34,7 +34,7 @@
 
 (define (make-box3d)
   (let ((aabbox3d_make (get-irrlicht-proc "aabbox3d_make")))
 
 (define (make-box3d)
   (let ((aabbox3d_make (get-irrlicht-proc "aabbox3d_make")))

-    (make <box3d> #:irr-pointer (aabbox3d_make))))
+    (aabbox3d_make)))

 
 (define-method (reset-box3d! (box3d <box3d>) init-value)
   (let ((reset (get-irrlicht-proc "aabbox3d_reset")))
 
 (define-method (reset-box3d! (box3d <box3d>) init-value)
   (let ((reset (get-irrlicht-proc "aabbox3d_reset")))

diff --git a/irrlicht/device.scm b/irrlicht/device.scm
index 04988d39602e24deb51ead3f2cce967fccbaa750..c922cece2076b139f62b51f36fd0e51cb2129a2b 100644 (file)
--- a/irrlicht/device.scm
+++ b/irrlicht/device.scm
@@ -47,35 +47,32 @@
        receiver))
 
   (let* ((createDevice (get-irrlicht-proc "createDevice"))
        receiver))
 
   (let* ((createDevice (get-irrlicht-proc "createDevice"))

-         (device-pointer (createDevice device-type window-size bits fullscreen stencilbuffer
-                                       vsync receiver)))
-    (cond ((null-pointer? device-pointer)
+         (device (createDevice device-type window-size bits fullscreen stencilbuffer
+                               vsync receiver)))
+    (cond ((null-object? device)

            (error "In procedure create-device: Device cannot be created"))
           (else
            (error "In procedure create-device: Device cannot be created"))
           (else

-           (make <irrlicht-device> #:irr-pointer device-pointer)))))
+           device))))

 
 (define-method (get-cursor-control (device <irrlicht-device>))
   (let ((getCursorControl (get-irrlicht-proc "getCursorControl" device)))
 
 (define-method (get-cursor-control (device <irrlicht-device>))
   (let ((getCursorControl (get-irrlicht-proc "getCursorControl" device)))

-    (make <cursor-control>
-      #:irr-pointer (getCursorControl device))))
+    (getCursorControl device)))

 
 (define-method (get-file-system (device <irrlicht-device>))
   (let ((getFileSystem (get-irrlicht-proc "getFileSystem" device)))
 
 (define-method (get-file-system (device <irrlicht-device>))
   (let ((getFileSystem (get-irrlicht-proc "getFileSystem" device)))

-    (make <file-system>
-      #:irr-pointer (getFileSystem device))))
+    (getFileSystem device)))

 
 (define-method (get-gui-environment (device <irrlicht-device>))
   (let ((getGUIEnvironment (get-irrlicht-proc "getGUIEnvironment" device)))
 
 (define-method (get-gui-environment (device <irrlicht-device>))
   (let ((getGUIEnvironment (get-irrlicht-proc "getGUIEnvironment" device)))

-    (make <gui-environment>
-      #:irr-pointer (getGUIEnvironment device))))
+    (getGUIEnvironment device)))

 
 (define-method (get-scene-manager (device <irrlicht-device>))
 
 (define-method (get-scene-manager (device <irrlicht-device>))

-  (make <scene-manager>
-    #:irr-pointer ((get-irrlicht-proc "getSceneManager" device) device)))
+  (let ((getSceneManager (get-irrlicht-proc "getSceneManager" device)))
+    (getSceneManager device)))

 
 (define-method (get-video-driver (device <irrlicht-device>))
 
 (define-method (get-video-driver (device <irrlicht-device>))

-  (make <video-driver>
-    #:irr-pointer ((get-irrlicht-proc "getVideoDriver" device) device)))
+  (let ((getVideoDriver (get-irrlicht-proc "getVideoDriver" device)))
+    (getVideoDriver device)))

 
 (define-method (is-window-active? (device <irrlicht-device>))
   (let ((isWindowActive (get-irrlicht-proc "isWindowActive" device)))
 
 (define-method (is-window-active? (device <irrlicht-device>))
   (let ((isWindowActive (get-irrlicht-proc "isWindowActive" device)))


@@ -92,5 +89,5 @@
   (let ((yield (get-irrlicht-proc "yield" device)))
     (yield device)))
 
   (let ((yield (get-irrlicht-proc "yield" device)))
     (yield device)))
 

-(export create-device get-cursor-control get-file-system get-gui-environment get-scene-manager
-        get-video-driver is-window-active? run set-window-caption! yield-device)
+(export <irrlicht-device> create-device get-cursor-control get-file-system get-gui-environment
+        get-scene-manager get-video-driver is-window-active? run set-window-caption! yield-device)

diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm
index 94aab7c8fe7c7c979c68877b00c24cef922d7e64..9b55633accaf17ad17cdd39077f3cf93896032e9 100644 (file)
--- a/irrlicht/foreign.scm
+++ b/irrlicht/foreign.scm
@@ -22,7 +22,7 @@
   #:use-module (system foreign)
   #:use-module (irrlicht base)
   #:export (get-irrlicht-proc
   #:use-module (system foreign)
   #:use-module (irrlicht base)
   #:export (get-irrlicht-proc

-            null-pointer?))
+            null-object?))

 
 ;; We use a hash table to store foreign irrlicht methods related with their
 ;; classes
 
 ;; We use a hash table to store foreign irrlicht methods related with their
 ;; classes


@@ -43,5 +43,5 @@
           (else
            proc))))
 
           (else
            proc))))
 

-(define (null-pointer? pointer)
-  (eq? pointer %null-pointer))
+(define (null-object? object)
+  (eq? (irr-pointer object) %null-pointer))

diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm
index 1471409807bc524261e95e27851b1e50a58ae3a3..fe2f09df54cb36af81972aa9e5a92c4b338becd1 100644 (file)
--- a/irrlicht/gui.scm
+++ b/irrlicht/gui.scm
@@ -56,17 +56,9 @@
          (parent (make <gui-element>))
          (id -1)
          (fill-background #f))
          (parent (make <gui-element>))
          (id -1)
          (fill-background #f))

-    (make <gui-static-text>
-      #:irr-pointer
-      ((get-irrlicht-proc "addStaticText" gui-environment parent)
-       gui-environment
-       text
-       rectangle
-       border
-       word-wrap
-       parent
-       id
-       fill-background))))
+    (let ((addStaticText (get-irrlicht-proc "addStaticText" gui-environment parent)))
+      (addStaticText gui-environment text rectangle border word-wrap parent
+                     id fill-background))))

 
 (define-method (draw-all (gui-environment <gui-environment>))
   ((get-irrlicht-proc "drawAll" gui-environment)
 
 (define-method (draw-all (gui-environment <gui-environment>))
   ((get-irrlicht-proc "drawAll" gui-environment)

diff --git a/irrlicht/scene.scm b/irrlicht/scene.scm
index 9626f4b33cdabe64723d1463852fd9a016492327..0ac44842f5fff33f744506b1f4864839dc22426d 100644 (file)
--- a/irrlicht/scene.scm
+++ b/irrlicht/scene.scm
@@ -66,12 +66,12 @@
     (let* ((addAnimatedMeshSceneNode (get-irrlicht-proc "addAnimatedMeshSceneNode"
                                                         scene-manager
                                                         parent))
     (let* ((addAnimatedMeshSceneNode (get-irrlicht-proc "addAnimatedMeshSceneNode"
                                                         scene-manager
                                                         parent))

-           (node-pointer (addAnimatedMeshSceneNode scene-manager mesh parent id position
-                                                   rotation scale also-add-if-mesh-pointer-zero)))
-      (cond ((null-pointer? node-pointer)
+           (node (addAnimatedMeshSceneNode scene-manager mesh parent id position
+                                           rotation scale also-add-if-mesh-pointer-zero)))
+      (cond ((null-object? node)

              (error "In procedure add-animated-mesh-scene-node!: Scene node cannot be created"))
             (else
              (error "In procedure add-animated-mesh-scene-node!: Scene node cannot be created"))
             (else

-             (make <animated-mesh-scene-node> #:irr-pointer node-pointer))))))
+             node)))))

 
 (define-method (add-camera-scene-node! (scene-manager <scene-manager>) . rest)
   (let-keywords rest #f
 
 (define-method (add-camera-scene-node! (scene-manager <scene-manager>) . rest)
   (let-keywords rest #f


@@ -80,15 +80,8 @@
          (lookat '(0 0 100))
          (id -1)
          (make-active #t))
          (lookat '(0 0 100))
          (id -1)
          (make-active #t))

-    (make <camera-scene-node>
-      #:irr-pointer
-      ((get-irrlicht-proc "addCameraSceneNode" scene-manager parent)
-       scene-manager
-       parent
-       position
-       lookat
-       id
-       make-active))))
+    (let ((addCameraSceneNode (get-irrlicht-proc "addCameraSceneNode" scene-manager parent)))
+      (addCameraSceneNode scene-manager parent position lookat id make-active))))

 
 (define-method (add-camera-scene-node-fps! (scene-manager <scene-manager>) . rest)
   (let-keywords rest #f
 
 (define-method (add-camera-scene-node-fps! (scene-manager <scene-manager>) . rest)
   (let-keywords rest #f


@@ -104,14 +97,12 @@
          (make-active #t))
     (let ((addCameraSceneNodeFPS (get-irrlicht-proc "addCameraSceneNodeFPS"
                                                     scene-manager parent)))
          (make-active #t))
     (let ((addCameraSceneNodeFPS (get-irrlicht-proc "addCameraSceneNodeFPS"
                                                     scene-manager parent)))

-      (make <camera-scene-node>
-        #:irr-pointer
-        (addCameraSceneNodeFPS scene-manager #:parent parent #:rotate-speed rotate-speed
-                               #:move-speed move-speed #:id id #:key-map-array key-map-array
-                               #:key-map-size key-map-size
-                               #:no-vertical-movement no-vertical-movement
-                               #:jump-speed jump-speed #:invert-mouse invert-mouse
-                               #:make-active make-active)))))
+      (addCameraSceneNodeFPS scene-manager #:parent parent #:rotate-speed rotate-speed
+                             #:move-speed move-speed #:id id #:key-map-array key-map-array
+                             #:key-map-size key-map-size
+                             #:no-vertical-movement no-vertical-movement
+                             #:jump-speed jump-speed #:invert-mouse invert-mouse
+                             #:make-active make-active))))

 
 (define-method (add-custom-scene-node! (scene-manager <scene-manager>) proc-render
                                        proc-get-bounding-box  proc-get-material-count
 
 (define-method (add-custom-scene-node! (scene-manager <scene-manager>) proc-render
                                        proc-get-bounding-box  proc-get-material-count


@@ -123,10 +114,8 @@
          (rotation '(0 0 0))
          (scale '(1 1 1)))
     (let ((addCustomSceneNode (get-irrlicht-proc "addCustomSceneNode" scene-manager parent)))
          (rotation '(0 0 0))
          (scale '(1 1 1)))
     (let ((addCustomSceneNode (get-irrlicht-proc "addCustomSceneNode" scene-manager parent)))

-      (make <scene-node>
-        #:irr-pointer
-        (addCustomSceneNode scene-manager proc-render proc-get-bounding-box proc-get-material-count
-                            proc-get-material parent id position rotation scale)))))
+      (addCustomSceneNode scene-manager proc-render proc-get-bounding-box proc-get-material-count
+                          proc-get-material parent id position rotation scale))))

 
 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
                                        (mesh <animated-mesh>)
 
 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
                                        (mesh <animated-mesh>)


@@ -137,10 +126,8 @@
          (minimal-polys-per-node 512)
          (also-add-if-mesh-pointer-zero #f))
     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))
          (minimal-polys-per-node 512)
          (also-add-if-mesh-pointer-zero #f))
     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))

-      (make <mesh-scene-node>
-        #:irr-pointer
-        (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
-                            also-add-if-mesh-pointer-zero)))))
+      (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
+                          also-add-if-mesh-pointer-zero))))

 
 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
                                        (mesh <mesh>)
 
 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
                                        (mesh <mesh>)


@@ -151,16 +138,12 @@
          (minimal-polys-per-node 256)
          (also-add-if-mesh-pointer-zero #f))
     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))
          (minimal-polys-per-node 256)
          (also-add-if-mesh-pointer-zero #f))
     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))

-      (make <mesh-scene-node>
-        #:irr-pointer
-        (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
-                            also-add-if-mesh-pointer-zero)))))
+      (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
+                          also-add-if-mesh-pointer-zero))))

 
 (define-method (create-rotation-animator (scene-manager <scene-manager>) rotation-speed)
   (let ((createRotationAnimator (get-irrlicht-proc "createRotationAnimator" scene-manager)))
 
 (define-method (create-rotation-animator (scene-manager <scene-manager>) rotation-speed)
   (let ((createRotationAnimator (get-irrlicht-proc "createRotationAnimator" scene-manager)))

-    (make <scene-node-animator>
-      #:irr-pointer
-      (createRotationAnimator scene-manager rotation-speed))))
+    (createRotationAnimator scene-manager rotation-speed)))

 
 (define-method (draw-all (scene-manager <scene-manager>))
   ((get-irrlicht-proc "drawAll" scene-manager)
 
 (define-method (draw-all (scene-manager <scene-manager>))
   ((get-irrlicht-proc "drawAll" scene-manager)


@@ -168,15 +151,15 @@
 
 (define-method (get-mesh (scene-manager <scene-manager>) filename)
   (let* ((getMesh (get-irrlicht-proc "getMesh" scene-manager))
 
 (define-method (get-mesh (scene-manager <scene-manager>) filename)
   (let* ((getMesh (get-irrlicht-proc "getMesh" scene-manager))

-         (mesh-pointer (getMesh scene-manager filename)))
-    (cond ((null-pointer? mesh-pointer)
+         (mesh (getMesh scene-manager filename)))
+    (cond ((null-object? mesh)

            (error "In procedure get-mesh: Mesh cannot be created"))
           (else
            (error "In procedure get-mesh: Mesh cannot be created"))
           (else

-           (make <animated-mesh> #:irr-pointer mesh-pointer)))))
+           mesh))))

 
 (define-method (get-root-scene-node (scene-manager <scene-manager>))
   (let ((getRootSceneNode (get-irrlicht-proc "getRootSceneNode" scene-manager)))
 
 (define-method (get-root-scene-node (scene-manager <scene-manager>))
   (let ((getRootSceneNode (get-irrlicht-proc "getRootSceneNode" scene-manager)))

-    (make <scene-node> #:irr-pointer (getRootSceneNode scene-manager))))
+    (getRootSceneNode scene-manager)))

 
 (export <scene-manager> add-animated-mesh-scene-node! add-camera-scene-node!
         add-camera-scene-node-fps! add-custom-scene-node! add-octree-scene-node!
 
 (export <scene-manager> add-animated-mesh-scene-node! add-camera-scene-node!
         add-camera-scene-node-fps! add-custom-scene-node! add-octree-scene-node!

diff --git a/irrlicht/video.scm b/irrlicht/video.scm
index 6c56f62776c86290d16642b76e7e2c8b157b0b2a..f4feff4f4b552f6ac5d0b1f2affcb4b4b14169fa 100644 (file)
--- a/irrlicht/video.scm
+++ b/irrlicht/video.scm
@@ -64,23 +64,21 @@
                         (normalize-normals #f)
                         (use-mip-maps #t))
   (let ((SMaterial_make (get-irrlicht-proc "SMaterial_make")))
                         (normalize-normals #f)
                         (use-mip-maps #t))
   (let ((SMaterial_make (get-irrlicht-proc "SMaterial_make")))

-    (make <material>
-      #:irr-pointer
-      (SMaterial_make #:material-type material-type #:ambient-color ambient-color
-                      #:diffuse-color diffuse-color #:emissive-color emissive-color
-                      #:specular-color specular-color #:shininess shininess
-                      #:material-type-param material-type-param
-                      #:material-type-param-2 material-type-param-2
-                      #:thickness thickness #:z-buffer z-buffer #:anti-aliasing anti-aliasing
-                      #:color-mask color-mask #:color-material color-material
-                      #:blend-operation blend-operation
-                      #:polygon-offset-factor polygon-offset-factor
-                      #:polygon-offset-direction polygon-offset-direction
-                      #:wireframe wireframe #:point-cloud point-cloud
-                      #:gouraud-shading gouraud-shading #:lighting lighting
-                      #:z-write-enable z-write-enable #:backface-culling backface-culling
-                      #:frontface-culling frontface-culling #:fog-enable fog-enable
-                      #:normalize-normals normalize-normals #:use-mip-maps use-mip-maps))))
+    (SMaterial_make #:material-type material-type #:ambient-color ambient-color
+                    #:diffuse-color diffuse-color #:emissive-color emissive-color
+                    #:specular-color specular-color #:shininess shininess
+                    #:material-type-param material-type-param
+                    #:material-type-param-2 material-type-param-2
+                    #:thickness thickness #:z-buffer z-buffer #:anti-aliasing anti-aliasing
+                    #:color-mask color-mask #:color-material color-material
+                    #:blend-operation blend-operation
+                    #:polygon-offset-factor polygon-offset-factor
+                    #:polygon-offset-direction polygon-offset-direction
+                    #:wireframe wireframe #:point-cloud point-cloud
+                    #:gouraud-shading gouraud-shading #:lighting lighting
+                    #:z-write-enable z-write-enable #:backface-culling backface-culling
+                    #:frontface-culling frontface-culling #:fog-enable fog-enable
+                    #:normalize-normals normalize-normals #:use-mip-maps use-mip-maps)))

 
 (export <material> make-material)
 
 
 (export <material> make-material)
 


@@ -124,11 +122,8 @@
     (getName video-driver)))
 
 (define-method (get-texture (video-driver <video-driver>) filename)
     (getName video-driver)))
 
 (define-method (get-texture (video-driver <video-driver>) filename)

-  (make <texture>
-    #:irr-pointer
-    ((get-irrlicht-proc "getTexture" video-driver)
-     video-driver
-     filename)))
+  (let ((getTexture (get-irrlicht-proc "getTexture" video-driver)))
+    (getTexture video-driver filename)))

 
 (define-method (set-material! (video-driver <video-driver>) (material <material>))
   (let ((setMaterial (get-irrlicht-proc "setMaterial" video-driver)))
 
 (define-method (set-material! (video-driver <video-driver>) (material <material>))
   (let ((setMaterial (get-irrlicht-proc "setMaterial" video-driver)))


@@ -152,8 +147,6 @@
 
 (define (make-vertex3d position normal color tcoords)
   (let ((S3DVertex_make (get-irrlicht-proc "S3DVertex_make")))
 
 (define (make-vertex3d position normal color tcoords)
   (let ((S3DVertex_make (get-irrlicht-proc "S3DVertex_make")))

-    (make <vertex3d>
-      #:irr-pointer
-      (S3DVertex_make position normal color tcoords))))
+    (S3DVertex_make position normal color tcoords)))

 
 (export <vertex3d> get-position make-vertex3d)
 
 (export <vertex3d> get-position make-vertex3d)

diff --git a/src/box3d.cpp b/src/box3d.cpp
index b1b873c58034774e133bdb337b4fdbb7778a95a8..e254bc23cf2372a08efc8f18773e8302787e53b7 100644 (file)
--- a/src/box3d.cpp
+++ b/src/box3d.cpp
@@ -40,7 +40,7 @@ SCM
 aabbox3d_make ()
 {
   core::aabbox3df* aabbox = new core::aabbox3df ();
 aabbox3d_make ()
 {
   core::aabbox3df* aabbox = new core::aabbox3df ();

-  return scm_from_pointer ((void*)aabbox, NULL);
+  return scm_from_irr_pointer ("<box3d>", (void*) aabbox);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/device.cpp b/src/device.cpp
index ba00f3960f86c821a6ec22ec4420d06d5b8966ba..dbd251cc390b65d733bae8416f38446383ff62a8 100644 (file)
--- a/src/device.cpp
+++ b/src/device.cpp
@@ -46,7 +46,7 @@ irr_createDevice (SCM device_type,
                   scm_to_bool (stencilbuffer),
                   scm_to_bool (vsync),
                   (IEventReceiver*)scm_to_irr_pointer (receiver));
                   scm_to_bool (stencilbuffer),
                   scm_to_bool (vsync),
                   (IEventReceiver*)scm_to_irr_pointer (receiver));

-  return scm_from_pointer ((void*)device, NULL);
+  return scm_from_irr_pointer ("<irrlicht-device>", (void*) device);

 }
 
 SCM
 }
 
 SCM


@@ -54,7 +54,7 @@ IrrlichtDevice_getCursorControl (SCM device)
 {
   gui::ICursorControl* cursor_control =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getCursorControl ();
 {
   gui::ICursorControl* cursor_control =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getCursorControl ();

-  return scm_from_pointer ((void*)cursor_control, NULL);
+  return scm_from_irr_pointer ("<cursor-control>", (void*) cursor_control);

 }
 
 SCM
 }
 
 SCM


@@ -62,7 +62,7 @@ IrrlichtDevice_getFileSystem (SCM device)
 {
   io::IFileSystem* file_system =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getFileSystem ();
 {
   io::IFileSystem* file_system =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getFileSystem ();

-  return scm_from_pointer ((void*)file_system, NULL);
+  return scm_from_irr_pointer ("<file-system>", (void*) file_system);

 }
 
 SCM
 }
 
 SCM


@@ -70,7 +70,7 @@ IrrlichtDevice_getGUIEnvironment (SCM device)
 {
   gui::IGUIEnvironment* gui_env =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getGUIEnvironment ();
 {
   gui::IGUIEnvironment* gui_env =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getGUIEnvironment ();

-  return scm_from_pointer ((void*)gui_env, NULL);
+  return scm_from_irr_pointer ("<gui-environment>", (void*) gui_env);

 }
 
 SCM
 }
 
 SCM


@@ -78,7 +78,7 @@ IrrlichtDevice_getSceneManager (SCM device)
 {
   scene::ISceneManager* manager =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getSceneManager ();
 {
   scene::ISceneManager* manager =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getSceneManager ();

-  return scm_from_pointer ((void*)manager, NULL);
+  return scm_from_irr_pointer ("<scene-manager>", (void*) manager);

 }
 
 SCM
 }
 
 SCM


@@ -86,7 +86,7 @@ IrrlichtDevice_getTimer (SCM device)
 {
   ITimer* timer =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getTimer ();
 {
   ITimer* timer =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getTimer ();

-  return scm_from_pointer ((void*)timer, NULL);
+  return scm_from_irr_pointer ("<timer>", (void*) timer);

 }
 
 SCM
 }
 
 SCM


@@ -94,7 +94,7 @@ IrrlichtDevice_getVideoDriver (SCM device)
 {
   video::IVideoDriver* driver =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getVideoDriver ();
 {
   video::IVideoDriver* driver =
     ((IrrlichtDevice*)scm_to_irr_pointer (device))->getVideoDriver ();

-  return scm_from_pointer ((void*)driver, NULL);
+  return scm_from_irr_pointer ("<video-driver>", (void*) driver);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/event-receiver.cpp b/src/event-receiver.cpp
index f8f8a5572c822c8e21386eb1e58b7e42869399bf..1d8e09722e887d784f3bef4e707ca12123fc3d05 100644 (file)
--- a/src/event-receiver.cpp
+++ b/src/event-receiver.cpp
@@ -43,13 +43,13 @@ IEventReceiver_make (SCM proc_on_event)
 
     virtual bool OnEvent (const SEvent& event)
     {
 
     virtual bool OnEvent (const SEvent& event)
     {

-      SCM wrapped_event = scm_from_irr_pointer ("irrlicht irr", "<event>", (void*) &event);
+      SCM wrapped_event = scm_from_irr_pointer ("<event>", (void*) &event);

       return scm_to_bool (scm_call_1 (scm_on_event, wrapped_event));
     }
   };
 
   CustomReceiver* receiver = new CustomReceiver (proc_on_event);
       return scm_to_bool (scm_call_1 (scm_on_event, wrapped_event));
     }
   };
 
   CustomReceiver* receiver = new CustomReceiver (proc_on_event);

-  return scm_from_irr_pointer ("irrlicht irr", "<event-receiver>", (void*) receiver);
+  return scm_from_irr_pointer ("<event-receiver>", (void*) receiver);

 }
 
 SCM
 }
 
 SCM


@@ -64,7 +64,7 @@ SEvent_SGUIEvent_Caller (SCM event)
 {
   gui::IGUIElement* caller =
     ((SEvent*)scm_to_irr_pointer (event))->GUIEvent.Caller;
 {
   gui::IGUIElement* caller =
     ((SEvent*)scm_to_irr_pointer (event))->GUIEvent.Caller;

-  return scm_from_pointer ((void*)caller, NULL);
+  return scm_from_irr_pointer ("<gui-element>", (void*) caller);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/gui-environment.cpp b/src/gui-environment.cpp
index e7645176999d0523e62b75f054a58f155ecd394d..d29750ffa88e3a0c5be0d3bb92baa9124f7d5752 100644 (file)
--- a/src/gui-environment.cpp
+++ b/src/gui-environment.cpp
@@ -52,7 +52,7 @@ IGUIEnvironment_addButton (SCM gui_environment,
 
   free (wtext);
   free (wtooltiptext);
 
   free (wtext);
   free (wtooltiptext);

-  return scm_from_pointer ((void*)button, NULL);
+  return scm_from_irr_pointer ("<gui-button>", (void*) button);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -75,7 +75,7 @@ IGUIEnvironment_addEditBox (SCM gui_environment,
                 scm_to_int32 (id));
 
   free (wtext);
                 scm_to_int32 (id));
 
   free (wtext);

-  return scm_from_pointer ((void*)editbox, NULL);
+  return scm_from_irr_pointer ("<gui-editbox>", (void*) editbox);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -100,7 +100,7 @@ IGUIEnvironment_addImage (SCM gui_environment,
                       wtext);
 
   free (wtext);
                       wtext);
 
   free (wtext);

-  return scm_from_pointer ((void*) new_image, NULL);
+  return scm_from_irr_pointer ("<gui-image>", (void*) new_image);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -117,7 +117,7 @@ IGUIEnvironment_addListBox (SCM gui_environment,
                 (TParent)scm_to_irr_pointer (parent),
                 scm_to_int32 (id),
                 scm_to_bool (draw_background));
                 (TParent)scm_to_irr_pointer (parent),
                 scm_to_int32 (id),
                 scm_to_bool (draw_background));

-  return scm_from_pointer ((void*)listbox, NULL);
+  return scm_from_irr_pointer ("<gui-listbox>", (void*) listbox);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -134,7 +134,7 @@ IGUIEnvironment_addScrollBar (SCM gui_environment,
                   scm_to_rect_s32 (rectangle),
                   (TParent)scm_to_irr_pointer (parent),
                   scm_to_int32 (id));
                   scm_to_rect_s32 (rectangle),
                   (TParent)scm_to_irr_pointer (parent),
                   scm_to_int32 (id));

-  return scm_from_pointer ((void*)scrollbar, NULL);
+  return scm_from_irr_pointer ("<gui-scrollbar>", (void*) scrollbar);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -161,7 +161,7 @@ IGUIEnvironment_addStaticText (SCM gui_environment,
                    scm_to_bool (fill_background));
 
   free (wtext);
                    scm_to_bool (fill_background));
 
   free (wtext);

-  return scm_from_pointer ((void*)static_text, NULL);
+  return scm_from_irr_pointer ("<gui-static-text>", (void*) static_text);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -184,7 +184,7 @@ IGUIEnvironment_addWindow (SCM gui_environment,
                scm_to_int32 (id));
 
   free (wtext);
                scm_to_int32 (id));
 
   free (wtext);

-  return scm_from_pointer ((void*)window, NULL);
+  return scm_from_irr_pointer ("<gui-window>", (void*) window);

 }
 
 SCM
 }
 
 SCM


@@ -199,7 +199,7 @@ IGUIEnvironment_getBuiltInFont (SCM gui_environment)
 {
   gui::IGUIFont* font =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getBuiltInFont ();
 {
   gui::IGUIFont* font =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getBuiltInFont ();

-  return scm_from_pointer ((void*)font, NULL);
+  return scm_from_irr_pointer ("<gui-font>", (void*) font);

 }
 
 SCM
 }
 
 SCM


@@ -210,7 +210,7 @@ IGUIEnvironment_getFont (SCM gui_environment,
   gui::IGUIFont* font =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getFont (cfilename);
   free (cfilename);
   gui::IGUIFont* font =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getFont (cfilename);
   free (cfilename);

-  return scm_from_pointer ((void*)font, NULL);
+  return scm_from_irr_pointer ("<gui-font>", (void*) font);

 }
 
 SCM
 }
 
 SCM


@@ -218,7 +218,7 @@ IGUIEnvironment_getSkin (SCM gui_environment)
 {
   gui::IGUISkin* skin =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getSkin ();
 {
   gui::IGUISkin* skin =
     ((gui::IGUIEnvironment*)scm_to_irr_pointer (gui_environment))->getSkin ();

-  return scm_from_pointer ((void*)skin, NULL);
+  return scm_from_irr_pointer ("<gui-skin>", (void*) skin);

 }
 
 void
 }
 
 void

diff --git a/src/gui-skin.cpp b/src/gui-skin.cpp
index 06242ddebec7fab5f344dd920847cf13eafff45a..aeebebe897d1965abc32ae84a8e1aaa7f8ab687e 100644 (file)
--- a/src/gui-skin.cpp
+++ b/src/gui-skin.cpp
@@ -43,7 +43,7 @@ IGUISkin_getFont (SCM gui_skin,
 {
   gui::IGUISkin* skin = (gui::IGUISkin*) scm_to_irr_pointer (gui_skin);
   gui::IGUIFont* font = skin->getFont (scm_to_default_font (which));
 {
   gui::IGUISkin* skin = (gui::IGUISkin*) scm_to_irr_pointer (gui_skin);
   gui::IGUIFont* font = skin->getFont (scm_to_default_font (which));

-  return scm_from_pointer ((void*) font, NULL);
+  return scm_from_irr_pointer ("<gui-font>", (void*) font);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/gui-toolbar.cpp b/src/gui-toolbar.cpp
index 18a71f78f5d48255594cbf7933ae4f59b9a0e3b9..134081691d57de16018e74b3a994383a82ca624e 100644 (file)
--- a/src/gui-toolbar.cpp
+++ b/src/gui-toolbar.cpp
@@ -52,7 +52,7 @@ IGUIToolBar_addButton (SCM gui_toolbar,
 
   free (wtext);
   free (wtooltiptext);
 
   free (wtext);
   free (wtooltiptext);

-  return scm_from_pointer ((void*) button, NULL);
+  return scm_from_irr_pointer ("<gui-button>", (void*) button);

 }
 
 void
 }
 
 void

diff --git a/src/material.cpp b/src/material.cpp
index 8380924fc210249324a254c33bf420eecabd7a1d..087952a78074afe97a6d3842f51eb8d7c92e2d09 100644 (file)
--- a/src/material.cpp
+++ b/src/material.cpp
@@ -26,6 +26,7 @@
 #include "gsubr.h"
 #include "material.h"
 #include "material-types.h"
 #include "gsubr.h"
 #include "material.h"
 #include "material-types.h"

+#include "wrapped.h"

 
 using namespace irr;
 
 
 using namespace irr;
 


@@ -116,7 +117,7 @@ SMaterial_make (SCM rest)
   material->FogEnable = scm_to_bool (fog_enable);
   material->NormalizeNormals = scm_to_bool (normalize_normals);
   material->UseMipMaps = scm_to_bool (use_mip_maps);
   material->FogEnable = scm_to_bool (fog_enable);
   material->NormalizeNormals = scm_to_bool (normalize_normals);
   material->UseMipMaps = scm_to_bool (use_mip_maps);

-  return scm_from_pointer ((void*) material, NULL);
+  return scm_from_irr_pointer ("<material>", (void*) material);

 }
 
 void
 }
 
 void

diff --git a/src/scene-manager.cpp b/src/scene-manager.cpp
index c9edc8f7488147bf25b4ae3cc2920f0ad10ad883..31f433075664c02b269ebfd4c1b461febd6cb3d3 100644 (file)
--- a/src/scene-manager.cpp
+++ b/src/scene-manager.cpp
@@ -48,7 +48,7 @@ ISceneManager_addAnimatedMeshSceneNode (SCM scene_manager,
                                     scm_to_vector3df (rotation),
                                     scm_to_vector3df (scale),
                                     scm_to_bool (also_add_if_mesh_pointer_zero));
                                     scm_to_vector3df (rotation),
                                     scm_to_vector3df (scale),
                                     scm_to_bool (also_add_if_mesh_pointer_zero));

-  return scm_from_pointer ((void*) node, NULL);
+  return scm_from_irr_pointer ("<animated-mesh-scene-node>", (void*) node);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -67,7 +67,7 @@ ISceneManager_addCameraSceneNode (SCM scene_manager,
                               scm_to_vector3df (lookat),
                               scm_to_int32 (id),
                               scm_to_bool (make_active));
                               scm_to_vector3df (lookat),
                               scm_to_int32 (id),
                               scm_to_bool (make_active));

-  return scm_from_pointer ((void*) camera, NULL);
+  return scm_from_irr_pointer ("<camera-scene-node>", (void*) camera);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -112,7 +112,7 @@ ISceneManager_addCameraSceneNodeFPS (SCM scene_manager,
                                  scm_to_double (jump_speed),
                                  scm_to_bool (invert_mouse),
                                  scm_to_bool (make_active));
                                  scm_to_double (jump_speed),
                                  scm_to_bool (invert_mouse),
                                  scm_to_bool (make_active));

-  return scm_from_pointer ((void*) camera, NULL);
+  return scm_from_irr_pointer ("<camera-scene-node>", (void*) camera);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -133,7 +133,7 @@ ISceneManager_addCubeSceneNode (SCM scene_manager,
                             scm_to_vector3df (position),
                             scm_to_vector3df (rotation),
                             scm_to_vector3df (scale));
                             scm_to_vector3df (position),
                             scm_to_vector3df (rotation),
                             scm_to_vector3df (scale));

-  return scm_from_pointer ((void*) node, NULL);
+  return scm_from_irr_pointer ("<mesh-scene-node>", (void*) node);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -218,7 +218,7 @@ ISceneManager_addCustomSceneNode (SCM scene_manager,
                          proc_get_bounding_box,
                          proc_get_material_count,
                          proc_get_material);
                          proc_get_bounding_box,
                          proc_get_material_count,
                          proc_get_material);

-  return scm_from_pointer ((void*) node, NULL);
+  return scm_from_irr_pointer ("<scene-node>", (void*) node);

 }
 
 template <typename TParent, typename TMesh>
 }
 
 template <typename TParent, typename TMesh>


@@ -237,7 +237,7 @@ ISceneManager_addOctreeSceneNode (SCM scene_manager,
                               scm_to_int32 (id),
                               scm_to_int32 (minimal_polys_per_node),
                               scm_to_bool (also_add_if_mesh_pointer_zero));
                               scm_to_int32 (id),
                               scm_to_int32 (minimal_polys_per_node),
                               scm_to_bool (also_add_if_mesh_pointer_zero));

-  return scm_from_pointer ((void*) node, NULL);
+  return scm_from_irr_pointer ("<mesh-scene-node>", (void*) node);

 }
 
 template <typename TParent>
 }
 
 template <typename TParent>


@@ -260,7 +260,7 @@ ISceneManager_addSphereSceneNode (SCM scene_manager,
                               scm_to_vector3df (position),
                               scm_to_vector3df (rotation),
                               scm_to_vector3df (scale));
                               scm_to_vector3df (position),
                               scm_to_vector3df (rotation),
                               scm_to_vector3df (scale));

-  return scm_from_pointer ((void*) node, NULL);
+  return scm_from_irr_pointer ("<mesh-scene-node>", (void*) node);

 }
 
 SCM
 }
 
 SCM


@@ -280,7 +280,7 @@ ISceneManager_createFlyCircleAnimator (SCM scene_manager,
                                    scm_to_vector3df (direction),
                                    scm_to_double (start_position),
                                    scm_to_double (radius_ellipsoid));
                                    scm_to_vector3df (direction),
                                    scm_to_double (start_position),
                                    scm_to_double (radius_ellipsoid));

-  return scm_from_pointer ((void*) anim, NULL);
+  return scm_from_irr_pointer ("<scene-node-animator>", (void*) anim);

 }
 
 SCM
 }
 
 SCM


@@ -298,7 +298,7 @@ ISceneManager_createFlyStraightAnimator (SCM scene_manager,
                                      scm_to_uint32 (time_for_way),
                                      scm_to_bool (loop),
                                      scm_to_bool (pingpong));
                                      scm_to_uint32 (time_for_way),
                                      scm_to_bool (loop),
                                      scm_to_bool (pingpong));

-  return scm_from_pointer ((void*) anim, NULL);
+  return scm_from_irr_pointer ("<scene-node-animator>", (void*) anim);

 }
 
 SCM
 }
 
 SCM


@@ -308,7 +308,7 @@ ISceneManager_createRotationAnimator (SCM scene_manager,
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);
   scene::ISceneNodeAnimator* anim =
     smgr->createRotationAnimator (scm_to_vector3df (rotation_speed));
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);
   scene::ISceneNodeAnimator* anim =
     smgr->createRotationAnimator (scm_to_vector3df (rotation_speed));

-  return scm_from_pointer ((void*) anim, NULL);
+  return scm_from_irr_pointer ("<scene-node-animator>", (void*) anim);

 }
 
 SCM
 }
 
 SCM


@@ -326,14 +326,14 @@ ISceneManager_getMesh (SCM scene_manager,
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);
   scene::IAnimatedMesh* mesh = smgr->getMesh(cfilename);
   free (cfilename);
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);
   scene::IAnimatedMesh* mesh = smgr->getMesh(cfilename);
   free (cfilename);

-  return scm_from_pointer ((void*) mesh, NULL);
+  return scm_from_irr_pointer ("<animated-mesh>", (void*) mesh);

 }
 
 SCM
 ISceneManager_getRootSceneNode (SCM scene_manager)
 {
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);
 }
 
 SCM
 ISceneManager_getRootSceneNode (SCM scene_manager)
 {
   scene::ISceneManager* smgr = (scene::ISceneManager*) scm_to_irr_pointer (scene_manager);

-  return scm_from_pointer ((void*) smgr->getRootSceneNode (), NULL);
+  return scm_from_irr_pointer ("<scene-node>", (void*) smgr->getRootSceneNode ());

 }
 
 void
 }
 
 void

diff --git a/src/vertex3d.cpp b/src/vertex3d.cpp
index f7c7afb67e59e19b6d258417560d6e9c144b508b..e0ca2d2cab1ee198e0fd6798ab2740d1f346023c 100644 (file)
--- a/src/vertex3d.cpp
+++ b/src/vertex3d.cpp
@@ -41,7 +41,7 @@ S3DVertex_make (SCM position,
                           scm_to_vector3df (normal),
                           scm_to_color (color),
                           scm_to_vector2df (tcoords));
                           scm_to_vector3df (normal),
                           scm_to_color (color),
                           scm_to_vector2df (tcoords));

-  return scm_from_pointer ((void*) vertex, NULL);
+  return scm_from_irr_pointer ("<vertex3d>", (void*) vertex);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/video-driver.cpp b/src/video-driver.cpp
index 35491116ff13fcc1e039736c8e26a29456128dca..60fc867cdb3050e46a0111230e8bd13854cb19cc 100644 (file)
--- a/src/video-driver.cpp
+++ b/src/video-driver.cpp
@@ -129,7 +129,7 @@ IVideoDriver_getTexture (SCM video_driver,
   video::IVideoDriver* driver = (video::IVideoDriver*) scm_to_irr_pointer (video_driver);
   video::ITexture* texture = driver->getTexture (cfilename);
   free (cfilename);
   video::IVideoDriver* driver = (video::IVideoDriver*) scm_to_irr_pointer (video_driver);
   video::ITexture* texture = driver->getTexture (cfilename);
   free (cfilename);

-  return scm_from_pointer ((void*) texture, NULL);
+  return scm_from_irr_pointer ("<texture>", (void*) texture);

 }
 
 SCM
 }
 
 SCM

diff --git a/src/wrapped.cpp b/src/wrapped.cpp
index 6da7adf5063ef7cce71dbd1539ceb8fca7993a5c..d569440f0b911e3d6b815f6a6be1ab49ac63b5b2 100644 (file)
--- a/src/wrapped.cpp
+++ b/src/wrapped.cpp
@@ -19,14 +19,17 @@
    <http://www.gnu.org/licenses/>.
 */
 
    <http://www.gnu.org/licenses/>.
 */
 

+#include <irrlicht/irrlicht.h>

 #include <libguile.h>
 #include "wrapped.h"
 
 #include <libguile.h>
 #include "wrapped.h"
 

+using namespace irr;
+

 /* Make a GOOPS instance from a C++ object pointer */
 SCM
 /* Make a GOOPS instance from a C++ object pointer */
 SCM

-scm_from_irr_pointer (const char* module, const char* class_name, void* pointer)
+scm_from_irr_pointer (const char* class_name, void* pointer)

 {
 {

-  SCM scm_class = scm_variable_ref (scm_c_public_lookup (module, class_name));
+  SCM scm_class = scm_variable_ref (scm_c_public_lookup ("irrlicht", class_name));

   SCM k_pointer = scm_from_utf8_keyword ("irr-pointer");
   SCM scm_pointer = scm_from_pointer (pointer, NULL);
   return scm_make (scm_list_3 (scm_class, k_pointer, scm_pointer));
   SCM k_pointer = scm_from_utf8_keyword ("irr-pointer");
   SCM scm_pointer = scm_from_pointer (pointer, NULL);
   return scm_make (scm_list_3 (scm_class, k_pointer, scm_pointer));

diff --git a/src/wrapped.h b/src/wrapped.h
index 21f080ef0de9b55f85ae897d5d0d2228a3e5954b..2518025c937a03d414ca0040a567c3aeffc20077 100644 (file)
--- a/src/wrapped.h
+++ b/src/wrapped.h
@@ -22,10 +22,13 @@
 #ifndef __GUILE_IRRLICHT_WRAPPED_H_INCLUDED__
 #define __GUILE_IRRLICHT_WRAPPED_H_INCLUDED__
 
 #ifndef __GUILE_IRRLICHT_WRAPPED_H_INCLUDED__
 #define __GUILE_IRRLICHT_WRAPPED_H_INCLUDED__
 

+#include <irrlicht/irrlicht.h>

 #include <libguile.h>
 
 #include <libguile.h>
 

+using namespace irr;
+

 SCM
 SCM

-scm_from_irr_pointer (const char* module, const char* class_name, void* pointer);
+scm_from_irr_pointer (const char* class_name, void* pointer);

 
 void*
 scm_to_irr_pointer (SCM obj);
 
 void*
 scm_to_irr_pointer (SCM obj);