131 lines
5 KiB
Clojure
131 lines
5 KiB
Clojure
(ns heyarne.rect-packing.core
|
||
(:require [reagent.core :as r]
|
||
[reagent.dom :as dom]
|
||
[thi.ng.geom.core :as geom]
|
||
[thi.ng.geom.rect :as rect]
|
||
[thi.ng.geom.vector :as v]
|
||
[fipp.edn :refer [pprint]]))
|
||
|
||
(defonce state (r/atom {:rects []
|
||
:frame (rect/rect 500 500)}))
|
||
|
||
(comment
|
||
|
||
(swap! state assoc :rects [])
|
||
(swap! state update :rects conj (rect/rect 200 200))
|
||
|
||
;; fill with random rectangles
|
||
(swap! state assoc :rects (repeatedly 100 #(rect/rect 50 50)))
|
||
|
||
)
|
||
|
||
|
||
(defn pack-rects-naive
|
||
"Sorts all rectangles by height and places them next to each other into frame,
|
||
starting at the top left."
|
||
[frame rects]
|
||
(let [rects (sort-by (comp - geom/height) rects)]
|
||
(-> (reduce (fn [acc rect]
|
||
;; a word on "top" vs "bottom": the thi.ng coordinate system
|
||
;; works like the ones you know from scool, i.e. [0 1] is
|
||
;; above [0 0]. the svg coordinate system uses screen
|
||
;; coordinates, where [0 0] is at the top left. if you see
|
||
;; rect/bottom we're actually looking at the top edge that is
|
||
;; drawn in the svg.
|
||
(let [last-placed (or (last (:result acc)) (rect/rect 0 0))
|
||
moved-right (geom/translate rect [(rect/right last-placed) (rect/bottom (:row-start acc))])]
|
||
;; do we still have enough space to the right?
|
||
(if (<= (rect/right moved-right) (rect/right frame))
|
||
;; if yes, everything is bon
|
||
(update acc :result conj moved-right)
|
||
;; if no, move to the bottom
|
||
(let [moved-bottom (geom/translate rect [0 (rect/top (:row-start acc))])]
|
||
(-> (assoc acc :row-start moved-bottom)
|
||
(update :result conj moved-bottom))))))
|
||
{:row-start (first rects)
|
||
:result []}
|
||
rects)
|
||
:result)))
|
||
|
||
#_(pack-rects-naive (:frame @state) (:rects @state))
|
||
|
||
#_(->> (pack-rects-naive (:frame @state) (:rects @state))
|
||
(group-by :size)
|
||
(into (sorted-map-by geom/height)))
|
||
|
||
(defn by-size [rects]
|
||
(->> (group-by (comp reverse :size) rects)
|
||
(into (sorted-map-by (comp (partial * -1) compare)))))
|
||
|
||
(defn add-parts-to-cut! [order]
|
||
(let [rects (repeatedly (:num order) #(rect/rect (:width order) (:height order)))]
|
||
(swap! state update :rects (comp vec concat) rects)))
|
||
|
||
(defn order []
|
||
(let [base-order {:num 1
|
||
:width 100
|
||
:height 100}
|
||
addition (r/atom base-order)]
|
||
(fn []
|
||
(let [to-add @addition]
|
||
[:p "Add part to cut: "]
|
||
[:form {:on-submit (fn [e]
|
||
(.preventDefault e)
|
||
(add-parts-to-cut! @addition)
|
||
(reset! addition base-order))}
|
||
[:input.num-rects {:type "number"
|
||
:on-change #(swap! addition assoc :num (js/parseInt (.. % -target -value) 10))
|
||
:value (:num to-add)}] " × "
|
||
[:input.rect-dim {:type "number"
|
||
:on-change #(swap! addition assoc :width (js/parseInt (.. % -target -value) 10))
|
||
:value (:width to-add)}] " cm by "
|
||
[:input.rect-dim {:type "number"
|
||
:on-change #(swap! addition assoc :height (js/parseInt (.. % -target -value) 10))
|
||
:value (:height to-add)}] " cm "
|
||
[:button "Add"]]))))
|
||
|
||
(defn debug [val]
|
||
[:pre (with-out-str (pprint val))])
|
||
|
||
(defn inventory [rects]
|
||
(prn "re-rendering inventory with rects" rects)
|
||
[:<>
|
||
[order]
|
||
(when (seq rects)
|
||
[:<>
|
||
[:p "List of parts to cut:"]
|
||
[debug (by-size rects)]
|
||
#_[:ul
|
||
(for [[size rects] (by-size rects)
|
||
:let [k (pr-str size)]]
|
||
^{:key k}
|
||
[:li [:input.num-rects {:type "number"
|
||
#_#_ :on-change #(update-rects! rects size (js/Number. (-> % .-target .-value)))
|
||
#_#_ :value (str (count rects))}] (str " x " (:x size) "x" (:y size))])]])])
|
||
|
||
(defn visualization [frame packed-rects]
|
||
[:svg.visualization {:viewBox "-0.5 -0.5 501 501" :xmlns "http://www.w3.org/2000/svg"}
|
||
[:rect {:width (geom/width frame)
|
||
:height (geom/height frame)}]
|
||
(for [[idx rect] (map-indexed vector packed-rects)
|
||
:let [[x y] (:p rect)
|
||
w (geom/width rect)
|
||
h (geom/height rect)]]
|
||
^{:key idx} [:<>
|
||
[:rect {:width w :height h :x x :y y}]
|
||
[:text {:x x :y y :dx 4 :dy 14} (str w "x" h)]])])
|
||
|
||
(defn main []
|
||
(let [{:keys [frame rects]} @state
|
||
packed (pack-rects-naive frame rects)]
|
||
[:main
|
||
[:h1 "Visualization"]
|
||
[visualization frame packed]
|
||
[:h2 "Rectangles"]
|
||
[inventory rects]]))
|
||
|
||
(defn ^:dev/after-load init []
|
||
(println "Initializing…")
|
||
(dom/render [main] (.querySelector js/document "#app")))
|
||
|
||
(defonce app (init))
|