X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fvideo.scm;h=f4feff4f4b552f6ac5d0b1f2affcb4b4b14169fa;hb=3bb58c2b45af12c0f9c9eac648e67ac6fa90e104;hp=dc61f644279cb1e90e18e4c45fc2a42065d697b2;hpb=86e2a7367842fd005dda3b20454f370d4ebfcf2c;p=guile-irrlicht.git diff --git a/irrlicht/video.scm b/irrlicht/video.scm index dc61f64..f4feff4 100644 --- a/irrlicht/video.scm +++ b/irrlicht/video.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,124 +19,134 @@ (define-module (irrlicht video) - #:use-module (ice-9 match) - #:use-module (system foreign) - #:use-module ((irrlicht bindings core) #:prefix ffi-core:) - #:use-module ((irrlicht bindings video) #:prefix ffi-video:) - #:use-module (irrlicht util) - #:use-module (irrlicht util foreign) - #:export (begin-scene - end-scene - get-fps - get-texture - get-video-driver-name - set-material! - set-transform! - make-s3dvertex - vertex-position - make-material)) - -(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 - (bool->integer back-buffer) - (bool->integer z-buffer) - (ffi-video:scolor->pointer color) - video-data - (if (null? source-rect) - %null-pointer - (ffi-core:rect->pointer 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))) - -(define (set-material! driver material) - (ffi-video:set-material - driver - (ffi-video:smaterial->pointer material))) - -(define (set-transform! driver state mat) - (let ((transform-state - (match state - ('view ffi-video:ETS_VIEW) - ('world ffi-video:ETS_WORLD) - ('projection ffi-video:ETS_PROJECTION) - ('texture0 ffi-video:ETS_TEXTURE_0) - ('texture1 ffi-video:ETS_TEXTURE_1) - ('texture2 ffi-video:ETS_TEXTURE_2) - ('texture3 ffi-video:ETS_TEXTURE_3) - ('texture4 ffi-video:ETS_TEXTURE_4) - ('texture5 ffi-video:ETS_TEXTURE_5) - ('texture6 ffi-video:ETS_TEXTURE_6) - ('texture7 ffi-video:ETS_TEXTURE_7) - ('count ffi-video:ETS_COUNT)))) - (ffi-video:set-transform - driver - transform-state - mat))) - -;; s3d vertices -(define (make-s3dvertex position normal color t-coords) - (ffi-video:pointer->s3dvertex - (make-c-struct ffi-video:s3dvertex - (list position normal color t-coords)))) - -(define (vertex-position vertex) - (let ((data (parse-c-struct (ffi-video:s3dvertex->pointer vertex) - ffi-video:s3dvertex))) - (car data))) - -;; smaterial -(define* (make-material #:key (wireframe #f) (lighting #t)) - (let ((material - (list - ;; textureLayer[4] - (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer) - (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer) - (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer) - (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer) - ffi-video:EMT_SOLID ; materialType - (list 255 255 255 255) ; ambientColor - (list 255 255 255 255) ; diffuseColor - (list 0 0 0 0) ; emissiveColor - (list 255 255 255 255) ; specularColor - 0 ; shininess - 0 ; materialTypeParam - 0 ; materialTypeParam2 - 1 ; thickness - ffi-video:ECFN_LESSEQUAL ; zBuffer - ffi-video:EAAM_SIMPLE ; antiAliasing - (list - ffi-video:ECP_ALL ; colorMask - ffi-video:ECM_DIFFUSE ; colorMaterial - ffi-video:EBO_NONE ; blendOperation - 0 ; polygonOffsetFactor - ffi-video:EPO_FRONT ; polygonOffsetDirection - (bool->integer wireframe) ; wireframe - (bool->integer #f) ; pointCloud - (bool->integer #t) ; gouraudShading - (bool->integer lighting) ; lighting - (bool->integer #t) ; zWriteEnable - (bool->integer #t) ; backfaceCulling - (bool->integer #f) ; frontfaceCulling - (bool->integer #f) ; fogEnable - (bool->integer #f) ; normalizeNormals - (bool->integer #t) ; useMipMaps - )))) - (ffi-video:pointer->smaterial - (make-c-struct+ ffi-video:smaterial material)))) + #:use-module (oop goops) + #:use-module (ice-9 optargs) + #:use-module (irrlicht base) + #:use-module (irrlicht foreign)) + + +;; ITexture +(define-class () + (irr-class #:init-value "ITexture")) + +(export ) + + +;; SMaterial +(define-class () + (irr-class #:init-value "SMaterial")) + +(define* (make-material #:key + (material-type 'solid) + (ambient-color '(255 255 255 255)) + (diffuse-color '(255 255 255 255)) + (emissive-color '(0 0 0 0)) + (specular-color '(255 255 255 255)) + (shininess 0) + (material-type-param 0) + (material-type-param-2 0) + (thickness 1) + (z-buffer 'less-equal) + (anti-aliasing 'simple) + (color-mask 'all) + (color-material 'diffuse) + (blend-operation 'none) + (polygon-offset-factor 0) + (polygon-offset-direction 'front) + (wireframe #f) + (point-cloud #f) + (gouraud-shading #t) + (lighting #t) + (z-write-enable #t) + (backface-culling #t) + (frontface-culling #f) + (fog-enable #f) + (normalize-normals #f) + (use-mip-maps #t)) + (let ((SMaterial_make (get-irrlicht-proc "SMaterial_make"))) + (SMaterial_make #:material-type material-type #:ambient-color ambient-color + #:diffuse-color diffuse-color #:emissive-color emissive-color + #:specular-color specular-color #:shininess shininess + #:material-type-param material-type-param + #:material-type-param-2 material-type-param-2 + #:thickness thickness #:z-buffer z-buffer #:anti-aliasing anti-aliasing + #:color-mask color-mask #:color-material color-material + #:blend-operation blend-operation + #:polygon-offset-factor polygon-offset-factor + #:polygon-offset-direction polygon-offset-direction + #:wireframe wireframe #:point-cloud point-cloud + #:gouraud-shading gouraud-shading #:lighting lighting + #:z-write-enable z-write-enable #:backface-culling backface-culling + #:frontface-culling frontface-culling #:fog-enable fog-enable + #:normalize-normals normalize-normals #:use-mip-maps use-mip-maps))) + +(export make-material) + + +;; IVideoDriver +(define-class () + (irr-class #:init-value "IVideoDriver")) + +(define-method (begin-scene (video-driver ) . rest) + (let-keywords rest #f + ((back-buffer #t) + (z-buffer #t) + (color '(255 0 0 0)) + video-data + source-rect) + ((get-irrlicht-proc "beginScene" video-driver) + video-driver + back-buffer + z-buffer + color + video-data + source-rect))) + +(define-method (draw-vertex-primitive-list (video-driver ) vertices indices . rest) + (let-keywords rest #f + ((v-type 'standard) + (p-type 'triangles)) + (let ((drawVertexPrimitiveList (get-irrlicht-proc "drawVertexPrimitiveList" video-driver))) + (drawVertexPrimitiveList video-driver vertices indices v-type p-type)))) + +(define-method (end-scene (video-driver )) + ((get-irrlicht-proc "endScene" video-driver) + video-driver)) + +(define-method (get-fps (video-driver )) + (let ((getFPS (get-irrlicht-proc "getFPS" video-driver))) + (getFPS video-driver))) + +(define-method (get-name (video-driver )) + (let ((getName (get-irrlicht-proc "getName" video-driver))) + (getName video-driver))) + +(define-method (get-texture (video-driver ) filename) + (let ((getTexture (get-irrlicht-proc "getTexture" video-driver))) + (getTexture video-driver filename))) + +(define-method (set-material! (video-driver ) (material )) + (let ((setMaterial (get-irrlicht-proc "setMaterial" video-driver))) + (setMaterial video-driver material))) + +(define-method (set-transform! (video-driver ) state mat) + (let ((setTransform (get-irrlicht-proc "setTransform" video-driver))) + (setTransform video-driver state mat))) + +(export begin-scene draw-vertex-primitive-list end-scene get-fps get-name get-texture + set-material! set-transform!) + + +;; S3DVertex +(define-class () + (irr-class #:init-value "S3DVertex")) + +(define-method (get-position (vertex3d )) + (let ((S3DVertex_Pos (get-irrlicht-proc "S3DVertex_Pos"))) + (S3DVertex_Pos vertex3d))) + +(define (make-vertex3d position normal color tcoords) + (let ((S3DVertex_make (get-irrlicht-proc "S3DVertex_make"))) + (S3DVertex_make position normal color tcoords))) + +(export get-position make-vertex3d)