X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fvideo.scm;h=1df01fe47a04d9bd251f77455fafaa90d808893c;hb=cc03ee884302dfeb94b5da68dd2b618c41333d5c;hp=e113815ad3501fa5ecc0b284affcee1976562248;hpb=eaa186435f0c641c53841d8d15581525bd542249;p=guile-irrlicht.git

diff --git a/irrlicht/video.scm b/irrlicht/video.scm
index e113815..1df01fe 100644
--- a/irrlicht/video.scm
+++ b/irrlicht/video.scm
@@ -22,11 +22,17 @@
   #: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))
+            get-video-driver-name
+            set-material!
+            make-s3dvertex
+            vertex-position
+            make-material))
 
 (define* (begin-scene driver
                       #:key
@@ -36,13 +42,13 @@
                       (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)
+                         (bool->integer back-buffer)
+                         (bool->integer z-buffer)
+                         (ffi-video:scolor->pointer color)
                          video-data
                          (if (null? source-rect)
                              %null-pointer
-                             (make-c-struct ffi-core:rect source-rect))))
+                             (ffi-core:rect->pointer source-rect))))
 
 (define (end-scene driver)
   (ffi-video:end-scene driver))
@@ -56,3 +62,59 @@
 (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)))
+
+;; 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))))