Define custom methods for drawing the context for a canvas

In Racket, I know how to make my own custom canvas%
class with its own on-event method:

(define my-canvas%
  (class canvas%
    (define/override (on-event event)
      (cond ...));; handle the event
    (super-new)))

I would like to make a similar change to the drawing context returned by (send canvas get-dc)
so that it has more drawing methods. If I make a custom my-dc%
class, I would have to find a way to make my-canvas%
return it
instead of the ordinary dc%
when called with get-dc
. Is this possible?

More specifically, my-dc%
would look something like this (where my defined draw-circle
is supposed to use the built-in draw-arc
):

(define my-dc%
  (class dc%
    (define (draw-circle x y radius)
      (draw-arc (- x radius) ; left
                (- y radius) ; top
                (* 2 radius) ; width
                (* 2 radius) ; height
                0            ; start-angle
                (* 2 pi)))   ; end-angle
    (super-new)))

so that I can later do just (send dc draw-circle 100 100 20)
to draw a circle, like every other drawing method.

You can probably write a container that delegates most of the work off to the contained dc%. You could do something like this:

#lang racket
(require racket/gui/base)

(define my-dc%
  (class* object% (dc)
    (init-field delegate)
    (super-new)

    (define/public (cache-font-metrics-key)
      (send delegate cache-font-metrics-key))

    (define/public (clear)
      (send delegate clear))

    (define/public (copy x y width height x2 y2)
      (send delegate copy x y width height x2 y2))

    (define/public (draw-arc x y width height start-radians end-radians)
      (send delegate draw-arc x y width height start-radians end-radians))

    ;; FILL ME IN...
))

going through all the methods listed in the
dc

interface. This approach is admittedly pretty brute force, but it should work. Then you could add whatever extra methods you wanted to this class, since it’s yours.

Here is a complete example, using some macros to reduce a bunch of the copy-and-pasting I’d otherwise do:

#lang racket
(require racket/gui/base)

;; Defines a dc implementation that can wrap around
;; another dc.
;;
;; Can also be found at: https://gist.github.com/dyoo/5025445
;;
;; The test code near the bottom shows an example
;; of how to use the delegate.

(define wrapped-dc%
  (class* object% (dc)
    (init-field delegate)
    (super-new)

    ;; This bit of code tries to generate the delegate method
    ;; given the method signature.  It's not quite perfect
    ;; yet because I'm having trouble capturing the re-write rule
    ;; for set-pen and set-brush.
    (define-syntax (write-delegate-method stx)
      (syntax-case stx ()
        [(_ (name args ...))
         (with-syntax ([(arg-ids ...)
                        (for/list ([arg (syntax->list #'(args ...))])
                          (syntax-case arg ()
                            [(id default)
                             #'id]
                            [id
                             #'id]))])
           #'(define/public (name args ...)
               (send delegate name arg-ids ...)))]))

    (define-syntax-rule (write-delegate-methods sig ...)
      (begin (write-delegate-method sig) ...))

    (write-delegate-methods
     (cache-font-metrics-key)
     (clear)
     (copy x y width height x2 y2)
     (draw-arc x y width height start-radians end-radians)
     (draw-bitmap source dest-x dest-y
                  (style 'solid)
                  (color (send the-color-database find-color "black"))
                  (mask #f))
     (draw-bitmap-section source dest-x dest-y src-x src-y
                          src-width src-height
                          [style 'solid]
                          [color (send the-color-database find-color "black")]
                          [mask #f])
     (draw-ellipse x y width height)
     (draw-line x1 y1 x2 y2)
     (draw-lines points [xoffset 0] [yoffset 0])
     (draw-path path
                [xoffset 0] [yoffset 0]
                [fill-style 'odd-even])
     (draw-point x y)
     (draw-polygon points
                   [xoffset 0] [yoffset 0]
                   [fill-style 'odd-even])
     (draw-rectangle x y width height)
     (draw-rounded-rectangle x y width height [radius -0.25])
     (draw-spline x1 y1 x2 y2 x3 y3)
     (draw-text text x y [combine #f] [offset 0] [angle 0])
     (end-doc)
     (end-page)
     (erase)
     (flush)
     (get-alpha)
     (get-background)
     (get-brush)
     (get-char-height)
     (get-char-width)
     (get-clipping-region)
     (get-device-scale)
     (get-font)
     (get-gl-context)
     (get-initial-matrix)
     (get-origin)
     (get-pen)
     (get-rotation)
     (get-scale)
     (get-size)
     (get-smoothing)
     (get-text-background)
     (get-text-extent string [font #f] [combine? #f] [offset 0])
     (get-text-foreground)
     (get-text-mode)
     (get-transformation)
     (glyph-exists? c)
     (ok?)
     (resume-flush)
     (rotate angle)
     (scale x-scale y-scale)
     (set-alpha opacity)
     (set-background color)
     ;(set-brush brush) ;; fixme: this is not quite right
     (set-clipping-rect x y width height)
     (set-clipping-region rgn)
     (set-font font)
     (set-initial-matrix m)
     (set-origin x y)
     ;(set-pen pen) ;; fixme: this is not quite right
     (set-rotation angle)
     (set-scale x-scale y-scale)
     (set-smoothing mode)
     (set-text-background color)
     (set-text-foreground color)
     (set-text-mode mode)
     (set-transformation t)
     (start-doc message)
     (start-page)
     (suspend-flush)
     (transform m)
     (translate dx dy)
     (try-color try result))

    ;; We'll manually write the methods for set-brush and set-pen
    ;; because they're case-lambdas and a bit unusual, rather
    ;; than complicate the macro any further.
    (public set-brush)
    (define set-brush
      (case-lambda [(brush)
                    (send delegate set-brush brush)]
                   [(color style)
                    (send delegate set-brush color style)]))
    (public set-pen)
    (define set-pen
      (case-lambda [(pen)
                    (send delegate set-pen pen)]
                   [(color width style)
                    (send delegate set-pen color width style)]))))

(module+ test
  (define bm (make-bitmap 100 100))
  (define my-dc (new wrapped-dc% [delegate (send bm make-dc)]))
  (send my-dc draw-rectangle 10 10 30 50)
  (print bm)
  (newline)

  (define extended-dc%
    (class wrapped-dc%
      (super-new)
      (inherit draw-arc)
      (define/public (draw-circle x y radius)
        (draw-arc (- x radius) (- y radius)
                  (* 2 radius)
                  (* 2 radius)
                  0
                  (* 2 pi)))))

  (define bm2 (make-bitmap 100 100))
  (define my-new-dc (new extended-dc%
                         [delegate (send bm2 make-dc)]))
  (send my-new-dc set-smoothing 'aligned)
  (send my-new-dc draw-circle 50 50 30)
  (print bm2))

The test
module at the end here shows that we can wrap a dc
and extend it as we want.

Racket is supposed to have some built-in support for this in the
surrogate

form, though I have to admit I haven’t tried it yet. If I have time, I’ll try to cook up an example and revise this answer if it’s an improvement over the above.

Hello, buddy!稿源:Hello, buddy! (源链) | 关于 | 阅读提示

本站遵循[CC BY-NC-SA 4.0]。如您有版权、意见投诉等问题,请通过eMail联系我们处理。
酷辣虫 » 前端开发 » Define custom methods for drawing the context for a canvas

喜欢 (0)or分享给?

专业 x 专注 x 聚合 x 分享 CC BY-NC-SA 4.0

使用声明 | 英豪名录