Nodgui tips

(asdf:make "nodgui")

(use-package 'nodgui)

(defun bind-red (e)
  (declare (ignore e))
  (do-msg "click on red!"))

(defun bind-green (e)
  (declare (ignore e))
  (do-msg "click on green!"))


(with-nodgui ()
  (let* ((size 500)
         (canvas (make-canvas nil :width size :height size))
         (arc1 (create-arc canvas
                           (/ size 4) (/ size 4)
                           (* size 3/4) (* size 3/4) :start 0 :extent 180))
         (arc2 (create-arc canvas
                           (/ size 4) (/ size 4)
                           (* size 3/4) (* size 3/4) :start 180 :extent 180)))
    (itemconfigure canvas arc1 "fill" "#ff0000")
    (itemconfigure canvas arc2 "fill" "#00ff00")
    (itemconfigure canvas arc1 "tag" "red")
    (itemconfigure canvas arc2 "tag" "green")
    (tagbind canvas "red" "<ButtonPress-1>" #'bind-red)
    (tagbind canvas "green" "<ButtonPress-1>" #'bind-green)
    (pack canvas)))

(asdf:make "nodgui")

(defpackage :arrow
  (:use :cl
        :nodgui))

(in-package :arrow)

(defun deg->rad (deg)
  (/ (* deg (* 2 pi)) 360))

(defun rotate-point (x y angle)
  (values (- (* x (cos angle)) (* y (sin angle)))
          (+ (* x (sin angle)) (* y (cos angle)))))

(defun main (angle &key (draw-center->end nil))
  (with-nodgui ()
    (let* ((canvas (make-canvas nil :width 640 :height 480))
           (arr-x-start   0)
           (arr-y-start   0)
           (arr-x-end    20)
           (arr-y-end    20)
           (bb-x-start  100)
           (bb-y-start  100)
           (bb-x-end    240)
           (bb-y-end    340)
           (rangle      (deg->rad (- angle)))
           (x-center    (+ bb-x-start (/ (- bb-x-end bb-x-start) 2)))
           (y-center    (+ bb-y-start (/ (- bb-y-end bb-y-start) 2)))
           (a-axe       (-  bb-x-end x-center))
           (b-axe       (-  bb-y-end y-center))
           (arc-x-end   (* a-axe (cos rangle)))
           (arc-y-end   (* b-axe (sin rangle))))
      (create-arc canvas
                  bb-x-start
                  bb-y-start
                  bb-x-end
                  bb-y-end
                  :style "arc"
                  :extent angle)
      (let ((h1 (create-line* canvas
                              x-center y-center
                              (+ x-center a-axe)
                              y-center))
            (h2 (create-line* canvas
                              x-center y-center
                              x-center
                              (+ y-center b-axe))))
        (itemconfigure canvas h1 "fill" "#ff0000")
        (itemconfigure canvas h2 "fill" "#00ff00"))
      (when draw-center->end
        (let ((h3 (create-line* canvas
                                x-center y-center
                                (+ x-center arc-x-end)
                                (+ y-center arc-y-end))))
          (itemconfigure canvas h3 "fill" "#ff00ff")))
      (multiple-value-bind (xrot-start yrot-start)
          (rotate-point arr-x-start arr-y-start rangle)
        (multiple-value-bind (xrot-end yrot-end)
            (rotate-point arr-x-end arr-y-end rangle)
          (incf xrot-start (+ x-center arc-x-end))
          (incf yrot-start (+ y-center arc-y-end))
          (incf xrot-end  (+ x-center arc-x-end))
          (incf yrot-end   (+ y-center arc-y-end))
          (create-line* canvas xrot-start yrot-start xrot-end yrot-end)))
      (multiple-value-bind (xrot-start yrot-start)
          (rotate-point arr-x-start arr-y-start (+ (deg->rad 90) rangle))
        (multiple-value-bind (xrot-end yrot-end)
            (rotate-point arr-x-end arr-y-end (+ (deg->rad 90) rangle))
          (setf arr-x-start xrot-start)
          (setf arr-y-start yrot-start)
          (setf arr-x-end   xrot-end)
          (setf arr-y-end   yrot-end)
          (incf arr-x-start (+ x-center arc-x-end))
          (incf arr-y-start (+ y-center arc-y-end))
          (incf arr-x-end   (+ x-center arc-x-end))
          (incf arr-y-end   (+ y-center arc-y-end)))
        (create-line* canvas arr-x-start arr-y-start arr-x-end arr-y-end))
      (pack canvas))))