hgg-3d-0.2.0.0: src/Graphics/Hgg/ThreeD/Easy.hs
-- |
-- Module : Graphics.Hgg.ThreeD.Easy
-- Description : A thin wrapper over the 3D output paths (saveSVG3D)
-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License : BSD-3-Clause
--
-- [日本語]: 'VisualSpec3D' から各出力経路への dispatch helper。 3 経路:
--
-- * 'saveSVG3D' ─ CPU projection (= 静的 SVG 出力、 本 module 実装)
-- * 'Graphics.Hgg.ThreeD.Browser.saveHTML3D' ─ WebGL bundle 埋込 HTML (= 'Graphics.Hgg.ThreeD.Browser')
-- * 'Graphics.Hgg.ThreeD.Browser.showBrowser' ─ tmp HTML + xdg-open (= 'Graphics.Hgg.ThreeD.Browser')
--
-- 同 spec を 3 経路に出し分けられる。 用途で使い分け:
--
-- * 印刷 / doc 埋込 → 'saveSVG3D'
-- * 配布 / 単一 HTML 配布 → 'Graphics.Hgg.ThreeD.Browser.saveHTML3D'
-- * 開発時 interactive 確認 → 'Graphics.Hgg.ThreeD.Browser.showBrowser'
-- [English]: Dispatch helpers from a 'VisualSpec3D' to each output path.
-- Three paths:
--
-- * 'saveSVG3D' ─ CPU projection (static SVG output, implemented here)
-- * 'Graphics.Hgg.ThreeD.Browser.saveHTML3D' ─ WebGL bundle embedded in HTML (see
-- 'Graphics.Hgg.ThreeD.Browser')
-- * 'Graphics.Hgg.ThreeD.Browser.showBrowser' ─ a tmp HTML file plus xdg-open (see
-- 'Graphics.Hgg.ThreeD.Browser')
--
-- The same spec can be routed to any of the three. Pick based on use case:
--
-- * printing / embedding in a doc → 'saveSVG3D'
-- * distribution as a single HTML file → 'Graphics.Hgg.ThreeD.Browser.saveHTML3D'
-- * interactive checking during development → 'Graphics.Hgg.ThreeD.Browser.showBrowser'
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Hgg.ThreeD.Easy
( saveSVG3D
-- * PDF / PNG 出力 (glue)
, savePDF3D
, savePNG3D
, spec3DToPrimitives
-- * 群別タイル配置
, saveSVG3DFacet
, renderSpec3DInPanel
-- * 正規化 pipeline (test 用に公開)
, padAxes3D
, normPoint3D
, normLayer3D
-- * 投影 contour (test 用に公開)
, renderProjectedContour3D
) where
import Data.List (nub, sortOn)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Monoid (First (..), Last (..))
import Data.Text (Text)
import qualified Data.Text as T
import Graphics.Hgg.Backend.SVG (savePrimitivesSVG)
import Graphics.Hgg.Backend.PDF (savePrimitivesPDF)
import Graphics.Hgg.Backend.Rasterific (savePrimitivesPNG, defaultPNGConfig)
import Graphics.Hgg.Render (FillStyle (..), Point (..),
Primitive (..), solid,
StrokeStyle (..),
TextAnchor (..),
TextStyle (..))
import Graphics.Hgg.Render.Common (continuousColor)
import Graphics.Hgg.Math.Griddata (innerLevels, marchingSegments)
import Graphics.Hgg.Layout (Rect (..))
import Graphics.Hgg.ThreeD.Axes (Axes3D (..),
defaultPaneStyle3D,
renderAxes3DPanes,
renderAxes3DWithLabels)
import Graphics.Hgg.ThreeD.Line (renderLine3D, renderWireframe3D,
renderQuiver3D)
import Graphics.Hgg.ThreeD.Projection (Projected (..), Viewport (..),
project3D)
import Graphics.Hgg.ThreeD.Scatter (scatterPointsDepth)
import Graphics.Hgg.ThreeD.Spec (Layer3D, Mark3DKind (..),
VisualSpec3D (..),
autoAxes3D, layerToLine,
layerToScatter, layerToQuiver,
layerToSurface, layerToBar,
layerToWireframe, lyr3Kind,
lyr3Color, lyr3Size,
lyr3Colormap, lyr3Colorbar,
lyr3Contours,
ContourDir (..),
lyr3Grid, lyr3Labels,
lyr3Legend,
lyr3Points, lyr3Annots,
lyr3XRange,
lyr3YRange, lyr3BarBaseZ,
lyr3Width, lyr3StemBaseZ,
lyr3Vectors, lyr3VecScale,
lyr3EdgeColor, lyr3Shaded,
lyr3Alpha,
lyr3PtErrs, viridisStops3D,
vs3Axes, vs3AxisTitles,
vs3Camera, vs3Height,
vs3Layers, vs3Log, vs3Pane,
vs3Proj, vs3Title,
vs3Width, vs3XAspect,
vs3YAspect, vs3ZAspect)
import qualified Data.Vector as V
import Graphics.Hgg.ThreeD.Surface (surfaceFacesDepth,
trianglesFacesDepth)
import Graphics.Hgg.ThreeD.Delaunay (delaunay2D)
import Graphics.Hgg.ThreeD.Bar (Bar3D (..), barFacesDepth,
renderBarSticks, renderStems3D,
renderErrorBars3D)
import Graphics.Hgg.ThreeD.Types
-- | [日本語]: 'VisualSpec3D' を CPU projection で SVG に保存。
--
-- defaults:
--
-- * camera → 'defaultCameraZUp' 3
-- * projection → 'defaultPerspective'
-- * axes → 'autoAxes3D' (= layers の Point3 集合から bbox 算出)
-- * width / height → 700 / 700
-- * title → ""
-- [English]: Saves a 'VisualSpec3D' as SVG via CPU projection.
--
-- Defaults:
--
-- * camera → 'defaultCameraZUp' 3
-- * projection → 'defaultPerspective'
-- * axes → 'autoAxes3D' (bbox computed from the layers' Point3 sets)
-- * width / height → 700 / 700
-- * title → ""
saveSVG3D :: FilePath -> VisualSpec3D -> IO ()
saveSVG3D path spec =
let (w, h, title, prims) = spec3DToPrimitives spec
in savePrimitivesSVG path w h title prims
-- | [日本語]: 'VisualSpec3D' を (幅, 高さ, タイトル, [Primitive]) に落とす
-- 共通核。 各 backend (SVG/PDF/PNG) の出力関数が共有する。 prims は
-- 'renderSpec3DInPanel' 単一 panel (= キャンバス全域)。 title は別返し
-- (SVG は backend が <text> 化・PDF/PNG は 'savePDF3D'/'savePNG3D' が PText 化)。
-- [English]: The shared core that reduces a 'VisualSpec3D' to
-- (width, height, title, [Primitive]), shared by each backend's (SVG /
-- PDF / PNG) output function. prims come from a single
-- 'renderSpec3DInPanel' panel (the whole canvas). title is returned
-- separately (the SVG backend turns it into @\<text\>@; PDF/PNG have
-- 'savePDF3D' / 'savePNG3D' turn it into a @PText@).
spec3DToPrimitives :: VisualSpec3D -> (Int, Int, Text, [Primitive])
spec3DToPrimitives spec =
let w = fromMaybe 700 (getLast (vs3Width spec))
h = fromMaybe 700 (getLast (vs3Height spec))
title = fromMaybe "" (getLast (vs3Title spec))
prims = renderSpec3DInPanel 0 0 (fromIntegral w) (fromIntegral h) spec
in (w, h, title, prims)
-- | [日本語]: 3D 図を PDF に保存 ('saveSVG3D' の PDF 版)。 [Primitive] を
-- 既存 PDF backend ('savePrimitivesPDF') へ配線。 title は上部中央の PText に
-- する (PDF backend は title 引数を持たないため)。 ⚠ PDF 標準フォントは
-- Latin-1 のみ (日本語ラベルは 'savePNG3D')。
-- [English]: Saves a 3D figure as PDF (the PDF counterpart of
-- 'saveSVG3D'). Wires @[Primitive]@ to the existing PDF backend
-- ('savePrimitivesPDF'). The title is turned into a top-centered 'PText'
-- (the PDF backend has no title argument). ⚠ PDF's standard fonts are
-- Latin-1 only (use 'savePNG3D' for Japanese labels).
savePDF3D :: FilePath -> VisualSpec3D -> IO ()
savePDF3D path spec =
let (w, h, title, prims) = spec3DToPrimitives spec
in savePrimitivesPDF path w h (titlePrims w title <> prims)
-- | [日本語]: 3D 図を PNG に保存 ('saveSVG3D' の PNG 版・日本語ラベル可)。
-- [Primitive] を既存 Rasterific backend ('savePrimitivesPNG') へ配線。
-- [English]: Saves a 3D figure as PNG (the PNG counterpart of
-- 'saveSVG3D'; supports Japanese labels). Wires @[Primitive]@ to the
-- existing Rasterific backend ('savePrimitivesPNG').
savePNG3D :: FilePath -> VisualSpec3D -> IO ()
savePNG3D path spec =
let (w, h, title, prims) = spec3DToPrimitives spec
in savePrimitivesPNG defaultPNGConfig path w h (titlePrims w title <> prims)
-- | [日本語]: タイトルを上部中央の PText に (空なら無し)。 SVG backend の title 描画
-- (font-size 16・中央・y≈24) に概ね合わせる。
-- [English]: Turns the title into a top-centered 'PText' (nothing if
-- empty). Roughly matches the SVG backend's title rendering (font-size
-- 16, centered, y≈24).
titlePrims :: Int -> Text -> [Primitive]
titlePrims w title
| T.null title = []
| otherwise =
[ PText (Point (fromIntegral w / 2) 24) title
(TextStyle "#333333" 16 "sans-serif" AnchorMiddle 0 "normal" False) ]
-- | [日本語]: 'VisualSpec3D' を__任意のパネル矩形__ @(px,py,pw,ph)@ 内に
-- 描画する純粋核 ('saveSVG3D' と 'saveSVG3DFacet' が共有)。 軸 box・正規化
-- pipeline・layer・colorbar をパネル局所座標で出す。 @(0,0,w,h)@ で呼ぶと
-- 旧 'saveSVG3D' とビット同一 (margin 50・colorbar 右端)。
-- [English]: The pure core that renders a 'VisualSpec3D' into
-- __an arbitrary panel rectangle__ @(px,py,pw,ph)@ (shared by 'saveSVG3D'
-- and 'saveSVG3DFacet'). Emits the axis box, normalization pipeline,
-- layers, and colorbar in panel-local coordinates. Calling it with
-- @(0,0,w,h)@ is bit-identical to the original 'saveSVG3D' (margin 50,
-- colorbar on the right edge).
renderSpec3DInPanel :: Double -> Double -> Double -> Double -> VisualSpec3D -> [Primitive]
renderSpec3DInPanel px py pw ph spec =
let layers = vs3Layers spec
cam = fromMaybe (defaultCameraZUp 3) (getLast (vs3Camera spec))
proj = fromMaybe defaultPerspective (getLast (vs3Proj spec))
-- Phase 25 A8: log scale flag を Axes3D に注入 (auto or user の bbox に上書き)。
-- normPoint3D / 軸 renderer / surface 正規化が ax の axes*Log を読む。
(lx, ly, lz) = fromMaybe (False, False, False) (getLast (vs3Log spec))
ax0 = padAxes3D (fromMaybe (autoAxes3D layers) (getLast (vs3Axes spec)))
ax = ax0 { axesXLog = lx, axesYLog = ly, axesZLog = lz }
-- Phase 24 A2: colormap 付き surface があれば右に colorbar を出す
-- (z range はその layer の grid 全体)。
-- Phase 25 A3: 連続色 scatter ('colorContinuousBy3D') の colorbar 情報
-- ('lyr3Colorbar' = resolve 産物) も同じ場所に出す (surface 優先で先頭採用)。
cbInfo = listToMaybe
( [ (stops, minimum zs, maximum zs)
| l <- layers
, getFirst (lyr3Kind l) == Just M3Surface
, Just stops <- [getLast (lyr3Colormap l)]
, Just grid <- [getLast (lyr3Grid l)]
, let zs = concat grid
, not (null zs) ]
++ [ cb | l <- layers, Just cb <- [getLast (lyr3Colorbar l)] ])
cbW = case cbInfo of { Just _ -> 70; Nothing -> 0 }
-- Phase 25 A2: 群色分けの離散凡例 (lyr3Legend・初出順で union)
legendEntries = nub (concatMap (fromMaybe [] . getLast . lyr3Legend) layers)
lgW = if null legendEntries then 0 else 100
m = 50 -- パネル内側 margin (colorbar/凡例 分は右を空ける)
vp = Viewport (px + m) (py + m) (pw - 2*m - cbW - lgW) (ph - 2*m)
-- Phase 24 A8 / 25 A8: box aspect (正規化後 x/y/z を各 a 倍) と軸名。
-- za は従来 (z のみ)、 Phase 25 A8 で x/y も追加 (既定 1 = 恒等)。
xa = fromMaybe 1 (getLast (vs3XAspect spec))
ya = fromMaybe 1 (getLast (vs3YAspect spec))
za = fromMaybe 1 (getLast (vs3ZAspect spec))
labels = fromMaybe ("x", "y", "z") (getLast (vs3AxisTitles spec))
applyAspect (Point3 x y z) = Point3 (x * xa) (y * ya) (z * za)
-- Phase 24 A8: 全 layer を正規化 + aspect した上で、 **surface 面と
-- scatter 点を層横断で 1 つの depth リストに混ぜて大域ソート** する
-- (= scatter 点が surface 膜を透ける問題の解消)。 床面 contour は床に
-- 固定なので先 (奥)、 line/wireframe は depth 統合せず後 (前) に描く。
scaled = map (scaleAspectLayer xa ya za . normLayer3D ax) layers
floorPrims = concatMap (renderProjectedContour3D (xa, ya, za) cam proj vp) scaled
depthItems = concatMap (depthItemsOf cam proj vp) scaled
otherPrims = concatMap (otherLayerPrims cam proj vp) scaled
errBarPrims = concatMap (errorBarPrimsOf cam proj vp) scaled -- Phase 25 A5
textPrims = concatMap (textPrimsOf cam proj vp) scaled -- Phase 25 A7
mergedDepth = map snd (sortOn (negate . fst) depthItems)
-- Phase 24 A3: データ座標を [-1,1]^3 に正規化してから投影する。
-- 既定 camera (距離 3-5) は単位スケール前提のため、 実データ
-- (z ≈ 80 等) をそのまま投影すると視界外になる。 軸ラベルは
-- 元のデータ値のまま ('renderAxes3DWithLabels')。 mplot3d の axes box 同型。
-- Phase 25 A6: 壁面 pane + gridline (既定 ON)。 cube wireframe より前 =
-- 最背面に置き、 データ・wireframe を pane の手前に出す。
paneOn = fromMaybe True (getLast (vs3Pane spec))
panePrims = if paneOn
then renderAxes3DPanes (applyAspect . normPoint3D ax)
defaultPaneStyle3D cam proj vp ax
else []
in panePrims
<> renderAxes3DWithLabels (applyAspect . normPoint3D ax) labels cam proj vp ax
<> floorPrims
<> mergedDepth
<> otherPrims
<> errBarPrims
<> textPrims
<> maybe [] (renderColorbar3D px py pw ph) cbInfo
<> renderLegend3D px py pw ph legendEntries
-- | [日本語]: 群色分けの離散凡例 (色チップ + ラベル) をパネル右端に縦並び。
-- colorbar があればその左、 無ければ右端。 entries = (カテゴリ, 色) の初出順。
-- [English]: Renders the discrete group-coloring legend (color chips plus
-- labels), stacked vertically along the panel's right edge. Sits left of
-- the colorbar if there is one, otherwise flush right. entries are
-- (category, color) pairs in first-occurrence order.
renderLegend3D :: Double -> Double -> Double -> Double -> [(Text, Text)] -> [Primitive]
renderLegend3D _ _ _ _ [] = []
renderLegend3D px py pw ph entries =
let chip = 12 :: Double
rowH = 20 :: Double
n = length entries
x0 = px + pw - 96
y0 = py + (ph - fromIntegral n * rowH) / 2
tsL = TextStyle "#333333" 11 "sans-serif" AnchorStart 0 "normal" False
row (i, (cat, col)) =
let y = y0 + fromIntegral i * rowH
in [ PRect (Rect x0 y chip chip)
(FillStyle col 1.0) (Just (StrokeStyle "#333333" 0.5))
, PText (Point (x0 + chip + 6) (y + chip - 2)) cat tsL ]
in concatMap row (zip [0 :: Int ..] entries)
-- | [日本語]: depth 統合対象 (surface 面・scatter 点) を @(depth, Primitive)@
-- で返す。 line/wireframe/floor は対象外 ([])。
-- [English]: Returns the depth-integration targets (surface faces,
-- scatter points) as @(depth, Primitive)@ pairs. line / wireframe / floor
-- are excluded (@[]@).
depthItemsOf :: Camera3D -> Projection3D -> Viewport -> Layer3D -> [(Double, Primitive)]
depthItemsOf cam proj vp l = case getFirst (lyr3Kind l) of
Just M3Surface -> surfaceFacesDepth cam proj vp (layerToSurface l)
Just M3Scatter -> scatterPointsDepth cam proj vp (layerToScatter l)
Just M3Bar -> barFacesDepth cam proj vp (layerToBar l) -- Phase 25 A5 (cuboid のみ)
-- Phase 26 A5: trisurf = 正規化済点群を (x,y) で Delaunay 三角分割し face を depth 統合
Just M3Trisurf ->
let pts = fromMaybe [] (getLast (lyr3Points l))
tris = delaunay2D [ (x, y) | Point3 x y _ <- pts ]
vpts = V.fromList pts
triPts = [ (vpts V.! a, vpts V.! b, vpts V.! c) | (a, b, c) <- tris ]
col = fromMaybe "#5b9bd5" (getLast (lyr3Color l))
ecol = fromMaybe "#3a73a6" (getLast (lyr3EdgeColor l))
shaded = fromMaybe True (getLast (lyr3Shaded l))
cmap = getLast (lyr3Colormap l)
alpha = fromMaybe 1 (getLast (lyr3Alpha l))
in trianglesFacesDepth cam proj vp col ecol shaded cmap alpha triPts
_ -> []
-- | [日本語]: depth 統合対象外の layer (line/wireframe・bar stick) を描く。
-- [English]: Draws the layers that are excluded from depth integration
-- (line / wireframe, bar sticks).
otherLayerPrims :: Camera3D -> Projection3D -> Viewport -> Layer3D -> [Primitive]
otherLayerPrims cam proj vp l = case getFirst (lyr3Kind l) of
Just M3Line -> renderLine3D cam proj vp (layerToLine l)
Just M3Wireframe -> renderWireframe3D cam proj vp (layerToWireframe l)
Just M3Bar -> renderBarSticks cam proj vp (layerToBar l) -- Phase 25 A5 (stick のみ)
-- Phase 26 A4: stem は細い垂線 + 先端マーカー (前面 overlay)。 線幅既定 2・
-- マーカー半径既定 5 (lyr3Width / lyr3Size で上書き可)。
Just M3Stem ->
let bar = (layerToBar l) { br3Width = fromMaybe 2 (getLast (lyr3Width l)) }
markerR = fromMaybe 5 (getLast (lyr3Size l))
in renderStems3D cam proj vp bar markerR
-- Phase 26 A3: 3D vector field (前面 overlay・投影後 2D 矢印)
Just M3Quiver -> renderQuiver3D cam proj vp (layerToQuiver l)
_ -> []
-- | [日本語]: 層の per-point err (正規化済) があれば誤差棒を描く (bar/scatter
-- 共通)。 頂点列は正規化済 'lyr3Points'。 最前面に描くため depth 統合外。
-- [English]: Draws error bars when a layer's per-point err (already
-- normalized) is present (shared by bar and scatter). Vertices come from
-- the already-normalized 'lyr3Points'. Drawn in front, outside depth
-- integration.
errorBarPrimsOf :: Camera3D -> Projection3D -> Viewport -> Layer3D -> [Primitive]
errorBarPrimsOf cam proj vp l =
case (getLast (lyr3PtErrs l), getLast (lyr3Points l)) of
(Just es, Just pts) | not (null es) ->
renderErrorBars3D cam proj vp "#333333" 1.0 (zip pts es)
_ -> []
-- | [日本語]: テキスト注釈 layer (M3Text) を描く。 正規化済 'lyr3Points' を
-- 投影し、 各点に 'lyr3Labels' の文字列を PText で置く (depth 統合外の前面 overlay)。
-- 文字色 = 'lyr3Color' (既定 @#333333@)、 サイズ = 'lyr3Size' (既定 11)。 点の
-- 少し上 (-6px) に中央寄せ。
-- [English]: Draws the text-annotation layer (M3Text). Projects the
-- already-normalized 'lyr3Points' and places each point's 'lyr3Labels'
-- string as a 'PText' (a front overlay outside depth integration). Text
-- color comes from 'lyr3Color' (default @#333333@), size from
-- 'lyr3Size' (default 11). Centered, slightly above each point (-6px).
textPrimsOf :: Camera3D -> Projection3D -> Viewport -> Layer3D -> [Primitive]
textPrimsOf cam proj vp l = case getFirst (lyr3Kind l) of
Just M3Text ->
let pts = fromMaybe [] (getLast (lyr3Points l))
lbs = fromMaybe [] (getLast (lyr3Labels l))
col = fromMaybe "#333333" (getLast (lyr3Color l))
sz = fromMaybe 11 (getLast (lyr3Size l))
ts = TextStyle col sz "sans-serif" AnchorMiddle 0 "normal" False
toScreen p = let Projected sx sy _ = project3D cam proj vp p in Point sx sy
place p t = let Point lx ly = toScreen p in PText (Point lx (ly - 6)) t ts
in zipWith place pts lbs
_ -> []
-- | [日本語]: 正規化済 layer を box aspect @(xa, ya, za)@ 倍する。
-- surface は grid z (za) と x/y range (xa/ya)、 それ以外は点列の各成分。
-- @(1,1,1)@ は恒等 (= 旧出力ビット不変)。 surface の grid x/y は xRange を縮める
-- ことで反映 (Surface.hs が xRange を線形補間して頂点を置くため)。
-- [English]: Scales an already-normalized layer by the box aspect
-- @(xa, ya, za)@. For a surface, this scales grid z (za) and the x/y
-- range (xa/ya); for other layers, each component of the point list.
-- @(1,1,1)@ is the identity (bit-identical to legacy output). A surface's
-- grid x/y is reflected by shrinking xRange (since Surface.hs places
-- vertices by linearly interpolating xRange).
scaleAspectLayer :: Double -> Double -> Double -> Layer3D -> Layer3D
scaleAspectLayer xa ya za l
| xa == 1 && ya == 1 && za == 1 = l
| otherwise = case getFirst (lyr3Kind l) of
Just M3Surface ->
l { lyr3Grid = Last (fmap (map (map (* za))) (getLast (lyr3Grid l)))
, lyr3XRange = Last (fmap (scaleRange xa) (getLast (lyr3XRange l)))
, lyr3YRange = Last (fmap (scaleRange ya) (getLast (lyr3YRange l)))
}
_ ->
-- Phase 25 A5: bar 底面 z・err (z 量) も同じ za で縮める
-- Phase 26 A3: quiver ベクトルも各成分を aspect 倍 (始点 + vec が aspect 後点と一致)
l { lyr3Points = Last (fmap (map sp) (getLast (lyr3Points l)))
, lyr3BarBaseZ = Last (fmap (* za) (getLast (lyr3BarBaseZ l)))
, lyr3PtErrs = Last (fmap (map (* za)) (getLast (lyr3PtErrs l)))
, lyr3Vectors = Last (fmap (map sv) (getLast (lyr3Vectors l)))
}
where sp (Point3 x y z) = Point3 (x * xa) (y * ya) (z * za)
sv (Vec3 vx vy vz) = Vec3 (vx * xa) (vy * ya) (vz * za)
scaleRange a (lo, hi) = (lo * a, hi * a)
-- | [日本語]: 群別 3D 図のタイル配置 (= 「群別曲面の並置」)。 N 個の
-- @(群ラベル, spec)@ を near-square グリッド (@ncol = ceil(√n)@) に並べ、 各
-- パネルを 'renderSpec3DInPanel' で描き、 上部に群ラベルを置く。 colorbar は
-- panel 毎 (各 spec の colormap surface に追従)。 camera/axes は各 spec が個別に
-- 持つ前提 (analyze の群別 @surfaceOf@ 出力をそのまま渡せる)。 1 パネルの
-- 既定サイズは 380×380 px (spec が @width3DV@/@height3DV@ を持てばそれを使う)。
-- [English]: Tiles a set of grouped 3D figures ("placing group surfaces
-- side by side"). Arranges N @(group label, spec)@ pairs into a
-- near-square grid (@ncol = ceil(√n)@), draws each panel with
-- 'renderSpec3DInPanel', and places the group label above it. The
-- colorbar is per-panel (following each spec's colormap surface).
-- camera / axes are assumed to belong to each spec individually (so
-- output from hanalyze's grouped @surfaceOf@ can be passed
-- straight through). Each panel defaults to 380×380 px (used unless the
-- spec sets @width3DV@/@height3DV@).
saveSVG3DFacet :: FilePath -> [(Text, VisualSpec3D)] -> IO ()
saveSVG3DFacet _ [] = pure ()
saveSVG3DFacet path panels = do
let n = length panels
ncol = ceiling (sqrt (fromIntegral n :: Double)) :: Int
nrow = (n + ncol - 1) `div` ncol
-- パネルサイズ = 先頭 spec の width/height (なければ 380)
panelW = fromIntegral (fromMaybe 380 (getLast (vs3Width (snd (head panels)))))
panelH = fromIntegral (fromMaybe 380 (getLast (vs3Height (snd (head panels))))) :: Double
wPx = round (panelW * fromIntegral ncol) :: Int
hPx = round (panelH * fromIntegral nrow) :: Int
tsLab = TextStyle "#333333" 13 "sans-serif" AnchorMiddle 0 "bold" False
panelPrims k (label, spec) =
let row = k `div` ncol
col = k `mod` ncol
px = fromIntegral col * panelW
py = fromIntegral row * panelH
lbl = PText (Point (px + panelW / 2) (py + 22)) label tsLab
in lbl : renderSpec3DInPanel px py panelW panelH spec
prims = concat (zipWith panelPrims [0 ..] panels)
savePrimitivesSVG path wPx hPx "" prims
-- | [日本語]: 退化した軸 (min == max) を ±0.5 に広げる (正規化の 0 割り防止)。
-- [English]: Widens a degenerate axis (min == max) to ±0.5 (prevents
-- division by zero during normalization).
padAxes3D :: Axes3D -> Axes3D
padAxes3D ax =
let pad lo hi | hi > lo = (lo, hi)
| otherwise = (lo - 0.5, lo + 0.5)
(x0, x1) = pad (axesXMin ax) (axesXMax ax)
(y0, y1) = pad (axesYMin ax) (axesYMax ax)
(z0, z1) = pad (axesZMin ax) (axesZMax ax)
in ax { axesXMin = x0, axesXMax = x1
, axesYMin = y0, axesYMax = y1
, axesZMin = z0, axesZMax = z1 }
-- | [日本語]: 軸 bbox を [-1,1]^3 へ写す正規化 (各軸独立)。 log 軸
-- ('axes*Log') は log10 空間で affine、 線形軸はそのまま affine。
-- [English]: Normalizes the axis bbox to @[-1,1]^3@ (each axis
-- independently). A log axis ('axes*Log') is affine in log10 space; a
-- linear axis is affine directly.
normPoint3D :: Axes3D -> Point3 -> Point3
normPoint3D ax (Point3 x y z) =
Point3 (normCoord (axesXLog ax) (axesXMin ax) (axesXMax ax) x)
(normCoord (axesYLog ax) (axesYMin ax) (axesYMax ax) y)
(normCoord (axesZLog ax) (axesZMin ax) (axesZMax ax) z)
-- | [日本語]: 1 軸の正規化 (log/線形)。 @[lo,hi]@ → @[-1,1]@。 log は値・端を
-- 1e-12 に clamp してから log10 空間で affine。
-- [English]: Normalizes a single axis (log or linear): @[lo,hi]@ to
-- @[-1,1]@. For log, values and endpoints are clamped to 1e-12 and then
-- made affine in log10 space.
normCoord :: Bool -> Double -> Double -> Double -> Double
normCoord isLog lo hi v
| isLog =
let lo' = logBase 10 (max 1e-12 lo)
hi' = logBase 10 (max 1e-12 hi)
v' = logBase 10 (max 1e-12 v)
in if hi' <= lo' then 0 else -1 + 2 * (v' - lo') / (hi' - lo')
| hi <= lo = 0
| otherwise = -1 + 2 * (v - lo) / (hi - lo)
-- | [日本語]: layer のデータを正規化座標に写す。 surface は grid の z と
-- x/y range、 それ以外は点列。 colormap の色は z 正規化に対して不変 (affine)。
-- [English]: Maps a layer's data into normalized coordinates. For a
-- surface, this is the grid's z and the x/y range; for other layers, the
-- point list. Colormap colors are invariant under z normalization
-- (it's affine).
normLayer3D :: Axes3D -> Layer3D -> Layer3D
normLayer3D ax l0 = case getFirst (lyr3Kind l) of
Just M3Surface ->
-- Phase 25 A8: surface の z は log-z 対応 (axesZLog)。 surface の x/y log は
-- 未対応 (grid x/y は xRange を線形補間する Surface.hs 都合)。
let nmz = normCoord (axesZLog ax) (axesZMin ax) (axesZMax ax)
in l { lyr3XRange = Last (Just (-1, 1))
, lyr3YRange = Last (Just (-1, 1))
, lyr3Grid = Last (fmap (map (map nmz)) (getLast (lyr3Grid l)))
}
kind ->
-- Phase 25 A5: 点に加え err (z 量・delta) と bar 底面 z も正規化する。
let zspan = axesZMax ax - axesZMin ax
zscale = if zspan <= 0 then 0 else 2 / zspan -- delta 用 (±err)
nmz v = if zspan <= 0 then 0 else -1 + 2 * (v - axesZMin ax) / zspan
clampN = max (-1) . min 1
l1 = l { lyr3Points = Last (fmap (map (normPoint3D ax)) (getLast (lyr3Points l)))
, lyr3PtErrs = Last (fmap (map (* zscale)) (getLast (lyr3PtErrs l)))
}
in case kind of
Just M3Bar -> l1 { lyr3BarBaseZ = Last (Just (clampN (nmz 0))) }
-- Phase 26 A4: stem は stemBaseZ (data 空間・既定 0) を正規化して底面に使う
Just M3Stem -> l1 { lyr3BarBaseZ = Last (Just (clampN (nmz (fromMaybe 0 (getLast (lyr3StemBaseZ l)))))) }
-- Phase 26 A3: quiver のベクトルは per-axis の affine 微分 (= 2/span) で正規化
-- (正規化は affine ゆえ norm(p+v)-norm(p) = v * 2/span)。
Just M3Quiver ->
let xspan = axesXMax ax - axesXMin ax
yspan = axesYMax ax - axesYMin ax
sx = if xspan <= 0 then 0 else 2 / xspan
sy = if yspan <= 0 then 0 else 2 / yspan
sz = zscale
nv (Vec3 vx vy vz) = Vec3 (vx * sx) (vy * sy) (vz * sz)
in l1 { lyr3Vectors = Last (fmap (map nv) (getLast (lyr3Vectors l))) }
_ -> l1
where
-- Phase 30 A6: inline 注釈 ('lyr3Annots') を持つ M3Text は、 正規化前に
-- lyr3Points/lyr3Labels へ materialize する (= 以降の正規化・renderer は無改修。
-- 列駆動 text3D は resolveLayer3D で既に lyr3Points/Labels が入るので annots は空)。
l = case (getFirst (lyr3Kind l0), lyr3Annots l0) of
(Just M3Text, annots@(_:_)) ->
l0 { lyr3Points = Last (Just (map fst annots))
, lyr3Labels = Last (Just (map snd annots)) }
_ -> l0
-- | [日本語]: パネル右端の縦 colorbar (gradient strip + min/mid/max ラベル)。
-- 2D の gradient bar 凡例と同じ 'continuousColor' 補間 = palette 整合。
-- パネル矩形 @(px,py,pw,ph)@ 局所座標で配置 (facet 対応)。
-- [English]: The vertical colorbar (a gradient strip plus min/mid/max
-- labels) along the panel's right edge, using the same 'continuousColor'
-- interpolation as the 2D gradient-bar legend (palette-consistent).
-- Positioned in panel-local coordinates @(px,py,pw,ph)@ (supports facets).
renderColorbar3D :: Double -> Double -> Double -> Double -> ([Text], Double, Double) -> [Primitive]
renderColorbar3D px py pw ph (stops, zMin, zMax) =
let barW = 14 :: Double
barH = ph * 0.45
x0 = px + pw - 58
y0 = py + (ph - barH) / 2
nStrip = 48 :: Int
stripH = barH / fromIntegral nStrip
strip k =
let t = fromIntegral k / fromIntegral (nStrip - 1)
-- t=1 (zMax) が上。 +0.5 はストライプ間の継ぎ目消し
y = y0 + barH - stripH * fromIntegral (k + 1)
in PRect (Rect x0 y barW (stripH + 0.5))
(FillStyle (continuousColor stops t) 1.0)
Nothing
ts = TextStyle "#444444" 9 "sans-serif" AnchorStart 0 "normal" False
tickAt v =
let t = if zMax <= zMin then 0.5 else (v - zMin) / (zMax - zMin)
in y0 + barH * (1 - t)
tick v = PText (Point (x0 + barW + 4) (tickAt v + 3)) (fmtNum3D v) ts
in map strip [0 .. nStrip - 1]
<> map tick [zMin, (zMin + zMax) / 2, zMax]
-- | [日本語]: tick 値の短い整形 (Axes3D の formatNum と同形)。
-- [English]: A compact formatting for tick values (the same shape as
-- Axes3D's formatNum).
fmtNum3D :: Double -> Text
fmtNum3D x =
let s = T.pack (show (fromIntegral (round (x * 10) :: Int) / 10.0 :: Double))
in T.dropWhileEnd (== '.') (T.dropWhileEnd (== '0') s)
-- | [日本語]: surface の contour を壁面へ投影する (matplotlib
-- @contour(..., zdir=)@ 相当)。 'lyr3Contours' の各 @(dir, n)@ を描く:
--
-- * 'ContourZ' (床) = z 等値面 level set @{f=z_k}@ を 'marchingSegments' で抽出し
-- floor へ落とす (topographic map)。
-- * 'ContourX' (左右壁) = x 軸の @n@ 位置で曲面を切り、 断面プロファイル
-- @z = f(x_k, y)@ を yz 壁へ描く。
-- * 'ContourY' (前後壁) = y 軸の @n@ 位置で断面 @z = f(x, y_k)@ を xz 壁へ描く。
--
-- 投影壁は __カメラから遠い面に自動固定__ (eye と target の各軸符号で min/max 面を選ぶ・
-- 曲面の手前に出て遮らないように)。 grid・aspect 正規化済 layer を受ける。 mpl の
-- rotate_axes 経路 (= dir⊥平面で切った断面を壁へ投影) を再現 (実測で数値突合済)。
-- [English]: Projects a surface's contour onto a wall (equivalent to
-- matplotlib's @contour(..., zdir=)@). Draws each @(dir, n)@ from
-- 'lyr3Contours':
--
-- * 'ContourZ' (floor) — extracts the z level-set contour @{f=z_k}@ via
-- 'marchingSegments' and drops it onto the floor (a topographic map).
-- * 'ContourX' (left/right wall) — slices the surface at @n@ positions
-- along x, drawing the cross-section profile @z = f(x_k, y)@ on the yz
-- wall.
-- * 'ContourY' (front/back wall) — draws the cross-section
-- @z = f(x, y_k)@ at @n@ positions along y on the xz wall.
--
-- The projection wall __auto-pins to the far face from the camera__
-- (chosen from the eye's and target's sign along each axis, so it never
-- gets in front of the surface and occludes it). Takes an
-- already grid- and aspect-normalized layer. Reproduces matplotlib's
-- rotate_axes path (projecting a cross-section cut perpendicular to
-- @dir@ onto the wall); verified numerically against it.
renderProjectedContour3D
:: (Double, Double, Double)
-> Camera3D -> Projection3D -> Viewport -> Layer3D -> [Primitive]
renderProjectedContour3D (xa, ya, za) cam proj vp l =
case lyr3Contours l of
[] -> []
cs ->
let grid = fromMaybe [] (getLast (lyr3Grid l))
ny = length grid
nx = case grid of { row : _ -> length row; [] -> 0 }
in if nx < 2 || ny < 2 then [] else
let (xMin, xMax) = fromMaybe (-1, 1) (getLast (lyr3XRange l)) -- cube [-xa, xa]
(yMin, yMax) = fromMaybe (-1, 1) (getLast (lyr3YRange l)) -- cube [-ya, ya]
xNodes = [ xMin + (xMax - xMin) * fromIntegral j / fromIntegral (nx - 1)
| j <- [0 .. nx - 1] ]
yNodes = [ yMin + (yMax - yMin) * fromIntegral i / fromIntegral (ny - 1)
| i <- [0 .. ny - 1] ]
allZ = concat grid
zmin = minimum allZ
zmax = maximum allZ
stops = fromMaybe viridisStops3D (getLast (lyr3Colormap l))
frac lo hi v = if hi <= lo then 0.5 else (v - lo) / (hi - lo)
colAt t = continuousColor stops (max 0 (min 1 t))
projPt p = let pr = project3D cam proj vp p in Point (projX pr) (projY pr)
polyline col pts = [ PLine (projPt p) (projPt q) (solid col 1.2)
| (p, q) <- zip pts (drop 1 pts) ]
-- 投影壁 = カメラから遠い面。 eye と target の各軸差の符号で min/max を選ぶ
-- (eye が +側なら −側の壁を使い、 曲面の奥に投影が回る)。
Point3 ex ey ez = cameraEye cam
Point3 tx ty tz = cameraTarget cam
farWall a e t = if e >= t then negate a else a
one (ContourZ, nLev) =
let offset = farWall za ez tz
levels = innerLevels nLev zmin zmax
drawLevel lv =
[ PLine (projPt (Point3 ax' ay offset)) (projPt (Point3 bx by offset))
(solid (colAt (frac zmin zmax lv)) 1.2)
| ((ax', ay), (bx, by)) <- marchingSegments xNodes yNodes grid lv ]
in if zmax <= zmin then [] else concatMap drawLevel levels
one (ContourX, nLev) =
-- x 軸を等分した位置で断面 z=f(x_k, y)。 各 y 行で grid を x 方向に補間。
let offset = farWall xa ex tx
section x0 =
polyline (colAt (frac xMin xMax x0))
[ Point3 offset (yNodes !! i) (interp1 xNodes (grid !! i) x0)
| i <- [0 .. ny - 1] ]
in concatMap section (innerLevels nLev xMin xMax)
one (ContourY, nLev) =
-- y 軸を等分した位置で断面 z=f(x, y_k)。 各 x 列で grid を y 方向に補間。
let offset = farWall ya ey ty
colZ j = [ (grid !! i) !! j | i <- [0 .. ny - 1] ]
section y0 =
polyline (colAt (frac yMin yMax y0))
[ Point3 (xNodes !! j) offset (interp1 yNodes (colZ j) y0)
| j <- [0 .. nx - 1] ]
in concatMap section (innerLevels nLev yMin yMax)
in concatMap one cs
-- | [日本語]: 1 次元線形補間。 @interp1 nodes vals p@ は昇順 @nodes@ 上の値 @vals@ を位置 @p@ で
-- 補間 (範囲外は端値で clamp・隣接 2 点で線形)。 断面 contour の grid 補間に使う。
-- [English]: 1D linear interpolation. @interp1 nodes vals p@ interpolates
-- the values @vals@ over ascending @nodes@ at position @p@ (out-of-range
-- is clamped to the endpoint value; linear between the two neighbors).
-- Used for grid interpolation in cross-section contours.
interp1 :: [Double] -> [Double] -> Double -> Double
interp1 nodes vals p = go (zip nodes vals)
where
go [] = 0
go [(_, v)] = v
go ((a, va) : rest@((b, vb) : _))
| p <= a = va
| p <= b = va + (vb - va) * (p - a) / (b - a)
| otherwise = go rest