1 files changed, 338 insertions, 0 deletions
diff --git a/src/SomhairlesDream.Frontend/App.fs b/src/SomhairlesDream.Frontend/App.fs
new file mode 100644
index 0000000..835dfa9
--- /dev/null
+++ b/src/SomhairlesDream.Frontend/App.fs
@@ -0,0 +1,338 @@
+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 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
+
+type RunSelection =
+    { ProjectId: string
+      RunId: string
+      BaseId: string
+      TargetId: string
+      Render: bool }
+
+type ViewState =
+    { Renderer: ThreeRenderer
+      Scene: ThreeNode
+      Camera: ThreeNode
+      Group: ThreeNode
+      Canvas: HTMLCanvasElement }
+
+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 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 renderFrame (frame: ReplayFrame) =
+    selectedFrame <- frame
+
+    match viewState with
+    | None -> ()
+    | Some view ->
+        view.Group.clear()
+        addMesh view frame
+        view.Renderer.render(view.Scene, view.Camera)
+
+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)
+    renderFrame selectedFrame
+
+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
+    renderFrame selectedFrame
+    window.addEventListener("resize", fun _ -> resizeView view)
+
+    let rec animate (_: float) =
+        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 showFrameMetadata (frame: ReplayFrame) =
+    setText "mesh-label" 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 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
+
+    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
+    showFrameMetadata frame
+    renderFrame frame
+
+let updateStreamState message =
+    setText "stream-state" message
+
+let toggleReplay () =
+    match replayTimer with
+    | Some handle ->
+        clearInterval handle
+        replayTimer <- None
+        setText "replay-button" "重建演示"
+        setText "replay-state" "演示已暂停"
+    | None ->
+        replayIndex <- 0
+        setText "replay-button" "暂停重建"
+        setText "replay-state" "重建中 · 几何逐帧替换"
+
+        let tick () =
+            if replayIndex >= frames.Length then
+                match replayTimer with
+                | Some handle -> clearInterval handle
+                | None -> ()
+
+                replayTimer <- None
+                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 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
+
+let boot () =
+    showFrameMetadata frames[0]
+
+    try
+        initializeView ()
+    with _ ->
+        fallbackView ()
+
+    (element "replay-button").addEventListener("click", fun _ -> toggleReplay ())
+    (element "run-controls").addEventListener("submit", fun event ->
+        event.preventDefault()
+        startRun (selectedRun ()))
+
+boot ()