X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fgui.scm;h=65b24bb8d2103ed2bc5de27881543b60c7755ceb;hb=ccf806174807ff53f58505c9b7f399cb9483abca;hp=86afd9ca5dd6c775e0aae0d3205a0b486e95cb55;hpb=e1e79af4472feb78b4ec672f768eb8fdd10670fc;p=guile-irrlicht.git diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index 86afd9c..65b24bb 100644 --- a/irrlicht/gui.scm +++ b/irrlicht/gui.scm @@ -42,7 +42,11 @@ (define-class ( ) (irr-class #:init-value "IGUIElement")) -(export ) +(define-method (get-id (element )) + (let ((getID (get-irrlicht-proc "getID" element))) + (getID element))) + +(export get-id) ;; IGUIEnvironment @@ -58,6 +62,14 @@ (let ((addButton (get-irrlicht-proc "addButton" gui-environment parent))) (addButton gui-environment rectangle parent id text tooltiptext)))) +(define-method (add-editbox! (gui-environment ) text rectangle . rest) + (let-keywords rest #f + ((border #t) + (parent (make )) + (id -1)) + (let ((addEditBox (get-irrlicht-proc "addEditBox" gui-environment parent))) + (addEditBox gui-environment text rectangle border parent id)))) + (define-method (add-image! (gui-environment ) image pos . rest) (let-keywords rest #f ((use-alpha-channel #t) @@ -67,6 +79,21 @@ (let ((addImage (get-irrlicht-proc "addImage" gui-environment parent))) (addImage gui-environment image pos use-alpha-channel parent id text)))) +(define-method (add-listbox! (gui-environment ) rectangle . rest) + (let-keywords rest #f + ((parent (make )) + (id -1) + (draw-background #f)) + (let ((addListBox (get-irrlicht-proc "addListBox" gui-environment parent))) + (addListBox gui-environment rectangle parent id draw-background)))) + +(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) @@ -87,15 +114,18 @@ (getBuiltInFont gui-environment))) (define-method (get-font (gui-environment ) filename) - (let ((getFont (get-irrlicht-proc "getFont" gui-environment))) - (getFont gui-environment filename))) + (let ((getFont (get-irrlicht-proc "getFont" gui-environment)) + (font (getFont gui-environment filename))) + (if (null-object? font) + (error "In procedure get-font: Font unavailable") + font))) (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) +(export add-button! add-editbox! add-image! add-listbox! add-scrollbar! + add-static-text! draw-all get-built-in-font get-font get-skin) ;; IGUIStaticText @@ -120,13 +150,21 @@ (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)))) -(export set-font!) +(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 @@ -141,3 +179,36 @@ (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!) + + +;; IGUIListBox +(define-class () + (irr-class #:init-value "IGUIListBox")) + +(export ) + + +;; IGUIEditBox +(define-class () + (irr-class #:init-value "IGUIEditBox")) + +(export )