]> git.jsancho.org Git - guile-irrlicht.git/blob - examples/02-quake3map.scm
yield-device
[guile-irrlicht.git] / examples / 02-quake3map.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 ;;; Irrlicht 02.Quake3Map example
22 ;;; http://irrlicht.sourceforge.net/docu/example002.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 driver (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 driver)
49   (exit #f))
50
51 ;; start up the engine
52 (define device
53   (create-device
54    #:device-type driver
55    #:window-size '(640 480)))
56 (when (not device)
57   (exit #f))
58
59 ;; instances for doing things
60 (define driver (get-video-driver device))
61 (define scene-manager (get-scene-manager device))
62 (define driver-name (get-name driver))
63
64 ;; load Quake3 map
65 (add-file-archive! (get-file-system device) "media/map-20kdm2.pk3")
66
67 (define mesh (get-mesh scene-manager "20kdm2.bsp"))
68 (define node (add-octree-scene-node!
69               scene-manager mesh
70               #:minimal-polys-per-node 1024))
71 (set-position! node '(-1300 -144 -1249))
72
73 ;; FPS camera
74 (add-camera-scene-node-fps! scene-manager)
75 (set-visible! (get-cursor-control device) #f)
76
77 ;; loop
78 (define last-fps -1)
79 (while (run device)
80   (cond ((is-window-active? device)
81          (begin-scene driver #:color '(255 200 200 200))
82          (draw-all scene-manager)
83          (end-scene driver)
84
85          (let ((fps (get-fps driver)))
86            (when (not (= last-fps fps))
87              (let ((caption
88                     (format #f "Irrlicht Engine - Quake 3 Map example [~a] FPS:~a" driver-name fps)))
89                (set-window-caption! device caption))
90              (set! last-fps fps))))
91         (else
92          (yield-device device))))
93
94 ;; delete device
95 (drop! device)
96 (exit #t)