gui/dc-utils.ss
(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)])

  ;; with-relative-dc : DC Real Real (DC -> Result) -> Result
  ;; Performs computation based on the given DC, but with a translated
  ;; coordinate system for the dynamic extent of the computation.
  (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))

  ;; with-bounded-dc : DC Real Real Real Real (DC -> Result) -> Result
  ;; Performs computation based on the given DC, but with a superimposed
  ;; bounding box for the dynamic extent of the computation.
  (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))

  )