hgg-3d-0.1.0.0: src/Graphics/Hgg/ThreeD/Browser.hs
-- |
-- Module : Graphics.Hgg.ThreeD.Browser
-- Description : HS-side browser display driver (Phase 5 A5)
-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License : BSD-3-Clause
--
-- @
-- import Graphics.Hgg.ThreeD.Spec
-- import Graphics.Hgg.ThreeD.Browser
-- main = showBrowser $ purePlot3D <> layer3D (scatter3D pts) <> camera (defaultCameraZUp 3)
-- @
--
-- 中身: spec を aeson で JSON 化、 PS WebGL bundle (= data-files) と inline 結合した
-- self-contained HTML を tmp に出力、 OS 別 browser-open コマンド (xdg-open / open / start) で起動。
--
-- 設計判断 (= phase-5 計画 md §2.4):
--
-- * **bundle embed 方式**: cabal data-files 採用 (= dev iteration 速さ重視、
-- PS 側更新時 HS 再 build 不要)。 将来 TH 'embedFile' 切替時は 'getBundleJS'
-- の中身だけ差替えで済む。 詳細 → @design\/bundle-embed-choice.md@
-- * **3 つの出力経路**: 'showBrowser' (= tmp + open)、 'saveHTML3D' (= 配布用、 単一 HTML)、
-- 'Graphics.Hgg.ThreeD.Easy.saveSVG3D' (= 静的 SVG、 Phase 3 CPU projection 経路)
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Hgg.ThreeD.Browser
( -- * 主要 API
showBrowser
, saveHTML3D
-- * 内部 (= bundle 取得、 swap 用に export)
, getBundleJS
) where
import Data.Aeson (encode)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import Paths_hgg_3d (getDataFileName)
import System.Directory (getTemporaryDirectory)
import System.FilePath ((</>))
import System.Info (os)
import System.Process (callCommand)
import Graphics.Hgg.ThreeD.Spec (VisualSpec3D)
-- ===========================================================================
-- bundle 取得 (= 絶縁レイヤ、 後で TH に swap 可能)
-- ===========================================================================
-- | PS WebGL bundle (= data/webgl-spec.js) を ByteString で取得。
--
-- 現在は @cabal data-files@ 経由 ('Paths_hgg_3d.getDataFileName')。
-- 将来 TH 'embedFile' に切替時はこの 1 関数のみ差替えれば済むよう設計
-- (= 切替手順は @design\/bundle-embed-choice.md@)。
getBundleJS :: IO BS.ByteString
getBundleJS = do
path <- getDataFileName "data/webgl-spec.js"
BS.readFile path
-- ===========================================================================
-- showBrowser / saveHTML3D
-- ===========================================================================
-- | spec を **ブラウザで interactive 表示**。 tmp HTML 生成 + OS 別 browser-open。
--
-- WebGL2 backend で描画、 mouse drag で camera orbit、 wheel で zoom、
-- 右 drag で pan。 操作仕様は Phase 4 demo と同一。
showBrowser :: VisualSpec3D -> IO ()
showBrowser spec = do
tmpDir <- getTemporaryDirectory
let path = tmpDir </> "hgg-3d-tmp.html"
saveHTML3D path spec
openInBrowser path
-- | spec を **self-contained HTML として保存** (= 配布用、 bundle inline 埋込)。
--
-- 出力ファイルは外部依存無し、 ブラウザで直接開ける。
saveHTML3D :: FilePath -> VisualSpec3D -> IO ()
saveHTML3D path spec = do
bundleJS <- getBundleJS
let specJSON = encode spec
html = mkHTML bundleJS specJSON
LBS.writeFile path html
-- ===========================================================================
-- HTML 生成
-- ===========================================================================
-- | bundle JS + spec JSON を 1 HTML に埋込。 ESM ではなく通常 script 経路
-- (= spago bundle 出力は IIFE、 ESM import すると export named 'main' 不在で失敗、
-- Phase 4 で確認済の罠)。
mkHTML :: BS.ByteString -> LBS.ByteString -> LBS.ByteString
mkHTML bundleJS specJSON = LBS.concat
[ "<!DOCTYPE html>\n"
, "<html lang=\"ja\">\n"
, "<head>\n"
, "<meta charset=\"UTF-8\">\n"
, "<title>hgg 3D</title>\n"
, "<style>\n"
-- Phase 27 A8: 2D / CPU SVG plot (tpBackground=#ffffff) と背景を揃える (白)
, " body { margin: 0; background: #ffffff; color: #333333;\n"
, " font-family: -apple-system, \"Hiragino Sans\", \"Yu Gothic UI\", sans-serif; }\n"
, " #plot-container { width: 100vw; height: 100vh; display: flex;\n"
, " flex-direction: column; }\n"
, " #plot { flex: 1; cursor: grab; background: #ffffff; }\n"
, " #plot:active { cursor: grabbing; }\n"
, " #info { padding: 8px 16px; font-size: 12px; color: #666666;\n"
, " border-top: 1px solid #dddddd; }\n"
, "</style>\n"
, "</head>\n"
, "<body>\n"
, "<div id=\"plot-container\">\n"
, " <canvas id=\"plot\" width=\"1024\" height=\"720\"></canvas>\n"
, " <div id=\"info\">左ドラッグ orbit / 右ドラッグ pan / wheel zoom</div>\n"
, "</div>\n"
, "<script>\n"
, LBS.fromStrict bundleJS
, "\n</script>\n"
, "<script>\n"
, " // spec JSON を inline 埋込、 PS Examples.WebGLPlot.renderFromSpec で描画\n"
, " var SPEC = "
, specJSON
, ";\n"
, " if (window.hggPlot && window.hggPlot.renderFromSpec) {\n"
, " window.hggPlot.renderFromSpec(\"plot\", SPEC);\n"
, " } else {\n"
, " console.error(\"[hgg] window.hggPlot not initialized\");\n"
, " }\n"
, "</script>\n"
, "</body>\n"
, "</html>\n"
]
where
_unused = LBS8.pack "" -- LBS8 import を保持 (= 将来 debug println で使用)
-- ===========================================================================
-- OS 別 browser-open
-- ===========================================================================
-- | OS 検出して xdg-open (Linux) / open (macOS) / start (Windows) を呼ぶ。
--
-- WSL は @os == \"linux\"@ で xdg-open 経路。 wslview などインストール済なら動作。
-- 失敗時は path を stdout に出すので手動で開ける。
openInBrowser :: FilePath -> IO ()
openInBrowser path = case os of
"linux" -> safeCall ("xdg-open " <> quote path)
"darwin" -> safeCall ("open " <> quote path)
"mingw32" -> safeCall ("start " <> quote path) -- Windows GHC
other -> do
putStrLn $ "[hgg] unknown OS '" <> other <> "', open manually: " <> path
where
safeCall cmd = do
putStrLn $ "[hgg] " <> cmd
callCommand cmd
-- path にスペース含むケースに備えて double quote。 簡略化のため escape 無し
-- (= tmp dir path に通常スペースは無いが念のため)
quote p = "\"" <> p <> "\""