{-# LANGUAGE ImplicitParams, ScopedTypeVariables, OverloadedStrings #-}
module Graphics.UI.FLTK.Theme.Light.Assets
(
Assets
, loadAssets
, dejaVuSans
, josefinSlabSemiBold
, yanoneKaffesatz
, cancelButtonImage
, downSmallImage
, forwardImage
, leftImage
, okButtonImage
, returnButtonImage
, rewindImage
, rightImage
, upSmallImage
)
where
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.FLTKHS
import qualified Data.Text as T
import Data.List
import qualified Graphics.UI.FLTK.LowLevel.FL as FL
import qualified Data.ByteString as B
import Control.Exception
import Graphics.UI.Font.Load
import Data.Maybe
import Control.Monad
import Paths_fltkhs_themes
data Assets =
Assets
{
_dejaVuSans :: Font
, _yanoneKaffesatz :: Font
, _josefinSlabSemiBold :: Font
, _returnButtonImage :: Ref PNGImage
, _okButtonImage :: Ref PNGImage
, _cancelButtonImage :: Ref PNGImage
, _downSmallImage :: Ref PNGImage
, _upSmallImage :: Ref PNGImage
, _forwardImage :: Ref PNGImage
, _rewindImage :: Ref PNGImage
, _leftImage :: Ref PNGImage
, _rightImage :: Ref PNGImage
} deriving Show
dejaVuSans :: (?assets :: Assets) => Font
dejaVuSans = _dejaVuSans ?assets
yanoneKaffesatz :: (?assets :: Assets) => Font
yanoneKaffesatz = _yanoneKaffesatz ?assets
josefinSlabSemiBold :: (?assets :: Assets) => Font
josefinSlabSemiBold = _josefinSlabSemiBold ?assets
returnButtonImage :: (?assets :: Assets) => Ref PNGImage
returnButtonImage = _returnButtonImage ?assets
okButtonImage :: (?assets :: Assets) => Ref PNGImage
okButtonImage = _okButtonImage ?assets
cancelButtonImage :: (?assets :: Assets) => Ref PNGImage
cancelButtonImage = _cancelButtonImage ?assets
downSmallImage :: (?assets :: Assets) => Ref PNGImage
downSmallImage = _downSmallImage ?assets
upSmallImage :: (?assets :: Assets) => Ref PNGImage
upSmallImage = _upSmallImage ?assets
forwardImage :: (?assets :: Assets) => Ref PNGImage
forwardImage = _forwardImage ?assets
rewindImage :: (?assets :: Assets) => Ref PNGImage
rewindImage = _rewindImage ?assets
leftImage :: (?assets :: Assets) => Ref PNGImage
leftImage = _leftImage ?assets
rightImage :: (?assets :: Assets) => Ref PNGImage
rightImage = _rightImage ?assets
fonts :: [FilePath]
fonts =
[
"fonts/DejaVuSans.ttf"
, "fonts/YanoneKaffeesatz-Regular.ttf"
, "fonts/JosefinSlab-SemiBold.ttf"
]
fontNames :: [T.Text]
fontNames =
[
"DejaVu Sans"
, "Yanone Kaffeesatz Regular"
, "Josefin Slab"
]
imagePaths :: [FilePath]
imagePaths =
[
"images/dialog-ok.png"
, "images/dialog-apply.png"
, "images/dialog-cancel.png"
, "images/down-small.png"
, "images/up-small.png"
, "images/forward.png"
, "images/rewind.png"
, "images/left.png"
, "images/right.png"
]
loadAssets :: IO Assets
loadAssets = do
fontPaths <- mapM getDataFileName fonts
loaded <- mapM loadFont fontPaths
let errors = catMaybes (Data.List.map (\p -> case p of { Left err -> Just err; _ -> Nothing}) loaded)
when (not (Data.List.null errors))
(ioError (userError ("loadAssets (fatal error): unable to load font assets for the Light theme:\n" ++
(Data.List.concat (Data.List.intersperse "\n" errors)))))
ips <- mapM getDataFileName imagePaths
images <- mapM
(\p -> do
bytes <- B.readFile p `catch`
(\(e :: SomeException) -> ioError
(userError ("loadAssets (fatal error): image does not exist at path: " ++ p)))
iE <- pngImageNewWithData (T.pack "") bytes
case iE of
Left _ -> ioError (userError ("loadAssets (fatal error): unable to read image data into a PNGImage:\n" ++ p))
Right i -> return i)
ips
numFaces <- FL.setFonts Nothing
let fonts = Prelude.map Font [0 .. numFaces - 1 ]
withFaces <- mapM
(
\f -> do
(face,_) <- FL.getFontName f
return (face,f)
)
fonts
let fontNumbers = catMaybes (Data.List.map (\fName -> Prelude.lookup fName withFaces) fontNames)
_ <- FL.setScheme "gtk+"
let addImages as = as (images !! 0)
(images !! 1)
(images !! 2)
(images !! 3)
(images !! 4)
(images !! 5)
(images !! 6)
(images !! 7)
(images !! 8)
assets =
if (Data.List.length fontNumbers /= Data.List.length fontNames)
then addImages (Assets helvetica helvetica helvetica )
else addImages (Assets (fontNumbers !! 0) (fontNumbers !! 1) (fontNumbers !! 2))
return assets