module Wumpus.Basic.System.FontLoader
(
FontLoader
, afmLoaderByEnv
, gsLoaderByEnv
, simpleFontLoader
, default_font_loader_help
) where
import Wumpus.Basic.Kernel.Base.FontSupport
import Wumpus.Basic.System.FontLoader.AfmTopLevel
import Wumpus.Basic.System.FontLoader.GSTopLevel
import Control.Monad
import System.Environment
import System.IO.Error
type FontLoader = [Either FontDef FontFamily] -> IO FontLoadResult
wumpus_gs_font_dir :: String
wumpus_gs_font_dir = "WUMPUS_GS_FONT_DIR"
wumpus_afm_font_dir :: String
wumpus_afm_font_dir = "WUMPUS_AFM_FONT_DIR"
afmLoaderByEnv :: IO (Maybe FontLoader)
afmLoaderByEnv = do
mb <- envLookup wumpus_afm_font_dir
case mb of
Nothing -> return Nothing
Just path -> return $ Just (\xs -> loadAfmFontMetrics path $ fontList xs)
gsLoaderByEnv :: IO (Maybe FontLoader)
gsLoaderByEnv = do
mb <- envLookup wumpus_gs_font_dir
case mb of
Nothing -> return Nothing
Just path -> return $ Just (\xs -> loadGSFontMetrics path $ fontList xs)
simpleFontLoader :: (FontLoader -> IO a) -> IO (Maybe a)
simpleFontLoader mf =
gsLoaderByEnv >>= maybe fk1 sk
where
fk1 = afmLoaderByEnv >>= maybe fk2 sk
fk2 = putStrLn default_font_loader_help >> return Nothing
sk loader = mf loader >>= return . Just
envLookup :: String -> IO (Maybe String)
envLookup name = liftM fn $ try $ getEnv name
where
fn (Left _) = Nothing
fn (Right a) = Just a
fontList :: [Either FontDef FontFamily] -> [FontDef]
fontList = foldr fn []
where
fn (Left a) acc = a:acc
fn (Right b) acc = let f1 = maybe id (\a -> (a:)) $ ff_bold b
f2 = maybe id (\a -> (a:)) $ ff_italic b
f3 = maybe id (\a -> (a:)) $ ff_bold_italic b
in ff_regular b : (f1 $ f2 $ f3 acc)
default_font_loader_help :: String
default_font_loader_help = unlines $
[ "This example uses glyph metrics loaded at runtime."
, "It can use either the metrics files supplied with GhostScript,"
, "or the AFM v4.1 metrics for the Core 14 fonts available from"
, "Adobe's website."
, ""
, "To use GhostScripts font metrics set the environemt variable"
, wumpus_gs_font_dir ++ " to point to the GhostScript fonts"
, "directory (e.g. /usr/share/ghostscript/fonts)."
, ""
, "To use the Adode Core 14 font metrics download the archive from"
, "the Adobe website and set the environment variable "
, wumpus_afm_font_dir ++ " to point to it."
, ""
, "If you have both environment variables set, the GhostScript loader"
, "will be used."
]