X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=blobdiff_plain;f=irrlicht%2Fvideo.scm;h=5659276c57bd432f90fc69c5926af973b0c28265;hp=0c334fe2d84344b7c101136ce55a7a3908448c5c;hb=09e9ed196aadab0f77e831c134fce8bdb58b772b;hpb=6260608f2ca73178ffd580af1c26ee0c424aa047 diff --git a/irrlicht/video.scm b/irrlicht/video.scm index 0c334fe..5659276 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,181 +19,51 @@ (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 scene) #:prefix ffi-scene:) - #:use-module ((irrlicht bindings video) #:prefix ffi-video:) - #:use-module (irrlicht util) - #:use-module (irrlicht util foreign) - #:export (begin-scene - draw-vertex-primitive-list - 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* (draw-vertex-primitive-list driver vertices index-list - #:key - (v-type 'standard) - (p-type 'triangles)) - (define (make-c-vertices vertices) - (let ((vals (map (lambda (vertex) - (parse-c-struct (ffi-video:s3dvertex->pointer vertex) - ffi-video:s3dvertex)) - vertices)) - (types (make-list (length vertices) ffi-video:s3dvertex))) - (make-c-struct types vals))) - - (define (make-c-indices indices) - (let* ((vals (apply append indices)) - (types (make-list (length vals) int32))) - (make-c-struct types vals))) - - (let ((vertices-pointer (make-c-vertices vertices)) - (vertex-count (length vertices)) - (indices-pointer (make-c-indices index-list)) - (prim-count (length index-list)) - (vertex-type - (match v-type - ('standard ffi-video:EVT_STANDARD) - ('2tcoords ffi-video:EVT_2TCOORDS) - ('tangents ffi-video:EVT_TANGENTS))) - (primitive-type - (match p-type - ('points ffi-scene:EPT_POINTS) - ('strip ffi-scene:EPT_LINE_STRIP) - ('line-loop ffi-scene:EPT_LINE_LOOP) - ('lines ffi-scene:EPT_LINES) - ('triangle-strip ffi-scene:EPT_TRIANGLE_STRIP) - ('triangle-fan ffi-scene:EPT_TRIANGLE_FAN) - ('triangles ffi-scene:EPT_TRIANGLES) - ('quad-strip ffi-scene:EPT_QUAD_STRIP) - ('quads ffi-scene:EPT_QUADS) - ('polygon ffi-scene:EPT_POLYGON) - ('point-sprites ffi-scene:EPT_POINT_SPRITES)))) - - - (ffi-video:draw-vertex-primitive-list - driver - vertices-pointer - vertex-count - indices-pointer - prim-count - vertex-type - primitive-type - ffi-video:EIT_32BIT))) - -(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)))) - (make-c-material)))) - -(define-public (make-c-material) - (ffi-video:make-c-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" #:getter irr-class)) + +(export ) + + +;; IVideoDriver +(define-class () + (irr-class #:init-value "IVideoDriver" #:getter irr-class)) + +(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 (end-scene (video-driver )) + ((get-irrlicht-proc "endScene" video-driver) + 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) + (make + #:irr-pointer + ((get-irrlicht-proc "getTexture" video-driver) + video-driver + filename))) + +(export begin-scene end-scene get-name get-texture)