X-Git-Url: https://git.jsancho.org/?p=guile-irrlicht.git;a=blobdiff_plain;f=examples%2F05-user-interface.scm;fp=examples%2F05-user-interface.scm;h=83740778e23d14859655b76c64d265dee99fb9d4;hp=e723f9486c24b7b50fbb3f5631301755d1b408b8;hb=bba89dd95bb2a8a96ff79caf5925319841bd7aeb;hpb=2d5101a54220c88c752ea4b5e54891f5a6e31678 diff --git a/examples/05-user-interface.scm b/examples/05-user-interface.scm index e723f94..8374077 100644 --- a/examples/05-user-interface.scm +++ b/examples/05-user-interface.scm @@ -134,45 +134,52 @@ #:word-wrap #f #:parent window))))) +(define (on-scrollbar-event id caller) + (if (= id GUI-ID-TRANSPARENCY-SCROLLBAR) + (let ((pos (get-position caller))) + (set-skin-transparency pos (get-skin gui-env)))) + #f) + +(define (on-button-event id) + (cond ((= id GUI-ID-QUIT-BUTTON) + ;; quit + (close-device device) + #t) + + ((= id GUI-ID-NEW-WINDOW-BUTTON) + ;; new-window + (open-new-window) + #t) + + ((= id GUI-ID-FILE-OPEN-BUTTON) + ;; open file + (add-item! listbox "File open") + (add-file-open-dialog! gui-env + #:title "Please choose a file" + #:restore-cwd #t) + #t) + + (else #f))) + +(define (on-file-selected-event caller) + (add-item! listbox (get-file-name caller)) + #f) + +(define (on-gui-event event) + (let* ((caller (get-event-gui-caller event)) + (id (get-id caller)) + (event-type (get-event-gui-type event))) + (cond ((equal? event-type 'scrollbar-changed) + (on-scrollbar-event id caller)) + ((equal? event-type 'button-clicked) + (on-button-event id)) + ((equal? event-type 'file-selected) + (on-file-selected-event caller)) + (else #f)))) + (define (on-event event) (if (equal? (get-event-type event) 'gui-event) - (let* ((caller (get-event-gui-caller event)) - (id (get-id caller)) - (event-type (get-event-gui-type event))) - - (cond ((equal? event-type 'scrollbar-changed) - (if (= id GUI-ID-TRANSPARENCY-SCROLLBAR) - (let ((pos (get-position caller))) - (set-skin-transparency pos (get-skin gui-env)))) - #f) - - ((equal? event-type 'button-clicked) - (cond ((= id GUI-ID-QUIT-BUTTON) - ;; quit - (close-device device) - #t) - - ((= id GUI-ID-NEW-WINDOW-BUTTON) - ;; new-window - (open-new-window) - #t) - - ((= id GUI-ID-FILE-OPEN-BUTTON) - ;; open file - (add-item! listbox "File open") - (add-file-open-dialog! gui-env - #:title "Please choose a file" - #:restore-cwd #t) - #t) - - (else #f))) - - ((equal? event-type 'file-selected) - (add-item! listbox (get-file-name caller)) - #f) - - (else #f))) - + (on-gui-event event) #f)) (set-event-receiver! device (make-event-receiver on-event))