irrlicht.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)
  22   #:use-module (ice-9 match)
  23   #:use-module (system foreign)
  24   #:use-module ((irrlicht bindings) #:prefix ffi:)
  25   #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
  26   #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:)
  27   #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
  28   #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
  29   #:export (;; device
  30             create-device
  31             get-video-driver
  32             get-gui-environment
  33             get-scene-manager
  34             set-window-caption!
  35             device-run?
  36             device-drop!
  37             ;; driver
  38             begin-scene
  39             end-scene
  40             get-texture
  41             ;; gui
  42             add-static-text!
  43             gui-draw-all
  44             ;; scene
  45             add-animated-mesh-scene-node
  46             add-camera-scene-node
  47             get-mesh
  48             scene-draw-all
  49             set-material-flag-am!
  50             set-material-texture-am!
  51             set-md2-animation!))
  52
  53 ;; Device functions
  54 (define* (create-device #:optional
  55                         (device-type 'software)
  56                         (window-size '(640 480))
  57                         (bits 16)
  58                         (fullscreen #f)
  59                         (stencilbuffer #f)
  60                         (vsync #f))
  61   (let ((driver (match device-type
  62                        ('null ffi-video:EDT_NULL)
  63                        ('software ffi-video:EDT_SOFTWARE)
  64                        ('burnings ffi-video:EDT_BURNINGSVIDEO)
  65                        ('direct3d8 ffi-video:EDT_DIRECT3D8)
  66                        ('direct3d9 ffi-video:EDT_DIRECT3D9)
  67                        ('opengl ffi-video:EDT_OPENGL)
  68                        ('count ffi-video:EDT_COUNT)))
  69         (wsize (make-c-struct ffi-core:dimension2d window-size)))
  70     (let ((device (ffi:create-device driver wsize bits
  71                                      (if fullscreen 1 0)
  72                                      (if stencilbuffer 1 0)
  73                                      (if vsync 1 0))))
  74       (if (null-pointer? device) #f device))))
  75
  76 (define (get-video-driver device)
  77   (ffi:get-video-driver device))
  78
  79 (define (get-gui-environment device)
  80   (ffi:get-gui-environment device))
  81
  82 (define (get-scene-manager device)
  83   (ffi:get-scene-manager device))
  84
  85 (define (set-window-caption! device text)
  86   (ffi:set-window-caption device (string->pointer text)))
  87
  88 (define (device-run? device)
  89   (if (> (ffi:run device) 0) #t #f))
  90
  91 (define (device-drop! device)
  92   (if (> (ffi:drop device) 0) #t #f))
  93
  94
  95 ;; Driver functions
  96 (define* (begin-scene driver
  97                       #:optional
  98                       (back-buffer #t)
  99                       (z-buffer #t)
 100                       (color '(255 0 0 0))
 101                       (video-data %null-pointer)
 102                       (source-rect '()))
 103   (ffi-video:begin-scene driver
 104                          (if back-buffer 1 0)
 105                          (if z-buffer 1 0)
 106                          (make-c-struct ffi-video:scolor color)
 107                          video-data
 108                          (if (null? source-rect)
 109                              %null-pointer
 110                              (make-c-struct ffi-core:rect source-rect))))
 111
 112 (define (end-scene driver)
 113   (ffi-video:end-scene driver))
 114
 115 (define (get-texture driver filename)
 116   (ffi-video:get-texture driver (string->pointer filename)))
 117
 118
 119 ;; GUI functions
 120 (define* (add-static-text! gui-env text rectangle
 121                            #:optional
 122                            (border #f)
 123                            (word-wrap #t)
 124                            (parent %null-pointer)
 125                            (id -1)
 126                            (fill-background #f))
 127   (ffi-gui:add-static-text gui-env
 128                            (string->pointer text)
 129                            (make-c-struct ffi-core:rect rectangle)
 130                            (if border 1 0)
 131                            (if word-wrap 1 0)
 132                            parent
 133                            id
 134                            (if fill-background 1 0)))
 135
 136 (define (gui-draw-all gui-env)
 137   (ffi-gui:draw-all gui-env))
 138
 139
 140 ;; Scene functions
 141 (define* (add-animated-mesh-scene-node scene-manager mesh
 142                                        #:key
 143                                        (parent %null-pointer)
 144                                        (id -1)
 145                                        (position '(0 0 0))
 146                                        (rotation '(0 0 0))
 147                                        (scale '(1 1 1))
 148                                        (also-add-if-mesh-pointer-zero #f))
 149   (let ((node (ffi-scene:add-animated-mesh-scene-node
 150                scene-manager
 151                mesh
 152                parent
 153                id
 154                (make-c-struct ffi-core:vector3df position)
 155                (make-c-struct ffi-core:vector3df rotation)
 156                (make-c-struct ffi-core:vector3df scale)
 157                (if also-add-if-mesh-pointer-zero 1 0))))
 158     (if (null-pointer? node) #f node)))
 159
 160 (define* (add-camera-scene-node scene-manager
 161                                 #:key
 162                                 (parent %null-pointer)
 163                                 (position '(0 0 0))
 164                                 (lookat '(0 0 100))
 165                                 (id -1)
 166                                 (make-active #t))
 167   (let ((camera (ffi-scene:add-camera-scene-node
 168                  scene-manager
 169                  parent
 170                  (make-c-struct ffi-core:vector3df position)
 171                  (make-c-struct ffi-core:vector3df lookat)
 172                  id
 173                  (if make-active 1 0))))
 174     (if (null-pointer? camera) #f camera)))
 175
 176 (define (get-mesh scene-manager filename)
 177   (let ((mesh (ffi-scene:get-mesh scene-manager (string->pointer filename))))
 178     (if (null-pointer? mesh) #f mesh)))
 179
 180 (define (scene-draw-all scene-manager)
 181   (ffi-scene:draw-all scene-manager))
 182
 183 (define (set-material-flag-am! node flag newvalue)
 184   (let ((material-flag
 185          (match flag
 186                 ('wireframe ffi-video:EMF_WIREFRAME)
 187                 ('pointcloud ffi-video:EMF_POINTCLOUD)
 188                 ('gouraud-shading ffi-video:EMF_GOURAUD_SHADING)
 189                 ('lighting ffi-video:EMF_LIGHTING)
 190                 ('zbuffer ffi-video:EMF_ZBUFFER)
 191                 ('zwrite-enable ffi-video:EMF_ZWRITE_ENABLE)
 192                 ('back-face-culling ffi-video:EMF_BACK_FACE_CULLING)
 193                 ('front-face-culling ffi-video:EMF_FRONT_FACE_CULLING)
 194                 ('bilinear-filter ffi-video:EMF_BILINEAR_FILTER)
 195                 ('trilinear-filter ffi-video:EMF_TRILINEAR_FILTER)
 196                 ('anisotropic-filter ffi-video:EMF_ANISOTROPIC_FILTER)
 197                 ('fog-enable ffi-video:EMF_FOG_ENABLE)
 198                 ('normalize-normals ffi-video:EMF_NORMALIZE_NORMALS)
 199                 ('texture-wrap ffi-video:EMF_TEXTURE_WRAP)
 200                 ('anti-aliasing ffi-video:EMF_ANTI_ALIASING)
 201                 ('color-mask ffi-video:EMF_COLOR_MASK)
 202                 ('color-material ffi-video:EMF_COLOR_MATERIAL)
 203                 ('use-mip-maps ffi-video:EMF_USE_MIP_MAPS)
 204                 ('blend-operation ffi-video:EMF_BLEND_OPERATION)
 205                 ('polygon-offset ffi-video:EMF_POLYGON_OFFSET))))
 206     (ffi-scene:set-material-flag-am
 207      node
 208      material-flag
 209      (if newvalue 1 0))))
 210
 211 (define (set-material-texture-am! node texture-layer texture)
 212   (ffi-scene:set-material-texture-am node texture-layer texture))
 213
 214 (define (set-md2-animation! node anim)
 215   (let ((animation-type
 216          (match anim
 217                 ('stand ffi-scene:EMAT_STAND)
 218                 ('run ffi-scene:EMAT_RUN)
 219                 ('attack ffi-scene:EMAT_ATTACK)
 220                 ('pain-a ffi-scene:EMAT_PAIN_A)
 221                 ('pain-b ffi-scene:EMAT_PAIN_B)
 222                 ('pain-c ffi-scene:EMAT_PAIN_C)
 223                 ('jump ffi-scene:EMAT_JUMP)
 224                 ('flip ffi-scene:EMAT_FLIP)
 225                 ('salute ffi-scene:EMAT_SALUTE)
 226                 ('fallback ffi-scene:EMAT_FALLBACK)
 227                 ('wave ffi-scene:EMAT_WAVE)
 228                 ('point ffi-scene:EMAT_POINT)
 229                 ('crouch-stand ffi-scene:EMAT_CROUCH_STAND)
 230                 ('crouch-walk ffi-scene:EMAT_CROUCH_WALK)
 231                 ('crouch-attack ffi-scene:EMAT_CROUCH_ATTACK)
 232                 ('crouch-pain ffi-scene:EMAT_CROUCH_PAIN)
 233                 ('crouch-death ffi-scene:EMAT_CROUCH_DEATH)
 234                 ('death-fallback ffi-scene:EMAT_DEATH_FALLBACK)
 235                 ('death-fallforward ffi-scene:EMAT_DEATH_FALLFORWARD)
 236                 ('death-fallbackslow ffi-scene:EMAT_DEATH_FALLBACKSLOW)
 237                 ('boom ffi-scene:EMAT_BOOM)
 238                 ('count ffi-scene:EMAT_COUNT))))
 239     (ffi-scene:set-md2-animation
 240      node
 241      animation-type)))