{-# OPTIONS -Wall #-}

module FontPic where

import Wumpus.Drawing.Chains
import Wumpus.Drawing.Colour.SVGColours ( steel_blue )
import Wumpus.Drawing.Colour.X11Colours ( indian_red1 )
import Wumpus.Drawing.Text.SafeFonts

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 :: FontFace -> Int -> String
fontMsg ff sz = msgF []
  where
    msgF = showString (ps_font_name ff) . showChar ' ' . shows sz . showString "pt"


makeLabel :: RGBi -> FontFace -> Int -> DLocGraphic
makeLabel rgb ff sz = localize upd (textline $ fontMsg ff sz)
  where
    upd = fillColour rgb . fontAttr ff 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] 


pointChain :: LocChain Double
pointChain = verticalSteps $ map (fromIntegral . (+2)) point_sizes


fontGraphic :: RGBi -> FontFace -> DLocGraphic 
fontGraphic rgb ff = 
    unchainZipWith emptyLocGraphic mkGF point_sizes pointChain 
  where
    mkGF sz = makeLabel rgb ff sz


std_ctx :: DrawingContext
std_ctx = standardContext 10


fontDrawing :: [(RGBi,FontFace)] -> DCtxPicture
fontDrawing xs = drawTracing $  
    draw $ unchainZipWith emptyLocGraphic (uncurry fontGraphic) xs chn `at` start
  where
    chn   = tableDown 4 (1,180)
    start = P2 0 (4*180)



--------------------------------------------------------------------------------
-- Times

times_cxpic :: CtxPicture Double
times_cxpic = 
    fontDrawing [ (steel_blue,  times_roman)
                , (indian_red1, times_italic)
                , (steel_blue,  times_bold)
                , (indian_red1, times_bold_italic)
                ] 

helvetica_cxpic :: CtxPicture Double
helvetica_cxpic = 
    fontDrawing [ (steel_blue,  helvetica)
                , (indian_red1, helvetica_oblique)
                , (steel_blue,  helvetica_bold)
                , (indian_red1, helvetica_bold_oblique)
                ] 



--------------------------------------------------------------------------------

courier_cxpic :: CtxPicture Double
courier_cxpic = 
    fontDrawing [ (steel_blue,  courier)
                , (indian_red1, courier_oblique)
                , (steel_blue,  courier_bold)
                , (indian_red1, courier_bold_oblique)
                ] 


--------------------------------------------------------------------------------

    
symbol_cxpic :: CtxPicture Double
symbol_cxpic = 
    fontDrawing [ (steel_blue, symbol) ]