From bba89dd95bb2a8a96ff79caf5925319841bd7aeb Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Thu, 11 Jun 2020 09:02:29 +0200 Subject: [PATCH] split on-event --- examples/05-user-interface.scm | 81 ++++++++++++++++++---------------- 1 file changed, 44 insertions(+), 37 deletions(-) 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)) -- 2.39.5