{-# LANGUAGE OverloadedStrings #-} module Text.AsciiDiagram.DefaultContext ( defaultCss , defaultCssRules , defaultDefinitions ) where import Control.Monad.State.Strict( execState ) import Data.Monoid( (<>) ) import Graphics.Svg.Types ( HasDrawAttributes( .. ), drawAttr ) import Graphics.Svg( cssRulesOfText ) import Codec.Picture( PixelRGBA8( PixelRGBA8 ) ) import qualified Graphics.Svg.Types as Svg import qualified Graphics.Svg.CssTypes as Css import qualified Data.Map as M import qualified Data.Text as T import Text.Printf import Linear( V2( .. ) ) import Control.Lens( (.=), (.~), (&) ) defaultCss :: Float -> T.Text defaultCss textSize = T.pack $ printf ("\n" <> "text { font-family: Consolas, \"DejaVu Sans Mono\", monospace; font-size: %dpx }\n" <> ".dashed_elem { stroke-dasharray: 4, 3 }\n" <> ".filled_shape { fill: url(#shape_light); stroke: black; stroke-width: 1px; }\n" <> ".line_element { fill: none; stroke: black; stroke-width: 1px; }\n" <> ".bullet { stroke-width: 1px; fill: white; stroke: black }\n" <> ".arrow_head { fill: black; stroke: none; }\n" ) (2 + floor textSize :: Int) defaultCssRules :: Float -> [Css.CssRule] defaultCssRules = cssRulesOfText . defaultCss lightShapeGradient :: Svg.Element lightShapeGradient = Svg.ElementLinearGradient $ Svg.defaultSvg { Svg._linearGradientStart = (Svg.Percent 0, Svg.Percent 0) , Svg._linearGradientStop = (Svg.Percent 0, Svg.Percent 1) , Svg._linearGradientStops = [ Svg.defaultSvg { Svg._gradientOffset = 0, Svg._gradientColor = PixelRGBA8 245 245 245 255 } , Svg.defaultSvg { Svg._gradientOffset = 1, Svg._gradientColor = PixelRGBA8 216 216 216 255 } ] } toSymbol :: Double -> Double -> [Svg.Tree] -> Svg.Element toSymbol width height geom = element where element = Svg.ElementGeometry $ Svg.SymbolTree tree tree = Svg.Symbol $ execState build Svg.defaultSvg build = do Svg.groupChildren .= geom Svg.groupViewBox .= Just (0, 0, width, height) Svg.groupAspectRatio . Svg.aspectRatioAlign .= Svg.AlignNone asFilled :: (Svg.WithDrawAttributes a) => a -> a asFilled el = el & drawAttr.attrClass .~ ["filled_shape"] defaultCircle :: Svg.Element defaultCircle = toSymbol 50 50 [Svg.CircleTree $ asFilled circle] where circle = Svg.defaultSvg { Svg._circleCenter = (Css.Num 25, Css.Num 25) , Svg._circleRadius = Css.Num 24.5 } h, v :: [Svg.Coord] -> Svg.PathCommand h = Svg.HorizontalTo Svg.OriginRelative v = Svg.VerticalTo Svg.OriginRelative m :: [Svg.RPoint] -> Svg.PathCommand m = Svg.MoveTo Svg.OriginRelative c :: [(Svg.RPoint, Svg.RPoint, Svg.RPoint)] -> Svg.PathCommand c = Svg.CurveTo Svg.OriginRelative l :: [Svg.RPoint] -> Svg.PathCommand l = Svg.LineTo Svg.OriginRelative z :: Svg.PathCommand z = Svg.EndPath defaultDocument :: Svg.Element defaultDocument = toSymbol 51 51 [Svg.PathTree $ asFilled path] where path = Svg.defaultSvg { Svg._pathDefinition = [ m [V2 49.98 0.79, V2 (-49.166) 0, V2 0 45.402] , c [(V2 15.92 12.45, V2 30.40 (-13.44), V2 49.17 0)] , z ] } ioShape :: Svg.Element ioShape = toSymbol 100 100 [Svg.PathTree $ asFilled path] where path = Svg.defaultSvg { Svg._pathDefinition = [ m [V2 19.207 1.6] , h [79.414] , l [V2 (-17.192) 97.297] , h [-79.414] , z ] } storageShape :: Svg.Element storageShape = toSymbol 80 80 geometry where geometry = Svg.PathTree . asFilled <$> [path1, path2] path1 = Svg.defaultSvg { Svg._pathDefinition = [ m [V2 4.8122 67.74] , v [-53.769] , c [ (V2 0.0 (-3.2991) , V2 16.067 (-5.9743), V2 35.845 (-5.9743)) , (V2 19.78 0.0, V2 35.848 2.6752, V2 35.848 5.9743) ] , v [53.769] , c [(V2 0.0 3.2925, V2 (-16.068) 5.9743, V2 (-35.848) 5.9743) , (V2 (-19.779) 0.0, V2 (-35.845) (-2.6818), V2 (-35.845) (-5.9743)) ] , z ] } path2 = Svg.defaultSvg { Svg._pathDefinition = [ m [ V2 4.8122 13.97, V2 4.779e-2 0.30672, V2 0.13807 0.30272 , V2 0.22834 0.29872, V2 0.31464 0.29344, V2 0.40094 0.28944 , V2 0.48325 0.2828, V2 0.56423 0.27744, V2 0.64256 0.2708 , V2 0.71823 0.26416, V2 0.79258 0.25752, V2 0.86294 0.25096 , V2 0.9333 0.2416, V2 0.99968 0.23496, V2 1.0647 0.22568 , V2 1.1271 0.2164, V2 1.1869 0.2084, V2 1.2453 0.19784 , V2 1.301 0.1872, V2 1.3555 0.17792, V2 1.4046 0.16728 , V2 1.455 0.15536, V2 1.5002 0.14336, V2 1.5466 0.1328 , V2 1.5865 0.11952, V2 1.6276 0.10752, V2 1.6648 9.42e-2 , V2 1.7007 8.1e-2, V2 1.7338 6.64e-2, V2 1.7644 5.31e-2 , V2 1.7923 3.72e-2, V2 1.8188 2.39e-2, V2 1.8427 8.0e-3 ] , c [(V2 19.78 0.0, V2 35.848 (-2.6818), V2 35.848 (-5.9743))] ] } defaultDefinitions :: M.Map String Svg.Element defaultDefinitions = M.fromList [ ("shape_light", lightShapeGradient) , ("circle", defaultCircle) , ("document", defaultDocument) , ("io", ioShape) , ("storage", storageShape) ]