]> git.jsancho.org Git - guile-irrlicht.git/blob - examples/04-movement.scm
get-fps
[guile-irrlicht.git] / 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)