;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
-;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
;;;
;;; This file is part of guile-irrlicht.
;;;
(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 core)
+ #: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 (;; classes
+ <animated-mesh>
+ <animated-mesh-scene-node>
+ <attribute-exchanging-object>
+ <box3d>
+ <camera-scene-node>
+ <cursor-control>
+ <event>
+ <event-receiver>
+ <file-archive>
+ <file-system>
+ <gui-button>
+ <gui-editbox>
+ <gui-element>
+ <gui-environment>
+ <gui-font>
+ <gui-image>
+ <gui-listbox>
+ <gui-scrollbar>
+ <gui-skin>
+ <gui-static-text>
+ <irrlicht-device>
+ <key-map>
+ <material>
+ <mesh>
+ <mesh-scene-node>
+ <reference-counted>
+ <scene-manager>
+ <scene-node>
+ <scene-node-animator>
+ <texture>
+ <timer>
+ <vertex3d>
+ <video-driver>
+ ;; methods
+ add-animated-mesh-scene-node!
+ add-animator!
+ add-button!
+ add-camera-scene-node!
+ add-camera-scene-node-fps!
+ add-cube-scene-node!
+ add-custom-scene-node!
+ add-editbox!
+ add-file-archive!
+ add-image!
+ add-internal-point!
+ add-listbox!
+ add-octree-scene-node!
+ add-scrollbar!
+ add-sphere-scene-node!
+ add-static-text!
+ begin-scene
+ create-device
+ create-fly-circle-animator
+ create-fly-straight-animator
+ create-rotation-animator
+ draw-vertex-primitive-list
+ drop!
+ end-scene
+ get-absolute-transformation
+ get-built-in-font
+ get-color
+ get-cursor-control
+ get-event-gui-caller
+ get-event-key
+ get-event-key-pressed
+ get-event-type
+ get-file-system
+ get-font
+ get-fps
+ get-gui-environment
+ get-mesh
+ get-name
+ get-root-scene-node
+ get-scene-manager
+ get-skin
+ get-texture
+ get-time
+ get-timer
+ get-video-driver
+ is-window-active?
+ make-box3d
+ make-event-receiver
+ make-material
+ make-vertex3d
+ reset-box3d!
+ run
+ set-animation-speed!
+ set-color!
+ set-event-receiver!
+ set-font!
+ set-frame-loop!
+ set-material!
+ set-material-flag!
+ set-material-texture!
+ set-max!
+ set-md2-animation!
+ set-override-color!
+ set-resizable!
+ set-rotation!
+ set-scale!
+ set-transform!
+ set-visible!
+ set-window-caption!
+ yield-device))
+
+;; Merged methods have to be exported apart
+(re-export draw-all
+ get-position
+ set-position!)
projects / guile-irrlicht.git / blobdiff