;;; <http://www.gnu.org/licenses/>.
-(define-module (irrlicht)
- #:use-module (ice-9 match)
- #:use-module (system foreign)
- #:use-module ((irrlicht bindings) #:prefix ffi:)
- #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
- #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:)
- #:use-module ((irrlicht bindings io) #:prefix ffi-io:)
- #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
- #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
- #:export (;; device
- create-device
- get-cursor-control
- get-file-system
- get-video-driver
- get-gui-environment
- get-scene-manager
- is-window-active?
- set-window-caption!
- device-run?
- device-drop!
- ;; video driver
- begin-scene
- end-scene
- get-fps
- get-texture
- get-video-driver-name
- ;; gui
- add-static-text!
- gui-draw-all
- set-visible-cursor!
- ;; io
- add-file-archive!
- ;; scene
- add-animated-mesh-scene-node
- add-camera-scene-node
- add-camera-scene-node-fps!
- add-octree-scene-node-am
- get-mesh
- scene-draw-all
- set-material-flag-am!
- set-material-texture-am!
- set-md2-animation!
- set-position!))
-
-;; Device functions
-(define* (create-device #:key
- (device-type 'software)
- (window-size '(640 480))
- (bits 16)
- (fullscreen #f)
- (stencilbuffer #f)
- (vsync #f))
- (let ((driver (match device-type
- ('null ffi-video:EDT_NULL)
- ('software ffi-video:EDT_SOFTWARE)
- ('burnings ffi-video:EDT_BURNINGSVIDEO)
- ('direct3d8 ffi-video:EDT_DIRECT3D8)
- ('direct3d9 ffi-video:EDT_DIRECT3D9)
- ('opengl ffi-video:EDT_OPENGL)
- ('count ffi-video:EDT_COUNT)))
- (wsize (make-c-struct ffi-core:dimension2d window-size)))
- (let ((device (ffi:create-device driver wsize bits
- (if fullscreen 1 0)
- (if stencilbuffer 1 0)
- (if vsync 1 0))))
- (if (null-pointer? device) #f device))))
-
-(define (get-cursor-control device)
- (ffi:get-cursor-control device))
-
-(define (get-file-system device)
- (ffi:get-file-system device))
-
-(define (get-video-driver device)
- (ffi:get-video-driver device))
-
-(define (get-gui-environment device)
- (ffi:get-gui-environment device))
-
-(define (get-scene-manager device)
- (ffi:get-scene-manager device))
-
-(define (is-window-active? device)
- (if (> (ffi:is-window-active device) 0) #t #f))
-
-(define (set-window-caption! device text)
- (ffi:set-window-caption device (string->pointer text)))
-
-(define (device-run? device)
- (if (> (ffi:run device) 0) #t #f))
-
-(define (device-drop! device)
- (if (> (ffi:drop device) 0) #t #f))
-
-
-;; Video driver functions
-(define* (begin-scene driver
- #:key
- (back-buffer #t)
- (z-buffer #t)
- (color '(255 0 0 0))
- (video-data %null-pointer)
- (source-rect '()))
- (ffi-video:begin-scene driver
- (if back-buffer 1 0)
- (if z-buffer 1 0)
- (make-c-struct ffi-video:scolor color)
- video-data
- (if (null? source-rect)
- %null-pointer
- (make-c-struct ffi-core:rect source-rect))))
-
-(define (end-scene driver)
- (ffi-video:end-scene driver))
-
-(define (get-fps driver)
- (ffi-video:get-fps driver))
-
-(define (get-texture driver filename)
- (ffi-video:get-texture driver (string->pointer filename)))
-
-(define (get-video-driver-name driver)
- (pointer->string
- (ffi-video:get-video-driver-name driver)))
-
-
-;; GUI functions
-(define* (add-static-text! gui-env text rectangle
- #:key
- (border #f)
- (word-wrap #t)
- (parent %null-pointer)
- (id -1)
- (fill-background #f))
- (ffi-gui:add-static-text gui-env
- (string->pointer text)
- (make-c-struct ffi-core:rect rectangle)
- (if border 1 0)
- (if word-wrap 1 0)
- parent
- id
- (if fill-background 1 0)))
-
-(define (gui-draw-all gui-env)
- (ffi-gui:draw-all gui-env))
-
-(define (set-visible-cursor! cursor-control visible)
- (ffi-gui:set-visible-cursor
- cursor-control
- (if visible 1 0)))
-
-
-;; IO functions
-(define* (add-file-archive! file-system filename
- #:key
- (ignore-case #t)
- (ignore-paths #t)
- (archive-type 'unknown)
- (password "")
- (ret-archive %null-pointer))
- (let ((type (match archive-type
- ('zip ffi-io:EFAT_ZIP)
- ('gzip ffi-io:EFAT_GZIP)
- ('folder ffi-io:EFAT_FOLDER)
- ('pak ffi-io:EFAT_PAK)
- ('npk ffi-io:EFAT_NPK)
- ('tar ffi-io:EFAT_TAR)
- ('wad ffi-io:EFAT_WAD)
- ('unknown ffi-io:EFAT_UNKNOWN))))
- (ffi-io:add-file-archive file-system
- (string->pointer filename)
- (if ignore-case 1 0)
- (if ignore-paths 1 0)
- type
- (string->pointer password)
- ret-archive)))
-
-
-;; Scene functions
-(define* (add-animated-mesh-scene-node scene-manager mesh
- #:key
- (parent %null-pointer)
- (id -1)
- (position '(0 0 0))
- (rotation '(0 0 0))
- (scale '(1 1 1))
- (also-add-if-mesh-pointer-zero #f))
- (let ((node (ffi-scene:add-animated-mesh-scene-node
- scene-manager
- mesh
- parent
- id
- (make-c-struct ffi-core:vector3df position)
- (make-c-struct ffi-core:vector3df rotation)
- (make-c-struct ffi-core:vector3df scale)
- (if also-add-if-mesh-pointer-zero 1 0))))
- (if (null-pointer? node) #f node)))
-
-(define* (add-camera-scene-node scene-manager
- #:key
- (parent %null-pointer)
- (position '(0 0 0))
- (lookat '(0 0 100))
- (id -1)
- (make-active #t))
- (let ((camera (ffi-scene:add-camera-scene-node
- scene-manager
- parent
- (make-c-struct ffi-core:vector3df position)
- (make-c-struct ffi-core:vector3df lookat)
- id
- (if make-active 1 0))))
- (if (null-pointer? camera) #f camera)))
-
-(define* (add-camera-scene-node-fps! scene-manager
- #:key
- (parent %null-pointer)
- (rotate-speed 100.0)
- (move-speed 0.5)
- (id -1)
- (key-map-array %null-pointer)
- (key-map-size 0)
- (no-vertical-movement #f)
- (jump-speed 0.0)
- (invert-mouse #f)
- (make-active #t))
- (ffi-scene:add-camera-scene-node-fps
- scene-manager
- parent
- rotate-speed
- move-speed
- id
- key-map-array
- key-map-size
- (if no-vertical-movement 1 0)
- jump-speed
- (if invert-mouse 1 0)
- (if make-active 1 0)))
-
-(define* (add-octree-scene-node-am scene-manager mesh
- #:key
- (parent %null-pointer)
- (id -1)
- (minimal-polys-per-node 512)
- (also-add-if-mesh-pointer-zero #f))
- (ffi-scene:add-octree-scene-node-am
- scene-manager
- mesh
- parent
- id
- minimal-polys-per-node
- (if also-add-if-mesh-pointer-zero 1 0)))
-
-(define (get-mesh scene-manager filename)
- (let ((mesh (ffi-scene:get-mesh scene-manager (string->pointer filename))))
- (if (null-pointer? mesh) #f mesh)))
-
-(define (scene-draw-all scene-manager)
- (ffi-scene:draw-all scene-manager))
-
-(define (set-material-flag-am! node flag newvalue)
- (let ((material-flag
- (match flag
- ('wireframe ffi-video:EMF_WIREFRAME)
- ('pointcloud ffi-video:EMF_POINTCLOUD)
- ('gouraud-shading ffi-video:EMF_GOURAUD_SHADING)
- ('lighting ffi-video:EMF_LIGHTING)
- ('zbuffer ffi-video:EMF_ZBUFFER)
- ('zwrite-enable ffi-video:EMF_ZWRITE_ENABLE)
- ('back-face-culling ffi-video:EMF_BACK_FACE_CULLING)
- ('front-face-culling ffi-video:EMF_FRONT_FACE_CULLING)
- ('bilinear-filter ffi-video:EMF_BILINEAR_FILTER)
- ('trilinear-filter ffi-video:EMF_TRILINEAR_FILTER)
- ('anisotropic-filter ffi-video:EMF_ANISOTROPIC_FILTER)
- ('fog-enable ffi-video:EMF_FOG_ENABLE)
- ('normalize-normals ffi-video:EMF_NORMALIZE_NORMALS)
- ('texture-wrap ffi-video:EMF_TEXTURE_WRAP)
- ('anti-aliasing ffi-video:EMF_ANTI_ALIASING)
- ('color-mask ffi-video:EMF_COLOR_MASK)
- ('color-material ffi-video:EMF_COLOR_MATERIAL)
- ('use-mip-maps ffi-video:EMF_USE_MIP_MAPS)
- ('blend-operation ffi-video:EMF_BLEND_OPERATION)
- ('polygon-offset ffi-video:EMF_POLYGON_OFFSET))))
- (ffi-scene:set-material-flag-am
- node
- material-flag
- (if newvalue 1 0))))
-
-(define (set-material-texture-am! node texture-layer texture)
- (ffi-scene:set-material-texture-am node texture-layer texture))
-
-(define (set-md2-animation! node anim)
- (let ((animation-type
- (match anim
- ('stand ffi-scene:EMAT_STAND)
- ('run ffi-scene:EMAT_RUN)
- ('attack ffi-scene:EMAT_ATTACK)
- ('pain-a ffi-scene:EMAT_PAIN_A)
- ('pain-b ffi-scene:EMAT_PAIN_B)
- ('pain-c ffi-scene:EMAT_PAIN_C)
- ('jump ffi-scene:EMAT_JUMP)
- ('flip ffi-scene:EMAT_FLIP)
- ('salute ffi-scene:EMAT_SALUTE)
- ('fallback ffi-scene:EMAT_FALLBACK)
- ('wave ffi-scene:EMAT_WAVE)
- ('point ffi-scene:EMAT_POINT)
- ('crouch-stand ffi-scene:EMAT_CROUCH_STAND)
- ('crouch-walk ffi-scene:EMAT_CROUCH_WALK)
- ('crouch-attack ffi-scene:EMAT_CROUCH_ATTACK)
- ('crouch-pain ffi-scene:EMAT_CROUCH_PAIN)
- ('crouch-death ffi-scene:EMAT_CROUCH_DEATH)
- ('death-fallback ffi-scene:EMAT_DEATH_FALLBACK)
- ('death-fallforward ffi-scene:EMAT_DEATH_FALLFORWARD)
- ('death-fallbackslow ffi-scene:EMAT_DEATH_FALLBACKSLOW)
- ('boom ffi-scene:EMAT_BOOM)
- ('count ffi-scene:EMAT_COUNT))))
- (ffi-scene:set-md2-animation
- node
- animation-type)))
-
-(define (set-position! node newpos)
- (ffi-scene:set-position
- node
- (make-c-struct ffi-core:vector3df newpos)))
+(define-module (irrlicht))
+
+(eval-when (eval load compile)
+ ;; load public symbols into current module
+ (let ((public-modules
+ '((irrlicht device)
+ (irrlicht gui)
+ (irrlicht io)
+ (irrlicht scene)
+ (irrlicht video)))
+ (current-interface
+ (module-public-interface (current-module))))
+ (for-each
+ (lambda (m)
+ (module-use! current-interface (resolve-interface m)))
+ public-modules)))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht device)
+ #:use-module (ice-9 match)
+ #:use-module (system foreign)
+ #:use-module ((irrlicht bindings) #:prefix ffi:)
+ #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
+ #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
+ #:export (create-device
+ get-cursor-control
+ get-file-system
+ get-video-driver
+ get-gui-environment
+ get-scene-manager
+ is-window-active?
+ set-window-caption!
+ device-run?
+ device-drop!))
+
+(define* (create-device #:key
+ (device-type 'software)
+ (window-size '(640 480))
+ (bits 16)
+ (fullscreen #f)
+ (stencilbuffer #f)
+ (vsync #f))
+ (let ((driver (match device-type
+ ('null ffi-video:EDT_NULL)
+ ('software ffi-video:EDT_SOFTWARE)
+ ('burnings ffi-video:EDT_BURNINGSVIDEO)
+ ('direct3d8 ffi-video:EDT_DIRECT3D8)
+ ('direct3d9 ffi-video:EDT_DIRECT3D9)
+ ('opengl ffi-video:EDT_OPENGL)
+ ('count ffi-video:EDT_COUNT)))
+ (wsize (make-c-struct ffi-core:dimension2d window-size)))
+ (let ((device (ffi:create-device driver wsize bits
+ (if fullscreen 1 0)
+ (if stencilbuffer 1 0)
+ (if vsync 1 0))))
+ (if (null-pointer? device) #f device))))
+
+(define (get-cursor-control device)
+ (ffi:get-cursor-control device))
+
+(define (get-file-system device)
+ (ffi:get-file-system device))
+
+(define (get-video-driver device)
+ (ffi:get-video-driver device))
+
+(define (get-gui-environment device)
+ (ffi:get-gui-environment device))
+
+(define (get-scene-manager device)
+ (ffi:get-scene-manager device))
+
+(define (is-window-active? device)
+ (if (> (ffi:is-window-active device) 0) #t #f))
+
+(define (set-window-caption! device text)
+ (ffi:set-window-caption device (string->pointer text)))
+
+(define (device-run? device)
+ (if (> (ffi:run device) 0) #t #f))
+
+(define (device-drop! device)
+ (if (> (ffi:drop device) 0) #t #f))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht gui)
+ #:use-module (ice-9 match)
+ #:use-module (system foreign)
+ #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
+ #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:)
+ #:export (add-static-text!
+ gui-draw-all
+ set-visible-cursor!))
+
+(define* (add-static-text! gui-env text rectangle
+ #:key
+ (border #f)
+ (word-wrap #t)
+ (parent %null-pointer)
+ (id -1)
+ (fill-background #f))
+ (ffi-gui:add-static-text gui-env
+ (string->pointer text)
+ (make-c-struct ffi-core:rect rectangle)
+ (if border 1 0)
+ (if word-wrap 1 0)
+ parent
+ id
+ (if fill-background 1 0)))
+
+(define (gui-draw-all gui-env)
+ (ffi-gui:draw-all gui-env))
+
+(define (set-visible-cursor! cursor-control visible)
+ (ffi-gui:set-visible-cursor
+ cursor-control
+ (if visible 1 0)))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht io)
+ #:use-module (ice-9 match)
+ #:use-module (system foreign)
+ #:use-module ((irrlicht bindings io) #:prefix ffi-io:)
+ #:export (add-file-archive!))
+
+(define* (add-file-archive! file-system filename
+ #:key
+ (ignore-case #t)
+ (ignore-paths #t)
+ (archive-type 'unknown)
+ (password "")
+ (ret-archive %null-pointer))
+ (let ((type (match archive-type
+ ('zip ffi-io:EFAT_ZIP)
+ ('gzip ffi-io:EFAT_GZIP)
+ ('folder ffi-io:EFAT_FOLDER)
+ ('pak ffi-io:EFAT_PAK)
+ ('npk ffi-io:EFAT_NPK)
+ ('tar ffi-io:EFAT_TAR)
+ ('wad ffi-io:EFAT_WAD)
+ ('unknown ffi-io:EFAT_UNKNOWN))))
+ (ffi-io:add-file-archive file-system
+ (string->pointer filename)
+ (if ignore-case 1 0)
+ (if ignore-paths 1 0)
+ type
+ (string->pointer password)
+ ret-archive)))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht scene)
+ #:use-module (ice-9 match)
+ #:use-module (system foreign)
+ #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
+ #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
+ #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
+ #:export (add-animated-mesh-scene-node
+ add-camera-scene-node
+ add-camera-scene-node-fps!
+ add-octree-scene-node-am
+ get-mesh
+ scene-draw-all
+ set-material-flag-am!
+ set-material-texture-am!
+ set-md2-animation!
+ set-position!))
+
+(define* (add-animated-mesh-scene-node scene-manager mesh
+ #:key
+ (parent %null-pointer)
+ (id -1)
+ (position '(0 0 0))
+ (rotation '(0 0 0))
+ (scale '(1 1 1))
+ (also-add-if-mesh-pointer-zero #f))
+ (let ((node (ffi-scene:add-animated-mesh-scene-node
+ scene-manager
+ mesh
+ parent
+ id
+ (make-c-struct ffi-core:vector3df position)
+ (make-c-struct ffi-core:vector3df rotation)
+ (make-c-struct ffi-core:vector3df scale)
+ (if also-add-if-mesh-pointer-zero 1 0))))
+ (if (null-pointer? node) #f node)))
+
+(define* (add-camera-scene-node scene-manager
+ #:key
+ (parent %null-pointer)
+ (position '(0 0 0))
+ (lookat '(0 0 100))
+ (id -1)
+ (make-active #t))
+ (let ((camera (ffi-scene:add-camera-scene-node
+ scene-manager
+ parent
+ (make-c-struct ffi-core:vector3df position)
+ (make-c-struct ffi-core:vector3df lookat)
+ id
+ (if make-active 1 0))))
+ (if (null-pointer? camera) #f camera)))
+
+(define* (add-camera-scene-node-fps! scene-manager
+ #:key
+ (parent %null-pointer)
+ (rotate-speed 100.0)
+ (move-speed 0.5)
+ (id -1)
+ (key-map-array %null-pointer)
+ (key-map-size 0)
+ (no-vertical-movement #f)
+ (jump-speed 0.0)
+ (invert-mouse #f)
+ (make-active #t))
+ (ffi-scene:add-camera-scene-node-fps
+ scene-manager
+ parent
+ rotate-speed
+ move-speed
+ id
+ key-map-array
+ key-map-size
+ (if no-vertical-movement 1 0)
+ jump-speed
+ (if invert-mouse 1 0)
+ (if make-active 1 0)))
+
+(define* (add-octree-scene-node-am scene-manager mesh
+ #:key
+ (parent %null-pointer)
+ (id -1)
+ (minimal-polys-per-node 512)
+ (also-add-if-mesh-pointer-zero #f))
+ (ffi-scene:add-octree-scene-node-am
+ scene-manager
+ mesh
+ parent
+ id
+ minimal-polys-per-node
+ (if also-add-if-mesh-pointer-zero 1 0)))
+
+(define (get-mesh scene-manager filename)
+ (let ((mesh (ffi-scene:get-mesh scene-manager (string->pointer filename))))
+ (if (null-pointer? mesh) #f mesh)))
+
+(define (scene-draw-all scene-manager)
+ (ffi-scene:draw-all scene-manager))
+
+(define (set-material-flag-am! node flag newvalue)
+ (let ((material-flag
+ (match flag
+ ('wireframe ffi-video:EMF_WIREFRAME)
+ ('pointcloud ffi-video:EMF_POINTCLOUD)
+ ('gouraud-shading ffi-video:EMF_GOURAUD_SHADING)
+ ('lighting ffi-video:EMF_LIGHTING)
+ ('zbuffer ffi-video:EMF_ZBUFFER)
+ ('zwrite-enable ffi-video:EMF_ZWRITE_ENABLE)
+ ('back-face-culling ffi-video:EMF_BACK_FACE_CULLING)
+ ('front-face-culling ffi-video:EMF_FRONT_FACE_CULLING)
+ ('bilinear-filter ffi-video:EMF_BILINEAR_FILTER)
+ ('trilinear-filter ffi-video:EMF_TRILINEAR_FILTER)
+ ('anisotropic-filter ffi-video:EMF_ANISOTROPIC_FILTER)
+ ('fog-enable ffi-video:EMF_FOG_ENABLE)
+ ('normalize-normals ffi-video:EMF_NORMALIZE_NORMALS)
+ ('texture-wrap ffi-video:EMF_TEXTURE_WRAP)
+ ('anti-aliasing ffi-video:EMF_ANTI_ALIASING)
+ ('color-mask ffi-video:EMF_COLOR_MASK)
+ ('color-material ffi-video:EMF_COLOR_MATERIAL)
+ ('use-mip-maps ffi-video:EMF_USE_MIP_MAPS)
+ ('blend-operation ffi-video:EMF_BLEND_OPERATION)
+ ('polygon-offset ffi-video:EMF_POLYGON_OFFSET))))
+ (ffi-scene:set-material-flag-am
+ node
+ material-flag
+ (if newvalue 1 0))))
+
+(define (set-material-texture-am! node texture-layer texture)
+ (ffi-scene:set-material-texture-am node texture-layer texture))
+
+(define (set-md2-animation! node anim)
+ (let ((animation-type
+ (match anim
+ ('stand ffi-scene:EMAT_STAND)
+ ('run ffi-scene:EMAT_RUN)
+ ('attack ffi-scene:EMAT_ATTACK)
+ ('pain-a ffi-scene:EMAT_PAIN_A)
+ ('pain-b ffi-scene:EMAT_PAIN_B)
+ ('pain-c ffi-scene:EMAT_PAIN_C)
+ ('jump ffi-scene:EMAT_JUMP)
+ ('flip ffi-scene:EMAT_FLIP)
+ ('salute ffi-scene:EMAT_SALUTE)
+ ('fallback ffi-scene:EMAT_FALLBACK)
+ ('wave ffi-scene:EMAT_WAVE)
+ ('point ffi-scene:EMAT_POINT)
+ ('crouch-stand ffi-scene:EMAT_CROUCH_STAND)
+ ('crouch-walk ffi-scene:EMAT_CROUCH_WALK)
+ ('crouch-attack ffi-scene:EMAT_CROUCH_ATTACK)
+ ('crouch-pain ffi-scene:EMAT_CROUCH_PAIN)
+ ('crouch-death ffi-scene:EMAT_CROUCH_DEATH)
+ ('death-fallback ffi-scene:EMAT_DEATH_FALLBACK)
+ ('death-fallforward ffi-scene:EMAT_DEATH_FALLFORWARD)
+ ('death-fallbackslow ffi-scene:EMAT_DEATH_FALLBACKSLOW)
+ ('boom ffi-scene:EMAT_BOOM)
+ ('count ffi-scene:EMAT_COUNT))))
+ (ffi-scene:set-md2-animation
+ node
+ animation-type)))
+
+(define (set-position! node newpos)
+ (ffi-scene:set-position
+ node
+ (make-c-struct ffi-core:vector3df newpos)))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht video)
+ #:use-module (system foreign)
+ #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
+ #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
+ #:export (begin-scene
+ end-scene
+ get-fps
+ get-texture
+ get-video-driver-name))
+
+(define* (begin-scene driver
+ #:key
+ (back-buffer #t)
+ (z-buffer #t)
+ (color '(255 0 0 0))
+ (video-data %null-pointer)
+ (source-rect '()))
+ (ffi-video:begin-scene driver
+ (if back-buffer 1 0)
+ (if z-buffer 1 0)
+ (make-c-struct ffi-video:scolor color)
+ video-data
+ (if (null? source-rect)
+ %null-pointer
+ (make-c-struct ffi-core:rect source-rect))))
+
+(define (end-scene driver)
+ (ffi-video:end-scene driver))
+
+(define (get-fps driver)
+ (ffi-video:get-fps driver))
+
+(define (get-texture driver filename)
+ (ffi-video:get-texture driver (string->pointer filename)))
+
+(define (get-video-driver-name driver)
+ (pointer->string
+ (ffi-video:get-video-driver-name driver)))
projects / guile-irrlicht.git / commitdiff