{-# OPTIONS -Wall #-}
module FontPic where
import Wumpus.Drawing.Colour.SVGColours ( steel_blue )
import Wumpus.Drawing.Colour.X11Colours ( indian_red1 )
import Wumpus.Drawing.Text.StandardFontDefs
import Wumpus.Basic.Kernel -- package: wumpus-basic
import Wumpus.Core -- package: wumpus-core
import System.Directory
main :: IO ()
main = do
createDirectoryIfMissing True "./out/"
--
let courier_pic = runCtxPictureU std_ctx courier_cxpic
writeEPS "./out/font_courier.eps" courier_pic
writeSVG "./out/font_courier.svg" courier_pic
--
let times_pic = runCtxPictureU std_ctx times_cxpic
writeEPS "./out/font_times.eps" times_pic
writeSVG "./out/font_times.svg" times_pic
--
let helvetica_pic = runCtxPictureU std_ctx helvetica_cxpic
writeEPS "./out/font_helvetica.eps" helvetica_pic
writeSVG "./out/font_helvetica.svg" helvetica_pic
--
let symbol_pic = runCtxPictureU std_ctx symbol_cxpic
writeEPS "./out/font_symbol.eps" symbol_pic
writeSVG "./out/font_symbol.svg" symbol_pic
fontMsg :: FontDef -> Int -> String
fontMsg ft sz = msgF []
where
msgF = showString name . showChar ' ' . shows sz . showString "pt"
name = ps_font_name $ font_def_face ft
makeLabel :: RGBi -> FontDef -> Int -> DLocGraphic
makeLabel rgb ft sz = localize upd (dcTextlabel $ fontMsg ft sz)
where
upd = text_colour rgb . font_attr ft sz
-- indian_red1
-- steel_blue
point_sizes :: [Int]
point_sizes = [10, 12, 18, 24, 36, 48]
positions :: [Int]
positions = [0, 12, 27, 49, 78, 122]
-- Note - this chain might be worth putting in a library...
pointChain :: (Int -> DLocGraphic) -> DLocImage DPoint2
pointChain fn = chain chn_alg $ map fn point_sizes
where
chn_alg = linearChain $ iterationScheme start step
start = \pt -> (pt,point_sizes)
step (pt,[]) = ((displace (vvec 50) pt, []), pt)
step (pt,(y:ys)) = ((displace (vvec $ fromIntegral $ 2 + y) pt, ys), pt)
fontGraphic :: RGBi -> FontDef -> DLocGraphic
fontGraphic rgb ft = ignoreAns $ pointChain mkGF
where
mkGF sz = makeLabel rgb ft sz
std_ctx :: DrawingContext
std_ctx = standardContext 10
fontDrawing :: [(RGBi,FontDef)] -> CtxPicture
fontDrawing xs = drawTracing $
draw $ chain_ chn_alg (map (uncurry fontGraphic) xs) `at` start
where
chn_alg = tableDown 4 (1,180)
start = P2 0 (4*180)
--------------------------------------------------------------------------------
-- Times
times_cxpic :: CtxPicture
times_cxpic =
fontDrawing [ (steel_blue, times_roman)
, (indian_red1, times_italic)
, (steel_blue, times_bold)
, (indian_red1, times_bold_italic)
]
helvetica_cxpic :: CtxPicture
helvetica_cxpic =
fontDrawing [ (steel_blue, helvetica)
, (indian_red1, helvetica_oblique)
, (steel_blue, helvetica_bold)
, (indian_red1, helvetica_bold_oblique)
]
--------------------------------------------------------------------------------
courier_cxpic :: CtxPicture
courier_cxpic =
fontDrawing [ (steel_blue, courier)
, (indian_red1, courier_oblique)
, (steel_blue, courier_bold)
, (indian_red1, courier_bold_oblique)
]
--------------------------------------------------------------------------------
symbol_cxpic :: CtxPicture
symbol_cxpic =
fontDrawing [ (steel_blue, symbol) ]