hoodle-render-0.4: src/Graphics/Hoodle/Render/Item.hs

{-# LANGUAGE TypeFamilies, TypeOperators, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Graphics.Hoodle.Render.Item 
-- Copyright   : (c) 2011-2014 Ian-Woo Kim
--
-- License     : GPL-3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-- Rendering RItem 
-- 
-----------------------------------------------------------------------------

module Graphics.Hoodle.Render.Item where

import           Control.Applicative
import           Control.Concurrent (forkIO) 
import           Control.Monad
import           Control.Monad.Identity
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Reader
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
-- import qualified Data.ByteString.Lazy as LB
import           Data.ByteString.Base64
-- import           Data.UUID
import           Data.UUID.V4
import           Graphics.GD.ByteString
import qualified Graphics.Rendering.Cairo as Cairo
import qualified Graphics.Rendering.Cairo.SVG as RSVG
-- import           Graphics.UI.Gtk (postGUIAsync)
import           System.Directory
import           System.FilePath
-- from hoodle-platform 
import           Data.Hoodle.BBox
import           Data.Hoodle.Simple
import           Hoodle.Util.Process
-- from this package
import           Graphics.Hoodle.Render.Type.Item
import           Graphics.Hoodle.Render.Type.Renderer


-- | construct renderable item 
cnstrctRItem :: Item -> Renderer RItem 
cnstrctRItem (ItemStroke strk) = return (RItemStroke (runIdentity (makeBBoxed strk)))
cnstrctRItem (ItemImage img) = do 
    (handler,_) <- ask 
    let imgbbx = runIdentity (makeBBoxed img)
        src = img_src img
    -- uuid <- liftIO $  nextRandom

    -- liftIO . forkIO $ do
    --   let embed = getByteStringIfEmbeddedPNG src 
    --   msfc <- case embed of         
    --     Just bstr -> do 
    --       sfc <- saveTempPNGToCreateSurface bstr 
    --       return (Just sfc)
    --     Nothing -> do
    --       let filesrc = C8.unpack (img_src img)
    --           filesrcext = takeExtension filesrc 
    --           imgaction 
    --             | filesrcext == ".PNG" || filesrcext == ".png" = do 
    --                 b <- doesFileExist filesrc 
    --                 if b then Just <$> Cairo.imageSurfaceCreateFromPNG filesrc
    --                      else return Nothing 
    --             | filesrcext == ".JPG" || filesrcext == ".jpg" = do 
    --                 b <- doesFileExist filesrc 
    --                 if b then Just <$> getJPGandCreateSurface filesrc 
    --                      else return Nothing 
    --             | otherwise = return Nothing 
    --       imgaction
    --   maybe (return ()) (\sfc-> handler (uuid, (1.0,sfc))) msfc


    let embed = getByteStringIfEmbeddedPNG src 
    msfc <- liftIO $ case embed of         
      Just bstr -> do 
        sfc <- saveTempPNGToCreateSurface bstr 
        return (Just sfc)
      Nothing -> do
	let filesrc = C8.unpack (img_src img)
	    filesrcext = takeExtension filesrc 
	    imgaction 
	      | filesrcext == ".PNG" || filesrcext == ".png" = do 
		  b <- doesFileExist filesrc 
		  if b then Just <$> Cairo.imageSurfaceCreateFromPNG filesrc
		       else return Nothing 
	      | filesrcext == ".JPG" || filesrcext == ".jpg" = do 
		  b <- doesFileExist filesrc 
		  if b then Just <$> getJPGandCreateSurface filesrc 
		       else return Nothing 
	      | otherwise = return Nothing 
	imgaction
    -- maybe (return ()) (\sfc-> handler (uuid, (1.0,sfc))) msfc

    return (RItemImage imgbbx msfc)
cnstrctRItem (ItemSVG svg@(SVG _ _ bstr _ _)) = do 
    let str = C8.unpack bstr 
        svgbbx = runIdentity (makeBBoxed svg)
    rsvg <- liftIO (RSVG.svgNewFromString str)
    return (RItemSVG svgbbx (Just rsvg))
cnstrctRItem (ItemLink lnk@(Link _ _ _ _ _ bstr _ _)) = do 
    let str = C8.unpack bstr 
        lnkbbx = runIdentity (makeBBoxed lnk)
    rsvg <- liftIO $ RSVG.svgNewFromString str
    return (RItemLink lnkbbx (Just rsvg))
cnstrctRItem (ItemLink lnk@(LinkDocID _ _ _ _ _ bstr _ _)) = do 
    let str = C8.unpack bstr 
        lnkbbx = runIdentity (makeBBoxed lnk)
    rsvg <- liftIO $ RSVG.svgNewFromString str
    return (RItemLink lnkbbx (Just rsvg))    
cnstrctRItem (ItemLink lnk@(LinkAnchor _ _ _ _ bstr _ _)) = 
    if C8.null bstr 
    then let lnkbbx = runIdentity (makeBBoxed lnk) 
         in return (RItemLink lnkbbx Nothing) 
    else do 
      let str = C8.unpack bstr 
          lnkbbx = runIdentity (makeBBoxed lnk)
      rsvg <- liftIO $ RSVG.svgNewFromString str
      return (RItemLink lnkbbx (Just rsvg))    
cnstrctRItem (ItemAnchor anc@(Anchor _ bstr _ _)) = 
    if C8.null bstr 
    then let ancbbx = runIdentity (makeBBoxed anc) 
         in return (RItemAnchor ancbbx Nothing)
    else do 
      let str = C8.unpack bstr 
          ancbbx = runIdentity (makeBBoxed anc)
      rsvg <- liftIO $ RSVG.svgNewFromString str
      return (RItemAnchor ancbbx (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 Cairo.Surface 
getJPGandCreateSurface fp = do 
    img <- loadJpegFile fp  
    bstr <- savePngByteString img
    saveTempPNGToCreateSurface bstr 

-- | 
saveTempPNGToCreateSurface :: C8.ByteString -> IO Cairo.Surface
saveTempPNGToCreateSurface bstr = do 
    pipeActionWith (B.writeFile "/dev/stdout" bstr) Cairo.imageSurfaceCreateFromPNG