1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
|
module SomhairlesDream.Frontend.App
open System
open Browser.Dom
open Browser.Types
open Fable.Core
open Fable.Core.JsInterop
open SomhairlesDream.Frontend.Bindings
open SomhairlesDream.Shared
[<Erase>]
type SnapshotPayload =
abstract projectId: string with get
abstract runId: string with get
abstract status: string with get
abstract currentStepIndex: int with get
abstract totalSteps: int with get
abstract completedSteps: string array with get
abstract lastHeartbeatAt: string with get
abstract updatedAt: string with get
abstract message: string with get
abstract manifestUrl: string with get
abstract error: string with get
abstract isStale: bool with get
[<Erase>]
type ManifestStep =
abstract stepIndex: int with get
abstract artifactPath: string with get
[<Erase>]
type ManifestPayload =
abstract projectId: string with get
abstract runId: string with get
abstract status: string with get
abstract steps: ManifestStep array with get
type RunSelection =
{ ProjectId: string
RunId: string
BaseId: string
TargetId: string
Render: bool }
type ViewState =
{ Renderer: ThreeRenderer
Scene: ThreeNode
Camera: ThreeCamera
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]
let mutable replayTimer: int option = None
let mutable replayIndex = 0
let mutable eventSource: EventSource option = None
let mutable currentProjectId = ""
let mutable currentRunId = ""
/// Checkpoint artifact paths published by the currently selected run. Empty
/// when no real history exists and the placeholder fallback is shown.
let mutable historicalSteps: string array = [||]
/// Index into historicalSteps of the user-pinned historical checkpoint.
/// None means the viewport follows the latest published checkpoint.
let mutable pinnedIndex: int 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
/// Last failed step load plus whether it was a historical (replay) load, so
/// the retry affordance re-requests the same owner in the same scope.
let mutable failedLoad: (LoadOwner * bool) option = None
let mutable displayedNode: ThreeNode option = None
let mutable freezeRotation = false
let element id = document.getElementById(id)
let setText id value =
(element id).textContent <- value
let setWidth id value =
(element id).setAttribute("style", sprintf "width: %s" value)
let setStatusClass (status: string) =
let host = element "status-chip"
[| "idle"; "queued"; "running"; "succeeded"; "failed"; "stale" |]
|> Array.iter (fun name -> host.classList.remove($"status-{name}"))
host.classList.add($"status-{status}")
host.setAttribute("data-status", status)
let statusName (payload: SnapshotPayload) =
if payload.isStale then
"stale"
else
match payload.status with
| "complete" -> "succeeded"
| "idle"
| "queued"
| "running"
| "failed" as status -> status
| _ -> "unknown"
let statusLabel (payload: SnapshotPayload) =
match payload.status, payload.isStale with
| _, true -> "心跳超时"
| "idle", _ -> "待机"
| "queued", _ -> "排队中"
| "running", _ -> "运行中"
| "complete", _ -> "已完成"
| "failed", _ -> "失败"
| _ -> "未知状态"
let addMesh (view: ViewState) (frame: ReplayFrame) =
let geometry = createBufferGeometry ()
let positions = MeshData.positionData frame.Mesh
let indices = MeshData.triangleIndices frame.Mesh
geometry.setAttribute("position", createFloat32BufferAttribute(positions, 3)) |> ignore
geometry.setIndex(createUint32BufferAttribute indices) |> ignore
geometry.computeVertexNormals()
let color =
match frame.Version with
| 1 -> "#d7a948"
| 2 -> "#efe4c4"
| _ -> "#a7c7c0"
let material =
createMeshStandardMaterial (
createObj
[ "color" ==> color
"roughness" ==> 0.36
"metalness" ==> 0.72 ]
)
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
failedLoad <- None
let renderFrame (frame: ReplayFrame) =
selectedFrame <- frame
displayedNode <- None
invalidateLoads ()
viewMode <- FrameMode
match viewState with
| None -> ()
| Some view ->
clearGroup view.Group
addMesh view frame
view.Renderer.render(view.Scene, view.Camera)
let frameObject (view: ViewState) (node: ThreeNode) =
let box = createBox3 ()
box.setFromObject node |> ignore
if not (box.isEmpty ()) then
let center = createVector3 ()
let size = createVector3 ()
box.getCenter center |> ignore
box.getSize size |> ignore
let radius = 0.5 * size.length ()
if radius > 0.000001 then
node.position.set(-center.x, -center.y, -center.z) |> ignore
let camera = view.Camera
let width = max 1.0 (float view.Canvas.clientWidth)
let height = max 1.0 (float view.Canvas.clientHeight)
let aspect = width / height
camera.aspect <- aspect
let fovY = camera.fov * Math.PI / 180.0
let fovX = 2.0 * atan (tan (fovY / 2.0) * aspect)
let limitingFov = min fovY fovX
let distance = 1.28 * radius / sin (limitingFov / 2.0)
let dirX, dirY, dirZ = 0.62, 0.45, 0.70
let norm = sqrt (dirX * dirX + dirY * dirY + dirZ * dirZ)
camera.position.set(dirX / norm * distance, dirY / norm * distance, dirZ / norm * distance)
|> ignore
camera.near <- max (distance * 0.01) (distance - radius * 2.5)
camera.far <- distance + radius * 4.0
camera.lookAt(0.0, 0.0, 0.0)
camera.updateProjectionMatrix ()
let resizeView (view: ViewState) =
let width = max 1.0 (float view.Canvas.clientWidth)
let height = max 1.0 (float view.Canvas.clientHeight)
view.Renderer.setSize(width, height, false)
view.Camera.aspect <- width / height
view.Camera.updateProjectionMatrix()
match displayedNode with
| Some node ->
frameObject view node
view.Renderer.render(view.Scene, view.Camera)
| None -> view.Renderer.render(view.Scene, view.Camera)
let initializeView () =
let canvas = document.getElementById("viewport-canvas") :?> HTMLCanvasElement
let width = max 1.0 (float canvas.clientWidth)
let height = max 1.0 (float canvas.clientHeight)
let renderer =
createRenderer (
createObj
[ "canvas" ==> canvas
"antialias" ==> true
"alpha" ==> true ]
)
renderer.setPixelRatio(window.devicePixelRatio)
renderer.setSize(width, height, false)
let scene = createScene()
scene.background <- createColor("#11171a")
let camera = createPerspectiveCamera(34.0, width / height, 0.1, 100.0)
camera.position.set(6.4, 4.6, 7.2) |> ignore
camera.lookAt(0.0, 1.2, 0.0)
let group = createGroup()
scene.add(group)
scene.add(createAmbientLight("#f0e6c8", 1.9))
let keyLight = createDirectionalLight("#f2c76b", 2.8)
keyLight.position.set(4.0, 7.0, 5.0) |> ignore
scene.add(keyLight)
let view =
{ Renderer = renderer
Scene = scene
Camera = camera
Group = group
Canvas = canvas }
viewState <- Some view
freezeRotation <- (queryParam "freeze") = "1"
exposeViewerDebug camera scene group canvas
renderFrame selectedFrame
window.addEventListener("resize", fun _ -> resizeView view)
let rec animate (_: float) =
if not freezeRotation then
group.rotation.y <- group.rotation.y + 0.003
renderer.render(scene, camera)
requestAnimationFrame animate |> ignore
requestAnimationFrame animate |> ignore
let fallbackView () =
setText "viewport-note" "WebGL 视图待命 · 已保留重建数据"
(element "viewport-panel").classList.add("viewport-fallback")
let setNoteRetryable (retryable: bool) =
let note = element "viewport-note"
if retryable then
note.classList.add("is-retryable")
else
note.classList.remove("is-retryable")
let updateFollowButton () =
if Array.length historicalSteps > 0 && pinnedIndex.IsSome then
(element "follow-button").removeAttribute("disabled")
setText "follow-button" "跟随最新"
else
(element "follow-button").setAttribute("disabled", "disabled")
if Array.length historicalSteps > 0 then
setText "follow-button" "跟随最新 · 已开启"
else
setText "follow-button" "跟随最新"
let stopReplay () =
match replayTimer with
| Some handle ->
clearInterval handle
replayTimer <- None
| None -> ()
let showFrameMetadata (frame: ReplayFrame) =
setText "mesh-label" (sprintf "占位 · %s" frame.Label)
setText "timeline-current" (sprintf "V%02d · 占位 · %s" frame.Version frame.Label)
let setManifestLink (payload: SnapshotPayload) =
let link = element "artifact-manifest-link"
match payload.manifestUrl with
| value when String.IsNullOrWhiteSpace(value) ->
link.removeAttribute("href")
link.classList.add("is-hidden")
| value ->
link.setAttribute("href", value)
link.classList.remove("is-hidden")
let startStepLoad (view: ViewState) (owner: LoadOwner) (historical: bool) =
let generation = loadGeneration + 1
loadGeneration <- generation
pendingLoad <- Some(generation, owner)
viewMode <- StepMode
failedLoad <- None
setNoteRetryable false
let loader = createGLTFLoader ()
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)
if historical then
setText "viewport-note" (sprintf "历史几何加载中 · %s" owner.Path)
else
setText "viewport-note" (sprintf "管线几何加载中 · %s" owner.Path)
loadGLTF loader url
(fun gltf ->
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)
if historical then
setText "viewport-note" (sprintf "历史几何 · %s" owner.Path)
else
setText "viewport-note" (sprintf "管线几何 · %s" owner.Path)
else
disposeNodeResources gltf.scene)
(fun _ ->
if pendingLoad = Some(generation, owner) then
pendingLoad <- None
loadedStep <- None
failedLoad <- Some(owner, historical)
setNoteRetryable true
if historical then
setText "viewport-note" (sprintf "历史几何加载失败 · %s" owner.Path)
else
setText "viewport-note" (sprintf "管线几何加载失败 · %s" owner.Path))
let loadStepArtifact (view: ViewState) (stepPath: string) (historical: bool) =
let owner =
{ ProjectId = currentProjectId
RunId = currentRunId
Path = stepPath }
match pendingLoad with
| Some (_, pending) when pending = owner -> ()
| _ -> startStepLoad view owner historical
let retryFailedLoad () =
match viewState, failedLoad with
| Some view, Some (owner, historical) when owner.ProjectId = currentProjectId && owner.RunId = currentRunId ->
loadStepArtifact view owner.Path historical
| _ -> ()
let applyHistoricalStep (index: int) (duringPlayback: bool) =
match viewState with
| Some view when index >= 0 && index < Array.length historicalSteps ->
pinnedIndex <- Some index
let path = historicalSteps[index]
let version = index + 1
setText "mesh-label" (sprintf "历史 · %s" path)
setText "timeline-current" (sprintf "V%02d · 历史回放 · %s" version path)
loadStepArtifact view path true
if duringPlayback then
setText "replay-state" (sprintf "历史回放中 · V%02d (%d/%d)" version version (Array.length historicalSteps))
else
setText "replay-state" (sprintf "历史回放 · 已固定 V%02d" version)
| _ -> ()
let rec renderTimeline () =
let track = element "timeline-track"
clearChildren track
let line = document.createElement("span")
line.className <- "timeline-line"
line.setAttribute("aria-hidden", "true")
track.appendChild line |> ignore
if Array.length historicalSteps > 0 then
track.setAttribute("style", sprintf "grid-template-columns: repeat(%d, 1fr)" historicalSteps.Length)
historicalSteps
|> Array.iteri (fun i path ->
let active =
match pinnedIndex with
| Some pinned -> pinned = i
| None -> i = historicalSteps.Length - 1
track.appendChild (createStepNode (i + 1) path active true (Some i)) |> ignore)
else
track.setAttribute("style", "grid-template-columns: repeat(3, 1fr)")
frames
|> Array.iter (fun frame ->
track.appendChild
(createStepNode frame.Version (sprintf "占位 · %s" frame.Label) false (frame.Version < frames.Length) None)
|> ignore)
and selectStep (index: int) =
if index >= 0 && index < Array.length historicalSteps then
stopReplay ()
applyHistoricalStep index false
updateFollowButton ()
renderTimeline ()
and createStepNode (version: int) (label: string) (active: bool) (complete: bool) (onClickIndex: int option) =
let classes = ResizeArray [ "timeline-step" ]
if complete then classes.Add("timeline-step-complete")
if onClickIndex.IsSome then classes.Add("timeline-step-real")
if active then classes.Add("timeline-step-active")
let step = document.createElement("div")
step.className <- String.concat " " classes
let dot = document.createElement("span")
dot.className <- "timeline-dot"
dot.setAttribute("aria-hidden", "true")
step.appendChild dot |> ignore
let versionLabel = document.createElement("span")
versionLabel.className <- "timeline-version"
versionLabel.textContent <- sprintf "V%02d" version
step.appendChild versionLabel |> ignore
let text = document.createElement("span")
text.className <- "timeline-label"
text.textContent <- label
step.appendChild text |> ignore
match onClickIndex with
| Some index -> step.addEventListener("click", fun _ -> selectStep index)
| None -> ()
step
let followLatestStep () =
match viewState with
| Some view when Array.length historicalSteps > 0 ->
stopReplay ()
pinnedIndex <- None
let total = Array.length historicalSteps
let latest = historicalSteps[total - 1]
loadStepArtifact view latest false
setText "mesh-label" latest
setText "timeline-current" (sprintf "V%02d · 实时跟随 · %s" total latest)
setText "replay-state" (sprintf "实时跟随 · 最新 V%02d" total)
updateFollowButton ()
renderTimeline ()
| _ -> ()
let updateState (payload: SnapshotPayload) =
let status = statusName payload
setStatusClass status
setText "status-label" (statusLabel payload)
let message =
if payload.status = "failed" && not (String.IsNullOrWhiteSpace(payload.error)) then
payload.error
else
payload.message
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
stopReplay ()
pinnedIndex <- None
historicalSteps <- [||]
setText "replay-button" "占位演示"
setText "replay-state" "占位示例 · 未选择历史"
updateFollowButton ()
currentProjectId <- payload.projectId
currentRunId <- payload.runId
let currentVersion = max 0 (payload.currentStepIndex + 1)
setText "target-version" (sprintf "V%02d" payload.totalSteps)
setText "current-version" (sprintf "V%02d" currentVersion)
setText "version-readout" (sprintf "%02d / %02d" currentVersion payload.totalSteps)
setText "updated-at" payload.updatedAt
let progress =
if payload.totalSteps <= 0 then 0.0
else min 100.0 (float currentVersion / float payload.totalSteps * 100.0)
setWidth "progress-fill" (sprintf "%.0f%%" progress)
let frame =
frames
|> Array.tryFind (fun candidate -> candidate.Version = currentVersion)
|> Option.defaultValue selectedFrame
setManifestLink payload
let completedSteps =
if isNull (box payload.completedSteps) then [||] else payload.completedSteps
match viewState, completedSteps with
| Some view, [||] ->
if historicalSteps.Length > 0 then
stopReplay ()
historicalSteps <- [||]
pinnedIndex <- None
setText "replay-button" "占位演示"
renderTimeline ()
updateFollowButton ()
showFrameMetadata frame
renderFrame frame
| Some view, steps ->
if steps <> historicalSteps then
if historicalSteps.Length = 0 then
stopReplay ()
setText "replay-button" "播放历史"
historicalSteps <- steps
match pinnedIndex with
| Some pinned when pinned >= steps.Length -> pinnedIndex <- None
| _ -> ()
renderTimeline ()
updateFollowButton ()
match pinnedIndex with
| Some _ -> ()
| None ->
let latest = steps[steps.Length - 1]
let owner =
{ ProjectId = payload.projectId
RunId = payload.runId
Path = latest }
if loadedStep <> Some owner then
loadStepArtifact view latest false
setText "mesh-label" latest
setText "timeline-current" (sprintf "V%02d · 实时跟随 · %s" steps.Length latest)
setText "replay-state" (sprintf "实时跟随 · 最新 V%02d" steps.Length)
| None, steps ->
if steps.Length > 0 then
setText "mesh-label" steps[steps.Length - 1]
else
showFrameMetadata frame
let updateStreamState message =
setText "stream-state" message
let startPlaceholderPlayback () =
replayIndex <- 0
setText "replay-button" "暂停占位演示"
setText "replay-state" "占位演示中 · 未选择历史"
let tick () =
if replayIndex >= frames.Length then
stopReplay ()
setText "replay-button" "占位演示"
setText "replay-state" "占位演示完成 · 未选择历史"
else
let frame = frames[replayIndex]
showFrameMetadata frame
renderFrame frame
setText "replay-state" (sprintf "占位演示中 · V%02d %s" frame.Version frame.Label)
replayIndex <- replayIndex + 1
tick ()
replayTimer <- Some(setInterval tick 900)
let startHistoricalPlayback () =
if Array.length historicalSteps > 0 then
setText "replay-button" "暂停历史回放"
applyHistoricalStep 0 true
updateFollowButton ()
renderTimeline ()
let total = Array.length historicalSteps
let tick () =
match pinnedIndex with
| Some pinned when pinned + 1 < total ->
applyHistoricalStep (pinned + 1) true
renderTimeline ()
| Some pinned ->
stopReplay ()
setText "replay-button" "播放历史"
setText "replay-state" (sprintf "历史回放完成 · 停在 V%02d" (pinned + 1))
| None ->
stopReplay ()
setText "replay-button" "播放历史"
replayTimer <- Some(setInterval tick 1500)
let toggleReplay () =
match replayTimer with
| Some handle ->
clearInterval handle
replayTimer <- None
if Array.length historicalSteps > 0 then
let current = Option.defaultValue 0 pinnedIndex
setText "replay-button" "播放历史"
setText "replay-state" (sprintf "历史回放 · 已暂停 · V%02d" (current + 1))
else
setText "replay-button" "占位演示"
setText "replay-state" "占位演示 · 已暂停"
| None ->
if Array.length historicalSteps > 0 then
startHistoricalPlayback ()
else
startPlaceholderPlayback ()
let disconnectFromServer () =
match eventSource with
| Some source ->
source.close()
eventSource <- None
| None -> ()
let connectToServer (selection: RunSelection) =
disconnectFromServer ()
let projectId = JS.encodeURIComponent selection.ProjectId
let runId = JS.encodeURIComponent selection.RunId
let source = createEventSource (sprintf "/api/runs/events?projectId=%s&runId=%s" projectId runId)
eventSource <- Some source
source.onmessage <- fun event ->
let payload = JS.JSON.parse(event.data) :?> SnapshotPayload
updateState payload
updateStreamState "实时链路 · SSE 已连接"
source.onerror <- fun _ -> updateStreamState "实时链路 · 等待自动重连"
let inputValue id =
(element id :?> HtmlInput).value
let selectedRun () =
{ ProjectId = inputValue "project-id-input"
RunId = inputValue "run-id-input"
BaseId = inputValue "base-id-input"
TargetId = inputValue "target-id-input"
Render = (element "run-render-input" :?> HtmlInput).``checked`` }
let startRun (selection: RunSelection) =
let requestBody =
createObj
[ "projectId" ==> selection.ProjectId
"runId" ==> selection.RunId
"baseId" ==> selection.BaseId
"targetId" ==> selection.TargetId
"render" ==> selection.Render ]
let requestOptions =
createObj
[ "method" ==> "POST"
"headers" ==> createObj [ "Content-Type" ==> "application/json" ]
"body" ==> JS.JSON.stringify requestBody ]
setText "run-message" "正在启动设计运行"
updateStreamState "实时链路 · 等待服务端确认"
async {
try
let! response = fetch ("/api/runs/start", requestOptions) |> Async.AwaitPromise
if response.ok then
let! value = response.json() |> Async.AwaitPromise
let payload = value :?> SnapshotPayload
updateState payload
connectToServer selection
updateStreamState "实时链路 · SSE 已连接"
else
setText "run-message" (sprintf "启动失败 · HTTP %d" response.status)
updateStreamState "实时链路 · 启动失败"
with _ ->
setText "run-message" "启动失败 · 无法连接服务端"
updateStreamState "实时链路 · 连接失败"
}
|> Async.StartImmediate
/// Boot-time historical load: surface the pre-published probe build replay so
/// first-time visitors see the real vehicle instead of an empty placeholder.
/// Any failure leaves the honest placeholder idle state untouched.
let loadBootHistory () =
let selection = selectedRun ()
let projectId = JS.encodeURIComponent selection.ProjectId
let runId = JS.encodeURIComponent selection.RunId
let url = sprintf "/api/artifacts/manifest?projectId=%s&runId=%s" projectId runId
let requestOptions = createObj [ "method" ==> "GET" ]
async {
try
let! response = fetch (url, requestOptions) |> Async.AwaitPromise
if response.ok then
let! value = response.json () |> Async.AwaitPromise
let payload = value :?> ManifestPayload
if payload.status = "complete" && Array.length payload.steps > 0 then
let steps =
payload.steps
|> Array.sortBy (fun step -> step.stepIndex)
|> Array.map (fun step -> step.artifactPath)
if Array.length steps > 0 then
currentProjectId <- selection.ProjectId
currentRunId <- selection.RunId
historicalSteps <- steps
setText "project-id" selection.ProjectId
setText "run-id" selection.RunId
setText "target-version" (sprintf "V%02d" steps.Length)
setText "current-version" (sprintf "V%02d" steps.Length)
setText "version-readout" (sprintf "%02d / %02d" steps.Length steps.Length)
setWidth "progress-fill" "100%"
setText "updated-at" "预发布历史"
setText "mesh-label" (sprintf "历史 · %s" steps[steps.Length - 1])
setText "timeline-current" (sprintf "V%02d · 构建重演 · %s" steps.Length steps[steps.Length - 1])
setText "replay-button" "播放历史"
setText "replay-state" "构建重演 · 预发布历史"
renderTimeline ()
updateFollowButton ()
match viewState with
| Some view -> loadStepArtifact view steps[steps.Length - 1] true
| None -> ()
with _ ->
()
}
|> Async.StartImmediate
let boot () =
showFrameMetadata frames[0]
try
initializeView ()
with _ ->
fallbackView ()
(element "replay-button").addEventListener("click", fun _ -> toggleReplay ())
(element "follow-button").addEventListener("click", fun _ -> followLatestStep ())
(element "viewport-note").addEventListener("click", fun _ -> retryFailedLoad ())
(element "run-controls").addEventListener("submit", fun event ->
event.preventDefault()
startRun (selectedRun ()))
loadBootHistory ()
renderTimeline ()
boot ()
|