define-foreign syntax

diff --git a/irrlicht/bindings.scm b/irrlicht/bindings.scm
index 0039b2d0cc4aea89465aaaac9a2674d4cf493e35..a7031a996e4d86174968bcff1cc3fde489dfc53e 100644 (file)
--- a/irrlicht/bindings.scm
+++ b/irrlicht/bindings.scm
@@ -19,66 +19,35 @@
 
 
 (define-module (irrlicht bindings)
-  #:use-module (system foreign))
+  #:use-module (system foreign)
+  #:use-module (irrlicht util))
 
-(define cirr (dynamic-link "libCIrrlicht"))
+(define-foreign create-device
+  '* "irr_createDevice" (list int '* uint32 int int int))
 
-(define-public create-device
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_createDevice" cirr)
-   (list int '* uint32 int int int)))
+(define-foreign get-cursor-control
+  '* "irr_getCursorControl" (list '*))
 
-(define-public get-cursor-control
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_getCursorControl" cirr)
-   (list '*)))
+(define-foreign get-file-system
+  '* "irr_getFileSystem" (list '*))
 
-(define-public get-file-system
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_getFileSystem" cirr)
-   (list '*)))
+(define-foreign get-video-driver
+  '* "irr_getVideoDriver" (list '*))
 
-(define-public get-video-driver
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_getVideoDriver" cirr)
-   (list '*)))
+(define-foreign get-gui-environment
+  '* "irr_getGUIEnvironment" (list '*))
 
-(define-public get-gui-environment
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_getGUIEnvironment" cirr)
-   (list '*)))
+(define-foreign get-scene-manager
+  '* "irr_getSceneManager" (list '*))
 
-(define-public get-scene-manager
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_getSceneManager" cirr)
-   (list '*)))
+(define-foreign is-window-active
+  int "irr_isWindowActive" (list '*))
 
-(define-public is-window-active
-  (pointer->procedure
-   int
-   (dynamic-func "irr_isWindowActive" cirr)
-   (list '*)))
+(define-foreign set-window-caption
+  void "irr_setWindowCaption" (list '* '*))
 
-(define-public set-window-caption
-  (pointer->procedure
-   void
-   (dynamic-func "irr_setWindowCaption" cirr)
-   (list '* '*)))
+(define-foreign run
+  int "irr_run" (list '*))
 
-(define-public run
-  (pointer->procedure
-   int
-   (dynamic-func "irr_run" cirr)
-   (list '*)))
-
-(define-public drop
-  (pointer->procedure
-   int
-   (dynamic-func "irr_drop" cirr)
-   (list '*)))
+(define-foreign drop
+  int "irr_drop" (list '*))

diff --git a/irrlicht/bindings/gui.scm b/irrlicht/bindings/gui.scm
index beb6459d9a76d58ee6c0d3fcaf4c862867cca547..ad2a8c80fe8088772daae32eee253793853bac0c 100644 (file)
--- a/irrlicht/bindings/gui.scm
+++ b/irrlicht/bindings/gui.scm
@@ -19,24 +19,14 @@
 
 
 (define-module (irrlicht bindings gui)
-  #:use-module (system foreign))
+  #:use-module (system foreign)
+  #:use-module (irrlicht util))
 
-(define cirr (dynamic-link "libCIrrlicht"))
+(define-foreign add-static-text
+  '* "irr_gui_addStaticText" (list '* '* '* int int '* int int))
 
-(define-public add-static-text
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_gui_addStaticText" cirr)
-   (list '* '* '* int int '* int int)))
+(define-foreign draw-all
+  void "irr_gui_drawAll" (list '*))
 
-(define-public draw-all
-  (pointer->procedure
-   void
-   (dynamic-func "irr_gui_drawAll" cirr)
-   (list '*)))
-
-(define-public set-visible-cursor
-  (pointer->procedure
-   void
-   (dynamic-func "irr_gui_setVisibleCursor" cirr)
-   (list '* int)))
+(define-foreign set-visible-cursor
+  void "irr_gui_setVisibleCursor" (list '* int))

diff --git a/irrlicht/bindings/io.scm b/irrlicht/bindings/io.scm
index 5532ec10f68f9f10c3a721f5e24e11ae49c34956..3373a7b0a36fdd80f9cf793d7f1db8a37cb4ac95 100644 (file)
--- a/irrlicht/bindings/io.scm
+++ b/irrlicht/bindings/io.scm
@@ -20,9 +20,8 @@
 
 (define-module (irrlicht bindings io)
   #:use-module (system foreign)
-  #:use-module (rnrs arithmetic bitwise))
-
-(define cirr (dynamic-link "libCIrrlicht"))
+  #:use-module (rnrs arithmetic bitwise)
+  #:use-module (irrlicht util))
 
 (define (make-cirr-id c0 c1 c2 c3)
   (define (char->numeric c)
@@ -52,8 +51,5 @@
 (define-public EFAT_UNKNOWN (make-cirr-id #\u #\n #\k #\n))
 
 ;; IO functions
-(define-public add-file-archive
-  (pointer->procedure
-   int
-   (dynamic-func "irr_io_addFileArchive" cirr)
-   (list '* '* int int int '* '*)))
+(define-foreign add-file-archive
+  int "irr_io_addFileArchive" (list '* '* int int int '* '*))

diff --git a/irrlicht/bindings/scene.scm b/irrlicht/bindings/scene.scm
index 752825bfc265c4f468b7ebf67ecaa251ae836cb5..63dc24c77931951269eb184e8cfd0154a9d4240d 100644 (file)
--- a/irrlicht/bindings/scene.scm
+++ b/irrlicht/bindings/scene.scm
@@ -19,9 +19,8 @@
 
 
 (define-module (irrlicht bindings scene)
-  #:use-module (system foreign))
-
-(define cirr (dynamic-link "libCIrrlicht"))
+  #:use-module (system foreign)
+  #:use-module (irrlicht util))
 
 ;;  irr_scene_EMD2_ANIMATION_TYPE enum
 (define-public EMAT_STAND                 0)
@@ -48,62 +47,32 @@
 (define-public EMAT_COUNT                21)
 
 ;; Scene functions
-(define-public add-animated-mesh-scene-node
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_scene_addAnimatedMeshSceneNode" cirr)
-   (list '* '* '* int '* '* '* int)))
+(define-foreign add-animated-mesh-scene-node
+  '* "irr_scene_addAnimatedMeshSceneNode" (list '* '* '* int '* '* '* int))
 
-(define-public add-camera-scene-node
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_scene_addCameraSceneNode" cirr)
-   (list '* '* '* '* int int)))
+(define-foreign add-camera-scene-node
+  '* "irr_scene_addCameraSceneNode" (list '* '* '* '* int int))
 
-(define-public add-camera-scene-node-fps
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_scene_addCameraSceneNodeFPS" cirr)
-   (list '* '* float float int '* int int float int int)))
+(define-foreign add-camera-scene-node-fps
+  '* "irr_scene_addCameraSceneNodeFPS" (list '* '* float float int '* int int float int int))
 
-(define-public add-octree-scene-node-am
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_scene_addOctreeSceneNodeAM" cirr)
-   (list '* '* '* int int int)))
+(define-foreign add-octree-scene-node-am
+  '* "irr_scene_addOctreeSceneNodeAM" (list '* '* '* int int int))
 
-(define-public draw-all
-  (pointer->procedure
-   void
-   (dynamic-func "irr_scene_drawAll" cirr)
-   (list '*)))
+(define-foreign draw-all
+  void "irr_scene_drawAll" (list '*))
 
-(define-public get-mesh
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_scene_getMesh" cirr)
-   (list '* '*)))
+(define-foreign get-mesh
+  '* "irr_scene_getMesh" (list '* '*))
 
-(define-public set-material-flag-am
-  (pointer->procedure
-   void
-   (dynamic-func "irr_scene_setMaterialFlagAM" cirr)
-   (list '* int int)))
+(define-foreign set-material-flag-am
+  void "irr_scene_setMaterialFlagAM" (list '* int int))
 
-(define-public set-material-texture-am
-  (pointer->procedure
-   void
-   (dynamic-func "irr_scene_setMaterialTextureAM" cirr)
-   (list '* int '*)))
+(define-foreign set-material-texture-am
+  void "irr_scene_setMaterialTextureAM" (list '* int '*))
 
-(define-public set-md2-animation
-  (pointer->procedure
-   void
-   (dynamic-func "irr_scene_setMD2Animation" cirr)
-   (list '* int)))
+(define-foreign set-md2-animation
+  void "irr_scene_setMD2Animation" (list '* int))
 
-(define-public set-position
-  (pointer->procedure
-   void
-   (dynamic-func "irr_scene_setPosition" cirr)
-   (list '* '*)))
+(define-foreign set-position
+  void "irr_scene_setPosition" (list '* '*))

diff --git a/irrlicht/bindings/video.scm b/irrlicht/bindings/video.scm
index 20445520e7b4b0162773235d975d611e92b566ee..994543d811836e6bf545457cf894f4398d77fc3f 100644 (file)
--- a/irrlicht/bindings/video.scm
+++ b/irrlicht/bindings/video.scm
@@ -19,9 +19,8 @@
 
 
 (define-module (irrlicht bindings video)
-  #:use-module (system foreign))
-
-(define cirr (dynamic-link "libCIrrlicht"))
+  #:use-module (system foreign)
+  #:use-module (irrlicht util))
 
 ;; E_DRIVER_TYPE enum
 (define-public EDT_NULL            0)
@@ -60,32 +59,17 @@
   (list uint32 uint32 uint32 uint32))
 
 ;; Driver functions
-(define-public begin-scene
-  (pointer->procedure
-   int
-   (dynamic-func "irr_video_beginScene" cirr)
-   (list '* int int '* '* '*)))
+(define-foreign begin-scene
+  int "irr_video_beginScene" (list '* int int '* '* '*))
 
-(define-public end-scene
-  (pointer->procedure
-   int
-   (dynamic-func "irr_video_endScene" cirr)
-   (list '*)))
+(define-foreign end-scene
+  int "irr_video_endScene" (list '*))
 
-(define-public get-fps
-  (pointer->procedure
-   int
-   (dynamic-func "irr_video_getFPS" cirr)
-   (list '*)))
+(define-foreign get-fps
+  int "irr_video_getFPS" (list '*))
 
-(define-public get-texture
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_video_getTexture" cirr)
-   (list '* '*)))
+(define-foreign get-texture
+  '* "irr_video_getTexture" (list '* '*))
 
-(define-public get-video-driver-name
-  (pointer->procedure
-   '*
-   (dynamic-func "irr_video_getName" cirr)
-   (list '*)))
+(define-foreign get-video-driver-name
+  '* "irr_video_getName" (list '*))

diff --git a/irrlicht/util.scm b/irrlicht/util.scm
index 8c5b9e4eb4651465c38ffda5b64d101a8623c4e6..afc3cb85b69d01d250c7ad41c2d530f51e3b941f 100644 (file)
--- a/irrlicht/util.scm
+++ b/irrlicht/util.scm
@@ -19,11 +19,25 @@
 
 
 (define-module (irrlicht util)
+  #:use-module (system foreign)
   #:export (bool->integer
-            integer->bool))
+            integer->bool
+            define-foreign))
 
 (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)))