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

an attempt to fix up the bounding boxes on ellipses

Browse Source 
svn: r16281
This commit is contained in:
Robby Findler 2009-10-08 14:20:04 +00:00
parent d39cbf9c57
commit e87712fdda
2 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/2htdp/private/image-core.ss
View File

@ -424,10 +424,19 @@ and they all have good sample contracts. (It is amazing what we can do with kids
[atomic-shape (translate-shape simple-shape)]) [atomic-shape (translate-shape simple-shape)])
(cond (cond
[(ellipse? atomic-shape) [(ellipse? atomic-shape)
(let ([path (new dc-path%)] (let* ([path (new dc-path%)]
[θ (degrees->radians (ellipse-angle atomic-shape))]) [w (ellipse-width atomic-shape)]
(send path ellipse 0 0 (ellipse-width atomic-shape) (ellipse-height atomic-shape)) [h (ellipse-height atomic-shape)]
[θ (degrees->radians (ellipse-angle atomic-shape))]
[cos2 (sqr (cos θ))]
[sin2 (sqr (sin θ))]
[rotated-width (+ (* w cos2) (* h sin2))]
[rotated-height (+ (* w sin2) (* h cos2))])
(send path ellipse 0 0 w h)
(send path translate (- (/ w 2)) (- (/ h 2)))
(send path rotate θ) (send path rotate θ)
(send path translate (/ rotated-width 2) (/ rotated-height 2))
(send dc set-pen (mode-color->pen (ellipse-mode atomic-shape) (ellipse-color atomic-shape))) (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-brush (mode-color->brush (ellipse-mode atomic-shape) (ellipse-color atomic-shape)))
(send dc draw-path path dx dy))] (send dc draw-path path dx dy))]

3
collects/tests/2htdp/test-image.ss
View File

@ -10,8 +10,7 @@
;; test case: (beside (text "a"...) (text "b" ...)) vs (text "ab") ;; test case: (beside (text "a"...) (text "b" ...)) vs (text "ab")
(show-image (overlay (rectangle 200 20 'solid 'red) (show-image (frame (rotate 30 (ellipse 200 400 'solid 'purple))))
(scale 2 (rectangle 200 20 'solid 'blue))))
#; #;
(show-image (show-image