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

added support for examples that don't return images

Browse Source 
svn: r16626
This commit is contained in:
Robby Findler 2009-11-08 23:59:07 +00:00
parent 3e51bc7199
commit 155dc95f11
4 changed files with 121 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/teachpack/2htdp/scribblings/image-gen.ss
View File

@ -1,6 +1,7 @@
#lang scheme/gui
(require 2htdp/private/image-more)
(require 2htdp/private/image-more
mrlib/image-core)
(define-namespace-anchor anchor)
(define ns (namespace-anchor->namespace anchor))
@ -25,20 +26,33 @@
(define mapping '())
(define (handle-image exp)
(let* ([i (length mapping)]
[fn (format "~a.png" i)])
(printf "saving ~s\n" exp)
(set! mapping (cons (list exp fn) mapping))
(parameterize ([current-namespace image-ns])
(save-image (eval exp)
(build-path "img" fn)))))
(printf ".") (flush-output)
(let ([i (length mapping)])
(let ([result (parameterize ([current-namespace image-ns]) (eval exp))])
(cond
[(image? result)
(let ([fn (format "~a.png" i)])
(set! mapping (cons `(list ',exp 'image ,fn) mapping))
(save-image result (build-path "img" fn)))]
[else
(unless (equal? result (read/write result))
(error 'handle-image "expression ~s produced ~s, which I can't write"
exp result))
(set! mapping (cons `(list ',exp 'val ,result) mapping))]))))
(define (read/write result)
(let-values ([(in out) (make-pipe)])
(thread (λ () (write result out) (close-output-port out)))
(read in)))
(for-each handle-image expressions)
(printf "\n")
(call-with-output-file "image-toc.ss"
(λ (port)
(fprintf port "#lang scheme/base\n(provide mapping)\n")
(fprintf port ";; this file is generated by image-gen.ss -- do not edit\n\n")
(fprintf port ";; this file is generated by image-gen.ss -- do not edit\n;; note that the file that creates this file depends on this file\n;; it is always safe to simply define (and provide) mapping as the empty list\n\n")
(pretty-print
`(define mapping (list ,@(map (λ (l) `(list ',(car l) ,(cadr l))) mapping)))
`(define mapping (list ,@mapping))
port))
#:exists 'truncate)

78
collects/teachpack/2htdp/scribblings/image-toc.ss
View File

@ -1,9 +1,25 @@
#lang scheme/base
(provide mapping)
;; this file is generated by image-gen.ss -- do not edit
;; note that the file that creates this file depends on this file
;; it is always safe to simply define (and provide) mapping as the empty list
(define mapping
(list
(list
'(image-height
(overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple")))
'val
60)
(list '(image-height (circle 30 "solid" "orange")) 'val 60)
(list '(image-height (ellipse 30 40 "solid" "orange")) 'val 40)
(list
'(image-width
(beside (circle 20 "solid" "orange") (circle 20 "solid" "purple")))
'val
80)
(list '(image-width (circle 30 "solid" "orange")) 'val 60)
(list '(image-width (ellipse 30 40 "solid" "orange")) 'val 30)
(list
'(beside/places
"bottom"
@ -11,16 +27,18 @@
(frame (ellipse 20 50 "solid" "mediumslateblue"))
(ellipse 20 30 "solid" "slateblue")
(ellipse 20 10 "solid" "navy"))
'image
"38.png")
(list '(frame (ellipse 20 20 "outline" "black")) "37.png")
(list '(ellipse 60 60 "solid" "blue") "36.png")
(list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) "35.png")
(list '(ellipse 40 60 "solid" "blue") "34.png")
(list '(scale 2 (ellipse 20 30 "solid" "blue")) "33.png")
(list '(rotate 5 (rectangle 50 50 "outline" "black")) "32.png")
(list '(rotate 45 (ellipse 60 20 "solid" "olivedrab")) "31.png")
(list '(frame (ellipse 20 20 "outline" "black")) 'image "37.png")
(list '(ellipse 60 60 "solid" "blue") 'image "36.png")
(list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) 'image "35.png")
(list '(ellipse 40 60 "solid" "blue") 'image "34.png")
(list '(scale 2 (ellipse 20 30 "solid" "blue")) 'image "33.png")
(list '(rotate 5 (rectangle 50 50 "outline" "black")) 'image "32.png")
(list '(rotate 45 (ellipse 60 20 "solid" "olivedrab")) 'image "31.png")
(list
'(beside/places "baseline" (text "ijy" 18 "black") (text "ijy" 24 "black"))
'image
"30.png")
(list
'(beside/places
@ -29,6 +47,7 @@
(ellipse 20 50 "solid" "darkorchid")
(ellipse 20 30 "solid" "purple")
(ellipse 20 10 "solid" "indigo"))
'image
"29.png")
(list
'(beside/places
@ -37,6 +56,7 @@
(ellipse 20 50 "solid" "mediumslateblue")
(ellipse 20 30 "solid" "slateblue")
(ellipse 20 10 "solid" "navy"))
'image
"28.png")
(list
'(beside
@ -44,6 +64,7 @@
(ellipse 20 50 "solid" "darkgray")
(ellipse 20 30 "solid" "dimgray")
(ellipse 20 10 "solid" "black"))
'image
"27.png")
(list
'(overlay/xy
@ -51,6 +72,7 @@
-10
-10
(rectangle 10 10 "solid" "black"))
'image
"26.png")
(list
'(overlay/xy
@ -58,6 +80,7 @@
10
10
(rectangle 10 10 "solid" "black"))
'image
"25.png")
(list
'(overlay/xy
@ -65,6 +88,7 @@
10
0
(rectangle 10 10 "outline" "black"))
'image
"24.png")
(list
'(overlay/xy
@ -72,6 +96,7 @@
25
25
(ellipse 10 10 "solid" "forestgreen"))
'image
"23.png")
(list
'(overlay/places
@ -81,6 +106,7 @@
(rectangle 30 30 "solid" "black")
(rectangle 40 40 "solid" "red")
(rectangle 50 50 "solid" "black"))
'image
"22.png")
(list
'(overlay/places
@ -88,6 +114,7 @@
"middle"
(rectangle 30 60 "solid" "orange")
(ellipse 60 30 "solid" "purple"))
'image
"21.png")
(list
'(overlay
@ -97,34 +124,39 @@
(ellipse 40 40 "solid" "black")
(ellipse 50 50 "solid" "red")
(ellipse 60 60 "solid" "black"))
'image
"20.png")
(list
'(overlay
(ellipse 60 30 "solid" "purple")
(rectangle 30 60 "solid" "orange"))
'image
"19.png")
(list
'(text/font "not really a link" 18 "blue" #f 'roman 'normal 'normal #t)
'image
"18.png")
(list
'(text/font "Goodbye" 18 "indigo" #f 'modern 'italic 'normal #f)
'image
"17.png")
(list
'(text/font "Hello" 24 "olive" "Gill Sans" 'swiss 'normal 'bold #f)
'image
"16.png")
(list '(text "Goodbye" 36 "indigo") "15.png")
(list '(text "Hello" 24 "olive") "14.png")
(list '(star-polygon 20 10 3 "solid" "cornflowerblue") "13.png")
(list '(star-polygon 40 7 3 "outline" "darkred") "12.png")
(list '(star-polygon 40 5 2 "solid" "seagreen") "11.png")
(list '(star 40 "solid" "gray") "10.png")
(list '(triangle 40 "solid" "tan") "9.png")
(list '(regular-polygon 20 6 "solid" "red") "8.png")
(list '(regular-polygon 20 4 "outline" "blue") "7.png")
(list '(regular-polygon 30 3 "outline" "red") "6.png")
(list '(rectangle 20 40 "solid" 'blue) "5.png")
(list '(rectangle 40 20 "outline" 'black) "4.png")
(list '(ellipse 20 40 "solid" "blue") "3.png")
(list '(ellipse 40 20 "outline" "black") "2.png")
(list '(circle 20 "solid" "blue") "1.png")
(list '(circle 30 "outline" "red") "0.png")))
(list '(text "Goodbye" 36 "indigo") 'image "15.png")
(list '(text "Hello" 24 "olive") 'image "14.png")
(list '(star-polygon 20 10 3 "solid" "cornflowerblue") 'image "13.png")
(list '(star-polygon 40 7 3 "outline" "darkred") 'image "12.png")
(list '(star-polygon 40 5 2 "solid" "seagreen") 'image "11.png")
(list '(star 40 "solid" "gray") 'image "10.png")
(list '(triangle 40 "solid" "tan") 'image "9.png")
(list '(regular-polygon 20 6 "solid" "red") 'image "8.png")
(list '(regular-polygon 20 4 "outline" "blue") 'image "7.png")
(list '(regular-polygon 30 3 "outline" "red") 'image "6.png")
(list '(rectangle 20 40 "solid" 'blue) 'image "5.png")
(list '(rectangle 40 20 "outline" 'black) 'image "4.png")
(list '(ellipse 20 40 "solid" "blue") 'image "3.png")
(list '(ellipse 40 20 "outline" "black") 'image "2.png")
(list '(circle 20 "solid" "blue") 'image "1.png")
(list '(circle 30 "outline" "red") 'image "0.png")))

27
collects/teachpack/2htdp/scribblings/image-util.ss
View File

@ -6,8 +6,7 @@
(for-syntax scheme/base)
"image-toc.ss")
(provide image-examples
exp->filename)
(provide image-examples)
(define-syntax (image-examples stx)
(syntax-case stx ()
@ -31,21 +30,25 @@
"s"))))
(map (λ (x exp)
(list x
(let ([fn (format "2htdp/scribblings/img/~a" (exp->filename exp))])
(if (file-exists? fn)
(schemeblock #,(image fn))
(make-paragraph
error-color
(format "missing image! ~a" (exp->filename exp)))))))
(let ([line (exp->line exp)])
(case (car line)
[(val)
(schemeblock #,(schemeresult #,(cadr line)))]
[(image)
(let ([fn (format "2htdp/scribblings/img/~a" (cadr line))])
(if (file-exists? fn)
(schemeblock #,(image fn))
(make-paragraph
error-color
(format "missing image! ~a" (cadr line)))))]))))
expr-paras
val-list+outputs)))))
(define (exp->filename exp)
(define (exp->line exp)
(let ([fn (assoc exp mapping)])
(cond
[fn
(cadr fn)]
[fn (cdr fn)]
[else
(unless (getenv "PLTSHOWIMAGES")
(fprintf (current-error-port) "exp->filename: unknown exp ~s\n" exp))
"unk.png"])))
(list 'image "unk.png")])))

30
collects/teachpack/2htdp/scribblings/image.scrbl
View File

@ -286,11 +286,21 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
@defproc[(image-width [i image?]) (and/c number? positive?)]{
Returns the width of @scheme[i].
@image-examples[(image-width (ellipse 30 40 "solid" "orange"))
(image-width (circle 30 "solid" "orange"))
(image-width (beside (circle 20 "solid" "orange")
(circle 20 "solid" "purple")))]
}
@defproc[(image-height [i image?]) (and/c number? positive?)]{
Returns the height of @scheme[i].
}
@image-examples[(image-height (ellipse 30 40 "solid" "orange"))
(image-height (circle 30 "solid" "orange"))
(image-height (overlay (circle 20 "solid" "orange")
(circle 30 "solid" "purple")))]
}
@section{Image Predicates}
@ -367,7 +377,7 @@ are equal. Similarly, constructing a 20x10 rectangle and
then rotating it by 90 degress is equal to a 10x20 rectangle
(provided they have the same color and mode).
Equality testing contains a two surprises, though:
Equality testing may contain a few nuances, though:
@itemize[
@item{Overlaying two images in opposite orders is never equal. For example,
these two images are not @scheme[equal]:
@ -390,4 +400,18 @@ Equality testing contains a two surprises, though:
small roundoff errors that make the images draw slightly differently.
To combat this problem, use @scheme[equal~?] to compare the images,
or @scheme[check-within] for test suites involving images.}]
or @scheme[check-within] for test suites involving images.}
@item{In order to make equality on images created with
@scheme[text] and @scheme[text/font]
work well, each string passed to either of those functions results
in a number of horizontally aligned images, one for each letter in the
string. This means that, for example
@schemeblock[(equal? (beside/places "baseline"
(text "a" 18 "black")
(text "b" 18 "black"))
(text "ab" 18 "black"))]
is true, but that subtle aspects of font drawing may be wrong, since
the underlying toolkit only gets a single letter at a time, instead
of the entire word (or sentence).
}
]