定义绘制画布上下文的自定义方法

Question

在Racket中，我知道如何使用自己的事件方法创建自己的自定义canvas%类：

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

我想对(send canvas get-dc)返回的绘图上下文进行类似的更改，以便它有更多的绘图方法。如果我制作了自定义my-dc%课程，我必须找到一种方法，使用{{1}调用my-canvas%返回 而不是普通dc% }}。这可能吗？

更具体地说，get-dc看起来像这样（我定义的my-dc%应该使用内置的draw-circle）：

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))) 一样画一个圆圈，就像其他绘图方法一样。

Answer 1

不，基于查看文档和源代码，我认为不可能更改画布使用的dc<%>类。

你必须改为使用draw-circle函数：

(define (draw-circle dc x y radius)
  (send dc draw-arc ....))

Answer 2

您可以编写一个容器，将大部分工作委托给包含的dc％。你可以这样做：

#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...
))

浏览dc<%>界面中列出的所有方法。这种方法无疑是相当暴力的，但它应该有效。然后你可以添加你想要的任何额外的方法，因为它是你的。

这是一个完整的例子，使用一些宏来减少我本来会做的一堆复制和粘贴：

#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))

此处末尾的test模块显示我们可以包装dc并根据需要进行扩展。

Racket应该以surrogate形式为此提供一些内置支持，但我不得不承认我还没有尝试过。如果我有时间，我会尝试做一个例子并修改这个答案，如果这是对上述的改进。