view,image: handle #f height case with 'fit

Bogdanp · Feb 16, 2024 · 66f8be4 · 66f8be4
1 parent 6749695
commit 66f8be4
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 14 deletions.
diff --git a/examples/image.rkt b/examples/image.rkt
@@ -8,7 +8,13 @@
 (define @path (@ #f))
 (define @width (@ 200))
 (define @height (@ 200))
-(define @size (obs-combine list @width @height))
+(define @size
+  (obs-combine
+   (λ (w h)
+     (list
+      (and (> w 0) w)
+      (and (> h 0) h)))
+   @width @height))
 (define @mode (@ 'fit))
 
 ;; The contract on `image' requires the path to be a valid filesystem
@@ -38,12 +44,12 @@
         (@mode . λ:= . (compose1 string->symbol string-downcase)))
        (slider
         #:label "Width"
-        #:min-value 1
+        #:min-value 0
         #:max-value 800
         @width (λ:= @width))
        (slider
         #:label "Height"
-        #:min-value 1
+        #:min-value 0
         #:max-value 800
         @height (λ:= @height)))
       (image (@path . ~> . path-fallback) #:size @size #:mode @mode))]

diff --git a/gui-easy-lib/gui/easy/private/view/image.rkt b/gui-easy-lib/gui/easy/private/view/image.rkt
@@ -78,31 +78,31 @@
       (match size
         ['(#f #f) bmp]
         [`(,w ,h)
-         (define-values (sw sh)
+         (define-values (src-w src-h)
            (values
             (send bmp get-width)
             (send bmp get-height)))
-         (define r (/ sh sw))
+         (define aspect-ratio (/ src-h src-w))
          (define-values (pw ph)
            (values
-            (if w w (exact-ceiling (/ h r)))      ; in case of either w or h is #f
-            (if h h (* w r))))
-         (define-values (w* h*)
+            (or w (exact-ceiling (/ h aspect-ratio)))
+            (or h (exact-ceiling (* w aspect-ratio)))))
+         (define-values (dst-w dst-h)
            (case mode
              [(fill)
               (values pw ph)]
 
              [(fit)
-              (if (>= (* pw r) ph)
-                  (values (exact-ceiling (/ ph r)) ph)
-                  (values pw (exact-ceiling (* pw r))))]))
+              (if (>= (* pw aspect-ratio) ph)
+                  (values (exact-ceiling (/ ph aspect-ratio)) ph)
+                  (values pw (exact-ceiling (* pw aspect-ratio))))]))
          (define bmp-dc
            (new gui:bitmap-dc%
-                [bitmap (gui:make-bitmap w* h* #:backing-scale backing-scale)]))
+                [bitmap (gui:make-bitmap dst-w dst-h #:backing-scale backing-scale)]))
          (send bmp-dc draw-bitmap-section-smooth
                bmp
-               0 0 w* h*
-               0 0 sw sh)
+               0 0 dst-w dst-h
+               0 0 src-w src-h)
          (send bmp-dc get-bitmap)]))))
 
 (define (image @image