X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fdevice.scm;h=0fdeed7ffecad1484d7e473a6e497a87ed654f7e;hb=3bb58c2b45af12c0f9c9eac648e67ac6fa90e104;hp=6049016fc1f8b5a2f5f92900ae128606c1f0f8d0;hpb=8c5c5f5fc4aef51c5dfa515b3a8eee67de3b8e9b;p=guile-irrlicht.git diff --git a/irrlicht/device.scm b/irrlicht/device.scm index 6049016..0fdeed7 100644 --- a/irrlicht/device.scm +++ b/irrlicht/device.scm @@ -22,14 +22,16 @@ #:use-module (oop goops) #:use-module (irrlicht base) #:use-module (irrlicht foreign) - #:use-module (irrlicht irr) - #:use-module (irrlicht gui) - #:use-module (irrlicht scene) - #:use-module (irrlicht video)) + #:use-module ((irrlicht irr) #:select ( ))) ;; IrrlichtDevice -(define-class ()) +(define-class () + (irr-class #:init-value "IrrlichtDevice")) + +(define-method (close-device (device )) + (let ((closeDevice (get-irrlicht-proc "closeDevice" device))) + (closeDevice device))) (define* (create-device #:key (device-type 'software) @@ -44,30 +46,63 @@ "In procedure create-device: Wrong type argument (expecting ):" receiver)) - (make - #:irr-pointer - (irr_createDevice - device-type - window-size - bits - fullscreen - stencilbuffer - vsync - (irr-pointer receiver)))) + (let* ((createDevice (get-irrlicht-proc "createDevice")) + (device (createDevice device-type window-size bits fullscreen stencilbuffer + vsync receiver))) + (if (null-object? device) + (error "In procedure create-device: Device cannot be created") + device))) + +(define-method (get-cursor-control (device )) + (let ((getCursorControl (get-irrlicht-proc "getCursorControl" device))) + (getCursorControl device))) + +(define-method (get-file-system (device )) + (let ((getFileSystem (get-irrlicht-proc "getFileSystem" device))) + (getFileSystem device))) (define-method (get-gui-environment (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getGUIEnvironment (irr-pointer device)))) + (let ((getGUIEnvironment (get-irrlicht-proc "getGUIEnvironment" device))) + (getGUIEnvironment device))) (define-method (get-scene-manager (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getSceneManager (irr-pointer device)))) + (let ((getSceneManager (get-irrlicht-proc "getSceneManager" device))) + (getSceneManager device))) + +(define-method (get-timer (device )) + (let ((getTimer (get-irrlicht-proc "getTimer" device))) + (getTimer device))) (define-method (get-video-driver (device )) - (make - #:irr-pointer (irr_IrrlichtDevice_getVideoDriver (irr-pointer device)))) + (let* ((getVideoDriver (get-irrlicht-proc "getVideoDriver" device)) + (driver (getVideoDriver device))) + (if (null-object? driver) + (error "In procedure get-video-driver: Driver unavailable") + driver))) + +(define-method (is-window-active? (device )) + (let ((isWindowActive (get-irrlicht-proc "isWindowActive" device))) + (isWindowActive device))) + +(define-method (run (device )) + ((get-irrlicht-proc "run" device) device)) + +(define-method (set-event-receiver! (device ) (receiver )) + (let ((setEventReceiver (get-irrlicht-proc "setEventReceiver" device receiver))) + (setEventReceiver device receiver))) + +(define-method (set-resizable! (device ) resize) + (let ((setResizable (get-irrlicht-proc "setResizable" device))) + (setResizable device resize))) (define-method (set-window-caption! (device ) text) - (irr_IrrlichtDevice_setWindowCaption (irr-pointer device) text)) + ((get-irrlicht-proc "setWindowCaption" device) + device text)) + +(define-method (yield-device (device )) + (let ((yield (get-irrlicht-proc "yield" device))) + (yield device))) -(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!) +(export close-device create-device get-cursor-control get-file-system + get-gui-environment get-scene-manager get-timer get-video-driver is-window-active? run + set-event-receiver! set-resizable! set-window-caption! yield-device)