X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fforeign.scm;h=96cec83bd0dd04c9dfca6a5c5c5757cf07992337;hb=1289b18b5a3277202d3e5eb3ae65186447142aae;hp=ff46223674e7aa73a341b563502c496e40cb2ea1;hpb=c9c098c6a9363eb59f435eb195a4bc5b9098b1dd;p=guile-irrlicht.git

diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm
index ff46223..96cec83 100644
--- a/irrlicht/foreign.scm
+++ b/irrlicht/foreign.scm
@@ -18,6 +18,48 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 
-(define-module (irrlicht foreign))
+(define-module (irrlicht foreign)
+  #:use-module (system foreign)
+  #:use-module (irrlicht base)
+  #:export (get-irrlicht-proc
+            null-object?
+            remember-wrapped
+            mem-wrapped))
 
-(load-extension "libguile-irrlicht" "init_guile_irrlicht")
+;; We use a hash table to store foreign irrlicht methods related with their
+;; classes
+;; This is needed because we need to "simulate" C++ inheritance
+(define remote-proc-table (make-hash-table))
+
+(define (get-irrlicht-proc proc-name . objects)
+  (let* ((name (if (null? objects)
+                   proc-name
+                   (let ((classes (map irr-class objects)))
+                     (string-join (cons (car classes) (cons proc-name (cdr classes))) "_"))))
+         (proc (hash-ref remote-proc-table name)))
+    (cond ((not proc)
+           (load-extension "libguile-irrlicht" "init_guile_irrlicht")
+           (let ((new-proc (eval-string name)))
+             (hash-set! remote-proc-table name new-proc)
+             new-proc))
+          (else
+           proc))))
+
+(define (null-object? object)
+  (null-pointer? (irr-pointer object)))
+
+;; Table for storing foreign irrlicht wrapped objects by its pointer address
+;; We can recover them later, when we have an address without knowing its type, like in
+;; events case
+(define wrapped-obj-table (make-hash-table))
+
+(define (remember-wrapped object)
+  (or (hash-ref wrapped-obj-table
+                (pointer-address (irr-pointer object)))
+      object))
+
+(define (mem-wrapped object)
+  (hash-set! wrapped-obj-table
+             (pointer-address (irr-pointer object))
+             object)
+  object)