X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=blobdiff_plain;f=irrlicht%2Fscene.scm;h=425d01ec026bd8c08fa666beb6d764518deab0f8;hp=8c622efec9c19512e6479a7f1651357bc2a3d5b0;hb=0c415f2f23b5351bdd8e3901ccc29073fe98d9f6;hpb=eaa186435f0c641c53841d8d15581525bd542249 diff --git a/irrlicht/scene.scm b/irrlicht/scene.scm index 8c622ef..425d01e 100644 --- a/irrlicht/scene.scm +++ b/irrlicht/scene.scm @@ -1,5 +1,5 @@ ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine -;;; Copyright (C) 2019 Javier Sancho +;;; Copyright (C) 2020 Javier Sancho ;;; ;;; This file is part of guile-irrlicht. ;;; @@ -19,164 +19,224 @@ (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 + #:use-module (oop goops) + #:use-module (ice-9 optargs) + #:use-module (irrlicht base) + #:use-module (irrlicht foreign) + #:use-module (irrlicht io) + #:use-module (irrlicht irr) + #:use-module (irrlicht video)) + + +;; IMesh +(define-class () + (irr-class #:init-value "IMesh")) + +(export ) + + +;; IAnimatedMesh +(define-class () + (irr-class #:init-value "IAnimatedMesh")) + +(export ) + + +;; ISceneNodeAnimator +(define-class ( ) + (irr-class #:init-value "ISceneNodeAnimator")) + +(export ) + + +;; ISceneManager +(define-class () + (irr-class #:init-value "ISceneManager")) + +(define-method (add-animated-mesh-scene-node! (scene-manager ) + (mesh ) + . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (position '(0 0 0)) + (rotation '(0 0 0)) + (scale '(1 1 1)) + (also-add-if-mesh-pointer-zero #f)) + (make + #:irr-pointer + ((get-irrlicht-proc "addAnimatedMeshSceneNode" scene-manager parent) + scene-manager + mesh + parent + id + position + rotation + scale + also-add-if-mesh-pointer-zero)))) + +(define-method (add-camera-scene-node! (scene-manager ) . rest) + (let-keywords rest #f + ((parent (make )) + (position '(0 0 0)) + (lookat '(0 0 100)) + (id -1) + (make-active #t)) + (make + #:irr-pointer + ((get-irrlicht-proc "addCameraSceneNode" scene-manager parent) + scene-manager + parent + position + lookat + id + make-active)))) + +(define-method (add-camera-scene-node-fps! (scene-manager ) . rest) + (let-keywords rest #f + ((parent (make )) + (rotate-speed 100) + (move-speed 0.5) + (id -1) + (key-map-array (make )) + (key-map-size 0) + (no-vertical-movement #f) + (jump-speed 0) + (invert-mouse #f) + (make-active #t)) + (let ((addCameraSceneNodeFPS (get-irrlicht-proc "addCameraSceneNodeFPS" + scene-manager parent))) + (make + #:irr-pointer + (addCameraSceneNodeFPS scene-manager #:parent parent #:rotate-speed rotate-speed + #:move-speed move-speed #:id id #:key-map-array key-map-array + #:key-map-size key-map-size + #:no-vertical-movement no-vertical-movement + #:jump-speed jump-speed #:invert-mouse invert-mouse + #:make-active make-active))))) + +(define-method (add-custom-scene-node! (scene-manager ) proc-render + proc-get-bounding-box proc-get-material-count + proc-get-material . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (position '(0 0 0)) + (rotation '(0 0 0)) + (scale '(1 1 1))) + (let ((addCustomSceneNode (get-irrlicht-proc "addCustomSceneNode" scene-manager parent))) + (make + #:irr-pointer + (addCustomSceneNode scene-manager proc-render proc-get-bounding-box proc-get-material-count + proc-get-material parent id position rotation scale))))) + +(define-method (add-octree-scene-node! (scene-manager ) + (mesh ) + . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (minimal-polys-per-node 512) + (also-add-if-mesh-pointer-zero #f)) + (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh))) + (make + #:irr-pointer + (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node + also-add-if-mesh-pointer-zero))))) + +(define-method (add-octree-scene-node! (scene-manager ) + (mesh ) + . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (minimal-polys-per-node 256) + (also-add-if-mesh-pointer-zero #f)) + (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh))) + (make + #:irr-pointer + (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node + also-add-if-mesh-pointer-zero))))) + +(define-method (create-rotation-animator (scene-manager ) rotation-speed) + (let ((createRotationAnimator (get-irrlicht-proc "createRotationAnimator" scene-manager))) + (make + #:irr-pointer + (createRotationAnimator scene-manager rotation-speed)))) + +(define-method (draw-all (scene-manager )) + ((get-irrlicht-proc "drawAll" scene-manager) + scene-manager)) + +(define-method (get-mesh (scene-manager ) filename) + (make + #:irr-pointer + ((get-irrlicht-proc "getMesh" scene-manager) + scene-manager + filename))) + +(define-method (get-root-scene-node (scene-manager )) + (let ((getRootSceneNode (get-irrlicht-proc "getRootSceneNode" scene-manager))) + (make #:irr-pointer (getRootSceneNode scene-manager)))) + +(export add-animated-mesh-scene-node! add-camera-scene-node! + add-camera-scene-node-fps! add-custom-scene-node! add-octree-scene-node! + create-rotation-animator draw-all get-root-scene-node get-mesh) + + +;; ISceneNode +(define-class () + (irr-class #:init-value "ISceneNode")) + +(define-method (add-animator! (node ) (animator )) + (let ((addAnimator (get-irrlicht-proc "addAnimator" node))) + (addAnimator node animator))) + +(define-method (get-absolute-transformation (node )) + (let ((getAbsoluteTransformation (get-irrlicht-proc "getAbsoluteTransformation" node))) + (getAbsoluteTransformation node))) + +(define-method (set-material-flag! (node ) flag new-value) + ((get-irrlicht-proc "setMaterialFlag" node) node - (make-c-struct ffi-core:vector3df newpos))) + flag + new-value)) + +(define-method (set-material-texture! (node ) texture-layer (texture )) + ((get-irrlicht-proc "setMaterialTexture" node) + node + texture-layer + texture)) + +(define-method (set-position! (node ) new-pos) + (let ((setPosition (get-irrlicht-proc "setPosition" node))) + (setPosition node new-pos))) + +(export add-animator! get-absolute-transformation set-material-flag! + set-material-texture! set-position!) + + +;; IAnimatedMeshSceneNode +(define-class () + (irr-class #:init-value "IAnimatedMeshSceneNode")) + +(define-method (set-md2-animation! (node ) anim) + ((get-irrlicht-proc "setMD2Animation" node) + node + anim)) + +(export set-md2-animation!) + + +;; ICameraSceneNode +(define-class () + (irr-class #:init-value "ICameraSceneNode")) + +(export ) + + +;; IMeshSceneNode +(define-class () + (irr-class #:init-value "IMeshSceneNode")) + +(export )