hgg-rasterific (empty) → 0.1.0.0
raw patch · 5 files changed
+648/−0 lines, 5 filesdep +FontyFruitydep +JuicyPixelsdep +Rasterific
Dependencies added: FontyFruity, JuicyPixels, Rasterific, base, bytestring, directory, filepath, hgg-core, hgg-frame, hgg-rasterific, hspec, text
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- hgg-rasterific.cabal +57/−0
- src/Graphics/Hgg/Backend/Rasterific.hs +440/−0
- test/Spec.hs +114/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for `hgg-rasterific`++## 0.1.0.0 — 2026-07-18++First public release on Hackage.++- PNG backend (Rasterific + FontyFruity TrueType; Japanese labels supported).
+ LICENSE view
@@ -0,0 +1,30 @@+BSD 3-Clause License++Copyright (c) 2026, Toshiaki Honda+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ hgg-rasterific.cabal view
@@ -0,0 +1,57 @@+cabal-version: 3.0+name: hgg-rasterific+version: 0.1.0.0+extra-doc-files: CHANGELOG.md+synopsis: PNG backend for hgg (Rasterific + JuicyPixels)+description:+ Raster PNG backend for hgg. Interprets the [Primitive] list from+ hgg-core with Rasterific (a pure-Haskell rasterizer, BSD-3) and encodes+ PNG via JuicyPixels, in the same single-pass architecture as the+ SVG / PDF backends. Fonts are loaded from TrueType files via+ FontyFruity, so CJK labels are fully supported (complementing the+ Latin-only PDF backend).+license: BSD-3-Clause+homepage: https://github.com/frenzieddoll/hgg+license-file: LICENSE+author: Toshiaki Honda+maintainer: frenzieddoll@gmail.com+copyright: 2026 Aelysce Project (Toshiaki Honda)+category: Graphics+build-type: Simple++common warnings+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wpartial-fields+ -Wredundant-constraints++library+ import: warnings+ exposed-modules: Graphics.Hgg.Backend.Rasterific+ hs-source-dirs: src+ build-depends: base >= 4.17 && < 5+ , directory >= 1.3 && < 1.4+ , filepath >= 1.4 && < 1.6+ , text >= 2.0 && < 2.2+ , FontyFruity >= 0.5.3 && < 0.6+ , JuicyPixels >= 3.3 && < 3.4+ , Rasterific >= 0.7.5 && < 0.8+ , hgg-core ^>= 0.1+ , hgg-frame ^>= 0.1+ default-language: Haskell2010++test-suite hgg-rasterific-tests+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ default-language: Haskell2010+ build-depends: base+ , bytestring+ , directory+ , filepath+ , hspec >= 2.10 && < 2.12+ , text+ , FontyFruity+ , JuicyPixels+ , hgg-core+ , hgg-rasterific
+ src/Graphics/Hgg/Backend/Rasterific.hs view
@@ -0,0 +1,440 @@+-- |+-- Module : Graphics.Hgg.Backend.Rasterific+-- Description : raster PNG backend (Phase 22、 Rasterific + FontyFruity)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- plot-core の '[Primitive]' を Rasterific の 'R.Drawing' 命令に解釈して+-- JuicyPixels で PNG エンコードする (SVG/PDF backend と同じ Layer 1 構図)。+-- Rasterific は y 下向き (SVG 同系) なので **y 反転は不要** (PDF と対照的)。+--+-- フォントは FontyFruity の TrueType 読込 = **日本語ラベル対応**+-- (PDF v1 制約の受け皿)。 探索は fontconfig 非依存の固定候補リスト+-- (明示 'pngFontPath' → 既知ディレクトリ × 既知ファイル名)。+-- ★FontyFruity は .ttc (TrueType Collection) / CFF 系 OTF 非対応 —+-- 見つからない時は探索パスを列挙して loud エラー。+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Backend.Rasterific+ ( -- * 通常 (Resolver 不要 = inline 列のみの図)+ savePNG+ -- * Resolver 同伴 (= 'ColByName' を含む図)+ , savePNGWith+ -- * Phase 14 系: BoundPlot (df バインド済) を描画する+ , savePNGBound+ -- * 設定付き (フォント明示 / Hi-DPI)+ , savePNGConfigured+ , PNGConfig (..)+ , defaultPNGConfig+ -- * 低レベル: [Primitive] を直接描画 (Phase 24 A8・3D backend glue 用)+ , savePrimitivesPNG+ -- * フォント解決 (診断 / テスト用)+ , PNGFonts (..)+ , loadPNGFonts+ ) where++import Graphics.Hgg.Frame (BoundPlot (..))+import Graphics.Hgg.Layout (Layout (..), Rect (..),+ ViewportSize (..), computeLayout)+import Graphics.Hgg.Render (FillStyle (..), LineStyle (..),+ PathSegment (..), Point (..),+ Primitive (..), StrokeStyle (..),+ TextAnchor (..), TextStyle (..),+ Transform (..), renderToPrimitives,+ scalePrimitives)+import Graphics.Hgg.Spec (Resolver, VisualSpec, emptyResolver,+ vsDpi)+import Data.Monoid (getLast)+import Graphics.Hgg.Validate (Severity (..), diagnosticSeverity,+ renderDiagnostic)+import Codec.Picture (PixelRGBA8 (..), writePng)+import Data.Char (digitToInt, isHexDigit, toLower)+import Data.List (intercalate)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Graphics.Rasterific as R+import qualified Graphics.Rasterific.Texture as RT+import qualified Graphics.Rasterific.Transformations as RTr+import qualified Graphics.Text.TrueType as F+import System.Directory (doesDirectoryExist, doesFileExist,+ getHomeDirectory, listDirectory)+import System.FilePath (takeExtension, (</>))+import System.IO (hPutStrLn, stderr)++-- ===========================================================================+-- 設定+-- ===========================================================================++-- | PNG 出力設定。 'defaultPNGConfig' から record update で部分指定する。+data PNGConfig = PNGConfig+ { pngFontPath :: Maybe FilePath+ -- ^ regular TTF の明示指定 (最優先)。 Nothing = 候補リスト探索+ , pngFontPathBold :: Maybe FilePath+ -- ^ bold TTF。 Nothing = bold 候補探索 → 無ければ regular で代替+ , pngScale :: Double+ -- ^ Hi-DPI 倍率 (既定 1.0 = SVG と同 pixel 寸法)。 2.0 で縦横 2 倍+ } deriving (Show, Eq)++defaultPNGConfig :: PNGConfig+defaultPNGConfig = PNGConfig+ { pngFontPath = Nothing+ , pngFontPathBold = Nothing+ , pngScale = 1.0+ }++-- ===========================================================================+-- 入口 (PDF backend の savePDF / savePDFWith / savePDFBound と対称)+-- ===========================================================================++-- | PNG ファイルに保存。 Resolver 不要 (= inline 列のみの図、 = 通常)。+-- 列名参照を含む図は 'savePNGWith'、 DataFrame は 'savePNGBound' (@df |>> spec@)。+savePNG :: FilePath -> VisualSpec -> IO ()+savePNG path = savePNGWith path emptyResolver++-- | 'Resolver' を渡して PNG ファイルに保存。 'ColByName' を含む図用。+savePNGWith :: FilePath -> Resolver -> VisualSpec -> IO ()+savePNGWith = savePNGConfigured defaultPNGConfig++-- | 'BoundPlot' (= @df |>> spec@ の結果) を PNG ファイルに保存。+-- Error severity の検証診断は stderr に報告してから書き出す+-- (savePDFBound と同じ lenient 既定)。+savePNGBound :: FilePath -> BoundPlot -> IO ()+savePNGBound path (BoundPlot r spec diags) = do+ mapM_ (hPutStrLn stderr . T.unpack . renderDiagnostic)+ (filter ((== SevError) . diagnosticSeverity) diags)+ savePNGWith path r spec++-- | 'PNGConfig' 付き保存 (フォント明示 / Hi-DPI)。+savePNGConfigured :: PNGConfig -> FilePath -> Resolver -> VisualSpec -> IO ()+savePNGConfigured cfg path r spec = do+ -- ★ Phase 33 B5: layout/prims は純 pt。PNG は raster なので k=dpi/72 を一度だけ+ -- 掛けて device px へ (HS SVG backend と同一・唯一の dpi 適用点)。font size も+ -- scalePrimitives で device px になり、drawTextPrim の px→point 変換はそのまま整合。+ -- pngScale (Hi-DPI) は k と直交の追加倍率として savePrimitivesPNG 側で温存。+ let layout = computeLayout r spec+ k = maybe 96 id (getLast (vsDpi spec)) / 72+ prims = scalePrimitives k (renderToPrimitives r layout spec)+ ViewportSize wpt hpt = lpViewport layout+ w = round (fromIntegral wpt * k) :: Int+ h = round (fromIntegral hpt * k) :: Int+ savePrimitivesPNG cfg path w h prims++-- | Phase 24 A8: [Primitive] 列を所与のキャンバスサイズで PNG に直接描画する+-- 低レベル経路 ('savePrimitivesSVG' の PNG 版)。 2D の 'savePNGConfigured' と+-- 3D の 'savePNG3D' が共有。 'pngScale' で Hi-DPI 拡大。+savePrimitivesPNG :: PNGConfig -> FilePath -> Int -> Int -> [Primitive] -> IO ()+savePrimitivesPNG cfg path w h prims = do+ let s = max 1e-3 (pngScale cfg)+ wI = max 1 (ceiling (fromIntegral w * s)) :: Int+ hI = max 1 (ceiling (fromIntegral h * s)) :: Int+ fonts <- loadPNGFonts cfg+ -- 画像初期化は白。 theme 背景は [Primitive] 先頭の背景 rect が全面を塗る+ -- (Render/Layer.hs の background) ので実質 theme 色になる。+ let bg = PixelRGBA8 255 255 255 255+ img = R.renderDrawing wI hI bg $+ R.withTransformation (RTr.scale (f s) (f s)) $+ drawPrims fonts prims+ writePng path img++-- ===========================================================================+-- フォント探索 (fontconfig 非依存・決定的)+-- ===========================================================================++-- | 解釈器に渡すフォント束。 v1 は family 非区別 (regular/bold の 2 face のみ。+-- 日本語 .ttf で serif/italic が揃う環境は稀のため。 計画 md の設計判断)。+data PNGFonts = PNGFonts+ { pfRegular :: F.Font+ , pfBold :: F.Font+ }++-- | 候補ディレクトリ (存在するものだけ走査・/usr/share/fonts は再帰)。+fontSearchDirs :: IO [FilePath]+fontSearchDirs = do+ home <- getHomeDirectory+ pure+ [ home </> ".fonts"+ , home </> ".local/share/fonts"+ , "/usr/share/fonts"+ , "/usr/local/share/fonts"+ , "/mnt/c/Windows/Fonts" -- WSL (※日本語は .ttc が多く対象外になりがち)+ ]++-- | 候補ファイル名 (優先順・小文字比較)。 日本語対応 .ttf を先頭に、+-- 最後に Latin のみの DejaVu (JP フォント不在環境の文字化け回避より+-- 「とりあえず描ける」 を優先。 JP が必要なら pngFontPath で明示)。+regularCandidates :: [String]+regularCandidates =+ [ "hackgen-regular.ttf"+ , "notosanscjkjp-regular.ttf"+ , "notosansjp-regular.ttf"+ , "ipagp.ttf" -- IPA P ゴシック+ , "ipag.ttf" -- IPA ゴシック+ , "takaopgothic.ttf"+ , "takaogothic.ttf"+ , "dejavusans.ttf"+ ]++boldCandidates :: [String]+boldCandidates =+ [ "hackgen-bold.ttf"+ , "notosanscjkjp-bold.ttf"+ , "notosansjp-bold.ttf"+ , "dejavusans-bold.ttf"+ ]++-- | フォント load。 明示 path → 候補探索 → loud エラー。+loadPNGFonts :: PNGConfig -> IO PNGFonts+loadPNGFonts cfg = do+ index <- ttfIndex+ reg <- resolveFont index "regular" (pngFontPath cfg) regularCandidates+ bold <- case pngFontPathBold cfg of+ Just p -> loadOrDie p+ Nothing -> case lookupCandidates index boldCandidates of+ Just p -> loadOrDie p+ Nothing -> pure reg -- bold 不在は regular で代替 (v1 制約)+ pure (PNGFonts reg bold)+ where+ resolveFont index roleName mExplicit candidates = case mExplicit of+ Just p -> do+ ok <- doesFileExist p+ if ok then loadOrDie p+ else die ("明示指定の " ++ roleName ++ " フォントがありません: " ++ p)+ Nothing -> case lookupCandidates index candidates of+ Just p -> loadOrDie p+ Nothing -> do+ dirs <- fontSearchDirs+ die $ unlines+ [ "日本語対応 TTF フォントが見つかりません。"+ , "探索ディレクトリ: " ++ intercalate ", " dirs+ , "候補ファイル名: " ++ intercalate ", " candidates+ , ".ttc (TrueType Collection) は非対応です。 .ttf を"+ , "PNGConfig { pngFontPath = Just <path> } で明示指定してください。"+ ]+ loadOrDie p = do+ ef <- F.loadFontFile p+ case ef of+ Right font -> pure font+ Left err -> die ("TTF の load に失敗 (" ++ p ++ "): " ++ err+ ++ " (※.ttc/OTF は非対応・.ttf のみ)")+ die msg = errorWithoutStackTrace ("hgg-rasterific: " ++ msg)++-- | 探索ディレクトリ配下の .ttf を再帰列挙して (小文字ファイル名, path) の+-- 索引にする。 候補リスト順 (= 優先順) に索引を引く。+ttfIndex :: IO [(String, FilePath)]+ttfIndex = do+ dirs <- fontSearchDirs+ concat <$> mapM walk dirs+ where+ walk dir = do+ ok <- doesDirectoryExist dir+ if not ok then pure [] else do+ entries <- listDirectory dir+ fmap concat . mapM (entryOf dir) $ entries+ entryOf dir e = do+ let p = dir </> e+ isDir <- doesDirectoryExist p+ if isDir+ then walk p+ else pure [ (map toLower e, p)+ | map toLower (takeExtension e) == ".ttf" ]++lookupCandidates :: [(String, FilePath)] -> [String] -> Maybe FilePath+lookupCandidates index = go+ where+ go [] = Nothing+ go (c : cs) = case lookup c index of+ Just p -> Just p+ Nothing -> go cs++-- ===========================================================================+-- Primitive 解釈器+-- ===========================================================================++-- | Double → Float (Rasterific の座標は Float)。+f :: Double -> Float+f = realToFrac++v2 :: Point -> R.Point+v2 (Point x y) = R.V2 (f x) (f y)++-- | Primitive 列を順に描く。 PClipPush/PTransformPush は対応する Pop までを+-- **再帰グルーピング**して 'R.withClipping' / 'R.withTransformation' に入れる+-- (PDF backend の drawPrims と同型。 Rasterific の clip/transform も+-- scoped combinator なので同じ構図が自然に合う)。+-- 対応の取れない Pop は黙って無視 (SVG backend と同じ寛容さ)。+drawPrims :: PNGFonts -> [Primitive] -> R.Drawing PixelRGBA8 ()+drawPrims fonts = go+ where+ go [] = pure ()+ go (PClipPush rect : rest) =+ let (inner, after) = breakMatch isClipPush isClipPop rest+ in do R.withClipping (R.fill (rectShape rect)) (go inner)+ go after+ go (PTransformPush tr : rest) =+ let (inner, after) = breakMatch isTrPush isTrPop rest+ in do R.withTransformation (transformOf tr) (go inner)+ go after+ go (PClipPop : rest) = go rest+ go (PTransformPop : rest) = go rest+ go (p : rest) = drawOne fonts p >> go rest++ isClipPush p = case p of { PClipPush _ -> 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 の開きっ放しと同義)。+breakMatch :: (Primitive -> Bool) -> (Primitive -> Bool)+ -> [Primitive] -> ([Primitive], [Primitive])+breakMatch isPush isPop = walk (0 :: Int)+ where+ walk _ [] = ([], [])+ walk n (p : rest)+ | isPop p && n == 0 = ([], rest)+ | otherwise =+ let n' = if isPush p then n + 1 else if isPop p then n - 1 else n+ (inner, after) = walk n' rest+ in (p : inner, after)++-- | SVG 系 Transform → Rasterific Transformation (y 下向き同士なのでそのまま)。+transformOf :: Transform -> RTr.Transformation+transformOf (TranslateT dx dy) = RTr.translate (R.V2 (f dx) (f dy))+transformOf (ScaleT sx sy) = RTr.scale (f sx) (f sy)++-- | 単独 primitive の描画。 push/pop は 'drawPrims' が先に消費する。+drawOne :: PNGFonts -> Primitive -> R.Drawing PixelRGBA8 ()+drawOne _ (PLine a b ls) = drawLine a b ls+drawOne _ (PRect rect fs ms) = drawRect rect fs ms+drawOne _ (PCircle c rad fs ms _hover) = drawCircle c rad fs ms+drawOne _ (PPath segs fs ms) = drawPath segs fs ms+drawOne fonts (PText p s ts) = drawTextPrim fonts p s ts+drawOne _ _ = pure ()++-- | 線分: 色/幅/破線。 cap は SVG 既定 butt 相当 (CapStraight 0)。+drawLine :: Point -> Point -> LineStyle -> R.Drawing PixelRGBA8 ()+drawLine a b (LineStyle col w dash) =+ R.withTexture (RT.uniformTexture (colorOf col 1.0)) $+ strokeMaybeDashed dash (f w) (R.line (v2 a) (v2 b))++-- | dash 配列 (px) が空なら実線、 あれば dashedStroke。+strokeMaybeDashed :: [Double] -> Float+ -> [R.Primitive] -> R.Drawing PixelRGBA8 ()+strokeMaybeDashed dash w geom = case dash of+ [] -> R.stroke w joinStyle capStyle geom+ ds -> R.dashedStroke (map f ds) w joinStyle capStyle geom+ where+ joinStyle = R.JoinMiter 0+ capStyle = (R.CapStraight 0, R.CapStraight 0)++rectShape :: Rect -> [R.Primitive]+rectShape (Rect x y w h) = R.rectangle (R.V2 (f x) (f y)) (f w) (f h)++-- | 矩形: fill (+ 任意 stroke)。 'Rect' は左上基準 = Rasterific と同じ。+drawRect :: Rect -> FillStyle -> Maybe StrokeStyle -> R.Drawing PixelRGBA8 ()+drawRect rect fs ms = fillShape (rectShape rect) fs ms++-- | 円: fill (+ 任意 stroke)。 hover label は PNG では捨てる (PDF と同じ)。+drawCircle :: Point -> Double -> FillStyle -> Maybe StrokeStyle+ -> R.Drawing PixelRGBA8 ()+drawCircle c rad fs ms = fillShape (R.circle (v2 c) (f rad)) fs ms++-- | Shape 共通: FillStyle (色 + opacity → alpha 合成) で塗り、+-- StrokeStyle があれば縁取る。+fillShape :: [R.Primitive] -> FillStyle -> Maybe StrokeStyle+ -> R.Drawing PixelRGBA8 ()+fillShape shape (FillStyle col opa) ms = do+ if col == "none"+ then pure ()+ else R.withTexture (RT.uniformTexture (colorOf col opa)) (R.fill shape)+ case ms of+ Nothing -> pure ()+ Just (StrokeStyle sc sw) ->+ R.withTexture (RT.uniformTexture (colorOf sc 1.0)) $+ strokeMaybeDashed [] (f sw) shape++-- | パス: MoveTo 区切りで subpath ('R.Path') に分割して fill / stroke。+-- fill は全 subpath の primitive をまとめて 1 回 (= SVG の nonzero winding が+-- subpath 横断で効く)、 stroke は subpath ごと (= まとめると subpath 間に+-- 偽の接続 join が入る) に塗り分ける。+drawPath :: [PathSegment] -> FillStyle -> Maybe StrokeStyle+ -> R.Drawing PixelRGBA8 ()+drawPath [] _ _ = pure ()+drawPath segs (FillStyle fc opa) ms = do+ let subPrims = map R.pathToPrimitives (splitSubpaths segs)+ if fc == "none"+ then pure ()+ else R.withTexture (RT.uniformTexture (colorOf fc opa)) $+ R.fill (concat subPrims)+ case ms of+ Nothing -> pure ()+ Just (StrokeStyle sc sw) ->+ R.withTexture (RT.uniformTexture (colorOf sc 1.0)) $+ mapM_ (strokeMaybeDashed [] (f sw)) subPrims++-- | 'PathSegment' 列 → 'R.Path' 列。 MoveTo で新 subpath、 ClosePath は+-- 現 subpath の close フラグ (以降に命令が続く稀ケースは同じ原点で新 subpath)。+-- 先頭が MoveTo でない場合は原点 (0,0) 開始 (PDF backend と同じ寛容さ)。+splitSubpaths :: [PathSegment] -> [R.Path]+splitSubpaths = go (R.V2 0 0) []+ where+ go origin acc [] = closeOff origin acc False []+ go origin acc (MoveTo p : rest) =+ closeOff origin acc False (go (v2 p) [] rest)+ go origin acc (LineTo p : rest) =+ go origin (R.PathLineTo (v2 p) : acc) rest+ go origin acc (CurveTo c1 c2 p : rest) =+ go origin (R.PathCubicBezierCurveTo (v2 c1) (v2 c2) (v2 p) : acc) rest+ go origin acc (ClosePath : rest) =+ closeOff origin acc True (go origin [] rest)+ -- 空 subpath (連続 MoveTo 等) は捨てる+ closeOff _ [] _ rest = rest+ closeOff origin acc closed rest =+ R.Path origin closed (reverse acc) : rest++-- | テキスト: 'R.printTextAt' (基準点 = baseline 開始 = SVG の text y と同義)。+-- anchor は 'F.stringBoundingBox' の advance width (_xMax 位置に格納・+-- FontyFruity ソース実測) で x 補正。 tsRotate (degrees CW・SVG 同義) は+-- y 下向き同士なので符号そのまま (PDF と対照的)、 rotate→translate の合成で+-- (x,y) 周りに回す。 tsSize は px → 'F.pixelSizeInPointAtDpi' で 96 dpi の+-- point に変換 ('R.renderDrawing' = 96 dpi 固定)。+-- v1 は family 非区別: tsWeight == "bold" のみ分岐、 italic は regular で代替。+drawTextPrim :: PNGFonts -> Point -> Text -> TextStyle+ -> R.Drawing PixelRGBA8 ()+drawTextPrim fonts (Point x y) txt ts =+ R.withTexture (RT.uniformTexture (colorOf (tsColor ts) 1.0)) $+ if tsRotate ts == 0+ then R.printTextAt font sizePt (R.V2 (f x + dx) (f y)) str+ else R.withTransformation+ -- Phase 50 A1: 内部 tsRotate は CCW 正 (canonical)。 Rasterific は y-down/CW ゆえ+ -- ここで符号反転して device CW へ (唯一の変換点)。+ (RTr.translate (R.V2 (f x) (f y))+ <> RTr.rotate (f (negate (tsRotate ts)) * pi / 180))+ (R.printTextAt font sizePt (R.V2 dx 0) str)+ where+ font = if tsWeight ts == "bold" then pfBold fonts else pfRegular fonts+ sizePt = F.pixelSizeInPointAtDpi (f (max 1 (tsSize ts))) 96+ str = T.unpack txt+ advW = F._xMax (F.stringBoundingBox font 96 sizePt str)+ dx = case tsAnchor ts of+ AnchorStart -> 0+ AnchorMiddle -> negate (advW / 2)+ AnchorEnd -> negate advW++-- ===========================================================================+-- 色 (theme 色は全て "#rrggbb" hex。 named / 不正は黒 fallback)+-- ===========================================================================++-- | hex 色 + opacity → PixelRGBA8 (opacity は alpha 成分に畳む =+-- PDF v1 の opacity 問題は PNG では起きない)。+colorOf :: Text -> Double -> PixelRGBA8+colorOf t opa = case T.unpack t of+ ['#', r1, r2, g1, g2, b1, b2]+ | all isHexDigit [r1, r2, g1, g2, b1, b2] ->+ PixelRGBA8 (hex2 r1 r2) (hex2 g1 g2) (hex2 b1 b2) alpha+ ['#', r, g, b]+ | all isHexDigit [r, g, b] -> PixelRGBA8 (hex2 r r) (hex2 g g) (hex2 b b) alpha+ "white" -> PixelRGBA8 255 255 255 alpha+ _ -> PixelRGBA8 0 0 0 alpha+ where+ alpha = fromIntegral (max 0 (min 255 (round (opa * 255) :: Int)))+ hex2 a b = fromIntegral (digitToInt a * 16 + digitToInt b)
+ test/Spec.hs view
@@ -0,0 +1,114 @@+-- | hgg-rasterific のテスト (Phase 22)。+-- PNG は「magic 先頭 + JuicyPixels decode 成功 + 寸法 > 0」 を固定する+-- (golden バイト比較は SVG golden と役割重複のためしない。 計画 md のリスク欄)。+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Graphics.Hgg.Backend.Rasterific (PNGConfig (..), PNGFonts (..),+ defaultPNGConfig, loadPNGFonts,+ savePNG, savePNGConfigured)+import Graphics.Hgg.Easy+import Codec.Picture (Image (..), PixelRGBA8,+ convertRGBA8, decodePng)+import qualified Data.ByteString as BS+import qualified Graphics.Text.TrueType as F+import System.Directory (getTemporaryDirectory,+ removeFile)+import System.FilePath ((</>))+import Test.Hspec++-- | savePNG して decode まで通し、 画像を返す共通 helper。+saveAndDecodeImg :: FilePath -> VisualSpec -> IO (Image PixelRGBA8)+saveAndDecodeImg name spec = do+ tmp <- getTemporaryDirectory+ let path = tmp </> name+ savePNG path spec+ bs <- BS.readFile path+ BS.take 8 bs `shouldBe` BS.pack [0x89, 0x50, 0x4E, 0x47, 0x0D, 0x0A, 0x1A, 0x0A]+ removeFile path+ case decodePng bs of+ Left err -> error ("PNG decode 失敗: " ++ err)+ Right dyn -> pure (convertRGBA8 dyn)++-- | 寸法だけ欲しい場合の短縮。+saveAndDecode :: FilePath -> VisualSpec -> IO (Int, Int)+saveAndDecode name spec = do+ img <- saveAndDecodeImg name spec+ pure (imageWidth img, imageHeight img)++main :: IO ()+main = hspec $ do+ describe "Phase 22 A1: savePNG (骨格 = line/rect/circle)" $ do+ it "scatter spec が valid な PNG を書く (decode + 寸法)" $ do+ (w, h) <- saveAndDecode "hgg-png-test-scatter.png" $+ layer (scatter (inline [1, 2, 3, 4]) (inline [2, 4, 1, 3]))+ w `shouldSatisfy` (> 100)+ h `shouldSatisfy` (> 100)++ it "bar spec (rect 経路) も例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-bar.png" $+ layer (bar (inlineCat (["a", "b", "a"] :: [String]))+ (inline [1, 2, 3]))+ w `shouldSatisfy` (> 100)++ describe "Phase 22 A2: PPath + clip/transform 再帰グルーピング" $ do+ it "density (PPath 経路) が例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-density.png" $+ layer (density (inline [1, 2, 2, 3, 3, 3, 4, 5]))+ w `shouldSatisfy` (> 100)++ it "coordCartesianX (PClipPush/Pop 経路) が例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-clip.png" $+ layer (line (inline [1, 2, 3, 4]) (inline [2, 4, 1, 3]))+ <> coordCartesianX 1.5 3.5+ w `shouldSatisfy` (> 100)++ it "facet (複数 panel) が例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-facet.png" $+ layer (scatter (inline [1, 2, 3, 4]) (inline [2, 4, 1, 3]))+ <> facet (inlineCat (["g1", "g1", "g2", "g2"] :: [String]))+ w `shouldSatisfy` (> 100)++ it "coordPolar が例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-polar.png" $+ layer (line (inline [1, 2, 3, 4, 5, 6]) (inline [2, 4, 1, 3, 2, 5]))+ <> coordPolar+ w `shouldSatisfy` (> 100)++ describe "Phase 22 A3: PText (TrueType・anchor/rotate・日本語)" $ do+ it "title + 軸ラベル (回転 y ラベル含む) が例外なく書ける" $ do+ (w, _) <- saveAndDecode "hgg-png-test-text.png" $+ layer (scatter (inline [1, 2, 3]) (inline [3, 1, 2]))+ <> title "Latin title"+ <> xLabel "weight" <> yLabel "mpg"+ w `shouldSatisfy` (> 100)++ it "既定探索のフォントが日本語 glyph を持つ (isPlaceholder 欠落なし)" $ do+ fonts <- loadPNGFonts defaultPNGConfig+ let jp = "日本語タイトル重さあいう" :: String+ filter (F.isPlaceholder (pfRegular fonts)) jp `shouldBe` []++ it "日本語 title が実際に pixel を描く (空 title との画像差分)" $ do+ let base = layer (scatter (inline [1, 2, 3]) (inline [3, 1, 2]))+ imgJp <- saveAndDecodeImg "hgg-png-test-jp.png"+ (base <> title "日本語タイトル")+ imgNo <- saveAndDecodeImg "hgg-png-test-nojp.png" base+ imageData imgJp `shouldNotBe` imageData imgNo++ describe "Phase 22 A4: pngScale (Hi-DPI)" $ do+ it "pngScale 2.0 で寸法が縦横 2 倍になる" $ do+ tmp <- getTemporaryDirectory+ let spec = layer (scatter (inline [1, 2, 3]) (inline [3, 1, 2]))+ save s name = do+ let path = tmp </> name+ savePNGConfigured defaultPNGConfig { pngScale = s }+ path emptyResolver spec+ bs <- BS.readFile path+ removeFile path+ case decodePng bs of+ Left err -> error ("PNG decode 失敗: " ++ err)+ Right dyn -> pure (convertRGBA8 dyn)+ img1 <- save 1.0 "hgg-png-test-1x.png"+ img2 <- save 2.0 "hgg-png-test-2x.png"+ imageWidth img2 `shouldBe` 2 * imageWidth img1+ imageHeight img2 `shouldBe` 2 * imageHeight img1