From: Javier Sancho <jsf@jsancho.org>
Date: Tue, 31 Dec 2019 15:18:54 +0000 (+0100)
Subject: Generic function for unwrapping foreign records
X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=commitdiff_plain;h=71e6e638cba09643fca5dccd1b7295b7db0def06

Generic function for unwrapping foreign records
---

diff --git a/irrlicht/device.scm b/irrlicht/device.scm
index 051cddd..c773dbc 100644
--- a/irrlicht/device.scm
+++ b/irrlicht/device.scm
@@ -52,7 +52,7 @@
                        ('opengl ffi-video:EDT_OPENGL)
                        ('count ffi-video:EDT_COUNT))))
     (let ((device (ffi:create-device driver
-                                     (dimension2d->pointer window-size)
+                                     (foreign-record->pointer window-size)
                                      bits
                                      (bool->integer fullscreen)
                                      (bool->integer stencilbuffer)
diff --git a/irrlicht/dimension2d.scm b/irrlicht/dimension2d.scm
index 6b03cd0..7eb8cfd 100644
--- a/irrlicht/dimension2d.scm
+++ b/irrlicht/dimension2d.scm
@@ -24,7 +24,6 @@
   #:export (dimension2d
             make-dimension2d
             dimension2d?
-            dimension2d->pointer
             dimension2d-width
             dimension2d-height))
 
@@ -32,6 +31,5 @@
 (define-foreign-record-type dimension2d
   (make-dimension2d width height)
   dimension2d?
-  dimension2d->pointer
   (width uint32 dimension2d-width)
   (height uint32 dimension2d-height))
diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm
index 495a9c7..bd5eede 100644
--- a/irrlicht/gui.scm
+++ b/irrlicht/gui.scm
@@ -23,7 +23,6 @@
   #:use-module (system foreign)
   #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
   #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:)
-  #:use-module (irrlicht rect)
   #:use-module (irrlicht util)
   #:export (add-static-text!
             gui-draw-all
@@ -38,7 +37,7 @@
                            (fill-background #f))
   (ffi-gui:add-static-text gui-env
                            (string->pointer text)
-                           (rect->pointer rectangle)
+                           (foreign-record->pointer rectangle)
                            (bool->integer border)
                            (bool->integer word-wrap)
                            parent
diff --git a/irrlicht/rect.scm b/irrlicht/rect.scm
index f481a7c..b73f32d 100644
--- a/irrlicht/rect.scm
+++ b/irrlicht/rect.scm
@@ -24,7 +24,6 @@
   #:export (rect
             make-rect
             rect?
-            rect->pointer
             rect-x
             rect-y
             rect-x2
@@ -34,7 +33,6 @@
 (define-foreign-record-type rect
   (make-rect x y x2 y2)
   rect?
-  rect->pointer
   (x int32 rect-x)
   (y int32 rect-y)
   (x2 int32 rect-x2)
diff --git a/irrlicht/util.scm b/irrlicht/util.scm
index e7c8641..efa5ba7 100644
--- a/irrlicht/util.scm
+++ b/irrlicht/util.scm
@@ -25,7 +25,8 @@
   #:export (bool->integer
             integer->bool
             define-foreign
-            define-foreign-record-type))
+            define-foreign-record-type
+            foreign-record->pointer))
 
 (define (bool->integer var)
   (if var 1 0))
@@ -79,7 +80,7 @@
                   (iota (length field-specs))))
 
     (syntax-case x ()
-      ((_ name (make-name make-arg ...) predicate? unwrap-record field-spec ...)
+      ((_ name (make-name make-arg ...) predicate? field-spec ...)
        (with-syntax (((type-id ...) (field-types #'(field-spec ...)))
                      ((field-name ...) (field-names #'(field-spec ...)))
                      (((getter getter-id) ...) (field-getters #'(field-spec ...)))
@@ -133,3 +134,6 @@
            (else #f))))
     (if procedure
         (apply procedure bv 0 value '()))))
+
+(define (foreign-record->pointer record)
+  (struct-ref record 0))