]> git.jsancho.org Git - guile-irrlicht.git/blobdiff - irrlicht/util.scm
WIP: SMaterial and vertices
[guile-irrlicht.git] / irrlicht / util.scm
index ecd21f65525c76b177a4df0aa8d5cf9b4d7f4155..8c5b9e4eb4651465c38ffda5b64d101a8623c4e6 100644 (file)
 
 
 (define-module (irrlicht util)
-  #:use-module (system foreign)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu)
   #:export (bool->integer
-            integer->bool
-            define-foreign
-            define-foreign-record-type))
+            integer->bool))
 
 (define (bool->integer var)
   (if var 1 0))
 
 (define (integer->bool var)
   (if (= var 0) #f #t))
-
-;; Based on guile-sdl2 function, thanks a lot
-(define irrlicht-func
-  (let ((cirr (dynamic-link "libCIrrlicht")))
-    (lambda (return-type function-name arg-types)
-      (pointer->procedure return-type
-                          (dynamic-func function-name cirr)
-                          arg-types))))
-
-(define-syntax-rule (define-foreign name return-type func-name arg-types)
-  (define-public name
-    (irrlicht-func return-type func-name arg-types)))
-
-;; foreign struct record type
-(define-record-type standard-foreign-record-type
-  (make-foreign-record-type name types fields)
-  foreign-record-type?
-  (name foreign-record-type-name)
-  (types foreign-record-type-types)
-  (fields foreign-record-type-fields))
-
-(define-record-type foreign-record
-  (make-foreign-record type pointer)
-  foreign-record?
-  (type foreign-record-type)
-  (pointer foreign-record-pointer set-foreign-record-pointer!))
-
-(set-record-type-printer! foreign-record
-  (lambda (record port)
-    (format port "#<~a" (foreign-record-type-name (foreign-record-type record)))
-    (let* ((pointer (foreign-record-pointer record))
-           (record-type (foreign-record-type record))
-           (types (foreign-record-type-types record-type))
-           (fields (foreign-record-type-fields record-type))
-           (values (parse-c-struct pointer types)))
-      (for-each (lambda (field value)
-                  (format port " ~a: ~a" field value))
-                fields
-                values))
-    (format port ">")))
-
-(define-syntax define-foreign-record-type
-  (lambda (x)
-    (define (field-names field-specs)
-      (map (lambda (field-spec)
-             (syntax-case field-spec ()
-               ((name type getter) #'name)
-               ((name type getter setter) #'name)))
-           field-specs))
-    (define (field-types field-specs)
-      (map (lambda (field-spec)
-             (syntax-case field-spec ()
-               ((name type getter) #'type)
-               ((name type getter setter) #'type)))
-           field-specs))
-    (syntax-case x ()
-      ((_ name (make-name make-arg ...) predicate? field-spec ...)
-       (with-syntax (((type-id ...) (field-types #'(field-spec ...)))
-                     ((field-name ...) (field-names #'(field-spec ...))))
-         #'(begin
-             (define name
-               (make-foreign-record-type
-                'name
-                (list type-id ...)
-                (list 'field-name ...)))
-             (define (make-name make-arg ...)
-               (let* ((types (foreign-record-type-types name))
-                      (c-struct-pointer (make-c-struct types (list make-arg ...))))
-                 (make-foreign-record name c-struct-pointer)))
-             (define (predicate? record)
-               (and
-                (foreign-record? record)
-                (let* ((record-type (foreign-record-type record))
-                       (type-name (foreign-record-type-name record-type)))
-                  (equal? type-name (foreign-record-type-name name)))))
-             (export name)
-             (export make-name)
-             (export predicate?)))))))