]> git.jsancho.org Git - guile-irrlicht.git/blobdiff - irrlicht/video.scm
TOC with direct C++
[guile-irrlicht.git] / irrlicht / video.scm
index 7fc99fa87b363cc9c363c1a03a9d6e76eede70d3..0c334fe2d84344b7c101136ce55a7a3908448c5c 100644 (file)
 
 
 (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))
+            get-video-driver-name
+            set-material!
+            set-transform!
+            make-s3dvertex
+            vertex-position
+            make-material))
 
 (define* (begin-scene driver
                       #:key
   (ffi-video:begin-scene driver
                          (bool->integer back-buffer)
                          (bool->integer z-buffer)
-                         (make-c-struct ffi-video:scolor (reverse color))
+                         (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* (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-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))