packages feed

svg-icons-2.10.0: src/Main.hs

{-# LANGUAGE     OverloadedStrings       #-}

{- |
The main purpose of this module is 
generating the images found within the haddock documentation
of this package.
-}
module Main where

import           System.Directory
import           Text.Blaze.Svg11 ((!))
import           Text.Blaze.Svg11 as S
import           Text.Blaze.Svg11.Attributes as A

import SvgIcons.Core.Geometry
import SvgIcons.Core.Render
import SvgIcons.Core.Style
import SvgIcons.Core.Utils
import SvgIcons.Icons (exampleIcons)
import SvgIcons.Icons.Arrows   (svgArrows)
import SvgIcons.Icons.Business (svgBusiness)
import SvgIcons.Icons.Coding   (svgCoding)
import SvgIcons.Icons.Computer (svgComputer)
import SvgIcons.Icons.Cosmos   (svgCosmos)
import SvgIcons.Icons.Human    (svgHuman)
import SvgIcons.Icons.Math     (svgMath)
import SvgIcons.Icons.Office   (svgOffice)
import SvgIcons.Icons.Outdoors (svgOutdoors)
import SvgIcons.Icons.Religion (svgReligion)
import SvgIcons.Icons.Textarea (svgTextarea)
import SvgIcons.Icons.Tools    (svgTools)
import SvgIcons.Images.CountryFlags (countryFlags)
import SvgIcons.Images.Mosaics      (mosaicSample)





{- |
prop> main = renderAll "./svg"
-}
main :: IO ()
main = renderAll "./svg"


{- |
Renders all icons and images from this package into 
the target directory. This is used to generate the 
example SVGs found in this documentation.

The directory is created if it does not exist, and
some subdirectories are created to distinguish between
icons or images.

__WARNING:__ this function __deletes the target directory__
and then creates it again. Be careful.
-}
renderAll :: FilePath -> IO ()
renderAll svgFolder = do
  createDirectoryIfMissing False svgFolder
  removeDirectoryRecursive       svgFolder
  createDirectory                svgFolder
  renderExamples (svgFolder ++ "/examples/")
  renderIcons    (svgFolder ++ "/icons/")
  renderImages   (svgFolder ++ "/images/")
  renderTest     (svgFolder ++ "/test/") (starPolygonOverlap 7 900 50 (0,0))
  putStrLn "Svg files compiled correctly"


{- |
Renders the examples from `Icons` module
into the targeted directory.
-}
renderExamples :: FilePath -> IO ()
renderExamples path = do
  createDirectory path
  renderSvgFiles path exampleIcons
  renderGeometryExamples path


{- |
Renders the examples from `Core.Geometry` module
into the targeted directory.
-}
renderGeometryExamples :: FilePath -> IO ()
renderGeometryExamples path = do
    createDirectory p
    renderSvgFiles p [("anglesHelp", anglesHelp)]
    renderSvgFiles p (map fillIcons geometryExamples)
    renderSvgFiles p (map fullIcons geometryExamples)
    renderSvgFiles p (map strkIcons geometryExamples)
  where
    p = path ++ "/geometry/"
    fillIcons (a,b) = (a ++ "_fill" , stdDims $ fillStyle b)
    fullIcons (a,b) = (a ++ "_full" , stdDims $ fullStyle b)
    strkIcons (a,b) = (a ++ "_strk" , stdDims $ strkStyle b)


{- |
Renders all icons into the 
targeted directory.

All icons are rendered in a @viewbox "-1 -1 2 2"@ and
with 3 style variants:

  * Black fill and no stroke
  * Black stroke and no fill
  * Silver fill and black stroke
-}
renderIcons :: FilePath -> IO ()
renderIcons path = 
  do
    createDirectory path
    createDirectory arrowsPath
    createDirectory businessPath
    createDirectory codingPath
    createDirectory computerPath
    createDirectory cosmosPath
    createDirectory humanPath
    createDirectory mathPath
    createDirectory officePath
    createDirectory outdoorsPath
    createDirectory religionPath
    createDirectory textareaPath
    createDirectory toolsPath
    renderSvgFiles arrowsPath (map fillIcons svgArrows)
    renderSvgFiles arrowsPath (map fullIcons svgArrows)
    renderSvgFiles arrowsPath (map strkIcons svgArrows)
    renderSvgFiles businessPath (map fillIcons svgBusiness)
    renderSvgFiles businessPath (map fullIcons svgBusiness)
    renderSvgFiles businessPath (map strkIcons svgBusiness)
    renderSvgFiles codingPath (map fillIcons svgCoding)
    renderSvgFiles codingPath (map fullIcons svgCoding)
    renderSvgFiles codingPath (map strkIcons svgCoding)
    renderSvgFiles computerPath (map fillIcons svgComputer)
    renderSvgFiles computerPath (map fullIcons svgComputer)
    renderSvgFiles computerPath (map strkIcons svgComputer)
    renderSvgFiles cosmosPath (map fillIcons svgCosmos)
    renderSvgFiles cosmosPath (map fullIcons svgCosmos)
    renderSvgFiles cosmosPath (map strkIcons svgCosmos)
    renderSvgFiles humanPath (map fillIcons svgHuman)
    renderSvgFiles humanPath (map fullIcons svgHuman)
    renderSvgFiles humanPath (map strkIcons svgHuman)
    renderSvgFiles mathPath (map fillIcons svgMath)
    renderSvgFiles mathPath (map fullIcons svgMath)
    renderSvgFiles mathPath (map strkIcons svgMath)
    renderSvgFiles officePath (map fillIcons svgOffice)
    renderSvgFiles officePath (map fullIcons svgOffice)
    renderSvgFiles officePath (map strkIcons svgOffice)
    renderSvgFiles outdoorsPath (map fillIcons svgOutdoors)
    renderSvgFiles outdoorsPath (map fullIcons svgOutdoors)
    renderSvgFiles outdoorsPath (map strkIcons svgOutdoors)
    renderSvgFiles religionPath (map fillIcons svgReligion)
    renderSvgFiles religionPath (map fullIcons svgReligion)
    renderSvgFiles religionPath (map strkIcons svgReligion)
    renderSvgFiles textareaPath (map fillIcons svgTextarea)
    renderSvgFiles textareaPath (map fullIcons svgTextarea)
    renderSvgFiles textareaPath (map strkIcons svgTextarea)
    renderSvgFiles toolsPath (map fillIcons svgTools)
    renderSvgFiles toolsPath (map fullIcons svgTools)
    renderSvgFiles toolsPath (map strkIcons svgTools)
  where
    fillIcons (a,b) = (a ++ "_fill" , stdDims $ fillStyle b)
    fullIcons (a,b) = (a ++ "_full" , stdDims $ fullStyle b)
    strkIcons (a,b) = (a ++ "_strk" , stdDims $ strkStyle b)
    -- test (a,b) = (a, coreSvg def $ b >> frame (-1) (-1) 2 2)
    arrowsPath   = path ++ "arrows/"
    businessPath = path ++ "business/"
    codingPath   = path ++ "coding/"
    computerPath = path ++ "computer/"
    cosmosPath   = path ++ "cosmos/"
    humanPath    = path ++ "human/"
    mathPath     = path ++ "math/"
    officePath   = path ++ "office/"
    outdoorsPath = path ++ "outdoors/"
    religionPath = path ++ "religion/"
    textareaPath = path ++ "textarea/"
    toolsPath    = path ++ "tools/"



{- |
Renders all images into the targeted directory.
-}
renderImages :: FilePath -> IO ()
renderImages path = do
    createDirectory path
    createDirectory countryFlagsPath
    createDirectory mosaicsPath
    renderSvgFiles countryFlagsPath countryFlags
    renderSvgFiles mosaicsPath      mosaicSample
  where
    countryFlagsPath = path ++ "countryFlags/"
    mosaicsPath      = path ++ "mosaics/"



{- |
Takes an icon as second argument and renders it with all
3 styles (fill, full and stroke) into the targeted directory.

The `frame` function is used for testing purposes.
-}
renderTest :: FilePath -> Svg -> IO ()
renderTest path svgTest = do
    createDirectory path
    renderSvgFiles path test
  where
    -- test = 
    --   [ (,) "test_fill" (stdDims $ fillStyle svgFramed)
    --   , (,) "test_full" (stdDims $ fullStyle svgFramed)
    --   , (,) "test_strk" (stdDims $ strkStyle svgFramed)
    --   ]
    test =
      [ ("test", svgFramed)]
    svgFramed =
      S.svg
        ! A.viewbox "-1000 -1000 2000 2000"
        $ do 
          S.g (svgTest >> frame 0.1 "black" (-1) (-1) 2 2)
            ! A.stroke "black"
            ! A.strokeWidth "10"
            ! A.fill "white"