lang/langfilter/LaantasImage.hs

111 lines
3.1 KiB
Haskell
Raw Normal View History

module LaantasImage
(Image (..), splitImage, splitImage', makeImage)
where
import Lang
import Text.Pandoc.Definition hiding (Image)
import qualified Text.Pandoc.Definition as Pandoc
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 System.Environment
import System.FilePath
import System.Process
data Image =
Image {
text, title :: Text,
file :: FilePath,
size, stroke :: Double,
width :: Int,
color :: Text,
showText :: Bool
} deriving (Eq, Show)
splitImage :: Vars => Text -> Maybe Image
splitImage (Text.uncons -> Just (c, txt))
| c == '!' = Just $ splitImage' txt
| c == '#' = Just $ (splitImage' txt) {showText = False}
splitImage _ = Nothing
splitImage' :: Vars => Text -> Image
splitImage' txt =
case imageOpts txt of
Just (txt, opts) -> defaultImage txt ?defColor
& withOpt opts "file" (\f i -> i {file = makeFile f})
& 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 -> defaultImage 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
defaultImage :: Text -> Text -> Image
defaultImage txt color =
Image {
text = Text.filter notPunc txt,
title = toTitle txt,
file = makeFile txt,
size = 20,
stroke = 0.75,
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
makeFile :: Text -> FilePath
makeFile txt = map stripWeird (Text.unpack txt) <.> "svg"
where stripWeird c = if weirdUrl c then '_' else c
toTitle :: Text -> Text
toTitle = Text.filter \c -> c /= '\\' && c /= '#'
makeImage :: Image -> IO Inline
makeImage (Image {..}) = do
exe <- getEnv "LAANTAS_SCRIPT"
parent <- dropFileName <$> getEnv "FILENAME"
dir <- getEnv "DIRNAME"
let fullFile = dir </> file
let relFile = Text.pack $ makeRelative parent fullFile
callProcess exe
["-S", show size, "-K", show stroke, "-W", show width,
"-C", Text.unpack color, "-t", Text.unpack text, "-o", fullFile]
pure $ Pandoc.Image ("", ["scr","laantas"], []) [] (relFile, title)
weirdUrl :: Char -> Bool
weirdUrl c = c `elem` ("#\\?&_/.·,{} " :: String)
notPunc :: Char -> Bool
notPunc c = c `notElem` ("{}·" :: String)