{-# OPTIONS -Wall #-}
module FontPic where
import Wumpus.Basic.SafeFonts
import Wumpus.Basic.SVGColours ( steelBlue )
import Wumpus.Basic.X11Colours ( indianRed1 )
import Wumpus.Deprecated.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 :: DRGB -> FontAttr -> DPoint2 -> DPrimitive
makeFontLabel c fa = textlabel (c,fa) msg
where
msg = unwords [ font_name $ font_face fa, (show $ font_size fa) ++ "pt"]
blueLabel :: FontFace -> Int -> DPoint2 -> DPrimitive
blueLabel ff i = makeFontLabel steelBlue (FontAttr i ff)
redLabel :: FontFace -> Int -> DPoint2 -> DPrimitive
redLabel ff i = makeFontLabel indianRed1 (FontAttr i ff)
point_sizes :: [Int]
point_sizes = [10, 12, 18, 24, 36, 48]
--------------------------------------------------------------------------------
-- Times
times_pic :: Picture Double
times_pic = timesroman_pic -//- timesitalic_pic -//- timesbold_pic
-//- timesbolditalic_pic
timesroman_pic :: Picture Double
timesroman_pic =
frameMulti $ zipWith (blueLabel timesRoman) point_sizes (mkPoints 1.5)
timesitalic_pic :: Picture Double
timesitalic_pic =
frameMulti $ zipWith (redLabel timesItalic) point_sizes (mkPoints 1.5)
timesbold_pic :: Picture Double
timesbold_pic =
frameMulti $ zipWith (blueLabel timesBold) point_sizes (mkPoints 1.5)
timesbolditalic_pic :: Picture Double
timesbolditalic_pic =
frameMulti $ zipWith (redLabel timesBoldItalic) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
helvetica_pic :: Picture Double
helvetica_pic = helvetica_pic1 -//- helveticaoblique_pic -//- helveticabold_pic
-//- helveticaboldoblique_pic
helvetica_pic1 :: Picture Double
helvetica_pic1 =
frameMulti $ zipWith (blueLabel helvetica) point_sizes (mkPoints 1.5)
helveticaoblique_pic :: Picture Double
helveticaoblique_pic =
frameMulti $ zipWith (redLabel helveticaOblique) point_sizes (mkPoints 1.5)
helveticabold_pic :: Picture Double
helveticabold_pic =
frameMulti $ zipWith (blueLabel helveticaBold) point_sizes (mkPoints 1.5)
helveticaboldoblique_pic :: Picture Double
helveticaboldoblique_pic =
frameMulti $ zipWith (redLabel helveticaBoldOblique) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
courier_pic :: Picture Double
courier_pic = courier_pic1 -//- courieroblique_pic -//- courierbold_pic
-//- courierboldoblique_pic
courier_pic1 :: Picture Double
courier_pic1 =
frameMulti $ zipWith (blueLabel courier) point_sizes (mkPoints 1.5)
courieroblique_pic :: Picture Double
courieroblique_pic =
frameMulti $ zipWith (redLabel courierOblique) point_sizes (mkPoints 1.5)
courierbold_pic :: Picture Double
courierbold_pic =
frameMulti $ zipWith (blueLabel courierBold) point_sizes (mkPoints 1.5)
courierboldoblique_pic :: Picture Double
courierboldoblique_pic =
frameMulti $ zipWith (redLabel courierBoldOblique) point_sizes (mkPoints 1.5)
--------------------------------------------------------------------------------
symbol_pic :: Picture Double
symbol_pic =
frameMulti $ 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))