110 lines
3.0 KiB
Haskell
110 lines
3.0 KiB
Haskell
module LaantasImage
|
|
(Image (..), splitImage, splitImage', makeImage)
|
|
where
|
|
|
|
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 :: Text -> Maybe Image
|
|
splitImage (Text.uncons -> Just (c, txt))
|
|
| c == '!' = Just $ splitImage' txt
|
|
| c == '#' = Just $ (splitImage' txt) {showText = False}
|
|
splitImage _ = Nothing
|
|
|
|
splitImage' :: Text -> Image
|
|
splitImage' txt₀ =
|
|
case imageOpts txt₀ of
|
|
Just (txt, opts) -> defaultImage txt
|
|
& 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₀
|
|
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 -> Image
|
|
defaultImage txt =
|
|
Image {
|
|
text = Text.filter notPunc txt,
|
|
title = toTitle txt,
|
|
file = makeFile txt,
|
|
size = 20,
|
|
stroke = 0.75,
|
|
width = 600,
|
|
color = "hsl(340deg, 50%, 35%)",
|
|
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)
|