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

adjust the wxme reader so that it now creates image-snip%s when it finds image-snips in file

Browse Source 
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
(cherry picked from commit 0fce29f552)
This commit is contained in:
Robby Findler 2011-02-02 20:10:44 -06:00 committed by Eli Barzilay
parent 9215e3c401
commit 4e9b5bcaef
5 changed files with 219 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/racket/snip/private/snip.rkt
View File

@ -49,7 +49,8 @@
readable-snip<%>
image-type?)
image-type?
int->img-type)
;; these are used only in contracts
;; we don't want the real definitions b/c they require the gui
@ -826,6 +827,9 @@
(values filename
(int->img-type type)
#f))])
;; the call to create an image-snip% object
;; here should match the way that super-make-object
;; is called in wxme/image.rkt
(let ([snip (make-object image-snip%
(if (equal? loadfile #"")
#f

20
collects/scribblings/gui/wxme.scrbl
View File

@ -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
View 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)

59
collects/wxme/image.rkt
View File

@ -1,11 +1,62 @@
#lang racket/base
(require racket/class
racket/snip
"private/class-help.ss")
(module image mzscheme
(require mzlib/class
"private/class-help.ss")
(provide image%)
(provide image%)
#|
This code is a bit strange in order to attempt to
preserve backwards compatibility with pre-5.1 versions.
The old version is:
(define image%
(class object%
(init-accessible filename data w h dx dy)
(super-new))))
The things I attempted to preserve:
- image% as a class whose objects can be tested with is-a?
- the get-* methods that init-accessible provides; with the exception
of get-filename, which is now the image-snip% method, these are done
still with init-accessible
The get-filename method changed, tho: it now returns a path (it returned
bytes before)
- the constructor arity (there are now additional optional arguments that
wxme supplies to be able to call super-make-object)
The main change is to make this file depend on racket/snip so that
image% can be a subclass of image-snip% and thus work with things like
the 2htdp/universe libraries (in executables)
|#
(define image%
(class image-snip%
(init filename)
(init-accessible data w h dx dy)
(init [relative 1] [type 'unknown])
;; the call to super-make-object is intended to mimic the way that racket/snip/private/snip.rkt
;; creates an image-snip% object in the image-snip-class% class's read method
(let ([data (get-data)])
(super-make-object
(if data
(let-values ([(in out) (make-pipe)])
(thread (λ () (display data out) (close-output-port out)))
in)
(if (bytes? filename)
(bytes->path filename)
#f))
(if data 'unknown/alpha type)
(positive? relative)
(and data #t)))
(inherit resize set-offset)
(resize (get-w) (get-h))
(set-offset (get-dx) (get-dy))))

8
collects/wxme/wxme.rkt
View File

@ -8,6 +8,7 @@
mzlib/list
scheme/gui/dynamic
syntax/modread
(only racket/snip/private/snip int->img-type)
"image.ss"
"editor.ss"
"private/compat.ss")
@ -449,7 +450,7 @@
[h (read-inexact who port vers "image-snip height")]
[dx (read-inexact who port vers "image-snip x-offset")]
[dy (read-inexact who port vers "image-snip y-offset")]
[rel? (read-integer who port vers "image-snip relative?")])
[relative (read-integer who port vers "image-snip relative?")])
(let ([data
(and (and (equal? filename #"")
(cvers . > . 1)
@ -466,7 +467,10 @@
(loop (add1 i))))))))])
(if (header-plain-text? header)
#"."
(make-object image% (if data #f filename) data w h dx dy)))))]
(make-object image%
(if data #f filename)
data w h dx dy
relative (int->img-type type))))))]
[else
(if (header-skip-content? header)
#f