diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2010-2011, Ian-Woo Kim. All rights reserved. +Copyright 2011-2013, Ian-Woo Kim. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/hoodle-render.cabal b/hoodle-render.cabal --- a/hoodle-render.cabal +++ b/hoodle-render.cabal @@ -1,5 +1,5 @@ Name: hoodle-render -Version: 0.2.0 +Version: 0.2.1 Synopsis: Hoodle file renderer Description: Rendering library using cairo for hoodle file format License: BSD3 @@ -25,16 +25,21 @@ Build-Depends: base == 4.*, mtl == 2.*, + filepath, + directory, containers >= 0.4, cairo == 0.12.*, + svgcairo == 0.12.*, strict == 0.3.*, bytestring >= 0.9, - lens >= 2.4, - hoodle-types >= 0.1.0, - TypeCompose == 0.9.* + base64-bytestring >= 0.1, + lens >= 2.5, + hoodle-types >= 0.1.1, + TypeCompose == 0.9.*, + gd >= 3000.7 if flag(poppler) - Build-Depends: poppler >= 0.12.2.1 + Build-Depends: poppler >= 0.12.2.2 else Build-Depends: diff --git a/src/Graphics/Hoodle/Render.hs b/src/Graphics/Hoodle/Render.hs --- a/src/Graphics/Hoodle/Render.hs +++ b/src/Graphics/Hoodle/Render.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -46,8 +46,9 @@ , cnstrctRHoodle ) where -import Control.Lens (view,set,over) +import Control.Lens (view,set) import Control.Monad.State hiding (mapM,mapM_) +import qualified Data.ByteString.Char8 as C import Data.Foldable import Data.Traversable (mapM) import qualified Data.Map as M @@ -61,6 +62,7 @@ #ifdef POPPLER import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage #endif +import qualified Graphics.Rendering.Cairo.SVG as RSVG -- from this package -- import Graphics.Hoodle.Render.Simple import Graphics.Hoodle.Render.Background @@ -85,26 +87,26 @@ let opacity = if stroke_tool s == "highlighter" then predefined_highlighter_opacity else 1.0 - case M.lookup (stroke_color s) predefined_pencolor of + case getPenColor (stroke_color s) of Just (r,g,b,a) -> setSourceRGBA r g b (a*opacity) - Nothing -> setSourceRGBA 0 0 0 1 + Nothing -> setSourceRGBA 0.5 0.5 0.5 1 setLineWidth w setLineCap LineCapRound setLineJoin LineJoinRound drawStrokeCurve d - stroke + stroke renderStrk s@(VWStroke _ _ d) = do let opacity = if stroke_tool s == "highlighter" then predefined_highlighter_opacity else 1.0 - case M.lookup (stroke_color s) predefined_pencolor of + case getPenColor (stroke_color s) of Just (r,g,b,a) -> setSourceRGBA r g b (a*opacity) - Nothing -> setSourceRGBA 0 0 0 1 + Nothing -> setSourceRGBA 0.5 0.5 0.5 1 setFillRule FillRuleWinding drawVWStrokeCurve d fill --- | render image +-- | render image : not fully implemented renderImg :: Image -> Render () renderImg (Image _ (x,y) (Dim w h)) = do setSourceRGBA 0 0 0 1 @@ -112,10 +114,32 @@ rectangle x y w h stroke +-- | render svg : not fully implemented +renderSVG :: SVG -> Render () +renderSVG svg@(SVG _ _ bstr _ _) = do + let str = C.unpack bstr + RSVG.withSvgFromString str $ \rsvg -> do + let svgbbx = mkSVGBBox svg + let (x,y) = (svg_pos . svgbbx_svg) svgbbx + BBox (x1,y1) (x2,y2) = getBBox svgbbx + (ix',iy') = RSVG.svgGetSize rsvg + ix = fromIntegral ix' + iy = fromIntegral iy' + clipBBox (Just (getBBox svgbbx)) + save + translate x y + scale ((x2-x1)/ix) ((y2-y1)/iy) + RSVG.svgRender rsvg + restore + resetClip + return () + + -- | render item renderItem :: Item -> Render () renderItem (ItemStroke strk) = renderStrk strk renderItem (ItemImage img) = renderImg img +renderItem (ItemSVG svg) = renderSVG svg -- | render background without any constraint renderBkg :: (Background,Dimension) -> Render () @@ -195,18 +219,37 @@ BBox (x1,y1) (x2,y2) = getBBox img ix <- liftM fromIntegral (imageSurfaceGetWidth sfc) iy <- liftM fromIntegral (imageSurfaceGetHeight sfc) - clipBBox (Just (getBBox img)) + -- clipBBox (Just (getBBox img)) save translate x y scale ((x2-x1)/ix) ((y2-y1)/iy) setSourceSurface sfc 0 0 paint restore - resetClip + -- resetClip return itm +renderRItem itm@(RItemSVG svgbbx mrsvg) = do + case mrsvg of + Nothing -> renderSVG (svgbbx_svg svgbbx) + Just rsvg -> do + let (x,y) = (svg_pos . svgbbx_svg) svgbbx + BBox (x1,y1) (x2,y2) = getBBox svgbbx + (ix',iy') = RSVG.svgGetSize rsvg + ix = fromIntegral ix' + iy = fromIntegral iy' + clipBBox (Just (getBBox svgbbx)) + save + translate x y + scale ((x2-x1)/ix) ((y2-y1)/iy) + RSVG.svgRender rsvg + restore + resetClip + return () + return itm + ------------ -- InBBox -- ------------ @@ -239,9 +282,25 @@ Just bbox -> (hltHittedByBBox bbox . view gitems) layer (mapM_ renderRItem . concatMap unHitted . getB) hittestbbox resetClip - return layer + -- return layer + -- simply twice rendering if whole redraw happening + case view gbuffer layer of + LyBuf (Just sfc) -> do + liftIO $ renderWith sfc $ do + -- renderRLayer_InBBox mbbox lyr + clipBBox mbbox + setSourceRGBA 0 0 0 0 + setOperator OperatorSource + paint + setOperator OperatorOver + (mapM_ renderRItem . concatMap unHitted . getB) hittestbbox + resetClip + return layer + _ -> return layer + + ----------------------- -- draw using buffer -- ----------------------- @@ -257,7 +316,7 @@ Just sfc -> do setSourceSurface sfc 0 0 paint - RBkgPDF _ _ _ _ msfc -> do + RBkgPDF _ _ _n _ msfc -> do case msfc of Nothing -> renderRBkg (b,dim) >> return () Just sfc -> do @@ -269,35 +328,50 @@ renderRLayer_InBBoxBuf :: Maybe BBox -> RLayer -> Render RLayer renderRLayer_InBBoxBuf mbbox lyr = do case view gbuffer lyr of - LyBuf (Just sfc) -> do clipBBox mbbox - setSourceSurface sfc 0 0 - paint - resetClip - _ -> renderRLayer_InBBox mbbox lyr >> return () - return lyr + LyBuf (Just sfc) -> do + clipBBox mbbox + setSourceSurface sfc 0 0 + paint + resetClip + return lyr + _ -> do + renderRLayer_InBBox mbbox lyr + -- return lyr ------------------- -- update buffer ------------------- -- | -updateLayerBuf :: Maybe BBox -> RLayer -> IO RLayer -updateLayerBuf mbbox lyr = do +updateLayerBuf :: Dimension -> Maybe BBox -> RLayer -> IO RLayer +updateLayerBuf (Dim w h) mbbox lyr = do case view gbuffer lyr of LyBuf (Just sfc) -> do renderWith sfc $ do - clearBBox mbbox renderRLayer_InBBox mbbox lyr return lyr - _ -> return lyr + LyBuf Nothing -> do + -- return lyr + sfc <- createImageSurface FormatARGB32 (floor w) (floor h) + renderWith sfc $ do + renderRLayer_InBBox Nothing lyr + return (set gbuffer (LyBuf (Just sfc)) lyr) + + + -- liftIO $ putStrLn "renderRLayer_InBBoxBuf" + -- clipBBox mbbox + -- setSourceSurface sfc 0 0 + -- paint + -- resetClip + -- | updatePageBuf :: RPage -> IO RPage updatePageBuf pg = do let dim = view gdimension pg mbbox = Just . dimToBBox $ dim - nlyrs <- mapM (updateLayerBuf mbbox) . view glayers $ pg + nlyrs <- mapM (updateLayerBuf dim mbbox) . view glayers $ pg return (set glayers nlyrs pg) -- | diff --git a/src/Graphics/Hoodle/Render/Background.hs b/src/Graphics/Hoodle/Render/Background.hs --- a/src/Graphics/Hoodle/Render/Background.hs +++ b/src/Graphics/Hoodle/Render/Background.hs @@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.PDFBackground --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Debug.hs b/src/Graphics/Hoodle/Render/Debug.hs --- a/src/Graphics/Hoodle/Render/Debug.hs +++ b/src/Graphics/Hoodle/Render/Debug.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Debug --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -45,9 +45,9 @@ import Data.Hoodle.Simple import Data.Hoodle.BBox import Data.Hoodle.Predefined -#ifdef POPPLER -import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage -#endif +-- #ifdef POPPLER +-- import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage +-- #endif -- from this package import Graphics.Hoodle.Render import Graphics.Hoodle.Render.Type @@ -98,12 +98,22 @@ let BBox (x1,y1) (x2,y2) = imgbbx_bbx ibbox rectangle x1 y1 (x2-x1) (y2-y1) stroke + +renderSVGBBx_BBoxOnly :: SVGBBox -> Render () +renderSVGBBx_BBoxOnly svg = do + setSourceRGBA 0 0 0 1 + setLineWidth 10 + let BBox (x1,y1) (x2,y2) = getBBox svg + rectangle x1 y1 (x2-x1) (y2-y1) + stroke + -- | renderRItem_BBoxOnly :: RItem -> Render () renderRItem_BBoxOnly (RItemStroke sbbox) = renderStrkBBx_BBoxOnly sbbox renderRItem_BBoxOnly (RItemImage ibbox _) = renderImgBBx_BBoxOnly ibbox +renderRItem_BBoxOnly (RItemSVG svg _) = renderSVGBBx_BBoxOnly svg -- | diff --git a/src/Graphics/Hoodle/Render/Generic.hs b/src/Graphics/Hoodle/Render/Generic.hs --- a/src/Graphics/Hoodle/Render/Generic.hs +++ b/src/Graphics/Hoodle/Render/Generic.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Generic --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -16,7 +16,9 @@ import Control.Applicative import Control.Lens +import Control.Monad hiding (mapM_,mapM) import Data.Foldable +import Data.Traversable import Graphics.Rendering.Cairo -- from hoodle-platform import Data.Hoodle.BBox @@ -27,7 +29,7 @@ import Graphics.Hoodle.Render.Debug import Graphics.Hoodle.Render.Type -- -import Prelude hiding (mapM_) +import Prelude hiding (mapM_,mapM) -- | temporary util passarg :: (Monad m) => (a -> m ()) -> a -> m a @@ -122,11 +124,23 @@ instance RenderOptionable (InBBox RPage) where type RenderOption (InBBox RPage) = InBBoxOption cairoRenderOption (InBBoxOption mbbox) (InBBox page) = do - let mbboxtemp = mbbox >>= \bbox -> return (inflate bbox 2.0) -- this is due to a thin unexpected grey margin. - cairoRenderOption (RBkgDrawPDFInBBox mbboxtemp) (view gbackground page, view gdimension page) - mapM_ (renderRLayer_InBBox mbbox) . view glayers $ page - return (InBBox page) + cairoRenderOption (RBkgDrawPDFInBBox mbbox) (view gbackground page, view gdimension page) + -- mapM_ (renderRLayer_InBBox mbbox) . view glayers $ page + let lyrs = view glayers page + nlyrs <- mapM (liftM unInBBox . cairoRenderOption (InBBoxOption mbbox) . InBBox ) lyrs + let npage = set glayers nlyrs page + return (InBBox npage) +-- | +instance RenderOptionable (InBBoxBkgBuf RPage) where + type RenderOption (InBBoxBkgBuf RPage) = InBBoxOption + cairoRenderOption (InBBoxOption mbbox) (InBBoxBkgBuf page) = do + cairoRenderOption (RBkgDrawPDFInBBox mbbox) (view gbackground page, view gdimension page) + -- mapM_ (renderRLayer_InBBox mbbox) . view glayers $ page + let lyrs = view glayers page + nlyrs <- mapM (renderRLayer_InBBox mbbox) lyrs + let npage = set glayers nlyrs page + return (InBBoxBkgBuf npage) diff --git a/src/Graphics/Hoodle/Render/Highlight.hs b/src/Graphics/Hoodle/Render/Highlight.hs --- a/src/Graphics/Hoodle/Render/Highlight.hs +++ b/src/Graphics/Hoodle/Render/Highlight.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Highlight --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -55,13 +55,6 @@ drawVWStrokeCurve d fill -{- - Img _ _ _ -> cairoOneStrokeBBoxOnly sbbox - _ -> do - _ -> error "in cairoOneStrokeSelected" --} - - -- | render items highlighted renderRItemHltd :: RItem -> Render () renderRItemHltd (RItemStroke strk) = renderStrkHltd strk @@ -69,6 +62,12 @@ setSourceRGBA 0 0 0 1 setLineWidth 10 let BBox (x1,y1) (x2,y2) = imgbbx_bbx img + rectangle x1 y1 (x2-x1) (y2-y1) + stroke +renderRItemHltd (RItemSVG svg _) = do + setSourceRGBA 0 0 0 1 + setLineWidth 10 + let BBox (x1,y1) (x2,y2) = getBBox svg rectangle x1 y1 (x2-x1) (y2-y1) stroke diff --git a/src/Graphics/Hoodle/Render/Item.hs b/src/Graphics/Hoodle/Render/Item.hs --- a/src/Graphics/Hoodle/Render/Item.hs +++ b/src/Graphics/Hoodle/Render/Item.hs @@ -1,9 +1,10 @@ {-# LANGUAGE TypeFamilies, TypeOperators, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.Item --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -16,20 +17,72 @@ module Graphics.Hoodle.Render.Item where +import Control.Applicative +import Control.Monad +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 -import Graphics.Rendering.Cairo +import Data.ByteString.Base64 +import Graphics.GD.ByteString +import Graphics.Rendering.Cairo +import qualified Graphics.Rendering.Cairo.SVG as RSVG +import System.Directory +import System.FilePath -- from hoodle-platform import Data.Hoodle.BBox import Data.Hoodle.Simple -- from this package import Graphics.Hoodle.Render.Type.Item + -- | construct renderable item cnstrctRItem :: Item -> IO RItem cnstrctRItem (ItemStroke strk) = return (RItemStroke (mkStrokeBBox strk)) cnstrctRItem (ItemImage img) = do let imgbbx = mkImageBBox img - filesrc = C8.unpack (img_src img) - sfc <- imageSurfaceCreateFromPNG filesrc - -- rendering is not implemented yet - return (RItemImage imgbbx (Just sfc)) + src = img_src img + embed = getByteStringIfEmbeddedPNG src + case embed of + Just bstr -> do + sfc <- saveTempPNGToCreateSurface bstr + return (RItemImage imgbbx (Just sfc)) + Nothing -> do + let filesrc = C8.unpack (img_src img) + filesrcext = takeExtension filesrc + imgaction + | filesrcext == ".PNG" || filesrcext == ".png" = + Just <$> imageSurfaceCreateFromPNG filesrc + | filesrcext == ".JPG" || filesrcext == ".jpg" = + Just <$> getJPGandCreateSurface filesrc + | otherwise = return Nothing + msfc <- imgaction + return (RItemImage imgbbx msfc) +cnstrctRItem (ItemSVG svg@(SVG _ _ bstr _ _)) = do + let str = C8.unpack bstr + svgbbx = mkSVGBBox svg + rsvg <- RSVG.svgNewFromString str + return (RItemSVG svgbbx (Just rsvg)) + +-- | get embedded png image. If not, just give me nothing. +getByteStringIfEmbeddedPNG :: C8.ByteString -> Maybe C8.ByteString +getByteStringIfEmbeddedPNG bstr = do + guard (C8.length bstr > 22) + let (header,dat) = C8.splitAt 22 bstr + guard (header == "data:image/png;base64,") + either (const Nothing) return (decode dat) + + +-- | read JPG file using GD library and create cairo image surface +-- currently, this uses temporary png file (which is potentially dangerous) +getJPGandCreateSurface :: FilePath -> IO Surface +getJPGandCreateSurface fp = do + img <- loadJpegFile fp + bstr <- savePngByteString img + saveTempPNGToCreateSurface bstr + +-- | +saveTempPNGToCreateSurface :: C8.ByteString -> IO Surface +saveTempPNGToCreateSurface bstr = do + tdir <- getTemporaryDirectory + let tfile = tdir "temp.png" + B.writeFile tfile bstr + imageSurfaceCreateFromPNG tfile diff --git a/src/Graphics/Hoodle/Render/Primitive.hs b/src/Graphics/Hoodle/Render/Primitive.hs --- a/src/Graphics/Hoodle/Render/Primitive.hs +++ b/src/Graphics/Hoodle/Render/Primitive.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Primitive --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Type.hs b/src/Graphics/Hoodle/Render/Type.hs --- a/src/Graphics/Hoodle/Render/Type.hs +++ b/src/Graphics/Hoodle/Render/Type.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Type/Background.hs b/src/Graphics/Hoodle/Render/Type/Background.hs --- a/src/Graphics/Hoodle/Render/Type/Background.hs +++ b/src/Graphics/Hoodle/Render/Type/Background.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.Background --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -55,6 +55,10 @@ , rbkg_popplerpage :: Maybe () #endif , rbkg_cairosurface :: Maybe Surface } + +isRBkgSmpl :: RBackground -> Bool +isRBkgSmpl (RBkgSmpl _ _ _) = True +isRBkgSmpl _ = False data RBkgOpt = RBkgDrawPDF | RBkgDrawWhite diff --git a/src/Graphics/Hoodle/Render/Type/HitTest.hs b/src/Graphics/Hoodle/Render/Type/HitTest.hs --- a/src/Graphics/Hoodle/Render/Type/HitTest.hs +++ b/src/Graphics/Hoodle/Render/Type/HitTest.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.HitTest --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Type/Hoodle.hs b/src/Graphics/Hoodle/Render/Type/Hoodle.hs --- a/src/Graphics/Hoodle/Render/Type/Hoodle.hs +++ b/src/Graphics/Hoodle/Render/Type/Hoodle.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.Hoodle --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -82,8 +82,12 @@ ---------------------- -- | -newtype InBBox a = InBBox a +newtype InBBox a = InBBox { unInBBox :: a } -- | data InBBoxOption = InBBoxOption (Maybe BBox) + +-- | +newtype InBBoxBkgBuf a = InBBoxBkgBuf { unInBBoxBkgBuf :: a } + diff --git a/src/Graphics/Hoodle/Render/Type/Item.hs b/src/Graphics/Hoodle/Render/Type/Item.hs --- a/src/Graphics/Hoodle/Render/Type/Item.hs +++ b/src/Graphics/Hoodle/Render/Type/Item.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.Item --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -17,17 +17,25 @@ module Graphics.Hoodle.Render.Type.Item where import Graphics.Rendering.Cairo +import qualified Graphics.Rendering.Cairo.SVG as RSVG -- from hoodle-platform import Data.Hoodle.BBox import Data.Hoodle.Simple data RItem = RItemStroke StrokeBBox | RItemImage ImageBBox (Maybe Surface) + | RItemSVG SVGBBox (Maybe RSVG.SVG) instance BBoxable RItem where getBBox (RItemStroke strk) = getBBox strk getBBox (RItemImage img _) = getBBox img + getBBox (RItemSVG svg _) = getBBox svg +instance Show RItem where + show (RItemStroke strk) = "RItemStroke " ++ show strk + show (RItemImage img _) = "RItemImage " ++ show img + show (RItemSVG svg _) = "RItemSVG " ++ show svg + -- | isStrkInRItem :: RItem -> Bool isStrkInRItem (RItemStroke _) = True @@ -38,6 +46,12 @@ isImgInRItem (RItemImage _ _) = True isImgInRItem _ = False +-- | +isSVGInRItem :: RItem -> Bool +isSVGInRItem (RItemSVG _ _) = True +isSVGInRItem _ = False + + -- | findStrkInRItem :: RItem -> Maybe StrokeBBox findStrkInRItem (RItemStroke strk) = Just strk @@ -49,11 +63,18 @@ findImgInRItem _ = Nothing +-- | +findSVGInRItem :: RItem -> Maybe SVGBBox +findSVGInRItem (RItemSVG svg _) = Just svg +findSVGInRItem _ = Nothing + + -- | rItem2Item :: RItem -> Item rItem2Item (RItemStroke strk) = (ItemStroke . strkbbx_strk) strk rItem2Item (RItemImage img _) = (ItemImage . imgbbx_img) img +rItem2Item (RItemSVG svg _) = (ItemSVG. svgbbx_svg) svg {- -- | diff --git a/src/Graphics/Hoodle/Render/Type/Select.hs b/src/Graphics/Hoodle/Render/Type/Select.hs --- a/src/Graphics/Hoodle/Render/Type/Select.hs +++ b/src/Graphics/Hoodle/Render/Type/Select.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Type.Select --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Util.hs b/src/Graphics/Hoodle/Render/Util.hs --- a/src/Graphics/Hoodle/Render/Util.hs +++ b/src/Graphics/Hoodle/Render/Util.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Util --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Graphics/Hoodle/Render/Util/HitTest.hs b/src/Graphics/Hoodle/Render/Util/HitTest.hs --- a/src/Graphics/Hoodle/Render/Util/HitTest.hs +++ b/src/Graphics/Hoodle/Render/Util/HitTest.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Hoodle.Render.Util.HitTest --- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- Copyright : (c) 2011-2013 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -44,7 +44,7 @@ -> ((Double,Double),(Double,Double)) -- ^ line2 -> Bool do2LinesIntersect ((x1,y1),(x2,y2)) ((x3,y3),(x4,y4)) = - (x2-xc)*(xc-x1)>=0 && (x3-xc)*(xc-x4) >=0 + (x2-xc)*(xc-x1)>0 && (x3-xc)*(xc-x4) >0 where x21 = x2-x1 x43 = x4-x3 y21 = y2-y1 @@ -53,8 +53,7 @@ -- | previously, hitTestLineStroke doesLineHitStrk :: ((Double,Double),(Double,Double)) -> Stroke -> Bool -doesLineHitStrk line1 str@(Stroke _t _c _w _d) = - test (stroke_data str) +doesLineHitStrk line1 str@(Stroke _t _c _w _d) = test (stroke_data str) where test [] = False test ((_:!:_):[]) = False test ((x0:!:y0):(x:!:y):rest) @@ -70,7 +69,8 @@ -- | Do two bounding boxes intersect with each other? -- previously, hitTestBBoxBBox do2BBoxIntersect :: BBox -> BBox -> Bool -do2BBoxIntersect b1@(BBox (ulx1,uly1) (lrx1,lry1)) b2@(BBox (ulx2,uly2) (lrx2,lry2)) = p1 && p2 +do2BBoxIntersect (BBox (ulx1,uly1) (lrx1,lry1)) (BBox (ulx2,uly2) (lrx2,lry2)) + = p1 && p2 where p1 = ulx1 <= ulx2 && ulx2 <= lrx1 || ulx1 <= lrx2 && lrx2 <= lrx1 || ulx2 <= ulx1 && ulx1 <= lrx2 @@ -80,16 +80,6 @@ || uly2 <= uly1 && uly1 <= lry2 || uly2 <= lry1 && lry1 <= lry2 - - {- isPointInBBox b2 (ulx1,uly1) - || isPointInBBox b2 (lrx1,lry1) - || isPointInBBox b2 (lrx1,uly1) - || isPointInBBox b2 (ulx1,lry1) - || isPointInBBox b1 (ulx2,uly2) - || isPointInBBox b1 (lrx2,lry2) - || isPointInBBox b1 (lrx2,uly2) - || isPointInBBox b1 (ulx2,lry2) -} - -- | is the second bbox inside the first bbox? -- previously, hitTestInsideBBox isBBox2InBBox1 :: BBox -- ^ 1st bbox @@ -157,8 +147,6 @@ where test (RItemStroke strk) = (doesLineHitStrk line . strkbbx_strk) strk test _ = False - - -- | hltItmsHittedByLineFrmSelected_StateT :: ((Double,Double),(Double,Double))