added Cols, fixed Media

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 "&nbsp;"]]
+
+toHtml :: String -> Inline
+toHtml = RawInline (Format "html")

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 <> "<br />" <> 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 <> "<br />" <> 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

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