X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fgui.scm;h=ca705d528913035bf016fa6782052f4b2a596171;hb=bca809c8b7d6a3056e51dff6a8016fd0a2cac476;hp=10cf0bf05280c81ac192d324ad23766b6cd2f92b;hpb=a33bf2efe7a2578915cd27d3d2f3462c41ca0517;p=guile-irrlicht.git diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index 10cf0bf..ca705d5 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) @@ -58,6 +67,13 @@ (let ((addImage (get-irrlicht-proc "addImage" gui-environment parent))) (addImage gui-environment image pos use-alpha-channel parent id text)))) +(define-method (add-scrollbar! (gui-environment ) horizontal rectangle . rest) + (let-keywords rest #f + ((parent (make )) + (id -1)) + (let ((addScrollBar (get-irrlicht-proc "addScrollBar" gui-environment parent))) + (addScrollBar gui-environment horizontal rectangle parent id)))) + (define-method (add-static-text! (gui-environment ) text rectangle . rest) (let-keywords rest #f ((border #f) @@ -73,14 +89,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-scrollbar! 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 +121,57 @@ (irr-class #:init-value "IGUIImage")) (export ) + + +;; IGUISkin +(define-class () + (irr-class #:init-value "IGUISkin")) + +(define-method (get-color (skin ) color) + (let ((getColor (get-irrlicht-proc "getColor" skin))) + (getColor skin color))) + +(define-method (set-font! (skin ) font . rest) + (let-keywords rest #f + ((which 'default)) + (let ((setFont (get-irrlicht-proc "setFont" skin))) + (setFont skin font which)))) + +(define-method (set-color! (skin ) which new-color) + (let ((setColor (get-irrlicht-proc "setColor" skin))) + (setColor skin which new-color))) + +(export get-color set-font! set-color!) + + +;; IGUIFont +(define-class () + (irr-class #:init-value "IGUIFont")) + +(export ) + + +;; IGUIButton +(define-class () + (irr-class #:init-value "IGUIButton")) + +(export ) + + +;; IGUIScrollBar +(define-class () + (irr-class #:init-value "IGUIScrollBar")) + +(define-method (get-position (scrollbar )) + (let ((getPos (get-irrlicht-proc "getPos" scrollbar))) + (getPos scrollbar))) + +(define-method (set-max! (scrollbar ) max) + (let ((setMax (get-irrlicht-proc "setMax" scrollbar))) + (setMax scrollbar max))) + +(define-method (set-position! (scrollbar ) pos) + (let ((setPos (get-irrlicht-proc "setPos" scrollbar))) + (setPos scrollbar pos))) + +(export get-position set-max! set-position!)