(module snip-mixins mzscheme

  (require (lib "contract.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "mrpict.ss" "texpict")
           "interfaces.ss"
           "dc-utils.ss"
           "easel.ss")

  (provide/contract
   [updatable-snip-mixin (mixin/c [snip%] [] [updatee<%>])]
   [custom-snip-mixin (mixin/c [snip%] [] [])])

  (define (updatable-snip-mixin super%)
    (class* super% (updatee<%>)
      (super-new)
      (inherit get-admin)

      (public on-update)

      (define (on-update)
        (send (get-admin) resized this #t))))

  (define (custom-snip-mixin super%)
    (unreadable-snip-mixin
     (simple-draw-snip-mixin
      (functional-location-snip-mixin
       (functional-extent-snip-mixin super%)))))

  (define (unreadable-snip-mixin super%)
    (class super%
      (super-new)
      (inherit set-snipclass)
      (set-snipclass unreadable-snipclass)))

  (define (simple-draw-snip-mixin super%)
    (class super%
      (super-new)
      (override-final draw)
      (public paint)

      (define (draw dc x y left top right bottom dx dy draw-caret)
        (parameterize ([dc-for-text-size dc])
          (paint (new easel-dc-wrapper%
                      [dc dc] [dx x] [dy y]
                      [left left] [top top] [right right] [bottom bottom]))))

      (define (paint easel)
        (void))))

  (define (functional-location-snip-mixin super%)
    (class super%
      (super-new)
      (inherit get-admin)
      (public get-location)

      (define (get-location)
        (let* ([editor (send (get-admin) get-editor)]
               [x1 (box 0)]
               [x2 (box 0)]
               [y1 (box 0)]
               [y2 (box 0)])
          (send editor get-snip-location this x1 y1 #f)
          (send editor get-snip-location this x2 y2 #t)
          (values x1 y1 (- x2 x1) (- y2 y1))))))

  (define (functional-extent-snip-mixin super%)
    (class super%
      (super-new)
      (override-final get-extent)
      (public extent)

      (define (get-extent dc x y
                          width-box
                          height-box
                          bottom-box
                          top-box
                          left-box
                          right-box)
        (let*-values ([(width height bottom top left right)
                       (parameterize ([dc-for-text-size dc])
                         (extent dc x y))])
          (fill-box! width-box width)
          (fill-box! height-box height)
          (fill-box! bottom-box bottom)
          (fill-box! top-box top)
          (fill-box! left-box left)
          (fill-box! right-box right)))

      (define (extent dc x y)
        (let* ([width-box (box 0)]
               [height-box (box 0)]
               [bottom-box (box 0)]
               [top-box (box 0)]
               [left-box (box 0)]
               [right-box (box 0)])
          (super get-extent dc x y
                 width-box
                 height-box
                 bottom-box
                 top-box
                 left-box
                 right-box)
          (values (unbox width-box)
                  (unbox height-box)
                  (unbox bottom-box)
                  (unbox top-box)
                  (unbox left-box)
                  (unbox right-box))))))

  (define unreadable-snipclass
    (let* ([unreadable-snipclass
            (new
             (class snip-class%
               (super-new)
               (override read)
               (define (read stream) #f)))])
      (send* unreadable-snipclass
        [set-classname "Unreadable"]
        [set-version 0])
      unreadable-snipclass))

  (define (fill-box! box/f value)
    (when box/f (set-box! box/f value)))

  )