adjust the wxme reader so that it now creates image-snip%s when it finds image-snips in file
it used to create image% objects that were simple containers for the data in the file; the change _should_ be backwards compatibile; the only know incompatibility is that the get-filename method now returns a path instead of bytes (this is to match the image-snip% class) closes PR 1168 please merge to the 5.1 release branch original commit: 0fce29f552eeef416bfb66459123614518f02513
This commit is contained in:
parent
f0f7137803
commit
13a61d62d7
|
@ -3,6 +3,7 @@
|
|||
(for-label wxme
|
||||
wxme/editor
|
||||
wxme/image
|
||||
racket/snip
|
||||
(except-in wxme/comment reader)
|
||||
(except-in wxme/xml reader)
|
||||
(except-in wxme/scheme reader)
|
||||
|
@ -302,7 +303,7 @@ Several compatibility mappings are installed automatically for the
|
|||
@racketmodname[wxme] library. They correspond to popular graphical
|
||||
elements supported by various versions of DrRacket, including comment
|
||||
boxes, fractions, XML boxes, Racket boxes, text boxes, and images
|
||||
generated by the ``world'' and ``image'' teachpacks (or, more
|
||||
generated by the @racketmodname[htdp/image] teachpack (or, more
|
||||
generally, from @racketmodname[mrlib/cache-image-snip]), and test-case
|
||||
boxes.
|
||||
|
||||
|
@ -323,7 +324,8 @@ special-comment content is the readable instance. XML, Racket, and
|
|||
text boxes similarly produce instances of @racket[editor%] and
|
||||
@racket[readable<%>] that expand in the usual way; see
|
||||
@racketmodname[wxme/xml], @racketmodname[wxme/scheme], and
|
||||
@racket[wxme/text]. Images from the ``world'' and ``image'' teachpacks
|
||||
@racket[wxme/text]. Images from the
|
||||
@racketmodname[htdp/image] teachpack
|
||||
are packaged as instances of @racket[cache-image%] from the
|
||||
@racketmodname[wxme/cache-image] library. Test-case boxes are packaged
|
||||
as instances of @racket[test-case%] from the
|
||||
|
@ -353,14 +355,14 @@ editor's content.}
|
|||
|
||||
@defmodule[wxme/image]
|
||||
|
||||
@defclass[image% object% ()]{
|
||||
@defclass[image% image-snip% ()]{
|
||||
|
||||
Instantiated for images in a @tech{WXME} stream in text mode.
|
||||
|
||||
@defmethod[(get-filename) (or/c bytes? false/c)]{
|
||||
|
||||
Returns a filename as bytes, or @racket[#f] if data is available
|
||||
instead.}
|
||||
This class can just be treated like @racket[image-snip%] and should
|
||||
behave just like it, except it has the methods below in addition
|
||||
in case old code still needs them. In other words, the methods
|
||||
below are provided for backwards compatibility with earlier
|
||||
verisons of Racket.
|
||||
|
||||
@defmethod[(get-data) (or/c bytes? false/c)]{
|
||||
|
||||
|
@ -543,7 +545,7 @@ rational numbers.}]
|
|||
@defthing[reader (is-a?/c snip-reader<%>)]{
|
||||
|
||||
A text-mode reader for images in a WXME stream generated by the
|
||||
``image'' and ``world'' teachpacks---or, more generally, by
|
||||
@racketmodname[htdp/image] teachpack---or, more generally, by
|
||||
@racketmodname[mrlib/cache-image-snip].}]
|
||||
|
||||
|
||||
|
|
142
collects/tests/gracket/image-snip-unmarshalling.rkt
Normal file
142
collects/tests/gracket/image-snip-unmarshalling.rkt
Normal file
|
@ -0,0 +1,142 @@
|
|||
#lang racket/gui
|
||||
(require wxme
|
||||
wxme/image)
|
||||
|
||||
#|
|
||||
|
||||
This file tests the wxme image-snip reader against the normal
|
||||
image-snip reader (ie image-snip-class%'s read method)
|
||||
|
||||
It creates a bunch of different image-snip% objects
|
||||
(the try-perms and below functions)
|
||||
and then feeds them thru both paths to get two new image snips
|
||||
(in the beginning of test-wxme-image-snip-reader/proc)
|
||||
and compares a bunch of properties of them
|
||||
(the end of that function).
|
||||
|
||||
|#
|
||||
|
||||
(define-syntax (test-wxme-image-snip-reader stx)
|
||||
(syntax-case stx ()
|
||||
[(_ is)
|
||||
(with-syntax ([line (syntax-line stx)])
|
||||
#'(test-wxme-image-snip-reader/proc line is))]))
|
||||
|
||||
(define tests 0)
|
||||
(define (test-wxme-image-snip-reader/proc line is)
|
||||
(set! tests (+ tests 1))
|
||||
(define t (new text%))
|
||||
(send t insert is)
|
||||
(define sp (open-output-string))
|
||||
(void (send t save-port sp))
|
||||
(define wp (wxme-port->port (open-input-string (get-output-string sp))))
|
||||
(define wxme-is (read-char-or-special wp))
|
||||
|
||||
(define t2 (new text%))
|
||||
(send t2 insert-port (open-input-string (get-output-string sp)))
|
||||
(define copy-is (send t2 find-first-snip))
|
||||
|
||||
(define (warn . args)
|
||||
(fprintf (current-error-port)
|
||||
(string-append (format "FAILED test-wxme-image-snip-reader.rkt line ~a: " line)
|
||||
(apply format args))))
|
||||
|
||||
(define-syntax-rule (cmp mtd) (cmp/proc (λ (x) (send x mtd)) 'mtd))
|
||||
(define (cmp/proc call-mtd mtd)
|
||||
(let ([is-ans (call-mtd is)]
|
||||
[wxme-is-ans (call-mtd wxme-is)]
|
||||
[copy-is-ans (call-mtd copy-is)])
|
||||
(unless (same? copy-is-ans wxme-is-ans)
|
||||
(warn "~a returned different results; copy-is: ~s wxme-is: ~s\n"
|
||||
mtd
|
||||
copy-is-ans
|
||||
wxme-is-ans))
|
||||
#;
|
||||
(unless (same? is-ans copy-is-ans)
|
||||
(warn "~a returned different results; is: ~s copy-is: ~s\n"
|
||||
mtd
|
||||
is-ans
|
||||
copy-is-ans))))
|
||||
|
||||
(when (is-a? is image%)
|
||||
(warn "the input image-snip% is an image%\n"))
|
||||
|
||||
(unless (is-a? wxme-is image%)
|
||||
(warn "new image snip is not an image%\n"))
|
||||
|
||||
(cmp get-filename)
|
||||
(cmp get-filetype)
|
||||
(cmp get-bitmap)
|
||||
(cmp get-bitmap-mask))
|
||||
|
||||
(define (same? x y)
|
||||
(cond
|
||||
[(and (is-a? x bitmap%)
|
||||
(is-a? y bitmap%))
|
||||
(and (= (send x get-width)
|
||||
(send y get-width))
|
||||
(= (send x get-height)
|
||||
(send y get-height))
|
||||
(= (send x get-depth)
|
||||
(send y get-depth))
|
||||
(check? (bitmap->bytes x #f)
|
||||
(bitmap->bytes y #f)
|
||||
'bitmap/#f)
|
||||
(check? (bitmap->bytes x #t)
|
||||
(bitmap->bytes y #t)
|
||||
'bitmap/#t))]
|
||||
[else (equal? x y)]))
|
||||
|
||||
|
||||
(define (check? a b what)
|
||||
(cond
|
||||
[(equal? a b) #t]
|
||||
[else
|
||||
;(fprintf (current-error-port) "checking ~s, doesn't match\n~s\nvs\n~s\n\n" what a b)
|
||||
#f]))
|
||||
|
||||
(define (bitmap->bytes bmp alpha?)
|
||||
(define w (send bmp get-width))
|
||||
(define h (send bmp get-height))
|
||||
(define bytes (make-bytes (* 4 w h) 0))
|
||||
(send bmp get-argb-pixels 0 0 w h bytes alpha?)
|
||||
bytes)
|
||||
|
||||
(define (try-perms files kinds relative-path?s inline?s)
|
||||
(for* ([file (in-list files)]
|
||||
[kind (in-list kinds)]
|
||||
[relative-path? (in-list relative-path?s)]
|
||||
[inline? (in-list inline?s)])
|
||||
(test-wxme-image-snip-reader (make-object image-snip% file kind relative-path? inline?))))
|
||||
|
||||
(try-perms (list (collection-file-path "b-run.png" "icons"))
|
||||
'(unknown unknown/mask unknown/alpha
|
||||
png png/mask png/alpha)
|
||||
'(#f)
|
||||
'(#f #t))
|
||||
|
||||
(parameterize ([current-directory (collection-path "icons")])
|
||||
(try-perms (list "b-run.png")
|
||||
'(unknown unknown/mask unknown/alpha
|
||||
png png/mask png/alpha)
|
||||
'(#f)
|
||||
'(#f #t)))
|
||||
|
||||
(define (draw-circle bm)
|
||||
(define bdc (make-object bitmap-dc% bm))
|
||||
(send bdc set-smoothing 'smoothed)
|
||||
(send bdc set-brush "red" 'solid)
|
||||
(send bdc draw-ellipse 1 1 8 8)
|
||||
(send bdc set-bitmap #f))
|
||||
|
||||
(let ([bm (make-bitmap 10 10 #f)])
|
||||
(draw-circle bm)
|
||||
(test-wxme-image-snip-reader (make-object image-snip% bm))
|
||||
(test-wxme-image-snip-reader (make-object image-snip% bm #f))
|
||||
(test-wxme-image-snip-reader (make-object image-snip% bm bm)))
|
||||
|
||||
(let ([bm (make-bitmap 10 10)])
|
||||
(draw-circle bm)
|
||||
(test-wxme-image-snip-reader (make-object image-snip% bm)))
|
||||
|
||||
(printf "ran ~a tests\n" tests)
|
Loading…
Reference in New Issue
Block a user