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

adjust 2htdp/image's add-curve and scene+curve so they accurately

Browse Source 
compute the bounding box

using the new get-path-bounding-box method

original commit: 8851f8f7276ca9ff048182f3826b857a3bee5917
This commit is contained in:
Robby Findler 2013-08-12 15:49:06 -05:00
parent e2ad8c6179
commit 7bc384eb68
1 changed files with 33 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt
View File

@ -885,30 +885,35 @@ has been moved out).
(send dc set-smoothing 'smoothed) (send dc set-smoothing 'smoothed)
(send dc draw-path path dx dy))] (send dc draw-path path dx dy))]
[(curve-segment? simple-shape) [(curve-segment? simple-shape)
(let* ([path (new dc-path%)] (define path (curve-segment->path simple-shape))
[start (curve-segment-start simple-shape)] (send dc set-pen (mode-color->pen 'outline (curve-segment-color simple-shape)))
[end (curve-segment-end simple-shape)] (send dc set-brush "black" 'transparent)
[sx (point-x start)] (send dc set-smoothing 'smoothed)
[sy (point-y start)] (send dc draw-path path dx dy)]))
[ex (point-x end)]
[ey (point-y end)] (define (curve-segment->path simple-shape)
[sa (degrees->radians (curve-segment-s-angle simple-shape))] (define start (curve-segment-start simple-shape))
[ea (degrees->radians (curve-segment-e-angle simple-shape))] (define end (curve-segment-end simple-shape))
[d (sqrt (+ (sqr (- ey sy)) (sqr (- ex sx))))] (define sx (point-x start))
[sp (* (curve-segment-s-pull simple-shape) d)] (define sy (point-y start))
[ep (* (curve-segment-e-pull simple-shape) d)]) (define ex (point-x end))
(send path move-to sx sy) (define ey (point-y end))
(send path curve-to (define sa (degrees->radians (curve-segment-s-angle simple-shape)))
(+ sx (* sp (cos sa))) (define ea (degrees->radians (curve-segment-e-angle simple-shape)))
(- sy (* sp (sin sa)))
(- ex (* ep (cos ea))) (define path (new dc-path%))
(+ ey (* ep (sin ea))) (define d (sqrt (+ (sqr (- ey sy)) (sqr (- ex sx)))))
ex (define sp (* (curve-segment-s-pull simple-shape) d))
ey) (define ep (* (curve-segment-e-pull simple-shape) d))
(send dc set-pen (mode-color->pen 'outline (curve-segment-color simple-shape))) (send path move-to sx sy)
(send dc set-brush "black" 'transparent) (send path curve-to
(send dc set-smoothing 'smoothed) (+ sx (* sp (cos sa)))
(send dc draw-path path dx dy))])) (- sy (* sp (sin sa)))
(- ex (* ep (cos ea)))
(+ ey (* ep (sin ea)))
ex
ey)
path)
(define (render-np-atomic-shape np-atomic-shape dc dx dy) (define (render-np-atomic-shape np-atomic-shape dc dx dy)
(cond (cond
@ -1350,7 +1355,10 @@ the mask bitmap and the original bitmap are all together in a single bytes!
to-img to-img
bitmap->image bitmap->image
image-snip->image image-snip->image
image-snip%) image-snip%
curve-segment->path
mode-color->pen)
;; method names ;; method names
(provide get-shape get-bb get-pinhole get-normalized? get-normalized-shape) (provide get-shape get-bb get-pinhole get-normalized? get-normalized-shape)