fix scale so it cooperates with the dc's current transformation
closes PR 14424
This commit is contained in:
parent
980e957407
commit
c90538d249
|
@ -1078,23 +1078,23 @@
|
||||||
(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)
|
||||||
|
@ -1102,7 +1102,7 @@
|
||||||
(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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user