From: Javier Sancho 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/?a=commitdiff_plain;h=954186a692ada723b904a9a28a7b9043deeb7552;p=guile-irrlicht.git 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 +;;; +;;; 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 +;;; . + + +;;; 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 +;;; +;;; 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 +;;; . + + +(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 '*)))