X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fdevice.scm;h=b75d4d3f7b87d75e4bcf8ba3d967b1a9791d4232;hb=73e48b7e6472724899af8284491802e950156004;hp=e07a812d2e0b6818473e2af7278f17dbb34dda9b;hpb=2dfe078cf4082caf641c96449907f36a9029b486;p=guile-irrlicht.git diff --git a/irrlicht/device.scm b/irrlicht/device.scm index e07a812..b75d4d3 100644 --- a/irrlicht/device.scm +++ b/irrlicht/device.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,15 +19,19 @@ (define-module (irrlicht device) - #:export (create-device - get-gui-environment - get-scene-manager - get-video-driver - set-window-caption!)) + #: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)) -(load-extension "libguile-irrlicht" "init_guile_irrlicht") -(define irr-create-device create-device) +;; IrrlichtDevice +(define-class () + (irr-class #:init-value "IrrlichtDevice" #:getter irr-class)) + (define* (create-device #:key (device-type 'software) (window-size '(640 480)) @@ -35,11 +39,37 @@ (fullscreen #f) (stencilbuffer #f) (vsync #f) - (receiver 0)) - (irr-create-device device-type - window-size - bits - fullscreen - stencilbuffer - vsync - receiver)) + (receiver (make ))) + (if (not (is-a? receiver )) + (error + "In procedure create-device: Wrong type argument (expecting ):" + receiver)) + + (make + #:irr-pointer + ((get-irrlicht-proc "createDevice") + device-type + window-size + bits + fullscreen + stencilbuffer + vsync + (irr-pointer receiver)))) + +(define-method (get-gui-environment (device )) + (make + #:irr-pointer ((get-irrlicht-proc "getGUIEnvironment" device) (irr-pointer device)))) + +(define-method (get-scene-manager (device )) + (make + #:irr-pointer ((get-irrlicht-proc "getSceneManager" device) (irr-pointer device)))) + +(define-method (get-video-driver (device )) + (make + #:irr-pointer ((get-irrlicht-proc "getVideoDriver" device) (irr-pointer device)))) + +(define-method (set-window-caption! (device ) text) + ((get-irrlicht-proc "setWindowCaption" device) + (irr-pointer device) text)) + +(export create-device get-gui-environment get-scene-manager get-video-driver set-window-caption!)