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