diff --git a/collects/2htdp/private/image-more.ss b/collects/2htdp/private/image-more.ss index c293956cf8..2ee20d620d 100644 --- a/collects/2htdp/private/image-more.ss +++ b/collects/2htdp/private/image-more.ss @@ -114,12 +114,12 @@ ;; places images on top of each other with their upper left corners aligned. ;; last one goes on the bottom (define/chk (overlay image image2 . image3) - (overlay/internal 'left 'top image (cons image2 image3))) + (overlay/internal 'middle 'middle image (cons image2 image3))) ;; underlay : image image image ... -> image (define (underlay image image2 . image3) (let ([imgs (reverse (list* image image2 image3))]) - (overlay/internal 'left 'top (car imgs) (cdr imgs)))) + (overlay/internal 'middle 'middle (car imgs) (cdr imgs)))) ;; overlay/align : string string image image image ... -> image ;; the first string has to be one of "center" "middle" "left" or "right" (or symbols) @@ -204,7 +204,7 @@ ;; beside : image image image ... -> image ;; places images in a single horizontal row, top aligned (define/chk (beside image1 image2 . image3) - (beside/internal 'top image1 (cons image2 image3))) + (beside/internal 'middle image1 (cons image2 image3))) ;; beside/align : string image image image ... -> image ;; places images in a horizontal row where the vertical alignment is @@ -233,7 +233,7 @@ ;; above : image image image ... -> image ;; places images in a single vertical row, left aligned (define/chk (above image1 image2 . image3) - (above/internal 'left image1 (cons image2 image3))) + (above/internal 'middle image1 (cons image2 image3))) ;; beside/align : string image image image ... -> image ;; places images in a horizontal row where the vertical alignment is @@ -457,22 +457,8 @@ (+ r dx) (+ b dy))))])) -;; points->ltrb : (cons point (listof points)) -> (values number number number number) (define (points->ltrb points) - (let* ([fx (point-x (car points))] - [fy (point-y (car points))] - [left fx] - [top fy] - [right fx] - [bottom fy]) - (for-each (λ (point) - (let ([new-x (point-x point)] - [new-y (point-y point)]) - (set! left (min new-x left)) - (set! top (min new-y top)) - (set! right (max new-x right)) - (set! bottom (max new-y bottom)))) - (cdr points)) + (let-values ([(left top right bottom) (points->ltrb-values points)]) (make-ltrb left top right bottom))) (define (np-atomic-bb atomic-shape) diff --git a/collects/2htdp/tests/test-image.ss b/collects/2htdp/tests/test-image.ss index e153b28abb..378fa0199c 100644 --- a/collects/2htdp/tests/test-image.ss +++ b/collects/2htdp/tests/test-image.ss @@ -15,7 +15,7 @@ (define t (new text%)) (define f (new frame% [label ""] [width 600] [height 400])) (define ec (new editor-canvas% [parent f] [editor t])) -(for ((i (in-list images))) (send t insert i)) +(for ((i (in-list images))) (send t insert i) (send t insert " ")) (send f show #t) |# @@ -233,6 +233,47 @@ => #t) + +(let ([size 10]) + (test (add-line + (add-line + (add-line + (add-line + (rectangle size size 'solid 'white) + 0 0 0 size 'black) + 0 size size size 'black) + size size size 0 'black) + size 0 0 0 'black) + => + (overlay (rectangle size size 'outline 'black) + (rectangle size size 'solid 'white))) + + (test (add-line + (add-line + (add-line + (add-line + (rectangle size size 'solid 'white) + 0 0 size 0 'black) + size 0 size size 'black) + size size 0 size 'black) + 0 size 0 0 'black) + => + (overlay (rectangle size size 'outline 'black) + (rectangle size size 'solid 'white))) + + (test (add-line + (add-line + (add-line + (add-line + (rectangle size size 'solid 'white) + 0 0 size 0 'black) + 0 0 0 size 'black) + 0 size size size 'black) + size 0 size size 'black) + => + (overlay (rectangle size size 'outline 'black) + (rectangle size size 'solid 'white)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; testing overlays @@ -243,7 +284,7 @@ => (make-image (make-overlay - (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue))) + (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue))) (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red)))) (make-bb 120 120 @@ -251,7 +292,7 @@ #f)) (test (overlay/xy (ellipse 100 100 'solid 'blue) - 0 0 + -10 -10 (ellipse 120 120 'solid 'red)) => (overlay (ellipse 100 100 'solid 'blue) @@ -293,8 +334,8 @@ => (make-image (make-overlay - (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green))) - (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red)))) + (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))) + (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))) (make-bb 100 100 100) @@ -307,9 +348,9 @@ (make-image (make-overlay (make-translate - 0 0 + 10 10 (make-overlay - (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue))) + (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue))) (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))))) (make-translate 0 0 (image-shape (ellipse 140 140 'solid 'green)))) (make-bb 140 140 140) @@ -403,7 +444,7 @@ (test (beside (ellipse 50 100 'solid 'red) (ellipse 100 50 'solid 'blue)) => - (beside/align 'top + (beside/align 'center (ellipse 50 100 'solid 'red) (ellipse 100 50 'solid 'blue))) @@ -446,7 +487,7 @@ (test (above (ellipse 50 100 'solid 'red) (ellipse 100 50 'solid 'blue)) => - (above/align 'left + (above/align 'center (ellipse 50 100 'solid 'red) (ellipse 100 50 'solid 'blue))) @@ -458,14 +499,14 @@ (make-image (make-overlay (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))) - (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue)))) + (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue)))) (make-bb 120 120 120) #f)) (test (underlay/xy (ellipse 100 100 'solid 'blue) - 0 0 + -10 -10 (ellipse 120 120 'solid 'red)) => (underlay (ellipse 100 100 'solid 'blue) @@ -503,8 +544,8 @@ => (make-image (make-overlay - (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red))) - (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green)))) + (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))) + (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))) (make-bb 100 100 100) @@ -520,8 +561,8 @@ 0 0 (make-overlay (make-translate 0 0 (image-shape (ellipse 140 140 'solid 'green))) - (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))))) - (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue)))) + (make-translate 10 10 (image-shape (ellipse 120 120 'solid 'red))))) + (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue)))) (make-bb 140 140 140) #f)) @@ -624,8 +665,9 @@ (make-translate 135 170 (make-ellipse 50 100 0 'solid "blue"))) (test (normalize-shape (image-shape - (beside (rectangle 10 10 'solid 'black) - (crop 0 0 5 5 (rectangle 10 10 'solid 'green))))) + (beside/align 'top + (rectangle 10 10 'solid 'black) + (crop 0 0 5 5 (rectangle 10 10 'solid 'green))))) => (make-overlay (make-polygon @@ -950,15 +992,27 @@ ;; curves ;; -(test (add-curve (rectangle 100 20 'solid 'black) - 10 10 0 1/4 - 90 10 0 1/4 - 'white) +;; make sure a curve stays roughly in the middle pixels by +;; covering up a white curve with a thin black bar +(test (overlay/align 'middle + 'middle + (rectangle 82 2 'solid 'black) + (add-curve (rectangle 100 20 'solid 'black) + 10 10 0 1/4 + 90 10 0 1/4 + 'white)) + => - (add-line (rectangle 100 20 'solid 'black) - 10 10 - 90 10 - 'white)) + (rectangle 100 20 'solid 'black)) + +;; and then make sure the curve actually draws something ... +(test (not (equal? (add-curve (rectangle 100 20 'solid 'black) + 10 10 0 1/4 + 90 10 0 1/4 + 'white) + (rectangle 100 20 'solid 'black))) + => + #t) (test (scale 2 (add-curve @@ -1133,11 +1187,13 @@ => #t) -(test (beside (rectangle 10 10 'solid 'black) - (crop 0 0 10 10 (rectangle 10 10 'solid 'green))) +(test (beside/align 'middle + (rectangle 10 10 'solid 'black) + (crop 0 0 10 10 (rectangle 10 10 'solid 'green))) => - (beside (rectangle 10 10 'solid 'black) - (rectangle 10 10 'solid 'green))) + (beside/align 'middle + (rectangle 10 10 'solid 'black) + (rectangle 10 10 'solid 'green))) (test (place-image (circle 4 'solid 'black) 10 10 @@ -1165,15 +1221,17 @@ -4 -4 (rectangle 40 40 'solid 'orange)) => - (overlay (crop 4 4 16 16 (circle 8 'solid 'black)) - (rectangle 40 40 'solid 'orange))) + (overlay/xy (crop 4 4 16 16 (circle 8 'solid 'black)) + 0 0 + (rectangle 40 40 'solid 'orange))) (test (place-image (circle 4 'solid 'black) -4 0 (rectangle 40 40 'solid 'orange)) => - (overlay (crop 4 0 4 8 (circle 4 'solid 'black)) - (rectangle 40 40 'solid 'orange))) + (overlay/xy (crop 4 0 4 8 (circle 4 'solid 'black)) + 0 0 + (rectangle 40 40 'solid 'orange))) (test (place-image/align (circle 4 'solid 'black) 5 10 'center 'center diff --git a/collects/mrlib/image-core.ss b/collects/mrlib/image-core.ss index 829dab3555..ee3855cf62 100644 --- a/collects/mrlib/image-core.ss +++ b/collects/mrlib/image-core.ss @@ -202,21 +202,21 @@ has been moved out). (init-field shape bb normalized?) (define/public (equal-to? that eq-recur) (or (eq? this that) - (and (not (skip-image-equality-fast-path)) ;; this is here to make testing more effective - (equal? (get-normalized-shape) (send that get-normalized-shape))) (and (is-a? that image%) (same-bb? bb (send that get-bb)) - (let ([w (round (inexact->exact (bb-right bb)))] - [h (round (inexact->exact (bb-bottom bb)))]) - (or (zero? w) - (zero? h) - (let ([bm1 (make-object bitmap% w h)] - [bm2 (make-object bitmap% w h)] - [bytes1 (make-bytes (* w h 4) 0)] - [bytes2 (make-bytes (* w h 4) 0)] - [bdc (make-object bitmap-dc%)]) - (and (check-same? bm1 bm2 bytes1 bytes2 bdc "red" that) - (check-same? bm1 bm2 bytes1 bytes2 bdc "green" that)))))))) + (or (and (not (skip-image-equality-fast-path)) ;; this is here to make testing more effective + (equal? (get-normalized-shape) (send that get-normalized-shape))) + (let ([w (+ 1 (round (inexact->exact (bb-right bb))))] ;; some shapes (ie, rectangles) draw 1 outside the bounding box + [h (+ 1 (round (inexact->exact (bb-bottom bb))))]) ;; so we make the bitmap slightly bigger to accomodate that. + (or (zero? w) + (zero? h) + (let ([bm1 (make-object bitmap% w h)] + [bm2 (make-object bitmap% w h)] + [bytes1 (make-bytes (* w h 4) 0)] + [bytes2 (make-bytes (* w h 4) 0)] + [bdc (make-object bitmap-dc%)]) + (and (check-same? bm1 bm2 bytes1 bytes2 bdc "red" that) + (check-same? bm1 bm2 bytes1 bytes2 bdc "green" that))))))))) (define/private (check-same? bm1 bm2 bytes1 bytes2 bdc color that) (clear-bitmap/draw/bytes bm1 bdc bytes1 this color) @@ -280,9 +280,7 @@ has been moved out). (define/override (copy) (make-image shape bb normalized?)) (define/override (draw dc x y left top right bottom dx dy draw-caret?) (let ([smoothing (send dc get-smoothing)]) - (send dc set-smoothing 'aligned) - (render-image this dc x y) - (send dc set-smoothing smoothing))) + (render-image this dc x y))) (define/override (get-extent dc x y [w #f] [h #f] [descent #f] [space #f] [lspace #f] [rspace #f]) (send (get-the-snip-class-list) add snip-class) @@ -524,12 +522,14 @@ has been moved out). (let ([pen (send dc get-pen)] [brush (send dc get-brush)] [font (send dc get-font)] - [fg (send dc get-text-foreground)]) + [fg (send dc get-text-foreground)] + [smoothing (send dc get-smoothing)]) (render-normalized-shape (send image get-normalized-shape) dc dx dy) (send dc set-pen pen) (send dc set-brush brush) (send dc set-font font) - (send dc set-text-foreground fg))) + (send dc set-text-foreground fg) + (send dc set-smoothing smoothing))) (define (render-normalized-shape shape dc dx dy) (cond @@ -556,20 +556,43 @@ has been moved out). (define (render-simple-shape simple-shape dc dx dy) (cond [(polygon? simple-shape) - (let ([path (polygon-points->path (polygon-points simple-shape))]) - (send dc set-pen (mode-color->pen (polygon-mode simple-shape) - (polygon-color simple-shape))) - (send dc set-brush (mode-color->brush (polygon-mode simple-shape) - (polygon-color simple-shape))) - (send dc draw-path path dx dy 'winding))] + (send dc set-pen (mode-color->pen (polygon-mode simple-shape) + (polygon-color simple-shape))) + (send dc set-brush (mode-color->brush (polygon-mode simple-shape) + (polygon-color simple-shape))) + (send dc set-smoothing (mode->smoothing (polygon-mode simple-shape))) + (cond + [(eq? (polygon-mode simple-shape) 'outline) + (let ([connect + (λ (p1 p2) + (let ([path (new dc-path%)]) + (send path move-to (point-x p1) (point-y p1)) + (send path line-to (point-x p2) (point-y p2)) + (send dc draw-path path dx dy)))]) + (let loop ([points (polygon-points simple-shape)]) + (cond + [(null? (cdr points)) + (connect (car points) (car (polygon-points simple-shape)))] + [else + (connect (car points) (cadr points)) + (loop (cdr points))])))] + [else + (let ([path (polygon-points->path (polygon-points simple-shape))]) + (send dc draw-path path dx dy 'winding))])] [(line-segment? simple-shape) - (let ([start (line-segment-start simple-shape)] - [end (line-segment-end simple-shape)]) + (let* ([start (line-segment-start simple-shape)] + [end (line-segment-end simple-shape)] + [path (new dc-path%)] + [sx (point-x start)] + [sy (point-y start)] + [ex (point-x end)] + [ey (point-y end)]) + (send path move-to sx sy) + (send path line-to ex ey) (send dc set-pen (line-segment-color simple-shape) 1 'solid) (send dc set-brush "black" 'transparent) - (send dc draw-line - (+ dx (point-x start)) (+ dy (point-y start)) - (+ dx (point-x end)) (+ dy (point-y end))))] + (send dc set-smoothing 'aligned) + (send dc draw-path path dx dy))] [(curve-segment? simple-shape) (let* ([path (new dc-path%)] [start (curve-segment-start simple-shape)] @@ -585,14 +608,15 @@ has been moved out). [ep (* (curve-segment-e-pull simple-shape) d)]) (send path move-to sx sy) (send path curve-to - (+ sx (* sp (cos sa))) - (- sy (* sp (sin sa))) - (- ex (* ep (cos ea))) - (+ ey (* ep (sin ea))) - ex - ey) + (+ sx (* sp (cos sa))) + (- sy (* sp (sin sa))) + (- ex (* ep (cos ea))) + (+ ey (* ep (sin ea))) + ex + ey) (send dc set-pen (curve-segment-color simple-shape) 1 'solid) (send dc set-brush "black" 'transparent) + (send dc set-smoothing 'aligned) (send dc draw-path path dx dy))] [else (let ([dx (+ dx (translate-dx simple-shape))] @@ -610,6 +634,7 @@ has been moved out). (send path rotate θ) (send dc set-pen (mode-color->pen (ellipse-mode atomic-shape) (ellipse-color atomic-shape))) (send dc set-brush (mode-color->brush (ellipse-mode atomic-shape) (ellipse-color atomic-shape))) + (send dc set-smoothing (mode->smoothing (ellipse-mode atomic-shape))) (send dc draw-path path dx dy)))] [(bitmap? atomic-shape) (let ([bm (get-rendered-bitmap atomic-shape)]) @@ -647,6 +672,34 @@ has been moved out). (send path line-to (round (point-x (car points))) (round (point-y (car points)))) path)) +(define (points->bb-path points) + (let ([path (new dc-path%)]) + (let-values ([(left top right bottom) (points->ltrb-values points)]) + (send path move-to left top) + (send path line-to right top) + (send path line-to right bottom) + (send path line-to left bottom) + (send path line-to left top) + path))) + +;; points->ltrb-values : (cons point (listof points)) -> (values number number number number) +(define (points->ltrb-values points) + (let* ([fx (point-x (car points))] + [fy (point-y (car points))] + [left fx] + [top fy] + [right fx] + [bottom fy]) + (for-each (λ (point) + (let ([new-x (point-x point)] + [new-y (point-y point)]) + (set! left (min new-x left)) + (set! top (min new-y top)) + (set! right (max new-x right)) + (set! bottom (max new-y bottom)))) + (cdr points)) + (values left top right bottom))) + #| the mask bitmap and the original bitmap are all together in a single bytes! @@ -766,13 +819,17 @@ the mask bitmap and the original bitmap are all together in a single bytes! (define (degrees->radians θ) (* θ 2 pi (/ 360))) +(define (mode->smoothing mode) + (case mode + [(outline) 'aligned] + [(solid) 'smoothed])) + (define (mode-color->pen mode color) - (send the-pen-list find-or-create-pen - (get-color-arg color) - 1 - (case mode - [(outline) 'solid] - [(solid) 'transparent]))) + (case mode + [(outline) + (send the-pen-list find-or-create-pen (get-color-arg color) 1 'solid)] + [(solid) + (send the-pen-list find-or-create-pen "black" 1 'transparent)])) (define (mode-color->brush mode color) (send the-brush-list find-or-create-brush @@ -820,7 +877,8 @@ the mask bitmap and the original bitmap are all together in a single bytes! degrees->radians normalize-shape ellipse-rotated-size - + points->ltrb-values + image? text->font diff --git a/collects/teachpack/2htdp/scribblings/image-toc.ss b/collects/teachpack/2htdp/scribblings/image-toc.ss index c1204b96a1..d6e0211399 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.ss +++ b/collects/teachpack/2htdp/scribblings/image-toc.ss @@ -25,14 +25,13 @@ (list '(image-width (circle 30 "solid" "orange")) 'val 60) (list '(image-width (ellipse 30 40 "solid" "orange")) 'val 30) (list - '(beside/align - "bottom" + '(beside (ellipse 20 70 "solid" "lightsteelblue") (frame (ellipse 20 50 "solid" "mediumslateblue")) (ellipse 20 30 "solid" "slateblue") (ellipse 20 10 "solid" "navy")) 'image - "f7f1480d58.png") + "54a488e1a5.png") (list '(frame (ellipse 20 20 "outline" "black")) 'image "6a5a617f28.png") (list '(above @@ -163,13 +162,13 @@ "2bea495d1f.png") (list '(above/align - "center" + "left" (ellipse 70 20 "solid" "yellowgreen") (ellipse 50 20 "solid" "olivedrab") (ellipse 30 20 "solid" "darkolivegreen") (ellipse 10 20 "solid" "darkgreen")) 'image - "166bb7bc683.png") + "ff11314e4e.png") (list '(above/align "right" @@ -193,13 +192,13 @@ "2187216ca96.png") (list '(beside/align - "center" + "top" (ellipse 20 70 "solid" "mediumorchid") (ellipse 20 50 "solid" "darkorchid") (ellipse 20 30 "solid" "purple") (ellipse 20 10 "solid" "indigo")) 'image - "2dd0a2a4517.png") + "10a0d35fa03.png") (list '(beside/align "bottom" @@ -265,12 +264,12 @@ "ff2fcb7b87.png") (list '(underlay/align - "middle" + "left" "middle" (rectangle 30 60 "solid" "orange") (ellipse 60 30 "solid" "purple")) 'image - "2d1e52503d7.png") + "1404e4b2af.png") (list '(underlay (ellipse 10 60 "solid" "red") @@ -335,21 +334,21 @@ "969a9aa483.png") (list '(overlay/align - "middle" + "left" "middle" (rectangle 30 60 "solid" "orange") (ellipse 60 30 "solid" "purple")) 'image - "bf08c71801.png") + "11b64ab4d3.png") (list '(overlay (regular-polygon 20 5 "solid" (make-color 50 50 255)) - (regular-polygon 25 5 "solid" (make-color 100 100 255)) - (regular-polygon 30 5 "solid" (make-color 150 150 255)) - (regular-polygon 35 5 "solid" (make-color 200 200 255)) - (regular-polygon 40 5 "solid" (make-color 250 250 255))) + (regular-polygon 26 5 "solid" (make-color 100 100 255)) + (regular-polygon 32 5 "solid" (make-color 150 150 255)) + (regular-polygon 38 5 "solid" (make-color 200 200 255)) + (regular-polygon 44 5 "solid" (make-color 250 250 255))) 'image - "1aea411192a.png") + "1acede17bc6.png") (list '(overlay (ellipse 10 10 "solid" "red") diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index b50aed1def..4ea193ef52 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -310,10 +310,10 @@ mean that the curve stays with the angle longer. (ellipse 50 50 "solid" "red") (ellipse 60 60 "solid" "black")) (overlay (regular-polygon 20 5 "solid" (make-color 50 50 255)) - (regular-polygon 25 5 "solid" (make-color 100 100 255)) - (regular-polygon 30 5 "solid" (make-color 150 150 255)) - (regular-polygon 35 5 "solid" (make-color 200 200 255)) - (regular-polygon 40 5 "solid" (make-color 250 250 255)))] + (regular-polygon 26 5 "solid" (make-color 100 100 255)) + (regular-polygon 32 5 "solid" (make-color 150 150 255)) + (regular-polygon 38 5 "solid" (make-color 200 200 255)) + (regular-polygon 44 5 "solid" (make-color 250 250 255)))] } @@ -323,7 +323,7 @@ mean that the curve stays with the angle longer. @scheme[x-place] and @scheme[y-place] are both @scheme["middle"], then the images are lined up on their centers. - @image-examples[(overlay/align "middle" "middle" + @image-examples[(overlay/align "left" "middle" (rectangle 30 60 "solid" "orange") (ellipse 60 30 "solid" "purple")) (overlay/align "right" "bottom" @@ -383,7 +383,7 @@ mean that the curve stays with the angle longer. @scheme[x-place] and @scheme[y-place] are both @scheme["middle"], then the images are lined up on their centers. - @image-examples[(underlay/align "middle" "middle" + @image-examples[(underlay/align "left" "middle" (rectangle 30 60 "solid" "orange") (ellipse 60 30 "solid" "purple")) (underlay/align "right" "top" @@ -446,7 +446,7 @@ mean that the curve stays with the angle longer. (ellipse 20 30 "solid" "slateblue") (ellipse 20 10 "solid" "navy")) - (beside/align "center" + (beside/align "top" (ellipse 20 70 "solid" "mediumorchid") (ellipse 20 50 "solid" "darkorchid") (ellipse 20 30 "solid" "purple") @@ -484,7 +484,7 @@ mean that the curve stays with the angle longer. (ellipse 30 20 "solid" "darkgoldenrod") (ellipse 10 20 "solid" "sienna")) - (above/align "center" + (above/align "left" (ellipse 70 20 "solid" "yellowgreen") (ellipse 50 20 "solid" "olivedrab") (ellipse 30 20 "solid" "darkolivegreen") @@ -622,11 +622,11 @@ and universes using @scheme[2htdp/universe]. debug image constructions, i.e., to see where certain sub-images appear within some larger image. - @image-examples[(beside/align "bottom" - (ellipse 20 70 "solid" "lightsteelblue") - (frame (ellipse 20 50 "solid" "mediumslateblue")) - (ellipse 20 30 "solid" "slateblue") - (ellipse 20 10 "solid" "navy"))] + @image-examples[(beside + (ellipse 20 70 "solid" "lightsteelblue") + (frame (ellipse 20 50 "solid" "mediumslateblue")) + (ellipse 20 30 "solid" "slateblue") + (ellipse 20 10 "solid" "navy"))] } @section{Image Properties} @@ -754,63 +754,4 @@ The baseline of an image is the place where the bottoms any letters line up, not Two images are equal if they draw exactly the same way, at their current size (not neccessarily at all sizes). -@;{ -Image equality testing is done structurally, i.e., based on -the construction of the image, -although with certain, expected equivalences. For example, -two rectangles with the same width, height, color, and mode -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 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]: - @schemeblock[(overlay/xy (rectangle 30 10 "solid" "blue") - 0 - 10 - (rectangle 30 10 "solid" "red"))] - @schemeblock[(overlay/xy (rectangle 30 10 "solid" "red") - 0 - -10 - (rectangle 30 10 "solid" "blue"))] - even thought they may appear to be the same when drawn. - - The rationale for them being different is that, at some scale factor, - they will draw differently; specifically when they are scaled down - far enough, the first will appear to be a single red pixel and the second will appear to - be a single blue pixel.} - @item{When rotating images, the internal calculations involve real numbers, not just - rationals and thus must be approximated with Scheme's inexact numbers, causing - 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.} - - @item{Combining a series of line segments to form a polygon produces - an image that is different than the polygon.} - - @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/align "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). - - The most obvious way that this shows up is in the handling of ligatures. - For example, the letter combinations ``ff'' and ``fi'' and ``fl'' are - generally drawn intertwined when they appear together, and thus an ``f'' - drawn separately from an ``i'' looks different than the ligature ``fi''. - For example, here is how 24 point Times font looks when the word ``refill'' - is drawn, first with ligatures and then without: - @centerline{@image["2htdp/scribblings/ligature.png"]}. - } -] -} +@include-section["porting-guide.scrbl"] diff --git a/collects/teachpack/2htdp/scribblings/img/10a0d35fa03.png b/collects/teachpack/2htdp/scribblings/img/10a0d35fa03.png new file mode 100644 index 0000000000..43e80fad7c Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/10a0d35fa03.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/11b64ab4d3.png b/collects/teachpack/2htdp/scribblings/img/11b64ab4d3.png new file mode 100644 index 0000000000..f19b1c706a Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/11b64ab4d3.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/1404e4b2af.png b/collects/teachpack/2htdp/scribblings/img/1404e4b2af.png new file mode 100644 index 0000000000..e1919abeb1 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/1404e4b2af.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/166bb7bc683.png b/collects/teachpack/2htdp/scribblings/img/166bb7bc683.png deleted file mode 100644 index 8117a8b7b1..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/166bb7bc683.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/1acede17bc6.png b/collects/teachpack/2htdp/scribblings/img/1acede17bc6.png new file mode 100644 index 0000000000..4caa13ad8a Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/1acede17bc6.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/1aea411192a.png b/collects/teachpack/2htdp/scribblings/img/1aea411192a.png deleted file mode 100644 index a6cff6e219..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/1aea411192a.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png b/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png deleted file mode 100644 index b569645886..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/2dd0a2a4517.png b/collects/teachpack/2htdp/scribblings/img/2dd0a2a4517.png deleted file mode 100644 index 9c4330165b..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/2dd0a2a4517.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/54a488e1a5.png b/collects/teachpack/2htdp/scribblings/img/54a488e1a5.png new file mode 100644 index 0000000000..ce139f3fe8 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/54a488e1a5.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/bf08c71801.png b/collects/teachpack/2htdp/scribblings/img/bf08c71801.png deleted file mode 100644 index aab464a076..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/bf08c71801.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/f7f1480d58.png b/collects/teachpack/2htdp/scribblings/img/f7f1480d58.png deleted file mode 100644 index 12adfdabfc..0000000000 Binary files a/collects/teachpack/2htdp/scribblings/img/f7f1480d58.png and /dev/null differ diff --git a/collects/teachpack/2htdp/scribblings/img/ff11314e4e.png b/collects/teachpack/2htdp/scribblings/img/ff11314e4e.png new file mode 100644 index 0000000000..aa773bfbf4 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/ff11314e4e.png differ diff --git a/collects/teachpack/2htdp/scribblings/porting-guide.scrbl b/collects/teachpack/2htdp/scribblings/porting-guide.scrbl new file mode 100644 index 0000000000..18ec7c328d --- /dev/null +++ b/collects/teachpack/2htdp/scribblings/porting-guide.scrbl @@ -0,0 +1,22 @@ +#lang scribble/doc + +@(require scribble/manual + (for-label (prefix-in htdp: htdp/image) + (prefix-in 2htdp: 2htdp/image))) + +@title{Porting from @schememodname[htdp/image]} + +why switch(?): faster image comparison, added rotate, scale, and curves, plus a bunch of new polygon primitives + +@schemeblock[(htdp:rectangle 10 10 "outline" "black") + (2htdp:rectangle 10 10 "outline" "black")] + +changes: + +no pinholes + +overlay arguments reversed (added underlay) + +lines drawn probably different somewhere (ellipses?) + +star function is different (bring back old star function?)