diff --git a/exporter/src/app/http/export_svg.cljs b/exporter/src/app/http/export_svg.cljs index db4d9da1c..ec310b68e 100644 --- a/exporter/src/app/http/export_svg.cljs +++ b/exporter/src/app/http/export_svg.cljs @@ -5,95 +5,114 @@ ;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; defined by the Mozilla Public License, v. 2.0. ;; -;; Copyright (c) 2020-2021 UXBOX Labs SL +;; Copyright (c) UXBOX Labs SL (ns app.http.export-svg (:require - [cuerdas.core :as str] - [clojure.walk :as walk] + ["path" :as path] + ["xml-js" :as xml] [app.browser :as bwr] - [app.config :as cfg] - [lambdaisland.glogi :as log] - [cljs.spec.alpha :as s] - [promesa.core :as p] - [app.common.exceptions :as exc :include-macros true] [app.common.data :as d] + [app.common.exceptions :as exc :include-macros true] [app.common.pages :as cp] [app.common.spec :as us] - ["xml-js" :as xml] - ["child_process" :as chp] - ["os" :as os] - ["path" :as path] - ["fs" :as fs]) + [app.config :as cfg] + [app.util.shell :as sh] + [cljs.spec.alpha :as s] + [clojure.walk :as walk] + [cuerdas.core :as str] + [lambdaisland.glogi :as log] + [promesa.core :as p]) (:import goog.Uri)) (log/set-level "app.http.export-svg" :trace) -(defn- create-tmpdir! - [prefix] - (p/create - (fn [resolve reject] - (fs/mkdtemp (path/join (os/tmpdir) prefix) - (fn [err dir] - (if err - (reject err) - (resolve dir))))))) - -(defn- write-file! - [fpath content] - (p/create - (fn [resolve reject] - (fs/writeFile fpath content (fn [err] - (if err - (reject err) - (resolve nil))))))) -(defn- read-file - [fpath] - (p/create - (fn [resolve reject] - (fs/readFile fpath (fn [err content] - (if err - (reject err) - (resolve content))))))) - -(defn- run-cmd! - [cmd] - (p/create - (fn [resolve reject] - (log/trace :fn :run-cmd :cmd cmd) - (chp/exec cmd #js {:encoding "buffer"} - (fn [error stdout stderr] - ;; (log/trace :fn :run-cmd :stdout stdout) - (if error - (reject error) - (resolve stdout))))))) - -(defn- rmdir! - [path] - (p/create - (fn [resolve reject] - (fs/rmdir path #js {:recursive true} - (fn [err] - (if err - (reject err) - (resolve nil))))))) - -(defn- parse-xml +(defn- xml->clj [data] (js->clj (xml/xml2js data))) -(defn- encode-xml +(defn- clj->xml [data] (xml/js2xml (clj->js data))) +(defn ^boolean empty-defs-element? + [item] + (and (= (get item "name") "defs") + (nil? (get item "attributes")) + (nil? (get item "elements")))) + +(defn ^boolean empty-path-element? + [item] + (and (= (get item "name") "path") + (let [d (get item ["attributes" "d"])] + (or (str/blank? d) + (nil? d) + (str/empty? d))))) + +(defn ^boolean foreign-object-element? + [item] + (and (map? item) + (= "foreignObject" (get item "name")))) + +(defn flatten-toplevel-svg-elements + "Flattens XML data structure if two nested top-side SVG elements found." + [item] + (if (and (= "svg" (get-in item ["elements" 0 "name"])) + (= "svg" (get-in item ["elements" 0 "elements" 0 "name"]))) + (update-in item ["elements" 0] assoc "elements" (get-in item ["elements" 0 "elements" 0 "elements"])) + item)) + +(defn replace-text-nodes + "Function responsible of replace the foreignObject elements on the + provided XML with the previously rasterized PATH's." + [xmldata nodes] + (letfn [(replace-fobject [item] + (if (foreign-object-element? item) + (let [id (get-in item ["attributes" "id"]) + node (get nodes id)] + (if node + (:svgdata node) + item)) + item)) + + (process-element [item xform] + (let [item (d/update-when item "elements" #(into [] xform %))] + (if (str/starts-with? (get-in item ["attributes" "id"]) "shape-") + (assoc item "elements" (get-in item ["elements" 0 "elements"])) + item)))] + + (let [xform (comp (remove empty-defs-element?) + (remove empty-path-element?) + (map replace-fobject))] + (->> xmldata + (xml->clj) + (flatten-toplevel-svg-elements) + (walk/prewalk (fn [item] + (cond-> item + (and (map? item) + (string? (get item "name")) + (= "element" (get item "type"))) + (process-element xform)))) + (clj->xml))))) + +(defn parse-viewbox + "Parses viewBox string into width & height map." + [data] + (let [[width height] (->> (str/split data #"\s+") + (drop 2) + (map d/parse-double))] + {:width width + :height height})) + + (defn- render-object [browser {:keys [page-id file-id object-id token scale suffix type]}] (letfn [(convert-to-ppm [pngpath] (log/trace :fn :convert-to-ppm) (let [basepath (path/dirname pngpath) ppmpath (path/join basepath "origin.ppm")] - (-> (run-cmd! (str "convert " pngpath " " ppmpath)) + (-> (sh/run-cmd! (str "convert " pngpath " " ppmpath)) (p/then (constantly ppmpath))))) (trace-color-mask [pbmpath] @@ -101,56 +120,72 @@ (let [basepath (path/dirname pbmpath) basename (path/basename pbmpath ".pbm") svgpath (path/join basepath (str basename ".svg"))] - (-> (run-cmd! (str "potrace --flat -b svg " pbmpath " -o " svgpath)) + (-> (sh/run-cmd! (str "potrace --flat -b svg " pbmpath " -o " svgpath)) (p/then (constantly svgpath))))) - (generate-color-mask [ppmpath color] - (log/trace :fn :generate-color-mask :ppmpath ppmpath :color color) + (generate-color-layer [ppmpath color] + (log/trace :fn :generate-color-layer :ppmpath ppmpath :color color) (let [basepath (path/dirname ppmpath) pbmpath (path/join basepath (str "mask-" (subs color 1) ".pbm"))] - (-> (run-cmd! (str/format "ppmcolormask \"%s\" %s" color ppmpath)) + (-> (sh/run-cmd! (str/format "ppmcolormask \"%s\" %s" color ppmpath)) (p/then (fn [stdout] - (-> (write-file! pbmpath stdout) + (-> (sh/write-file! pbmpath stdout) (p/then (constantly pbmpath))))) (p/then trace-color-mask) - (p/then read-file) + (p/then sh/read-file) (p/then (fn [data] - (p/let [data (parse-xml data) - data (get-in data ["elements" 0])] + (p/let [data (xml->clj data) + data (get-in data ["elements" 1])] {:color color :svgdata data})))))) - (join-color-layers [layers] + (join-color-layers [{:keys [x y width height] :as node} layers] (log/trace :fn :join-color-layers) - (loop [main (-> (:svgdata (first layers)) + (loop [result (-> (:svgdata (first layers)) (assoc "elements" [])) layers (seq layers)] - (if (nil? layers) - main - (let [layer (first layers) - elements (map (fn [element] - (update element "attributes" assoc "fill" (:color layer))) - (get-in layer [:svgdata "elements"] []))] - (recur (update main "elements" d/concat elements) - (next layers)))))) + (if-let [{:keys [color svgdata]} (first layers)] + (recur (->> (get svgdata "elements") + (filter #(= (get % "name") "g")) + (map #(update % "attributes" assoc "fill" color)) + (update result "elements" d/concat)) + (rest layers)) - (convert-to-svg [colors ppmpath] + ;; Now we have the result containing the svgdata of a + ;; SVG with all text layers. Now we need to transform + ;; this SVG to G (Group) and remove unnecesary metada + ;; objects. + (let [vbox (-> (get-in result ["attributes" "viewBox"]) + (parse-viewbox)) + transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y (/ width (:width vbox)) (/ height (:height vbox)))] + (-> result + (assoc "name" "g") + (assoc "attributes" {}) + (update "elements" (fn [elements] + (mapv (fn [group] + (let [paths (get group "elements")] + (if (= 1 (count paths)) + (let [path (first paths)] + (update path "attributes" + (fn [attrs] + (-> attrs + (d/merge (get group "attributes")) + (update "transform" #(str transform " " %)))))) + (update-in group ["attributes" "transform"] #(str transform " " %))))) + elements)))))))) + + (convert-to-svg [ppmpath {:keys [colors] :as node}] (log/trace :fn :convert-to-svg :ppmpath ppmpath :colors colors) - (-> (p/all (map (partial generate-color-mask ppmpath) colors)) - (p/then join-color-layers))) + (-> (p/all (map (partial generate-color-layer ppmpath) colors)) + (p/then (partial join-color-layers node)))) - (trace-single-node [{:keys [data] :as node}] - (log/trace :fn :trace-single-node) - (p/let [tdpath (create-tmpdir! "svgexport-") + (trace-node [{:keys [data] :as node}] + (log/trace :fn :trace-node) + (p/let [tdpath (sh/create-tmpdir! "svgexport-") pngpath (path/join tdpath "origin.png") - _ (write-file! pngpath data) + _ (sh/write-file! pngpath data) ppmpath (convert-to-ppm pngpath) - svgdata (convert-to-svg (:colors node) ppmpath) - svgdata (update svgdata "attributes" assoc - "width" (:width node) - "height" (:height node) - "x" (:x node) - "y" (:y node))] + svgdata (convert-to-svg ppmpath node)] (-> node (dissoc :data) (assoc :tempdir tdpath @@ -181,51 +216,26 @@ (clean-temp-data [{:keys [tempdir] :as node}] (p/do! - (rmdir! tempdir) + (sh/rmdir! tempdir) (dissoc node :tempdir))) - (process-single-text-node [item] + (process-text-node [item] (-> (p/resolved item) (p/then extract-single-node) - (p/then trace-single-node) + (p/then trace-node) (p/then clean-temp-data))) (process-text-nodes [page] (log/trace :fn :process-text-nodes) (-> (bwr/select-all page "#screenshot foreignObject") - (p/then (fn [nodes] - (reduce (fn [res node] - (p/then res (fn [res] - (-> (process-single-text-node node) - (p/then (fn [result] - (conj res result))))))) - (p/resolved []) - nodes))))) + (p/then (fn [nodes] (p/all (map process-text-node nodes)))))) - (replace-nodes-on-main [main nodes] - (let [main (parse-xml main) - index (d/index-by :id nodes) - main (walk/prewalk (fn [form] - (cond - (and (map? form) - (= "element" (get form "type")) - (= "foreignObject" (get form "name"))) - (let [id (get-in form ["attributes" "id"]) - node (get index id)] - (if node - (:svgdata node) - form)) - - :else - form)) - main)] - (encode-xml main))) - - (render-svg [page] - (p/let [dom (bwr/select page "#screenshot") - main (bwr/eval! dom (fn [elem] (.-outerHTML ^js elem))) - nodes (process-text-nodes page)] - (replace-nodes-on-main main nodes))) + (extract-svg [page] + (p/let [dom (bwr/select page "#screenshot") + xmldata (bwr/eval! dom (fn [elem] (.-outerHTML ^js elem))) + nodes (process-text-nodes page) + nodes (d/index-by :id nodes)] + (replace-text-nodes xmldata nodes))) (render-in-page [page {:keys [uri cookie] :as rctx}] (p/do! @@ -240,7 +250,7 @@ (handle [rctx page] (p/let [page (render-in-page page rctx)] - (render-svg page)))] + (extract-svg page)))] (let [path (str "/render-object/" file-id "/" page-id "/" object-id) uri (doto (Uri. (:public-uri cfg/config)) diff --git a/exporter/src/app/util/shell.cljs b/exporter/src/app/util/shell.cljs new file mode 100644 index 000000000..e4d727a00 --- /dev/null +++ b/exporter/src/app/util/shell.cljs @@ -0,0 +1,71 @@ +;; 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/. +;; +;; This Source Code Form is "Incompatible With Secondary Licenses", as +;; defined by the Mozilla Public License, v. 2.0. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.shell + "Shell & FS utilities." + (:require + ["child_process" :as chp] + ["fs" :as fs] + ["os" :as os] + ["path" :as path] + [lambdaisland.glogi :as log] + [promesa.core :as p])) + +(log/set-level "app.util.shell" :trace) + +(defn create-tmpdir! + [prefix] + (p/create + (fn [resolve reject] + (fs/mkdtemp (path/join (os/tmpdir) prefix) + (fn [err dir] + (if err + (reject err) + (resolve dir))))))) + +(defn write-file! + [fpath content] + (p/create + (fn [resolve reject] + (fs/writeFile fpath content (fn [err] + (if err + (reject err) + (resolve nil))))))) +(defn read-file + [fpath] + (p/create + (fn [resolve reject] + (fs/readFile fpath (fn [err content] + (if err + (reject err) + (resolve content))))))) + +(defn run-cmd! + [cmd] + (p/create + (fn [resolve reject] + (log/trace :fn :run-cmd :cmd cmd) + (chp/exec cmd #js {:encoding "buffer"} + (fn [error stdout stderr] + ;; (log/trace :fn :run-cmd :stdout stdout) + (if error + (reject error) + (resolve stdout))))))) + +(defn rmdir! + [path] + (p/create + (fn [resolve reject] + (fs/rmdir path #js {:recursive true} + (fn [err] + (if err + (reject err) + (resolve nil))))))) + + diff --git a/frontend/src/app/main/ui/shapes/text.cljs b/frontend/src/app/main/ui/shapes/text.cljs index c1c2ffe5b..a5f2d6962 100644 --- a/frontend/src/app/main/ui/shapes/text.cljs +++ b/frontend/src/app/main/ui/shapes/text.cljs @@ -88,10 +88,8 @@ [shape] (let [colors (->> (:content shape) (tree-seq map? :children) - (into #{} (comp (map :fill-color) (filter string?))))] - (if (empty? colors) - "#000000" - (apply str (interpose "," colors))))) + (into #{"#000000"} (comp (map :fill-color) (filter string?))))] + (apply str (interpose "," colors)))) (mf/defc text-shape {::mf/wrap-props false diff --git a/manage.sh b/manage.sh index 96c47776a..01631cd7a 100755 --- a/manage.sh +++ b/manage.sh @@ -73,18 +73,6 @@ function build { $DEVENV_IMGNAME:latest sudo -EH -u penpot ./scripts/build.sh } -function build-frontend { - build "frontend"; -} - -function build-exporter { - build "exporter"; -} - -function build-backend { - build "backend"; -} - function build-app-bundle { local version="$CURRENT_VERSION"; local bundle_dir="./bundle-app";