X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=blobdiff_plain;f=irrlicht%2Fforeign.scm;fp=irrlicht%2Fforeign.scm;h=0000000000000000000000000000000000000000;hp=96cec83bd0dd04c9dfca6a5c5c5757cf07992337;hb=d392bfc335713faab44275624d8fd78139880975;hpb=3bb58c2b45af12c0f9c9eac648e67ac6fa90e104 diff --git a/irrlicht/foreign.scm b/irrlicht/foreign.scm deleted file mode 100644 index 96cec83..0000000 --- a/irrlicht/foreign.scm +++ /dev/null @@ -1,65 +0,0 @@ -;;; 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 foreign) - #:use-module (system foreign) - #:use-module (irrlicht base) - #:export (get-irrlicht-proc - null-object? - remember-wrapped - mem-wrapped)) - -;; 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)