Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Brig/scaling redux #88

Merged
merged 17 commits into from
Jun 22, 2018
Merged

Brig/scaling redux #88

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
17 commits
Select commit Hold shift + click to select a range
9c464f9
First pass, use dc<%> scaling for zoom.
IonoclastBrigham Apr 30, 2018
1d4310a
Resolves a contract issue in del-embed-tags!.
IonoclastBrigham May 5, 2018
a6029d7
Second pass, use dc<%> scaling for zoom.
IonoclastBrigham May 5, 2018
a32a160
Refactors zoom menu.
IonoclastBrigham May 16, 2018
c282eba
Expands zoom menu à la Firefox.
IonoclastBrigham May 18, 2018
06f613e
Adds zoom level to status bar.
IonoclastBrigham May 18, 2018
b905f89
Refactors zoom buttons to use DC zoom.
IonoclastBrigham May 18, 2018
972a77d
Void out menu separators to avoid contaminating stdout.
IonoclastBrigham May 21, 2018
ded058f
Special zoom status label for fit, hidden for 1X.
IonoclastBrigham May 23, 2018
9f7c578
Make zoom-to-fit "sticky" when resizing the window.
IonoclastBrigham May 23, 2018
557fcbe
WIP: commenting code to disable image rescaling.
IonoclastBrigham May 24, 2018
7f54917
WIP: enable dc-zoom on image load, fix centering bug.
IonoclastBrigham May 24, 2018
77aa9cc
Adds center-fit zoom mode as default when loading image.
IonoclastBrigham May 26, 2018
f9af220
First pass, reenable scrollbars for dc-zoom.
IonoclastBrigham May 27, 2018
1973e1e
Second pass, reenable scrollbars for dc-zoom.
IonoclastBrigham May 28, 2018
e51d9a6
Factors out ivy-canvas% to its own source file, more modular.
IonoclastBrigham May 28, 2018
9531217
Changes equality operator to work with booleans.
IonoclastBrigham May 29, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
208 changes: 20 additions & 188 deletions frame.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,6 @@
images/flomap
pict
pict/convert
(only-in plot/utils
clamp-real
ivl)
racket/bool
racket/class
(only-in racket/format ~r)
Expand All @@ -24,6 +21,7 @@
"embed.rkt"
"error-log.rkt"
"files.rkt"
"ivy-canvas.rkt"
"meta-editor.rkt"
"search-dialog.rkt"
"tag-browser.rkt")
Expand Down Expand Up @@ -100,12 +98,17 @@

;; Fullscreen handling ;;

(define (toggle-fullscreen canvas frame)
(define was-fullscreen? (send frame is-fullscreened?))
(define (set-fullscreen going-to-be-fullscreen?)
(define was-fullscreen? (send ivy-frame is-fullscreened?))
(unless (= was-fullscreen? going-to-be-fullscreen?)
(send ivy-frame fullscreen going-to-be-fullscreen?)
(unless macosx?
(on-fullscreen-event going-to-be-fullscreen?))))

(define (toggle-fullscreen canvas)
(define was-fullscreen? (send ivy-frame is-fullscreened?))
(define going-to-be-fullscreen? (not was-fullscreen?))
(send frame fullscreen going-to-be-fullscreen?)
(unless macosx?
(on-fullscreen-event going-to-be-fullscreen?)))
(set-fullscreen going-to-be-fullscreen?))

(define (on-fullscreen-event is-fullscreen?)
(cond [is-fullscreen?
Expand Down Expand Up @@ -973,195 +976,24 @@ along with this program. If not, see <http://www.gnu.org/licenses/>."
(send txt set-position (send txt last-position)))
(send (ivy-tag-tfield) focus))

(define (insert-tag-tfield-comma)
(send (send (ivy-tag-tfield) get-editor) insert ", "))

; forward define for use by zoom methods
(define status-bar-zoom (make-parameter #f))

(define ivy-canvas%
(class canvas%
(super-new)
(init-field paint-callback
[canvas-backgorund color-black])

(define mouse-x 0)
(define mouse-y 0)

; whether the last zoom operation was "fit"
(define fit #f)

(define/public (get-mouse-pos)
(values mouse-x mouse-y))

(define (do-on-paint)
(when paint-callback
(paint-callback this (send this get-dc))))

(define/override (on-paint)
(do-on-paint))

; proc: ((is-a?/c canvas%) (is-a?/c dc<%>) . -> . any)
(define/public (set-on-paint! proc)
(set! paint-callback proc))

(define/override (on-drop-file pathname)
; append the image to the current collection
(define-values (base name must-be-dir?) (split-path pathname))
(define directory? (directory-exists? pathname))
(cond
; empty collection
[(equal? (first (pfs)) +root-path+)
(cond [directory?
(define files
(for/fold ([lst empty])
([p (in-directory pathname)])
(if (supported-file? p)
(append lst (list p))
lst)))
(image-dir pathname)
(pfs files)
(image-path (first files))
(load-image (first files))]
[else
(image-dir base)
(pfs (list pathname))
(image-path pathname)
(load-image pathname)])]
; collection has images; appending to collection
[else
(define files
(if (directory-exists? pathname)
(for/fold ([lst empty])
([p (in-directory pathname)])
(if (supported-file? p)
(append lst (list p))
lst))
(list pathname)))
; no duplicate paths allowed!
(pfs (remove-duplicates (append (pfs) files)))
; change label because it usually isn't called until
; (load-image) is called and we want to see the changes now
(send (status-bar-position) set-label
(format "~a / ~a"
(+ (get-index (image-path) (pfs)) 1)
(length (pfs))))]))

(define/override (on-event evt)
(define type (send evt get-event-type))
(case type
; track where the mouse is
[(enter motion)
(set! mouse-x (send evt get-x))
(set! mouse-y (send evt get-y))]))

(define/override (on-char key)
(define type (send key get-key-code))
(case type
[(wheel-down)
; do nothing if we've pressed ctrl+n
(unless (equal? (image-path) +root-path+)
(send this zoom-by -0.05))]
[(wheel-up)
; do nothing if we've pressed ctrl+n
(unless (equal? (image-path) +root-path+)
(send this zoom-by 0.05))]
; osx does things a little different
[(f11) (unless macosx?
(toggle-fullscreen this ivy-frame))]
; only do something if we're fullscreened,
; since the tag bar isn't available in fullscreen anyway
[(escape) (when (and (send ivy-frame is-fullscreened?) (not macosx?))
(toggle-fullscreen this ivy-frame))]
[(left) (load-previous-image)]
[(right) (load-next-image)]
[(home) (load-first-image)]
[(end) (load-last-image)]
[(#\,) (focus-tag-tfield)
(send (send (ivy-tag-tfield) get-editor) insert ", ")]
[(#\return) (focus-tag-tfield)]))

(define/private (configure-scrollbars zoom-factor)
(let* ([img-w (send image-bmp-master get-width)]
[img-h (send image-bmp-master get-height)]
[zoomed-img-w (inexact->exact (round (* img-w zoom-factor)))]
[zoomed-img-h (inexact->exact (round (* img-h zoom-factor)))]
[client-w (send this get-width)]
[client-h (send this get-height)]
[virtual-w (max client-w zoomed-img-w)]
[virtual-h (max client-h zoomed-img-h)]
[scroll-x 0.5] ; TODO
[scroll-y 0.5]) ; TODO
(send this init-auto-scrollbars virtual-w virtual-h scroll-x scroll-y)
(send this show-scrollbars
(> zoomed-img-w client-w)
(> zoomed-img-h client-h))))

; zooms to a specific zoom-factor (1.0 == "no zoom"),
; with optional staus bar label override
(define/public (zoom-to factor [status-label #f])
(set! fit #f) ; always make sure this is cleared when setting a new zoom level
(define dc (send this get-dc))
(send dc set-scale factor factor)
(configure-scrollbars factor)
(send this refresh-now)
(send (status-bar-zoom) set-label
(cond [status-label status-label]
[(not (= factor 1.0)) (format "@ ~aX" (~r factor #:precision 2))]
[else ""])))

; zooms view by a specified increment (positive or negative)
(define/public (zoom-by inc)
(define dc (send this get-dc))
(define-values [cur-scale-x cur-scale-y]
(send dc get-scale))
(define new-scale
(clamp-real (+ cur-scale-x inc) (ivl 0.1 4.0)))
(send this zoom-to new-scale))

; adjusts zoom level so the entire image fits, and at least one dimension
; will be the same size as the window.
(define/public (zoom-to-fit)
(let* ([client-w (send this get-width)]
[client-h (send this get-height)]
[img-w (send image-bmp-master get-width)]
[img-h (send image-bmp-master get-height)]
[new-zoom (min (/ client-w img-w)
(/ client-h img-h))])
(send this zoom-to new-zoom "[Fit]")
; must set this *after* calling zoom-to, where it is reset to false
(set! fit #t)))

; only zooms out if the image is too big to fit on either dimension
(define/public (center-fit)
(let ([client-w (send this get-width)]
[client-h (send this get-height)]
[img-w (send image-bmp-master get-width)]
[img-h (send image-bmp-master get-height)])
(cond [(or (> img-w client-w)
(> img-h client-h))
(send this zoom-to-fit)]
[else (send this zoom-to 1.0)])))

(define/override (on-size width height)
(recenter-origin width height)
(if fit
(send this zoom-to-fit)
(send this refresh-now)))

(define/private (recenter-origin width height)
(define dc (send this get-dc))
(send dc set-origin
(/ width 2)
(/ height 2)))

(define/public (recenter)
(define-values [virtual-w virtual-h] (send this get-virtual-size))
(recenter-origin virtual-w virtual-h))))

(ivy-canvas
(new ivy-canvas%
[parent ivy-frame]
[label "Ivy Image Canvas"]
[style '(hscroll vscroll)]
[stretchable-height #t]
[focus-tag-tfield focus-tag-tfield]
[insert-tag-tfield-comma insert-tag-tfield-comma]
[status-bar-position status-bar-position]
[status-bar-zoom status-bar-zoom]
[set-fullscreen set-fullscreen]
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What is the purpose of passing set-fullscreen and toggle-fullscreen as initialization parameters to the canvas? Wouldn't it be more appropriate to define/public them as member functions of the class?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So if you look at what those functions actually do, you couldn't make them member functions, as-is. The two callbacks you mention, for example operate on the ivy-frame instance, which the ivy-canvas% class doesn't know anything about, per se.

We could call get-parent, but the frame may not always be the direct parent of the canvas. I'd be pretty bummed about a solution where fullscreen stopped working depending on where the canvas was in the layout hierarchy. Perhaps get-top-level-window would work here?

Really, though, the only reason the canvas wants to know about any of this at all is that it's the one intercepting the fullscreen accelerator keys. What would probably be a cleaner solution would be to expose more general on-key callbacks that can be registered from the outside, instead of the canvas knowing/caring about fullscreen stuff at all.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, I see. That makes sense.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So short answer is there's a good, technical reason for it, but there's also a couple of alternatives that might be better but will require extra work. Guidance?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I want to say that having those be member functions is the "better" approach, since get-top-level-window will return the ivy frame, in this case.

[toggle-fullscreen toggle-fullscreen]
[paint-callback (λ (canvas dc)
(send canvas set-canvas-background color-black))]))
(send (ivy-canvas) accept-drop-files #t)
Expand Down
Loading