From 155dc95f11ea5b6ed29d07e9bb49711988284b84 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 8 Nov 2009 23:59:07 +0000 Subject: [PATCH] added support for examples that don't return images svn: r16626 --- .../teachpack/2htdp/scribblings/image-gen.ss | 34 +++++--- .../teachpack/2htdp/scribblings/image-toc.ss | 78 +++++++++++++------ .../teachpack/2htdp/scribblings/image-util.ss | 27 ++++--- .../teachpack/2htdp/scribblings/image.scrbl | 30 ++++++- 4 files changed, 121 insertions(+), 48 deletions(-) diff --git a/collects/teachpack/2htdp/scribblings/image-gen.ss b/collects/teachpack/2htdp/scribblings/image-gen.ss index 7089439816..6265a958af 100644 --- a/collects/teachpack/2htdp/scribblings/image-gen.ss +++ b/collects/teachpack/2htdp/scribblings/image-gen.ss @@ -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) diff --git a/collects/teachpack/2htdp/scribblings/image-toc.ss b/collects/teachpack/2htdp/scribblings/image-toc.ss index adb30f486f..e2a29de2e0 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.ss +++ b/collects/teachpack/2htdp/scribblings/image-toc.ss @@ -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"))) diff --git a/collects/teachpack/2htdp/scribblings/image-util.ss b/collects/teachpack/2htdp/scribblings/image-util.ss index 53a3e8d9c0..651d706b39 100644 --- a/collects/teachpack/2htdp/scribblings/image-util.ss +++ b/collects/teachpack/2htdp/scribblings/image-util.ss @@ -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")]))) diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index b66ba7e7fe..faaa586b5f 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -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). + } +]