{-# OPTIONS -Wall #-}
module FontPic where
import Wumpus.Basic.SafeFonts
import Wumpus.Basic.Colour.SVGColours ( steel_blue )
import Wumpus.Basic.Colour.X11Colours ( indian_red1 )
import Wumpus.Basic.PictureLanguage
import Wumpus.Core -- package: wumpus-core
import Data.AffineSpace -- package: vector-space
import Data.VectorSpace
import Data.List ( unfoldr )
import System.Directory
main :: IO ()
main = do
createDirectoryIfMissing True "./out/"
writeEPS_latin1 "./out/font_courier.eps" courier_pic
writeSVG_latin1 "./out/font_courier.svg" courier_pic
writeEPS_latin1 "./out/font_times.eps" times_pic
writeSVG_latin1 "./out/font_times.svg" times_pic
writeEPS_latin1 "./out/font_helvetica.eps" helvetica_pic
writeSVG_latin1 "./out/font_helvetica.svg" helvetica_pic
writeEPS_latin1 "./out/font_symbol.eps" symbol_pic
writeSVG_latin1 "./out/font_symbol.svg" symbol_pic
makeFontLabel :: RGBi -> FontAttr -> DPoint2 -> DPrimitive
makeFontLabel rgb fa = textlabel rgb fa msg
where
msg = unwords [ font_name $ font_face fa, (show $ font_size fa) ++ "pt"]
blueLabel :: FontFace -> Int -> DPoint2 -> DPrimitive
blueLabel ff i = makeFontLabel steel_blue (FontAttr i ff)
redLabel :: FontFace -> Int -> DPoint2 -> DPrimitive
redLabel ff i = makeFontLabel indian_red1 (FontAttr i ff)
point_sizes :: [Int]
point_sizes = [10, 12, 18, 24, 36, 48]
--------------------------------------------------------------------------------
-- Times
times_pic :: Picture Double
times_pic = timesroman_pic `nextToV` timesitalic_pic `nextToV` timesbold_pic
`nextToV` timesbolditalic_pic
timesroman_pic :: Picture Double
timesroman_pic =
frame $ zipWith (blueLabel timesRoman) point_sizes (mkPoints 1.5)
timesitalic_pic :: Picture Double
timesitalic_pic =
frame $ zipWith (redLabel timesItalic) point_sizes (mkPoints 1.5)
timesbold_pic :: Picture Double
timesbold_pic =
frame $ zipWith (blueLabel timesBold) point_sizes (mkPoints 1.5)
timesbolditalic_pic :: Picture Double
timesbolditalic_pic =
frame $ zipWith (redLabel timesBoldItalic) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
helvetica_pic :: Picture Double
helvetica_pic = vcat helvetica_pic1 [ helveticaoblique_pic
, helveticabold_pic
, helveticaboldoblique_pic ]
helvetica_pic1 :: Picture Double
helvetica_pic1 =
frame $ zipWith (blueLabel helvetica) point_sizes (mkPoints 1.5)
helveticaoblique_pic :: Picture Double
helveticaoblique_pic =
frame $ zipWith (redLabel helveticaOblique) point_sizes (mkPoints 1.5)
helveticabold_pic :: Picture Double
helveticabold_pic =
frame $ zipWith (blueLabel helveticaBold) point_sizes (mkPoints 1.5)
helveticaboldoblique_pic :: Picture Double
helveticaboldoblique_pic =
frame $ zipWith (redLabel helveticaBoldOblique) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
courier_pic :: Picture Double
courier_pic = vcat courier_pic1 [ courieroblique_pic
, courierbold_pic
, courierboldoblique_pic ]
courier_pic1 :: Picture Double
courier_pic1 =
frame $ zipWith (blueLabel courier) point_sizes (mkPoints 1.5)
courieroblique_pic :: Picture Double
courieroblique_pic =
frame $ zipWith (redLabel courierOblique) point_sizes (mkPoints 1.5)
courierbold_pic :: Picture Double
courierbold_pic =
frame $ zipWith (blueLabel courierBold) point_sizes (mkPoints 1.5)
courierboldoblique_pic :: Picture Double
courierboldoblique_pic =
frame $ zipWith (redLabel courierBoldOblique) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
symbol_pic :: Picture Double
symbol_pic =
frame $ zipWith (blueLabel symbol) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
mkPoints :: Num u => u -> [Point2 u]
mkPoints n = unfoldr phi zeroPt where
phi pt = Just (pt, pt .+^ (V2 0 15 ^* n))