hoodle-render 0.2.0 → 0.2.1

raw patch · 17 files changed

+252/−80 lines, 17 filesdep +base64-bytestringdep +directorydep +filepathdep ~hoodle-typesdep ~lensdep ~popplerPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base64-bytestring, directory, filepath, gd, svgcairo

Dependency ranges changed: hoodle-types, lens, poppler

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• hoodle-render.cabal +10/−5
• src/Graphics/Hoodle/Render.hs +97/−23
• src/Graphics/Hoodle/Render/Background.hs +1/−1
• src/Graphics/Hoodle/Render/Debug.hs +14/−4
• src/Graphics/Hoodle/Render/Generic.hs +20/−6
• src/Graphics/Hoodle/Render/Highlight.hs +7/−8
• src/Graphics/Hoodle/Render/Item.hs +59/−6
• src/Graphics/Hoodle/Render/Primitive.hs +1/−1
• src/Graphics/Hoodle/Render/Type.hs +1/−1
• src/Graphics/Hoodle/Render/Type/Background.hs +5/−1
• src/Graphics/Hoodle/Render/Type/HitTest.hs +1/−1
• src/Graphics/Hoodle/Render/Type/Hoodle.hs +6/−2
• src/Graphics/Hoodle/Render/Type/Item.hs +22/−1
• src/Graphics/Hoodle/Render/Type/Select.hs +1/−1
• src/Graphics/Hoodle/Render/Util.hs +1/−1
• src/Graphics/Hoodle/Render/Util/HitTest.hs +5/−17

@@ -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:

@@ -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:  

@@ -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 <ianwookim@gmail.com>@@ -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)  -- | 

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>@@ -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   -- | 

@@ -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 <ianwookim@gmail.com>@@ -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)    

@@ -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 <ianwookim@gmail.com>@@ -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 

@@ -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 <ianwookim@gmail.com>@@ -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 

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>@@ -55,6 +55,10 @@                    , rbkg_popplerpage :: Maybe () #endif                    , rbkg_cairosurface :: Maybe Surface } ++isRBkgSmpl :: RBackground -> Bool +isRBkgSmpl (RBkgSmpl _ _ _) = True +isRBkgSmpl _ = False   data RBkgOpt = RBkgDrawPDF               | RBkgDrawWhite 

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>@@ -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 }+ 

@@ -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 <ianwookim@gmail.com>@@ -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  {- -- | 

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>

@@ -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 <ianwookim@gmail.com>@@ -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))