scenes/consumers.py

@@ -1,60 +1,22 @@
 import json
-import uuid
 
 from channels.generic.websocket import AsyncWebsocketConsumer
 
 
 class SceneConsumer(AsyncWebsocketConsumer):
-    """One connection per open project. Two things ride it.
+    """One connection per open project. Joins the project's group and relays
-
+    scene deltas the server broadcasts (see scenes.views.scene). Read-only:
-    Scene deltas: relayed from what the server broadcasts on a save (see
+    edits still go through the PUT endpoint, which is the broadcast source."""
-    scenes.views.scene). Read-only — edits still go through the PUT endpoint,
-    which is the broadcast source.
-
-    Presence: who's viewing, which ad-hoc party they're in, and where that party
-    is looking. Peers gossip it between themselves and work the party out
-    locally (tl.party); all this does is hand out a connection id, stamp the
-    sender's server-side identity onto every message — so nobody can post as
-    somebody else — and relay. Nothing about a party is stored anywhere.
-    """
-
-    RELAYED = ("state", "nav")
 
     async def connect(self):
-        self.pk = self.scope["url_route"]["kwargs"]["pk"]
+        self.pk = self.scope['url_route']['kwargs']['pk']
-        self.group = f"project_{self.pk}"
+        self.group = f'project_{self.pk}'
-        self.cid = uuid.uuid4().hex[:12]
-        user = self.scope.get("user")
-        self.username = user.get_username() if user and user.is_authenticated else None
         await self.channel_layer.group_add(self.group, self.channel_name)
         await self.accept()
-        await self.send(text_data=json.dumps(
-            {"kind": "welcome", "cid": self.cid, "user": self.username}))
-        # the room answers a join with their own state, so rosters fill in both ways
-        await self._relay({"kind": "join"})
 
     async def disconnect(self, code):
-        if hasattr(self, "cid"):
+        await self.channel_layer.group_discard(self.group, self.channel_name)
-            await self._relay({"kind": "leave"})
-            await self.channel_layer.group_discard(self.group, self.channel_name)
-
-    async def receive(self, text_data=None, bytes_data=None):
-        try:
-            msg = json.loads(text_data or "{}")
-        except ValueError:
-            return
-        if isinstance(msg, dict) and msg.get("kind") in self.RELAYED:
-            await self._relay(msg)
-
-    async def _relay(self, msg):
-        await self.channel_layer.group_send(
-            self.group,
-            {"type": "peer.msg", "msg": {**msg, "cid": self.cid, "user": self.username}})
-
-    # broadcast handler: {type: "peer.msg", msg: {...}} — presence gossip
-    async def peer_msg(self, event):
-        await self.send(text_data=json.dumps(event["msg"]))
 
     # broadcast handler: {type: "scene.delta", delta: {...}}
     async def scene_delta(self, event):
-        await self.send(text_data=json.dumps(event["delta"]))
+        await self.send(text_data=json.dumps(event['delta']))

scenes/tests.py

@@ -1,12 +1,9 @@
 import json
 
-from channels.testing import WebsocketCommunicator
 from django.contrib.auth import get_user_model
-from django.contrib.auth.models import AnonymousUser
+from django.test import Client, TestCase
-from django.test import Client, TestCase, TransactionTestCase
 
 from scenes.models import Project, Revision
-from server.asgi import application
 
 User = get_user_model()
 
@@ -106,58 +103,3 @@ class AccessTests(SceneApiTestCase):
         User.objects.create_user("carol", password="pw")
         carol = Client(); carol.login(username="carol", password="pw")
         self.assertEqual(self.put(carol, changed={"a1": ann("x")}).status_code, 404)
-
-
-class PresenceRelayTests(TransactionTestCase):
-    """The socket hands out connection ids and stamps identity; the party itself
-    is worked out in the browsers, so there is nothing here to store or trust."""
-
-    def setUp(self):
-        self.alice = User.objects.create_user("alice", password="pw")
-        self.project = Project.objects.create(owner=self.alice, name="p")
-
-    async def open(self, user=None):
-        comm = WebsocketCommunicator(application, f"/ws/projects/{self.project.pk}/")
-        comm.scope["user"] = user or AnonymousUser()
-        connected, _ = await comm.connect()
-        self.assertTrue(connected)
-        return comm, await comm.receive_json_from()
-
-    async def test_welcome_carries_an_id_and_the_signed_in_name(self):
-        comm, welcome = await self.open(self.alice)
-        self.assertEqual(welcome["kind"], "welcome")
-        self.assertEqual(welcome["user"], "alice")
-        self.assertTrue(welcome["cid"])
-        await comm.disconnect()
-
-    async def test_presence_is_stamped_with_the_server_side_identity(self):
-        a, a_hello = await self.open(self.alice)
-        await a.receive_json_from()                       # our own join, echoed back
-        b, _ = await self.open()
-        self.assertEqual((await a.receive_json_from())["kind"], "join")
-
-        await b.send_json_to({"kind": "state", "party": a_hello["cid"],
-                              "joinable": True, "joining": a_hello["cid"],
-                              "user": "alice", "cid": "forged"})
-        seen = await a.receive_json_from()
-        self.assertEqual(seen["party"], a_hello["cid"])
-        self.assertIsNone(seen["user"])                   # anonymous, not "alice"
-        self.assertNotEqual(seen["cid"], "forged")
-        await a.disconnect(); await b.disconnect()
-
-    async def test_scene_edits_are_not_accepted_over_the_socket(self):
-        a, _ = await self.open(self.alice)
-        await a.receive_json_from()                       # join
-        await a.send_json_to({"kind": "scene", "changed": {"a1": ann("x")}})
-        self.assertTrue(await a.receive_nothing(timeout=0.2))
-        await a.disconnect()
-
-    async def test_leaving_tells_the_room(self):
-        a, _ = await self.open(self.alice)
-        await a.receive_json_from()                       # join
-        b, b_hello = await self.open()
-        await a.receive_json_from()                       # b's join
-        await b.disconnect()
-        bye = await a.receive_json_from()
-        self.assertEqual((bye["kind"], bye["cid"]), ("leave", b_hello["cid"]))
-        await a.disconnect()

tl/resources/public/css/app.css

@@ -658,48 +658,6 @@ html.dark .timeline-head {
                    font-family: var(--chicago); font-size: 11px; white-space: nowrap; }
 .menu-pop button:hover { background: var(--ink); color: var(--paper); }
 
-/* --- who's viewing: presence cluster + party menu ----------------------- */
-.presence { display: flex; align-items: center; gap: 5px; }
-.avatars { display: flex; align-items: center; gap: 3px; padding: 1px 4px;
-           background: var(--paper); border: 1px solid transparent; cursor: pointer; }
-.avatars:hover, .presence.in-party .avatars { border-color: var(--ink); }
-.avatar { width: 18px; height: 18px; flex: 0 0 auto; border: 1px solid var(--ink);
-          border-radius: 50%; display: inline-flex; align-items: center;
-          justify-content: center; font-family: var(--chicago); font-size: 10px;
-          color: #000; box-sizing: border-box; }
-/* party-mates wear the badge; everyone else is just present */
-.avatar.mate { box-shadow: 0 0 0 2px var(--paper), 0 0 0 3px var(--ink); }
-.avatar.more { background: var(--paper) !important; color: var(--ink); font-size: 9px; }
-.party-tag { font-family: var(--chicago); font-size: 9px; letter-spacing: 1px;
-             text-transform: uppercase; padding: 0 3px; margin-right: 2px;
-             background: var(--ink); color: var(--paper); }
-.solo-btn { font-size: 10px; }
-/* detached while authoring: still in the party, just not being steered by it */
-.presence.detached .party-tag { background: var(--paper); color: var(--ink);
-                                border: 1px solid var(--ink); }
-.presence.detached .avatar.mate { box-shadow: none; opacity: 0.5; }
-
-.peer-pop { min-width: 232px; padding: 0; }
-.peer-group { padding: 4px; border-bottom: 1px solid var(--ink); }
-.peer-group:last-of-type { border-bottom: none; }
-.peer-group.mine { background: var(--shade); }
-.peer-group-head { display: flex; align-items: center; justify-content: space-between;
-                   gap: 8px; padding: 2px 4px 4px; font-family: var(--chicago);
-                   font-size: 10px; letter-spacing: 0.5px; text-transform: uppercase;
-                   color: var(--mute); }
-.peer-group.mine .peer-group-head { color: var(--ink); }
-.peer-row { display: flex; align-items: center; gap: 6px; padding: 3px 4px; }
-.peer-name { flex: 1; min-width: 0; overflow: hidden; text-overflow: ellipsis;
-             white-space: nowrap; font-size: 12px; }
-.peer-you { color: var(--mute); }
-.peer-closed { font-size: 10px; color: var(--mute); }
-.link-btn { background: none; border: none; padding: 0 2px; cursor: pointer;
-            font-family: var(--chicago); font-size: 10px; color: var(--ink);
-            text-decoration: underline; }
-.link-btn:hover { background: var(--ink); color: var(--paper); text-decoration: none; }
-.peer-setting { display: flex; align-items: center; gap: 6px; padding: 6px 8px;
-                border-top: 2px solid var(--ink); font-size: 11px; cursor: pointer; }
-
 /* --- annotation / script pane tabs ------------------------------------- */
 .pane-wrap { flex: 1; min-width: 0; display: flex; flex-direction: column; }
 .pane-tabs { display: flex; gap: 0; background: var(--paper); border-bottom: 1px solid var(--ink); }

tl/src/tl/api.cljs

@@ -70,96 +70,25 @@
         nil)
       fallback))
 
-;; --- realtime: the project socket ----------------------------------------
+;; --- realtime: live peer deltas over a websocket --------------------------
-;; Two things ride it: scene deltas the server broadcasts after a PUT (the
+;; Not a fetch, so it can't ride :http-xhrio; it dispatches ::peer-delta itself.
-;; untagged message, kept as the default branch below), and the presence gossip
-;; peers send each other — who's viewing, who's in which party, and where the
-;; party is looking. Not fetches, so they can't ride :http-xhrio; each message
-;; dispatches its own event.
 
 (defn- ->clj [x] (js->clj x :keywordize-keys true))
 
 (defonce ^:private socket (atom nil))
-(defonce ^:private conn (atom {:id nil :tries 0 :timer nil}))
-
-(defn- event-for [{:keys [kind] :as msg}]
-  [(case kind
-     "welcome" :tl.events/peer-welcome
-     "join"    :tl.events/peer-join
-     "state"   :tl.events/peer-state
-     "leave"   :tl.events/peer-leave
-     "nav"     :tl.events/peer-nav
-     :tl.events/peer-delta)                     ; untagged = a scene delta
-   msg])
-
-(defn- ws-url [id]
-  (let [l     js/window.location
-        proto (if (= "https:" (.-protocol l)) "wss:" "ws:")
-        host  (if (= "" api-port) (.-host l) (str (.-hostname l) ":" api-port))]
-    (str proto "//" host "/ws/projects/" id "/")))
-
-(declare open!)
-
-;; A dropped socket is the normal case, not the exception — a laptop lid, a
-;; tunnel, a backend redeploy. Back off up to ~15s and keep trying; the welcome
-;; that comes back is what tells the app to catch up on what it missed.
-(defn- retry-later! [id]
-  (let [tries (:tries @conn)]
-    (swap! conn assoc
-           :tries (inc tries)
-           :timer (js/setTimeout #(open! id) (min 15000 (* 500 (js/Math.pow 2 tries)))))))
-
-(defn- open! [id]
-  (when (= id (:id @conn))
-    (let [s (js/WebSocket. (ws-url id))]
-      (reset! socket s)
-      (set! (.-onopen s) (fn [_] (swap! conn assoc :tries 0)))
-      (set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
-      (set! (.-onmessage s) (fn [e] (rf/dispatch (event-for (->clj (js/JSON.parse (.-data e)))))))
-      ;; off the wire we stop hearing about peers, so stop claiming to see them.
-      ;; Only the *current* socket does this — closing the previous one on a
-      ;; project switch must not wipe the new one's roster or retry into it.
-      (set! (.-onclose s) (fn [_]
-                            (when (identical? s @socket)
-                              (reset! socket nil)
-                              (rf/dispatch [:tl.events/peers-reset])
-                              (retry-later! id)))))))
 
 (defn connect-scene!
-  "Open (or replace) the websocket for project `id`, and keep it open."
+  "Open (or replace) the websocket that streams peer scene deltas for project
+   `id`. Incoming messages dispatch ::peer-delta, which merges them in."
   [id]
-  (some-> (:timer @conn) js/clearTimeout)
+  (when-let [s @socket] (.close s))
-  (when-let [s @socket] (set! (.-onclose s) nil) (.close s))
+  (when id
-  (reset! socket nil)
+    (let [l     js/window.location
-  (reset! conn {:id id :tries 0 :timer nil})
+          proto (if (= "https:" (.-protocol l)) "wss:" "ws:")
-  (when id (open! id)))
+          host  (if (= "" api-port) (.-host l) (str (.-hostname l) ":" api-port))
-
+          url   (str proto "//" host "/ws/projects/" id "/")
-(defn- send! [msg]
+          s     (js/WebSocket. url)]
-  (when-let [s @socket]
+      (reset! socket s)
-    (when (= 1 (.-readyState s))                ; OPEN — silently skip otherwise
+      (set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
-      (.send s (js/JSON.stringify (clj->js msg))))))
+      (set! (.-onmessage s)
-
+            (fn [e] (rf/dispatch [:tl.events/peer-delta (->clj (js/JSON.parse (.-data e)))]))))))
-;; our presence state (party membership + whether we let people in) — rare
-;; enough to go straight out
-(def send-state! send!)
-
-;; Nav rides every scrub and every jump, so it is throttled: leading edge for a
-;; snappy first move, trailing edge so the party lands on the final position
-;; rather than wherever the last tick happened to fall.
-(def ^:private nav-gap-ms 120)
-(defonce ^:private nav-last (atom 0))
-(defonce ^:private nav-timer (atom nil))
-(defonce ^:private nav-pending (atom nil))
-
-(defn- flush-nav! []
-  (reset! nav-timer nil)
-  (reset! nav-last (js/Date.now))
-  (when-let [m @nav-pending] (reset! nav-pending nil) (send! m)))
-
-(defn send-nav! [msg]
-  (reset! nav-pending msg)
-  (when @nav-timer (js/clearTimeout @nav-timer))
-  (let [due (max 0 (- nav-gap-ms (- (js/Date.now) @nav-last)))]
-    (if (zero? due)
-      (flush-nav!)
-      (reset! nav-timer (js/setTimeout flush-nav! due)))))

tl/src/tl/db.cljs

@@ -19,10 +19,6 @@
    :scene {:tracks {}
            :groups {:root {:type :timeline :name "root"}}}
 
-   ;; who else is viewing, and the ad-hoc party we're in (see tl.party).
-   ;; :me is our connection id, handed out by the server; the roster is gossip.
-   :peers {:me nil :roster {} :joinable true :parked nil}
-
    ;; view state
    :view  {:stack     [:root]             ; timeline-stack; top = current context
            :playheads {}                  ; per-context local playhead

tl/src/tl/events.cljs

@@ -6,7 +6,6 @@
    [tl.api :as api]
    [tl.db :as db]
    [tl.otio :as otio]
-   [tl.party :as party]
    [tl.routes :as routes]
    [tl.scene :as scene]))
 
@@ -89,49 +88,6 @@
     (assoc fx :route/replace-project-state (route-state db))
     fx))
 
-(defn- seek-fx
-  "Effect map putting the video on the current context's playhead (nothing when
-   the context resolves to no footage)."
-  [db]
-  (let [ctx  (peek (get-in db [:view :stack]))
-        segs (scene/content-segments (:scene db) ctx)
-        sf   (scene/local->source segs (scene/playhead (:view db) ctx))]
-    (when sf {:player/seek (/ sf (:fps db))})))
-
-;; --- parties: telling the others where we're looking ----------------------
-;; The roster and the party maths live in tl.party; these are the two ends of
-;; it inside the event layer — what we broadcast, and the gate on broadcasting.
-
-(defn- roster [db] (get-in db [:peers :roster] {}))
-(defn- my-cid [db] (get-in db [:peers :me]))
-
-(defn- nav-state
-  "Where we're looking, as the party sees it: which timeline we're in, where the
-   playhead sits, and whether we're rolling."
-  [db]
-  (let [stack (get-in db [:view :stack])]
-    {:kind "nav"
-     :stack (mapv name stack)
-     :playhead (scene/playhead (:view db) (peek stack))
-     :playing (boolean (get-in db [:view :playing?]))}))
-
-(defn- authoring?
-  "Is a draft open? Authoring means hunting around the timeline for marks, which
-   is nobody else's business — so while it's open we detach from the party: we
-   don't drive it (here) and it doesn't drive us (::peer-nav), and we catch up
-   with wherever it got to when the form closes (::finish-edit)."
-  [db]
-  (boolean (some :draft (vals (get-in db [:scene :groups])))))
-
-(defn- sync-view
-  "URL + party for an event that moved the view. Only deliberate moves go out:
-   playback ticks are left alone, because every member is running the same clip
-   off its own clock and a stream of positions would just fight them."
-  [fx db]
-  (cond-> (sync-route fx db)
-    (and (seq (party/peers (roster db) (my-cid db))) (not (authoring? db)))
-    (assoc :peer/nav (nav-state db))))
-
 ;; --- auth + routing -------------------------------------------------------
 
 (rf/reg-event-fx ::set-auth
@@ -175,21 +131,14 @@
 ;; the next one) doesn't flash the previous project's name/scene/thumbnails or a
 ;; stale load error while the next one loads.
 (defn- reset-project [db]
-  (merge db (select-keys db/default-db [:project :scene :fps :view :load :save-error :peers])))
+  (merge db (select-keys db/default-db [:project :scene :fps :view :load :save-error])))
 
-;; Leaving also drops the socket. It isn't just tidiness any more: an open
-;; socket keeps us in the project's roster, so peers would go on seeing us
-;; viewing something we walked away from — and its deltas would land in the
-;; next project's db while that one loads.
 (rf/reg-event-fx ::nav-list
                  (fn [{:keys [db]} _] {:db (-> (reset-project db) (assoc :page :list))
-                                       :connect-scene nil
                                        :fetch-projects true}))
 (rf/reg-event-db ::set-projects (fn [db [_ ps]] (assoc db :projects ps :projects-error nil)))
-(rf/reg-event-fx ::nav-create (fn [{:keys [db]} _]
+(rf/reg-event-db ::nav-create (fn [db _] (-> (reset-project db)
-                                {:db (-> (reset-project db)
+                                             (assoc :page :create :create-error nil))))
-                                         (assoc :page :create :create-error nil))
-                                 :connect-scene nil}))
 
 ;; loading a project is a three-hop chain: detail → OTIO file → scene, each
 ;; feeding the next, and any hop's failure lands the editor in :error.
@@ -199,7 +148,6 @@
                             (assoc :page :editor)
                             (assoc-in [:load :status] :loading)
                             (assoc-in [:view :route-state] view-state))
-                    :connect-scene nil            ; the previous project's, until ::project-ready
                     :http-xhrio (api/GET (str "/api/projects/" id "/")
                                          {:on-success [::project-detail-loaded]
                                           :on-failure [::project-load-error]})}))
@@ -242,230 +190,16 @@
 ;; A peer saved: merge their attributed groups in (and drop deletions). We keep
 ;; any group we're currently editing (flagged :draft) so a peer save can't yank
 ;; an in-progress edit out from under us — our own save is authoritative for it.
-(defn- merge-delta [db {:keys [changed deleted]}]
+(rf/reg-event-db
-  (let [restored (scene/restore-annotations changed)
-        drafts   (into #{} (keep (fn [[gid g]] (when (:draft g) gid))
-                                 (get-in db [:scene :groups])))]
-    (update-in db [:scene :groups]
-               (fn [groups]
-                 (-> (apply dissoc groups (map keyword deleted))
-                     (into (remove (fn [[gid _]] (contains? drafts gid)) restored)))))))
-
-(defn- prune-stack
-  "A peer deleted a timeline we were standing in: fall back to the nearest
-   surviving ancestor rather than rendering an empty context."
-  [db]
-  (let [stack (get-in db [:view :stack])
-        live  (vec (valid-stack (:scene db) stack))]
-    (cond-> db (not= live stack) (assoc-in [:view :stack] live))))
-
-(rf/reg-event-fx
  ::peer-delta
- (fn [{:keys [db]} [_ delta]]
+ (fn [db [_ {:keys [changed deleted]}]]
-   (let [was    (get-in db [:view :stack])
+   (let [restored (scene/restore-annotations changed)
-         db     (-> db (merge-delta delta) prune-stack)
+         drafts   (into #{} (keep (fn [[gid g]] (when (:draft g) gid))
-         parked (get-in db [:peers :parked])]
+                                  (get-in db [:scene :groups])))]
-     (cond-> {:db db}
+     (update-in db [:scene :groups]
-       (not= was (get-in db [:view :stack])) (merge (seek-fx db))
+                (fn [groups]
-       ;; a party jump we had to park (below) may be applicable now that this
+                  (-> (apply dissoc groups (map keyword deleted))
-       ;; delta has landed — the group it pointed at was probably in it.
+                      (into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
-       parked (assoc :dispatch [::peer-nav parked])))))
-
-;; --- presence: who else is viewing, and the party we're in ---------------
-;; Everything the peers know about each other arrives here as gossip; tl.party
-;; turns the roster into parties. The server only stamps identity and relays,
-;; so a party forms, drives and dissolves entirely between the browsers in it.
-
-(def ^:private joinable-key "tl/joinable")
-
-(rf/reg-fx :peer/nav   api/send-nav!)
-(rf/reg-fx :peer/state api/send-state!)
-(rf/reg-fx :peer/remember-joinable
-           (fn [on?] (.setItem js/localStorage joinable-key (if on? "1" "0"))))
-
-(defn- joinable-pref [] (not= "0" (.getItem js/localStorage joinable-key)))
-
-(defn- state-msg
-  "Our presence state. `joining` names the peer we just clicked Join on — they
-   adopt the party id if they're solo and letting people in; everyone else reads
-   it as \"the sender is the newcomer\"."
-  ([db] (state-msg db nil))
-  ([db joining]
-   {:kind "state"
-    :party (party/party-of (roster db) (my-cid db))
-    :joinable (boolean (get-in db [:peers :joinable]))
-    :joining joining}))
-
-(defn- upsert-peer [db {:keys [cid user] :as msg}]
-  (cond-> db
-    cid (update-in [:peers :roster cid] merge
-                   (cond-> {:cid cid :user (or user "guest")}
-                     (contains? msg :party)    (assoc :party (:party msg))
-                     (contains? msg :joinable) (assoc :joinable (boolean (:joinable msg)))))))
-
-;; Off the wire: everyone we could see is now a guess, so drop the roster. The
-;; party *id* we keep — it's just a name the members still carry, so coming back
-;; is a matter of saying it again rather than asking anyone's permission.
-(rf/reg-event-db
- ::peers-reset
- (fn [db _]
-   (assoc db :peers (merge (:peers db/default-db)
-                           {:dropped true
-                            :rejoin (party/party-of (roster db) (my-cid db))}))))
-
-;; The server hands us our connection id. Answer with our own state so the room
-;; learns whether we're joinable before anyone tries — and, if this is a socket
-;; coming *back*, pull the scene we missed while we were gone.
-(rf/reg-event-fx
- ::peer-welcome
- (fn [{:keys [db]} [_ msg]]
-   (let [{:keys [dropped rejoin]} (:peers db)
-         cid (:cid msg)
-         db  (-> db
-                 (assoc-in [:peers :me] cid)
-                 (assoc-in [:peers :joinable] (joinable-pref))
-                 (upsert-peer msg)
-                 (assoc-in [:peers :roster cid :party] rejoin)
-                 (update :peers merge {:dropped false :rejoin nil}))
-         id  (get-in db [:project :id])]
-     (cond-> {:db db :peer/state (state-msg db)}
-       (and dropped id)
-       (assoc :http-xhrio (api/GET (str "/api/projects/" id "/scene/")
-                                   {:on-success [::scene-resynced]
-                                    :on-failure [::ignore-error]}))))))
-
-;; Back after a drop: the socket only streams deltas, so anything saved while we
-;; were away never reached us. Merge the server's authored layer in the same way
-;; a live delta merges — drafts we're holding stay ours.
-;;
-;; Deliberately additive. "Absent from the server" can also mean "saved a
-;; moment ago and the PUT hasn't landed", and a wrong deletion costs someone
-;; their work while a stale extra group costs a reload — so a deletion missed
-;; while we were offline lingers until one.
-(rf/reg-event-db
- ::scene-resynced
- (fn [db [_ resp]]
-   (merge-delta db {:changed (get-in resp [:scene :groups] {})})))
-
-;; someone arrived: note them, and announce ourselves so their roster fills in.
-(rf/reg-event-fx
- ::peer-join
- (fn [{:keys [db]} [_ msg]]
-   (let [db (upsert-peer db msg)]
-     (cond-> {:db db}
-       (not= (my-cid db) (:cid msg)) (assoc :peer/state (state-msg db))))))
-
-(rf/reg-event-db
- ::peer-leave
- (fn [db [_ {:keys [cid]}]]
-   (update-in db [:peers :roster] dissoc cid)))
-
-(rf/reg-event-fx
- ::peer-state
- (fn [{:keys [db]} [_ {:keys [cid joining party] :as msg}]]
-   (let [me     (my-cid db)
-         db     (upsert-peer db msg)
-         ;; they clicked Join on us while we were flying solo: take on the id
-         ;; they derived from our cid. Nobody hosts — we both just carry it.
-         adopt? (and me (= me joining)
-                     (nil? (party/party-of (roster db) me))
-                     (get-in db [:peers :joinable]))
-         db     (cond-> db adopt? (assoc-in [:peers :roster me :party] party))
-         r      (roster db)
-         mine   (party/party-of r me)]
-     (cond-> {:db db}
-       adopt? (assoc :peer/state (state-msg db))
-       ;; a newcomer landed in our party and we drew the short straw: show them
-       ;; where we are, instead of parking them until somebody moves.
-       (and joining mine (= mine (party/party-of r cid))
-            (= me (party/responder r mine cid)))
-       (assoc :peer/nav (nav-state db))))))
-
-;; Changing party drops anything parked: it's a position from the party we just
-;; left, and replaying it later (on the way out of a form, say) would drag us
-;; back to people we're no longer with.
-(defn- set-party [db pid]
-  (-> db (assoc-in [:peers :roster (my-cid db) :party] pid)
-         (assoc-in [:peers :parked] nil)))
-
-(rf/reg-event-fx
- ::join
- (fn [{:keys [db]} [_ cid]]
-   (let [me (my-cid db) r (roster db)]
-     (if (party/joinable? r me cid)
-       (let [db (set-party db (party/join-id r cid))]
-         {:db db :peer/state (state-msg db cid)})
-       {:db db}))))
-
-(rf/reg-event-fx
- ::go-solo
- (fn [{:keys [db]} _]
-   (if (my-cid db)
-     (let [db (set-party db nil)]
-       {:db db :peer/state (state-msg db)})
-     {:db db})))
-
-(rf/reg-event-fx
- ::set-joinable
- (fn [{:keys [db]} [_ on?]]
-   (let [db (assoc-in db [:peers :joinable] (boolean on?))]
-     {:db db :peer/state (state-msg db) :peer/remember-joinable (boolean on?)})))
-
-;; Nav is the only message that steers another browser, and it arrives relayed
-;; from whatever a peer chose to send. Nothing downstream should have to cope
-;; with a shape it can't use — a bad frame reaching scene/assert-frame would
-;; throw inside the event loop and take the editor down with it.
-(defn- nav-stack
-  "The peer's stack as context keywords, or nil if it isn't one we could stand
-   in: it has to start at the root and name timelines all the way down."
-  [stack]
-  (let [ks (when (sequential? stack) (mapv #(when (string? %) (keyword %)) stack))]
-    (when (and (seq ks) (= :root (first ks)) (every? some? ks)) ks)))
-
-(defn- nav-frame [n]
-  (when (and (number? n) (not (neg? n)) (== n (js/Math.floor n))) n))
-
-(defn- standable? [db gid]
-  (contains? #{:timeline :annotation} (get-in db [:scene :groups gid :type])))
-
-;; A party-mate moved. We take their whole view — which timeline, where in it,
-;; rolling or not — because in a party anyone drives.
-(rf/reg-event-fx
- ::peer-nav
- (fn [{:keys [db]} [_ {:keys [cid playing] :as msg}]]
-   (let [stack    (nav-stack (:stack msg))
-         playhead (nav-frame (:playhead msg))]
-     (cond
-       (not (party/mirrors? (roster db) (my-cid db) cid))
-       ;; not (or no longer) one of ours — and if we were holding their move
-       ;; from when they were, it's stale now
-       {:db (cond-> db (= cid (get-in db [:peers :parked :cid]))
-                    (assoc-in [:peers :parked] nil))}
-
-       (not (and stack playhead)) {:db db}      ; nothing we can act on
-
-       ;; Two reasons to hold a move rather than take it, and one answer to
-       ;; both — park the latest one and replay it when the reason clears:
-       ;;   · we're authoring, so we're off on our own (::finish-edit replays)
-       ;;   · they jumped into a group we haven't been told about yet, because
-       ;;     they made it a moment ago and its scene delta is still in flight
-       ;;     (::peer-delta replays). Truncating to an ancestor instead would
-       ;;     strand us somewhere they aren't.
-       (or (authoring? db) (not (every? #(standable? db %) stack)))
-       {:db (assoc-in db [:peers :parked] msg)}
-
-       :else
-       (let [ctx       (peek stack)
-             playing?  (boolean (get-in db [:view :playing?]))
-             transport (not= (boolean playing) playing?)
-             db        (-> db
-                           (assoc-in [:peers :parked] nil)
-                           (assoc-in [:peers :echo] transport)
-                           (assoc-in [:view :stack] stack)
-                           (assoc-in [:view :playheads ctx] playhead))]
-         (cond-> (merge (sync-route {:db db} db) (seek-fx db))
-           (and transport playing)       (assoc :player/play true)
-           (and transport (not playing)) (assoc :player/pause true)))))))
 
 
 (rf/reg-event-fx
@@ -877,29 +611,14 @@
                          sf    (scene/local->source segs local)]
                      {:db db :player/seek (when sf (/ sf (:fps db)))})))
 
-;; `source` is :tick when the playback clock moved us rather than the user; the
-;; party hears about deliberate moves only (see sync-view).
 (rf/reg-event-fx ::set-playhead
-                 (fn [{:keys [db]} [_ ctx lf source]]
+                 (fn [{:keys [db]} [_ ctx lf]]
                    (let [lf      (scene/assert-frame "playhead" lf)
                          next-db (-> db
                                      (assoc-in [:view :playheads ctx] lf)
                                      (sync-draft-mark-for-playhead ctx lf))]
-                     (if (= :tick source)
+                     (sync-route {:db next-db} next-db))))
-                       (sync-route {:db next-db} next-db)
+(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
-                       (sync-view {:db next-db} next-db)))))
-;; The <video> is the source of truth here, so this fires both for our own
-;; transport and for a play the party started. Re-broadcasting the latter would
-;; bounce the starter's playhead back at them, so ::peer-nav flags the plays it
-;; asked for and we swallow exactly those.
-(rf/reg-event-fx ::set-playing
-                 (fn [{:keys [db]} [_ p]]
-                   (let [echo?   (get-in db [:peers :echo])
-                         next-db (-> db (assoc-in [:view :playing?] p)
-                                        (assoc-in [:peers :echo] false))]
-                     (if echo?
-                       {:db next-db}
-                       (sync-view {:db next-db} next-db)))))
 ;; reveal an annotation's immediate children into the current timeline lane
 (rf/reg-event-db ::toggle-children
                  (fn [db [_ gid]]
@@ -913,8 +632,11 @@
 ;; we land in, at its remembered playhead (0 = that context's start).
 (defn- enter-ctx
   [db stack-fn]
-  (let [db (update-in db [:view :stack] stack-fn)]
+  (let [db   (update-in db [:view :stack] stack-fn)
-    (sync-view (merge {:db db :player/pause true} (seek-fx db)) db)))
+        ctx  (peek (get-in db [:view :stack]))
+        segs (scene/content-segments (:scene db) ctx)
+        sf   (scene/local->source segs (scene/playhead (:view db) ctx))]
+    (sync-route {:db db :player/pause true :player/seek (when sf (/ sf (:fps db)))} db)))
 
 (rf/reg-event-fx ::expand   (fn [{:keys [db]} [_ gid]] (enter-ctx db #(conj % gid))))
 (rf/reg-event-fx ::collapse (fn [{:keys [db]} _] (enter-ctx db #(if (> (count %) 1) (pop %) %))))
@@ -963,17 +685,15 @@
 
 ;; Edit the annotation you're currently inside: drop into its parent timeline so
 ;; its marks are editable there, remembering to pop back when done. Root has no
-;; parent (and no marks) — edit it in place. The draft flag goes on *before* the
+;; parent (and no marks) — edit it in place.
-;; pop, so that pop is ours alone and doesn't drag the party up a level with us.
 (rf/reg-event-fx ::edit-here
                  (fn [{:keys [db]} [_ gid]]
                    (let [root? (= :timeline (get-in db [:scene :groups gid :type]))
-                         db    (-> db (assoc-in [:scene :groups gid :draft] :edit)
-                                      (assoc-in [:view :pt] :new)
-                                      (assoc-in [:view :edit-return] (when-not root? gid)))
                          fx    (if root? {:db db} (enter-ctx db pop))]
-                     (update fx :db #(assoc-in % [:view :edit-context]
+                     (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
-                                               (peek (get-in % [:view :stack])))))))
+                                           (assoc-in [:view :pt] :new)
+                                           (assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
+                                           (assoc-in [:view :edit-return] (when-not root? gid)))))))
 (rf/reg-event-fx ::finish-edit
                  (fn [{:keys [db]} _]
                    ;; leaving the form (save OR cancel): tear down all authoring
@@ -984,16 +704,8 @@
                                       (assoc-in [:view :pt] nil)
                                       (assoc-in [:view :draft-stage] nil)
                                       (assoc-in [:view :edit-return] nil)
-                                      (assoc-in [:view :edit-context] nil))
+                                      (assoc-in [:view :edit-context] nil))]
-                         ;; back on the party's clock: whatever it did while we
-                         ;; were heads-down is parked, and replaying it now puts
-                         ;; us exactly where the others are. It also takes
-                         ;; priority over hopping back into the annotation we
-                         ;; were editing — that hop would only broadcast a
-                         ;; position we're about to leave.
-                         parked   (get-in db [:peers :parked])]
                      (cond
-                       parked   {:db db :dispatch [::peer-nav parked]}
                        return-g (enter-ctx db #(conj % return-g))
                        :else    {:db db}))))
 (rf/reg-event-db ::draft-focus (fn [db [_ pt]]    (assoc-in db [:view :pt] pt)))

tl/src/tl/party.cljs

@@ -1,85 +0,0 @@
-(ns tl.party
-  "Ad-hoc viewing parties, derived from the presence roster.
-
-   Presence is a flat map of cid → {:cid :user :party :joinable}, gossiped over
-   the project socket (tl.api). A party is nothing but an id that its members
-   carry: nobody hosts one, you only join one. Joining someone who is flying
-   solo adopts *their cid* as the id, so two people clicking Join in the same
-   instant land in the same party, and the party outlives whoever was joined
-   first. Everyone in a party drives everyone else — a nav from any member
-   moves all the others — which is why joining someone needs their consent
-   (:joinable), and why leaving is one click.
-
-   Everything here is a pure function of the roster, so every peer computes the
-   same answer from the same gossip and the server never has to know any of it."
-  (:refer-clojure :exclude [groups]))
-
-(defn party-of [roster cid] (get-in roster [cid :party]))
-
-(defn members
-  "cids carrying party id `pid`. nil isn't a party, so it has no members."
-  [roster pid]
-  (if pid
-    (into #{} (keep (fn [[cid p]] (when (= pid (:party p)) cid))) roster)
-    #{}))
-
-(defn peers
-  "The OTHER members of `cid`'s party."
-  [roster cid]
-  (disj (members roster (party-of roster cid)) cid))
-
-(defn in-party?
-  "A party id nobody else carries isn't a party — it's a join that went
-   unanswered, or the last one standing. Either way: solo."
-  [roster cid]
-  (boolean (seq (peers roster cid))))
-
-(defn join-id
-  "The party id you take on by joining `cid`: theirs if they're in one, else
-   their own cid. Deriving it from the target rather than minting a fresh one
-   is what makes simultaneous joins converge on a single party."
-  [roster cid]
-  (or (party-of roster cid) cid))
-
-(defn joinable?
-  "May `me` join `cid`? They have to be someone else, have to be letting people
-   in, and have to not already be in the party we're in."
-  [roster me cid]
-  (boolean (and me cid (not= me cid)
-                (get-in roster [cid :joinable])
-                (let [theirs (party-of roster cid)]
-                  (or (nil? theirs) (not= theirs (party-of roster me)))))))
-
-(defn mirrors?
-  "Does `me` apply a nav broadcast from `sender`? Same party, different person."
-  [roster me sender]
-  (let [mine (party-of roster me)]
-    (boolean (and me (not= me sender) mine (= mine (party-of roster sender))))))
-
-(defn responder
-  "The one member of `pid` that answers `newcomer` with the party's current
-   position, so a join draws a single reply instead of one per member: the
-   lowest cid among the members who were already there. Deterministic, and
-   still hostless — it's recomputed from whoever is present."
-  [roster pid newcomer]
-  (first (sort (disj (members roster pid) newcomer))))
-
-(defn groups
-  "The roster laid out for the who's-viewing menu: parties first — mine, then
-   the rest largest-first — and everyone flying solo in a final {:id nil} group.
-   Members are named maps (:cid merged in), sorted by username."
-  [roster me]
-  (let [named   (fn [cid] (assoc (get roster cid) :cid cid))
-        by-user (fn [cids] (mapv named (sort-by (juxt #(str (get-in roster [% :user])) str) cids)))
-        mine    (party-of roster me)
-        parties (->> (keep :party (vals roster))
-                     distinct
-                     (keep (fn [pid]
-                             (let [m (members roster pid)]
-                               (when (> (count m) 1)
-                                 {:id pid :members (by-user m)}))))
-                     (sort-by (juxt #(not= mine (:id %)) #(- (count (:members %))) #(str (:id %))))
-                     vec)
-        solo    (by-user (remove #(in-party? roster %) (keys roster)))]
-    (cond-> parties
-      (seq solo) (conj {:id nil :members solo}))))

tl/src/tl/subs.cljs

@@ -2,7 +2,6 @@
   (:require [clojure.string :as str]
             [re-frame.core :as rf]
             [tl.filter :as filter]
-            [tl.party :as party]
             [tl.scene :as scene]))
 
 (rf/reg-sub ::status  (fn [db] (get-in db [:load :status])))
@@ -54,46 +53,6 @@
 
 (rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack)))
 
-;; --- presence / parties ---------------------------------------------------
-
-(rf/reg-sub ::my-cid   (fn [db] (get-in db [:peers :me])))
-(rf/reg-sub ::roster   (fn [db] (get-in db [:peers :roster] {})))
-(rf/reg-sub ::joinable (fn [db] (boolean (get-in db [:peers :joinable]))))
-
-;; everyone on the socket, me first, for the avatar cluster — each flagged with
-;; whether they're in the party I'm in.
-(rf/reg-sub
- ::peers
- :<- [::roster] :<- [::my-cid]
- (fn [[r me] _]
-   (let [mates (party/peers r me)]
-     (->> (vals r)
-          (sort-by (juxt #(not= me (:cid %)) #(str (:user %)) :cid))
-          (mapv #(assoc % :you? (= me (:cid %)) :mate? (contains? mates (:cid %))))))))
-
-(rf/reg-sub ::in-party? :<- [::roster] :<- [::my-cid]
-            (fn [[r me] _] (party/in-party? r me)))
-
-;; authoring detaches us from the party until the form closes (see ::finish-edit)
-(rf/reg-sub ::detached? :<- [::in-party?] :<- [::draft-group]
-            (fn [[in? draft] _] (boolean (and in? draft))))
-
-;; the who's-viewing menu: parties (mine first) then everyone flying solo, with
-;; each row told whether I'm allowed to join it.
-(rf/reg-sub
- ::peer-groups
- :<- [::roster] :<- [::my-cid]
- (fn [[r me] _]
-   (let [mine (party/party-of r me)]
-     (mapv (fn [g]
-             (-> g
-                 (assoc :mine? (and (:id g) (= (:id g) mine)))
-                 (update :members
-                         (fn [ms] (mapv #(assoc % :you? (= me (:cid %))
-                                                  :join? (party/joinable? r me (:cid %)))
-                                        ms)))))
-           (party/groups r me)))))
-
 ;; Any non-draft annotation can receive marks from the current context.
 (rf/reg-sub
  ::associate-targets
@@ -305,16 +264,12 @@
 (defn- binding-bars [scene ctx segs annotations bound]
   (vec
    (mapcat (fn [gid]
-             (let [g (get-in scene [:groups gid])
+             (let [g (get-in scene [:groups gid])]
-                   segments (scene/resolve scene gid)
-                   bars #(if (= gid ctx)
-                           (scene/merge-bars (map :local %))
-                           (scene/project-bars % segs))]
                (concat
                 (when (seq (bound g))
-                  [{:gids (bound g) :bars (bars segments)}])
+                  [{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}])
                 (for [m (:marks g) :when (seq (bound m))]
-                  {:gids (bound m) :bars (bars (filter #(= (:id m) (:mark %)) segments))}))))
+                  {:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)}))))
            (conj (set (map :id annotations)) ctx))))
 
 (rf/reg-sub ::drawing-bars

tl/src/tl/views.cljs

@@ -152,10 +152,10 @@
                                   discontinuity? (assoc :pending-ns ns))))
                   (when discontinuity?
                     (seek-video! fps ns))
-                  (rf/dispatch [::events/set-playhead ctx nl :tick]))
+                  (rf/dispatch [::events/set-playhead ctx nl]))
-              (do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss)) :tick]) ; snap to the very end
+              (do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss))])  ; snap to the very end
                   (.pause v)))                                   ; end → pause event disengages
-            (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss)) :tick])))))
+            (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))))
     (when @play (reset! raf (js/requestAnimationFrame play-tick)))))
 
 (defn- engage-play!
@@ -188,15 +188,6 @@
 
 ;; effects the stack events use to keep the player on the current context
 (rf/reg-fx :player/pause (fn [_]    (when-let [v @video-el] (.pause v))))
-;; A party-mate started playback. .play() can be refused (autoplay policy, if
-;; this tab has had no interaction yet) — say so rather than leaving an
-;; unhandled rejection, because ::set-playing is also what clears the flag that
-;; stops us echoing a mirrored play back at them.
-(rf/reg-fx :player/play  (fn [_] (when-let [v @video-el]
-                                   (when (.-paused v)
-                                     (some-> (.play v)
-                                             (.catch (fn [_]
-                                                       (rf/dispatch [::events/set-playing false]))))))))
 (rf/reg-fx :player/seek  (fn [secs] (when (and @video-el secs) (set! (.-currentTime @video-el) secs))))
 
 (defn- ann-scroll-to?
@@ -1214,13 +1205,13 @@
                       (when (has-type? e "text/ann")
                         (.stopPropagation e) (.preventDefault e) (reset! over? true)))
      :on-drag-leave (fn [_] (reset! over? false))
-     ;; plain drop MOVES the edge you grabbed onto this card; SHIFT-drop LINKS
+     ;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
-     ;; (adds this edge, keeping the source one) — Blender's M / ⇧M.
+     ;; (links, keeping the source edge).
      :on-drop       (fn [e]
                       (let [src (.. e -dataTransfer (getData "text/ann"))]
                         (when (seq src)
                           (.stopPropagation e) (.preventDefault e) (reset! over? false)
-                          (rf/dispatch [::events/reparent (keyword src) (:id a) (.-shiftKey e)]))))}))
+                          (rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))}))
 
 (defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen]
   (r/with-let [over? (r/atom false) hov? (r/atom false)]
@@ -2101,72 +2092,6 @@
              [:button {:on-click #(grab (routes/project-url id [:root] nil) :project)}
               (if (= @copied :project) "✓ Link copied" "Copy link to the whole project")]]])]))))
 
-;; --- who's viewing: presence + ad-hoc parties -----------------------------
-;; The cluster of faces is the Google-Docs part; the menu behind it is where a
-;; party is joined or left. Nobody hosts a party — see tl.party — so every row
-;; offers the same thing: Join, or (for the one you're in) Leave.
-
-(defn- avatar [{:keys [user you? mate?]}]
-  [:span.avatar {:class (str (when mate? "mate ") (when you? "you"))
-                 :style {:background (str "hsl(" (mod (hash (or user "guest")) 360)
-                                          " 58% 58%)")}
-                 :title (str user (when you? " (you)"))}
-   (str/upper-case (subs (if (seq user) user "?") 0 1))])
-
-(defn- peer-group-row [{:keys [id mine? members]}]
-  [:div.peer-group {:class (when mine? "mine")}
-   [:div.peer-group-head
-    [:span (cond mine?     (str "Your party · " (count members))
-                 (nil? id) "Not in a party"
-                 :else     (str "Party · " (count members)))]
-    (cond
-      mine? [:button.link-btn {:on-click #(rf/dispatch [::events/go-solo])} "Leave"]
-      id    (when-let [door (some #(when (:join? %) (:cid %)) members)]
-              [:button.link-btn {:on-click #(rf/dispatch [::events/join door])} "Join"]))]
-   (for [p members]
-     ^{:key (:cid p)}
-     [:div.peer-row
-      [avatar p]
-      [:span.peer-name (:user p) (when (:you? p) [:span.peer-you " (you)"])]
-      (cond
-        (:you? p)  nil
-        (:join? p) [:button.link-btn {:on-click #(rf/dispatch [::events/join (:cid p)])} "Join"]
-        ;; only once we've actually heard them say so — an absent flag just
-        ;; means their state hasn't come round yet
-        (false? (:joinable p)) [:span.peer-closed "not joinable"])])])
-
-(defn presence []
-  (let [open? (r/atom false)]
-    (fn []
-      (let [peers    @(rf/subscribe [::subs/peers])
-            in?      @(rf/subscribe [::subs/in-party?])
-            off?     @(rf/subscribe [::subs/detached?])
-            joinable @(rf/subscribe [::subs/joinable])
-            extra    (max 0 (- (count peers) 4))]
-        (when (seq peers)
-          [:div.menu-wrap.presence {:class (str (when in? "in-party ") (when off? "detached"))}
-           [:button.avatars {:on-click #(swap! open? not)
-                             :title (cond off? "Editing on your own — you'll catch up with the party when you're done"
-                                          in?  "You're in a party"
-                                          :else "Who's viewing")}
-            (when in? [:span.party-tag (if off? "editing" "party")])
-            (for [p (take 4 peers)] ^{:key (:cid p)} [avatar p])
-            (when (pos? extra) [:span.avatar.more (str "+" extra)])]
-           (when in?
-             [:button.bar-btn.solo-btn {:on-click #(rf/dispatch [::events/go-solo])
-                                        :title "Watch on your own again"} "Leave"])
-           (when @open?
-             [:<>
-              [:div.menu-backdrop {:on-click #(reset! open? false)}]
-              [:div.menu-pop.peer-pop
-               (for [g @(rf/subscribe [::subs/peer-groups])]
-                 ^{:key (str (:id g))} [peer-group-row g])
-               [:label.peer-setting
-                [:input {:type "checkbox" :checked joinable
-                         :on-change #(rf/dispatch [::events/set-joinable
-                                                   (.. % -target -checked)])}]
-                "Let others join me"]]])])))))
-
 (defn user-menu []
   (let [open? (r/atom false)]
     (fn []
@@ -2196,7 +2121,6 @@
       [:span.title-name (or (:name proj)
                             (when (= :loading @(rf/subscribe [::subs/status])) "Loading…"))]]
      [:div.titlebar-right
-      [presence]
       [share-menu]
       (when authed? [user-menu])]]))
 

tl/test/tl/flow_test.cljs

@@ -8,17 +8,10 @@
             [tl.scene :as s]
             [tl.scene-test :as fixture]))
 
-(doseq [k [:player/pause :player/play :player/seek :http-xhrio :route
+(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
-           :route/replace-project-state :connect-scene :fetch-projects
+           :connect-scene :fetch-projects :poll-thumbnails :upload-project]]
-           :poll-thumbnails :upload-project :peer/remember-joinable]]
   (rf/reg-fx k (fn [_] nil)))
 
-;; presence effects are the wire; capture instead of stubbing so the tests can
-;; assert on what the party would actually hear.
-(defonce sent (atom []))
-(rf/reg-fx :peer/nav   (fn [m] (swap! sent conj [:nav m])))
-(rf/reg-fx :peer/state (fn [m] (swap! sent conj [:state m])))
-
 (defn seed []
   (let [sc (-> fixture/base
                (fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100))
@@ -28,16 +21,6 @@
 (defn setup! [scene stack]
   (reset! rdb/app-db {:scene scene :fps 24 :project {:id nil}
                       :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}}))
-(defn peers!
-  "Put us on the socket as `me`, in a party with `mates` when there are any."
-  [me mates]
-  (reset! sent [])
-  (swap! rdb/app-db assoc :project {:id 7}
-         :peers {:me me :joinable true
-                 :roster (into {me {:cid me :user me :party (when (seq mates) "p")}}
-                               (map (fn [c] [c {:cid c :user c :party "p" :joinable true}]))
-                               mates)}))
-
 (defn scene* [] (:scene @rdb/app-db))
 (defn group [gid] (get-in (scene*) [:groups gid]))
 (defn pane-ids [] (set (map :id @(rf/subscribe [::subs/all-annotations]))))
@@ -174,28 +157,6 @@
    (is (= [:d] (mapv :id @(rf/subscribe [::subs/active-drawings]))))
    (is (= #{:n} @(rf/subscribe [::subs/active-note-set])))))
 
-(deftest repeated-marks-bind-to-own-occurrences-but-project-in-other-contexts
-  (rf-test/run-test-sync
-   (let [marks (mapv (fn [i [a b]]
-                       (assoc (fixture/mark i (fixture/part :a a b))
-                              :drawings [i] :notes [i]))
-                     [:d1 :d2 :d3 :d4] [[12 72] [51 96] [22 77] [22 90]])
-         sc (reduce #(assoc-in %1 [:groups %2] {:type :drawing :strokes []})
-                    (apply fixture/annotation fixture/base :repeat [:root] marks)
-                    [:d1 :d2 :d3 :d4])]
-     (setup! sc [:root :repeat])
-     (doseq [[frame expected] [[0 #{:d1}] [55 #{:d1}] [59 #{:d1}]
-                               [60 #{:d2}] [104 #{:d2}] [105 #{:d3}]
-                               [159 #{:d3}] [160 #{:d4}] [227 #{:d4}] [228 #{}]]]
-       (rf/dispatch [::ev/set-playhead :repeat frame])
-       (is (= expected (set (map :id @(rf/subscribe [::subs/active-drawings])))))
-       (is (= expected @(rf/subscribe [::subs/active-note-set]))))
-     (setup! sc [:root])
-     (rf/dispatch [::ev/set-playhead :root 67])
-     (is (= #{:d1 :d2 :d3 :d4}
-            (set (map :id @(rf/subscribe [::subs/active-drawings])))))
-     (is (= #{:d1 :d2 :d3 :d4} @(rf/subscribe [::subs/active-note-set]))))))
-
 (deftest nested-repeat-projection-is-shared-by-editor-and-lane
   (rf-test/run-test-sync
    (setup! fixture/base [:root])
@@ -267,153 +228,3 @@
    (rf/dispatch [::ev/reparent :x :b1])
    (is (= #{:b1} (s/membership (scene*) :x)))
    (is (not (contains? (pane-ids) :x)))))
-
-;; --- presence / ad-hoc parties -------------------------------------------
-
-(deftest a-party-mates-jump-takes-us-with-them
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "a1"] :playhead 5 :playing false}])
-   (is (= [:root :a1] @(rf/subscribe [::subs/stack])))
-   (is (= 5 @(rf/subscribe [::subs/playhead])))
-   (testing "someone outside the party doesn't move us"
-     (rf/dispatch [::ev/peer-nav {:cid "stranger" :stack ["root"] :playhead 0 :playing false}])
-     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))
-   (testing "and neither does our own broadcast coming back"
-     (rf/dispatch [::ev/peer-nav {:cid "me" :stack ["root"] :playhead 0 :playing false}])
-     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))))
-
-(deftest a-jump-into-an-annotation-we-have-not-been-told-about-waits-for-it
-  ;; the save that created it is a PUT and the jump rides the socket, so the two
-  ;; can land out of order. Park the jump rather than stranding us at the root.
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "fresh"] :playhead 0 :playing false}])
-   (is (= [:root] @(rf/subscribe [::subs/stack])))
-   (rf/dispatch [::ev/peer-delta {:changed {:fresh {:type "annotation" :in ["root"]
-                                                    :name "fresh" :marks []}}}])
-   (is (= [:root :fresh] @(rf/subscribe [::subs/stack])))
-   (is (nil? (get-in @rdb/app-db [:peers :parked])))))
-
-(deftest a-peer-deleting-the-timeline-we-are-standing-in-pops-us-out
-  (rf-test/run-test-sync
-   (setup! (seed) [:root :a1])
-   (peers! "me" [])
-   (rf/dispatch [::ev/peer-delta {:deleted ["a1"]}])
-   (is (= [:root] @(rf/subscribe [::subs/stack])))))
-
-(deftest being-joined-adopts-the-party-and-answers-with-where-we-are
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" [])
-   (rf/dispatch [::ev/peer-state {:cid "you" :user "you" :party "me"
-                                  :joinable true :joining "me"}])
-   (is (= "me" (get-in @rdb/app-db [:peers :roster "me" :party])))
-   (is (= #{:state :nav} (set (map first @sent))))
-   (testing "with the door shut, a join doesn't pull us in"
-     (peers! "solo" [])
-     (swap! rdb/app-db assoc-in [:peers :joinable] false)
-     (rf/dispatch [::ev/peer-state {:cid "you" :user "you" :party "solo"
-                                    :joinable true :joining "solo"}])
-     (is (nil? (get-in @rdb/app-db [:peers :roster "solo" :party]))))))
-
-(deftest only-deliberate-moves-reach-the-party
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/set-playhead :root 10 :tick])   ; the playback clock ticking
-   (is (= [] @sent))
-   (rf/dispatch [::ev/set-playhead :root 20])         ; a scrub
-   (rf/dispatch [::ev/expand :a1])
-   (is (= [["root"] ["root" "a1"]] (map (comp :stack second) @sent)))
-   (testing "and a party of one says nothing at all"
-     (peers! "me" [])
-     (rf/dispatch [::ev/set-playhead :root 30])
-     (is (= [] @sent)))))
-
-(deftest a-mirrored-play-is-not-echoed-back-at-the-peer-who-started-it
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root"] :playhead 0 :playing true}])
-   (reset! sent [])
-   (rf/dispatch [::ev/set-playing true])              ; our <video> reporting the play
-   (is (= [] @sent))
-   (testing "our own next transport change still goes out"
-     (rf/dispatch [::ev/set-playing false])
-     (is (= [:nav] (map first @sent))))))
-
-(deftest authoring-detaches-from-the-party-and-catches-up-on-the-way-out
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/edit-annotation :a1])          ; hunting for marks
-   (reset! sent [])
-   (testing "our mark-hunting is our own business"
-     (rf/dispatch [::ev/set-playhead :root 40])
-     (rf/dispatch [::ev/expand :b1])
-     (is (= [] @sent)))
-   (testing "and the party can't drag us off the form"
-     (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root"] :playhead 120 :playing false}])
-     (is (= [:root :b1] @(rf/subscribe [::subs/stack])))
-     (is (some? (get-in @rdb/app-db [:peers :parked]))))
-   (testing "closing the form puts us exactly where the party got to"
-     (rf/dispatch [::ev/save-group :a1 (group :a1) (group :a1)])
-     (rf/dispatch [::ev/finish-edit])
-     (is (= [:root] @(rf/subscribe [::subs/stack])))
-     (is (= 120 @(rf/subscribe [::subs/playhead])))
-     (is (nil? (get-in @rdb/app-db [:peers :parked]))))))
-
-(deftest opening-an-annotation-to-edit-it-does-not-pull-the-party-up-a-level
-  (rf-test/run-test-sync
-   (setup! (seed) [:root :a1])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/edit-here :a1])                ; pops to :root to expose marks
-   (is (= [:root] @(rf/subscribe [::subs/stack])))
-   (is (= [] @sent))))
-
-(deftest a-malformed-nav-is-ignored-not-obeyed-and-never-throws
-  ;; nav is the only message that steers another browser, and it arrives
-  ;; relayed from whatever a peer chose to send
-  (rf-test/run-test-sync
-   (setup! (seed) [:root :a1])
-   (peers! "me" ["you"])
-   (doseq [bad [{:stack ["root" "a1"] :playhead 10.5}       ; not a frame
-                {:stack ["root" "a1"] :playhead -4}
-                {:stack ["root" "a1"] :playhead nil}
-                {:stack ["a1"] :playhead 0}                 ; doesn't start at the root
-                {:stack [] :playhead 0}
-                {:stack nil :playhead 0}
-                {:stack ["root" 7] :playhead 0}]]
-     (rf/dispatch [::ev/peer-nav (assoc bad :cid "you" :playing false)])
-     (is (= [:root :a1] @(rf/subscribe [::subs/stack])) (pr-str bad))
-     (is (nil? (get-in @rdb/app-db [:peers :parked])) (pr-str bad)))
-   (testing "and a context we could never stand in is held, not entered"
-     ;; :a is a clip — it exists, so it is not a not-yet-synced group
-     (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "a"] :playhead 0 :playing false}])
-     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))))
-
-(deftest leaving-the-party-drops-a-move-we-were-holding
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/edit-annotation :a1])              ; detached: their move parks
-   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "b1"] :playhead 3 :playing false}])
-   (is (some? (get-in @rdb/app-db [:peers :parked])))
-   (rf/dispatch [::ev/go-solo])                          ; …but then we leave
-   (is (nil? (get-in @rdb/app-db [:peers :parked])))
-   (rf/dispatch [::ev/save-group :a1 (group :a1) (group :a1)])
-   (rf/dispatch [::ev/finish-edit])
-   (is (= [:root] @(rf/subscribe [::subs/stack])) "not dragged back to people we left")))
-
-(deftest a-held-move-from-someone-who-left-the-party-is-dropped-on-replay
-  (rf-test/run-test-sync
-   (setup! (seed) [:root])
-   (peers! "me" ["you"])
-   (rf/dispatch [::ev/edit-annotation :a1])
-   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "b1"] :playhead 3 :playing false}])
-   (swap! rdb/app-db assoc-in [:peers :roster "you" :party] nil)   ; they went solo
-   (rf/dispatch [::ev/peer-delta {}])                              ; triggers the replay
-   (is (nil? (get-in @rdb/app-db [:peers :parked])))))

tl/test/tl/party_test.cljs

@@ -1,61 +0,0 @@
-(ns tl.party-test
-  (:require [cljs.test :refer-macros [deftest is testing]]
-            [tl.party :as party]))
-
-(defn- roster [& entries]
-  (into {} (map (fn [[cid user p joinable]]
-                  [cid {:cid cid :user user :party p :joinable (not (false? joinable))}]))
-        entries))
-
-(def ^:private solo (roster ["a" "ann" nil] ["b" "bo" nil] ["c" "cy" nil]))
-
-(deftest joining-a-solo-peer-takes-their-cid-as-the-party-id
-  ;; deterministic, so two people clicking Join at once converge instead of
-  ;; minting two parties that each end up with one member
-  (is (= "a" (party/join-id solo "a")))
-  (is (= "a" (party/join-id (assoc-in solo ["b" :party] "a") "b"))))
-
-(deftest a-party-id-nobody-else-carries-is-not-a-party
-  (let [r (assoc-in solo ["b" :party] "a")]          ; b joined a; a hasn't answered
-    (is (not (party/in-party? r "b")))
-    (is (empty? (party/peers r "b")))))
-
-(deftest members-drive-each-other-and-nobody-else
-  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a"))]
-    (is (party/in-party? r "a"))
-    (is (= #{"b"} (party/peers r "a")))
-    (is (party/mirrors? r "a" "b"))
-    (is (party/mirrors? r "b" "a"))
-    (is (not (party/mirrors? r "a" "a")))            ; never our own broadcast
-    (is (not (party/mirrors? r "c" "a")))            ; outsider stays put
-    (is (not (party/mirrors? r "a" "c")))))
-
-(deftest joining-needs-consent-and-is-not-offered-twice
-  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
-              (assoc-in ["c" :joinable] false))]
-    (is (party/joinable? r "c" "a"))                 ; c may join a's party
-    (is (not (party/joinable? r "a" "c")))           ; c is not letting people in
-    (is (not (party/joinable? r "a" "b")))           ; already in it together
-    (is (not (party/joinable? r "a" "a")))))         ; not ourselves
-
-(deftest one-member-answers-a-newcomer-and-it-is-never-the-newcomer
-  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
-              (assoc-in ["c" :party] "a"))]
-    (is (= "a" (party/responder r "a" "c")))
-    (is (= "a" (party/responder r "a" "b")))
-    ;; the peer that was joined answers, even though the joiner minted the id
-    (is (= "b" (party/responder (-> solo (assoc-in ["a" :party] "b")
-                                         (assoc-in ["b" :party] "b"))
-                                "b" "a")))))
-
-(deftest menu-groups-my-party-first-then-parties-then-everyone-solo
-  (let [r (-> (roster ["a" "ann" nil] ["b" "bo" nil] ["c" "cy" nil]
-                      ["d" "di" nil] ["e" "ed" nil])
-              (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
-              (assoc-in ["d" :party] "d") (assoc-in ["e" :party] "d"))
-        gs (party/groups r "d")]
-    (is (= ["d" "a" nil] (mapv :id gs)))
-    (is (= [["di" "ed"] ["ann" "bo"] ["cy"]]
-           (mapv #(mapv :user (:members %)) gs)))
-    (testing "an unanswered join shows its author as solo, not as a party"
-      (is (= [nil] (mapv :id (party/groups (assoc-in solo ["b" :party] "a") "b")))))))