hgg-pdf 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+193/−53 lines, 4 filesdep ~hgg-coredep ~hgg-framePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hgg-core, hgg-frame
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- hgg-pdf.cabal +3/−3
- src/Graphics/Hgg/Backend/PDF.hs +155/−49
- test/Spec.hs +30/−1
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog for `hgg-pdf` +## 0.2.0.0 — 2026-08-13++- Follows the hgg-core 0.2 coordinate generalization.+- Bilingual (English / Japanese) haddock.+ ## 0.1.0.0 — 2026-07-18 First public release on Hackage.
hgg-pdf.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hgg-pdf-version: 0.1.0.0+version: 0.2.0.0 extra-doc-files: CHANGELOG.md synopsis: PDF backend for hgg (HPDF) description:@@ -30,8 +30,8 @@ build-depends: base >= 4.17 && < 5 , text >= 2.0 && < 2.2 , HPDF >= 1.7 && < 1.9- , hgg-core ^>= 0.1- , hgg-frame ^>= 0.1+ , hgg-core ^>= 0.2+ , hgg-frame ^>= 0.2 default-language: Haskell2010 test-suite hgg-pdf-tests
src/Graphics/Hgg/Backend/PDF.hs view
@@ -1,22 +1,34 @@ -- | -- Module : Graphics.Hgg.Backend.PDF--- Description : ベクタ PDF backend (Phase 17、 HPDF)+-- Description : Vector PDF backend (HPDF) -- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda) -- License : BSD-3-Clause ----- plot-core の '[Primitive]' を HPDF (Graphics.PDF) の 'P.Draw' 命令に+-- [日本語]: plot-core の '[Primitive]' を HPDF (Graphics.PDF) の 'P.Draw' 命令に -- 解釈する (SVG backend と同じ Layer 1 構図)。 座標系は per-primitive で -- y 反転 (PDF = 左下原点 y 上向き / Primitive = SVG 系 左上原点 y 下向き。 -- global flip だと text が鏡像になるため per-primitive 変換)。 ----- ★v1 制約: フォントは PDF 標準 14 種 (Latin) のみ — 日本語ラベルは+-- [English]: Interprets plot-core's '[Primitive]' as HPDF (Graphics.PDF)+-- 'P.Draw' instructions (the same Layer 1 structure as the SVG backend). The+-- coordinate system is y-flipped per primitive (PDF has its origin at the+-- bottom-left with y pointing up, while Primitive uses the SVG convention —+-- origin top-left, y pointing down. A global flip would mirror text, so the+-- conversion is applied per primitive instead).+--+-- [日本語]: ★v1 制約: フォントは PDF 標準 14 種 (Latin) のみ — 日本語ラベルは -- 出せない (非 Latin-1 文字は警告 + @?@ 置換)。 日本語の受け皿は -- hgg-rasterific (PNG + TrueType)。+--+-- [English]: v1 constraint: only the 14 standard PDF fonts (Latin) are+-- available — Japanese labels cannot be rendered (non-Latin-1 characters+-- trigger a warning and are replaced with @?@). Japanese labels are handled+-- by hgg-rasterific (PNG + TrueType) instead. {-# LANGUAGE OverloadedStrings #-} module Graphics.Hgg.Backend.PDF ( -- * 通常 (Resolver 不要 = inline 列のみの図) savePDF- -- * Resolver 同伴 (= 'ColByName' を含む図)+ -- * Resolver 同伴 (= @ColByName@ を含む図) , savePDFWith -- * Phase 14 系: BoundPlot (df バインド済) を描画する , savePDFBound@@ -34,7 +46,9 @@ Transform (..), renderToPrimitives) import Graphics.Hgg.Spec (Resolver, VisualSpec, emptyResolver) import Graphics.Hgg.Validate (Severity (..), diagnosticSeverity,- renderDiagnostic)+ renderDiagnostic,+ reportFacetInlineWarnings,+ reportTernaryMarkWarnings) import Data.Char (digitToInt, isHexDigit) import Data.Complex (Complex ((:+))) import Data.Text (Text)@@ -46,14 +60,22 @@ -- 入口 (SVG backend の saveSVG / saveSVGWith / saveSVGBound と対称) -- =========================================================================== --- | PDF ファイルに保存。 Resolver 不要 (= inline 列のみの図、 = 通常)。--- 列名参照を含む図は 'savePDFWith'、 DataFrame は 'savePDFBound' (@df |>> spec@)。+-- | [日本語]: PDF ファイルに保存。 Resolver 不要 (= inline 列のみの図、 = 通常)。+-- 列名参照を含む図は 'savePDFWith'、 DataFrame は 'savePDFBound' (@df |>> spec@)。+-- [English]: Saves to a PDF file. No 'Resolver' needed (figures with+-- inline columns only — the usual case). For figures with column-name+-- references use 'savePDFWith'; for a DataFrame use 'savePDFBound'+-- (@df |>> spec@). savePDF :: FilePath -> VisualSpec -> IO () savePDF path = savePDFWith path emptyResolver --- | 'Resolver' を渡して PDF ファイルに保存。 'ColByName' を含む図用。+-- | [日本語]: 'Resolver' を渡して PDF ファイルに保存。 @ColByName@ を含む図用。+-- [English]: Saves to a PDF file given a 'Resolver'. For figures that+-- include @ColByName@. savePDFWith :: FilePath -> Resolver -> VisualSpec -> IO () savePDFWith path r spec = do+ reportFacetInlineWarnings r spec -- ★ Phase 62 A4 (§3): 描画は継続+ reportTernaryMarkWarnings r spec -- Phase 64 A13: coordTernary unsupported mark -- ★ Phase 33 B5: PDF は point ネイティブ (PDFRect 単位 = pt) ゆえ k=1。layout/prims -- は純 pt なので scalePrimitives 不要 (恒等)・viewport pt をそのまま頁サイズに。 -- raster backend のような dpi 乗算をするとサイズが二重変換になるので禁止。@@ -62,9 +84,13 @@ ViewportSize w h = lpViewport layout savePrimitivesPDF path w h prims --- | Phase 24 A8: [Primitive] 列を所与のキャンバスサイズで PDF に直接描画する--- 低レベル経路 ('savePrimitivesSVG' の PDF 版)。 2D の 'savePDFWith' と 3D の--- 'savePDF3D' が共有。 非 Latin-1 ラベルは警告 + @?@ 置換 (v1 制約)。+-- | [日本語]: [Primitive] 列を所与のキャンバスサイズで PDF に直接描画する+-- 低レベル経路 (@savePrimitivesSVG@ の PDF 版)。 2D の 'savePDFWith' と 3D の+-- @savePDF3D@ が共有。 非 Latin-1 ラベルは警告 + @?@ 置換 (v1 制約)。+-- [English]: A low-level path that draws a list of Primitives directly to+-- PDF at a given canvas size (the PDF counterpart of @savePrimitivesSVG@).+-- Shared by 2D's 'savePDFWith' and 3D's @savePDF3D@. Non-Latin-1 labels+-- trigger a warning and are replaced with @?@ (v1 constraint). savePrimitivesPDF :: FilePath -> Int -> Int -> [Primitive] -> IO () savePrimitivesPDF path w h prims = do let (wD, hD) = (fromIntegral w, fromIntegral h)@@ -74,9 +100,12 @@ page <- P.addPage Nothing P.drawWithPage page (drawPrims fonts hD prims) --- | v1 制約の loud 化: 非 Latin-1 文字を含むラベルがあれば stderr に 1 回警告--- (描画では @?@ に置換される)。 日本語ラベルは PNG backend--- (hgg-rasterific) を使う。+-- | [日本語]: v1 制約の loud 化: 非 Latin-1 文字を含むラベルがあれば stderr に 1 回警告+-- (描画では @?@ に置換される)。 日本語ラベルは PNG backend+-- (hgg-rasterific) を使う。+-- [English]: Makes the v1 constraint loud: if a label contains non-Latin-1+-- characters, warns once on stderr (rendering replaces them with @?@).+-- Use the PNG backend (hgg-rasterific) for Japanese labels. warnNonLatin :: [Primitive] -> IO () warnNonLatin prims | any hasNonLatin prims =@@ -89,9 +118,12 @@ hasNonLatin (PText _ s _) = T.any (> '\xFF') s hasNonLatin _ = False --- | 'BoundPlot' (= @df |>> spec@ の結果) を PDF ファイルに保存。--- Error severity の検証診断は stderr に報告してから書き出す--- (saveSVGBound と同じ lenient 既定)。+-- | [日本語]: 'BoundPlot' (= @df |>> spec@ の結果) を PDF ファイルに保存。+-- Error severity の検証診断は stderr に報告してから書き出す+-- (saveSVGBound と同じ lenient 既定)。+-- [English]: Saves a 'BoundPlot' (the result of @df |>> spec@) to a PDF+-- file. Reports error-severity validation diagnostics to stderr before+-- writing the file (the same lenient default as saveSVGBound). savePDFBound :: FilePath -> BoundPlot -> IO () savePDFBound path (BoundPlot r spec diags) = do mapM_ (hPutStrLn stderr . T.unpack . renderDiagnostic)@@ -102,12 +134,21 @@ -- Primitive 解釈器 -- =========================================================================== --- | Primitive 列を順に描く。 第 1 引数 = viewport 高さ (y 反転用)。+-- | [日本語]: Primitive 列を順に描く。 第 1 引数 = viewport 高さ (y 反転用)。 ----- PClipPush/PTransformPush は対応する Pop までを**再帰グルーピング**して--- 'P.withNewContext' に入れる (PDF の clip / CTM は graphics state 復元で--- しか戻せないため。 SVG backend は \<g\> 開閉で済むのと対照的)。--- 対応の取れない Pop は黙って無視 (SVG backend と同じ寛容さ)。+-- PClipPush/PTransformPush は対応する Pop までを__再帰グルーピング__して+-- 'P.withNewContext' に入れる (PDF の clip / CTM は graphics state 復元で+-- しか戻せないため。 SVG backend は \<g\> 開閉で済むのと対照的)。+-- 対応の取れない Pop は黙って無視 (SVG backend と同じ寛容さ)。+--+-- [English]: Draws the list of Primitives in order. The first argument is+-- the viewport height (used for the y flip).+--+-- PClipPush/PTransformPush __recursively groups__ everything up to the+-- matching Pop and wraps it in 'P.withNewContext' (because PDF clip / CTM+-- can only be undone by restoring the graphics state — unlike the SVG+-- backend, which just opens and closes a \<g\>). An unmatched Pop is+-- silently ignored (the same leniency as the SVG backend). drawPrims :: StdFonts -> Double -> [Primitive] -> P.Draw () drawPrims fonts h = go where@@ -118,6 +159,13 @@ clipRectOf h rect go inner go after+ -- Phase 64 §2: 多角形 clip。 矩形と同じく Pop までを withNewContext で囲う。+ go (PClipPath pts : rest) =+ let (inner, after) = breakMatch isClipPush isClipPop rest+ in do P.withNewContext $ do+ clipPolyOf h pts+ go inner+ go after go (PTransformPush tr : rest) = let (inner, after) = breakMatch isTrPush isTrPop rest in do P.withNewContext $ do@@ -128,13 +176,18 @@ go (PTransformPop : rest) = go rest go (p : rest) = drawOne fonts h p >> go rest - isClipPush p = case p of { PClipPush _ -> True; _ -> False }+ -- clip push は矩形版 / 多角形版の 2 種。 入れ子の数え上げでは同じ「push」 扱い。+ isClipPush p = case p of { PClipPush _ -> True; PClipPath _ -> True; _ -> False } isClipPop p = case p of { PClipPop -> True; _ -> False } isTrPush p = case p of { PTransformPush _ -> True; _ -> False } isTrPop p = case p of { PTransformPop -> True; _ -> False } --- | 同種 push の入れ子を数えながら、 対応する pop までの内側と残りに割る。--- 対応 pop が無ければ全部内側 (= 末尾まで clip が効く・SVG の開きっ放しと同義)。+-- | [日本語]: 同種 push の入れ子を数えながら、 対応する pop までの内側と残りに割る。+-- 対応 pop が無ければ全部内側 (= 末尾まで clip が効く・SVG の開きっ放しと同義)。+-- [English]: Counts nested pushes of the same kind and splits the list+-- into the inner part (up to the matching pop) and the rest. If there is+-- no matching pop, everything is treated as inner (the clip stays in+-- effect to the end — the same as SVG leaving it open). breakMatch :: (Primitive -> Bool) -> (Primitive -> Bool) -> [Primitive] -> ([Primitive], [Primitive]) breakMatch isPush isPop = walk (0 :: Int)@@ -147,7 +200,9 @@ (inner, after) = walk n' rest in (p : inner, after) --- | 単独 primitive の描画。 push/pop は 'drawPrims' が先に消費する。+-- | [日本語]: 単独 primitive の描画。 push/pop は 'drawPrims' が先に消費する。+-- [English]: Draws a single primitive. push/pop are consumed beforehand by+-- 'drawPrims'. drawOne :: StdFonts -> Double -> Primitive -> P.Draw () drawOne _ h (PLine a b ls) = drawLine h a b ls drawOne _ h (PRect rect fs ms) = drawRect h rect fs ms@@ -156,24 +211,51 @@ drawOne fonts h (PText p s ts) = drawTextPrim fonts h p s ts drawOne _ _ _ = pure () --- | 矩形 clip: 矩形 path を current path にして 'P.setAsClipPath'。+-- | [日本語]: 矩形 clip: 矩形 path を current path にして 'P.setAsClipPath'。+-- [English]: Rectangular clip: sets the rectangle path as the current path+-- and calls 'P.setAsClipPath'. clipRectOf :: Double -> Rect -> P.Draw () clipRectOf h (Rect x y w rh) = do P.addShape (P.Rectangle (x :+ (h - y - rh)) ((x + w) :+ (h - y))) P.setAsClipPath --- | SVG 系 Transform → PDF Matrix。 y 反転 F (y↦h−y) は per-primitive に--- 掛かるため、 SVG 空間の変換 M は **F∘M∘F (共役)** で PDF 空間に写す:--- translate (dx,dy) → translate (dx,−dy) / scale (sx,sy) →--- translate (0, h(1−sy)) ∘ scale (sx,sy)。 ※現状 core は PTransformPush を--- 発行しない (SVG backend も未対応) — 将来の発行に備えた整合実装。+-- | [日本語]: 多角形 clip: 頂点列を path にして閉じ、 'P.setAsClipPath'。+-- 3 点未満は path を作らず何もしない (= clip 無しで素通し。 'PClipPath' の規約)。+-- [English]: Polygon clip: builds a closed path from the vertices and calls+-- 'P.setAsClipPath'. Fewer than 3 vertices builds no path and does nothing+-- (pass-through with no clip — the 'PClipPath' contract).+clipPolyOf :: Double -> [Point] -> P.Draw ()+clipPolyOf h pts+ | length pts < 3 = pure ()+ | otherwise = do+ case pts of+ (p0 : rest) -> P.beginPath (pdfPt h p0)+ >> mapM_ (P.addLineToPath . pdfPt h) rest+ [] -> pure ()+ P.closePath+ P.setAsClipPath++-- | [日本語]: SVG 系 Transform → PDF Matrix。 y 反転 F (y↦h−y) は per-primitive に+-- 掛かるため、 SVG 空間の変換 M は __F∘M∘F (共役)__ で PDF 空間に写す:+-- translate (dx,dy) → translate (dx,−dy) / scale (sx,sy) →+-- translate (0, h(1−sy)) ∘ scale (sx,sy)。 ※現状 core は PTransformPush を+-- 発行しない (SVG backend も未対応) — 将来の発行に備えた整合実装。+-- [English]: Converts an SVG-style Transform to a PDF Matrix. Since the y+-- flip F (y↦h−y) is applied per primitive, the SVG-space transform M is+-- mapped to PDF space as __F∘M∘F (conjugation)__: translate (dx,dy) →+-- translate (dx,−dy); scale (sx,sy) → translate (0, h(1−sy)) ∘+-- scale (sx,sy). Note: core currently never emits PTransformPush (nor does+-- the SVG backend support it) — this is a consistent implementation kept+-- ready for when it eventually does. matrixOf :: Double -> Transform -> P.Matrix matrixOf _ (TranslateT dx dy) = P.translate (dx :+ negate dy) matrixOf h (ScaleT sx sy) = P.translate (0 :+ (h * (1 - sy))) * P.scale sx sy --- | パス: MoveTo/LineTo/CurveTo/ClosePath を HPDF path 命令に写して--- fill / stroke / 両方 を塗り分ける。+-- | [日本語]: パス: MoveTo/LineTo/CurveTo/ClosePath を HPDF path 命令に写して+-- fill / stroke / 両方 を塗り分ける。+-- [English]: Path: maps MoveTo/LineTo/CurveTo/ClosePath to HPDF path+-- instructions, painting fill, stroke, or both accordingly. drawPath :: Double -> [PathSegment] -> FillStyle -> Maybe StrokeStyle -> P.Draw () drawPath _ [] _ _ = pure ()@@ -205,11 +287,15 @@ applyStroke (Just (StrokeStyle sc sw)) = P.strokeColor (colorOf sc) >> P.setWidth sw --- | SVG 系座標 (左上原点 y 下) → PDF 座標 (左下原点 y 上)。+-- | [日本語]: SVG 系座標 (左上原点 y 下) → PDF 座標 (左下原点 y 上)。+-- [English]: Converts SVG-style coordinates (origin top-left, y down) to+-- PDF coordinates (origin bottom-left, y up). pdfPt :: Double -> Point -> P.Point pdfPt h (Point x y) = x :+ (h - y) --- | 線分: 色/幅/破線を設定して stroke。+-- | [日本語]: 線分: 色/幅/破線を設定して stroke。+-- [English]: Line segment: sets color, width and dash pattern, then+-- strokes. drawLine :: Double -> Point -> Point -> LineStyle -> P.Draw () drawLine h a b (LineStyle col w dash) = P.withNewContext $ do P.strokeColor (colorOf col)@@ -219,20 +305,26 @@ P.addLineToPath (pdfPt h b) P.strokePath --- | 矩形: fill (+ 任意 stroke)。 'Rect' は左上基準なので下端 = y + h 側。+-- | [日本語]: 矩形: fill (+ 任意 stroke)。 'Rect' は左上基準なので下端 = y + h 側。+-- [English]: Rectangle: fill (+ optional stroke). 'Rect' is anchored at+-- the top-left, so its bottom edge is at y + h. drawRect :: Double -> Rect -> FillStyle -> Maybe StrokeStyle -> P.Draw () drawRect h (Rect x y w rh) fs ms = P.withNewContext $ do let shape = P.Rectangle (x :+ (h - y - rh)) ((x + w) :+ (h - y)) fillShape shape fs ms --- | 円: fill (+ 任意 stroke)。 hover label は PDF では捨てる。+-- | [日本語]: 円: fill (+ 任意 stroke)。 hover label は PDF では捨てる。+-- [English]: Circle: fill (+ optional stroke). The hover label is dropped+-- in PDF output. drawCircle :: Double -> Point -> Double -> FillStyle -> Maybe StrokeStyle -> P.Draw () drawCircle h (Point cx cy) rad fs ms = P.withNewContext $ do let shape = P.Circle cx (h - cy) rad fillShape shape fs ms --- | Shape 共通: FillStyle (色 + opacity) で塗り、 StrokeStyle があれば縁取る。+-- | [日本語]: Shape 共通: FillStyle (色 + opacity) で塗り、 StrokeStyle があれば縁取る。+-- [English]: Common to all shapes: paints with FillStyle (color ++-- opacity), and outlines with StrokeStyle if present. fillShape :: P.Shape a => a -> FillStyle -> Maybe StrokeStyle -> P.Draw () fillShape shape (FillStyle col opa) ms = do if col == "none"@@ -248,17 +340,23 @@ P.setWidth sw P.stroke shape --- | LineStyle の dash 配列 (px) → HPDF DashPattern。 空 = 実線。+-- | [日本語]: LineStyle の dash 配列 (px) → HPDF DashPattern。 空 = 実線。+-- [English]: Converts LineStyle's dash array (px) to an HPDF DashPattern.+-- An empty array means a solid line. setDashOf :: [Double] -> P.Draw () setDashOf [] = P.setNoDash setDashOf dash = P.setDash (P.DashPattern dash 0) -- ===========================================================================--- テキスト (Phase 17 A3) — PDF 標準フォント (Latin のみ・v1 制約)+-- テキスト — PDF 標準フォント (Latin のみ・v1 制約) -- =========================================================================== --- | 標準フォント束 (3 family × 4 変種)。 'mkStdFont' は AFM parse を伴う IO--- なので savePDF 入口で 1 回 load して 'P.Draw' 解釈器に渡す。+-- | [日本語]: 標準フォント束 (3 family × 4 変種)。 @mkStdFont@ は AFM parse を伴う IO+-- なので savePDF 入口で 1 回 load して 'P.Draw' 解釈器に渡す。+-- [English]: The bundle of standard fonts (3 families × 4 variants).+-- Since @mkStdFont@ is an IO action that parses AFM data, it is loaded+-- once at the savePDF entry point and passed into the 'P.Draw'+-- interpreter. data StdFonts = StdFonts { sfSans :: (P.AnyFont, P.AnyFont, P.AnyFont, P.AnyFont) -- ^ Helvetica (regular, bold, oblique, bold-oblique)@@ -285,8 +383,11 @@ <*> load4 (P.Courier, P.Courier_Bold, P.Courier_Oblique, P.Courier_BoldOblique) --- | family ("serif" / "monospace" 系は対応 family、 他は Helvetica) +--- weight/italic で 12 変種から選ぶ。+-- | [日本語]: family ("serif" / "monospace" 系は対応 family、 他は Helvetica) ++-- weight/italic で 12 変種から選ぶ。+-- [English]: Selects one of 12 variants by family ("serif" / "monospace"+-- families map to their counterpart, everything else falls back to+-- Helvetica) combined with weight/italic. selectFont :: StdFonts -> Text -> Text -> Bool -> P.AnyFont selectFont fonts fam weight italic = let (r, b, o, bo)@@ -299,9 +400,14 @@ (False, True) -> o (False, False) -> r --- | PText: anchor は 'P.textWidth' (AFM metrics) で x 補正、 tsRotate--- (degrees CW・SVG 同義) は (x,y) 周りの回転 = PDF (y 上向き) では符号反転。--- 非 Latin-1 文字は @?@ 置換 (警告は 'warnNonLatin' が IO 側で 1 回出す)。+-- | [日本語]: PText: anchor は 'P.textWidth' (AFM metrics) で x 補正、 tsRotate+-- (degrees CW・SVG 同義) は (x,y) 周りの回転 = PDF (y 上向き) では符号反転。+-- 非 Latin-1 文字は @?@ 置換 (警告は 'warnNonLatin' が IO 側で 1 回出す)。+-- [English]: PText: adjusts x for the anchor using 'P.textWidth' (AFM+-- metrics). tsRotate (degrees CW, matching SVG) is a rotation around+-- (x,y); since PDF has y pointing up, its sign is flipped. Non-Latin-1+-- characters are replaced with @?@ (the warning is emitted once by+-- 'warnNonLatin' on the IO side). drawTextPrim :: StdFonts -> Double -> Point -> Text -> TextStyle -> P.Draw () drawTextPrim fonts h (Point x y) txt ts = P.withNewContext $ do let anyf = selectFont fonts (tsFamily ts) (tsWeight ts) (tsItalic ts)@@ -322,7 +428,7 @@ else do P.applyMatrix (P.translate (x :+ (h - y))) -- Phase 50 A1: 内部 tsRotate は CCW 正 (canonical)。 PDF/PostScript は y-up で CCW 正- -- ゆえ **恒等** で渡す (旧: CW canonical を negate していた。 canonical CCW 化で解消)。+ -- ゆえ __恒等__ で渡す (旧: CW canonical を negate していた。 canonical CCW 化で解消)。 P.applyMatrix (P.rotate (P.Degree (tsRotate ts))) P.drawText $ do P.setFont font
test/Spec.hs view
@@ -4,8 +4,11 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Graphics.Hgg.Backend.PDF (savePDF)+import Graphics.Hgg.Backend.PDF (savePDF, savePrimitivesPDF) import Graphics.Hgg.Easy+import Graphics.Hgg.Layout (Rect (..))+import Graphics.Hgg.Render (FillStyle (..), Point (..),+ Primitive (..)) import qualified Data.ByteString.Char8 as BS import System.Directory (getTemporaryDirectory, removeFile) import System.FilePath ((</>))@@ -50,6 +53,32 @@ spec = layer (line (inline [1, 2, 3, 4]) (inline [2, 4, 1, 3])) <> coordCartesianX 1.5 3.5 savePDF path spec+ bs <- BS.readFile path+ BS.take 5 bs `shouldBe` "%PDF-"+ removeFile path++ describe "Phase 64 A7: PClipPath (多角形 clip)" $ do+ -- PDF は content stream が圧縮され得るので描画結果の byte 検査はせず、+ -- 「例外なく書ける + 中身が非自明」 を固定する (このファイル冒頭の方針)。+ it "三角形 clip が例外なく書ける" $ do+ tmp <- getTemporaryDirectory+ let path = tmp </> "hgg-pdf-test-clippath.pdf"+ prims = [ PClipPath [Point 100 20, Point 180 180, Point 20 180]+ , PRect (Rect 0 0 200 200) (FillStyle "#ff0000" 1) Nothing+ , PClipPop ]+ savePrimitivesPDF path 200 200 prims+ bs <- BS.readFile path+ BS.take 5 bs `shouldBe` "%PDF-"+ BS.length bs `shouldSatisfy` (> 500)+ removeFile path++ it "頂点 3 点未満 (退化) でも例外なく書ける (clip 無しで素通し)" $ do+ tmp <- getTemporaryDirectory+ let path = tmp </> "hgg-pdf-test-clippath-degenerate.pdf"+ prims = [ PClipPath [Point 10 10, Point 20 20]+ , PRect (Rect 0 0 200 200) (FillStyle "#ff0000" 1) Nothing+ , PClipPop ]+ savePrimitivesPDF path 200 200 prims bs <- BS.readFile path BS.take 5 bs `shouldBe` "%PDF-" removeFile path