From ada6a5b08d39f176e6b98aae091844d24fc3ed04 Mon Sep 17 00:00:00 2001 From: Lehi Toskin Date: Fri, 9 Dec 2016 13:17:05 -0800 Subject: [PATCH] Add logo to frames, move code around --- base.rkt | 12 ++++++++++++ db-statistics.rkt | 13 +++++++------ frame.rkt | 12 ------------ tag-browser.rkt | 19 +++++++++---------- 4 files changed, 28 insertions(+), 28 deletions(-) diff --git a/base.rkt b/base.rkt index e03bbd8..db5b033 100644 --- a/base.rkt +++ b/base.rkt @@ -107,6 +107,18 @@ str (substring str 0 n))) +; awww yeah... so oldskool... +(define (remove-children parent kids) + (when (> (length kids) 0) + (send parent delete-child (car kids)) + (remove-children parent (cdr kids)))) + +; just check out those tail recursions... +(define (add-children parent kids) + (when (> (length kids) 0) + (send parent add-child (car kids)) + (add-children parent (cdr kids)))) + ; objects that will be used extensively in transparency-grid (define dgray-color (make-object color% 128 128 128)) (define lgray-color (make-object color% 204 204 204)) diff --git a/db-statistics.rkt b/db-statistics.rkt index 499e9f8..ea85965 100644 --- a/db-statistics.rkt +++ b/db-statistics.rkt @@ -4,7 +4,9 @@ racket/format racket/gui/base racket/list - "db.rkt") + "base.rkt" + "db.rkt" + "files.rkt") (provide stats-frame update-stats) (define stats-frame (new frame% @@ -12,15 +14,14 @@ [width 800] [height 100])) +(unless (macosx?) + (send stats-frame set-icon (read-bitmap logo))) + (define stats-vpanel (new vertical-panel% [parent stats-frame] [alignment '(left center)])) -(define (remove-children) - (for ([child (in-list (send stats-vpanel get-children))]) - (send stats-vpanel delete-child child))) - (define (greater lst [num 0] [name ""]) (cond [(empty? lst) (values num name)] [else @@ -62,5 +63,5 @@ (void)) (define (update-stats) - (remove-children) + (remove-children stats-vpanel (send stats-vpanel get-children)) (create-children)) diff --git a/frame.rkt b/frame.rkt index 612882a..834bb7c 100644 --- a/frame.rkt +++ b/frame.rkt @@ -60,18 +60,6 @@ ;; Fullscreen handling ;; -; awww yeah... so oldskool... -(define (remove-children parent kids) - (when (> (length kids) 0) - (send parent delete-child (car kids)) - (remove-children parent (cdr kids)))) - -; just check out those tail recursions... -(define (add-children parent kids) - (when (> (length kids) 0) - (send parent add-child (car kids)) - (add-children parent (cdr kids)))) - (define (toggle-fullscreen canvas frame) (define was-fullscreen? (send frame is-fullscreened?)) (define going-to-be-fullscreen? (not was-fullscreen?)) diff --git a/tag-browser.rkt b/tag-browser.rkt index db3c72b..eeb3842 100644 --- a/tag-browser.rkt +++ b/tag-browser.rkt @@ -5,7 +5,8 @@ racket/gui/base racket/string "base.rkt" - "db.rkt") + "db.rkt" + "files.rkt") (provide show-tag-browser) (define browser-frame @@ -14,6 +15,10 @@ [width 800] [height 500])) +; set the icon for the frame +(unless (macosx?) + (send browser-frame set-icon (read-bitmap logo))) + ; begin menu bar definitions (define browser-menu-bar @@ -144,9 +149,7 @@ ; 15 the tallest any column can be (define tag-grid (grid-list (image-taglist img-label) 15)) ; remove any children vpanel might have - (define children (send edit-tags-check-hpanel get-children)) - (unless (null? children) - (map (λ (child) (send edit-tags-check-hpanel delete-child child)) children)) + (remove-children edit-tags-check-hpanel (send edit-tags-check-hpanel get-children)) ; loop over the tag sections (for ([tag-section (in-list tag-grid)]) (define vpanel-section @@ -259,9 +262,7 @@ (generate-thumbnails (list img-str))) (send thumb-bmp load-file thumb-path) ; remove old thumb-button - (define vpanel-children (send thumb-vpanel get-children)) - (unless (null? vpanel-children) - (send thumb-vpanel delete-child (car (send thumb-vpanel get-children)))) + (remove-children thumb-vpanel (send thumb-vpanel get-children)) ; generate new thumb-button (new button% [parent thumb-vpanel] @@ -303,9 +304,7 @@ (send tag-lbox clear) (send img-lbox clear) ; remove old thumb-button - (define vpanel-children (send thumb-vpanel get-children)) - (unless (null? vpanel-children) - (send thumb-vpanel delete-child (car (send thumb-vpanel get-children)))) + (remove-children thumb-vpanel (send thumb-vpanel get-children)) ; get every tag in the database (define tag-labels (sort (table-column 'tags 'Tag_Label) string