irrlicht/video.scm

   1 ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
   2 ;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
   3 ;;;
   4 ;;; This file is part of guile-irrlicht.
   5 ;;;
   6 ;;; Guile-irrlicht is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU Lesser General Public License as
   8 ;;; published by the Free Software Foundation; either version 3 of the
   9 ;;; License, or (at your option) any later version.
  10 ;;;
  11 ;;; Guile-irrlicht is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;; General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU Lesser General Public
  17 ;;; License along with guile-irrlicht.  If not, see
  18 ;;; <http://www.gnu.org/licenses/>.
  19
  20
  21 (define-module (irrlicht video)
  22   #:use-module (ice-9 match)
  23   #:use-module (system foreign)
  24   #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
  25   #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
  26   #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
  27   #:use-module (irrlicht util)
  28   #:use-module (irrlicht util foreign)
  29   #:export (begin-scene
  30             draw-vertex-primitive-list
  31             end-scene
  32             get-fps
  33             get-texture
  34             get-video-driver-name
  35             set-material!
  36             set-transform!
  37             make-s3dvertex
  38             vertex-position
  39             make-material))
  40
  41 (define* (begin-scene driver
  42                       #:key
  43                       (back-buffer #t)
  44                       (z-buffer #t)
  45                       (color '(255 0 0 0))
  46                       (video-data %null-pointer)
  47                       (source-rect '()))
  48   (ffi-video:begin-scene driver
  49                          (bool->integer back-buffer)
  50                          (bool->integer z-buffer)
  51                          (ffi-video:scolor->pointer color)
  52                          video-data
  53                          (if (null? source-rect)
  54                              %null-pointer
  55                              (ffi-core:rect->pointer source-rect))))
  56
  57 (define* (draw-vertex-primitive-list driver vertices index-list
  58                                      #:key
  59                                      (v-type 'standard)
  60                                      (p-type 'triangles))
  61   (define (make-c-vertices vertices)
  62     (let ((vals (map (lambda (vertex)
  63                        (parse-c-struct (ffi-video:s3dvertex->pointer vertex)
  64                                        ffi-video:s3dvertex))
  65                      vertices))
  66           (types (make-list (length vertices) ffi-video:s3dvertex)))
  67       (make-c-struct types vals)))
  68
  69   (define (make-c-indices indices)
  70     (let* ((vals (apply append indices))
  71            (types (make-list (length vals) int32)))
  72       (make-c-struct types vals)))
  73
  74   (let ((vertices-pointer (make-c-vertices vertices))
  75         (vertex-count (length vertices))
  76         (indices-pointer (make-c-indices index-list))
  77         (prim-count (length index-list))
  78         (vertex-type
  79          (match v-type
  80                 ('standard ffi-video:EVT_STANDARD)
  81                 ('2tcoords ffi-video:EVT_2TCOORDS)
  82                 ('tangents ffi-video:EVT_TANGENTS)))
  83         (primitive-type
  84          (match p-type
  85                 ('points ffi-scene:EPT_POINTS)
  86                 ('strip ffi-scene:EPT_LINE_STRIP)
  87                 ('line-loop ffi-scene:EPT_LINE_LOOP)
  88                 ('lines ffi-scene:EPT_LINES)
  89                 ('triangle-strip ffi-scene:EPT_TRIANGLE_STRIP)
  90                 ('triangle-fan ffi-scene:EPT_TRIANGLE_FAN)
  91                 ('triangles ffi-scene:EPT_TRIANGLES)
  92                 ('quad-strip ffi-scene:EPT_QUAD_STRIP)
  93                 ('quads ffi-scene:EPT_QUADS)
  94                 ('polygon ffi-scene:EPT_POLYGON)
  95                 ('point-sprites ffi-scene:EPT_POINT_SPRITES))))
  96
  97
  98     (ffi-video:draw-vertex-primitive-list
  99      driver
 100      vertices-pointer
 101      vertex-count
 102      indices-pointer
 103      prim-count
 104      vertex-type
 105      primitive-type
 106      ffi-video:EIT_32BIT)))
 107
 108 (define (end-scene driver)
 109   (ffi-video:end-scene driver))
 110
 111 (define (get-fps driver)
 112   (ffi-video:get-fps driver))
 113
 114 (define (get-texture driver filename)
 115   (ffi-video:get-texture driver (string->pointer filename)))
 116
 117 (define (get-video-driver-name driver)
 118   (pointer->string
 119    (ffi-video:get-video-driver-name driver)))
 120
 121 (define (set-material! driver material)
 122   (ffi-video:set-material
 123    driver
 124    (ffi-video:smaterial->pointer material)))
 125
 126 (define (set-transform! driver state mat)
 127   (let ((transform-state
 128          (match state
 129                 ('view ffi-video:ETS_VIEW)
 130                 ('world ffi-video:ETS_WORLD)
 131                 ('projection ffi-video:ETS_PROJECTION)
 132                 ('texture0 ffi-video:ETS_TEXTURE_0)
 133                 ('texture1 ffi-video:ETS_TEXTURE_1)
 134                 ('texture2 ffi-video:ETS_TEXTURE_2)
 135                 ('texture3 ffi-video:ETS_TEXTURE_3)
 136                 ('texture4 ffi-video:ETS_TEXTURE_4)
 137                 ('texture5 ffi-video:ETS_TEXTURE_5)
 138                 ('texture6 ffi-video:ETS_TEXTURE_6)
 139                 ('texture7 ffi-video:ETS_TEXTURE_7)
 140                 ('count ffi-video:ETS_COUNT))))
 141     (ffi-video:set-transform
 142      driver
 143      transform-state
 144      mat)))
 145
 146 ;; s3d vertices
 147 (define (make-s3dvertex position normal color t-coords)
 148   (ffi-video:pointer->s3dvertex
 149    (make-c-struct ffi-video:s3dvertex
 150                   (list position normal color t-coords))))
 151
 152 (define (vertex-position vertex)
 153   (let ((data (parse-c-struct (ffi-video:s3dvertex->pointer vertex)
 154                               ffi-video:s3dvertex)))
 155     (car data)))
 156
 157 ;; smaterial
 158 (define* (make-material #:key (wireframe #f) (lighting #t))
 159   (let ((material
 160          (list
 161           ;; textureLayer[4]
 162           (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer)
 163           (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer)
 164           (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer)
 165           (list %null-pointer 0 0 0 0 0 0 %null-pointer %null-pointer)
 166           ffi-video:EMT_SOLID         ; materialType
 167           (list 255 255 255 255)      ; ambientColor
 168           (list 255 255 255 255)      ; diffuseColor
 169           (list 0 0 0 0)              ; emissiveColor
 170           (list 255 255 255 255)      ; specularColor
 171           0                           ; shininess
 172           0                           ; materialTypeParam
 173           0                           ; materialTypeParam2
 174           1                           ; thickness
 175           ffi-video:ECFN_LESSEQUAL    ; zBuffer
 176           ffi-video:EAAM_SIMPLE       ; antiAliasing
 177           (list
 178            ffi-video:ECP_ALL          ; colorMask
 179            ffi-video:ECM_DIFFUSE      ; colorMaterial
 180            ffi-video:EBO_NONE         ; blendOperation
 181            0                          ; polygonOffsetFactor
 182            ffi-video:EPO_FRONT        ; polygonOffsetDirection
 183            (bool->integer wireframe)  ; wireframe
 184            (bool->integer #f)         ; pointCloud
 185            (bool->integer #t)         ; gouraudShading
 186            (bool->integer lighting)   ; lighting
 187            (bool->integer #t)         ; zWriteEnable
 188            (bool->integer #t)         ; backfaceCulling
 189            (bool->integer #f)         ; frontfaceCulling
 190            (bool->integer #f)         ; fogEnable
 191            (bool->integer #f)         ; normalizeNormals
 192            (bool->integer #t)         ; useMipMaps
 193            ))))
 194     (ffi-video:pointer->smaterial
 195      ;;  (make-c-struct+ ffi-video:smaterial material))))
 196      (make-c-material))))
 197
 198 (define-public (make-c-material)
 199   (ffi-video:make-c-material))