#: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 (create-device
+ #: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!))
+ 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!))
-(define* (create-device #:optional
+;; Device functions
+(define* (create-device #:key
(device-type 'software)
(window-size '(640 480))
(bits 16)
('opengl ffi-video:EDT_OPENGL)
('count ffi-video:EDT_COUNT)))
(wsize (make-c-struct ffi-core:dimension2d window-size)))
- (ffi:create-device driver wsize bits
- (if fullscreen 1 0)
- (if stencilbuffer 1 0)
- (if vsync 1 0))))
+ (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-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)))
projects / guile-irrlicht.git / blobdiff