round-arrow.lsp.glisp

(defn round-rect
	{:doc "Draw a round rect"
	 :handles
		{:draw (fn [e]
		           (let [params (get e :params)
		                 [pos rect r] params
		                 top-left (rect2d/point rect)
		                 rect2d-e {:params [rect]}]
		                `[~{:type "path" :guide true
		                    :class "dashed"
		                    :path (line top-left
		                                (vec2/+ top-left [r r]))}
		                  ~@(apply-draw-handle rect2d rect2d-e)
		                  ~{:id :radius
		                    :type "arrow"
		                    :angle (deg 45)
		                    :pos (vec2/+ top-left [r r])}
		                  ~{:id :pos
		                    :type "translate"
		                    :pos pos}]))
			:drag (fn [e]
			          (let [params (get e :params)
			                id (get e :id)
			                pos (get e :pos)
			                [_ rect r] params
			                rect2d-e (assoc e :params [rect])]
			               (case id
			               	:pos
			               	{:replace [0 pos]}
			               	:radius
			               	{:replace [2 (clamp 0
			               	                    (/ (min (rect2d/width rect)
			               	                            (rect2d/height rect))
			               	                       2)
			               	                    (- (.x pos) (rect2d/left rect)))]}
			               	{:replace [1 (first (apply-drag-handle rect2d rect2d-e))]})))
		}}
	[pos [left top w h] r]
	(let [right (+ left w)
	      bottom (+ top h)]
	  (path/unite
	  	(let [center (rect2d/center [left top w h])
	  	      perp (->> (vec2/- pos center)
	  	                (vec2/normalize )
	  	                (vec2/rotate [0 0] (deg 90)))]
	  	     (polygon pos
	  	              (vec2/scale-add center perp 30)
	  	              (vec2/scale-add center perp -30)))
	  (path/join
		  (line [(+ left r) top] [(- right r) top])
		  (arc [(- right r) (+ top r)] r (deg -90) 0)
		  (line [right (+ top r)] [right (- bottom r)])
		  (arc [(- right r) (- bottom r)] r 0 (deg 90))
		  (line [(- right r) bottom] [(+ left r) bottom])
		  (arc [(+ left r) (- bottom r)] r (deg 90) (deg 180))
		  (line [left (- bottom r)] [left (+ top r)])
		  (arc [(+ left r) (+ top r)] r (deg 180) (deg 270))))))

(defn fc/arrow
  {:doc "Draw an arrow"
   :params [{:type "vec2"}
            {:type "vec2"}
            {:type "boolean"}]
   :handles {:draw (fn {:params [start end dir]}
                     [{:type "path" :guide true :class "dashed"
                       :path (line [(.x start) (.y end)] [(.x end) (.y start)])}
                      {:id :start :type "translate" :pos start}
                      {:id :end :type "translate" :pos end}
                      {:id :dir :type "dia"
                       :pos (if dir
                              [(.x start) (.y end)]
                              [(.x end) (.y start)])}])
             :drag (fn {:id id :pos pos :params [start end]}
                     (case id
                       :start {:replace [0 pos]}
                       :end {:replace [1 pos]}
                       :dir {:replace [2
                                       (let [AB (vec2/- end start)
                                             inv (pos? (* (.x AB) (.y AB)))
                                             dir (pos? (vec2/dot
                                                        (vec2/- pos start)
                                                        (vec2/rotate [0 0]
                                                                     (deg -90)
                                                                     AB)))]

                                         (if inv (not dir) dir))]}))}}

  [start end dir]
  (let [mid (if dir
              [(.x start) (.y end)]
              [(.x end) (.y start)])
        spline [:path :M start :C mid mid end]]
    (style []
           spline
           (g {:transform (path/align-at 1 spline)
               :style [(no-stroke) (fill *stroke-color*)]}
              (ngon [0 0] (* 2 *stroke-width*) 3)))))


:start-sketch

#@{:expanded true}(style (stroke "#8ACBE0" 16.4)
       (fc/arrow [-414.9571 68.6249] [-239.0972 -81.1309] false)
        (fc/arrow [-414.9571 68.6249] [-279.6274 186.7808] false)
        (fc/arrow [-414.9571 68.6249] [-156.6628 151.0592] false)
        (fc/arrow [-414.9571 68.6249] [-329.9838 -105.8225] true)
        (fc/arrow [-414.9571 68.6249] [-562.5529 -96.0814] false)
        (fc/arrow [-414.9571 68.6249] [-583.2528 197.3697] true)
        (fc/arrow [-562.5529 -13.2819] [-764.681 173.0169] false)
        (fc/arrow [-515.0649 196.152] [-393.301 436.027] false)
        (round-rect [-11.7157 -149.1393] [-76.9025 -52.5486 211.4339 172.2776] 18.4002))