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-input-key event)
  61                         (get-event-key-input-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 (when (not device)
  73   (exit #f))
  74
  75 (define driver (get-video-driver device))
  76 (define scene-manager (get-scene-manager device))
  77 (define gui-env (get-gui-environment device))
  78
  79 ;; create the node which will be moved with the WSAD keys
  80 (define ball (add-sphere-scene-node! scene-manager))
  81 (set-position! ball '(0 0 30))
  82 (set-material-texture! ball 0 (get-texture driver "media/wall.bmp"))
  83 (set-material-flag! ball 'lighting #f)
  84
  85 ;; create another node, movable using a scene node animator
  86 (let ((cube (add-cube-scene-node! scene-manager))
  87       (anim (create-fly-circle-animator scene-manager #:center '(0 0 30) #:radius 20)))
  88   (set-material-texture! cube 0 (get-texture driver "media/t351sml.jpg"))
  89   (set-material-flag! cube 'lighting #f)
  90   (add-animator! cube anim)
  91   (drop! anim))
  92
  93 ;; another scene with a b3d model and a 'fly straight' animator
  94 (let ((ninja (add-animated-mesh-scene-node!
  95               scene-manager (get-mesh scene-manager "media/ninja.b3d")))
  96       (anim (create-fly-straight-animator
  97              scene-manager '(100 0 60) '(-100 0 60) 3500 #:loop #t)))
  98   (add-animator! ninja anim)
  99   (drop! anim)
 100
 101   ;; make the model look right
 102   (set-material-flag! ninja 'lighting #f)
 103   (set-frame-loop! ninja 0 13)
 104   (set-animation-speed! ninja 15)
 105   (set-scale! ninja '(2 2 2))
 106   (set-rotation! ninja '(0 -90 0)))
 107
 108 ;; create a first person shooter camera
 109 (add-camera-scene-node-fps! scene-manager)
 110 (set-visible! (get-cursor-control device) #f)
 111
 112 ;; colorful irrlicht logo
 113 (add-image! gui-env (get-texture driver "media/irrlichtlogoalpha2.tga") '(10 20))
 114 (let ((diagnostics (add-static-text! gui-env "" '(10 10 400 20))))
 115   (set-override-color! diagnostics '(255 255 255 0)))
 116
 117 ;; game loop
 118 (let ((timer (get-timer device))
 119       (driver-name (get-name driver)))
 120   (let ((last-fps -1)
 121         (then (get-time timer))
 122         (movement-speed 5))
 123     (while (run device)
 124       (let* ((now (get-time timer))
 125              (frame-delta-time (/ (- now then) 1000)))
 126         (set! then now)
 127
 128         ;; check if W, S, A or D are pressed
 129         (let* ((node-position (get-position ball))
 130                (pos-x (car node-position))
 131                (pos-y (cadr node-position))
 132                (pos-z (caddr node-position)))
 133           (if (is-key-down? 'key-w)
 134               (set! pos-y (+ pos-y (* movement-speed frame-delta-time))))
 135           (if (is-key-down? 'key-s)
 136               (set! pos-y (- pos-y (* movement-speed frame-delta-time))))
 137           (if (is-key-down? 'key-a)
 138               (set! pos-x (- pos-x (* movement-speed frame-delta-time))))
 139           (if (is-key-down? 'key-d)
 140               (set! pos-x (+ pos-x (* movement-speed frame-delta-time))))
 141           (set-position! ball (list pos-x pos-y pos-z))))
 142
 143       (begin-scene driver #:color '(255 113 113 133))
 144       (draw-all scene-manager)
 145       (draw-all gui-env)
 146       (end-scene driver)
 147
 148       (let ((fps (get-fps driver)))
 149         (when (not (= last-fps fps))
 150           (let ((caption
 151                  (format #f "Movement Example - Irrlicht Engine [~a] fps: ~a" driver-name fps)))
 152             (set-window-caption! device caption))
 153           (set! last-fps fps))))))
 154
 155 ;; delete device
 156 (drop! device)
 157 (exit #t)