From: Javier Sancho <jsf@jsancho.org>
Date: Sat, 9 Nov 2019 19:17:43 +0000 (+0100)
Subject: Quake3Map example with all the functions needed
X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=commitdiff_plain;h=954186a692ada723b904a9a28a7b9043deeb7552

Quake3Map example with all the functions needed
---

diff --git a/examples/02.Quake3Map.scm b/examples/02.Quake3Map.scm
new file mode 100644
index 0000000..a3b897b
--- /dev/null
+++ b/examples/02.Quake3Map.scm
@@ -0,0 +1,96 @@
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; This file is part of guile-irrlicht.
+;;;
+;;; Guile-irrlicht is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-irrlicht is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with guile-irrlicht.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+
+;;; Irrlicht 01.HelloWorld example
+;;; http://irrlicht.sourceforge.net/docu/example001.html
+
+
+(use-modules (irrlicht)
+             (ice-9 match))
+
+;; ask user for driver
+(format #t
+        "Please select the driver you want for this example:
+ (a) OpenGL 1.5
+ (b) Direct3D 9.0c
+ (c) Direct3D 8.1
+ (d) Burning's Software Renderer
+ (e) Software Renderer
+ (f) NullDevice
+ (otherKey) exit~%~%")
+
+(define driver (match (read-char)
+                      (#\a 'opengl)
+                      (#\b 'direct3d9)
+                      (#\c 'direct3d8)
+                      (#\d 'burnings)
+                      (#\e 'software)
+                      (#\f 'null)
+                      (_ #f)))
+
+(when (not driver)
+  (exit #f))
+
+;; start up the engine
+(define device
+  (create-device
+   #:device-type driver
+   #:window-size '(640 480)))
+(when (not device)
+  (exit #f))
+
+;; instances for doing things
+(define driver (get-video-driver device))
+(define scene-manager (get-scene-manager device))
+(define driver-name (get-video-driver-name driver))
+
+;; load Quake3 map
+(add-file-archive! (get-file-system device) "media/map-20kdm2.pk3")
+
+(define mesh (get-mesh scene-manager "20kdm2.bsp"))
+(define node (add-octree-scene-node-am
+              scene-manager mesh
+              #:minimal-polys-per-node 1024))
+(set-position! node '(-1300 -144 -1249))
+
+;; FPS camera
+(add-camera-scene-node-fps! scene-manager)
+(set-visible-cursor! (get-cursor-control device) #f)
+
+;; loop
+(define last-fps -1)
+(while (device-run? device)
+  (cond ((is-window-active? device)
+         (begin-scene driver #:color '(255 200 200 200))
+         (scene-draw-all scene-manager)
+         (end-scene driver)
+
+         (let ((fps (get-fps driver)))
+           (when (not (= last-fps fps))
+             (let ((caption
+                    (format #f "Irrlicht Engine - Quake 3 Map example [~a] FPS:~a" driver-name fps)))
+               (set-window-caption! device caption))
+             (set! last-fps fps))))
+        (else
+         (yield device))))
+
+;; delete device
+(device-drop! device)
+(exit #t)
diff --git a/examples/media/map-20kdm2.pk3 b/examples/media/map-20kdm2.pk3
new file mode 100644
index 0000000..d86083e
Binary files /dev/null and b/examples/media/map-20kdm2.pk3 differ
diff --git a/irrlicht.scm b/irrlicht.scm
index ce5547b..5f954ca 100644
--- a/irrlicht.scm
+++ b/irrlicht.scm
@@ -24,31 +24,43 @@
   #:use-module ((irrlicht bindings) #:prefix ffi:)
   #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
   #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:)
+  #:use-module ((irrlicht bindings io) #:prefix ffi-io:)
   #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
   #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
   #:export (;; device
             create-device
+            get-cursor-control
+            get-file-system
             get-video-driver
             get-gui-environment
             get-scene-manager
+            is-window-active?
             set-window-caption!
             device-run?
             device-drop!
-            ;; driver
+            ;; video driver
             begin-scene
             end-scene
+            get-fps
             get-texture
+            get-video-driver-name
             ;; gui
             add-static-text!
             gui-draw-all
+            set-visible-cursor!
+            ;; io
+            add-file-archive!
             ;; scene
             add-animated-mesh-scene-node
             add-camera-scene-node
+            add-camera-scene-node-fps!
+            add-octree-scene-node-am
             get-mesh
             scene-draw-all
             set-material-flag-am!
             set-material-texture-am!
-            set-md2-animation!))
+            set-md2-animation!
+            set-position!))
 
 ;; Device functions
 (define* (create-device #:key
@@ -73,6 +85,12 @@
                                      (if vsync 1 0))))
       (if (null-pointer? device) #f device))))
 
+(define (get-cursor-control device)
+  (ffi:get-cursor-control device))
+
+(define (get-file-system device)
+  (ffi:get-file-system device))
+
 (define (get-video-driver device)
   (ffi:get-video-driver device))
 
@@ -82,6 +100,9 @@
 (define (get-scene-manager device)
   (ffi:get-scene-manager device))
 
+(define (is-window-active? device)
+  (if (> (ffi:is-window-active device) 0) #t #f))
+
 (define (set-window-caption! device text)
   (ffi:set-window-caption device (string->pointer text)))
 
@@ -92,7 +113,7 @@
   (if (> (ffi:drop device) 0) #t #f))
 
 
-;; Driver functions
+;; Video driver functions
 (define* (begin-scene driver
                       #:key
                       (back-buffer #t)
@@ -112,9 +133,16 @@
 (define (end-scene driver)
   (ffi-video:end-scene driver))
 
+(define (get-fps driver)
+  (ffi-video:get-fps driver))
+
 (define (get-texture driver filename)
   (ffi-video:get-texture driver (string->pointer filename)))
 
+(define (get-video-driver-name driver)
+  (pointer->string
+   (ffi-video:get-video-driver-name driver)))
+
 
 ;; GUI functions
 (define* (add-static-text! gui-env text rectangle
@@ -136,6 +164,37 @@
 (define (gui-draw-all gui-env)
   (ffi-gui:draw-all gui-env))
 
+(define (set-visible-cursor! cursor-control visible)
+  (ffi-gui:set-visible-cursor
+   cursor-control
+   (if visible 1 0)))
+
+
+;; IO functions
+(define* (add-file-archive! file-system filename
+                            #:key
+                            (ignore-case #t)
+                            (ignore-paths #t)
+                            (archive-type 'unknown)
+                            (password "")
+                            (ret-archive %null-pointer))
+  (let ((type (match archive-type
+                     ('zip ffi-io:EFAT_ZIP)
+                     ('gzip ffi-io:EFAT_GZIP)
+                     ('folder ffi-io:EFAT_FOLDER)
+                     ('pak ffi-io:EFAT_PAK)
+                     ('npk ffi-io:EFAT_NPK)
+                     ('tar ffi-io:EFAT_TAR)
+                     ('wad ffi-io:EFAT_WAD)
+                     ('unknown ffi-io:EFAT_UNKNOWN))))
+    (ffi-io:add-file-archive file-system
+                             (string->pointer filename)
+                             (if ignore-case 1 0)
+                             (if ignore-paths 1 0)
+                             type
+                             (string->pointer password)
+                             ret-archive)))
+
 
 ;; Scene functions
 (define* (add-animated-mesh-scene-node scene-manager mesh
@@ -173,6 +232,45 @@
                  (if make-active 1 0))))
     (if (null-pointer? camera) #f camera)))
 
+(define* (add-camera-scene-node-fps! scene-manager
+                                     #:key
+                                     (parent %null-pointer)
+                                     (rotate-speed 100.0)
+                                     (move-speed 0.5)
+                                     (id -1)
+                                     (key-map-array %null-pointer)
+                                     (key-map-size 0)
+                                     (no-vertical-movement #f)
+                                     (jump-speed 0.0)
+                                     (invert-mouse #f)
+                                     (make-active #t))
+  (ffi-scene:add-camera-scene-node-fps
+   scene-manager
+   parent
+   rotate-speed
+   move-speed
+   id
+   key-map-array
+   key-map-size
+   (if no-vertical-movement 1 0)
+   jump-speed
+   (if invert-mouse 1 0)
+   (if make-active 1 0)))
+
+(define* (add-octree-scene-node-am scene-manager mesh
+                                   #:key
+                                   (parent %null-pointer)
+                                   (id -1)
+                                   (minimal-polys-per-node 512)
+                                   (also-add-if-mesh-pointer-zero #f))
+  (ffi-scene:add-octree-scene-node-am
+   scene-manager
+   mesh
+   parent
+   id
+   minimal-polys-per-node
+   (if also-add-if-mesh-pointer-zero 1 0)))
+
 (define (get-mesh scene-manager filename)
   (let ((mesh (ffi-scene:get-mesh scene-manager (string->pointer filename))))
     (if (null-pointer? mesh) #f mesh)))
@@ -239,3 +337,8 @@
     (ffi-scene:set-md2-animation
      node
      animation-type)))
+
+(define (set-position! node newpos)
+  (ffi-scene:set-position
+   node
+   (make-c-struct ffi-core:vector3df newpos)))
diff --git a/irrlicht/bindings.scm b/irrlicht/bindings.scm
index 524dabe..0039b2d 100644
--- a/irrlicht/bindings.scm
+++ b/irrlicht/bindings.scm
@@ -29,6 +29,18 @@
    (dynamic-func "irr_createDevice" cirr)
    (list int '* uint32 int int int)))
 
+(define-public get-cursor-control
+  (pointer->procedure
+   '*
+   (dynamic-func "irr_getCursorControl" cirr)
+   (list '*)))
+
+(define-public get-file-system
+  (pointer->procedure
+   '*
+   (dynamic-func "irr_getFileSystem" cirr)
+   (list '*)))
+
 (define-public get-video-driver
   (pointer->procedure
    '*
@@ -47,6 +59,12 @@
    (dynamic-func "irr_getSceneManager" cirr)
    (list '*)))
 
+(define-public is-window-active
+  (pointer->procedure
+   int
+   (dynamic-func "irr_isWindowActive" cirr)
+   (list '*)))
+
 (define-public set-window-caption
   (pointer->procedure
    void
diff --git a/irrlicht/bindings/gui.scm b/irrlicht/bindings/gui.scm
index 387c841..beb6459 100644
--- a/irrlicht/bindings/gui.scm
+++ b/irrlicht/bindings/gui.scm
@@ -34,3 +34,9 @@
    void
    (dynamic-func "irr_gui_drawAll" cirr)
    (list '*)))
+
+(define-public set-visible-cursor
+  (pointer->procedure
+   void
+   (dynamic-func "irr_gui_setVisibleCursor" cirr)
+   (list '* int)))
diff --git a/irrlicht/bindings/io.scm b/irrlicht/bindings/io.scm
new file mode 100644
index 0000000..5532ec1
--- /dev/null
+++ b/irrlicht/bindings/io.scm
@@ -0,0 +1,59 @@
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; This file is part of guile-irrlicht.
+;;;
+;;; Guile-irrlicht is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-irrlicht is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with guile-irrlicht.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht bindings io)
+  #:use-module (system foreign)
+  #:use-module (rnrs arithmetic bitwise))
+
+(define cirr (dynamic-link "libCIrrlicht"))
+
+(define (make-cirr-id c0 c1 c2 c3)
+  (define (char->numeric c)
+    (if (char? c) (char->integer c) c))
+  (logior
+   (char->numeric c0)
+   (bitwise-arithmetic-shift-left (char->numeric c1) 8)
+   (bitwise-arithmetic-shift-left (char->numeric c2) 16)
+   (bitwise-arithmetic-shift-left (char->numeric c3) 24)))
+
+;; irr_io_E_FILE_ARCHIVE_TYPE enum
+;; A PKZIP archive
+(define-public EFAT_ZIP (make-cirr-id #\Z #\I #\P 0))
+;; A gzip archive
+(define-public EFAT_GZIP (make-cirr-id #\g #\z #\i #\p))
+;; A virtual directory
+(define-public EFAT_FOLDER (make-cirr-id #\f #\l #\d #\r))
+;; An ID Software PAK archive
+(define-public EFAT_PAK (make-cirr-id #\P #\A #\K 0))
+;; A Nebula Device archive
+(define-public EFAT_NPK (make-cirr-id #\N #\P #\K 0))
+;; A Tape ARchive
+(define-public EFAT_TAR (make-cirr-id #\T #\A #\R 0))
+;; A wad Archive, Quake2, Halflife
+(define-public EFAT_WAD (make-cirr-id #\W #\A #\D 0))
+;; The type of this archive is unknown
+(define-public EFAT_UNKNOWN (make-cirr-id #\u #\n #\k #\n))
+
+;; IO functions
+(define-public add-file-archive
+  (pointer->procedure
+   int
+   (dynamic-func "irr_io_addFileArchive" cirr)
+   (list '* '* int int int '* '*)))
diff --git a/irrlicht/bindings/scene.scm b/irrlicht/bindings/scene.scm
index 2cf4568..752825b 100644
--- a/irrlicht/bindings/scene.scm
+++ b/irrlicht/bindings/scene.scm
@@ -60,6 +60,18 @@
    (dynamic-func "irr_scene_addCameraSceneNode" cirr)
    (list '* '* '* '* int int)))
 
+(define-public add-camera-scene-node-fps
+  (pointer->procedure
+   '*
+   (dynamic-func "irr_scene_addCameraSceneNodeFPS" cirr)
+   (list '* '* float float int '* int int float int int)))
+
+(define-public add-octree-scene-node-am
+  (pointer->procedure
+   '*
+   (dynamic-func "irr_scene_addOctreeSceneNodeAM" cirr)
+   (list '* '* '* int int int)))
+
 (define-public draw-all
   (pointer->procedure
    void
@@ -89,3 +101,9 @@
    void
    (dynamic-func "irr_scene_setMD2Animation" cirr)
    (list '* int)))
+
+(define-public set-position
+  (pointer->procedure
+   void
+   (dynamic-func "irr_scene_setPosition" cirr)
+   (list '* '*)))
diff --git a/irrlicht/bindings/video.scm b/irrlicht/bindings/video.scm
index 47b05d1..2044552 100644
--- a/irrlicht/bindings/video.scm
+++ b/irrlicht/bindings/video.scm
@@ -72,8 +72,20 @@
    (dynamic-func "irr_video_endScene" cirr)
    (list '*)))
 
+(define-public get-fps
+  (pointer->procedure
+   int
+   (dynamic-func "irr_video_getFPS" cirr)
+   (list '*)))
+
 (define-public get-texture
   (pointer->procedure
    '*
    (dynamic-func "irr_video_getTexture" cirr)
    (list '* '*)))
+
+(define-public get-video-driver-name
+  (pointer->procedure
+   '*
+   (dynamic-func "irr_video_getName" cirr)
+   (list '*)))