1 files changed, 72 insertions, 17 deletions

diff --git a/src/SomhairlesDream.Frontend/App.fs b/src/SomhairlesDream.Frontend/App.fs
index 64fb61f..6e07798 100644
--- a/src/SomhairlesDream.Frontend/App.fs
+++ b/src/SomhairlesDream.Frontend/App.fs
@@ -37,6 +37,15 @@ type ViewState =
       Group: ThreeNode
       Canvas: HTMLCanvasElement }
 
+type LoadOwner =
+    { ProjectId: string
+      RunId: string
+      Path: string }
+
+type ViewMode =
+    | FrameMode
+    | StepMode
+
 let frames = Replay.frames ()
 let mutable viewState: ViewState option = None
 let mutable selectedFrame = frames[0]
@@ -45,7 +54,12 @@ let mutable replayIndex = 0
 let mutable eventSource: EventSource option = None
 let mutable currentProjectId = ""
 let mutable currentRunId = ""
-let mutable loadedStepPath: string option = None
+/// Bumped on every new step request and on every invalidation; only the
+/// response matching the latest generation may repaint the viewport.
+let mutable loadGeneration = 0
+let mutable pendingLoad: (int * LoadOwner) option = None
+let mutable loadedStep: LoadOwner option = None
+let mutable viewMode = FrameMode
 let mutable displayedNode: ThreeNode option = None
 let mutable freezeRotation = false
 
@@ -111,14 +125,24 @@ let addMesh (view: ViewState) (frame: ReplayFrame) =
     let mesh = createMesh(geometry, material)
     view.Group.add(mesh)
 
+let clearGroup (group: ThreeNode) =
+    group.children |> Array.iter disposeNodeResources
+    group.clear ()
+
+let invalidateLoads () =
+    loadGeneration <- loadGeneration + 1
+    pendingLoad <- None
+
 let renderFrame (frame: ReplayFrame) =
     selectedFrame <- frame
     displayedNode <- None
+    invalidateLoads ()
+    viewMode <- FrameMode
 
     match viewState with
     | None -> ()
     | Some view ->
-        view.Group.clear()
+        clearGroup view.Group
         addMesh view frame
         view.Renderer.render(view.Scene, view.Camera)
 
@@ -164,7 +188,7 @@ let resizeView (view: ViewState) =
     | Some node ->
         frameObject view node
         view.Renderer.render(view.Scene, view.Camera)
-    | None -> renderFrame selectedFrame
+    | None -> view.Renderer.render(view.Scene, view.Camera)
 
 let initializeView () =
     let canvas = document.getElementById("viewport-canvas") :?> HTMLCanvasElement
@@ -233,23 +257,45 @@ let setManifestLink (payload: SnapshotPayload) =
         link.setAttribute("href", value)
         link.classList.remove("is-hidden")
 
-let loadStepArtifact (view: ViewState) (stepPath: string) =
-    loadedStepPath <- Some stepPath
+let startStepLoad (view: ViewState) (owner: LoadOwner) =
+    let generation = loadGeneration + 1
+    loadGeneration <- generation
+    pendingLoad <- Some(generation, owner)
+    viewMode <- StepMode
     let loader = createGLTFLoader ()
-    let projectId = JS.encodeURIComponent currentProjectId
-    let runId = JS.encodeURIComponent currentRunId
-    let url = sprintf "/api/artifacts/steps?projectId=%s&runId=%s&path=%s" projectId runId (JS.encodeURIComponent stepPath)
-    setText "viewport-note" (sprintf "管线几何加载中 · %s" stepPath)
+    let projectId = JS.encodeURIComponent owner.ProjectId
+    let runId = JS.encodeURIComponent owner.RunId
+    let url = sprintf "/api/artifacts/steps?projectId=%s&runId=%s&path=%s" projectId runId (JS.encodeURIComponent owner.Path)
+    setText "viewport-note" (sprintf "管线几何加载中 · %s" owner.Path)
 
     loadGLTF loader url
         (fun gltf ->
-            view.Group.clear()
-            view.Group.add gltf.scene
-            displayedNode <- Some gltf.scene
-            frameObject view gltf.scene
-            view.Renderer.render(view.Scene, view.Camera)
-            setText "viewport-note" (sprintf "管线几何 · %s" stepPath))
-        (fun _ -> setText "viewport-note" (sprintf "管线几何加载失败 · %s" stepPath))
+            if pendingLoad = Some(generation, owner) then
+                pendingLoad <- None
+                clearGroup view.Group
+                view.Group.add gltf.scene
+                displayedNode <- Some gltf.scene
+                loadedStep <- Some owner
+                frameObject view gltf.scene
+                view.Renderer.render(view.Scene, view.Camera)
+                setText "viewport-note" (sprintf "管线几何 · %s" owner.Path)
+            else
+                disposeNodeResources gltf.scene)
+        (fun _ ->
+            if pendingLoad = Some(generation, owner) then
+                pendingLoad <- None
+                loadedStep <- None
+                setText "viewport-note" (sprintf "管线几何加载失败 · %s" owner.Path))
+
+let loadStepArtifact (view: ViewState) (stepPath: string) =
+    let owner =
+        { ProjectId = currentProjectId
+          RunId = currentRunId
+          Path = stepPath }
+
+    match pendingLoad with
+    | Some (_, pending) when pending = owner -> ()
+    | _ -> startStepLoad view owner
 
 let updateState (payload: SnapshotPayload) =
     let status = statusName payload
@@ -265,6 +311,11 @@ let updateState (payload: SnapshotPayload) =
     setText "run-message" message
     setText "project-id" payload.projectId
     setText "run-id" payload.runId
+
+    if currentProjectId <> payload.projectId || currentRunId <> payload.runId then
+        invalidateLoads ()
+        displayedNode <- None
+
     currentProjectId <- payload.projectId
     currentRunId <- payload.runId
 
@@ -297,8 +348,12 @@ let updateState (payload: SnapshotPayload) =
             renderFrame frame
         else
             let latest = steps[steps.Length - 1]
+            let owner =
+                { ProjectId = payload.projectId
+                  RunId = payload.runId
+                  Path = latest }
 
-            if loadedStepPath <> Some latest then
+            if loadedStep <> Some owner then
                 loadStepArtifact view latest
 
             setText "mesh-label" latest