Add font config support

app/Main.hs

@@ -28,7 +28,7 @@ main = do
         & L.basic . L.fgColor .~ blue
         & L.hover . L.fgColor .~ white
         & L.focus . L.fgColor .~ white
-  let config = [windowSize (1280, 960), useHdpi True]
+  let config = [windowSize (1280, 960), useHdpi True, fontDef "sans" "./assets/fonts/Roboto-Italic.ttf"]
 
   --simpleApp model (Just InitApp) theme handleAppEvent buildUI config
   simpleApp_ model (Just InitApp) theme handleAppEvent buildUI config
@@ -54,11 +54,11 @@ buildUI model = trace "Creating UI" widgetTree where
         radioV (model ^. fruit) RadioSt Orange,
         radioV (model ^. fruit) RadioSt Pear
       ] `key` "radio hstack" `style` [bgColor gray],
-      hstack [
-        checkbox condition1,
-        checkbox condition2,
-        checkbox condition3,
-        checkbox_ condition1 [onChange CheckboxSt]
+      vstack [
+        hstack [label "Label 1", box $ checkbox condition1],
+        hstack [label "Label 12", box $ checkbox condition2],
+        hstack [label "Label 123", box $ checkbox condition3],
+        hstack [label "Label 1234", box $ checkbox_ condition1 [onChange CheckboxSt]]
       ],
       hgrid [
         label_ "This is a really long label used to check what I did works fine" [textEllipsis],

src/Monomer/Graphics/Lens.hs

@@ -6,6 +6,8 @@ module Monomer.Graphics.Lens where
 
 import Control.Lens.TH (abbreviatedFields, makeLensesWith)
 
+import Monomer.Core.Lens
 import Monomer.Graphics.Types
 
 makeLensesWith abbreviatedFields ''Color
+makeLensesWith abbreviatedFields ''FontDef

src/Monomer/Graphics/NanoVGRenderer.hs

@@ -3,7 +3,7 @@
 
 module Monomer.Graphics.NanoVGRenderer (makeRenderer) where
 
-import Control.Monad (foldM, unless, when)
+import Control.Monad (foldM, forM_, unless, when)
 import Data.IORef
 import Data.List (foldl')
 import Data.Maybe
@@ -64,10 +64,12 @@ data CRect
   = CRect CFloat CFloat CFloat CFloat
   deriving (Eq, Show)
 
-makeRenderer :: Double -> IO Renderer
-makeRenderer dpr = do
+makeRenderer :: [FontDef] -> Double -> IO Renderer
+makeRenderer fonts dpr = do
   c <- VG.createGL3 (Set.fromList [VG.Antialias, VG.StencilStrokes, VG.Debug])
-  _ <- VG.createFont c "sans" (VG.FileName "./assets/fonts/Roboto-Regular.ttf")
+
+  forM_ fonts $ \(FontDef name path) ->
+    VG.createFont c name (VG.FileName path)
 
   lock <- L.new
   envRef <- newIORef $ Env {

src/Monomer/Graphics/Types.hs

@@ -25,6 +25,11 @@ instance Semigroup Color where
 instance Default Color where
   def = Color 255 255 255 1.0
 
+data FontDef = FontDef {
+  _fntName :: Text,
+  _fntPath :: Text
+}
+
 newtype Font
   = Font { unFont :: Text }
   deriving (Eq, Show)

src/Monomer/Main/Core.hs

@@ -55,7 +55,9 @@ simpleApp
   -> UIBuilder s e
   -> IO ()
 simpleApp model initEvent theme eventHandler uiBuilder =
-  simpleApp_ model initEvent theme eventHandler uiBuilder def
+  simpleApp_ model initEvent theme eventHandler uiBuilder [config]
+  where
+    config = fontDef "sans" "./assets/fonts/Roboto-Regular.ttf"
 
 simpleApp_
   :: (Eq s, Typeable s, Typeable e)
@@ -64,7 +66,7 @@ simpleApp_
   -> Theme
   -> EventHandler s e ()
   -> UIBuilder s e
-  -> [AppConfig e]
+  -> [AppConfig]
   -> IO ()
 simpleApp_ model initEvent theme eventHandler uiBuilder configs = do
   window <- initSDLWindow config
@@ -73,7 +75,7 @@ simpleApp_ model initEvent theme eventHandler uiBuilder configs = do
   let dpr = _sW winSize / fromIntegral winW
   let monomerContext = initMonomerContext () winSize useHdpi dpr
 
-  runStateT (runApp window theme appWidget) monomerContext
+  runStateT (runApp window config theme appWidget) monomerContext
   detroySDLWindow window
   where
     config = mconcat configs
@@ -81,8 +83,13 @@ simpleApp_ model initEvent theme eventHandler uiBuilder configs = do
     useHdpi = fromMaybe defaultUseHdpi (_apcHdpi config)
     appWidget = composite "app" model initEvent eventHandler uiBuilder
 
-runApp :: (MonomerM s m) => SDL.Window -> Theme -> WidgetInstance s e -> m ()
-runApp window theme widgetRoot = do
+runApp
+  :: (MonomerM s m)
+  => SDL.Window
+  -> AppConfig
+  -> Theme
+  -> WidgetInstance s e -> m ()
+runApp window config theme widgetRoot = do
   useHiDPI <- use hdpi
   devicePixelRate <- use dpr
   Size rw rh <- use L.windowSize
@@ -94,7 +101,7 @@ runApp window theme widgetRoot = do
   startTs <- fmap fromIntegral SDL.ticks
   model <- use mainModel
   os <- getPlatform
-  renderer <- liftIO $ makeRenderer dpr
+  renderer <- liftIO $ makeRenderer (config ^. L.fonts) dpr
   let wenv = WidgetEnv {
     _weOS = os,
     _weRenderer = renderer,

src/Monomer/Main/Platform.hs

@@ -24,7 +24,7 @@ import Monomer.Widgets.Composite
 
 foreign import ccall unsafe "initGlew" glewInit :: IO CInt
 
-initSDLWindow :: AppConfig e -> IO SDL.Window
+initSDLWindow :: AppConfig -> IO SDL.Window
 initSDLWindow config = do
   SDL.initialize [SDL.InitVideo]
   SDL.HintRenderScaleQuality $= SDL.ScaleLinear

src/Monomer/Main/Types.hs

@@ -11,6 +11,7 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM.TChan
 import Control.Monad.State
 import Data.Default
+import Data.Text (Text)
 import Data.Typeable (Typeable)
 import Data.Sequence (Seq)
 
@@ -18,6 +19,7 @@ import Monomer.Core.BasicTypes
 import Monomer.Core.Combinators
 import Monomer.Core.StyleTypes
 import Monomer.Event.Types
+import Monomer.Graphics.Types
 
 type MonomerM s m = (Eq s, MonadState (MonomerContext s) m, MonadIO m)
 
@@ -38,32 +40,40 @@ data MonomerContext s = MonomerContext {
   _mcWidgetTasks :: Seq WidgetTask
 }
 
-data AppConfig e = AppConfig {
+data AppConfig = AppConfig {
   _apcWindowSize :: Maybe (Int, Int),
-  _apcHdpi :: Maybe Bool
+  _apcHdpi :: Maybe Bool,
+  _apcFonts :: [FontDef]
 }
 
-instance Default (AppConfig e) where
+instance Default AppConfig where
   def = AppConfig {
     _apcWindowSize = Nothing,
-    _apcHdpi = Nothing
+    _apcHdpi = Nothing,
+    _apcFonts = []
   }
 
-instance Semigroup (AppConfig e) where
+instance Semigroup AppConfig where
   (<>) a1 a2 = AppConfig {
     _apcWindowSize = _apcWindowSize a2 <|> _apcWindowSize a1,
-    _apcHdpi = _apcHdpi a2 <|> _apcHdpi a1
+    _apcHdpi = _apcHdpi a2 <|> _apcHdpi a1,
+    _apcFonts = _apcFonts a1 ++ _apcFonts a2
   }
 
-instance Monoid (AppConfig e) where
+instance Monoid AppConfig where
   mempty = def
 
-instance WindowSize (AppConfig e) (Int, Int) where
+instance WindowSize AppConfig (Int, Int) where
   windowSize size = def {
     _apcWindowSize = Just size
   }
 
-useHdpi :: Bool -> AppConfig e
+useHdpi :: Bool -> AppConfig
 useHdpi use = def {
   _apcHdpi = Just use
 }
+
+fontDef :: Text -> Text -> AppConfig
+fontDef name path = def {
+  _apcFonts = [ FontDef name path ]
+}

tasks.md

@@ -191,8 +191,6 @@
   - Improve spacer
   - Remove Tree
   - Check why image dissapears when model changes (missing merge)
-
-- Pending
   - Reorganize modules.
     -  Common and Widget merged into new Core?
     -  Widget.Widgets moved to Widget?
@@ -203,6 +201,8 @@
     -  Create Lens.hs in each module instead of directory
     -  Clean up checkbox/radio (fgcolor, etc)
   - Simplify Main.hs by abstracting SDL initialization
+
+- Pending
   - Check if textBounds is enough, or we're missing descending part of font
     - getFullTextSize should be used?
   - Add center, right components based on box
@@ -227,6 +227,7 @@
   - Add user documentation
 
 Maybe postponed after release?
+  - Validate font exists before using it in NanoVG (crashes otherwise)
   - Do not draw non visible items in grid/stack (outside viewport)
   - Further textField improvements
     - Handle mouse selection