From 3b9a13d29cd1564a0c4ac487fee22838c001f498 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 17 Aug 2017 14:13:39 +0200 Subject: [PATCH] added Cols, fixed Media --- app/Cols.hs | 55 +++++++++++++++++++++++++++++++++++++++ app/Media.hs | 48 +++++++++++++++++++++++----------- pandoc-slide-filter.cabal | 9 +++++++ 3 files changed, 97 insertions(+), 15 deletions(-) create mode 100644 app/Cols.hs diff --git a/app/Cols.hs b/app/Cols.hs new file mode 100644 index 0000000..74b4378 --- /dev/null +++ b/app/Cols.hs @@ -0,0 +1,55 @@ +#!/usr/bin/env runhaskell +{-# LANGUAGE ScopedTypeVariables #-} + +import Text.Pandoc.JSON +import Text.Pandoc.Definition +import Text.Pandoc.Generic (topDown) +import Control.Exception +import Data.Monoid ((<>)) +import Data.List (partition, elem) +import System.FilePath +import Debug.Trace (trace) +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) + +main :: IO () +main = toJSONFilter (topDown cols :: Pandoc -> Pandoc) + +cols :: [Block] -> [Block] +cols (h@(Header 2 attr [Str wa,Space,Str wb]):a:b:rest) = + outerDiv:rest + where + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + total = wa' + wb' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b + , clearDiv + ] +cols (h@(Header 3 attr [Str wa,Space,Str wb,Space,Str wc]):a:b:c:rest) = + outerDiv:rest + where + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + wc' = fromMaybe 1 (readMaybe wc) :: Int + total = wa' + wb' + wc' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + pc = (100*wc') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b + , makeDiv pc c + , clearDiv + ] +cols x = x + +makeDiv :: Int -> Block -> Block +makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content] + +clearDiv :: Block +clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml " "]] + +toHtml :: String -> Inline +toHtml = RawInline (Format "html") diff --git a/app/Media.hs b/app/Media.hs index 9b3a4ac..5b3c337 100644 --- a/app/Media.hs +++ b/app/Media.hs @@ -12,25 +12,25 @@ main = toJSONFilter media -- | File-extensions that should be treated as audio audioExt :: [String] -audioExt = ["mp3","aac"] +audioExt = [".mp3",".aac"] -- | File-extensions that should be treated as video videoExt :: [String] -videoExt = [ "avi" - , "mp4" - , "mov" +videoExt = [ ".avi" + , ".mp4" + , ".mov" ] -- | File-extensions that should be treated as image imgExt :: [String] imgExt = - [ "jpg" - , "jpeg" - , "png" - , "gif" - , "tif" - , "tiff" - , "bmp" + [ ".jpg" + , ".jpeg" + , ".png" + , ".gif" + , ".tif" + , ".tiff" + , ".bmp" ] -- | File-extensions that should be treated as demo and will be included @@ -103,7 +103,7 @@ media (Image (id', att, att') alt (filename,_)) (direct, css) = classToPlain att --load svg and dump it in media (Image (id', att, att') [] (filename,_)) - | id' == "svg" || (takeExtension filename == "svg") + | id' == "svg" || (takeExtension filename == ".svg") = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ do svg <- readFile filename @@ -113,7 +113,7 @@ media (Image (id', att, att') [] (filename,_)) where (direct, css) = classToPlain att media (Image (id', att, att') alt (filename,_)) - | id' == "svg" || (takeExtension filename == "svg") + | id' == "svg" || (takeExtension filename == ".svg") = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $ do svg <- readFile filename @@ -143,9 +143,27 @@ media (Image (id', att, att') alt (filename,_)) media x = return [x] +-- | converts Attributes to String for usage in HTML +-- +-- Also converts width=xxx and height=xxx to the +-- corresponding style-attributes attToString :: Attr -> String -attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) -attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) +attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs +attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs + +convertToStyle :: [String] -> [(String,String)] -> [(String,String)] +convertToStyle keys kvpairs = ("style", newstyle):rest + where + oldstyle = case filter (\(k,v) -> k == "style") kvpairs of + [] -> "" + [(_,st)] -> st + stylesToAdd = filter (\(k,v) -> k `elem` keys) kvpairs + rest = filter (\(k,v) -> not $ k `elem` keys) kvpairs + newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle idFilter :: String -> String -> String diff --git a/pandoc-slide-filter.cabal b/pandoc-slide-filter.cabal index 1d3d65b..0167c56 100644 --- a/pandoc-slide-filter.cabal +++ b/pandoc-slide-filter.cabal @@ -22,6 +22,15 @@ executable media , filepath default-language: Haskell2010 +executable cols + hs-source-dirs: app + main-is: Cols.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , pandoc-types + , filepath + default-language: Haskell2010 + executable styling hs-source-dirs: app main-is: Styling.hs