Improved make curve options

This commit is contained in:
alonso.torres 2021-04-20 21:22:15 +02:00
parent de11e85d2b
commit c7683dfd80
8 changed files with 305 additions and 141 deletions

View file

@ -53,22 +53,43 @@
:c2x (:x h2)
:c2y (:y h2)}))
(defn make-curve-to [to h1 h2]
(defn update-curve-to
[command h1 h2]
(-> command
(assoc :command :curve-to)
(assoc-in [:params :c1x] (:x h1))
(assoc-in [:params :c1y] (:y h1))
(assoc-in [:params :c2x] (:x h2))
(assoc-in [:params :c2y] (:y h2))))
(defn make-curve-to
[to h1 h2]
{:command :curve-to
:relative false
:params (make-curve-params to h1 h2)})
(defn apply-content-modifiers [content modifiers]
(defn update-handler
[command prefix point]
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
(-> command
(assoc-in [:params cox] (:x point))
(assoc-in [:params coy] (:y point)))))
(defn apply-content-modifiers
"Apply to content a map with point translations"
[content modifiers]
(letfn [(apply-to-index [content [index params]]
(if (contains? content index)
(cond-> content
(and
(or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
(= :line-to (get-in content [index :params :command])))
(= :line-to (get-in content [index :command])))
(-> (assoc-in [index :command] :curve-to)
(assoc-in [index :params] :curve-to) (make-curve-params
(get-in content [index :params])
(get-in content [(dec index) :params])))
(assoc-in [index :params]
(make-curve-params
(get-in content [index :params])
(get-in content [(dec index) :params]))))
(:x params) (update-in [index :params :x] + (:x params))
(:y params) (update-in [index :params :y] + (:y params))
@ -117,6 +138,7 @@
(mapv (fn [[index _]] index))))
(defn handler-indices
"Return an index where the key is the positions and the values the handlers"
[content point]
(->> (d/with-prev content)
(d/enumerate)
@ -132,16 +154,24 @@
(defn opposite-index
"Calculate sthe opposite index given a prefix and an index"
[content index prefix]
(let [point (if (= prefix :c2)
(command->point (nth content index))
(command->point (nth content (dec index))))
handlers (-> (content->handlers content)
(get point))
point->handlers (content->handlers content)
opposite-prefix (if (= prefix :c1) :c2 :c1)]
(when (<= (count handlers) 2)
handlers (->> point
(point->handlers )
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)) )))]
(when (= (count handlers) 1)
(->> handlers
(d/seek (fn [[index prefix]] (= prefix opposite-prefix)))
(first)))))
first))))
(defn get-commands
"Returns the commands involving a point with its indices"
[content point]
(->> (d/enumerate content)
(filterv (fn [[idx cmd]] (= (command->point cmd) point)))))

View file

@ -54,59 +54,113 @@
(reduce change-content $ handlers)
(remove-line-curves $))))
(defn line->curve
[from-p cmd]
(let [to-p (upc/command->point cmd)
v (gpt/to-vec from-p to-p)
d (gpt/distance from-p to-p)
dv1 (-> (gpt/normal-left v)
(gpt/scale (/ d 3)))
h1 (gpt/add from-p dv1)
dv2 (-> (gpt/to-vec to-p h1)
(gpt/unit)
(gpt/scale (/ d 3)))
h2 (gpt/add to-p dv2)]
(-> cmd
(assoc :command :curve-to)
(assoc-in [:params :c1x] (:x h1))
(assoc-in [:params :c1y] (:y h1))
(assoc-in [:params :c2x] (:x h2))
(assoc-in [:params :c2y] (:y h2)))))
(defn make-curve-point
"Changes the content to make the point a 'curve'. The handlers will be positioned
in the same vector that results from te previous->next points but with fixed length."
[content point]
(let [content-next (d/enumerate (d/with-prev-next content))
make-curve
(fn [command previous]
(if (= :line-to (:command command))
(let [cur-point (upc/command->point command)
pre-point (upc/command->point previous)]
(-> command
(assoc :command :curve-to)
(assoc :params (upc/make-curve-params cur-point pre-point))))
command))
(let [make-curve-cmd (fn [cmd h1 h2]
(-> cmd
(update :params assoc
:c1x (:x h1) :c1y (:y h1)
:c2x (:x h2) :c2y (:y h2))))
update-handler
(fn [command prefix handler]
(if (= :curve-to (:command command))
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> command
(assoc-in [:params cx] (:x handler))
(assoc-in [:params cy] (:y handler))))
command))
indices (upc/point-indices content point)
vectors (->> indices (mapv (fn [index]
(let [cmd (nth content index)
prev-i (dec index)
prev (when (not (= :move-to (:command cmd)))
(get content prev-i))
next-i (inc index)
next (get content next-i)
calculate-vector
(fn [point next prev]
(let [base-vector (if (or (nil? next) (nil? prev) (= next prev))
(-> (gpt/to-vec point (or next prev))
(gpt/normal-left))
(gpt/to-vec next prev))]
(-> base-vector
(gpt/unit)
(gpt/multiply (gpt/point 100)))))
next (when (not (= :move-to (:command next)))
next)]
(hash-map :index index
:prev-i (when (some? prev) prev-i)
:prev-c prev
:prev-p (upc/command->point prev)
:next-i (when (some? next) next-i)
:next-c next
:next-p (upc/command->point next)
:command cmd)))))
redfn (fn [content [index [command prev next]]]
(if (= point (upc/command->point command))
(let [prev-point (if (= :move-to (:command command)) nil (upc/command->point prev))
next-point (if (= :move-to (:command next)) nil (upc/command->point next))
handler-vector (calculate-vector point next-point prev-point)
handler (gpt/add point handler-vector)
handler-opposite (gpt/add point (gpt/negate handler-vector))]
(-> content
(d/update-when index make-curve prev)
(d/update-when index update-handler :c2 handler)
(d/update-when (inc index) make-curve command)
(d/update-when (inc index) update-handler :c1 handler-opposite)))
content))]
(as-> content $
(reduce redfn $ content-next)
(remove-line-curves $))))
points (->> vectors (mapcat #(vector (:next-p %) (:prev-p %))) (remove nil?) (into #{}))]
(cond
(= (count points) 2)
;;
(let [v1 (gpt/to-vec (first points) point)
v2 (gpt/to-vec (first points) (second points))
vp (gpt/project v1 v2)
vh (gpt/subtract v1 vp)
add-curve
(fn [content {:keys [index prev-p next-p next-i]}]
(let [cur-cmd (get content index)
next-cmd (get content next-i)
;; New handlers for prev-point and next-point
prev-h (when (some? prev-p) (gpt/add prev-p vh))
next-h (when (some? next-p) (gpt/add next-p vh))
;; Correct 1/3 to the point improves the curve
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
next-h (when (some? next-h) (gpt/add next-h next-correction))
]
(cond-> content
(and (= :line-to (:command cur-cmd)) (some? prev-p))
(update index upc/update-curve-to prev-p prev-h)
(and (= :line-to (:command next-cmd)) (some? next-p))
(update next-i upc/update-curve-to next-h next-p)
(and (= :curve-to (:command cur-cmd)) (some? prev-p))
(update index upc/update-handler :c2 prev-h)
(and (= :curve-to (:command next-cmd)) (some? next-p))
(update next-i upc/update-handler :c1 next-h))))]
(->> vectors (reduce add-curve content)))
:else
(let [add-curve
(fn [content {:keys [index command prev-p next-c next-i]}]
(cond-> content
(and (= :line-to (:command command)))
(update index #(line->curve prev-p %))
(and (= :line-to (:command next-c)))
(update next-i #(line->curve point %))))]
(->> vectors (reduce add-curve content))))))
(defn get-segments
"Given a content and a set of points return all the segments in the path