feat: who's viewing, and ad-hoc parties that watch together
The project socket already carried scene deltas; it now also carries presence.
The top bar grows a Google-Docs-style cluster of faces, and the menu behind it
groups the room into parties, then everyone flying solo, with a Join on each.
A party has no host — you only join one. Joining someone solo adopts *their
cid* as the party id, so two people clicking Join in the same instant converge
instead of minting two parties of one, and the party outlives whoever was
joined first. Everyone in it drives everyone else: a jump, a scrub or a play
from any member moves all the others. That's why being joined needs consent
("Let others join me", on by default, remembered) and why Leave is one click.
Ordering was the thing to get right. A save is a PUT and a jump rides the
socket, so "create an annotation, then jump into it" can arrive at a peer in
the wrong order. Rather than truncate the stack and strand them at the root, a
nav naming a group we haven't been told about is parked and replayed the
moment the delta lands. Authoring parks it for the same reason: a draft
detaches you from the party so hunting for marks is nobody else's business,
and closing the form replays the park, putting you exactly where the party got
to. Deleting a timeline someone is standing in now pops them out too.
Playback ticks stay off the wire — every member runs the same clip off its own
clock, so streaming positions would only fight them. Only deliberate moves and
transport changes go out, and a play we started because a peer did isn't
echoed back at them.
The socket now reconnects with backoff and, on the way back, re-states the
party id it was carrying and pulls the scene it missed. That catch-up is
deliberately additive: "absent from the server" can also mean "saved a moment
ago", and a wrong deletion costs someone their work.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name
parent
12ab7c4fca
commit
60c4096d2f
11 changed files with 898 additions and 52 deletions
|
|
@ -1,22 +1,60 @@
|
|||
import json
|
||||
import uuid
|
||||
|
||||
from channels.generic.websocket import AsyncWebsocketConsumer
|
||||
|
||||
|
||||
class SceneConsumer(AsyncWebsocketConsumer):
|
||||
"""One connection per open project. Joins the project's group and relays
|
||||
scene deltas the server broadcasts (see scenes.views.scene). Read-only:
|
||||
edits still go through the PUT endpoint, which is the broadcast source."""
|
||||
"""One connection per open project. Two things ride it.
|
||||
|
||||
Scene deltas: relayed from what the server broadcasts on a save (see
|
||||
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.group = f'project_{self.pk}'
|
||||
self.pk = self.scope["url_route"]["kwargs"]["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):
|
||||
await self.channel_layer.group_discard(self.group, self.channel_name)
|
||||
if hasattr(self, "cid"):
|
||||
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"]))
|
||||
|
|
|
|||
|
|
@ -1,9 +1,12 @@
|
|||
import json
|
||||
|
||||
from channels.testing import WebsocketCommunicator
|
||||
from django.contrib.auth import get_user_model
|
||||
from django.test import Client, TestCase
|
||||
from django.contrib.auth.models import AnonymousUser
|
||||
from django.test import Client, TestCase, TransactionTestCase
|
||||
|
||||
from scenes.models import Project, Revision
|
||||
from server.asgi import application
|
||||
|
||||
User = get_user_model()
|
||||
|
||||
|
|
@ -103,3 +106,58 @@ 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()
|
||||
|
|
|
|||
|
|
@ -658,6 +658,48 @@ 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); }
|
||||
|
|
|
|||
|
|
@ -70,25 +70,96 @@
|
|||
nil)
|
||||
fallback))
|
||||
|
||||
;; --- realtime: live peer deltas over a websocket --------------------------
|
||||
;; Not a fetch, so it can't ride :http-xhrio; it dispatches ::peer-delta itself.
|
||||
;; --- realtime: the project socket ----------------------------------------
|
||||
;; Two things ride it: scene deltas the server broadcasts after a PUT (the
|
||||
;; 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 that streams peer scene deltas for project
|
||||
`id`. Incoming messages dispatch ::peer-delta, which merges them in."
|
||||
"Open (or replace) the websocket for project `id`, and keep it open."
|
||||
[id]
|
||||
(when-let [s @socket] (.close s))
|
||||
(when id
|
||||
(let [l js/window.location
|
||||
proto (if (= "https:" (.-protocol l)) "wss:" "ws:")
|
||||
host (if (= "" api-port) (.-host l) (str (.-hostname l) ":" api-port))
|
||||
url (str proto "//" host "/ws/projects/" id "/")
|
||||
s (js/WebSocket. url)]
|
||||
(reset! socket s)
|
||||
(set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
|
||||
(set! (.-onmessage s)
|
||||
(fn [e] (rf/dispatch [:tl.events/peer-delta (->clj (js/JSON.parse (.-data e)))]))))))
|
||||
(some-> (:timer @conn) js/clearTimeout)
|
||||
(when-let [s @socket] (set! (.-onclose s) nil) (.close s))
|
||||
(reset! socket nil)
|
||||
(reset! conn {:id id :tries 0 :timer nil})
|
||||
(when id (open! id)))
|
||||
|
||||
(defn- send! [msg]
|
||||
(when-let [s @socket]
|
||||
(when (= 1 (.-readyState s)) ; OPEN — silently skip otherwise
|
||||
(.send s (js/JSON.stringify (clj->js msg))))))
|
||||
|
||||
;; 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)))))
|
||||
|
|
|
|||
|
|
@ -19,6 +19,10 @@
|
|||
: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
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
[tl.api :as api]
|
||||
[tl.db :as db]
|
||||
[tl.otio :as otio]
|
||||
[tl.party :as party]
|
||||
[tl.routes :as routes]
|
||||
[tl.scene :as scene]))
|
||||
|
||||
|
|
@ -88,6 +89,49 @@
|
|||
(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
|
||||
|
|
@ -131,7 +175,7 @@
|
|||
;; 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])))
|
||||
(merge db (select-keys db/default-db [:project :scene :fps :view :load :save-error :peers])))
|
||||
|
||||
(rf/reg-event-fx ::nav-list
|
||||
(fn [{:keys [db]} _] {:db (-> (reset-project db) (assoc :page :list))
|
||||
|
|
@ -190,16 +234,201 @@
|
|||
;; 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.
|
||||
(rf/reg-event-db
|
||||
(defn- merge-delta [db {:keys [changed deleted]}]
|
||||
(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 [db [_ {:keys [changed deleted]}]]
|
||||
(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))))))))
|
||||
(fn [{:keys [db]} [_ delta]]
|
||||
(let [was (get-in db [:view :stack])
|
||||
db (-> db (merge-delta delta) prune-stack)
|
||||
parked (get-in db [:peers :parked])]
|
||||
(cond-> {:db db}
|
||||
(not= was (get-in db [:view :stack])) (merge (seek-fx db))
|
||||
;; a party jump we had to park (below) may be applicable now that this
|
||||
;; delta has landed — the group it pointed at was probably in it.
|
||||
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))))))
|
||||
|
||||
(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 (assoc-in db [:peers :roster me :party] (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-let [me (my-cid db)]
|
||||
(let [db (assoc-in db [:peers :roster me :party] 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?)})))
|
||||
|
||||
;; 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 stack playhead playing] :as msg}]]
|
||||
(let [stack (mapv keyword stack)]
|
||||
(cond
|
||||
(not (party/mirrors? (roster db) (my-cid db) cid)) {:db db}
|
||||
|
||||
;; 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 (and (seq stack) (every? #(get-in db [:scene :groups %]) 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]
|
||||
(scene/assert-frame "peer playhead" 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
|
||||
|
|
@ -611,14 +840,29 @@
|
|||
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]]
|
||||
(fn [{:keys [db]} [_ ctx lf source]]
|
||||
(let [lf (scene/assert-frame "playhead" lf)
|
||||
next-db (-> db
|
||||
(assoc-in [:view :playheads ctx] lf)
|
||||
(sync-draft-mark-for-playhead ctx lf))]
|
||||
(sync-route {:db next-db} next-db))))
|
||||
(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
|
||||
(if (= :tick source)
|
||||
(sync-route {:db next-db} next-db)
|
||||
(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]]
|
||||
|
|
@ -632,11 +876,8 @@
|
|||
;; 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)
|
||||
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)))
|
||||
(let [db (update-in db [:view :stack] stack-fn)]
|
||||
(sync-view (merge {:db db :player/pause true} (seek-fx 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 %) %))))
|
||||
|
|
@ -685,15 +926,17 @@
|
|||
|
||||
;; 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.
|
||||
;; parent (and no marks) — edit it in place. The draft flag goes on *before* the
|
||||
;; 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 [:scene :groups gid :draft] :edit)
|
||||
(assoc-in [:view :pt] :new)
|
||||
(assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
|
||||
(assoc-in [:view :edit-return] (when-not root? gid)))))))
|
||||
(update fx :db #(assoc-in % [:view :edit-context]
|
||||
(peek (get-in % [:view :stack])))))))
|
||||
(rf/reg-event-fx ::finish-edit
|
||||
(fn [{:keys [db]} _]
|
||||
;; leaving the form (save OR cancel): tear down all authoring
|
||||
|
|
@ -704,8 +947,16 @@
|
|||
(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)))
|
||||
|
|
|
|||
85
tl/src/tl/party.cljs
Normal file
85
tl/src/tl/party.cljs
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
(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}))))
|
||||
|
|
@ -2,6 +2,7 @@
|
|||
(: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])))
|
||||
|
|
@ -53,6 +54,46 @@
|
|||
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -152,10 +152,10 @@
|
|||
discontinuity? (assoc :pending-ns ns))))
|
||||
(when discontinuity?
|
||||
(seek-video! fps ns))
|
||||
(rf/dispatch [::events/set-playhead ctx nl]))
|
||||
(do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss))]) ; snap to the very end
|
||||
(rf/dispatch [::events/set-playhead ctx nl :tick]))
|
||||
(do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss)) :tick]) ; snap to the very end
|
||||
(.pause v))) ; end → pause event disengages
|
||||
(rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))))
|
||||
(rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss)) :tick])))))
|
||||
(when @play (reset! raf (js/requestAnimationFrame play-tick)))))
|
||||
|
||||
(defn- engage-play!
|
||||
|
|
@ -188,6 +188,11 @@
|
|||
|
||||
;; 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) —
|
||||
;; swallow it rather than leaving an unhandled rejection; we stay paused.
|
||||
(rf/reg-fx :player/play (fn [_] (when-let [v @video-el]
|
||||
(when (.-paused v)
|
||||
(some-> (.play v) (.catch (fn [_] nil)))))))
|
||||
(rf/reg-fx :player/seek (fn [secs] (when (and @video-el secs) (set! (.-currentTime @video-el) secs))))
|
||||
|
||||
(defn- ann-scroll-to?
|
||||
|
|
@ -2092,6 +2097,72 @@
|
|||
[: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 []
|
||||
|
|
@ -2121,6 +2192,7 @@
|
|||
[:span.title-name (or (:name proj)
|
||||
(when (= :loading @(rf/subscribe [::subs/status])) "Loading…"))]]
|
||||
[:div.titlebar-right
|
||||
[presence]
|
||||
[share-menu]
|
||||
(when authed? [user-menu])]]))
|
||||
|
||||
|
|
|
|||
|
|
@ -8,10 +8,17 @@
|
|||
[tl.scene :as s]
|
||||
[tl.scene-test :as fixture]))
|
||||
|
||||
(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
|
||||
:connect-scene :fetch-projects :poll-thumbnails :upload-project]]
|
||||
(doseq [k [:player/pause :player/play :player/seek :http-xhrio :route
|
||||
:route/replace-project-state :connect-scene :fetch-projects
|
||||
: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))
|
||||
|
|
@ -21,6 +28,16 @@
|
|||
(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]))))
|
||||
|
|
@ -250,3 +267,109 @@
|
|||
(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))))
|
||||
|
|
|
|||
61
tl/test/tl/party_test.cljs
Normal file
61
tl/test/tl/party_test.cljs
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
(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")))))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue