From: Javier Sancho Date: Mon, 11 Nov 2019 09:24:50 +0000 (+0100) Subject: define-foreign syntax X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=commitdiff_plain;h=4f9f0b90027aa3a254de58aea48a649727a05cda define-foreign syntax --- diff --git a/irrlicht/bindings.scm b/irrlicht/bindings.scm index 0039b2d..a7031a9 100644 --- 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 beb6459..ad2a8c8 100644 --- 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 5532ec1..3373a7b 100644 --- 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 752825b..63dc24c 100644 --- 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 2044552..994543d 100644 --- 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 8c5b9e4..afc3cb8 100644 --- 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)))