-
Notifications
You must be signed in to change notification settings - Fork 3
/
search-results.rkt
204 lines (176 loc) · 6.37 KB
/
search-results.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
#lang racket/base
; search-results.rkt
(require embedded-gui
file/convertible
pict
racket/class
racket/gui/base
racket/list
racket/path
"base.rkt"
"files.rkt"
"thumbnails.rkt")
(provide results-frame
display-tags
display-nil-results-alert)
(define searched-images empty)
(define results-frame
(new frame%
[label "Ivy - Tag Search Results"]
[width 700]
[height 450]))
; set the icon for the frame
(unless macosx?
(void (send results-frame set-icon logo-bmp)))
(define results-menu-bar (new menu-bar% [parent results-frame]))
(define results-menu-bar-file
(new menu%
[parent results-menu-bar]
[label "&File"]))
(define file-open-collection
(new menu-item%
[parent results-menu-bar-file]
[label "&Open as Collection"]
[shortcut #\O]
[help-string "Create a collection containing the search results."]
[callback (λ (button event)
(unless (empty? searched-images)
(send (ivy-tag-tfield) set-default-background)
(pfs searched-images)
(load-image (first searched-images))
(send results-frame show #f)))]))
(define file-add-to-collection
(new menu-item%
[parent results-menu-bar-file]
[label "Append results to c&ollection"]
[shortcut #\O]
[shortcut-prefix (if macosx? '(cmd shift) '(ctl shift))]
[help-string "Append search results to existing collection"]
[callback (λ (button event)
(unless (empty? searched-images)
(cond
; empty collection, create a new one
[(equal? (first (pfs)) (build-path "/"))
(send (ivy-tag-tfield) set-default-background)
(pfs searched-images)
(load-image (first searched-images))]
; append to the current collection
[else
(pfs (remove-duplicates (append (pfs) searched-images)))
(send (status-bar-position) set-label
(format "~a / ~a"
(+ (get-index (image-path) (pfs)) 1)
(length (pfs))))])
(send results-frame show #f)))]))
(define file-close
(new menu-item%
[parent results-menu-bar-file]
[label "Close"]
[shortcut #\W]
[help-string "Close the search results preview."]
[callback (λ (button event)
(send results-frame show #f))]))
(define btext%
(class text%
(super-new)
(define (get-snip)
(define pos (box 0))
(send this get-position pos)
(send this find-snip (unbox pos) 'after-or-none))
; ignore key presses
(define/override (on-char evt)
(void))
; only worry about left clicks
(define/override (on-event evt)
(define type (send evt get-event-type))
(case type
[(left-down)
(send this on-default-event evt)]
[(left-up)
(define snp (get-snip))
(when snp
(send this on-default-event evt)
(send snp do-callback evt))]))))
(define bsnip%
(class button-snip%
(inherit-field callback)
(super-new)
(define/public (do-callback evt)
(callback this evt))))
(define txt (new btext% [auto-wrap #t]))
(define ecanvas
(new editor-canvas%
[parent results-frame]
[editor txt]
[style '(auto-hscroll auto-vscroll no-focus)]))
(send ecanvas set-canvas-background color-black)
(define (display-nil-results-alert)
(message-box "Ivy - No Images Found"
"Sorry! No images with that tag combination have been found."
#f
(list 'ok 'stop)))
; tell the user we're preparing results preview
(define prep-notification
(new frame%
[label "Ivy - Preparing Search Preview"]
[width 200]
[height 40]
[style '(no-resize-border no-caption no-system-menu)]))
; set the icon for the frame
(unless macosx?
(void (send prep-notification set-icon logo-bmp)))
(define prep-msg
(new message%
[parent prep-notification]
[label "Preparing search result preview, please wait..."]))
; search for the tags and display everything
(define (display-tags imgs)
(cond
[(empty? imgs)
(display-nil-results-alert)]
[else
(send prep-notification center 'both)
(send prep-notification show #t)
; remove everything from the text so we can reuse it
(send txt erase)
(define imgs-str (sort (map path->string imgs) string<?))
(define thumbs-path (map path->md5 imgs-str))
(set! searched-images imgs)
; generate the thumbnail in case it does not exist
(generate-thumbnails
(filter path-string?
(for/list ([thumb (in-list thumbs-path)]
[path-str (in-list imgs-str)])
(if (file-exists? thumb)
#f
path-str))))
(for ([thumb-str (in-list thumbs-path)]
[img-path (in-list imgs)]
[img-str (in-list imgs-str)])
(define img-name (string-truncate (path->string (file-name-from-path img-str)) 15))
(define thumb+name
(pict->bitmap
(vc-append
(bitmap thumb-str)
(text img-name (list color-black)))))
(define in (open-input-bytes (convert thumb+name 'png-bytes)))
(send txt insert (new bsnip%
[images (cons in in)]
[callback
(λ (snp evt)
(pfs imgs)
(send (ivy-tag-tfield) set-default-background)
(load-image img-path))]))
(close-input-port in))
; collect garbage that we've made from generating
; the search results
(collect-garbage 'major)
(send prep-notification show #f)
; set the cursor position to the very beginning
(send txt set-position 0 'same #f #t)
; and scroll back to the top of the window
(send txt scroll-to-position 0)
; make sure the displayed images reflect any new searches
(send ecanvas refresh)
(send results-frame center 'both)
(send results-frame show #t)]))