github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-08 11:04:44 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/frontend/src/app/main/data/viewer.cljs
Andrey Antukh 93d36d04d8
✨ Stabilize fragmented file data across snapshots and GC (#12420) 
* ✨ Stabilize fragmented file data across snapshots and GC

Snapshots, automatic and user, now store pointer-based rows that share
fragments with the live file instead of duplicating page content.
`get-file-snapshot` resolves those pointers on the server so version
previews keep rendering plain data, and `restore!` reuses the shared
rows. Export still materializes (the package carries no fragments) and
import regenerates them.

`file-gc` treats the main file and every unpurged snapshot as liveness
roots, reads the file unrealized, and reattaches the original pointer
wherever the cleaned value is unchanged, so a pass over an untouched
file writes no fragments and a pass over an edited file keeps the ids
of the pages it did not touch. Snapshot creation and the restore
backup take the file row `FOR SHARE`, which serializes them with the
pass and closes the race that let a new snapshot reference fragments
the pass was about to mark.

All backend pointer bindings go through the `fdata/with-pointers`,
`with-tracked`, `with-tracked-pointers` and `with-untracked` macros.
The loader reads fragments a previous pass marked until `objects-gc`
purges them, and the frontend fails loudly with retry instead of
dropping an unresolved fragment.

Review fixes in this branch: the automatic snapshot attaches before
pending migrations, `realize-pointers` is the single verb,
`reattach-unchanged` takes the identity fast path, the restore guard
takes its revn from the backup read, and `PointerMap.withMeta`
generates a fresh id when metadata changes.

Tests cover both snapshot writers (red without the lock), snapshot
sharing and pin release through the real delete and purge paths,
reattach against orphan marking, preview after offload, the pointer
binding contracts and the with-meta id change.

Closes #12410

AI-assisted-by: muse-spark-1.3-contributor
AI-assisted-by: deepseek-v4.1-flash

♻️ Pin no-churn behavior for untouched pages

Pin the behavior the churn verification measured: a save keeps the
fragment id of every page it does not touch, with a page of eleven keys
(PersistentHashMap), a 46-shape objects map and a nine-page index (hash
map). Also pin the mixed case: a data-level objects-map flip rewrites
the old pointer pages once and the next save keeps the new ids.

The memory records the identity rule behind it: re-assoc with the same
value returns the same map in array and hash maps alike.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

⚡ Stop loading untouched pages when enabling objects-map

`enable-objects-map` wrapped every page on every save, and reading a
page's objects forced its PointerMap to load the fragment. A save of
one page in a seven-page file therefore made seven fragment reads.

Skip unloaded pointers: their fragment was already wrapped by the
encode-file that wrote it, so loading it only to wrap it again is a
no-op. The save now loads only the pages it edits. A page with a plain
fragment (a data-level feature flip) keeps its plain fragment until it
is first loaded or edited; a migration that enables the feature must
rewrite the data itself.

Cover the change with load-count tests for save and restore, update the
flip test to the new contract, and drop the stale restore comment.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

⚡ Keep page fragment ids through pending migrations

Applying a pending migration on read realized the file, ran the
migration and persisted it again; the persist wrapped every plain page
in a new PointerMap, so every page got a new fragment id even when the
migration did not change it. That leaves the fragment cache cold and
rewrites every fragment on the first read after a deploy.

Capture the original pointers before realizing, reattach the unchanged
positions after migrating (same value comparison file-gc already uses),
persist the reattached file and return the realized one: the read
contract is plain data. Read-only connections skip the persist and the
reattach. A migration that adds objects-map skips the reattach so the
pages get wrapped.

Move the three helpers to fdata so file-gc and the migration path share
them, and cover the path with a real 0031 migration test: the unchanged
page keeps its id, the changed page gets a new one, the caller gets
realized data and a second read does not migrate again.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Realize library pointers with each library's own loader

Fragment rows are keyed by file id, and every caller binds the
fragment loader of the file it works on. get-resolved-file-libraries
returned libraries with their pages still as pointers, so the first
read of a library page under fdata/pointer-map asked the consuming
file for the fragment and failed with :fragment-not-found. That
broke migrations and file validation for every file using a
pointer-mapped library.

The weak-map loader now realizes each library's pointers with the
library's own id. The test fails without the change.

AI-assisted-by: claude-opus-5-5
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>

* 🐛 Restore the pointer-map require the repair path still needs

The branch dropped `app.util.pointer-map` from the namespace while the
auto-repair path (added to develop before this branch) still rebinds
`pmap/*tracked*` around validation and repair in
`repair-preexisting-damage` and `process-changes-and-validate`. The
namespace did not compile, so the whole backend failed to load.

Those toggles do not fit the fdata macros: `with-untracked` binds nil
and `with-tracked` creates a fresh atom, while the repair path has to
turn tracking off and restore the existing atom (and read it before the
repair starts). Restore the require and keep the bindings explicit.

Also pin the feature-off path with a test: with `fdata/pointer-map` off
(the default), a save creates no fragments, file-gc writes nothing and
the snapshot preview still returns plain data. Drop a stray `\n` char
literal left at the end of one deftest.

Update the memories with the exception to the macro rule, the snapshot
FOR SHARE locking and the pre-migration automatic snapshot.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Validate debug files with their own pointer loader

The `/dbg/actions` file validation passed the file id where
`get-resolved-file-libraries` expects the file map, so the library map
was seeded with a nil key. It also validated a file read without
realizing it, so the first page lookup of a pointer-mapped file raised
"load is not supported when *load-fn* is not bind" and the endpoint
could not validate exactly the files the feature touches.

Read the file realized (validation walks every page and component
anyway) and build the library map from the file. The library loader
already resolves each library's pointers with its own id, so the
realized file and its libraries validate as plain data. Covered by a
handler-level test that fails before the change.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Bind the snapshot loader through the fdata helper

`reduce-snapshots` hand-rolled the same `binding` that
`fdata/with-pointers` builds (it also loaded the function's own
pointer loader before entering the reduction). Use the macro so the
rule holds there too and the namespace no longer needs
`app.util.pointer-map`; the loader is identical (same cfg and file-id)
and snapshot walking behaves the same.

AI-assisted-by: deepseek-v4.1-flash

* 📚 Note the pointer-binding exceptions and snapshot ordering

Record what the feature review settled:

- Two direct `binding`s stay on purpose: the fine-grained `*tracked*`
  toggles of `app.rpc.commands.files-update` (validation/repair turn
  tracking off and restore the existing atom) and
  `binfile.common/encode-file` (fresh tracked set inheriting the
  current one). Atom-scoped macros would only be worth it if the set
  grows.
- The automatic snapshot is taken before the pending migration, and
  the pre-migration window is narrow: the `get-file` RPC migrates on
  read and its ETag hashes the available migrations, so a post-deploy
  read cannot be a 304 from the pre-deploy state. The old-format
  snapshot only appears when the save is the first request to touch
  the file after the deploy, and `get-file-snapshot` previews it as
  stored.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Apply pending migrations when previewing a version

Automatic snapshots are attached before the save applies pending file
migrations, so a version can store the old format. The preview RPC
handed that data to the UI as stored, and the viewport renders it with
the current code.

Realize the snapshot with the live file id (fragments are keyed by
file, not by snapshot), normalize its migrations to a set (the decoder
keeps the pgarray as a vector, and `set/difference` would compare
indexes) and apply the pending migrations with the pure
`fmg/migrate-file` and the live libraries. Nothing is persisted: the
stored version keeps its data and restoring it re-migrates on the next
read. The response now carries the snapshot's migrations.

Use `:features` the way `get-file` does for `fdata/objects-map`: a
client that does not declare it gets plain objects. The historical
feature set is not checked against the enabled one on purpose: a
version may predate a feature change.

Cover the preview of a snapshot with a pending migration and the
objects realization; both pin that the stored row is untouched. Update
the file-data memory with the preview contract and the vector/set
trap.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Decode snapshot migrations as an ordered set

`file-snapshots/decode-snapshot` handed the `file_change.migrations`
pgarray as a vector. `set/difference` falls back to index lookups when
the first collection is shorter than the second, so the pending set was
right only by accident: a stored subset happens to work, while a
stored set larger than `available-migrations` (a snapshot taken by a
newer build) marks every available migration as pending and re-applies
it to already migrated data.

Decode it as a `d/ordered-set`, the type the rest of the code and
`schema:file` expect. This also covers `restore!` and the snapshot
list, and it lets `get-file-snapshot` drop the `(into #{} ...)`
normalization it was carrying. Re-wrap the union in `fmg/migrate` so
the invariant holds even when a caller hands a plain set.

A snapshot with NULL `migrations` predates SQL migration 0140 and
keeps the format version of its time. Pin that legacy path: the
preview regenerates the applied set from that version, migrates in
memory and leaves the stored row untouched. Update the file-data
memory with the invariant and the legacy path.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Fix flaky waiting-gauge assertion in climit test

The throwable-while-waiting test asserted the exact list of
waiting-gauge publications, but the component sampler republishes
the same count when its first tick lands inside the recorded
window under load. Assert only the last value, which is the
contract the helper documents.

AI-assisted-by: muse-spark-1.3

---------

Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
Co-authored-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
2026-11-02 15:02:55 +01:00

934 lines
31 KiB
Clojure
Raw Blame History

;; 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) KALEIDOS SUBSIDIARY SL
(ns app.main.data.viewer
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.files.changes :as cpc]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.schema :as sm]
[app.common.transit :as t]
[app.common.types.shape-tree :as ctt]
[app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.comments :as dcmt]
[app.main.data.common :as dcm]
[app.main.data.event :as ev]
[app.main.data.fonts :as df]
[app.main.data.helpers :as dsh]
[app.main.features :as features]
[app.main.features.pointer-map :as fpmap]
[app.main.repo :as rp]
[app.main.router :as rt]
[app.render-wasm.api :as wasm.api]
[app.util.globals :as ug]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
;; --- Local State Initialization
(def ^:private
default-local-state
{:zoom 1
:fullscreen? false
:interactions-mode :show-on-click
:show-interactions false
:comments-mode :all
:comments-show :unresolved
:selected #{}
:collapsed #{}
:hover nil
:share-id ""})
(declare fetch-comment-threads)
(declare fetch-bundle)
(declare bundle-fetched)
(declare zoom-to-fill)
(declare zoom-to-fit)
(def ^:private
schema:initialize
[:map {:title "initialize"}
[:file-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]
[:page-id {:optional true} ::sm/uuid]])
(defn initialize
[{:keys [file-id share-id] :as params}]
(dm/assert!
"expected valid params"
(sm/check schema:initialize params))
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc :current-file-id file-id)
(assoc :current-share-id share-id)
(update :viewer-local
(fn [lstate]
(if (nil? lstate)
default-local-state
lstate)))
(assoc-in [:viewer-local :share-id] share-id)
(update :comments-local dcmt/merge-persisted-filters)))
ptk/WatchEvent
(watch [_ state _]
(rx/of (fetch-bundle (d/without-nils params))
;; Only fetch threads for logged-in users
(when (some? (:profile state))
(fetch-comment-threads params))
(when (:share-id params)
(rx/of (ev/event {::ev/name "shared-prototipe-visited"})))))
ptk/EffectEvent
(effect [_ _ _]
;; Set the window name, the window name is used on inter-tab
;; navigation; in other words: when a user opens a tab with a
;; name, if there are already opened tab with that name, the
;; browser just focus the opened tab instead of creating new
;; tab.
(let [name (str "viewer-" file-id)]
(unchecked-set ug/global "name" name))
;; Make every `cf/resolve-file-media` call (inspector, code panel,
;; image previews, ...) share-link aware for the lifetime of this
;; viewer. Cleared by `finalize` below.
(cf/set-current-share-id! share-id))))
(defn finalize
[_]
(ptk/reify ::finalize
ptk/UpdateEvent
(update [_ state]
(dissoc state :viewer))
ptk/EffectEvent
(effect [_ _ _]
(cf/set-current-share-id! nil))))
;; --- Data Fetching
(def ^:private
schema:fetch-bundle
[:map {:title "fetch-bundle"}
[:page-id ::sm/uuid]
[:file-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]])
(defn resolve-viewer-fragment
"Resolves one pointer-mapped entry of the view-only bundle into a
[key data] pair. Thin wrapper over the shared `fpmap/resolve-pointer`
with share-link scoping; see it for the failure contract."
[file-id share-id entry]
(fpmap/resolve-pointer file-id share-id entry))
(defn- fetch-bundle
[{:keys [file-id share-id] :as params}]
(dm/assert!
"expected valid params"
(sm/check schema:fetch-bundle params))
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [_ _ _]
(let [;; NOTE: in viewer we don't have access to the team when
;; user is not logged-in, so we can't know which features
;; are active from team, so in this case it is necesary
;; report the whole set of supported features instead of
;; the enabled ones.
features cfeat/supported-features
params' (cond-> {:file-id file-id :features features}
(uuid? share-id)
(assoc :share-id share-id))
resolve (partial resolve-viewer-fragment file-id share-id)]
(->> (rp/cmd! :get-view-only-bundle params')
(rx/mapcat
(fn [bundle]
(->> (rx/from (-> bundle :file :data :pages-index seq))
(rx/merge-map
(fn [[_ page :as kp]]
(if (t/pointer? page)
(resolve kp)
(rx/of kp))))
(rx/reduce conj {})
(rx/map (fn [pages-index]
(update-in bundle [:file :data] assoc :pages-index pages-index))))))
(rx/mapcat
(fn [bundle]
(->> (rx/from (-> bundle :file :data seq))
(rx/merge-map
(fn [[_ object :as kp]]
(if (t/pointer? object)
(resolve kp)
(rx/of kp))))
(rx/reduce conj {})
(rx/map (fn [data]
(update bundle :file assoc :data data))))))
(rx/mapcat
(fn [{:keys [fonts team] :as bundle}]
(rx/of (df/fonts-fetched fonts)
(features/initialize (:features team))
(bundle-fetched (merge bundle params))))))))))
(declare go-to-frame)
(declare go-to-frame-by-index)
(declare go-to-frame-auto)
;; Applies to the viewer the changes passed as parameters
;; will not save the data but just modify the data localy
(defn- apply-changes-viewer
[changes]
(ptk/reify ::apply-changes-viewer
ptk/UpdateEvent
(update [_ state]
(let [file (-> (dm/get-in state [:viewer :file])
(update :data cpc/process-changes changes false))
pages
(->> (dm/get-in file [:data :pages])
(map (fn [page-id]
(let [data (get-in file [:data :pages-index page-id])]
[page-id (assoc data
:frames (ctt/get-viewer-frames (:objects data))
:all-frames (ctt/get-viewer-frames (:objects data) {:all-frames? true}))])))
(into {}))]
(-> state
(assoc-in [:viewer :file] file)
(assoc-in [:viewer :pages] pages))))))
(defn- generate-update-position-data-changes
[shapes page-id]
(reduce
(fn [result shape]
(conj result
{:type :mod-obj
:id (:id shape)
:page-id page-id
:operations
[{:type :set
:attr :position-data
:val (wasm.api/calculate-position-data shape)
:ignore-touched true
:ignore-geometry true}]}))
[]
shapes))
(defn update-page-position-data
[file-id page-id]
(ptk/reify ::update-page-position-data
ptk/WatchEvent
(watch [_ state _]
(if (and (features/active-feature? state "render-wasm/v1")
(contains? cf/flags :available-viewer-wasm))
;; Fallback matches the viewer UI when the URL omits page-id.
(let [page-id (or page-id
(-> (dsh/lookup-file-data state file-id)
:pages
first))
objects (dsh/lookup-page-objects state file-id page-id)
shapes
(reduce-kv
(fn [result _ shape]
(cond-> result
(and (cfh/text-shape? shape) (nil? (:position-data shape)))
(conj shape)))
[]
objects)
;; Positive size required: OffscreenCanvas(0, 0) crashes
;; `_set_render_options` on some browsers.
set-objects-stream
(rx/create
(fn [subs]
(wasm.api/init-canvas-context (js/OffscreenCanvas. 64 64))
(wasm.api/set-objects-callback shapes #(rx/push! subs :done))
nil))]
(if (d/not-empty? shapes)
(->> (rx/from @wasm.api/module)
(rx/mapcat (constantly set-objects-stream))
(rx/mapcat
(fn []
(let [changes (generate-update-position-data-changes shapes page-id)
_ (wasm.api/clear-canvas)]
(if (d/not-empty? changes)
(rx/of (apply-changes-viewer changes))
(rx/empty))))))
(rx/empty)))
;; Render wasm disabled, we do nothing
(rx/empty)))))
(defn bundle-fetched
[{:keys [project file team share-links libraries users permissions thumbnails] :as bundle}]
(let [pages (->> (dm/get-in file [:data :pages])
(map (fn [page-id]
(let [data (get-in file [:data :pages-index page-id])]
[page-id (assoc data
:frames (ctt/get-viewer-frames (:objects data))
:all-frames (ctt/get-viewer-frames (:objects data) {:all-frames? true}))])))
(into {}))]
(ptk/reify ::bundle-fetched
ptk/UpdateEvent
(update [_ state]
(let [team-id (:id team)
team (assoc team :members users)]
(-> state
(assoc :share-links share-links)
(assoc :current-team-id team-id)
(assoc :teams {team-id team})
(assoc :files (-> (d/index-by :id libraries)
(assoc (:id file) file)))
(assoc :viewer {:libraries (d/index-by :id libraries)
:users (d/index-by :id users)
:permissions permissions
:project project
:pages pages
:thumbnails thumbnails
:file file}))))
ptk/WatchEvent
(watch [_ state _]
(let [route (:route state)
qparams (:query-params route)
index (some-> (rt/get-query-param qparams :index) parse-long)
frame-id (some-> (:frame-id qparams) uuid/parse)
page-id (some-> (rt/get-query-param qparams :page-id) uuid/parse)
file-id (some-> (rt/get-query-param qparams :file-id) uuid/parse)]
(rx/merge
(rx/of (case (:zoom qparams)
"fit" zoom-to-fit
"fill" zoom-to-fill
nil))
(rx/of
(update-page-position-data file-id page-id)
(cond
(some? frame-id) (go-to-frame frame-id)
(some? index) (go-to-frame-by-index index)
:else (go-to-frame-auto)))))))))
(defn fetch-comment-threads
[{:keys [file-id page-id share-id] :as params}]
(letfn [(fetched [data state]
(->> data
(filter #(= page-id (:page-id %)))
(d/index-by :id)
(assoc state :comment-threads)))
(on-error [cause]
(let [{:keys [type]} (ex-data cause)]
(if (or (= :authentication type)
(= :not-found type))
(rx/empty)
(rx/throw cause))))]
(ptk/reify ::fetch-comment-threads
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/cmd! :get-comment-threads {:file-id file-id :share-id share-id})
(rx/map #(partial fetched %))
(rx/catch on-error))))))
(defn refresh-comment-thread
[{:keys [id file-id] :as thread}]
(letfn [(fetched [thread state]
(assoc-in state [:comment-threads id] thread))]
(ptk/reify ::refresh-comment-thread
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/cmd! :get-comment-thread {:file-id file-id :id id})
(rx/map #(partial fetched %)))))))
(defn fetch-comments
[{:keys [thread-id]}]
(assert (uuid? thread-id))
(letfn [(fetched [comments state]
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/cmd! :get-comments {:thread-id thread-id})
(rx/map #(partial fetched %)))))))
;; --- Zoom Management
(def update-zoom-querystring
(ptk/reify ::update-zoom-querystring
ptk/WatchEvent
(watch [_ state _]
(let [zoom-type (get-in state [:viewer-local :zoom-type])
params (rt/get-params state)
current (rt/get-query-param params :zoom)
expected (some-> zoom-type name)]
;; Zoom is view state: mirror it into the URL, replacing the history
;; entry, only when the query string does not already describe it.
(when (not= current expected)
(rx/of (rt/nav :viewer
(if (some? zoom-type)
(assoc params :zoom zoom-type)
(dissoc params :zoom))
{::rt/replace true})))))))
(def increase-zoom
(ptk/reify ::increase-zoom
ptk/UpdateEvent
(update [_ state]
(let [increase #(min (* % 1.3) 200)]
(-> state
(update-in [:viewer-local :zoom] (fnil increase 1))
(d/dissoc-in [:viewer-local :zoom-type]))))))
(def decrease-zoom
(ptk/reify ::decrease-zoom
ptk/UpdateEvent
(update [_ state]
(let [decrease #(max (/ % 1.3) 0.01)]
(-> state
(update-in [:viewer-local :zoom] (fnil decrease 1))
(d/dissoc-in [:viewer-local :zoom-type]))))))
(def reset-zoom
(ptk/reify ::reset-zoom
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:viewer-local :zoom] 1)
(d/dissoc-in [:viewer-local :zoom-type])))))
(def zoom-to-fit
(ptk/reify ::zoom-to-fit
ptk/UpdateEvent
(update [_ state]
(let [params (rt/get-params state)
page-id (some-> (:page-id params) uuid/parse)
index (some-> (rt/get-query-param params :index) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
srect (-> (nth frames index)
(get :selrect))
osize (dm/get-in state [:viewer-local :viewport-size])
wdiff (/ (:width osize) (:width srect))
hdiff (/ (:height osize) (:height srect))
minzoom (min wdiff hdiff)]
(-> state
(assoc-in [:viewer-local :zoom] minzoom)
(assoc-in [:viewer-local :zoom-type] :fit))))
ptk/WatchEvent
(watch [_ _ _] (rx/of update-zoom-querystring))))
(def zoom-to-fill
(ptk/reify ::zoom-to-fill
ptk/UpdateEvent
(update [_ state]
(let [params (rt/get-params state)
page-id (some-> (:page-id params) uuid/parse)
index (some-> (rt/get-query-param params :index) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
srect (-> (nth frames index)
(get :selrect))
osize (dm/get-in state [:viewer-local :viewport-size])
wdiff (/ (:width osize) (:width srect))
hdiff (/ (:height osize) (:height srect))
maxzoom (max wdiff hdiff)]
(-> state
(assoc-in [:viewer-local :zoom] maxzoom)
(assoc-in [:viewer-local :zoom-type] :fill))))
ptk/WatchEvent
(watch [_ _ _] (rx/of update-zoom-querystring))))
(def toggle-zoom-style
(ptk/reify ::toggle-zoom-style
ptk/WatchEvent
(watch [_ state _]
(let [zoom-type (get-in state [:viewer-local :zoom-type])]
(if (= zoom-type :fit)
(rx/of zoom-to-fill)
(rx/of zoom-to-fit))))))
(def toggle-fullscreen
(ptk/reify ::toggle-fullscreen
ptk/UpdateEvent
(update [_ state]
(update-in state [:viewer-local :fullscreen?] not))))
(defn exit-fullscreen
[]
(ptk/reify ::exit-fullscreen
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :fullscreen?] false))))
(defn set-viewport-size
[{:keys [size]}]
(ptk/reify ::set-viewport-size
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :viewport-size] size))))
;; --- Local State Management
(def toggle-thumbnails-panel
(ptk/reify ::toggle-thumbnails-panel
ptk/UpdateEvent
(update [_ state]
(update-in state [:viewer-local :show-thumbnails] not))))
(def close-thumbnails-panel
(ptk/reify ::close-thumbnails-panel
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :show-thumbnails] false))))
(def select-prev-frame
(ptk/reify ::select-prev-frame
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :viewer-animations)
(assoc :viewer-overlays [])))
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)
index (some-> (rt/get-query-param params :index) parse-long)]
(when (pos? index)
(rx/of
(dcmt/close-thread)
(rt/nav :viewer (assoc params :index (dec index)))))))))
(def select-next-frame
(ptk/reify ::select-next-frame
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :viewer-animations)
(assoc :viewer-overlays [])))
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)
index (some-> (rt/get-query-param params :index) parse-long)
page-id (some-> params :page-id uuid/parse)
total (count (get-in state [:viewer :pages page-id :frames]))]
(when (< index (dec total))
(rx/of
(dcmt/close-thread)
(rt/nav :viewer (assoc params :index (inc index)))))))))
(def select-first-frame
(ptk/reify ::select-first-frame
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)]
(rx/of
(dcmt/close-thread)
(rt/nav :viewer (assoc params :index 0)))))))
(def valid-interaction-modes
#{:hide :show :show-on-click})
(defn set-interactions-mode
[mode]
(dm/assert!
"expected valid interaction mode"
(contains? valid-interaction-modes mode))
(ptk/reify ::set-interactions-mode
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:viewer-local :interactions-mode] mode)
(assoc-in [:viewer-local :show-interactions] (case mode
:hide false
:show true
:show-on-click false))))
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)]
(rx/of (rt/nav :viewer (assoc params :interactions-mode mode)))))))
(declare flash-done)
(defn flash-interactions
[]
(ptk/reify ::flash-interactions
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :show-interactions] true))
ptk/WatchEvent
(watch [_ _ stream]
(let [stopper (rx/filter (ptk/type? ::flash-interactions) stream)]
(->> (rx/of flash-done)
(rx/delay 500)
(rx/take-until stopper))))))
(def flash-done
(ptk/reify ::flash-done
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :show-interactions] false))))
(defn set-nav-scroll
[scroll]
(ptk/reify ::set-nav-scroll
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :nav-scroll] scroll))))
(defn reset-nav-scroll
[]
(ptk/reify ::reset-nav-scroll
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:viewer-local :nav-scroll]))))
(defn update-exports-cache
[shapes-key exports]
(ptk/reify ::update-exports-cache
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:inspect-exports-cache shapes-key] exports))))
(defn complete-animation
[]
(ptk/reify ::complete-animation
ptk/UpdateEvent
(update [_ state]
(dissoc state :viewer-animations))))
;; --- Navigation inside page
(defn go-to-frame-by-index
[index]
(ptk/reify ::go-to-frame-by-index
ptk/UpdateEvent
(update [_ state]
(assoc state :viewer-overlays []))
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)]
(rx/of (rt/nav :viewer (assoc params :index index)))))))
(defn go-to-frame
([frame-id]
(go-to-frame frame-id nil))
([frame-id animation]
(dm/assert!
"expected valid parameters"
(and (uuid? frame-id)
(or (nil? animation)
(ctsi/check-animation! animation))))
(ptk/reify ::go-to-frame
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
index (some-> (rt/get-query-param qparams :index) parse-long)
frames (get-in state [:viewer :pages page-id :frames])
frame (get frames index)]
(cond-> state
:always
(assoc :viewer-overlays [])
(some? animation)
(assoc-in [:viewer-animations (:id frame)]
{:kind :go-to-frame
:orig-frame-id (:id frame)
:animation animation}))))
ptk/WatchEvent
(watch [_ state _]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
frames (get-in state [:viewer :pages page-id :frames])
index (d/index-of-pred frames #(= (:id %) frame-id))]
(rx/of (go-to-frame-by-index (or index 0))))))))
(defn go-to-frame-auto
[]
(ptk/reify ::go-to-frame-auto
ptk/WatchEvent
(watch [_ state _]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
flows (get-in state [:viewer :pages page-id :options :flows])]
(if (seq flows)
(let [frame-id (:starting-frame (first flows))]
(rx/of (go-to-frame frame-id)))
(rx/of (go-to-frame-by-index 0)))))))
(defn go-to-section
[section]
(ptk/reify ::go-to-section
ev/Event
(-data [_]
{::ev/origin "viewer"
:section (name section)})
ptk/UpdateEvent
(update [_ state]
(assoc state :viewer-overlays []))
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)]
(rx/of (rt/nav :viewer (assoc params :section section)))))))
;; --- Overlays
(defn- open-overlay*
[state frame position snap-to close-click-outside background-overlay animation fixed-source?]
(cond-> state
:always
(update :viewer-overlays conj
{:frame frame
:id (:id frame)
:position position
:snap-to snap-to
:close-click-outside close-click-outside
:background-overlay background-overlay
:animation animation
:fixed-source? fixed-source?})
(some? animation)
(assoc-in [:viewer-animations (:id frame)]
{:kind :open-overlay
:overlay-id (:id frame)
:animation animation})))
(defn- close-overlay*
[state frame-id animation]
(if (nil? animation)
(update state :viewer-overlays
(fn [overlays]
(d/removev #(= (:id (:frame %)) frame-id) overlays)))
(assoc-in state [:viewer-animations frame-id]
{:kind :close-overlay
:overlay-id frame-id
:animation animation})))
(defn open-overlay
[frame-id position snap-to close-click-outside background-overlay animation fixed-source?]
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
(boolean? close-click-outside)))
(dm/assert! (or (nil? background-overlay)
(boolean? background-overlay)))
(dm/assert! (or (nil? animation)
(ctsi/check-animation! animation)))
(ptk/reify ::open-overlay
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
frames (dm/get-in state [:viewer :pages page-id :all-frames])
frame (d/seek #(= (:id %) frame-id) frames)
overlays (:viewer-overlays state)]
(if-not (some #(= (:frame %) frame) overlays)
(open-overlay* state
frame
position
snap-to
close-click-outside
background-overlay
animation
fixed-source?)
state)))))
(defn toggle-overlay
[frame-id position snap-to close-click-outside background-overlay animation fixed-source?]
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
(boolean? close-click-outside)))
(dm/assert! (or (nil? background-overlay)
(boolean? background-overlay)))
(dm/assert! (or (nil? animation)
(ctsi/check-animation! animation)))
(ptk/reify ::toggle-overlay
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
frames (get-in state [:viewer :pages page-id :all-frames])
frame (d/seek #(= (:id %) frame-id) frames)
overlays (:viewer-overlays state)]
(if-not (some #(= (:frame %) frame) overlays)
(open-overlay* state
frame
position
snap-to
close-click-outside
background-overlay
animation
fixed-source?)
(close-overlay* state
(:id frame)
(ctsi/invert-direction animation)))))))
(defn close-overlay
([frame-id] (close-overlay frame-id nil))
([frame-id animation]
(dm/assert! (uuid? frame-id))
(dm/assert! (or (nil? animation)
(ctsi/check-animation! animation)))
(ptk/reify ::close-overlay
ptk/UpdateEvent
(update [_ state]
(close-overlay* state
frame-id
animation)))))
;; --- Objects selection
(defn deselect-all []
(ptk/reify ::deselect-all
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :selected] #{}))))
(defn select-shape
([id]
(ptk/reify ::select-shape
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:viewer-local :selected] #{id}))))))
(defn toggle-selection
[id]
(ptk/reify ::toggle-selection
ptk/UpdateEvent
(update [_ state]
(let [selected (get-in state [:viewer-local :selected])]
(cond-> state
(not (selected id)) (update-in [:viewer-local :selected] conj id)
(selected id) (update-in [:viewer-local :selected] disj id))))))
(defn shift-select-to
[id]
(ptk/reify ::shift-select-to
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
objects (get-in state [:viewer :pages page-id :objects])
selection (-> state
(get-in [:viewer-local :selected] #{})
(conj id))]
(-> state
(assoc-in [:viewer-local :selected]
(cfh/expand-region-selection objects selection)))))))
(defn select-all
[]
(ptk/reify ::select-all
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
index (some-> (rt/get-query-param qparams :index) parse-long)
objects (get-in state [:viewer :pages page-id :objects])
frame-id (get-in state [:viewer :pages page-id :frames index :id])
selection (->> objects
(filter #(= (:frame-id (second %)) frame-id))
(map first)
(into #{frame-id}))]
(-> state
(assoc-in [:viewer-local :selected] selection))))))
(defn toggle-collapse [id]
(ptk/reify ::toggle-collapse
ptk/UpdateEvent
(update [_ state]
(let [toggled? (contains? (get-in state [:viewer-local :collapsed]) id)]
(update-in state [:viewer-local :collapsed] (if toggled? disj conj) id)))))
(defn hover-shape
[id hover?]
(ptk/reify ::hover-shape
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :hover] (when hover? id)))))
;; --- Navigation outside page
(defn go-to-dashboard
[]
(ptk/reify ::go-to-dashboard
ptk/WatchEvent
(watch [_ state _]
(let [team-id (get-in state [:viewer :project :team-id])]
(rx/of (dcm/go-to-dashboard-recent :team-id team-id))))))
(defn go-to-page
[page-id]
(ptk/reify ::go-to-page
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :overlays] []))
ptk/WatchEvent
(watch [_ state _]
(let [params (-> (rt/get-params state)
(assoc :index 0)
(assoc :page-id page-id))]
(rx/of (rt/nav :viewer params))))))
(defn go-to-workspace
([] (go-to-workspace nil))
([page-id]
(ptk/reify ::go-to-workspace
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)
file-id (get-in state [:viewer :file :id])
team-id (get-in state [:viewer :project :team-id])
page-id (or page-id
(some-> (:page-id params) uuid/parse))
params {:page-id page-id
:file-id file-id
:team-id team-id}
name (dm/str "workspace-" file-id)]
(rx/of (rt/nav :workspace params
::rt/new-window true
::rt/window-name name)))))))
Reference in New Issue View Git Blame Copy Permalink