diff --git a/config/settings-default.yaml b/config/settings-default.yaml index 84d9416..1fcd463 100644 --- a/config/settings-default.yaml +++ b/config/settings-default.yaml @@ -38,6 +38,8 @@ ip-from-header: "_env:IP_FROM_HEADER:false" # mutable-static: false # skip-combining: false +# load-font-from-lib-data: false + ############################################################################### # SQL database ############################################################################### diff --git a/src/Diagrams/IntransitiveDAG.hs b/src/Diagrams/IntransitiveDAG.hs index c69dcb7..c2d0807 100644 --- a/src/Diagrams/IntransitiveDAG.hs +++ b/src/Diagrams/IntransitiveDAG.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -39,7 +39,6 @@ import Diagrams.TwoD.Path (stroke) import Diagrams.TwoD.Shapes (roundedRect) import Diagrams.TwoD.Size (width) import Diagrams.Util ((#), with, applyAll) -import Graphics.SVGFonts.Fonts (lin2) import Graphics.SVGFonts.Text (textSVG', TextOpts (..)) --import Yesod.Core.Handler (toTextUrl) @@ -81,18 +80,18 @@ box w h = # fc black # lc plain -textBox n s u = +textBox f n s u = let h = 1 - t = href u $ stroke $ textSVG' with {textFont = lin2, textHeight = h} s + t = href u $ stroke $ textSVG' with {textFont = f, textHeight = h} s t' = t # lc plain w = width t' b = box w h in named n $ t' `atop` b -- intransDag :: Graph g => g a b -> QDiagram -intransDag disp link graph = +intransDag font disp link graph = let ls = layers graph conn (n, _, cs) = map (\ c -> connectOutside c n) cs conns = concatMap (concatMap conn) ls - tbox (n, l, _) = textBox n (disp l) (link l) + tbox (n, l, _) = textBox font n (disp l) (link l) in applyAll conns $ vcat $ map (hcat . map tbox) ls diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 96c1e5f..84287bb 100644 --- a/src/Vervis/Application.hs +++ b/src/Vervis/Application.hs @@ -34,6 +34,8 @@ import Control.Concurrent (forkIO) import Control.Monad.Logger (liftLoc, runLoggingT, logInfo, logError) import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool) +import Graphics.SVGFonts.Fonts (lin2) +import Graphics.SVGFonts.ReadFont (loadFont) import Vervis.Import import Language.Haskell.TH.Syntax (qLocation) import Network.Wai (Middleware) @@ -98,6 +100,11 @@ makeFoundation appSettings = do Nothing -> return Nothing Just _ -> Just <$> newChan + appSvgFont <- + if appLoadFontFromLibData appSettings + then return lin2 + else loadFont "data/LinLibertineCut.svg" + -- We need a log function to create a connection pool. We need a connection -- pool to create our foundation. And we need our foundation to get a -- logging function. To get out of this loop, we initially create a diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index ea8108e..e9b0219 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -22,6 +22,7 @@ import Control.Monad.Trans.Maybe import Data.Time.Interval (fromTimeUnit) import Data.Time.Units (Day) import Database.Persist.Sql (ConnectionPool, runSqlPool) +import Graphics.SVGFonts.ReadFont (PreparedFont) import Text.Shakespeare.Text (textFile) import Text.Hamlet (hamletFile) --import Text.Jasmine (minifym) @@ -61,6 +62,7 @@ data App = App , appHttpManager :: Manager , appLogger :: Logger , appMailQueue :: Maybe (Chan (MailRecipe App)) + , appSvgFont :: PreparedFont Double } -- This is where we define all of the routes in our application. For a full diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index 5fafd6a..8d21d85 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -70,6 +70,10 @@ data AppSettings = AppSettings -- | Perform no stylesheet/script combining , appSkipCombining :: Bool + -- | Load SVG font file from the data file path of the @SVGFonts@ + -- library, instead of the app's production runtime data directory. + , appLoadFontFromLibData :: Bool + -- | Path to the directory under which git repos are placed , appRepoDir :: FilePath -- | Number of context lines to display around changes in commit diff @@ -108,6 +112,8 @@ instance FromJSON AppSettings where appMutableStatic <- o .:? "mutable-static" .!= defaultDev appSkipCombining <- o .:? "skip-combining" .!= defaultDev + appLoadFontFromLibData <- o .:? "load-font-from-lib-data" .!= defaultDev + appRepoDir <- o .: "repo-dir" appDiffContextLines <- o .: "diff-context-lines" appSshPort <- o .: "ssh-port" diff --git a/src/Vervis/Widget/Role.hs b/src/Vervis/Widget/Role.hs index ddc316e..78a36a5 100644 --- a/src/Vervis/Widget/Role.hs +++ b/src/Vervis/Widget/Role.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -29,7 +29,7 @@ import Diagrams.TwoD.Size (mkWidth) import Graphics.Svg.Core (renderText) import Text.Blaze.Html (preEscapedToHtml) import Yesod.Core (Route) -import Yesod.Core.Handler (getUrlRender) +import Yesod.Core.Handler (getsYesod, getUrlRender) import Yesod.Core.Widget (toWidget) import qualified Data.Text as T (unpack) @@ -46,8 +46,9 @@ roleGraph -> Widget roleGraph link shr g = do r <- getUrlRender + font <- getsYesod appSvgFont let dia :: Diagram SVG - dia = intransDag (T.unpack . rl2text) (T.unpack . r . link shr) g + dia = intransDag font (T.unpack . rl2text) (T.unpack . r . link shr) g opts = SVGOptions { _size = mkWidth 480 , _svgDefinitions = Nothing