suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove dependency on racket/snip (use file/convertible instead

Browse Source 
of a direct reference to bitmap-snip%)
This commit is contained in:
Robby Findler 2014-08-05 08:32:13 -05:00
parent fd67feddab
commit 8ec1fb6f7a
2 changed files with 22 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/pict-pkgs/pict-lib/info.rkt
View File

@ -5,7 +5,7 @@
(define deps '("scheme-lib" (define deps '("scheme-lib"
"base" "base"
"compatibility-lib" "compatibility-lib"
"draw-lib" "snip-lib")) "draw-lib"))
(define build-deps '("rackunit-lib")) (define build-deps '("rackunit-lib"))
(define pkg-desc "implementation (no documentation) part of \"pict\"") (define pkg-desc "implementation (no documentation) part of \"pict\"")

39
pkgs/pict-pkgs/pict-lib/texpict/utils.rkt
View File

@ -4,8 +4,8 @@
racket/class racket/class
racket/draw racket/draw
racket/math racket/math
file/convertible
racket/gui/dynamic racket/gui/dynamic
racket/snip
"mrpict.rkt") "mrpict.rkt")
;; Utilities for use with mrpict ;; Utilities for use with mrpict
@ -105,7 +105,7 @@
pict?)] pict?)]
[bitmap (-> (or/c path-string? [bitmap (-> (or/c path-string?
(is-a?/c bitmap%) (is-a?/c bitmap%)
(is-a?/c image-snip%)) convertible?)
pict?)] pict?)]
) )
@ -1005,22 +1005,25 @@
(define bitmap-draft-mode (make-parameter #f (lambda (x) (and x #t)))) (define bitmap-draft-mode (make-parameter #f (lambda (x) (and x #t))))
(define (bitmap filename) (define (bitmap arg)
(let ([bm (cond (define bm
[(bitmap-draft-mode) #f] (cond
[(filename . is-a? . bitmap%) filename] [(bitmap-draft-mode) #f]
[(path-string? filename) (make-object bitmap% filename 'unknown/alpha)] [(arg . is-a? . bitmap%) arg]
[(and (gui-available?) [(path-string? arg) (make-object bitmap% arg 'unknown/alpha)]
(filename . is-a? . (gui-dynamic-require 'image-snip%))) [(convertible? arg)
(send filename get-bitmap)])]) (define bytes (convert arg 'png-bytes #f))
(if (and bm (send bm ok?)) (and bytes (read-bitmap (open-input-bytes bytes)))]))
(let ([w (send bm get-width)] (cond
[h (send bm get-height)]) [(and bm (send bm ok?))
(dc (define w (send bm get-width))
(lambda (dc x y) (define h (send bm get-height))
(send dc draw-bitmap bm x y 'solid black-color (send bm get-loaded-mask))) (dc
w h)) (λ (dc x y)
(frame (inset (colorize (text "bitmap failed") "red") 2))))) (send dc draw-bitmap bm x y 'solid black-color (send bm get-loaded-mask)))
w h)]
[else
(frame (inset (colorize (text "bitmap failed") "red") 2))]))
(define find-brush (define find-brush
(lambda (color [style 'solid]) (lambda (color [style 'solid])