2

在 Racket 中，我知道如何canvas%使用自己的 on-event 方法制作自己的自定义类：

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

我想对返回的绘图上下文进行类似的更改，(send canvas get-dc)以便它具有更多绘图方法。如果我创建一个自定义my-dc%类，我将不得不找到一种方法来 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)))

这样我以后就可以(send dc draw-circle 100 100 20)像其他绘图方法一样画一个圆。

4

2 回答 2

1

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

您必须改为创建draw-circle一个函数：

(define (draw-circle dc x y radius)
  (send dc draw-arc ....))
于 2013-02-23T00:10:49.327 回答
1

您可能可以编写一个容器，将大部分工作委托给包含的 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模块表明我们可以包装 adc并根据需要扩展它。

Racket 应该在表单中对此有一些内置的支持surrogate，尽管我不得不承认我还没有尝试过。如果我有时间，我会尝试编写一个示例并修改此答案，如果它是对上述内容的改进。

于 2013-02-23T01:00:30.360 回答