✨ Parsing and file builder

common/src/app/common/file_builder.cljc

@@ -7,14 +7,52 @@
 (ns app.common.file-builder
   "A version parsing helper."
   (:require
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.common.pages.init :as init]
+   [app.common.geom.shapes :as gsh]
    [app.common.pages.changes :as ch]
-   ))
+   [app.common.pages.init :as init]
+   [app.common.pages.spec :as spec]
+   [app.common.spec :as us]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]))
 
 (def root-frame uuid/zero)
 
+;; This flag controls if we should execute spec validation after every commit
+(def verify-on-commit? true)
+
+(defn- commit-change [file change]
+  (when verify-on-commit?
+    (us/assert ::spec/change change))
+  (-> file
+      (update :changes conj change)
+      (update :data ch/process-changes [change] verify-on-commit?)))
+
+(defn- lookup-objects
+  ([file]
+   (lookup-objects file (:current-page-id file)))
+
+  ([file page-id]
+   (get-in file [:data :pages-index page-id :objects])))
+
+(defn- lookup-shape [file shape-id]
+  (-> (lookup-objects file)
+      (get shape-id)))
+
+(defn- commit-shape [file obj]
+  (let [page-id (:current-page-id file)
+        frame-id (:current-frame-id file)
+        parent-id (-> file :parent-stack peek)]
+    (-> file
+        (commit-change
+         {:type :add-obj
+          :id (:id obj)
+          :page-id page-id
+          :frame-id frame-id
+          :parent-id parent-id
+          :obj obj}))))
+
+;; PUBLIC API
+
 (defn create-file
   ([name]
    (let [id (uuid/next)]
@@ -26,17 +64,8 @@
       ;; We keep the changes so we can send them to the backend
       :changes []})))
 
-;; TODO: Change to `false`
-(def verify-on-commit? true)
-
-(defn commit-change [file change]
-  (-> file
-      (update :changes conj change)
-      (update :data ch/process-changes [change] verify-on-commit?)))
-
 (defn add-page
   [file name]
-
   (let [page-id (uuid/next)]
     (-> file
         (commit-change
@@ -49,22 +78,82 @@
         ;; Current page being edited
         (assoc :current-page-id page-id)
 
+        ;; Current frame-id
+        (assoc :current-frame-id root-frame)
+
         ;; Current parent stack we'll be nesting
         (assoc :parent-stack [root-frame]))))
 
-(defn add-artboard [file data])
+(defn add-artboard [file data]
+  (let [obj (-> (init/make-minimal-shape :frame)
+                (merge data))]
+    (-> file
+        (commit-shape obj)
+        (assoc :current-frame-id (:id obj))
+        (update :parent-stack conj (:id obj)))))
 
-(defn close-artboard [file])
+(defn close-artboard [file]
+  (-> file
+      (assoc :current-frame-id root-frame)
+      (update :parent-stack pop)))
 
-(defn add-group [file data])
-(defn close-group [file data]) 
+(defn add-group [file data]
+  (let [frame-id (:current-frame-id file)
+        selrect init/empty-selrect
+        name (:name data)
+        obj (-> (init/make-minimal-group frame-id selrect name)
+                (merge data))]
+    (-> file
+        (commit-shape obj)
+        (update :parent-stack conj (:id obj)))))
 
-(defn create-rect [file data])
-(defn create-circle [file data])
-(defn create-path [file data])
-(defn create-text [file data])
-(defn create-image [file data])
+(defn close-group [file]
+  (let [group-id (-> file :parent-stack peek)
+        group    (lookup-shape file group-id)
+        shapes   (->> group :shapes (mapv #(lookup-shape file %)))
+        selrect  (gsh/selection-rect shapes)
+        points   (gsh/rect->points selrect)]
 
-(defn close-page [file])
+    (-> file
+        (commit-change
+         {:type :mod-obj
+          :page-id (:current-page-id file)
+          :id group-id
+          :operations
+          [{:type :set :attr :selrect :val selrect}
+           {:type :set :attr :points  :val points}]})
+        (update :parent-stack pop))))
 
-(defn generate-changes [file])
+(defn create-shape [file type data]
+  (let [frame-id (:current-frame-id file)
+        frame (when-not (= frame-id root-frame)
+                (lookup-shape file frame-id))
+        obj (-> (init/make-minimal-shape type)
+                (merge data)
+                (cond-> frame
+                  (gsh/translate-from-frame frame)))]
+    (commit-shape file obj)))
+
+(defn create-rect [file data]
+  (create-shape file :rect data))
+
+(defn create-circle [file data]
+  (create-shape file :circle data))
+
+(defn create-path [file data]
+  (create-shape file :path data))
+
+(defn create-text [file data]
+  (create-shape file :text data))
+
+(defn create-image [file data]
+  (create-shape file :image data))
+
+(defn close-page [file]
+  (-> file
+      (dissoc :current-page-id)
+      (dissoc :parent-stack)))
+
+(defn generate-changes
+  [file]
+  (:changes file))

common/src/app/common/geom/matrix.cljc

@@ -8,6 +8,7 @@
   (:require
    #?(:cljs [cljs.pprint :as pp]
       :clj  [clojure.pprint :as pp])
+   [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.math :as mth]))
 
@@ -25,6 +26,15 @@
   ([a b c d e f]
    (Matrix. a b c d e f)))
 
+(def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
+
+(defn str->matrix
+  [matrix-str]
+  (let [params (->> (re-seq number-regex matrix-str)
+                    (filter #(-> % first empty? not))
+                    (map (comp d/parse-double first)))]
+    (apply matrix params)))
+
 (defn multiply
   ([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
     {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]

common/src/app/common/geom/shapes.cljc

@@ -100,6 +100,10 @@
   [shape {:keys [x y]}]
   (gtr/move shape (gpt/negate (gpt/point x y)))  )
 
+(defn translate-from-frame
+  [shape {:keys [x y]}]
+  (gtr/move shape (gpt/point x y))  )
+
 ;; --- Helpers
 
 (defn fully-contained?

common/src/app/common/pages.cljc

@@ -84,6 +84,7 @@
 (d/export init/make-file-data)
 (d/export init/make-minimal-shape)
 (d/export init/make-minimal-group)
+(d/export init/empty-file-data)
 
 ;; Specs
 

common/src/app/common/pages/init.cljc

@@ -85,6 +85,12 @@
 
    {:type :svg-raw}])
 
+(def empty-selrect
+  {:x  0    :y  0
+   :x1 0    :y1 0
+   :x2 1    :y2 1
+   :width 1 :height 1})
+
 (defn make-minimal-shape
   [type]
   (let [type (cond (= type :curve) :path

frontend/src/app/util/import/parser.cljc

@@ -0,0 +1,164 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.util.import.parser
+  (:require
+   [app.common.data :as d]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.shapes :as gsh]
+   [cuerdas.core :as str]
+   [app.util.path.parser :as upp]))
+
+(defn valid?
+  [root]
+  (contains? (:attrs root) :xmlns:penpot))
+
+(defn branch?
+  [node]
+  (and (contains? node :content)
+       (some? (:content node))))
+
+(defn close?
+  [node]
+  (and (vector? node)
+       (= ::close (first node))))
+
+(defn get-type
+  [node]
+  (if (close? node)
+    (second node)
+    (-> (get-in node [:attrs :penpot:type])
+        (keyword))))
+
+(defn shape?
+  [node]
+  (or (close? node)
+      (contains? (:attrs node) :penpot:type)))
+
+(defn get-attr
+  ([m att]
+   (get-attr m att identity))
+  ([m att val-fn]
+   (let [ns-att (->> att d/name (str "penpot:") keyword)
+         val (get-in m [:attrs ns-att])]
+     (when val (val-fn val)))))
+
+(defn get-children
+  [node]
+  (cond-> (:content node)
+    ;; We add a "fake" node to know when we are leaving the shape children
+    (shape? node)
+    (conj [::close (get-type node)])))
+
+(defn node-seq
+  [content]
+  (->> content (tree-seq branch? get-children)))
+
+(defn get-transform
+  [type node])
+
+(defn parse-style
+  "Transform style list into a map"
+  [style-str]
+  (if (string? style-str)
+    (->> (str/split style-str ";")
+         (map str/trim)
+         (map #(str/split % ":"))
+         (group-by first)
+         (map (fn [[key val]]
+                (vector (keyword key) (second (first val)))))
+         (into {}))
+    style-str))
+
+(defn add-attrs
+  [m attrs]
+  (reduce-kv
+   (fn [m k v]
+     (if (#{:style :data-style} k)
+       (assoc m :style (parse-style v))
+       (assoc m k v)))
+   m
+   attrs))
+
+(defn get-data-node
+  [node]
+
+  (let [data-tags #{:ellipse :rect :path}]
+    (->> node
+         (node-seq)
+         (filter #(contains? data-tags (:tag %)))
+         (map #(:attrs %))
+         (reduce add-attrs {}))))
+
+(def search-data-node? #{:rect :image :path :text :circle})
+(def has-position? #{:frame :rect :image :text})
+
+(defn parse-position
+  [props data]
+  (let [values (->> (select-keys data [:x :y :width :height])
+                    (d/mapm (fn [_ val] (d/parse-double val))))]
+    (d/merge props values)))
+
+(defn parse-circle
+  [props data]
+  (let [values (->> (select-keys data [:cx :cy :rx :ry])
+                    (d/mapm (fn [_ val] (d/parse-double val))))]
+
+    {:x (- (:cx values) (:rx values))
+     :y (- (:cy values) (:ry values))
+     :width (* (:rx values) 2)
+     :height (* (:ry values) 2)}))
+
+(defn parse-path
+  [props data]
+  (let [content (upp/parse-path (:d data))
+        selrect (gsh/content->selrect content)
+        points (gsh/rect->points selrect)]
+
+    (-> props
+        (assoc :content content)
+        (assoc :selrect selrect)
+        (assoc :points points))))
+
+(defn extract-data
+  [type node]
+  (let [data (if (search-data-node? type)
+               (get-data-node node)
+               (:attrs node))]
+    (cond-> {}
+      (has-position? type)
+      (-> (parse-position data)
+          (gsh/setup-selrect))
+
+      (= type :circle)
+      (-> (parse-circle data)
+          (gsh/setup-selrect))
+
+      (= type :path)
+      (parse-path data))))
+
+(defn str->bool
+  [val]
+  (= val "true"))
+
+(defn parse-data
+  [type node]
+
+  (when-not (close? node)
+    (let [name              (get-attr node :name)
+          blocked           (get-attr node :blocked str->bool)
+          hidden            (get-attr node :hidden str->bool)
+          transform         (get-attr node :transform gmt/str->matrix)
+          transform-inverse (get-attr node :transform-inverse gmt/str->matrix)]
+
+      (-> (extract-data type node)
+          (assoc :name name)
+          (assoc :blocked blocked)
+          (assoc :hidden hidden)
+          (cond-> (some? transform)
+            (assoc :transform transform))
+          (cond-> (some? transform-inverse)
+            (assoc :transform-inverse transform-inverse))))))

frontend/src/app/util/object.cljs

@@ -6,7 +6,7 @@
 
 (ns app.util.object
   "A collection of helpers for work with javascript objects."
-  (:refer-clojure :exclude [set! get get-in merge clone])
+  (:refer-clojure :exclude [set! get get-in merge clone contains?])
   (:require
    [cuerdas.core :as str]
    [goog.object :as gobj]
@@ -22,6 +22,10 @@
    (let [result (get obj k)]
      (if (undefined? result) default result))))
 
+(defn contains?
+  [obj k]
+  (some? (unchecked-get obj k)))
+
 (defn get-keys
   [obj]
   (js/Object.keys ^js obj))

frontend/src/app/util/path/parser.cljs

@@ -9,14 +9,13 @@
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.path :as gshp]
+   [app.common.math :as mth]
    [app.util.path.arc-to-curve :refer [a2c]]
    [app.util.path.commands :as upc]
-   [app.util.svg :as usvg]
-   [cuerdas.core :as str]
-   [clojure.set :as set]
-   [app.common.math :as mth]
    [app.util.path.geom :as upg]
-   ))
+   [app.util.svg :as usvg]
+   [clojure.set :as set]
+   [cuerdas.core :as str]))
 
 ;;
 (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")

frontend/src/app/util/svg.cljs

@@ -745,8 +745,6 @@
       (reduce gmt/multiply (gmt/matrix) matrices))
     (gmt/matrix)))
 
-
-
 (defn format-move [[x y]] (str "M" x " " y))
 (defn format-line [[x y]] (str "L" x " " y))