aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2015-04-02 21:06:51 -0700
committermb21 <mb21@users.noreply.github.com>2015-08-05 16:08:46 +0200
commit9deb335ca5fbf9f1db0cd1d046d2b59a9a5a55fe (patch)
treede7d3473f1122f86b41823fe9ac7d92bd2cb6578
parent4391c5f34cb0013dcc2f2b2f4e642d0b24ebc4b5 (diff)
downloadpandoc-9deb335ca5fbf9f1db0cd1d046d2b59a9a5a55fe.tar.gz
ICML writer: changed type of `writeICML`.
API change: It is now `WriterOptions -> Pandoc -> IO String`. Also handle new image attributes. (mb21)
-rw-r--r--src/Text/Pandoc.hs2
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs89
2 files changed, 51 insertions, 40 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index a4d963221..f9d19d9dd 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -273,7 +273,7 @@ writers = [
,("html" , PureStringWriter writeHtmlString)
,("html5" , PureStringWriter $ \o ->
writeHtmlString o{ writerHtml5 = True })
- ,("icml" , PureStringWriter writeICML)
+ ,("icml" , IOStringWriter writeICML)
,("s5" , PureStringWriter $ \o ->
writeHtmlString o{ writerSlideVariant = S5Slides
, writerTableOfContents = False })
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 2eeccba3a..71e541b6f 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -17,15 +17,17 @@ module Text.Pandoc.Writers.ICML (writeICML) where
import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Writers.Shared
-import Text.Pandoc.Shared (splitBy)
+import Text.Pandoc.Shared (splitBy, fetchItem, warn)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Pretty
+import Text.Pandoc.ImageSize
import Data.List (isPrefixOf, isInfixOf, stripPrefix)
import Data.Text as Text (breakOnAll, pack)
import Data.Monoid (mappend)
import Control.Monad.State
import Network.URI (isURI)
+import System.FilePath (pathSeparator)
import qualified Data.Set as Set
type Style = [String]
@@ -39,7 +41,7 @@ data WriterState = WriterState{
, maxListDepth :: Int
}
-type WS a = State WriterState a
+type WS a = StateT WriterState IO a
defaultWriterState :: WriterState
defaultWriterState = WriterState{
@@ -118,27 +120,27 @@ citeName = "Cite"
-- | Convert Pandoc document to string in ICML format.
-writeICML :: WriterOptions -> Pandoc -> String
-writeICML opts (Pandoc meta blocks) =
+writeICML :: WriterOptions -> Pandoc -> IO String
+writeICML opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
render' = render colwidth
- renderMeta f s = Just $ render' $ fst $ runState (f opts [] s) defaultWriterState
- Just metadata = metaToJSON opts
- (renderMeta blocksToICML)
- (renderMeta inlinesToICML)
- meta
- (doc, st) = runState (blocksToICML opts [] blocks) defaultWriterState
- main = render' doc
+ renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
+ metadata <- metaToJSON opts
+ (renderMeta blocksToICML)
+ (renderMeta inlinesToICML)
+ meta
+ (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
+ let main = render' doc
context = defField "body" main
$ defField "charStyles" (render' $ charStylesToDoc st)
$ defField "parStyles" (render' $ parStylesToDoc st)
$ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st)
$ metadata
- in if writerStandalone opts
- then renderTemplate' (writerTemplate opts) context
- else main
+ return $ if writerStandalone opts
+ then renderTemplate' (writerTemplate opts) context
+ else main
-- | Auxilary functions for parStylesToDoc and charStylesToDoc.
contains :: String -> (String, (String, String)) -> [(String, String)]
@@ -427,7 +429,7 @@ inlineToICML opts style (Link lst (url, title)) = do
cont = inTags True "HyperlinkTextSource"
[("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content
in (cont, newst)
-inlineToICML opts style (Image alt target) = imageICML opts style alt target
+inlineToICML opts style (Image attr alt target) = imageICML opts style attr alt target
inlineToICML opts style (Note lst) = footnoteToICML opts style lst
inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst
@@ -500,39 +502,48 @@ styleToStrAttr style =
in (stlStr, attrs)
-- | Assemble an ICML Image.
-imageICML :: WriterOptions -> Style -> [Inline] -> Target -> WS Doc
-imageICML _ style _ (linkURI, _) =
- let imgWidth = 300::Int --TODO: set width, height dynamically as in Docx.hs
- imgHeight = 200::Int
- scaleFact = show (1::Double) --TODO: set scaling factor so image is scaled exactly to imgWidth x imgHeight
- hw = show $ imgWidth `div` 2
- hh = show $ imgHeight `div` 2
- qw = show $ imgWidth `div` 4
- qh = show $ imgHeight `div` 4
- uriPrefix = if isURI linkURI then "" else "file:"
+imageICML :: WriterOptions -> Style -> Attr -> [Inline] -> Target -> WS Doc
+imageICML opts style attr _ (src, _) = do
+ res <- liftIO $ fetchItem (writerSourceURL opts) src
+ imgS <- case res of
+ Left (_) -> do
+ liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+ return def
+ Right (img, _) -> do
+ case imageSize img of
+ Right size -> return size
+ Left msg -> do
+ return $ warn $ "Could not determine image size in `" ++
+ src ++ "': " ++ msg
+ return def
+ let (ow, oh) = sizeInPoints imgS
+ (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS
+ hw = showFl $ ow / 2
+ hh = showFl $ oh / 2
+ scale = showFl (imgWidth / ow) ++ " 0 0 " ++ showFl (imgHeight / oh)
+ src' = if isURI src then src else "file://." ++ pathSeparator : src
(stlStr, attrs) = styleToStrAttr style
props = inTags True "Properties" [] $ inTags True "PathGeometry" []
$ inTags True "GeometryPathType" [("PathOpen","false")]
$ inTags True "PathPointArray" []
$ vcat [
- selfClosingTag "PathPointType" [("Anchor", "-"++qw++" -"++qh),
- ("LeftDirection", "-"++qw++" -"++qh), ("RightDirection", "-"++qw++" -"++qh)]
- , selfClosingTag "PathPointType" [("Anchor", "-"++qw++" "++qh),
- ("LeftDirection", "-"++qw++" "++qh), ("RightDirection", "-"++qw++" "++qh)]
- , selfClosingTag "PathPointType" [("Anchor", qw++" "++qh),
- ("LeftDirection", qw++" "++qh), ("RightDirection", qw++" "++qh)]
- , selfClosingTag "PathPointType" [("Anchor", qw++" -"++qh),
- ("LeftDirection", qw++" -"++qh), ("RightDirection", qw++" -"++qh)]
+ selfClosingTag "PathPointType" [("Anchor", "-"++hw++" -"++hh),
+ ("LeftDirection", "-"++hw++" -"++hh), ("RightDirection", "-"++hw++" -"++hh)]
+ , selfClosingTag "PathPointType" [("Anchor", "-"++hw++" "++hh),
+ ("LeftDirection", "-"++hw++" "++hh), ("RightDirection", "-"++hw++" "++hh)]
+ , selfClosingTag "PathPointType" [("Anchor", hw++" "++hh),
+ ("LeftDirection", hw++" "++hh), ("RightDirection", hw++" "++hh)]
+ , selfClosingTag "PathPointType" [("Anchor", hw++" -"++hh),
+ ("LeftDirection", hw++" -"++hh), ("RightDirection", hw++" -"++hh)]
]
image = inTags True "Image"
- [("Self","ue6"), ("ItemTransform", scaleFact++" 0 0 "++scaleFact++" -"++qw++" -"++qh)]
+ [("Self","ue6"), ("ItemTransform", scale++" -"++hw++" -"++hh)]
$ vcat [
inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded"
- $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)]
- , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)]
+ , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')]
]
doc = inTags True "CharacterStyleRange" attrs
- $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)]
+ $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"),
+ ("ItemTransform", scale++" "++hw++" -"++hh)]
$ (props $$ image)
- in do
- state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } )
+ state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } )