X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=blobdiff_plain;f=irrlicht.scm;h=c1e52c2c50d04f3a7f257e740e18758eb5f5eea2;hp=5f954cadf8ad67114d4058aca661823a55488f39;hb=09e9ed196aadab0f77e831c134fce8bdb58b772b;hpb=954186a692ada723b904a9a28a7b9043deeb7552 diff --git a/irrlicht.scm b/irrlicht.scm index 5f954ca..c1e52c2 100644 --- a/irrlicht.scm +++ b/irrlicht.scm @@ -1,5 +1,5 @@ ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine -;;; Copyright (C) 2019 Javier Sancho +;;; Copyright (C) 2020 Javier Sancho ;;; ;;; This file is part of guile-irrlicht. ;;; @@ -19,326 +19,36 @@ (define-module (irrlicht) - #:use-module (ice-9 match) - #:use-module (system foreign) - #: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! - ;; 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-position!)) - -;; Device functions -(define* (create-device #:key - (device-type 'software) - (window-size '(640 480)) - (bits 16) - (fullscreen #f) - (stencilbuffer #f) - (vsync #f)) - (let ((driver (match device-type - ('null ffi-video:EDT_NULL) - ('software ffi-video:EDT_SOFTWARE) - ('burnings ffi-video:EDT_BURNINGSVIDEO) - ('direct3d8 ffi-video:EDT_DIRECT3D8) - ('direct3d9 ffi-video:EDT_DIRECT3D9) - ('opengl ffi-video:EDT_OPENGL) - ('count ffi-video:EDT_COUNT))) - (wsize (make-c-struct ffi-core:dimension2d window-size))) - (let ((device (ffi:create-device driver wsize bits - (if fullscreen 1 0) - (if stencilbuffer 1 0) - (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)) - -(define (get-gui-environment device) - (ffi:get-gui-environment device)) - -(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))) - -(define (device-run? device) - (if (> (ffi:run device) 0) #t #f)) - -(define (device-drop! device) - (if (> (ffi:drop device) 0) #t #f)) - - -;; Video driver functions -(define* (begin-scene driver - #:key - (back-buffer #t) - (z-buffer #t) - (color '(255 0 0 0)) - (video-data %null-pointer) - (source-rect '())) - (ffi-video:begin-scene driver - (if back-buffer 1 0) - (if z-buffer 1 0) - (make-c-struct ffi-video:scolor color) - video-data - (if (null? source-rect) - %null-pointer - (make-c-struct ffi-core:rect source-rect)))) - -(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 - #:key - (border #f) - (word-wrap #t) - (parent %null-pointer) - (id -1) - (fill-background #f)) - (ffi-gui:add-static-text gui-env - (string->pointer text) - (make-c-struct ffi-core:rect rectangle) - (if border 1 0) - (if word-wrap 1 0) - parent - id - (if fill-background 1 0))) - -(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 - #:key - (parent %null-pointer) - (id -1) - (position '(0 0 0)) - (rotation '(0 0 0)) - (scale '(1 1 1)) - (also-add-if-mesh-pointer-zero #f)) - (let ((node (ffi-scene:add-animated-mesh-scene-node - scene-manager - mesh - parent - id - (make-c-struct ffi-core:vector3df position) - (make-c-struct ffi-core:vector3df rotation) - (make-c-struct ffi-core:vector3df scale) - (if also-add-if-mesh-pointer-zero 1 0)))) - (if (null-pointer? node) #f node))) - -(define* (add-camera-scene-node scene-manager - #:key - (parent %null-pointer) - (position '(0 0 0)) - (lookat '(0 0 100)) - (id -1) - (make-active #t)) - (let ((camera (ffi-scene:add-camera-scene-node - scene-manager - parent - (make-c-struct ffi-core:vector3df position) - (make-c-struct ffi-core:vector3df lookat) - id - (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))) - -(define (scene-draw-all scene-manager) - (ffi-scene:draw-all scene-manager)) - -(define (set-material-flag-am! node flag newvalue) - (let ((material-flag - (match flag - ('wireframe ffi-video:EMF_WIREFRAME) - ('pointcloud ffi-video:EMF_POINTCLOUD) - ('gouraud-shading ffi-video:EMF_GOURAUD_SHADING) - ('lighting ffi-video:EMF_LIGHTING) - ('zbuffer ffi-video:EMF_ZBUFFER) - ('zwrite-enable ffi-video:EMF_ZWRITE_ENABLE) - ('back-face-culling ffi-video:EMF_BACK_FACE_CULLING) - ('front-face-culling ffi-video:EMF_FRONT_FACE_CULLING) - ('bilinear-filter ffi-video:EMF_BILINEAR_FILTER) - ('trilinear-filter ffi-video:EMF_TRILINEAR_FILTER) - ('anisotropic-filter ffi-video:EMF_ANISOTROPIC_FILTER) - ('fog-enable ffi-video:EMF_FOG_ENABLE) - ('normalize-normals ffi-video:EMF_NORMALIZE_NORMALS) - ('texture-wrap ffi-video:EMF_TEXTURE_WRAP) - ('anti-aliasing ffi-video:EMF_ANTI_ALIASING) - ('color-mask ffi-video:EMF_COLOR_MASK) - ('color-material ffi-video:EMF_COLOR_MATERIAL) - ('use-mip-maps ffi-video:EMF_USE_MIP_MAPS) - ('blend-operation ffi-video:EMF_BLEND_OPERATION) - ('polygon-offset ffi-video:EMF_POLYGON_OFFSET)))) - (ffi-scene:set-material-flag-am - node - material-flag - (if newvalue 1 0)))) - -(define (set-material-texture-am! node texture-layer texture) - (ffi-scene:set-material-texture-am node texture-layer texture)) - -(define (set-md2-animation! node anim) - (let ((animation-type - (match anim - ('stand ffi-scene:EMAT_STAND) - ('run ffi-scene:EMAT_RUN) - ('attack ffi-scene:EMAT_ATTACK) - ('pain-a ffi-scene:EMAT_PAIN_A) - ('pain-b ffi-scene:EMAT_PAIN_B) - ('pain-c ffi-scene:EMAT_PAIN_C) - ('jump ffi-scene:EMAT_JUMP) - ('flip ffi-scene:EMAT_FLIP) - ('salute ffi-scene:EMAT_SALUTE) - ('fallback ffi-scene:EMAT_FALLBACK) - ('wave ffi-scene:EMAT_WAVE) - ('point ffi-scene:EMAT_POINT) - ('crouch-stand ffi-scene:EMAT_CROUCH_STAND) - ('crouch-walk ffi-scene:EMAT_CROUCH_WALK) - ('crouch-attack ffi-scene:EMAT_CROUCH_ATTACK) - ('crouch-pain ffi-scene:EMAT_CROUCH_PAIN) - ('crouch-death ffi-scene:EMAT_CROUCH_DEATH) - ('death-fallback ffi-scene:EMAT_DEATH_FALLBACK) - ('death-fallforward ffi-scene:EMAT_DEATH_FALLFORWARD) - ('death-fallbackslow ffi-scene:EMAT_DEATH_FALLBACKSLOW) - ('boom ffi-scene:EMAT_BOOM) - ('count ffi-scene:EMAT_COUNT)))) - (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))) + #:use-module (oop goops) + #:use-module (irrlicht base) + #:use-module (irrlicht device) + #:use-module (irrlicht gui) + #:use-module (irrlicht io) + #:use-module (irrlicht irr) + #:use-module (irrlicht scene) + #:use-module (irrlicht video) + #:duplicates (merge-generics) + #:re-export (add-animated-mesh-scene-node! + add-camera-scene-node! + add-file-archive! + add-static-text! + begin-scene + create-device + drop! + end-scene + get-file-system + get-gui-environment + get-mesh + get-name + get-scene-manager + get-texture + get-video-driver + is-empty? + run + set-material-flag! + set-material-texture! + set-md2-animation! + set-window-caption!)) + +;; Merged methods have to be exported apart +(re-export draw-all)