@@ -17,15 +17,17 @@ module Text.Pandoc.Writers.ICML (writeICML) where
1717import Text.Pandoc.Definition
1818import Text.Pandoc.XML
1919import Text.Pandoc.Writers.Shared
20−import Text.Pandoc.Shared (splitBy)
20+import Text.Pandoc.Shared (splitBy, fetchItem, warn)
2121import Text.Pandoc.Options
2222import Text.Pandoc.Templates (renderTemplate')
2323import Text.Pandoc.Pretty
24+import Text.Pandoc.ImageSize
2425import Data.List (isPrefixOf, isInfixOf, stripPrefix)
2526import Data.Text as Text (breakOnAll, pack)
2627import Data.Monoid (mappend)
2728import Control.Monad.State
2829import Network.URI (isURI)
30+import System.FilePath (pathSeparator)
2931import qualified Data.Set as Set
3032
3133type Style = [String]
@@ -39,7 +41,7 @@ data WriterState = WriterState{
3941 , maxListDepth :: Int
4042 }
4143
42−type WS a = State WriterState a
44+type WS a = StateT WriterState IO a
4345
4446defaultWriterState :: WriterState
4547defaultWriterState = WriterState{
@@ -118,27 +120,27 @@ citeName = "Cite"
118120
119121
120122-- | Convert Pandoc document to string in ICML format.
121−writeICML :: WriterOptions -> Pandoc -> String
122−writeICML opts (Pandoc meta blocks) =
123+writeICML :: WriterOptions -> Pandoc -> IO String
124+writeICML opts (Pandoc meta blocks) = do
123125 let colwidth = if writerWrapText opts
124126 then Just $ writerColumns opts
125127 else Nothing
126128 render' = render colwidth
127− renderMeta f s = Just $ render' $ fst $ runState (f opts [] s) defaultWriterState
128− Just metadata = metaToJSON opts
129− (renderMeta blocksToICML)
130− (renderMeta inlinesToICML)
131− meta
132− (doc, st) = runState (blocksToICML opts [] blocks) defaultWriterState
133− main = render' doc
129+ renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
130+ metadata <- metaToJSON opts
131+ (renderMeta blocksToICML)
132+ (renderMeta inlinesToICML)
133+ meta
134+ (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
135+ let main = render' doc
134136 context = defField "body" main
135137 $ defField "charStyles" (render' $ charStylesToDoc st)
136138 $ defField "parStyles" (render' $ parStylesToDoc st)
137139 $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st)
138140 $ metadata
139− in if writerStandalone opts
140− then renderTemplate' (writerTemplate opts) context
141− else main
141+ return $ if writerStandalone opts
142+ then renderTemplate' (writerTemplate opts) context
143+ else main
142144
143145-- | Auxilary functions for parStylesToDoc and charStylesToDoc.
144146contains :: String -> (String, (String, String)) -> [(String, String)]
@@ -427,7 +429,7 @@ inlineToICML opts style (Link lst (url, title)) = do
427429 cont = inTags True "HyperlinkTextSource"
428430 [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content
429431 in (cont, newst)
430−inlineToICML opts style (Image alt target) = imageICML opts style alt target
432+inlineToICML opts style (Image attr alt target) = imageICML opts style attr alt target
431433inlineToICML opts style (Note lst) = footnoteToICML opts style lst
432434inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst
433435
@@ -500,39 +502,48 @@ styleToStrAttr style =
500502 in (stlStr, attrs)
501503
502504-- | Assemble an ICML Image.
503−imageICML :: WriterOptions -> Style -> [Inline] -> Target -> WS Doc
504−imageICML _ style _ (linkURI, _) =
505− let imgWidth = 300::Int --TODO: set width, height dynamically as in Docx.hs
506− imgHeight = 200::Int
507− scaleFact = show (1::Double) --TODO: set scaling factor so image is scaled exactly to imgWidth x imgHeight
508− hw = show $ imgWidth `div` 2
509− hh = show $ imgHeight `div` 2
510− qw = show $ imgWidth `div` 4
511− qh = show $ imgHeight `div` 4
512− uriPrefix = if isURI linkURI then "" else "file:"
505+imageICML :: WriterOptions -> Style -> Attr -> [Inline] -> Target -> WS Doc
506+imageICML opts style attr _ (src, _) = do
507+ res <- liftIO $ fetchItem (writerSourceURL opts) src
508+ imgS <- case res of
509+ Left (_) -> do
510+ liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
511+ return def
512+ Right (img, _) -> do
513+ case imageSize img of
514+ Right size -> return size
515+ Left msg -> do
516+ return $ warn $ "Could not determine image size in `" ++
517+ src ++ "': " ++ msg
518+ return def
519+ let (ow, oh) = sizeInPoints imgS
520+ (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS
521+ hw = showFl $ ow / 2
522+ hh = showFl $ oh / 2
523+ scale = showFl (imgWidth / ow) ++ " 0 0 " ++ showFl (imgHeight / oh)
524+ src' = if isURI src then src else "file://." ++ pathSeparator : src
513525 (stlStr, attrs) = styleToStrAttr style
514526 props = inTags True "Properties" [] $ inTags True "PathGeometry" []
515527 $ inTags True "GeometryPathType" [("PathOpen","false")]
516528 $ inTags True "PathPointArray" []
517529 $ vcat [
518− selfClosingTag "PathPointType" [("Anchor", "-"++qw++" -"++qh),
519− ("LeftDirection", "-"++qw++" -"++qh), ("RightDirection", "-"++qw++" -"++qh)]
520− , selfClosingTag "PathPointType" [("Anchor", "-"++qw++" "++qh),
521− ("LeftDirection", "-"++qw++" "++qh), ("RightDirection", "-"++qw++" "++qh)]
522− , selfClosingTag "PathPointType" [("Anchor", qw++" "++qh),
523− ("LeftDirection", qw++" "++qh), ("RightDirection", qw++" "++qh)]
524− , selfClosingTag "PathPointType" [("Anchor", qw++" -"++qh),
525− ("LeftDirection", qw++" -"++qh), ("RightDirection", qw++" -"++qh)]
530+ selfClosingTag "PathPointType" [("Anchor", "-"++hw++" -"++hh),
531+ ("LeftDirection", "-"++hw++" -"++hh), ("RightDirection", "-"++hw++" -"++hh)]
532+ , selfClosingTag "PathPointType" [("Anchor", "-"++hw++" "++hh),
533+ ("LeftDirection", "-"++hw++" "++hh), ("RightDirection", "-"++hw++" "++hh)]
534+ , selfClosingTag "PathPointType" [("Anchor", hw++" "++hh),
535+ ("LeftDirection", hw++" "++hh), ("RightDirection", hw++" "++hh)]
536+ , selfClosingTag "PathPointType" [("Anchor", hw++" -"++hh),
537+ ("LeftDirection", hw++" -"++hh), ("RightDirection", hw++" -"++hh)]
526538 ]
527539 image = inTags True "Image"
528− [("Self","ue6"), ("ItemTransform", scaleFact++" 0 0 "++scaleFact++" -"++qw++" -"++qh)]
540+ [("Self","ue6"), ("ItemTransform", scale++" -"++hw++" -"++hh)]
529541 $ vcat [
530542 inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded"
531− $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)]
532− , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)]
543+ , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')]
533544 ]
534545 doc = inTags True "CharacterStyleRange" attrs
535− $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)]
546+ $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"),
547+ ("ItemTransform", scale++" "++hw++" -"++hh)]
536548 $ (props $$ image)
537− in do
538− state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } )
549+ state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } )