lang/langfilter/LaantasImage.hs

94 lines
2.5 KiB
Haskell

module LaantasImage
(Item (..), splitItem, splitItem', makeItem)
where
import Lang
import Text.Pandoc.Definition
import Data.Bifunctor
import Data.Function
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import qualified Laantas
data Item =
Item {
text, title :: Text,
size, stroke :: Double,
width :: Double,
color :: Text,
showText :: Bool
} deriving (Eq, Show)
splitItem :: Vars => Text -> Maybe Item
splitItem (Text.uncons -> Just (c, txt))
| c == '!' = Just $ splitItem' txt
| c == '#' = Just $ (splitItem' txt) {showText = False}
splitItem _ = Nothing
splitItem' :: Vars => Text -> Item
splitItem' txt =
case imageOpts txt of
Just (txt, opts) -> defaultItem txt ?defColor
& withOpt opts "size" (\s i -> i {size = readt s})
& withOpt opts "stroke" (\k i -> i {stroke = readt k})
& withOpt opts "width" (\w i -> i {width = readt w})
& withOpt opts "color" (\c i -> i {color = c})
Nothing -> defaultItem txt ?defColor
where readt x = read $ Text.unpack x
withOpt :: Ord k => Map k v -> k -> (v -> a -> a) -> (a -> a)
withOpt m k f =
case Map.lookup k m of
Just v -> f v
Nothing -> id
defaultItem :: Text -> Text -> Item
defaultItem txt color =
Item {
text = Text.filter notPunc txt,
title = toTitle txt,
size = 2,
stroke = 1.25,
width = 600,
color = color,
showText = True
}
split1 :: Text -> Text -> Maybe (Text, Text)
split1 s txt =
let (a, b) = Text.breakOn s txt in
if Text.null b then
Nothing
else
Just (Text.strip a, Text.strip $ Text.drop (Text.length s) b)
type Opts = Map Text Text
imageOpts :: Text -> Maybe (Text, Opts)
imageOpts = fmap (second splitOpts) . getOpts
getOpts :: Text -> Maybe (Text, Text)
getOpts = split1 "|"
splitOpts :: Text -> Map Text Text
splitOpts = Map.fromList . map splitOpt . Text.splitOn ";" where
splitOpt txt = fromMaybe ("file", txt) $ split1 "=" txt
toTitle :: Text -> Text
toTitle = Text.filter \c -> c /= '\\' && c /= '#'
makeItem :: Item -> Inline
makeItem (Item {..}) =
let env = Laantas.E {..}
words = Laantas.split text in
RawInline "html" $ Lazy.toStrict $ Laantas.prettyText $
Laantas.doGlyphsNoDoctype words env `Laantas.with`
[Laantas.Class_ Laantas.<<- "scr"]
notPunc :: Char -> Bool
notPunc c = c `notElem` ("{}·" :: String)