(module easel mzscheme

  (require (lib "contract.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "mrpict.ss" "texpict")
           "interfaces.ss")

  (define easel<%>
    (interface ()
      get-dx
      get-dy
      get-bbox
      translate
      paint-pict))

  (provide/contract
   [easel<%> interface?]
   [easel-dc-wrapper% (class/c easel<%>)])

  (define MIN-X -16383)
  (define MAX-X +16383)
  (define MIN-Y -16383)
  (define MAX-Y +16383)

  (define easel-dc-wrapper%
    (class* object% (easel<%>)
      (super-new)
      (init [(init-dc dc)]
            [(init-dx dx) 0]
            [(init-dy dy) 0]
            [left MIN-X]
            [top MIN-Y]
            [right MAX-X]
            [bottom MAX-Y]
            )

      (define dc init-dc)
      (define dx init-dx)
      (define dy init-dy)
      (define dc-left left)
      (define dc-top top)
      (define dc-right right)
      (define dc-bottom bottom)

      ;; Interface methods:
      (public get-dx get-dy get-bbox translate paint-pict)

      ;; Internal methods:
      (private x-to-dc y-to-dc x-from-dc y-from-dc verify!)

      ;; ------------------------------------------------------------
      ;; Internal methods:

      (define (x-to-dc x) (+ x dx))
      (define (y-to-dc y) (+ y dy))
      (define (x-from-dc x) (- x dx))
      (define (y-from-dc y) (- y dy))

      (define (verify! method description x y)
        (unless (and (<= MIN-X x MAX-X) (<= MIN-Y y MAX-Y))
          (raise
           (make-exn:fail:contract
            (string->immutable-string
             (format "easel<%>.~s: ~s out of bounds (~s,~s)"
                     method description x y))
            (current-continuation-marks)))))

      ;; ------------------------------------------------------------
      ;; External methods:

      (define (get-dx) dx)
      (define (get-dy) dy)
      (define (get-bbox)
        (values (x-from-dc dc-left)
                (y-from-dc dc-top)
                (x-from-dc dc-right)
                (y-from-dc dc-bottom)))

      (define (translate xoffset yoffset)
        (new easel-dc-wrapper%
             [dc dc]
             [dx (+ dx xoffset)]
             [dy (+ dy yoffset)]))

      (define (paint-pict x y pict)
        (let* ([x (x-to-dc x)]
               [y (y-to-dc y)]
               [w (pict-width pict)]
               [h (pict-height pict)])
          (verify! 'paint-pict "top left corner of pict" x y)
          (verify! 'paint-pict "bottom right corner of pict" (+ x w) (+ y h))
          (draw-pict pict dc x y)))

      ))

  )