(module dc-utils mzscheme
(require (lib "contract.ss")
(lib "class.ss")
(lib "mred.ss" "mred")
"interfaces.ss")
(provide/contract
[with-relative-dc
((object/c dc<%>) real? real? ((object/c dc<%>) . -> . any) . -> . any)]
[with-bounded-dc
((object/c dc<%>) real? real? real? real? ((object/c dc<%>) . -> . any)
. -> . any)])
(define (with-relative-dc drawing-context dx dy function)
(define (swap-origin)
(define-values (x y) (send drawing-context get-origin))
(send drawing-context set-origin saved-x saved-y)
(set! saved-x x)
(set! saved-y y))
(define-values (x y) (send drawing-context get-origin))
(define saved-x (+ x dx))
(define saved-y (+ y dy))
(dynamic-wind
swap-origin
(lambda () (function drawing-context))
swap-origin))
(define (with-bounded-dc drawing-context L T R B function)
(define (swap-region)
(define region (send drawing-context get-clipping-region))
(send drawing-context set-clipping-region saved-region)
(set! saved-region region))
(define region (send drawing-context get-clipping-region))
(define saved-region (new region% [dc drawing-context]))
(send saved-region set-rectangle L T (- R L) (- B T))
(when region (send saved-region intersect region))
(dynamic-wind
swap-region
(lambda () (function drawing-context))
swap-region))
)