From 13a61d62d737d15ee1f832f0bc3c73adcd8b922b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 2 Feb 2011 20:10:44 -0600 Subject: [PATCH] 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 --- collects/scribblings/gui/wxme.scrbl | 20 +-- .../gracket/image-snip-unmarshalling.rkt | 142 ++++++++++++++++++ 2 files changed, 153 insertions(+), 9 deletions(-) create mode 100644 collects/tests/gracket/image-snip-unmarshalling.rkt diff --git a/collects/scribblings/gui/wxme.scrbl b/collects/scribblings/gui/wxme.scrbl index e4926095..875dd4bd 100644 --- a/collects/scribblings/gui/wxme.scrbl +++ b/collects/scribblings/gui/wxme.scrbl @@ -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].}] diff --git a/collects/tests/gracket/image-snip-unmarshalling.rkt b/collects/tests/gracket/image-snip-unmarshalling.rkt new file mode 100644 index 00000000..cb8a4937 --- /dev/null +++ b/collects/tests/gracket/image-snip-unmarshalling.rkt @@ -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)