@@ -42,6 +42,7 @@ module Text.Pandoc.Readers.Odt.ContentReader
4242import Control.Arrow
4343import Control.Applicative hiding ( liftA, liftA2, liftA3 )
4444
45+import qualified Data.ByteString.Lazy as B
4546import qualified Data.Map as M
4647import Data.List ( find )
4748import Data.Maybe
@@ -50,6 +51,7 @@ import qualified Text.XML.Light as XML
5051
5152import Text.Pandoc.Definition
5253import Text.Pandoc.Builder
54+import Text.Pandoc.MediaBag (insertMedia, MediaBag)
5355import Text.Pandoc.Shared
5456
5557import Text.Pandoc.Readers.Odt.Base
@@ -68,6 +70,7 @@ import qualified Data.Set as Set
6870--------------------------------------------------------------------------------
6971
7072type Anchor = String
73+type Media = [(FilePath, B.ByteString)]
7174
7275data ReaderState
7376 = ReaderState { -- | A collection of styles read somewhere else.
@@ -87,14 +90,17 @@ data ReaderState
8790 -- | A map from internal anchor names to "pretty" ones.
8891 -- The mapping is a purely cosmetic one.
8992 , bookmarkAnchors :: M.Map Anchor Anchor
90−
93+ -- | A map of files / binary data from the archive
94+ , envMedia :: Media
95+ -- | Hold binary resources used in the document
96+ , odtMediaBag :: MediaBag
9197-- , sequences
9298-- , trackedChangeIDs
9399 }
94100 deriving ( Show )
95101
96−readerState :: Styles -> ReaderState
97−readerState styles = ReaderState styles [] 0 Nothing M.empty
102+readerState :: Styles -> Media -> ReaderState
103+readerState styles media = ReaderState styles [] 0 Nothing M.empty media mempty
98104
99105--
100106pushStyle' :: Style -> ReaderState -> ReaderState
@@ -134,6 +140,16 @@ putPrettyAnchor ugly pretty state@ReaderState{..}
134140usedAnchors :: ReaderState -> [Anchor]
135141usedAnchors ReaderState{..} = M.elems bookmarkAnchors
136142
143+getMediaBag :: ReaderState -> MediaBag
144+getMediaBag ReaderState{..} = odtMediaBag
145+
146+getMediaEnv :: ReaderState -> Media
147+getMediaEnv ReaderState{..} = envMedia
148+
149+insertMedia' :: (FilePath, B.ByteString) -> ReaderState -> ReaderState
150+insertMedia' (fp, bs) state@ReaderState{..}
151+ = state { odtMediaBag = insertMedia fp Nothing bs odtMediaBag }
152+
137153--------------------------------------------------------------------------------
138154-- Reader type and associated tools
139155--------------------------------------------------------------------------------
@@ -190,6 +206,22 @@ popStyle = keepingTheValue (
190206getCurrentListLevel :: OdtReaderSafe _x ListLevel
191207getCurrentListLevel = getExtraState >>^ currentListLevel
192208
209+--
210+updateMediaWithResource :: OdtReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
211+updateMediaWithResource = keepingTheValue (
212+ (keepingTheValue getExtraState
213+ >>% insertMedia'
214+ )
215+ >>> setExtraState
216+ )
217+ >>^ fst
218+
219+lookupResource :: OdtReaderSafe String (FilePath, B.ByteString)
220+lookupResource = proc target -> do
221+ state <- getExtraState -< ()
222+ case lookup target (getMediaEnv state) of
223+ Just bs -> returnV (target, bs) -<< ()
224+ Nothing -> returnV ("", B.empty) -< ()
193225
194226type AnchorPrefix = String
195227
@@ -511,6 +543,10 @@ read_plain_text = fst ^&&& read_plain_text' >>% recover
511543 extractText (XML.Text cData) = succeedWith (XML.cdData cData)
512544 extractText _ = failEmpty
513545
546+read_text_seq :: InlineMatcher
547+read_text_seq = matchingElement NsText "sequence"
548+ $ matchChildContent [] read_plain_text
549+
514550
515551-- specifically. I honor that, although the current implementation of '(<>)'
516552-- for 'Inlines' in "Text.Pandoc.Builder" will collaps them agein.
@@ -559,6 +595,8 @@ read_paragraph = matchingElement NsText "p"
559595 , read_reference_start
560596 , read_bookmark_ref
561597 , read_reference_ref
598+ , read_maybe_nested_img_frame
599+ , read_text_seq
562600 ] read_plain_text
563601
564602
@@ -583,6 +621,7 @@ read_header = matchingElement NsText "h"
583621 , read_reference_start
584622 , read_bookmark_ref
585623 , read_reference_ref
624+ , read_maybe_nested_img_frame
586625 ] read_plain_text
587626 ) -< blocks
588627 anchor <- getHeaderAnchor -< children
@@ -687,6 +726,64 @@ read_table_cell = matchingElement NsTable "table-cell"
687726 $ matchChildContent' [ read_paragraph
688727 ]
689728
729+----------------------
730+-- Images
731+----------------------
732+
733+--
734+read_maybe_nested_img_frame :: InlineMatcher
735+read_maybe_nested_img_frame = matchingElement NsDraw "frame"
736+ $ proc blocks -> do
737+ img <- (findChild' NsDraw "image") -< ()
738+ case img of
739+ Just _ -> read_frame -< blocks
740+ Nothing -> matchChildContent' [ read_frame_text_box ] -< blocks
741+
742+read_frame :: OdtReaderSafe Inlines Inlines
743+read_frame =
744+ proc blocks -> do
745+ w <- ( findAttr' NsSVG "width" ) -< ()
746+ h <- ( findAttr' NsSVG "height" ) -< ()
747+ titleNodes <- ( matchChildContent' [ read_frame_title ] ) -< blocks
748+ src <- matchChildContent' [ read_image_src ] -< blocks
749+ resource <- lookupResource -< src
750+ _ <- updateMediaWithResource -< resource
751+ alt <- (matchChildContent [] read_plain_text) -< blocks
752+ arr (uncurry4 imageWith ) -<
753+ (image_attributes w h, src, inlineListToIdentifier (toList titleNodes), alt)
754+
755+image_attributes :: Maybe String -> Maybe String -> Attr
756+image_attributes x y =
757+ ( "", [], (dim "width" x) ++ (dim "height" y))
758+ where
759+ dim _ (Just "") = []
760+ dim name (Just v) = [(name, v)]
761+ dim _ Nothing = []
762+
763+read_image_src :: (Namespace, ElementName, OdtReader Anchor Anchor)
764+read_image_src = matchingElement NsDraw "image"
765+ $ proc _ -> do
766+ imgSrc <- findAttr NsXLink "href" -< ()
767+ case imgSrc of
768+ Right src -> returnV src -<< ()
769+ Left _ -> returnV "" -< ()
770+
771+read_frame_title :: InlineMatcher
772+read_frame_title = matchingElement NsSVG "title"
773+ $ (matchChildContent [] read_plain_text)
774+
775+read_frame_text_box :: InlineMatcher
776+read_frame_text_box = matchingElement NsDraw "text-box"
777+ $ proc blocks -> do
778+ paragraphs <- (matchChildContent' [ read_paragraph ]) -< blocks
779+ arr read_img_with_caption -< toList paragraphs
780+
781+read_img_with_caption :: [Block] -> Inlines
782+read_img_with_caption ((Para ((Image attr _ target) : txt)) : _) =
783+ singleton (Image attr txt target) -- override caption with the text that follows
784+read_img_with_caption _ =
785+ mempty
786+
690787----------------------
691788-- Internal links
692789----------------------
@@ -783,8 +880,11 @@ read_text = matchChildContent' [ read_header
783880 ]
784881 >>^ doc
785882
786−read_body :: OdtReader _x Pandoc
883+read_body :: OdtReader _x (Pandoc, MediaBag)
787884read_body = executeIn NsOffice "body"
788885 $ executeIn NsOffice "text"
789− $ liftAsSuccess read_text
790−
886+ $ liftAsSuccess
887+ $ proc inlines -> do
888+ txt <- read_text -< inlines
889+ state <- getExtraState -< ()
890+ returnA -< (txt, getMediaBag state)