A library-grade annulus drawing function.

annulus.rkt

#lang racket
(require racket/draw pict)
(define (nonneg-real? x) (and (real? x) (>= x 0)))
(define style/c
  (one-of/c 'transparent 'solid 'xor 'hilite
            'dot 'long-dash 'short-dash 'dot-dash
            'xor-dot 'xor-long-dash 'xor-short-dash
            'xor-dot-dash))
(define (within-width-and-height w h)
  (make-contract #:name (format "within width and height ~a ~a" w h)
                 #:first-order
                 (λ (rw)
                    (define 2v (* 2 rw))
                    (and (positive? (- w 2v))
                         (positive? (- h 2v))))))
(provide (contract-out
           [annulus
                   (->i ([w nonneg-real?]
                         [h nonneg-real?]
                         [rw (w h) (and/c nonneg-real? (within-width-and-height w h))])
                        [#:color [color (or/c #f color/c)]
                         #:style [style style/c]
                         #:border-width [border-width nonneg-real?]
                         #:border-color [border-color (or/c #f color/c)]
                         #:border-style [border-style style/c]]
                        [result pict?])]))

(define (annulus w h rw
                 #:color [color #f]
                 #:style [style 'solid]
                 #:border-color [border-color #f]
                 #:border-width [border-width 1]
                 #:border-style [border-style 'solid])
  (dc (lambda (dc x y)
        (define p (new dc-path%))
        (define w2 (/ w 2))
        (define h2 (/ h 2))
        (define 2rw (* 2 rw))
        
        (send p move-to (- w rw) h2)
        (send p arc rw rw (- w 2rw) (- h 2rw) 0 (* 2 pi))
        (send p move-to w h2)
        (send p arc 0 0 w h 0 (* 2 pi))
        (send p translate x y)
        (send p close)
        
        (define brush (if color
                          (send the-brush-list find-or-create-brush color style)
                          (send the-brush-list find-or-create-brush "white" 'transparent)))
        (define pen (if border-color
                        (send the-pen-list find-or-create-pen border-color border-width border-style)
                        (send the-pen-list find-or-create-pen "black" 1 'transparent)))
        (with-save* dc ([get-brush set-brush brush]
                        [get-pen set-pen pen])
          (send dc draw-path p)))
      w h))