X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fgui.scm;h=86afd9ca5dd6c775e0aae0d3205a0b486e95cb55;hb=e1e79af4472feb78b4ec672f768eb8fdd10670fc;hp=10cf0bf05280c81ac192d324ad23766b6cd2f92b;hpb=a33bf2efe7a2578915cd27d3d2f3462c41ca0517;p=guile-irrlicht.git diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index 10cf0bf..86afd9c 100644 --- a/irrlicht/gui.scm +++ b/irrlicht/gui.scm @@ -23,8 +23,8 @@ #:use-module (ice-9 optargs) #:use-module (irrlicht base) #:use-module (irrlicht foreign) - #:use-module (irrlicht io) - #:use-module (irrlicht irr)) + #:use-module ((irrlicht io) #:select ()) + #:use-module ((irrlicht irr) #:select ( ))) ;; ICursorControl @@ -49,6 +49,15 @@ (define-class () (irr-class #:init-value "IGUIEnvironment")) +(define-method (add-button! (gui-environment ) rectangle . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (text "") + (tooltiptext "")) + (let ((addButton (get-irrlicht-proc "addButton" gui-environment parent))) + (addButton gui-environment rectangle parent id text tooltiptext)))) + (define-method (add-image! (gui-environment ) image pos . rest) (let-keywords rest #f ((use-alpha-channel #t) @@ -73,14 +82,31 @@ ((get-irrlicht-proc "drawAll" gui-environment) gui-environment)) -(export add-image! add-static-text! draw-all) +(define-method (get-built-in-font (gui-environment )) + (let ((getBuiltInFont (get-irrlicht-proc "getBuiltInFont" gui-environment))) + (getBuiltInFont gui-environment))) + +(define-method (get-font (gui-environment ) filename) + (let ((getFont (get-irrlicht-proc "getFont" gui-environment))) + (getFont gui-environment filename))) + +(define-method (get-skin (gui-environment )) + (let ((getSkin (get-irrlicht-proc "getSkin" gui-environment))) + (getSkin gui-environment))) + +(export add-button! add-image! add-static-text! draw-all get-built-in-font + get-font get-skin) ;; IGUIStaticText (define-class () (irr-class #:init-value "IGUIStaticText")) -(export ) +(define-method (set-override-color! (static-text ) color) + (let ((setOverrideColor (get-irrlicht-proc "setOverrideColor" static-text))) + (setOverrideColor static-text color))) + +(export set-override-color!) ;; IGUIImage @@ -88,3 +114,30 @@ (irr-class #:init-value "IGUIImage")) (export ) + + +;; IGUISkin +(define-class () + (irr-class #:init-value "IGUISkin")) + +(define-method (set-font! (skin ) font . rest) + (let-keywords rest #f + ((which 'default)) + (let ((setFont (get-irrlicht-proc "setFont" skin))) + (setFont skin font which)))) + +(export set-font!) + + +;; IGUIFont +(define-class () + (irr-class #:init-value "IGUIFont")) + +(export ) + + +;; IGUIButton +(define-class () + (irr-class #:init-value "IGUIButton")) + +(export )