From eaa186435f0c641c53841d8d15581525bd542249 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Sun, 10 Nov 2019 19:07:06 +0100 Subject: [PATCH] Split public functions --- irrlicht.scm | 340 +++----------------------------------------- irrlicht/device.scm | 85 +++++++++++ irrlicht/gui.scm | 52 +++++++ irrlicht/io.scm | 49 +++++++ irrlicht/scene.scm | 182 ++++++++++++++++++++++++ irrlicht/video.scm | 58 ++++++++ 6 files changed, 442 insertions(+), 324 deletions(-) create mode 100644 irrlicht/device.scm create mode 100644 irrlicht/gui.scm create mode 100644 irrlicht/io.scm create mode 100644 irrlicht/scene.scm create mode 100644 irrlicht/video.scm diff --git a/irrlicht.scm b/irrlicht.scm index 5f954ca..f3474c6 100644 --- a/irrlicht.scm +++ b/irrlicht.scm @@ -18,327 +18,19 @@ ;;; . -(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))) diff --git a/irrlicht/device.scm b/irrlicht/device.scm new file mode 100644 index 0000000..9a009ef --- /dev/null +++ b/irrlicht/device.scm @@ -0,0 +1,85 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2019 Javier Sancho +;;; +;;; 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 +;;; . + + +(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)) diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm new file mode 100644 index 0000000..641cf47 --- /dev/null +++ b/irrlicht/gui.scm @@ -0,0 +1,52 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2019 Javier Sancho +;;; +;;; 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 +;;; . + + +(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))) diff --git a/irrlicht/io.scm b/irrlicht/io.scm new file mode 100644 index 0000000..13288d5 --- /dev/null +++ b/irrlicht/io.scm @@ -0,0 +1,49 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2019 Javier Sancho +;;; +;;; 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 +;;; . + + +(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))) diff --git a/irrlicht/scene.scm b/irrlicht/scene.scm new file mode 100644 index 0000000..8c622ef --- /dev/null +++ b/irrlicht/scene.scm @@ -0,0 +1,182 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2019 Javier Sancho +;;; +;;; 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 +;;; . + + +(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))) diff --git a/irrlicht/video.scm b/irrlicht/video.scm new file mode 100644 index 0000000..e113815 --- /dev/null +++ b/irrlicht/video.scm @@ -0,0 +1,58 @@ +;;; guile-irrlicht --- FFI bindings for Irrlicht Engine +;;; Copyright (C) 2019 Javier Sancho +;;; +;;; 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 +;;; . + + +(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))) -- 2.39.2