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

fix scale so it cooperates with the dc's current transformation

Browse Source 
closes PR 14424
This commit is contained in:
Robby Findler 2014-04-06 20:40:37 -05:00
parent 980e957407
commit c90538d249
1 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
pkgs/pict-pkgs/pict-lib/texpict/utils.rkt
View File

@ -1078,32 +1078,32 @@
(scale main-pict (min (/ w (pict-width main-pict)) (scale main-pict (min (/ w (pict-width main-pict))
(/ h (pict-height main-pict))))])) (/ h (pict-height main-pict))))]))
(define scale (define scale
(case-lambda (case-lambda
[(p x-factor y-factor) [(p x-factor y-factor)
(let ([drawer (make-pict-drawer p)]) (define drawer (make-pict-drawer p))
(let ([new (define new
(dc (dc
(lambda (dc x y) (λ (dc x y)
(let-values ([(xs ys) (send dc get-scale)]) (define t (send dc get-transformation))
(send dc set-scale (* xs x-factor) (* ys y-factor)) (send dc scale x-factor y-factor)
(drawer dc (drawer dc
(/ x x-factor) (/ x x-factor)
(/ y y-factor)) (/ y y-factor))
(send dc set-scale xs ys))) (send dc set-transformation t))
(* (pict-width p) x-factor) (* (pict-width p) x-factor)
(* (pict-height p) y-factor) (* (pict-height p) y-factor)
(* (pict-ascent p) y-factor) (* (pict-ascent p) y-factor)
(* (pict-descent p) y-factor))]) (* (pict-descent p) y-factor)))
(make-pict (pict-draw new) (make-pict (pict-draw new)
(pict-width new) (pict-width new)
(pict-height new) (pict-height new)
(pict-ascent new) (pict-ascent new)
(pict-descent new) (pict-descent new)
(list (make-child p 0 0 x-factor y-factor 0 0)) (list (make-child p 0 0 x-factor y-factor 0 0))
#f #f
(pict-last p))))] (pict-last p))]
[(p factor) (scale p factor factor)])) [(p factor) (scale p factor factor)]))
(define (rotate p theta) (define (rotate p theta)
(let ([w (pict-width p)] (let ([w (pict-width p)]