;;; <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)