Skip to content

Commit

Permalink
Add support for "image" view in displaying bitmap% in memory (#49)
Browse files Browse the repository at this point in the history
  • Loading branch information
xioi authored Feb 10, 2024
1 parent 2122661 commit d8b3707
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 19 deletions.
38 changes: 20 additions & 18 deletions gui-easy-lib/gui/easy/private/view/image.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -15,23 +15,23 @@
(define backing-scale
(gui:get-display-backing-scale))

(struct props (path size mode))
(struct props (image size mode))

(define image%
(class* object% (view<%>)
(init-field @path @size @mode)
(init-field @image @size @mode)
(super-new)

(define @props
(obs-combine props @path @size @mode))
(obs-combine props @image @size @mode))

(define/public (dependencies)
(filter obs? (list @props)))

(define/public (create parent)
(match-define (props path size mode)
(match-define (props image size mode)
(peek @props))
(define bmp (read-bitmap path))
(define bmp (read-bitmap image))
(define bmp/scaled (scale bmp size mode))
(define the-canvas
(new (context-mixin gui:canvas%)
Expand All @@ -45,32 +45,34 @@
(let ([bmp (send self get-context 'bmp/scaled bmp/scaled)])
(send dc draw-bitmap bmp 0 0)))]))
(begin0 the-canvas
(send the-canvas set-context* 'path path 'bmp bmp 'bmp/scaled bmp/scaled)))
(send the-canvas set-context* 'image image 'bmp bmp 'bmp/scaled bmp/scaled)))

(define/public (update v what val)
(case/dep what
[@props
(define last-path
(send v get-context 'path))
(match-define (props path size mode) val)
(define last-image
(send v get-context 'image))
(match-define (props image size mode) val)
(define bmp
(if (equal? path last-path)
(if (equal? image last-image)
(send v get-context 'bmp)
(read-bitmap path)))
(read-bitmap image)))
(define bmp/scaled
(scale bmp size mode))
(send v set-context* 'path path 'bmp bmp 'bmp/scaled bmp/scaled)
(send v set-context* 'image image 'bmp bmp 'bmp/scaled bmp/scaled)
(send v min-width (send bmp/scaled get-width))
(send v min-height (send bmp/scaled get-height))
(send v refresh-now)]))

(define/public (destroy v)
(send v clear-context))

(define (read-bitmap path)
(gui:read-bitmap
#:try-@2x? #t
path))
(define (read-bitmap image)
(if (gui:is-a? image gui:bitmap%)
image
(gui:read-bitmap
#:try-@2x? #t
image)))

(define (scale bmp size mode)
(match size
Expand Down Expand Up @@ -99,10 +101,10 @@
0 0 sw sh)
(send bmp-dc get-bitmap)]))))

(define (image @path
(define (image @image
#:size [@size (obs '(#f #f))]
#:mode [@mode (obs 'fit)])
(new image%
[@path (->obs @path)]
[@image (->obs @image)]
[@size (->obs @size)]
[@mode (->obs @mode)]))
2 changes: 1 addition & 1 deletion gui-easy-lib/gui/easy/view.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@
#:min-size (maybe-obs/c size/c)
#:stretch (maybe-obs/c stretch/c))
view/c)]
[image (->* ((maybe-obs/c path-string?))
[image (->* ((maybe-obs/c (or/c path-string? (is-a?/c gui:bitmap%))))
(#:size (maybe-obs/c size/c)
#:mode (maybe-obs/c (or/c 'fit 'fill)))
view/c)]
Expand Down

0 comments on commit d8b3707

Please sign in to comment.