examples/04-movement.scm

   1 ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
   2 ;;; Copyright (C) 2020 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 ;;; Irrlicht 04.Movement example
  22 ;;; http://irrlicht.sourceforge.net/docu/example004.html
  23
  24
  25 (use-modules (irrlicht)
  26              (ice-9 match))
  27
  28 ;; ask user for driver
  29 (format #t
  30         "Please select the driver you want for this example:
  31  (a) OpenGL 1.5
  32  (b) Direct3D 9.0c
  33  (c) Direct3D 8.1
  34  (d) Burning's Software Renderer
  35  (e) Software Renderer
  36  (f) NullDevice
  37  (otherKey) exit~%~%")
  38
  39 (define device-type (match (read-char)
  40                            (#\a 'opengl)
  41                            (#\b 'direct3d9)
  42                            (#\c 'direct3d8)
  43                            (#\d 'burnings)
  44                            (#\e 'software)
  45                            (#\f 'null)
  46                            (_ #f)))
  47
  48 (when (not device-type)
  49   (exit #f))
  50
  51 ;; create event receiver
  52 (define key-is-down '())
  53 (define (is-key-down? key-code)
  54   (assoc-ref key-is-down key-code))
  55
  56 (define (on-event event)
  57   (if (equal? (get-event-type event) 'key-input-event)
  58       (set! key-is-down
  59             (assoc-set! key-is-down
  60                         (get-event-key event)
  61                         (get-event-key-pressed event))))
  62   #f)
  63
  64 (define receiver (make-event-receiver on-event))
  65
  66 ;; create device
  67 (define device
  68   (create-device
  69    #:device-type device-type
  70    #:window-size '(640 480)
  71    #:receiver receiver))
  72
  73 (define driver (get-video-driver device))
  74 (define scene-manager (get-scene-manager device))
  75 (define gui-env (get-gui-environment device))
  76
  77 ;; create the node which will be moved with the WSAD keys
  78 (define ball (add-sphere-scene-node! scene-manager))
  79 (set-position! ball '(0 0 30))
  80 (set-material-texture! ball 0 (get-texture driver "media/wall.bmp"))
  81 (set-material-flag! ball 'lighting #f)
  82
  83 ;; create another node, movable using a scene node animator
  84 (let ((cube (add-cube-scene-node! scene-manager))
  85       (anim (create-fly-circle-animator scene-manager #:center '(0 0 30) #:radius 20)))
  86   (set-material-texture! cube 0 (get-texture driver "media/t351sml.jpg"))
  87   (set-material-flag! cube 'lighting #f)
  88   (add-animator! cube anim)
  89   (drop! anim))
  90
  91 ;; another scene with a b3d model and a 'fly straight' animator
  92 (let ((ninja (add-animated-mesh-scene-node!
  93               scene-manager (get-mesh scene-manager "media/ninja.b3d")))
  94       (anim (create-fly-straight-animator
  95              scene-manager '(100 0 60) '(-100 0 60) 3500 #:loop #t)))
  96   (add-animator! ninja anim)
  97   (drop! anim)
  98
  99   ;; make the model look right
 100   (set-material-flag! ninja 'lighting #f)
 101   (set-frame-loop! ninja 0 13)
 102   (set-animation-speed! ninja 15)
 103   (set-scale! ninja '(2 2 2))
 104   (set-rotation! ninja '(0 -90 0)))
 105
 106 ;; create a first person shooter camera
 107 (add-camera-scene-node-fps! scene-manager)
 108 (set-visible! (get-cursor-control device) #f)
 109
 110 ;; colorful irrlicht logo
 111 (add-image! gui-env (get-texture driver "media/irrlichtlogoalpha2.tga") '(10 20))
 112 (let ((diagnostics (add-static-text! gui-env "" '(10 10 400 20))))
 113   (set-override-color! diagnostics '(255 255 255 0)))
 114
 115 ;; game loop
 116 (let ((timer (get-timer device))
 117       (driver-name (get-name driver)))
 118   (let ((last-fps -1)
 119         (then (get-time timer))
 120         (movement-speed 5))
 121     (while (run device)
 122       (let* ((now (get-time timer))
 123              (frame-delta-time (/ (- now then) 1000)))
 124         (set! then now)
 125
 126         ;; check if W, S, A or D are pressed
 127         (let* ((node-position (get-position ball))
 128                (pos-x (car node-position))
 129                (pos-y (cadr node-position))
 130                (pos-z (caddr node-position)))
 131           (if (is-key-down? 'key-w)
 132               (set! pos-y (+ pos-y (* movement-speed frame-delta-time))))
 133           (if (is-key-down? 'key-s)
 134               (set! pos-y (- pos-y (* movement-speed frame-delta-time))))
 135           (if (is-key-down? 'key-a)
 136               (set! pos-x (- pos-x (* movement-speed frame-delta-time))))
 137           (if (is-key-down? 'key-d)
 138               (set! pos-x (+ pos-x (* movement-speed frame-delta-time))))
 139           (set-position! ball (list pos-x pos-y pos-z))))
 140
 141       (begin-scene driver #:color '(255 113 113 133))
 142       (draw-all scene-manager)
 143       (draw-all gui-env)
 144       (end-scene driver)
 145
 146       (let ((fps (get-fps driver)))
 147         (when (not (= last-fps fps))
 148           (let ((caption
 149                  (format #f "Movement Example - Irrlicht Engine [~a] fps: ~a" driver-name fps)))
 150             (set-window-caption! device caption))
 151           (set! last-fps fps))))))
 152
 153 ;; delete device
 154 (drop! device)
 155 (exit #t)