{-# LANGUAGE ImplicitParams, ScopedTypeVariables, OverloadedStrings #-} {-| Module: Graphics.UI.FLTK.Theme.Assets A module that allows access to the resources (fonts, images, etc.) bundled with this theme. Clients of this package should not need to directly include this module since @Graphics.UI.FLTK.Theme.Light@ re-exports it. -} module Graphics.UI.FLTK.Theme.Light.Assets ( -- * Assets -- ** Description & Usage #AssetsDescriptionAndUsage# -- $Assets -- -- ** Why ImplicitParams? #WhyImplicitParams# -- -- $WhyImplicitParams Assets , loadAssets -- * Fonts -- -- $Fonts , dejaVuSans , josefinSlabSemiBold , yanoneKaffesatz -- * Images -- -- $Images , 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 -- | An opaque type that contains all of the resources needed by this theme. -- Getting to the resources requires threading something of the type as an implicit -- parameter to the accessors below, eg. 'dejaVuSans'. 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 -- | The [standard font](https://www.fontsquirrel.com/fonts/dejavu-sans) used for most labels, titles, output etc. dejaVuSans :: (?assets :: Assets) => Font dejaVuSans = _dejaVuSans ?assets -- | Currently unused but a [nice font](https://www.yanone.de/fonts/kaffeesatz/) around for the future ... yanoneKaffesatz :: (?assets :: Assets) => Font yanoneKaffesatz = _yanoneKaffesatz ?assets -- | A nice [banner font](https://www.fontsquirrel.com/fonts/josefin-slab). 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 -- | The down arrow. -- -- <> downSmallImage :: (?assets :: Assets) => Ref PNGImage downSmallImage = _downSmallImage ?assets -- | The up arrow. -- -- <> 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" ] -- | Used at app start time to load the resources of this theme into memory. -- This should never be called directly, but through -- 'Graphics.UI.FLTK.Theme.Light.Common.configureTheme' which does some other -- setup. 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 -- $Assets -- This module mediates access to fonts, images and whatever other data is needed -- by this theme. To provide a consistent look-and-feel across platforms the theme -- bundles whatever it needs and loads them when a user's app is started. The -- loaded assets should not interfere with any other process thread. For example, -- when a user's application starts up the 'dejaVuSansMono' font is loaded into the -- font cache, but it should be isolated to the app's process. -- -- -- To use the assets in an FLTK app you need to enable the @ImplicitParams@ -- pragma and then pass the 'Assets' implicit constraint to every function that -- needs the resources: -- -- @ -- {-\# LANGUAGE ImplicitParams ...\#-} -- ... -- myAwesomeUI :: (?assets :: Assets) => ... -- myAwesomeUI = do -- ... -- b <- buttonNew ... -- setLabelFont b dejaVuSansMono -- ... -- @ -- -- For more extensive documentation on how to use assets in the context of a -- full application see "Graphics.UI.FLTK.Theme.Light#GettingStarted". -- $WhyImplicitParams -- [ImplicitParams](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#implicit-parameters) -- is a fairly contentious extension because of how it interacts with -- [recursion](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#implicit-parameters-and-polymorphic-recursion) -- and the dangers of accidental name-shadowing. The two alternatives are -- [Reader](http://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Reader.html) -- and [reflection](http://hackage.haskell.org/package/reflection). While both -- are more principled the first requires all UI functions have a 'MonadReader' -- constraint which makes the API way uglier and harder to use, and the second -- incurs a dependency on -- [template-haskell](http://hackage.haskell.org/package/template-haskell) which -- I also did not want. /ImplicitParams/ are easier to use and have been in GHC -- since 6.8.1 and since we're just threading through some fonts and images -- hopefully the downsides won't become a big deal in practice. -- $Fonts -- The fonts required by this theme, all are TTF.