-- | To be able to run this example,
--
-- * install the GLFW-b library (for example using cabal)
--
-- * download the STIX2 font files in OTF format from <https://github.com/stipub/stixfonts>,
-- and put them in this directory (5 files with @.otf@ extension)
--
-- * compile this source file with @ghc -O --make -threaded@
--
module Main where
--------------------------------------------------------------------------------
import Data.Char hiding ( Space )
import Control.Monad
import Data.IORef
import System.IO.Unsafe as Unsafe
import qualified Data.Map as Map ; import Data.Map (Map)
import Graphics.Rendering.OpenGL as GL
import Graphics.UI.GLFW ( Window )
import Graphics.Rendering.MiniTypeset
import GL
import UnicodeMath
--------------------------------------------------------------------------------
-- * The \"document\" we want to render (normally you want to generate this)
document :: Document String
document
= Identified "document"
$ VertCat AlignRight
[ block12
, Space
, block3
]
block12 = HorzCat AlignBottom [ block1 , Space , block2 ]
block1 = Identified "block1"
$ VertCat AlignLeft [line1a,line1b,line1c,line1d]
block2 = VertCat AlignRight [line2a,line2b,line2c,line2d,line2e]
block3 = Identified "block3"
$ VertCat AlignLeft [ WithColor (Col 1 1 0) (String greeks), Space, WithColor (Col 1 1 1) equ ]
line1a = String "Lorem ipsum dolor sit amet,"
line1b = WithColor (Col 0.7 0 0)
$ String "consectetur adipiscing elit,"
line1c = Identified "line1c"
$ WithStyle Italic
$ String "sed do eiusmod tempor incididunt"
line1d = HorzCat AlignBottom
[ String "ut labore et "
, Identified "dolore" $ WithStyle BoldItalic $ WithColor (Col 0 0 0.75) $ String "dolore"
, String " magna aliqua."
]
line2a = String "Ut enim ad minim veniam,"
line2b = Identified "line2b"
$ WithStyle Bold
$ String "quis nostrud exercitation"
line2c = String "ullamco laboris nisi ut"
line2d = WithColor (Col 0 0.4 0)
$ WithStyle BoldItalic
$ String "aliquip ex ea commodo"
line2e = String "consequat."
equ = HorzCat AlignBottom
[ String $ take 8 math_test
, Identified "formula" $ WithColor (Col 0.5 0.5 1) $ String $ take 5 (drop 8 math_test)
, String $ drop 13 math_test
]
--------------------------------------------------------------------------------
-- | An enum encoding the font files we use
data MyFontFile
= Stix2TextRegular
| Stix2TextBold
| Stix2TextItalic
| Stix2TextBoldItalic
| Stix2Math
deriving (Eq,Ord,Show)
-- | An enum encoding our typeface variations
data MyStyle
= MyRegular
| MyBold
| MyItalic
| MyBoldItalic
| MyMath
deriving (Eq,Ord,Show)
-- | Mapping standard typeface variations to ours
myStyleMap :: BasicStyle -> MyStyle
myStyleMap s = case s of
Regular -> MyRegular
Bold -> MyBold
Italic -> MyItalic
BoldItalic -> MyBoldItalic
-- | Mapping typeface variatons to abstract fonts (not always necessary)
myStyleDefaultFont :: MyStyle -> MyFontFile
myStyleDefaultFont style = case style of
MyRegular -> Stix2TextRegular
MyBold -> Stix2TextBold
MyItalic -> Stix2TextItalic
MyBoldItalic -> Stix2TextBoldItalic
MyMath -> Stix2Math
-- | Mapping abstract font files to concrete font files
myFontFileMap :: MyFontFile -> FilePath
myFontFileMap ff = case ff of
Stix2TextRegular -> "STIX2Text-Regular.otf"
Stix2TextBold -> "STIX2Text-Bold.otf"
Stix2TextItalic -> "STIX2Text-Italic.otf"
Stix2TextBoldItalic -> "STIX2Text-BoldItalic.otf"
Stix2Math -> "STIX2Math.otf"
-- | Mapping (style,codepoint) pairs to (abstract) font files.
-- For example mathematical symbols are not present in the regular fonts, so
-- we always map them to the math font.
--
myCharMap :: MyStyle -> Char -> MyFontFile
myCharMap MyMath _ = Stix2Math
myCharMap style ch
| o <= 0x2100 = myStyleDefaultFont style
| o >= 0xfb00 = myStyleDefaultFont style
| otherwise = Stix2Math
where
o = ord ch
-- | Our \"multifont\" configuration
myUFC :: UserFontConfig MyFontFile MyStyle
myUFC = UserFontConfig
{ _ufcFontFiles = myFontFileMap
, _ufcCharMap = myCharMap
, _ufcStyleMap = myStyleMap
}
theMultiFont :: IORef (MultiFont MyFontFile MyStyle)
theMultiFont = Unsafe.unsafePerformIO $ newIORef $ error "multifont not loaded"
--------------------------------------------------------------------------------
display :: Window -> Double -> IO ()
display window time = do
clearColor $=! (Color4 0.5 0.5 0.5 1)
clear [ColorBuffer,DepthBuffer]
setWindowCoordSystem
mf <- readIORef theMultiFont
-- create layout
lout <- createLayout mf (Height 40) document
-- top-left corner of the rendered text
let pos0 = Pos 16 16
-- query bounding box positions, and render them
usertable <- dryrunLayout lout pos0
color $ Color4 1 1 1 (0.1 :: Double)
blend $=! Enabled
blendFunc $=! (SrcAlpha,One) -- MinusSrcAlpha)
mapM_ renderOuterBoxQuad (Map.elems usertable)
blend $=! Disabled
-- render the text
renderLayout lout pos0
return ()
--------------------------------------------------------------------------------
initMultifont = do
mf <- newMultiFont myUFC
writeIORef theMultiFont mf
return ()
main = do
initGL initMultifont (\() -> display)
--------------------------------------------------------------------------------