(in-package :clim-user)

(defun run (m)
  (ignore-errors (window-clear m))
  (with-translation (m 400 400)
    (let* ((n 6)
           (d 80)
           (r 300)
           (foo 80)
           (arrow-len 30)
           (arrow-width 24)
           (lw 10)
           (entry-fudge lw)
           (fs (* 4/3 r))
           )
      (with-text-style (m (make-text-style :sans-serif :roman fs))
        (with-rotation (m pi)
          (draw-text* m "A" 0 0 :align-x :center :align-y :center
                      :transform-glyphs t)))
      (with-drawing-options (m :line-cap-shape :round :line-thickness lw)
        (let ((dphi (/ (* 2 pi) n)))
          (loop for k below n do
                (with-rotation (m (* dphi k))
                  (with-translation (m 0 (- r))
                    (draw-rectangle* m (* -1 d) (* -1/2 d) (* 1 d) (* 1/2 d) :filled nil)
                    (draw-line* m 0 (* -1/2 d) 0 (* 1/2 d)))
                  (let ((entry-dx (- (+ d entry-fudge))))
                    (multiple-value-bind (x1 y1) (values (/ d 2) (- r))
                      (multiple-value-bind (x2 y2)
                          (transform-position (make-rotation-transformation dphi)
                                              entry-dx (- r))
                        (multiple-value-bind (x3 y3) (values (+ (/ d 2) foo) (- r))
                          (multiple-value-bind (x4 y4) 
                              (transform-position (make-rotation-transformation dphi)
                                                  (- entry-dx foo) (- r))
                            (draw-bezier* m (list x1 y1 x3 y3 x4 y4 x2 y2))
                            (with-rotation (m dphi)
                              (with-translation (m entry-dx (- r))
                                (draw-line* m (- arrow-len) (- arrow-width) 0 0)
                                (draw-line* m (- arrow-len) (+ arrow-width) 0 0)))
                            )))))))))))
  (force-output m))