changed the overlaying functions so they default to putting the images overlay'd on their centers, not upper lefts
svn: r17632
This commit is contained in:
Robby Findler
parent
8838d90cd5
commit
8c9088a770
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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"]
|
||||
|
|
|
|||
BIN
collects/teachpack/2htdp/scribblings/img/10a0d35fa03.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/10a0d35fa03.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.3 KiB |
BIN
collects/teachpack/2htdp/scribblings/img/11b64ab4d3.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/11b64ab4d3.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 742 B |
BIN
collects/teachpack/2htdp/scribblings/img/1404e4b2af.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/1404e4b2af.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 2.2 KiB |
BIN
collects/teachpack/2htdp/scribblings/img/1acede17bc6.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/1acede17bc6.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.4 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.0 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 2.3 KiB |
BIN
collects/teachpack/2htdp/scribblings/img/54a488e1a5.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/54a488e1a5.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.2 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 893 B |
Binary file not shown.
|
Before Width: | Height: | Size: 2.3 KiB |
BIN
collects/teachpack/2htdp/scribblings/img/ff11314e4e.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/ff11314e4e.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.2 KiB |
22
collects/teachpack/2htdp/scribblings/porting-guide.scrbl
Normal file
22
collects/teachpack/2htdp/scribblings/porting-guide.scrbl
Normal file
|
|
@ -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?)
|
||||
Loading…
Reference in New Issue
Block a user