- (unless (and (zerop width) (zerop height))
- (let ((x1 (+ x0 width))
- (y1 (+ y0 height)))
- (cond
- ((and (< (* 0.5 width) radius) (< (* 0.5 height) radius))
- (cairo:move-to cr x0 (* 0.5 (+ y0 y1)))
- (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0)
- (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1)))
- (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1)
- (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1))))
- ((< (* 0.5 width) radius)
- (cairo:move-to cr x0 (+ y0 radius))
- (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0)
- (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius))
- (cairo:line-to cr x1 (- y1 radius))
- (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1)
- (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius)))
- ((< (* 0.5 height) radius)
- (cairo:move-to cr x0 (* 0.5 (+ y0 y1)))
- (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0)
- (cairo:line-to cr (- x1 radius) y0)
- (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1)))
- (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1)
- (cairo:line-to cr (+ x0 radius) y1)
- (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1))))
- (t
- (cairo:move-to cr x0 (+ y0 radius))
- (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0)
- (cairo:line-to cr (- x1 radius) y0)
- (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius))
- (cairo:line-to cr x1 (- y1 radius))
- (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1)
- (cairo:line-to cr (+ x0 radius) y1)
- (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius))))
- (cairo:close-path cr)
-
- (cairo:set-source-color cr 0.5 0.5 1.0)
- (cairo:fill cr t)
- (cairo:set-source-color cr 0.5 0.0 0.0 0.5)
- (cairo:stroke cr)))))
-