3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-05 00:25:53 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor exportation process, make it considerably faster

Browse source
This commit is contained in:
Andrey Antukh 2022-03-29 12:34:11 +02:00 • committed by Andrés Moya
parent d6abd2202c
commit 9140fc71b9
33 changed files with 1096 additions and 1090 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

180
backend/src/app/rpc/queries/files.clj
View file

@ -205,107 +205,27 @@
(-> (retrieve-file cfg id) (-> (retrieve-file cfg id)
(assoc :permissions perms)))) (assoc :permissions perms))))
(declare trim-file-data)
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::trimmed-file
(s/keys :req-un [::profile-id ::id ::object-id ::page-id]))
(sv/defmethod ::trimmed-file
"Retrieve a file by its ID and trims all unnecesary content from
it. It is mainly used for rendering a concrete object, so we don't
need force download all shapes when only a small subset is
necesseary."
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(let [perms (get-permissions pool profile-id id)]
(check-read-permissions! perms)
(-> (retrieve-file cfg id)
(trim-file-data params)
(assoc :permissions perms))))
(defn- trim-file-data
[file {:keys [page-id object-id]}]
(let [page (get-in file [:data :pages-index page-id])
objects (->> (cph/get-children-with-self (:objects page) object-id)
(map #(dissoc % :thumbnail))
(d/index-by :id))
page (assoc page :objects objects)]
(-> file
(update :data assoc :pages-index {page-id page})
(update :data assoc :pages [page-id]))))
;; --- FILE THUMBNAIL ;; --- FILE THUMBNAIL
(declare strip-frames-with-thumbnails) (defn- trim-objects
(declare extract-file-thumbnail) "Given the page data and the object-id returns the page data with all
(declare get-first-page-data) other not needed objects removed from the `:objects` data
(declare get-thumbnail-data) structure."
[{:keys [objects] :as page} object-id]
(let [objects (cph/get-children-with-self objects object-id)]
(assoc page :objects (d/index-by :id objects))))
(s/def ::strip-frames-with-thumbnails ::us/boolean) (defn- prune-thumbnails
"Given the page data, removes the `:thumbnail` prop from all
shapes."
[page]
(update page :objects (fn [objects]
(d/mapm #(dissoc %2 :thumbnail) objects))))
(s/def ::page (defn- prune-frames-with-thumbnails
(s/keys :req-un [::profile-id ::file-id] "Remove unnecesary shapes from frames that have thumbnail from page
:opt-un [::strip-frames-with-thumbnails])) data."
[page]
(sv/defmethod ::page
"Retrieves the first page of the file. Used mainly for render
thumbnails on dashboard.
DEPRECATED: still here for backward compatibility."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)
data (get-first-page-data file props)]
data))
(s/def ::file-data-for-thumbnail
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::strip-frames-with-thumbnails]))
(sv/defmethod ::file-data-for-thumbnail
"Retrieves the data for generate the thumbnail of the file. Used mainly for render
thumbnails on dashboard."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)]
{:data (get-thumbnail-data file props)
:file-id file-id
:revn (:revn file)}))
(defn get-thumbnail-data
[{:keys [data] :as file} props]
(if-let [[page frame] (first
(for [page (-> data :pages-index vals)
frame (-> page :objects cph/get-frames)
:when (:file-thumbnail frame)]
[page frame]))]
(let [objects (->> (cph/get-children-with-self (:objects page) (:id frame))
(d/index-by :id))]
(cond-> (assoc page :objects objects)
(:strip-frames-with-thumbnails props)
(strip-frames-with-thumbnails)
:always
(assoc :thumbnail-frame frame)))
(let [page-id (-> data :pages first)]
(cond-> (get-in data [:pages-index page-id])
(:strip-frames-with-thumbnails props)
(strip-frames-with-thumbnails)))))
(defn get-first-page-data
[file props]
(let [page-id (get-in file [:data :pages 0])
data (cond-> (get-in file [:data :pages-index page-id])
(true? (:strip-frames-with-thumbnails props))
(strip-frames-with-thumbnails))]
data))
(defn strip-frames-with-thumbnails
"Remove unnecesary shapes from frames that have thumbnail."
[data]
(let [filter-shape? (let [filter-shape?
(fn [objects [id shape]] (fn [objects [id shape]]
(let [frame-id (:frame-id shape)] (let [frame-id (:frame-id shape)]
@ -328,7 +248,71 @@
(filter (partial filter-shape? objects))) (filter (partial filter-shape? objects)))
objects))] objects))]
(update data :objects update-objects))) (update page :objects update-objects)))
(defn- get-thumbnail-data
[{:keys [data] :as file}]
(if-let [[page frame] (first
(for [page (-> data :pages-index vals)
frame (-> page :objects cph/get-frames)
:when (:file-thumbnail frame)]
[page frame]))]
(let [objects (->> (cph/get-children-with-self (:objects page) (:id frame))
(d/index-by :id))]
(-> (assoc page :objects objects)
(assoc :thumbnail-frame frame)))
(let [page-id (-> data :pages first)]
(-> (get-in data [:pages-index page-id])
(prune-frames-with-thumbnails)))))
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::prune-frames-with-thumbnails ::us/boolean)
(s/def ::prune-thumbnails ::us/boolean)
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::page-id
::object-id
::prune-frames-with-thumbnails
::prune-thumbnails]))
(sv/defmethod ::page
"Retrieves the page data from file and returns it. If no page-id is
specified, the first page will be returned. If object-id is
specified, only that object and its children will be returned in the
page objects data structure.
Mainly used for rendering purposes."
[{:keys [pool] :as cfg} {:keys [profile-id file-id page-id object-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)
page-id (or page-id (-> file :data :pages first))
page (get-in file [:data :pages-index page-id])]
(cond-> page
(:prune-frames-with-thumbnails props)
(prune-frames-with-thumbnails)
(:prune-thumbnails props)
(prune-thumbnails)
(uuid? object-id)
(trim-objects object-id))))
(s/def ::file-data-for-thumbnail
(s/keys :req-un [::profile-id ::file-id]))
(sv/defmethod ::file-data-for-thumbnail
"Retrieves the data for generate the thumbnail of the file. Used mainly for render
thumbnails on dashboard. Returns the page data."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)]
{:page (get-thumbnail-data file)
:file-id file-id
:revn (:revn file)}))
;; --- Query: Shared Library Files ;; --- Query: Shared Library Files

2
common/deps.edn
View file

@ -22,7 +22,7 @@
java-http-clj/java-http-clj {:mvn/version "0.4.3"} java-http-clj/java-http-clj {:mvn/version "0.4.3"}
funcool/promesa {:mvn/version "8.0.450"} funcool/promesa {:mvn/version "8.0.450"}
funcool/cuerdas {:mvn/version "2022.01.14-391"} funcool/cuerdas {:mvn/version "2022.03.27-397"}
lambdaisland/uri {:mvn/version "1.13.95" lambdaisland/uri {:mvn/version "1.13.95"
:exclusions [org.clojure/data.json]} :exclusions [org.clojure/data.json]}

89
common/src/app/common/data/macros.cljc
View file

@ -13,6 +13,7 @@
#?(:clj [clojure.core :as c] #?(:clj [clojure.core :as c]
:cljs [cljs.core :as c]) :cljs [cljs.core :as c])
[app.common.data :as d] [app.common.data :as d]
[cuerdas.core :as str]
[cljs.analyzer.api :as aapi])) [cljs.analyzer.api :as aapi]))
(defmacro select-keys (defmacro select-keys
@ -36,61 +37,9 @@
`(let [v# (-> ~target ~@(map (fn [key] (list `c/get key)) keys))] `(let [v# (-> ~target ~@(map (fn [key] (list `c/get key)) keys))]
(if (some? v#) v# ~default)))) (if (some? v#) v# ~default))))
;; => benchmarking: clojure.core/str
;; --> WARM: 100000
;; --> BENCH: 500000
;; --> TOTAL: 197.82ms
;; --> MEAN: 395.64ns
;; => benchmarking: app.commons.data.macros/str
;; --> WARM: 100000
;; --> BENCH: 500000
;; --> TOTAL: 20.31ms
;; --> MEAN: 40.63ns
(defmacro str (defmacro str
"CLJS only macro variant of `str` function that performs string concat much faster." [& params]
([a] `(str/concat ~@params))
(if (:ns &env)
(list 'js* "\"\"+~{}" a)
(list `c/str a)))
([a b]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}" a b)
(list `c/str a b)))
([a b c]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}" a b c)
(list `c/str a b c)))
([a b c d]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}" a b c d)
(list `c/str a b c d)))
([a b c d e]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}" a b c d e)
(list `c/str a b c d e)))
([a b c d e f]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f)
(list `c/str a b c d e f)))
([a b c d e f g]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f g)
(list `c/str a b c d e f g)))
([a b c d e f g h]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f g h)
(list `c/str a b c d e f g h)))
([a b c d e f g h & rest]
(let [all (into [a b c d e f g h] rest)]
(if (:ns &env)
(let [xf (map (fn [items] `(str ~@items)))
pall (partition-all 8 all)]
(if (<= (count all) 64)
`(str ~@(sequence xf pall))
`(c/str ~@(sequence xf pall))))
`(c/str ~@all)))))
(defmacro export (defmacro export
"A helper macro that allows reexport a var in a current namespace." "A helper macro that allows reexport a var in a current namespace."
@ -129,36 +78,6 @@
;; (.setMacro (var ~n))) ;; (.setMacro (var ~n)))
~vr)))) ~vr))))
(defn- interpolate
[s params]
(loop [items (->> (re-seq #"([^\%]+)*(\%(\d+)?)?" s)
(remove (fn [[full seg]] (and (nil? seg) (not full)))))
result []
index 0]
(if-let [[_ segment var? sidx] (first items)]
(cond
(and var? sidx)
(let [cidx (dec (d/read-string sidx))]
(recur (rest items)
(-> result
(conj segment)
(conj (nth params cidx)))
(inc index)))
var?
(recur (rest items)
(-> result
(conj segment)
(conj (nth params index)))
(inc index))
:else
(recur (rest items)
(conj result segment)
(inc index)))
(remove nil? result))))
(defmacro fmt (defmacro fmt
"String interpolation helper. Can only be used with strings known at "String interpolation helper. Can only be used with strings known at
compile time. Can be used with indexed params access or sequential. compile time. Can be used with indexed params access or sequential.
@ -169,7 +88,7 @@
(dm/fmt \"url(%1)\" my-url) ; indexed (dm/fmt \"url(%1)\" my-url) ; indexed
" "
[s & params] [s & params]
(cons 'app.common.data.macros/str (interpolate s (vec params)))) `(str/ffmt ~s ~@params))

1
common/src/app/common/logging.cljc
View file

@ -9,7 +9,6 @@
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.common.spec :as us] [app.common.spec :as us]
[clojure.pprint :refer [pprint]]
[cuerdas.core :as str] [cuerdas.core :as str]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[fipp.edn :as fpp] [fipp.edn :as fpp]

27
common/src/app/common/pprint.cljc Normal file
View file

@ -0,0 +1,27 @@
;; 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.common.pprint
(:refer-clojure :exclude [prn])
(:require
[cuerdas.core :as str]
[fipp.edn :as fpp]))
(defn pprint-str
[expr]
(binding [*print-level* 8
*print-length* 25]
(with-out-str
(fpp/pprint expr {:width 110}))))
(defn pprint
([expr]
(println (pprint-str expr)))
([label expr]
(println (str/concat "============ " label "============"))
(pprint expr)))

7
exporter/src/app/browser.cljs
View file

@ -56,11 +56,12 @@
(defn screenshot (defn screenshot
([frame] (screenshot frame {})) ([frame] (screenshot frame {}))
([frame {:keys [full-page? omit-background? type quality] ([frame {:keys [full-page? omit-background? type quality path]
:or {type "png" full-page? false omit-background? false quality 95}}] :or {type "png" full-page? false omit-background? false quality 95}}]
(let [options (-> (obj/new) (let [options (-> (obj/new)
(obj/set! "type" (name type)) (obj/set! "type" (name type))
(obj/set! "omitBackground" omit-background?) (obj/set! "omitBackground" omit-background?)
(cond-> path (obj/set! "path" path))
(cond-> (= "jpeg" type) (obj/set! "quality" quality)) (cond-> (= "jpeg" type) (obj/set! "quality" quality))
(cond-> full-page? (-> (obj/set! "fullPage" true) (cond-> full-page? (-> (obj/set! "fullPage" true)
(obj/set! "clip" nil))))] (obj/set! "clip" nil))))]
@ -73,10 +74,10 @@
(defn pdf (defn pdf
([page] (pdf page {})) ([page] (pdf page {}))
([page {:keys [scale save-path page-ranges] ([page {:keys [scale path page-ranges]
:or {page-ranges "1" :or {page-ranges "1"
scale 1}}] scale 1}}]
(.pdf ^js page #js {:path save-path (.pdf ^js page #js {:path path
:scale scale :scale scale
:pageRanges page-ranges :pageRanges page-ranges
:printBackground true :printBackground true

20
exporter/src/app/handlers.cljs
View file

@ -6,7 +6,7 @@
(ns app.handlers (ns app.handlers
(:require (:require
[app.common.data.macros :as dm] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
@ -32,6 +32,7 @@
(let [explain (us/pretty-explain data) (let [explain (us/pretty-explain data)
data (-> data data (-> data
(assoc :explain explain) (assoc :explain explain)
(assoc :type :validation)
(dissoc ::s/problems ::s/value ::s/spec))] (dissoc ::s/problems ::s/value ::s/spec))]
(-> exchange (-> exchange
(assoc :response/status 400) (assoc :response/status 400)
@ -46,19 +47,24 @@
(and (= :internal type) (and (= :internal type)
(= :browser-not-ready code)) (= :browser-not-ready code))
(-> exchange (let [data {:type :server-error
(assoc :response/status 503) :code :internal
(assoc :response/body (t/encode data)) :hint (ex-message error)
(assoc :response/headers {"content-type" "application/transit+json"})) :data data}]
(-> exchange
(assoc :response/status 503)
(assoc :response/body (t/encode data))
(assoc :response/headers {"content-type" "application/transit+json"})))
:else :else
(let [data {:type :server-error (let [data {:type :server-error
:code type
:hint (ex-message error) :hint (ex-message error)
:data data}] :data data}]
(l/error :hint "unexpected internal error" :cause error) (l/error :hint "unexpected internal error" :cause error)
(-> exchange (-> exchange
(assoc :response/status 500) (assoc :response/status 500)
(assoc :response/body (t/encode data)) (assoc :response/body (t/encode (d/without-nils data)))
(assoc :response/headers {"content-type" "application/transit+json"})))))) (assoc :response/headers {"content-type" "application/transit+json"}))))))
(defmulti command-spec :cmd) (defmulti command-spec :cmd)
@ -98,4 +104,4 @@
:export-frames (export-frames/handler exchange params) :export-frames (export-frames/handler exchange params)
(ex/raise :type :internal (ex/raise :type :internal
:code :method-not-implemented :code :method-not-implemented
:hint (dm/fmt "method % not implemented" cmd))))) :hint (str/istr "method ~{cmd} not implemented")))))

161
exporter/src/app/handlers/export_frames.cljs
View file

@ -7,12 +7,14 @@
(ns app.handlers.export-frames (ns app.handlers.export-frames
(:require (:require
["path" :as path] ["path" :as path]
[app.common.data.macros :as dm] [app.common.logging :as l]
[app.common.exceptions :as exc :include-macros true] [app.common.exceptions :as exc]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.pprint :as pp]
[app.handlers.resources :as rsc] [app.handlers.resources :as rsc]
[app.handlers.export-shapes :refer [prepare-exports]]
[app.redis :as redis] [app.redis :as redis]
[app.renderer.pdf :as rp] [app.renderer :as rd]
[app.util.shell :as sh] [app.util.shell :as sh]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
@ -20,19 +22,17 @@
(declare ^:private handle-export) (declare ^:private handle-export)
(declare ^:private create-pdf) (declare ^:private create-pdf)
(declare ^:private export-frame)
(declare ^:private join-pdf) (declare ^:private join-pdf)
(declare ^:private move-file) (declare ^:private move-file)
(declare ^:private clean-tmp)
(s/def ::name ::us/string) (s/def ::name ::us/string)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::page-id ::us/uuid) (s/def ::page-id ::us/uuid)
(s/def ::frame-id ::us/uuid) (s/def ::object-id ::us/uuid)
(s/def ::uri ::us/uri) (s/def ::uri ::us/uri)
(s/def ::export (s/def ::export
(s/keys :req-un [::file-id ::page-id ::frame-id ::name])) (s/keys :req-un [::file-id ::page-id ::object-id ::name]))
(s/def ::exports (s/def ::exports
(s/every ::export :kind vector? :min-count 1)) (s/every ::export :kind vector? :min-count 1))
@ -42,42 +42,53 @@
:opt-un [::uri ::name])) :opt-un [::uri ::name]))
(defn handler (defn handler
[{:keys [:request/auth-token] :as exchange} {:keys [exports uri] :as params}] [{:keys [:request/auth-token] :as exchange} {:keys [exports uri profile-id] :as params}]
(let [xform (map #(assoc % :token auth-token :uri uri)) ;; NOTE: we need to have the `:type` prop because the exports
exports (sequence xform exports)] ;; datastructure preparation uses it for creating the groups.
(let [exports (-> (map #(assoc % :type :pdf :scale 1 :suffix "") exports)
(prepare-exports auth-token uri))]
(handle-export exchange (assoc params :exports exports)))) (handle-export exchange (assoc params :exports exports))))
(defn handle-export (defn handle-export
[exchange {:keys [exports wait uri name] :as params}] [exchange {:keys [exports wait uri name profile-id] :as params}]
(let [topic (-> exports first :file-id str) (let [total (count exports)
topic (str profile-id)
resource (rsc/create :pdf (or name (-> exports first :name))) resource (rsc/create :pdf (or name (-> exports first :name)))
on-progress (fn [progress] on-progress (fn [{:keys [done]}]
(let [data {:type :export-update (when-not wait
:resource-id (:id resource) (let [data {:type :export-update
:name (:name resource) :resource-id (:id resource)
:status "running" :name (:name resource)
:progress progress}] :filename (:filename resource)
(redis/pub! topic data))) :status "running"
:total total
:done done}]
(redis/pub! topic data))))
on-complete (fn [resource] on-complete (fn []
(let [data {:type :export-update (when-not wait
:resource-id (:id resource) (let [data {:type :export-update
:name (:name resource) :resource-id (:id resource)
:size (:size resource) :name (:name resource)
:status "ended"}] :filename (:filename resource)
(redis/pub! topic data))) :status "ended"}]
(redis/pub! topic data))))
on-error (fn [cause] on-error (fn [cause]
(let [data {:type :export-update (l/error :hint "unexpected error on frames exportation" :cause cause)
:resource-id (:id resource) (if wait
:name (:name resource) (p/rejected cause)
:status "error" (let [data {:type :export-update
:cause (ex-message cause)}] :resource-id (:id resource)
(redis/pub! topic data))) :name (:name resource)
:filename (:filename resource)
:status "error"
:cause (ex-message cause)}]
(redis/pub! topic data))))
proc (create-pdf :resource resource proc (create-pdf :resource resource
:items exports :exports exports
:on-progress on-progress :on-progress on-progress
:on-complete on-complete :on-complete on-complete
:on-error on-error)] :on-error on-error)]
@ -86,70 +97,46 @@
(assoc exchange :response/body (dissoc resource :path))))) (assoc exchange :response/body (dissoc resource :path)))))
(defn create-pdf (defn create-pdf
[& {:keys [resource items on-progress on-complete on-error] [& {:keys [resource exports on-progress on-complete on-error]
:or {on-progress identity :or {on-progress (constantly nil)
on-complete identity on-complete (constantly nil)
on-error identity}}] on-error p/rejected}}]
(p/let [progress (atom 0)
tmpdir (sh/create-tmpdir! "pdfexport") (let [file-id (-> exports first :file-id)
file-id (-> items first :file-id) result (atom [])
items (into [] (map #(partial export-frame tmpdir %)) items)
xform (map (fn [export-fn] on-object
#(p/finally (fn [{:keys [path] :as object}]
(export-fn) (let [res (swap! result conj path)]
(fn [result _] (on-progress {:done (count res)})))]
(on-progress {:total (count items)
:done (swap! progress inc) (-> (p/loop [exports (seq exports)]
:name (:name result)})))))] (when-let [export (first exports)]
(-> (reduce (fn [res export-fn] (p/let [proc (rd/render export on-object)]
(p/let [res res (p/recur (rest exports)))))
out (export-fn)]
(cons (:path out) res))) (p/then (fn [_] (deref result)))
(p/resolved nil) (p/then (partial join-pdf file-id))
(into '() xform items))
(p/then (partial join-pdf tmpdir file-id))
(p/then (partial move-file resource)) (p/then (partial move-file resource))
(p/then (partial clean-tmp tmpdir)) (p/then (constantly resource))
(p/then (fn [resource] (p/then (fn [resource]
(-> (sh/stat (:path resource)) (-> (sh/stat (:path resource))
(p/then #(merge resource %))))) (p/then #(merge resource %)))))
(p/catch on-error)
(p/finally (fn [result cause] (p/finally (fn [result cause]
(if cause (when-not cause
(on-error cause) (on-complete)))))))
(on-complete result)))))))
(defn- export-frame
[tmpdir {:keys [file-id page-id frame-id token uri] :as params}]
(let [file-name (dm/fmt "%.pdf" frame-id)
save-path (path/join tmpdir file-name)]
(-> (rp/render {:name (dm/str frame-id)
:uri uri
:suffix ""
:token token
:file-id file-id
:page-id page-id
:object-id frame-id
:scale 1
:save-path save-path})
(p/then (fn [_]
{:name file-name
:path save-path})))))
(defn- join-pdf (defn- join-pdf
[tmpdir file-id paths] [file-id paths]
(let [output-path (path/join tmpdir (str file-id ".pdf")) (p/let [tmpdir (sh/mktmpdir! "join-pdf")
paths-str (str/join " " paths)] path (path/join tmpdir (str/concat file-id ".pdf"))]
(-> (sh/run-cmd! (str "pdfunite " paths-str " " output-path)) (sh/run-cmd! (str "pdfunite " (str/join " " paths) " " path))
(p/then (constantly output-path))))) path))
(defn- move-file (defn- move-file
[{:keys [path] :as resource} output-path] [{:keys [path] :as resource} output-path]
(p/do (p/do
(sh/move! output-path path) (sh/move! output-path path)
(sh/rmdir! (path/dirname output-path))
resource)) resource))
(defn- clean-tmp
[tdpath data]
(p/do!
(sh/rmdir! tdpath)
data))

218
exporter/src/app/handlers/export_shapes.cljs
View file

@ -6,34 +6,35 @@
(ns app.handlers.export-shapes (ns app.handlers.export-shapes
(:require (:require
[app.common.exceptions :as exc :include-macros true] ["path" :as path]
[app.common.data :as d]
[app.common.exceptions :as exc]
[app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.redis :as redis]
[app.handlers.resources :as rsc] [app.handlers.resources :as rsc]
[app.renderer.bitmap :as rb] [app.redis :as redis]
[app.renderer.pdf :as rp] [app.renderer :as rd]
[app.renderer.svg :as rs] [app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p])) [promesa.core :as p]))
(declare ^:private handle-exports)
(declare ^:private handle-single-export) (declare ^:private handle-single-export)
(declare ^:private handle-multiple-export) (declare ^:private handle-multiple-export)
(declare ^:private run-export) (declare ^:private assoc-file-name)
(declare ^:private assign-file-name) (declare prepare-exports)
(s/def ::name ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::filename ::us/string)
(s/def ::name ::us/string)
(s/def ::object-id ::us/uuid) (s/def ::object-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::scale ::us/number) (s/def ::scale ::us/number)
(s/def ::suffix ::us/string) (s/def ::suffix ::us/string)
(s/def ::type ::us/keyword) (s/def ::type ::us/keyword)
(s/def ::suffix string?)
(s/def ::scale number?)
(s/def ::uri ::us/uri) (s/def ::uri ::us/uri)
(s/def ::profile-id ::us/uuid)
(s/def ::wait ::us/boolean) (s/def ::wait ::us/boolean)
(s/def ::export (s/def ::export
@ -47,13 +48,13 @@
:opt-un [::uri ::wait ::name])) :opt-un [::uri ::wait ::name]))
(defn handler (defn handler
[{:keys [:request/auth-token] :as exchange} {:keys [exports] :as params}] [{:keys [:request/auth-token] :as exchange} {:keys [exports uri] :as params}]
(let [xform (comp (let [exports (prepare-exports exports auth-token uri)]
(map #(assoc % :token auth-token)) (if (and (= 1 (count exports))
(assign-file-name)) (= 1 (count (-> exports first :objects))))
exports (into [] xform exports)] (handle-single-export exchange (-> params
(if (= 1 (count exports)) (assoc :export (first exports))
(handle-single-export exchange (assoc params :export (first exports))) (dissoc :exports)))
(handle-multiple-export exchange (assoc params :exports exports))))) (handle-multiple-export exchange (assoc params :exports exports)))))
(defn- handle-single-export (defn- handle-single-export
@ -61,87 +62,102 @@
(let [topic (str profile-id) (let [topic (str profile-id)
resource (rsc/create (:type export) (or name (:name export))) resource (rsc/create (:type export) (or name (:name export)))
on-progress (fn [progress] on-progress (fn [{:keys [path] :as object}]
(let [data {:type :export-update (p/do
:resource-id (:id resource) ;; Move the generated path to the resource
:status "running" ;; path destination.
:progress progress}] (sh/move! path (:path resource))
(redis/pub! topic data)))
on-complete (fn [resource]
(let [data {:type :export-update
:resource-id (:id resource)
:size (:size resource)
:name (:name resource)
:status "ended"}]
(redis/pub! topic data)))
(when-not wait
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:status "running"
:total 1
:done 1})
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:filename (:filename resource)
:name (:name resource)
:status "ended"}))))
on-error (fn [cause] on-error (fn [cause]
(let [data {:type :export-update (l/error :hint "unexpected error happened on export multiple process"
:resource-id (:id resource) :cause cause)
:name (:name resource) (if wait
:status "error" (p/rejected cause)
:cause (ex-message cause)}] (redis/pub! topic {:type :export-update
(redis/pub! topic data))) :resource-id (:id resource)
:status "error"
:cause (ex-message cause)})))
proc (-> (rd/render export on-progress)
(p/then (constantly resource))
(p/catch on-error))]
proc (rsc/create-simple :task #(run-export export)
:resource resource
:on-progress on-progress
:on-error on-error
:on-complete on-complete)]
(if wait (if wait
(p/then proc #(assoc exchange :response/body (dissoc % :path))) (p/then proc #(assoc exchange :response/body (dissoc % :path)))
(assoc exchange :response/body (dissoc resource :path))))) (assoc exchange :response/body (dissoc resource :path)))))
(defn- handle-multiple-export (defn- handle-multiple-export
[exchange {:keys [exports wait uri profile-id name] :as params}] [exchange {:keys [exports wait uri profile-id name] :as params}]
(let [tasks (map #(fn [] (run-export %)) exports) (let [resource (rsc/create :zip (or name (-> exports first :name)))
total (count exports)
topic (str profile-id) topic (str profile-id)
resource (rsc/create :zip (or name (-> exports first :name)))
on-progress (fn [progress] to-delete (atom #{})
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:status "running"
:progress progress}]
(redis/pub! topic data)))
on-complete (fn [resource] on-progress (fn [{:keys [done]}]
(let [data {:type :export-update (when-not wait
:resource-id (:id resource) (let [data {:type :export-update
:name (:name resource) :resource-id (:id resource)
:size (:size resource) :status "running"
:status "ended"}] :total total
(redis/pub! topic data))) :done done}]
(redis/pub! topic data))))
on-complete (fn []
(when-not wait
(let [data {:type :export-update
:name (:name resource)
:filename (:filename resource)
:resource-id (:id resource)
:status "ended"}]
(redis/pub! topic data))))
on-error (fn [cause] on-error (fn [cause]
(let [data {:type :export-update (l/error :hint "unexpected error on multiple exportation" :cause cause)
:resource-id (:id resource) (if wait
:name (:name resource) (p/rejected cause)
:status "error" (redis/pub! topic {:type :export-update
:cause (ex-message cause)}] :resource-id (:id resource)
(redis/pub! topic data))) :status "error"
:cause (ex-message cause)})))
proc (rsc/create-zip :resource resource zip (rsc/create-zip :resource resource
:tasks tasks
:on-progress on-progress
:on-complete on-complete :on-complete on-complete
:on-error on-error)] :on-error on-error
:on-progress on-progress)
append (fn [{:keys [filename path] :as object}]
(swap! to-delete conj path)
(rsc/add-to-zip! zip path filename))
proc (-> (p/do
(p/loop [exports (seq exports)]
(when-let [export (first exports)]
(p/let [proc (rd/render export append)]
(p/recur (rest exports)))))
(.finalize zip))
(p/then (fn [_] (p/run! #(sh/rmdir! (path/dirname %)) @to-delete)))
(p/then (constantly resource))
(p/catch on-error))
]
(if wait (if wait
(p/then proc #(assoc exchange :response/body (dissoc % :path))) (p/then proc #(assoc exchange :response/body (dissoc % :path)))
(assoc exchange :response/body (dissoc resource :path))))) (assoc exchange :response/body (dissoc resource :path)))))
(defn- run-export
[{:keys [type] :as params}]
(p/let [res (case type
:png (rb/render params)
:jpeg (rb/render params)
:svg (rs/render params)
:pdf (rp/render params))]
(assoc res :type type)))
(defn- assign-file-name (defn- assoc-file-name
"A transducer that assocs a candidate filename and avoid duplicates." "A transducer that assocs a candidate filename and avoid duplicates."
[] []
(letfn [(find-candidate [params used] (letfn [(find-candidate [params used]
@ -149,12 +165,8 @@
(let [candidate (str (:name params) (let [candidate (str (:name params)
(:suffix params "") (:suffix params "")
(when (pos? index) (when (pos? index)
(str "-" (inc index))) (str/concat "-" (inc index)))
(case (:type params) (mime/get-extension (:type params)))]
:png ".png"
:jpeg ".jpg"
:svg ".svg"
:pdf ".pdf"))]
(if (contains? used candidate) (if (contains? used candidate)
(recur (inc index)) (recur (inc index))
candidate))))] candidate))))]
@ -168,3 +180,37 @@
params (assoc params :filename candidate)] params (assoc params :filename candidate)]
(vswap! used conj candidate) (vswap! used conj candidate)
(rf result params)))))))) (rf result params))))))))
(def ^:const ^:private
default-partition-size 50)
(defn prepare-exports
[exports token uri]
(letfn [(process-group [group]
(sequence (comp (partition-all default-partition-size)
(map process-partition))
group))
(process-partition [[part1 :as part]]
{:file-id (:file-id part1)
:page-id (:page-id part1)
:name (:name part1)
:token token
:uri uri
:type (:type part1)
:scale (:scale part1)
:objects (mapv part-entry->object part)})
(part-entry->object [entry]
{:id (:object-id entry)
:filename (:filename entry)
:name (:name entry)
:suffix (:suffix entry)})]
(let [xform (comp
(map #(assoc % :token token))
(assoc-file-name))]
(->> (sequence xform exports)
(d/group-by (juxt :scale :type))
(map second)
(into [] (mapcat process-group))))))

109
exporter/src/app/handlers/resources.cljs
View file

@ -12,104 +12,33 @@
["os" :as os] ["os" :as os]
["path" :as path] ["path" :as path]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.util.shell :as sh] [app.util.shell :as sh]
[app.util.mime :as mime]
[cljs.core :as c] [cljs.core :as c]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p])) [promesa.core :as p]))
(defn- get-path (defn- get-path
[type id] [type id]
(path/join (os/tmpdir) (dm/str "exporter." (d/name type) "." id))) (path/join (os/tmpdir) (str/concat "exporter-resource." (c/name type) "." id)))
(defn- get-mtype
[type]
(case (d/name type)
"zip" "application/zip"
"pdf" "application/pdf"
"svg" "image/svg+xml"
"jpeg" "image/jpeg"
"png" "image/png"))
(defn create (defn create
"Generates ephimeral resource object." "Generates ephimeral resource object."
[type name] [type name]
(let [task-id (uuid/next)] (let [task-id (uuid/next)]
{:path (get-path type task-id) {:path (get-path type task-id)
:mtype (get-mtype type) :mtype (mime/get type)
:name name :name name
:id (dm/str (c/name type) "." task-id)})) :filename (str/concat name (mime/get-extension type))
:id (str/concat (c/name type) "." task-id)}))
(defn- write-as-zip!
[{:keys [id path]} items on-progress]
(let [^js zip (arc/create "zip")
^js out (fs/createWriteStream path)
append! (fn [{:keys [data name] :as result}]
(.append zip data #js {:name name}))
progress (atom 0)]
(p/create
(fn [resolve reject]
(.on zip "error" #(reject %))
(.on zip "end" resolve)
(.on zip "entry" (fn [data]
(let [name (unchecked-get data "name")
num (swap! progress inc)]
;; Sample code used for testing failing exports
#_(when (= 2 num)
(.abort ^js zip)
(reject (js/Error. "unable to create zip file")))
(on-progress
{:total (count items)
:done num}))))
(.pipe zip out)
(-> (reduce (fn [res export-fn]
(p/then res (fn [_] (-> (export-fn) (p/then append!)))))
(p/resolved 1)
items)
(p/then #(.finalize zip))
(p/catch reject))))))
(defn create-simple
[& {:keys [task resource on-progress on-complete on-error]
:or {on-progress identity
on-complete identity
on-error identity}
:as params}]
(let [path (:path resource)]
(-> (task)
(p/then (fn [{:keys [data name]}]
(on-progress {:total 1 :done 1 :name name})
(.writeFile fs/promises path data)))
(p/then #(sh/stat path))
(p/then #(merge resource %))
(p/finally (fn [result cause]
(if cause
(on-error cause)
(on-complete result)))))))
(defn create-zip
"Creates a resource with multiple files merget into a single zip file."
[& {:keys [resource tasks on-error on-progress on-complete]
:or {on-error identity
on-progress identity
on-complete identity}}]
(let [{:keys [path id] :as resource} resource]
(-> (write-as-zip! resource tasks on-progress)
(p/then #(sh/stat path))
(p/then #(merge resource %))
(p/finally (fn [result cause]
(if cause
(on-error cause)
(on-complete result)))))))
(defn- lookup (defn- lookup
[id] [id]
(p/let [[type task-id] (str/split id "." 2) (p/let [[type task-id] (str/split id "." 2)
path (get-path type task-id) path (get-path type task-id)
mtype (get-mtype type) mtype (mime/get (keyword type))
stat (sh/stat path)] stat (sh/stat path)]
(when-not stat (when-not stat
@ -131,3 +60,25 @@
(assoc :response/status 200) (assoc :response/status 200)
(assoc :response/body stream) (assoc :response/body stream)
(assoc :response/headers headers)))))) (assoc :response/headers headers))))))
(defn create-zip
[& {:keys [resource on-complete on-progress on-error]}]
(let [^js zip (arc/create "zip")
^js out (fs/createWriteStream (:path resource))
progress (atom 0)]
(.on zip "error" on-error)
(.on zip "end" on-complete)
(.on zip "entry" (fn [data]
(let [name (unchecked-get data "name")
num (swap! progress inc)]
(on-progress {:done num :filename name}))))
(.pipe zip out)
zip))
(defn add-to-zip!
[zip path name]
(.file ^js zip path #js {:name name}))
(defn close-zip!
[zip]
(.finalize ^js zip))

45
exporter/src/app/renderer.cljs Normal file
View file

@ -0,0 +1,45 @@
;; 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.renderer
"Common renderer interface."
(:require
[app.common.spec :as us]
[app.renderer.bitmap :as rb]
[app.renderer.pdf :as rp]
[app.renderer.svg :as rs]
[cljs.spec.alpha :as s]))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png :pdf :svg})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(s/def ::filename ::us/string)
(s/def ::object
(s/keys :req-un [::id ::name ::suffix ::filename]))
(s/def ::objects
(s/coll-of ::object :min-count 1))
(s/def ::render-params
(s/keys :req-un [::file-id ::page-id ::scale ::token ::type ::objects]
:opt-un [::uri]))
(defn- render
[{:keys [type] :as params} on-object]
(us/verify ::render-params params)
(us/verify fn? on-object)
(case type
:png (rb/render params on-object)
:jpeg (rb/render params on-object)
:pdf (rp/render params on-object)
:svg (rs/render params on-object)))

104
exporter/src/app/renderer/bitmap.cljs
View file

@ -7,75 +7,61 @@
(ns app.renderer.bitmap (ns app.renderer.bitmap
"A bitmap renderer." "A bitmap renderer."
(:require (:require
["path" :as path]
[app.browser :as bw] [app.browser :as bw]
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex :include-macros true] [app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uri :as u] [app.common.uri :as u]
[app.config :as cf] [app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p])) [promesa.core :as p]))
(defn screenshot-object
[{:keys [file-id page-id object-id token scale type uri]}]
(p/let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "render-object"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec!
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
(l/info :uri uri)
(p/do!
(bw/nav! page (str uri))
(p/let [node (bw/select page "#screenshot")]
(bw/wait-for node)
(bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
(bw/sleep page 2000) ; the good old fix with sleep
(case type
:png (bw/screenshot node {:omit-background? true :type type})
:jpeg (bw/screenshot node {:omit-background? false :type type}))))))))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(s/def ::params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::uri]))
(defn render (defn render
[params] [{:keys [file-id page-id token scale type uri objects] :as params} on-object]
(us/verify ::params params) (letfn [(prepare-options [uri]
(p/let [content (screenshot-object params)] #js {:screen #js {:width bw/default-viewport-width
{:data content :height bw/default-viewport-height}
:name (str (:name params) :viewport #js {:width bw/default-viewport-width
(:suffix params "") :height bw/default-viewport-height}
(case (:type params) :locale "en-US"
:png ".png" :storageState #js {:cookies (bw/create-cookies uri {:token token})}
:jpeg ".jpg")) :deviceScaleFactor scale
:size (alength content) :userAgent bw/default-user-agent})
:mtype (case (:type params)
:png "image/png"
:jpeg "image/jpeg")}))
(render-object [page {:keys [id] :as object}]
(p/let [tmpdir (sh/mktmpdir! "bitmap-render")
path (path/join tmpdir (str/concat id (mime/get-extension type)))
node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(case type
:png (bw/screenshot node {:omit-background? true :type type :path path})
:jpeg (bw/screenshot node {:omit-background? false :type type :path path}))
(on-object (assoc object :path path))))
(render [uri page]
(l/info :uri uri)
(p/do
;; navigate to the page and perform basic setup
(bw/nav! page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
;; take the screnshot of requested objects, one by one
(p/run! (partial render-object page) objects)
nil))]
(p/let [params {:file-id file-id
:page-id page-id
:object-id (mapv :id objects)
:route "objects"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec! (prepare-options uri) (partial render uri)))))

102
exporter/src/app/renderer/pdf.cljs
View file

@ -7,68 +7,62 @@
(ns app.renderer.pdf (ns app.renderer.pdf
"A pdf renderer." "A pdf renderer."
(:require (:require
["path" :as path]
[app.browser :as bw] [app.browser :as bw]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex :include-macros true] [app.common.exceptions :as ex :include-macros true]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uri :as u] [app.common.uri :as u]
[app.config :as cf] [app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cuerdas.core :as str]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[promesa.core :as p])) [promesa.core :as p]))
(defn pdf-from-object
[{:keys [file-id page-id object-id token scale type save-path uri] :as params}]
(p/let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "render-object"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec!
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
(l/info :uri uri)
(p/do!
(bw/nav! page uri)
(p/let [dom (bw/select page "#screenshot")]
(bw/wait-for dom)
(bw/screenshot dom {:full-page? true})
(bw/sleep page 2000) ; the good old fix with sleep
(if save-path
(bw/pdf page {:save-path save-path})
(bw/pdf page))))))))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::save-path ::us/string)
(s/def ::uri ::us/uri)
(s/def ::render-params
(s/keys :req-un [::name ::suffix ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::save-path ::uri]))
(defn render (defn render
[params] [{:keys [file-id page-id token scale type uri objects] :as params} on-object]
(us/assert ::render-params params) (letfn [(prepare-options [uri]
(p/let [content (pdf-from-object params)] #js {:screen #js {:width bw/default-viewport-width
{:data content :height bw/default-viewport-height}
:name (str (:name params) :viewport #js {:width bw/default-viewport-width
(:suffix params "") :height bw/default-viewport-height}
".pdf") :locale "en-US"
:size (alength content) :storageState #js {:cookies (bw/create-cookies uri {:token token})}
:mtype "application/pdf"})) :deviceScaleFactor scale
:userAgent bw/default-user-agent})
(prepare-uri [base-uri object-id]
(let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "objects"}]
(-> base-uri
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))))
(render-object [page base-uri {:keys [id] :as object}]
(p/let [uri (prepare-uri base-uri id)
tmp (sh/mktmpdir! "pdf-render")
path (path/join tmp (str/concat id (mime/get-extension type)))]
(l/info :uri uri)
(bw/nav! page uri)
(p/let [dom (bw/select page (dm/str "#screenshot-" id))]
(bw/wait-for dom)
(bw/screenshot dom {:full-page? true})
(bw/sleep page 2000) ; the good old fix with sleep
(bw/pdf page {:path path})
path)))
(render [base-uri page]
(p/loop [objects (seq objects)]
(when-let [object (first objects)]
(p/let [uri (prepare-uri base-uri (:id object))
path (render-object page base-uri object)]
(on-object (assoc object :path path))
(p/recur (rest objects))))))]
(let [base-uri (or uri (cf/get :public-uri))]
(bw/exec! (prepare-options base-uri)
(partial render base-uri)))))

133
exporter/src/app/renderer/svg.cljs
View file

@ -10,12 +10,14 @@
["xml-js" :as xml] ["xml-js" :as xml]
[app.browser :as bw] [app.browser :as bw]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex :include-macros true] [app.common.exceptions :as ex :include-macros true]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uri :as u] [app.common.uri :as u]
[app.config :as cf] [app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh] [app.util.shell :as sh]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[clojure.walk :as walk] [clojure.walk :as walk]
@ -111,9 +113,8 @@
{:width width {:width width
:height height})) :height height}))
(defn render
(defn- render-object [{:keys [page-id file-id objects token scale suffix type uri]} on-object]
[{:keys [page-id file-id object-id token scale suffix type uri]}]
(letfn [(convert-to-ppm [pngpath] (letfn [(convert-to-ppm [pngpath]
(l/trace :fn :convert-to-ppm) (l/trace :fn :convert-to-ppm)
(let [basepath (path/dirname pngpath) (let [basepath (path/dirname pngpath)
@ -246,7 +247,7 @@
(trace-node [{:keys [data] :as node}] (trace-node [{:keys [data] :as node}]
(l/trace :fn :trace-node) (l/trace :fn :trace-node)
(p/let [tdpath (sh/create-tmpdir! "svgexport-") (p/let [tdpath (sh/mktmpdir! "svgexport")
pngpath (path/join tdpath "origin.png") pngpath (path/join tdpath "origin.png")
_ (sh/write-file! pngpath data) _ (sh/write-file! pngpath data)
ppmpath (convert-to-ppm pngpath) ppmpath (convert-to-ppm pngpath)
@ -293,88 +294,74 @@
(sh/rmdir! tempdir) (sh/rmdir! tempdir)
(dissoc node :tempdir))) (dissoc node :tempdir)))
(process-text-node [page item] (extract-txt-node [page item]
(-> (p/resolved item) (-> (p/resolved item)
(p/then (partial resolve-text-node page)) (p/then (partial resolve-text-node page))
(p/then extract-single-node) (p/then extract-single-node)
(p/then trace-node) (p/then trace-node)
(p/then clean-temp-data))) (p/then clean-temp-data)))
(process-text-nodes [page] (extract-txt-nodes [page {:keys [id] :as objects}]
(l/trace :fn :process-text-nodes) (l/trace :fn :process-text-nodes)
(-> (bw/select-all page "#screenshot foreignObject") (-> (bw/select-all page (str/concat "#screenshot-" id " foreignObject"))
(p/then (fn [nodes] (p/all (map (partial process-text-node page) nodes)))))) (p/then (fn [nodes] (p/all (map (partial extract-txt-node page) nodes))))
(p/then (fn [nodes] (d/index-by :id nodes)))))
(extract [page] (extract-svg [page {:keys [id] :as object}]
(p/let [dom (bw/select page "#screenshot") (let [node (bw/select page (str/concat "#screenshot-" id))]
xmldata (bw/eval! dom (fn [elem] (.-outerHTML ^js elem))) (bw/wait-for node)
nodes (process-text-nodes page) (bw/eval! node (fn [elem] (.-outerHTML ^js elem)))))
nodes (d/index-by :id nodes)
result (replace-text-nodes xmldata nodes)
;; SVG standard don't allow the entity nbsp. &#160; is equivalent but (prepare-options [uri]
;; compatible with SVG #js {:screen #js {:width bw/default-viewport-width
result (str/replace result "&nbsp;" "&#160;")] :height bw/default-viewport-height}
;; (println "------- ORIGIN:") :viewport #js {:width bw/default-viewport-width
;; (cljs.pprint/pprint (xml->clj xmldata)) :height bw/default-viewport-height}
;; (println "------- RESULT:") :locale "en-US"
;; (cljs.pprint/pprint (xml->clj result)) :storageState #js {:cookies (bw/create-cookies uri {:token token})}
;; (println "-------") :deviceScaleFactor scale
result)) :userAgent bw/default-user-agent})
]
(p/let [params {:file-id file-id (render-object [page {:keys [id] :as object}]
:page-id page-id (p/let [tmpdir (sh/mktmpdir! "svg-render")
:object-id object-id path (path/join tmpdir (str/concat id (mime/get-extension type)))
:render-texts true node (bw/select page (str/concat "#screenshot-" id))]
:embed true (bw/wait-for node)
:route "render-object"} (p/let [xmldata (extract-svg page object)
txtdata (extract-txt-nodes page object)
result (replace-text-nodes xmldata txtdata)
result (str/replace result "&nbsp;" "&#160;")]
uri (-> (or uri (cf/get :public-uri)) ;; (println "------- ORIGIN:")
(assoc :path "/render.html") ;; (cljs.pprint/pprint (xml->clj xmldata))
(assoc :query (u/map->query-string params)))] ;; (println "------- RESULT:")
;; (cljs.pprint/pprint (xml->clj result))
;; (println "-------")
(bw/exec! (sh/write-file! path result)
#js {:screen #js {:width bw/default-viewport-width (on-object (assoc object :path path))
:height bw/default-viewport-height} path)))
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
(l/info :uri uri)
(p/do!
(bw/nav! page uri)
(p/let [dom (bw/select page "#screenshot")]
(bw/wait-for dom)
(bw/sleep page 2000))
(extract page))))))) (render [uri page]
(l/info :uri uri)
(p/do
;; navigate to the page and perform basic setup
(bw/nav! page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(s/def ::name ::us/string) ;; take the screnshot of requested objects, one by one
(s/def ::suffix ::us/string) (p/run! (partial render-object page) objects)
(s/def ::type #{:svg}) nil))]
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(s/def ::params (p/let [params {:file-id file-id
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::file-id ::scale ::token] :page-id page-id
:opt-un [::uri])) :render-texts true
:render-embed true
(defn render :object-id (mapv :id objects)
[params] :route "objects"}
(us/assert ::params params) uri (-> (or uri (cf/get :public-uri))
(p/let [content (render-object params)] (assoc :path "/render.html")
{:data content (assoc :query (u/map->query-string params)))]
:name (str (:name params) (bw/exec! (prepare-options uri)
(:suffix params "") (partial render uri)))))
".svg")
:size (alength content)
:mtype "image/svg+xml"}))

32
exporter/src/app/util/mime.cljs Normal file
View file

@ -0,0 +1,32 @@
;; 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.mime
"Mimetype and file extension helpers."
(:refer-clojure :exclude [get])
(:require
[app.common.data :as d]
[cljs.core :as c]))
(defn get-extension
[type]
(case type
:png ".png"
:jpeg ".jpg"
:svg ".svg"
:pdf ".pdf"
:zip ".zip"))
(defn- get
[type]
(case type
:zip "application/zip"
:pdf "application/pdf"
:svg "image/svg+xml"
:jpeg "image/jpeg"
:png "image/png"))

7
exporter/src/app/util/shell.cljs
View file

@ -16,12 +16,9 @@
(l/set-level! :trace) (l/set-level! :trace)
(defn create-tmpdir! (defn mktmpdir!
[prefix] [prefix]
(-> (.mkdtemp fs/promises prefix) (.mkdtemp fs/promises (path/join (os/tmpdir) prefix)))
(p/then (fn [result]
(path/join (os/tmpdir) result)))))
(defn move! (defn move!
[origin-path dest-path] [origin-path dest-path]

4
frontend/deps.edn
View file

@ -10,10 +10,12 @@
funcool/beicon {:mvn/version "2021.07.05-1"} funcool/beicon {:mvn/version "2021.07.05-1"}
funcool/okulary {:mvn/version "2020.04.14-0"} funcool/okulary {:mvn/version "2020.04.14-0"}
funcool/potok {:mvn/version "2021.09.20-0"} funcool/potok {:mvn/version "2021.09.20-0"}
funcool/rumext {:mvn/version "2022.01.20.128"} funcool/rumext {:mvn/version "2022.03.28-131"}
funcool/tubax {:mvn/version "2021.05.20-0"} funcool/tubax {:mvn/version "2021.05.20-0"}
instaparse/instaparse {:mvn/version "1.4.10"} instaparse/instaparse {:mvn/version "1.4.10"}
garden/garden {:mvn/version "1.3.10"}
} }
:aliases :aliases

98
frontend/src/app/main/data/exports.cljs
View file

@ -6,7 +6,6 @@
(ns app.main.data.exports (ns app.main.data.exports
(:require (:require
[app.common.data.macros :as dm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.data.modal :as modal] [app.main.data.modal :as modal]
[app.main.data.workspace.persistence :as dwp] [app.main.data.workspace.persistence :as dwp]
@ -47,6 +46,7 @@
state state
(dissoc state :export)))))) (dissoc state :export))))))
(defn show-workspace-export-dialog (defn show-workspace-export-dialog
([] (show-workspace-export-dialog nil)) ([] (show-workspace-export-dialog nil))
([{:keys [selected]}] ([{:keys [selected]}]
@ -55,8 +55,6 @@
(watch [_ state _] (watch [_ state _]
(let [file-id (:current-file-id state) (let [file-id (:current-file-id state)
page-id (:current-page-id state) page-id (:current-page-id state)
filename (-> (wsh/lookup-page state page-id) :name)
selected (or selected (wsh/lookup-selected state page-id {})) selected (or selected (wsh/lookup-selected state page-id {}))
shapes (if (seq selected) shapes (if (seq selected)
@ -74,11 +72,10 @@
(assoc :name (:name shape))))] (assoc :name (:name shape))))]
(rx/of (modal/show :export-shapes (rx/of (modal/show :export-shapes
{:exports (vec exports) {:exports (vec exports)})))))))
:filename filename})))))))
(defn show-viewer-export-dialog (defn show-viewer-export-dialog
[{:keys [shapes filename page-id file-id exports]}] [{:keys [shapes page-id file-id exports]}]
(ptk/reify ::show-viewer-export-dialog (ptk/reify ::show-viewer-export-dialog
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]
@ -91,51 +88,44 @@
(assoc :object-id (:id shape)) (assoc :object-id (:id shape))
(assoc :shape (dissoc shape :exports)) (assoc :shape (dissoc shape :exports))
(assoc :name (:name shape))))] (assoc :name (:name shape))))]
(rx/of (modal/show :export-shapes {:exports (vec exports) (rx/of (modal/show :export-shapes {:exports (vec exports)}))))))
:filename filename}))))))
(defn show-workspace-export-frames-dialog (defn show-workspace-export-frames-dialog
([frames] [frames]
(ptk/reify ::show-workspace-export-frames-dialog (ptk/reify ::show-workspace-export-frames-dialog
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(let [file-id (:current-file-id state) (let [file-id (:current-file-id state)
page-id (:current-page-id state) page-id (:current-page-id state)
filename (-> (wsh/lookup-page state page-id) exports (for [frame frames]
:name {:enabled true
(dm/str ".pdf")) :page-id page-id
:file-id file-id
:object-id (:id frame)
:shape frame
:name (:name frame)})]
exports (for [frame frames] (rx/of (modal/show :export-frames
{:enabled true {:exports (vec exports)}))))))
:page-id page-id
:file-id file-id
:frame-id (:id frame)
:shape frame
:name (:name frame)})]
(rx/of (modal/show :export-frames
{:exports (vec exports)
:filename filename})))))))
(defn- initialize-export-status (defn- initialize-export-status
[exports filename resource-id query-name] [exports cmd resource]
(ptk/reify ::initialize-export-status (ptk/reify ::initialize-export-status
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc state :export {:in-progress true (assoc state :export {:in-progress true
:resource-id resource-id :resource-id (:id resource)
:healthy? true :healthy? true
:error false :error false
:progress 0 :progress 0
:widget-visible true :widget-visible true
:detail-visible true :detail-visible true
:exports exports :exports exports
:filename filename
:last-update (dt/now) :last-update (dt/now)
:query-name query-name})))) :cmd cmd}))))
(defn- update-export-status (defn- update-export-status
[{:keys [progress status resource-id name] :as data}] [{:keys [done status resource-id filename] :as data}]
(ptk/reify ::update-export-status (ptk/reify ::update-export-status
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
@ -144,7 +134,7 @@
healthy? (< time-diff (dt/duration {:seconds 6}))] healthy? (< time-diff (dt/duration {:seconds 6}))]
(cond-> state (cond-> state
(= status "running") (= status "running")
(update :export assoc :progress (:done progress) :last-update (dt/now) :healthy? healthy?) (update :export assoc :progress done :last-update (dt/now) :healthy? healthy?)
(= status "error") (= status "error")
(update :export assoc :error (:cause data) :last-update (dt/now) :healthy? healthy?) (update :export assoc :error (:cause data) :last-update (dt/now) :healthy? healthy?)
@ -155,12 +145,12 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]
(when (= status "ended") (when (= status "ended")
(->> (rp/query! :download-export-resource resource-id) (->> (rp/query! :exporter {:cmd :get-resource :blob? true :id resource-id})
(rx/delay 500) (rx/delay 500)
(rx/map #(dom/trigger-download name %))))))) (rx/map #(dom/trigger-download filename %)))))))
(defn request-simple-export (defn request-simple-export
[{:keys [export filename]}] [{:keys [export]}]
(ptk/reify ::request-simple-export (ptk/reify ::request-simple-export
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
@ -170,22 +160,26 @@
(watch [_ state _] (watch [_ state _]
(let [profile-id (:profile-id state) (let [profile-id (:profile-id state)
params {:exports [export] params {:exports [export]
:profile-id profile-id}] :profile-id profile-id
:cmd :export-shapes
:wait true}]
(rx/concat (rx/concat
(rx/of ::dwp/force-persist) (rx/of ::dwp/force-persist)
(->> (rp/query! :export-shapes-simple params) (->> (rp/query! :export-shapes params)
(rx/map (fn [data] (rx/mapcat (fn [{:keys [id filename]}]
(dom/trigger-download filename data) (->> (rp/query! :exporter {:cmd :get-resource :blob? true :id id})
(clear-export-state uuid/zero))) (rx/map (fn [data]
(dom/trigger-download filename data)
(clear-export-state uuid/zero))))))
(rx/catch (fn [cause] (rx/catch (fn [cause]
(prn "KKKK" cause)
(rx/concat (rx/concat
(rx/of (clear-export-state uuid/zero)) (rx/of (clear-export-state uuid/zero))
(rx/throw cause)))))))))) (rx/throw cause))))))))))
(defn request-multiple-export (defn request-multiple-export
[{:keys [filename exports query-name] [{:keys [exports cmd]
:or {query-name :export-shapes-multiple} :or {cmd :export-shapes}
:as params}] :as params}]
(ptk/reify ::request-multiple-export (ptk/reify ::request-multiple-export
ptk/WatchEvent ptk/WatchEvent
@ -194,7 +188,7 @@
profile-id (:profile-id state) profile-id (:profile-id state)
ws-conn (:ws-conn state) ws-conn (:ws-conn state)
params {:exports exports params {:exports exports
:name filename :cmd cmd
:profile-id profile-id :profile-id profile-id
:wait false} :wait false}
@ -219,11 +213,10 @@
;; Launch the exportation process and stores the resource id ;; Launch the exportation process and stores the resource id
;; locally. ;; locally.
(->> (rp/query! query-name params) (->> (rp/query! :exporter params)
(rx/tap (fn [{:keys [id]}] (rx/map (fn [{:keys [id] :as resource}]
(vreset! resource-id id))) (vreset! resource-id id)
(rx/map (fn [{:keys [id]}] (initialize-export-status exports cmd resource))))
(initialize-export-status exports filename id query-name))))
;; We proceed to update the export state with incoming ;; We proceed to update the export state with incoming
;; progress updates. We delay the stoper for give some time ;; progress updates. We delay the stoper for give some time
@ -246,13 +239,12 @@
(rx/map #(clear-export-state @resource-id)) (rx/map #(clear-export-state @resource-id))
(rx/take-until (rx/delay 6000 stoper)))))))) (rx/take-until (rx/delay 6000 stoper))))))))
(defn retry-last-export (defn retry-last-export
[] []
(ptk/reify ::retry-last-export (ptk/reify ::retry-last-export
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(let [params (select-keys (:export state) [:filename :exports :query-name])] (let [params (select-keys (:export state) [:exports :cmd])]
(when (seq params) (when (seq params)
(rx/of (request-multiple-export params))))))) (rx/of (request-multiple-export params)))))))

6
frontend/src/app/main/errors.cljs
View file

@ -17,7 +17,6 @@
[app.util.i18n :refer [tr]] [app.util.i18n :refer [tr]]
[app.util.router :as rt] [app.util.router :as rt]
[app.util.timers :as ts] [app.util.timers :as ts]
[expound.alpha :as expound]
[fipp.edn :as fpp] [fipp.edn :as fpp]
[potok.core :as ptk])) [potok.core :as ptk]))
@ -113,13 +112,12 @@
(ts/schedule (ts/schedule
(st/emitf (st/emitf
(msg/show {:content "Internal error: assertion." (msg/show {:content "Internal error: assertion."
:type :error :type :error
:timeout 3000}))) :timeout 3000})))
;; Print to the console some debugging info ;; Print to the console some debugging info
(js/console.group message) (js/console.group message)
(js/console.info context) (js/console.info context)
(js/console.error (with-out-str (expound/printer error)))
(js/console.groupEnd message))) (js/console.groupEnd message)))
;; That are special case server-errors that should be treated ;; That are special case server-errors that should be treated

231
frontend/src/app/main/render.cljs
View file

@ -14,7 +14,8 @@
(:require (:require
["react-dom/server" :as rds] ["react-dom/server" :as rds]
[app.common.colors :as clr] [app.common.colors :as clr]
[app.common.geom.align :as gal] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
@ -22,10 +23,12 @@
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.config :as cfg] [app.config :as cfg]
[app.main.fonts :as fonts] [app.main.fonts :as fonts]
[app.main.ui.context :as muc]
[app.main.ui.shapes.bool :as bool] [app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.circle :as circle] [app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.embed :as embed] [app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.export :as export] [app.main.ui.shapes.export :as export]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.frame :as frame] [app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group] [app.main.ui.shapes.group :as group]
[app.main.ui.shapes.image :as image] [app.main.ui.shapes.image :as image]
@ -57,11 +60,9 @@
:fill color}]) :fill color}])
(defn- calculate-dimensions (defn- calculate-dimensions
[{:keys [objects] :as data} vport] [objects]
(let [shapes (cph/get-immediate-children objects) (let [shapes (cph/get-immediate-children objects)
rect (cond->> (gsh/selection-rect shapes) rect (gsh/selection-rect shapes)]
(some? vport)
(gal/adjust-to-viewport vport))]
(-> rect (-> rect
(update :x mth/finite 0) (update :x mth/finite 0)
(update :y mth/finite 0) (update :y mth/finite 0)
@ -156,24 +157,63 @@
(->> [x y width height] (->> [x y width height]
(map #(ust/format-precision % viewbox-decimal-precision))))) (map #(ust/format-precision % viewbox-decimal-precision)))))
(defn adapt-root-frame
[objects object]
(let [shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))
object (gsh/transform-shape object)]
(assoc object :fill-color "#f0f0f0")))
(defn adapt-objects-for-shape
[objects object-id]
(let [object (get objects object-id)
object (cond->> object
(cph/root-frame? object)
(adapt-root-frame objects))
;; Replace the previous object with the new one
objects (assoc objects object-id object)
modifier (-> (gpt/point (:x object) (:y object))
(gpt/negate)
(gmt/translate-matrix))
mod-ids (cons object-id (cph/get-children-ids objects object-id))
updt-fn #(-> %1
(assoc-in [%2 :modifiers :displacement] modifier)
(update %2 gsh/transform-shape))]
(reduce updt-fn objects mod-ids)))
(defn get-object-bounds
[objects object-id]
(let [object (get objects object-id)
padding (filters/calculate-padding object)
bounds (-> (filters/get-filters-bounds object)
(update :x - (:horizontal padding))
(update :y - (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding))))]
(if (cph/group-shape? object)
(if (:masked-group? object)
(get-object-bounds objects (-> object :shapes first))
(->> (:shapes object)
(into [bounds] (map (partial get-object-bounds objects)))
(gsh/join-rects)))
bounds)))
(mf/defc page-svg (mf/defc page-svg
{::mf/wrap [mf/memo]} {::mf/wrap [mf/memo]}
[{:keys [data width height thumbnails? embed? include-metadata?] :as props [{:keys [data thumbnails? render-embed? include-metadata?] :as props
:or {embed? false include-metadata? false}}] :or {render-embed? false include-metadata? false}}]
(let [objects (:objects data) (let [objects (:objects data)
shapes (cph/get-immediate-children objects) shapes (cph/get-immediate-children objects)
root-children dim (calculate-dimensions objects)
(->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))
vport (when (and (some? width) (some? height))
{:width width :height height})
dim (calculate-dimensions data vport)
vbox (format-viewbox dim) vbox (format-viewbox dim)
background-color (get-in data [:options :background] default-color) bgcolor (dm/get-in data [:options :background] default-color)
frame-wrapper frame-wrapper
(mf/use-memo (mf/use-memo
@ -185,7 +225,7 @@
(mf/deps objects) (mf/deps objects)
#(shape-wrapper-factory objects))] #(shape-wrapper-factory objects))]
[:& (mf/provider embed/context) {:value embed?} [:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?} [:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:view-box vbox [:svg {:view-box vbox
:version "1.1" :version "1.1"
@ -194,12 +234,17 @@
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns") :xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100%" :style {:width "100%"
:height "100%" :height "100%"
:background background-color}} :background bgcolor}}
(when include-metadata? (when include-metadata?
[:& export/export-page {:options (:options data)}]) [:& export/export-page {:options (:options data)}])
[:& ff/fontfaces-style {:shapes root-children}]
(let [shapes (->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))]
[:& ff/fontfaces-style {:shapes shapes}])
(for [item shapes] (for [item shapes]
(let [frame? (= (:type item) :frame)] (let [frame? (= (:type item) :frame)]
(cond (cond
@ -214,6 +259,10 @@
[:& shape-wrapper {:shape item [:& shape-wrapper {:shape item
:key (:id item)}])))]]])) :key (:id item)}])))]]]))
;; Component that serves for render frame thumbnails, mainly used in
;; the viewer and handoff
(mf/defc frame-svg (mf/defc frame-svg
{::mf/wrap [mf/memo]} {::mf/wrap [mf/memo]}
[{:keys [objects frame zoom show-thumbnails?] :or {zoom 1} :as props}] [{:keys [objects frame zoom show-thumbnails?] :or {zoom 1} :as props}]
@ -260,6 +309,10 @@
[:> shape-container {:shape frame} [:> shape-container {:shape frame}
[:& frame/frame-thumbnail {:shape frame}]]))])) [:& frame/frame-thumbnail {:shape frame}]]))]))
;; Component for rendering a thumbnail of a single componenent. Mainly
;; used to render thumbnails on assets panel.
(mf/defc component-svg (mf/defc component-svg
{::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]} {::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]}
[{:keys [objects group zoom] :or {zoom 1} :as props}] [{:keys [objects group zoom] :or {zoom 1} :as props}]
@ -304,81 +357,122 @@
[:> shape-container {:shape group} [:> shape-container {:shape group}
[:& group-wrapper {:shape group :view-box vbox}]]])) [:& group-wrapper {:shape group :view-box vbox}]]]))
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object zoom render-texts? render-embed?]
:or {zoom 1 render-embed? false}
:as props}]
(let [object (cond-> object
(:hide-fill-on-export object)
(assoc :fills []))
obj-id (:id object)
x (* (:x object) zoom)
y (* (:y object) zoom)
width (* (:width object) zoom)
height (* (:height object) zoom)
vbox (dm/str x " " y " " width " " height)
frame-wrapper
(mf/with-memo [objects]
(frame-wrapper-factory objects))
group-wrapper
(mf/with-memo [objects]
(group-wrapper-factory objects))
shape-wrapper
(mf/with-memo [objects]
(shape-wrapper-factory objects))
text-shapes (sequence (filter cph/text-shape?) (vals objects))
render-texts? (and render-texts? (d/seek (comp nil? :position-data) text-shapes))]
[:& (mf/provider embed/context) {:value render-embed?}
[:svg {:id (dm/str "screenshot-" obj-id)
:view-box vbox
:width width
:height height
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}}
(let [shapes (cph/get-children objects obj-id)]
[:& ff/fontfaces-style {:shapes shapes}])
(case (:type object)
:frame [:& frame-wrapper {:shape object :view-box vbox}]
:group [:> shape-container {:shape object}
[:& group-wrapper {:shape object}]]
[:& shape-wrapper {:shape object}])]
;; Auxiliary SVG for rendering text-shapes
(when render-texts?
(for [object text-shapes]
[:& (mf/provider muc/text-plain-colors-ctx) {:value true}
[:svg
{:id (dm/str "screenshot-text-" (:id object))
:view-box (dm/str "0 0 " (:width object) " " (:height object))
:width (:width object)
:height (:height object)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"}
[:& shape-wrapper {:shape (assoc object :x 0 :y 0)}]]]))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SPRITES (DEBUG)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(mf/defc component-symbol (mf/defc component-symbol
{::mf/wrap-props false} [{:keys [id data] :as props}]
[props] (let [name (:name data)
(let [id (obj/get props "id") objects (-> (:objects data)
data (obj/get props "data") (adapt-objects-for-shape id))
name (:name data) object (get objects id)
path (:path data) selrect (:selrect object)
objects (:objects data)
root (get objects id)
selrect (:selrect root)
vbox vbox
(format-viewbox (format-viewbox
{:width (:width selrect) {:width (:width selrect)
:height (:height selrect)}) :height (:height selrect)})
modifier
(mf/use-memo
(mf/deps (:x root) (:y root))
(fn []
(-> (gpt/point (:x root) (:y root))
(gpt/negate)
(gmt/translate-matrix))))
objects
(mf/use-memo
(mf/deps modifier id objects)
(fn []
(let [modifier-ids (cons id (cph/get-children-ids objects id))
update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)]
(reduce update-fn objects modifier-ids))))
root
(mf/use-memo
(mf/deps modifier root)
(fn [] (assoc-in root [:modifiers :displacement] modifier)))
group-wrapper group-wrapper
(mf/use-memo (mf/use-memo
(mf/deps objects) (mf/deps objects)
(fn [] (group-wrapper-factory objects)))] (fn [] (group-wrapper-factory objects)))]
[:> "symbol" #js {:id (str id) [:> "symbol" #js {:id (str id) :viewBox vbox}
:viewBox vbox
"penpot:path" path}
[:title name] [:title name]
[:> shape-container {:shape root} [:> shape-container {:shape object}
[:& group-wrapper {:shape root :view-box vbox}]]])) [:& group-wrapper {:shape object :view-box vbox}]]]))
(mf/defc components-sprite-svg (mf/defc components-sprite-svg
{::mf/wrap-props false} {::mf/wrap-props false}
[props] [props]
(let [data (obj/get props "data") (let [data (obj/get props "data")
children (obj/get props "children") children (obj/get props "children")
embed? (obj/get props "embed?") render-embed? (obj/get props "render-embed?")
include-metadata? (obj/get props "include-metadata?")] include-metadata? (obj/get props "include-metadata?")]
[:& (mf/provider embed/context) {:value embed?} [:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?} [:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:version "1.1" [:svg {:version "1.1"
:xmlns "http://www.w3.org/2000/svg" :xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink" :xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns") :xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100vw" :style {:display (when-not (some? children) "none")}}
:height "100vh"
:display (when-not (some? children) "none")}}
[:defs [:defs
(for [[component-id component-data] (:components data)] (for [[id data] (:components data)]
[:& component-symbol {:id component-id [:& component-symbol {:id id :key (dm/str id) :data data}])]
:key (str component-id)
:data component-data}])]
children]]])) children]]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RENDERING ;; RENDER FOR DOWNLOAD (wrongly called exportation)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- get-image-data [shape] (defn- get-image-data [shape]
@ -426,7 +520,7 @@
(->> (rx/of data) (->> (rx/of data)
(rx/map (rx/map
(fn [data] (fn [data]
(let [elem (mf/element page-svg #js {:data data :embed? true :include-metadata? true})] (let [elem (mf/element page-svg #js {:data data :render-embed? true :include-metadata? true})]
(rds/renderToStaticMarkup elem))))))) (rds/renderToStaticMarkup elem)))))))
(defn render-components (defn render-components
@ -445,5 +539,6 @@
(->> (rx/of data) (->> (rx/of data)
(rx/map (rx/map
(fn [data] (fn [data]
(let [elem (mf/element components-sprite-svg #js {:data data :embed? true :include-metadata? true})] (let [elem (mf/element components-sprite-svg
#js {:data data :render-embed? true :include-metadata? true})]
(rds/renderToStaticMarkup elem)))))))) (rds/renderToStaticMarkup elem))))))))

28
frontend/src/app/main/repo.cljs
View file

@ -105,34 +105,22 @@
(rx/map http/conditional-decode-transit) (rx/map http/conditional-decode-transit)
(rx/mapcat handle-response))) (rx/mapcat handle-response)))
(defn- send-export-command (defn- send-export
[& {:keys [cmd params blob?]}] [{:keys [blob?] :as params}]
(->> (http/send! {:method :post (->> (http/send! {:method :post
:uri (u/join base-uri "api/export") :uri (u/join base-uri "api/export")
:body (http/transit-data (assoc params :cmd cmd)) :body (http/transit-data (dissoc params :blob?))
:credentials "include" :credentials "include"
:response-type (if blob? :blob :text)}) :response-type (if blob? :blob :text)})
(rx/map http/conditional-decode-transit) (rx/map http/conditional-decode-transit)
(rx/mapcat handle-response))) (rx/mapcat handle-response)))
(defmethod query :export-shapes-simple (defmethod query :exporter
[_ params] [_ params]
(let [params (merge {:wait true} params)] (let [default {:wait false
(->> (rx/of params) :blob? false
(rx/mapcat #(send-export-command :cmd :export-shapes :params % :blob? false)) :uri (str base-uri)}]
(rx/mapcat #(send-export-command :cmd :get-resource :params % :blob? true))))) (send-export (merge default params))))
(defmethod query :export-shapes-multiple
[_ params]
(send-export-command :cmd :export-shapes :params params :blob? false))
(defmethod query :export-frames-multiple
[_ params]
(send-export-command :cmd :export-frames :params (assoc params :uri (str base-uri)) :blob? false))
(defmethod query :download-export-resource
[_ id]
(send-export-command :cmd :get-resource :params {:id id} :blob? true))
(derive :upload-file-media-object ::multipart-upload) (derive :upload-file-media-object ::multipart-upload)
(derive :update-profile-photo ::multipart-upload) (derive :update-profile-photo ::multipart-upload)

10
frontend/src/app/main/ui.cljs
View file

@ -19,7 +19,6 @@
[app.main.ui.onboarding] [app.main.ui.onboarding]
[app.main.ui.onboarding.questions] [app.main.ui.onboarding.questions]
[app.main.ui.releases] [app.main.ui.releases]
[app.main.ui.render :as render]
[app.main.ui.settings :as settings] [app.main.ui.settings :as settings]
[app.main.ui.static :as static] [app.main.ui.static :as static]
[app.main.ui.viewer :as viewer] [app.main.ui.viewer :as viewer]
@ -110,15 +109,6 @@
:index index :index index
:share-id share-id}])) :share-id share-id}]))
;; TODO: maybe move to `app.render` entrypoint (handled by render.html)
:render-sprite
(do
(let [file-id (uuid (get-in route [:path-params :file-id]))
component-id (get-in route [:query-params :component-id])
component-id (when (some? component-id) (uuid component-id))]
[:& render/render-sprite {:file-id file-id
:component-id component-id}]))
:workspace :workspace
(let [project-id (some-> params :path :project-id uuid) (let [project-id (some-> params :path :project-id uuid)
file-id (some-> params :path :file-id uuid) file-id (some-> params :path :file-id uuid)

22
frontend/src/app/main/ui/export.cljs
View file

@ -23,7 +23,7 @@
[rumext.alpha :as mf])) [rumext.alpha :as mf]))
(mf/defc export-multiple-dialog (mf/defc export-multiple-dialog
[{:keys [exports filename title query-name no-selection]}] [{:keys [exports title cmd no-selection]}]
(let [lstate (mf/deref refs/export) (let [lstate (mf/deref refs/export)
in-progress? (:in-progress lstate) in-progress? (:in-progress lstate)
@ -33,7 +33,10 @@
all-checked? (every? :enabled all-exports) all-checked? (every? :enabled all-exports)
all-unchecked? (every? (complement :enabled) all-exports) all-unchecked? (every? (complement :enabled) all-exports)
enabled-exports (into [] (filter :enabled) all-exports) enabled-exports (into []
(comp (filter :enabled)
(map #(dissoc % :shape :enabled)))
all-exports)
cancel-fn cancel-fn
(fn [event] (fn [event]
@ -45,9 +48,8 @@
(dom/prevent-default event) (dom/prevent-default event)
(st/emit! (modal/hide) (st/emit! (modal/hide)
(de/request-multiple-export (de/request-multiple-export
{:filename filename {:exports enabled-exports
:exports enabled-exports :cmd cmd})))
:query-name query-name})))
on-toggle-enabled on-toggle-enabled
(fn [index] (fn [index]
@ -145,25 +147,23 @@
(mf/defc export-shapes-dialog (mf/defc export-shapes-dialog
{::mf/register modal/components {::mf/register modal/components
::mf/register-as :export-shapes} ::mf/register-as :export-shapes}
[{:keys [exports filename]}] [{:keys [exports]}]
(let [title (tr "dashboard.export-shapes.title")] (let [title (tr "dashboard.export-shapes.title")]
[:& export-multiple-dialog [:& export-multiple-dialog
{:exports exports {:exports exports
:filename filename
:title title :title title
:query-name :export-shapes-multiple :cmd :export-shapes
:no-selection shapes-no-selection}])) :no-selection shapes-no-selection}]))
(mf/defc export-frames (mf/defc export-frames
{::mf/register modal/components {::mf/register modal/components
::mf/register-as :export-frames} ::mf/register-as :export-frames}
[{:keys [exports filename]}] [{:keys [exports]}]
(let [title (tr "dashboard.export-frames.title")] (let [title (tr "dashboard.export-frames.title")]
[:& export-multiple-dialog [:& export-multiple-dialog
{:exports exports {:exports exports
:filename filename
:title title :title title
:query-name :export-frames-multiple}])) :cmd :export-frames}]))
(mf/defc export-progress-widget (mf/defc export-progress-widget
{::mf/wrap [mf/memo]} {::mf/wrap [mf/memo]}

203
frontend/src/app/main/ui/render.cljs
View file

@ -1,203 +0,0 @@
;; 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.main.ui.render
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.uuid :as uuid]
[app.main.data.fonts :as df]
[app.main.render :as render]
[app.main.repo :as repo]
[app.main.store :as st]
[app.main.ui.context :as muc]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.util.dom :as dom]
[beicon.core :as rx]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(defn calc-bounds
[object objects]
(let [xf-get-bounds (comp (map #(get objects %)) (map #(calc-bounds % objects)))
padding (filters/calculate-padding object)
obj-bounds (-> (filters/get-filters-bounds object)
(update :x - (:horizontal padding))
(update :y - (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding))))]
(cond
(and (= :group (:type object))
(:masked-group? object))
(calc-bounds (get objects (first (:shapes object))) objects)
(= :group (:type object))
(->> (:shapes object)
(into [obj-bounds] xf-get-bounds)
(gsh/join-rects))
:else
obj-bounds)))
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object-id zoom render-texts? embed?]
:or {zoom 1 embed? false}
:as props}]
(let [object (get objects object-id)
frame-id (if (= :frame (:type object))
(:id object)
(:frame-id object))
modifier (-> (gpt/point (:x object) (:y object))
(gpt/negate)
(gmt/translate-matrix))
mod-ids (cons frame-id (cph/get-children-ids objects frame-id))
updt-fn #(-> %1
(assoc-in [%2 :modifiers :displacement] modifier)
(update %2 gsh/transform-shape))
objects (reduce updt-fn objects mod-ids)
object (get objects object-id)
object (cond-> object
(:hide-fill-on-export object)
(assoc :fills []))
all-children (cph/get-children objects object-id)
{:keys [x y width height] :as bs} (calc-bounds object objects)
[_ _ width height :as coords] (->> [x y width height] (map #(* % zoom)))
vbox (str/join " " coords)
frame-wrapper
(mf/with-memo [objects]
(render/frame-wrapper-factory objects))
group-wrapper
(mf/with-memo [objects]
(render/group-wrapper-factory objects))
shape-wrapper
(mf/with-memo [objects]
(render/shape-wrapper-factory objects))
is-text? (fn [shape] (= :text (:type shape)))
text-shapes (sequence (comp (map second) (filter is-text?)) objects)
render-texts? (and render-texts? (d/seek (comp nil? :position-data) text-shapes))]
(mf/with-effect [width height]
(dom/set-page-style!
{:size (dm/str (mth/ceil width) "px "
(mth/ceil height) "px")}))
[:& (mf/provider embed/context) {:value embed?}
[:svg {:id "screenshot"
:view-box vbox
:width width
:height height
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}}
[:& ff/fontfaces-style {:shapes all-children}]
(case (:type object)
:frame [:& frame-wrapper {:shape object :view-box vbox}]
:group [:> shape-container {:shape object}
[:& group-wrapper {:shape object}]]
[:& shape-wrapper {:shape object}])]
;; Auxiliary SVG for rendering text-shapes
(when render-texts?
(for [object text-shapes]
[:& (mf/provider muc/text-plain-colors-ctx) {:value true}
[:svg {:id (str "screenshot-text-" (:id object))
:view-box (str "0 0 " (:width object) " " (:height object))
:width (:width object)
:height (:height object)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"}
[:& shape-wrapper {:shape (assoc object :x 0 :y 0)}]]]))]))
(defn- adapt-root-frame
[objects object-id]
(if (uuid/zero? object-id)
(let [object (get objects object-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))
object (gsh/transform-shape object)
object (assoc object :fill-color "#f0f0f0")]
(assoc objects (:id object) object))
objects))
(mf/defc render-object
[{:keys [file-id page-id object-id render-texts? embed?] :as props}]
(let [objects (mf/use-state nil)]
(mf/with-effect [file-id page-id object-id]
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :trimmed-file {:id file-id :page-id page-id :object-id object-id}))
(rx/subs
(fn [[fonts {:keys [data]}]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))
(let [objs (get-in data [:pages-index page-id :objects])
objs (adapt-root-frame objs object-id)]
(reset! objects objs)))))
(constantly nil))
(when @objects
[:& object-svg {:objects @objects
:object-id object-id
:embed? embed?
:render-texts? render-texts?
:zoom 1}])))
(mf/defc render-sprite
[{:keys [file-id component-id] :as props}]
(let [file (mf/use-state nil)]
(mf/with-effect [file-id]
(->> (repo/query! :file {:id file-id})
(rx/subs
(fn [result]
(reset! file result))))
(constantly nil))
(when @file
[:*
[:& render/components-sprite-svg {:data (:data @file) :embed true}
(when (some? component-id)
[:use {:x 0 :y 0
:xlinkHref (str "#" component-id)}])]
(when-not (some? component-id)
[:ul
(for [[id data] (get-in @file [:data :components])]
(let [url (str "#/render-sprite/" (:id @file) "?component-id=" id)]
[:li [:a {:href url} (:name data)]]))])])))

1
frontend/src/app/main/ui/routes.cljs
View file

@ -61,7 +61,6 @@
["/debug/icons-preview" :debug-icons-preview]) ["/debug/icons-preview" :debug-icons-preview])
;; Used for export ;; Used for export
["/render-object/:file-id/:page-id/:object-id" :render-object]
["/render-sprite/:file-id" :render-sprite] ["/render-sprite/:file-id" :render-sprite]
["/dashboard/team/:team-id" ["/dashboard/team/:team-id"

9
frontend/src/app/main/ui/viewer/handoff/attributes/image.cljs
View file

@ -11,6 +11,7 @@
[app.util.code-gen :as cg] [app.util.code-gen :as cg]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.i18n :refer [tr]] [app.util.i18n :refer [tr]]
[cuerdas.core :as str]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))
(defn has-image? [shape] (defn has-image? [shape]
@ -34,12 +35,10 @@
[:div.attributes-value (-> shape :metadata :height) "px"] [:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]] [:& copy-button {:data (cg/generate-css-props shape :height)}]]
(let [mtype (-> shape :metadata :mtype) (let [mtype (-> shape :metadata :mtype)
name (:name shape) name (:name shape)
extension (dom/mtype->extension mtype)] extension (dom/mtype->extension mtype)]
[:a.download-button {:target "_blank" [:a.download-button {:target "_blank"
:download (if extension :download (cond-> name extension (str/concat extension))
(str name "." extension)
name)
:href (cfg/resolve-file-media (-> shape :metadata))} :href (cfg/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])]))) (tr "handoff.attributes.image.download")])])))

31
frontend/src/app/main/ui/viewer/shapes.cljs
View file

@ -390,34 +390,3 @@
:bool [:> bool-container {:shape shape :frame frame :objects objects}] :bool [:> bool-container {:shape shape :frame frame :objects objects}]
:svg-raw [:> svg-raw-container {:shape shape :frame frame :objects objects}]))))))) :svg-raw [:> svg-raw-container {:shape shape :frame frame :objects objects}])))))))
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
[{:keys [objects frame zoom] :or {zoom 1} :as props}]
(let [modifier (-> (gpt/point (:x frame) (:y frame))
(gpt/negate)
(gmt/translate-matrix))
update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)
frame-id (:id frame)
modifier-ids (into [frame-id] (cph/get-children-ids objects frame-id))
objects (reduce update-fn objects modifier-ids)
frame (assoc-in frame [:modifiers :displacement] modifier)
width (* (:width frame) zoom)
height (* (:height frame) zoom)
vbox (str "0 0 " (:width frame 0)
" " (:height frame 0))
wrapper (mf/use-memo
(mf/deps objects)
#(frame-container-factory objects))]
[:svg {:view-box vbox
:width width
:height height
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"}
[:& wrapper {:shape frame
:view-box vbox}]]))

8
frontend/src/app/main/ui/workspace/sidebar/options/menus/exports.cljs
View file

@ -30,7 +30,7 @@
state (mf/deref refs/export) state (mf/deref refs/export)
in-progress? (:in-progress state) in-progress? (:in-progress state)
filename (when (seqable? exports) sname (when (seqable? exports)
(let [shapes (wsh/lookup-shapes @st/state ids) (let [shapes (wsh/lookup-shapes @st/state ids)
sname (-> shapes first :name) sname (-> shapes first :name)
suffix (-> exports first :suffix)] suffix (-> exports first :suffix)]
@ -56,13 +56,13 @@
;; separatelly by the export-modal. ;; separatelly by the export-modal.
(let [defaults {:page-id page-id (let [defaults {:page-id page-id
:file-id file-id :file-id file-id
:name filename :name sname
:object-id (first ids)} :object-id (first ids)}
exports (mapv #(merge % defaults) exports)] exports (mapv #(merge % defaults) exports)]
(if (= 1 (count exports)) (if (= 1 (count exports))
(let [export (first exports)] (let [export (first exports)]
(st/emit! (de/request-simple-export {:export export :filename (:name export)}))) (st/emit! (de/request-simple-export {:export export})))
(st/emit! (de/request-multiple-export {:exports exports :filename filename}))))))) (st/emit! (de/request-multiple-export {:exports exports})))))))
;; TODO: maybe move to specific events for avoid to have this logic here? ;; TODO: maybe move to specific events for avoid to have this logic here?
add-export add-export

256
frontend/src/app/render.cljs
View file

@ -7,27 +7,38 @@
(ns app.render (ns app.render
"The main entry point for UI part needed by the exporter." "The main entry point for UI part needed by the exporter."
(:require (:require
[app.common.logging :as log] [app.common.logging :as l]
[app.common.math :as mth]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uri :as u] [app.common.uri :as u]
[app.config :as cf] [app.config :as cf]
[app.main.ui.render :as render] [app.main.data.fonts :as df]
[app.main.render :as render]
[app.main.repo :as repo]
[app.main.store :as st]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.globals :as glob] [app.util.globals :as glob]
[beicon.core :as rx]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str]
[garden.core :refer [css]]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))
(log/initialize!) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(log/set-level! :root :warn) ;; SETUP
(log/set-level! :app :info) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare reinit) (l/initialize!)
(l/set-level! :root :warn)
(l/set-level! :app :info)
(declare ^:private render-object) (declare ^:private render-single-object)
(declare ^:private render-components)
(declare ^:private render-objects)
(log/info :hint "Welcome to penpot (Export)" (l/info :hint "Welcome to penpot (Export)"
:version (:full @cf/version) :version (:full @cf/version)
:public-uri (str cf/public-uri)) :public-uri (str cf/public-uri))
(defn- parse-params (defn- parse-params
[loc] [loc]
@ -38,7 +49,8 @@
[] []
(when-let [params (parse-params glob/location)] (when-let [params (parse-params glob/location)]
(when-let [component (case (:route params) (when-let [component (case (:route params)
"render-object" (render-object params) "objects" (render-objects params)
"components" (render-components params)
nil)] nil)]
(mf/mount component (dom/get-element "app"))))) (mf/mount component (dom/get-element "app")))))
@ -55,23 +67,225 @@
[] []
(reinit)) (reinit))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ---- SINGLE OBJECT
(defn use-resource
"A general purpose hook for retrieve or subscribe to remote changes
using the reactive-streams mechanism mechanism.
It receives a function to execute for retrieve the stream that will
be used for creating the subscription. The function should be
stable, so is the responsability of the user of this hook to
properly memoize it.
TODO: this should be placed in some generic hooks namespace but his
right now is pending of refactor and it will be done later."
[f]
(let [[state ^js update-state!] (mf/useState {:loaded? false})]
(mf/with-effect [f]
(update-state! (fn [prev] (assoc prev :refreshing? true)))
(let [on-value (fn [data]
(update-state! #(-> %
(assoc :refreshing? false)
(assoc :loaded? true)
(merge data))))
subs (rx/subscribe (f) on-value)]
#(rx/dispose! subs)))
state))
(mf/defc object-svg
[{:keys [page-id file-id object-id render-embed? render-texts?]}]
(let [fetch-state (mf/use-fn
(mf/deps file-id page-id object-id)
(fn []
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :page {:file-id file-id
:page-id page-id
:object-id object-id
:prune-thumbnails true}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (comp :objects second))
(rx/map (fn [objects]
(let [objects (render/adapt-objects-for-shape objects object-id)
bounds (render/get-object-bounds objects object-id)
object (get objects object-id)]
{:objects objects
:object (merge object bounds)}))))))
{:keys [objects object]} (use-resource fetch-state)]
;; Set the globa CSS to assign the page size, needed for PDF
;; exportation process.
(mf/with-effect [object]
(when object
(dom/set-page-style!
{:size (str/concat
(mth/ceil (:width object)) "px "
(mth/ceil (:height object)) "px")})))
(when objects
[:& render/object-svg
{:objects objects
:object object
:render-embed? render-embed?
:render-texts? render-texts?
:zoom 1}])))
(mf/defc objects-svg
[{:keys [page-id file-id object-ids render-embed? render-texts?]}]
(let [fetch-state (mf/use-fn
(mf/deps file-id page-id)
(fn []
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :page {:file-id file-id
:page-id page-id
:prune-thumbnails true}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (comp :objects second)))))
objects (use-resource fetch-state)]
(when objects
(for [object-id object-ids]
(let [objects (render/adapt-objects-for-shape objects object-id)
bounds (render/get-object-bounds objects object-id)
object (merge (get objects object-id) bounds)]
[:& render/object-svg
{:objects objects
:key (str object-id)
:object object
:render-embed? render-embed?
:render-texts? render-texts?
:zoom 1}])))))
(s/def ::page-id ::us/uuid) (s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid) (s/def ::object-id
(s/or :single ::us/uuid
:multiple (s/coll-of ::us/uuid)))
(s/def ::render-text ::us/boolean) (s/def ::render-text ::us/boolean)
(s/def ::embed ::us/boolean) (s/def ::embed ::us/boolean)
(s/def ::render-object-params (s/def ::render-objects
(s/keys :req-un [::file-id ::page-id ::object-id] (s/keys :req-un [::file-id ::page-id ::object-id]
:opt-un [::render-text ::embed])) :opt-un [::render-text ::render-embed]))
(defn- render-object (defn- render-objects
[params] [params]
(let [{:keys [page-id file-id object-id render-texts embed]} (us/conform ::render-object-params params)] (let [{:keys [file-id
page-id
render-embed
render-texts]
:as params}
(us/conform ::render-objects params)
[type object-id] (:object-id params)]
(case type
:single
(mf/html
[:& object-svg
{:file-id file-id
:page-id page-id
:object-id object-id
:render-embed? render-embed
:render-texts? render-texts}])
:multiple
(mf/html
[:& objects-svg
{:file-id file-id
:page-id page-id
:object-ids (into #{} object-id)
:render-embed? render-embed
:render-texts? render-texts}]))))
;; ---- COMPONENTS SPRITE
(mf/defc components-sprite-svg
[{:keys [file-id embed] :as props}]
(let [fetch (mf/use-fn
(mf/deps file-id)
(fn [] (repo/query! :file {:id file-id})))
file (use-resource fetch)
state (mf/use-state nil)]
(when file
[:*
[:style
(css [[:body
{:margin 0
:overflow "hidden"
:width "100vw"
:height "100vh"}]
[:main
{:overflow "auto"
:display "flex"
:justify-content "center"
:align-items "center"
:height "calc(100vh - 200px)"}
[:svg {:width "50%"
:height "50%"}]]
[:.nav
{:display "flex"
:margin 0
:padding "10px"
:flex-direction "column"
:flex-wrap "wrap"
:height "200px"
:list-style "none"
:overflow-x "scroll"
:border-bottom "1px dotted #e6e6e6"}
[:a {:cursor :pointer
:text-overflow "ellipsis"
:white-space "nowrap"
:overflow "hidden"
:text-decoration "underline"}]
[:li {:display "flex"
:width "150px"
:padding "5px"
:border "0px solid black"}]]])]
[:ul.nav
(for [[id data] (get-in file [:data :components])]
(let [on-click (fn [event]
(dom/prevent-default event)
(swap! state assoc :component-id id))]
[:li {:key (str id)}
[:a {:on-click on-click} (:name data)]]))]
[:main
[:& render/components-sprite-svg
{:data (:data file)
:embed embed}
(when-let [component-id (:component-id @state)]
[:use {:x 0 :y 0 :xlinkHref (str "#" component-id)}])]]
])))
(s/def ::component-id ::us/uuid)
(s/def ::render-components
(s/keys :req-un [::file-id]
:opt-un [::embed ::component-id]))
(defn render-components
[params]
(let [{:keys [file-id component-id embed]} (us/conform ::render-components params)]
(mf/html (mf/html
[:& render/render-object [:& components-sprite-svg
{:file-id file-id {:file-id file-id
:page-id page-id :component-id component-id
:object-id object-id :embed embed}])))
:embed? embed
:render-texts? render-texts}])))

28
frontend/src/app/util/dom.cljs
View file

@ -403,16 +403,16 @@
(defn mtype->extension [mtype] (defn mtype->extension [mtype]
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
(case mtype (case mtype
"image/apng" "apng" "image/apng" ".apng"
"image/avif" "avif" "image/avif" ".avif"
"image/gif" "gif" "image/gif" ".gif"
"image/jpeg" "jpg" "image/jpeg" ".jpg"
"image/png" "png" "image/png" ".png"
"image/svg+xml" "svg" "image/svg+xml" ".svg"
"image/webp" "webp" "image/webp" ".webp"
"application/zip" "zip" "application/zip" ".zip"
"application/penpot" "penpot" "application/penpot" ".penpot"
"application/pdf" "pdf" "application/pdf" ".pdf"
nil)) nil))
(defn set-attribute! [^js node ^string attr value] (defn set-attribute! [^js node ^string attr value]
@ -464,11 +464,11 @@
(defn trigger-download-uri (defn trigger-download-uri
[filename mtype uri] [filename mtype uri]
(let [link (create-element "a") (let [link (create-element "a")
extension (mtype->extension mtype) extension (mtype->extension mtype)
filename (if extension filename (if (and extension (not (str/ends-with? filename extension)))
(str filename "." extension) (str/concat filename "." extension)
filename)] filename)]
(obj/set! link "href" uri) (obj/set! link "href" uri)
(obj/set! link "download" filename) (obj/set! link "download" filename)
(obj/set! (.-style ^js link) "display" "none") (obj/set! (.-style ^js link) "display" "none")

2
frontend/src/app/worker/export.cljs
View file

@ -135,7 +135,7 @@
(rx/map #(assoc % :file-id file-id)) (rx/map #(assoc % :file-id file-id))
(rx/flat-map (rx/flat-map
(fn [media] (fn [media]
(let [file-path (str file-id "/media/" (:id media) "." (dom/mtype->extension (:mtype media)))] (let [file-path (str/concat file-id "/media/" (:id media) (dom/mtype->extension (:mtype media)))]
(->> (http/send! (->> (http/send!
{:uri (cfg/resolve-file-media media) {:uri (cfg/resolve-file-media media)
:response-type :blob :response-type :blob

2
frontend/src/app/worker/import.cljs
View file

@ -48,7 +48,7 @@
:typographies (str file-id "/typographies.json") :typographies (str file-id "/typographies.json")
:media-list (str file-id "/media.json") :media-list (str file-id "/media.json")
:media (let [ext (dom/mtype->extension (:mtype media))] :media (let [ext (dom/mtype->extension (:mtype media))]
(str file-id "/media/" id "." ext)) (str/concat file-id "/media/" id ext))
:components (str file-id "/components.svg")) :components (str file-id "/components.svg"))
parse-svg? (and (not= type :media) (str/ends-with? path "svg")) parse-svg? (and (not= type :media) (str/ends-with? path "svg"))

10
frontend/src/app/worker/thumbnails.cljs
View file

@ -56,15 +56,16 @@
:uri (u/join (cfg/get-public-uri) path) :uri (u/join (cfg/get-public-uri) path)
:credentials "include" :credentials "include"
:query params}] :query params}]
(->> (http/send! request) (->> (http/send! request)
(rx/map http/conditional-decode-transit) (rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))) (rx/mapcat handle-response))))
(defn- render-thumbnail (defn- render-thumbnail
[{:keys [data file-id revn] :as params}] [{:keys [page file-id revn] :as params}]
(let [elem (if-let [frame (:thumbnail-frame data)] (let [elem (if-let [frame (:thumbnail-frame page)]
(mf/element render/frame-svg #js {:objects (:objects data) :frame frame}) (mf/element render/frame-svg #js {:objects (:objects page) :frame frame})
(mf/element render/page-svg #js {:data data :width "290" :height "150" :thumbnails? true}))] (mf/element render/page-svg #js {:data page :thumbnails? true}))]
{:data (rds/renderToStaticMarkup elem) {:data (rds/renderToStaticMarkup elem)
:fonts @fonts/loaded :fonts @fonts/loaded
:file-id file-id :file-id file-id
@ -81,6 +82,7 @@
:uri (u/join (cfg/get-public-uri) path) :uri (u/join (cfg/get-public-uri) path)
:credentials "include" :credentials "include"
:body (http/transit-data params)}] :body (http/transit-data params)}]
(->> (http/send! request) (->> (http/send! request)
(rx/map http/conditional-decode-transit) (rx/map http/conditional-decode-transit)
(rx/mapcat handle-response) (rx/mapcat handle-response)