path: root/src/SomhairlesDream.Frontend/App.fs

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
      Controls: obj }

// Auto-spin pauses while the visitor is dragging or zooming the model and
// resumes a few seconds after the last interaction, so inspecting a stage
// (dish, RTG, mast) is never fought by the idle animation.
let mutable lastInteractionMs = 0.0
let idleSpinDelayMs = 3500.0

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
        // Fit the longest axis horizontally (it runs across the screen in the
        // side-on hero camera) and the next-longest vertically.
        let axes = [| size.x; size.y; size.z |] |> Array.sort
        let longest = axes.[2]
        let smallest = axes.[0]

        if longest > 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 = max 0.3 (width / height)
            camera.aspect <- aspect
            let fovY = camera.fov * Math.PI / 180.0
            let tanHalf = tan (fovY / 2.0)
            // Longest axis lies across the screen; the smallest axis is the
            // one stacking vertically in a side-on view of a slender vehicle.
            let halfW = 0.5 * longest / (tanHalf * aspect)
            let halfH = 0.5 * smallest / tanHalf
            let distance = 1.25 * max halfW halfH
            // Side-on hero camera: look across the hull, not down its nose.
            let dirX, dirY, dirZ = 0.30, 0.44, 0.85
            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 1.0 (distance * 0.05)
            camera.far <- distance + longest * 3.0
            camera.lookAt(0.0, 0.0, 0.0)
            camera.updateProjectionMatrix ()

            // Re-sync the orbit target after every auto-fit so drag/zoom
            // pivots around the freshly centered model.
            match view.Controls with
            | null -> ()
            | controls ->
                setControlsTarget controls 0.0 0.0 0.0
                updateControls controls

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)
    // PBR pipeline: ACES tone mapping + a procedural studio environment map
    // so metalness/roughness from the GLB materials read as machined
    // hardware instead of flat plastic.
    setToneMappingACES renderer
    setToneMappingExposure (renderer, 1.15)
    setSRGBOutput renderer
    let scene = createScene()
    scene.background <- createColor("#11171a")
    let envScene = createEnvScene()
    let pmrem = createPMREMGenerator renderer
    let envTexture = pmremFromScene (pmrem, envScene)
    setSceneEnvironment (scene, envTexture)
    setSceneEnvironmentIntensity (scene, 0.55)
    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, 0.0, 0.0)
    let group = createGroup()
    scene.add(group)
    scene.add(createAmbientLight("#f0e6c8", 0.55))
    let keyLight = createDirectionalLight("#f2c76b", 2.8)
    keyLight.position.set(4.0, 7.0, 5.0) |> ignore
    scene.add(keyLight)
    let rimLight = createDirectionalLight("#7fa8ff", 1.4)
    rimLight.position.set(-6.0, -3.0, -4.0) |> ignore
    scene.add(rimLight)
    let bounceLight = createHemisphereLight("#3d4a56", "#141a1e", 0.9)
    scene.add(bounceLight)

    // Coordinate ground grid so the model reads as anchored in a workspace
    // instead of floating in a void.
    let grid = createGridHelper (24.0, 48, "#5a4a2a", "#2a2f33")
    setNodePositionY (grid, -1.35)
    scene.add(grid)

    let controls = createOrbitControls camera canvas
    setControlsTarget controls 0.0 0.0 0.0
    setControlsDamping controls true
    setControlsAutoRotateSpeed controls 0.7

    let view =
        { Renderer = renderer
          Scene = scene
          Camera = camera
          Group = group
          Canvas = canvas
          Controls = controls }

    viewState <- Some view

    freezeRotation <- (queryParam "freeze") = "1"
    setControlsAutoRotate controls (not freezeRotation)
    exposeViewerDebug camera scene group canvas controls
    renderFrame selectedFrame
    window.addEventListener("resize", fun _ -> resizeView view)

    canvas.addEventListener("pointerdown", fun _ -> lastInteractionMs <- JS.Constructors.Date.now ())
    canvas.addEventListener("wheel", fun _ -> lastInteractionMs <- JS.Constructors.Date.now ())
    canvas.addEventListener("touchstart", fun _ -> lastInteractionMs <- JS.Constructors.Date.now ())

    let rec animate (nowMs: float) =
        updateControls controls

        if not freezeRotation then
            group.rotation.y <- group.rotation.y + 0.003

        let interacting = nowMs - lastInteractionMs < idleSpinDelayMs
        setControlsAutoRotate controls (not freezeRotation && not interacting)

        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
    // Swap the viewport to a loading state immediately: drop the previous
    // mesh so the old geometry never lingers under the spinner.
    clearGroup view.Group
    displayedNode <- None
    loadedStep <- None
    toggleHidden ("viewport-loading", false)
    let loader = createGLTFLoader ()
    // Attach the Draco decoder so geometry-compressed GLBs stream in small.
    let draco = createDRACOLoader ()
    setDracoDecoderPath draco "/vendor/addons/libs/draco/"
    attachDracoLoader loader draco
    let projectId = JS.encodeURIComponent owner.ProjectId
    let runId = JS.encodeURIComponent owner.RunId
    // Cache-buster: the GLB is always re-fetched from the server.
    let stamp = int (JS.Constructors.Date.now () % 100000000.0)
    let url = sprintf "/api/artifacts/steps?projectId=%s&runId=%s&path=%s&ts=%d" projectId runId (JS.encodeURIComponent owner.Path) stamp

    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
                toggleHidden ("viewport-loading", true)
                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)
                toggleHidden ("viewport-loading", true)
                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 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


let inputValue id =
    (element id :?> HtmlInput).value

let probeSelection : RunSelection =
    { ProjectId = "probe-001"
      RunId = "run-probe-real-2"
      BaseId = "probe-base-000"
      TargetId = "probe-target-007"
      Render = false }

let shipSelection : RunSelection =
    { ProjectId = "ship-001"
      RunId = "run-ship-002"
      BaseId = "ship-base-000"
      TargetId = "ship-target-007"
      Render = false }

let mutable activeModel : RunSelection = probeSelection

let selectedRun () = activeModel

let highlightActiveCard (selection: RunSelection) =
    let library: HTMLElement = unbox (element "model-library")

    for index in 0 .. (library.children.length - 1) do
        let card: HTMLElement = unbox (library.children.item index)

        if card.classList.contains "model-card" then
            let project = card.getAttribute "data-project"
            let run = card.getAttribute "data-run"

            if project = selection.ProjectId && run = selection.RunId then
                card.classList.add "is-active"
            else
                card.classList.remove "is-active"

// The boot run id names a pre-published historical replay that already has an
// on-disk manifest; re-running it can only fail ("run directory already
// exists"). A user submit keeps their typed ids unless they left the boot
// default untouched — then pick a fresh live run id instead.
let freshLiveRunId (base_: string) =
    sprintf "%s-live-%d" base_ (int (JS.Constructors.Date.now () % 1000000.0))

let selectionForLiveStart (selection: RunSelection) =
    if selection.RunId = "run-probe-real-2" then
        { selection with RunId = freshLiveRunId selection.RunId }
    else
        selection

let loadHistoryFor (selection: RunSelection) =
    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 -> ()
                else
                    // Manifest answered but nothing is replayable: close the
                    // spinner instead of leaving it spinning forever.
                    toggleHidden ("viewport-loading", true)
                    setText "viewport-note" "该运行尚无可用历史几何"
        with _ ->
            // Manifest unreachable: fail honestly rather than spin forever.
            toggleHidden ("viewport-loading", true)
            setText "viewport-note" "历史几何加载失败 · 清单不可用"
    }
    |> Async.StartImmediate
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" "正在启动设计运行"

    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
            elif response.status = 409 then
                // The run id already exists on the server. If it completed
                // earlier, replay its published history instead of treating
                // the submit as a failure.
                setText "run-message" "该运行已完成 · 载入历史回放"
                loadHistoryFor selection
            else
                setText "run-message" (sprintf "启动失败 · HTTP %d" response.status)
        with _ ->
            setText "run-message" "启动失败 · 无法连接服务端"
    }
    |> 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 () =
    loadHistoryFor (selectedRun ())

let selectModel (card: HTMLElement) =
    let project = card.getAttribute "data-project"
    let run = card.getAttribute "data-run"
    let baseId = card.getAttribute "data-base"
    let targetId = card.getAttribute "data-target"

    let selection : RunSelection =
        { ProjectId = project
          RunId = run
          BaseId = baseId
          TargetId = targetId
          Render = false }

    activeModel <- selection
    highlightActiveCard selection
    setText "run-message" "载入模型历史"
    // Enter the loading state before the manifest round-trip: the previous
    // mesh is dropped and the spinner appears the instant a card is clicked.
    (match viewState with
     | Some view ->
         clearGroup view.Group
         displayedNode <- None
         loadedStep <- None
     | None -> ())

    toggleHidden ("viewport-loading", false)
    setText "viewport-note" "历史几何加载中"
    loadHistoryFor selection

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 ())

    let library: HTMLElement = unbox (element "model-library")

    for index in 0 .. (library.children.length - 1) do
        let card: HTMLElement = unbox (library.children.item index)

        if card.classList.contains "model-card" then
            card.addEventListener("click", fun _ -> selectModel card)

    highlightActiveCard activeModel
    loadBootHistory ()

    renderTimeline ()

boot ()