module Hoodle.Coroutine.Select.ManipulateImage where
import Control.Lens (set, view, _2)
import Control.Monad (when)
import Control.Monad.State (get)
import Data.ByteString.Base64 (encode)
import Data.Foldable (forM_)
import Data.Monoid ((<>))
import Data.Time
import qualified Graphics.GD.ByteString as G
import Graphics.Rendering.Cairo
import Data.Hoodle.BBox
import Data.Hoodle.Simple
import Graphics.Hoodle.Render.Item
import Graphics.Hoodle.Render.Util.HitTest (isBBox2InBBox1)
import Hoodle.Accessor
import Hoodle.Coroutine.Commit
import Hoodle.Coroutine.Draw
import Hoodle.Coroutine.Pen
import Hoodle.Device
import Hoodle.ModelAction.Page
import Hoodle.ModelAction.Pen
import Hoodle.ModelAction.Select
import Hoodle.ModelAction.Select.Transform
import qualified Hoodle.Type.Alias as A
import Hoodle.Type.Canvas
import Hoodle.Type.Coroutine
import Hoodle.Type.Enum
import Hoodle.Type.Event
import Hoodle.Type.HoodleState
import Hoodle.Type.PageArrangement
import Hoodle.View.Coordinate
import Hoodle.View.Draw
cropImage :: BBoxed Image -> MainCoroutine ()
cropImage imgbbx = do
liftIO $ putStrLn "cropImage called"
xst <- get
let (cid,cinfobox) = view currentCanvas xst
hdlmodst = view hoodleModeState xst
epage = forBoth' unboxBiAct (flip getCurrentPageEitherFromHoodleModeState hdlmodst) cinfobox
case hdlmodst of
ViewAppendState _ -> return ()
SelectState thdl -> do
case epage of
Left _ -> return ()
Right tpage -> initCropImage cid (thdl,tpage)
where
initCropImage cid (thdl,tpage) = do
r <- waitSomeEvent (\case PenDown _ _ _ -> True; _ -> False)
case r of
PenDown cid' _pbtn pcoord -> do
if (cid == cid') then startCropRect cid imgbbx (thdl,tpage) pcoord else return ()
_ -> return ()
startCropRect :: CanvasId
-> BBoxed Image
-> (A.Hoodle A.SelectMode,A.Page A.SelectMode)
-> PointerCoord
-> MainCoroutine ()
startCropRect cid imgbbx (thdl,tpage) pcoord0 = do
xst <- get
geometry <- liftIO $ getGeometry4CurrCvs xst
forM_ ((desktop2Page geometry . device2Desktop geometry) pcoord0) $ \(p0,c0) -> do
tsel <- createTempRender geometry (p0, BBox (unPageCoord c0) (unPageCoord c0))
ctime <- liftIO $ getCurrentTime
nbbox <- newCropRect cid geometry tsel (unPageCoord c0) (unPageCoord c0,ctime)
surfaceFinish (tempSurfaceSrc tsel)
surfaceFinish (tempSurfaceTgt tsel)
let pnum = (fst . tempInfo) tsel
let img = bbxed_content imgbbx
obbox = getBBox imgbbx
when (isBBox2InBBox1 obbox nbbox) $ do
mimg' <- liftIO $ createCroppedImage img obbox nbbox
forM_ mimg' $ \img' -> do
rimg' <- liftIO $ cnstrctRItem (ItemImage img')
let ntpage = replaceSelection rimg' tpage
nthdl <- liftIO $ updateTempHoodleSelectIO thdl ntpage (unPageNum pnum)
commit . set hoodleModeState (SelectState nthdl) =<< (liftIO (updatePageAll (SelectState nthdl) xst))
invalidateAllInBBox Nothing Efficient
return ()
newCropRect :: CanvasId
-> CanvasGeometry
-> TempRender (PageNum,BBox)
-> (Double,Double)
-> ((Double,Double),UTCTime)
-> MainCoroutine BBox
newCropRect cid geometry tsel orig (prev,otime) = do
let pnum = (fst . tempInfo) tsel
r <- nextevent
penMoveAndUpOnly r pnum geometry defact moveact upact
where
defact = newCropRect cid geometry tsel orig (prev,otime)
moveact (_pcoord,(x,y)) = do
(willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y)
if willUpdate
then do
let oinfo@(_,BBox xy0 _) = tempInfo tsel
nbbox = BBox xy0 (x,y)
ninfo = set _2 nbbox oinfo
invalidateTemp cid (tempSurfaceSrc tsel) (renderBoxSelection nbbox)
newCropRect cid geometry tsel {tempInfo = ninfo} orig (ncoord,ntime)
else defact
upact _pcoord = (return . snd . tempInfo) tsel
createCroppedImage :: Image -> BBox -> BBox -> IO (Maybe Image)
createCroppedImage img (BBox (xo0,yo0) (xo1,yo1)) (BBox (xn0,yn0) (xn1,yn1)) = do
let src = img_src img
embed = getByteStringIfEmbeddedPNG src
case embed of
Nothing -> return Nothing
Just bstr -> do
gdimg <- G.loadPngByteString bstr
(w,h) <- G.imageSize gdimg
let w' = floor $ (fromIntegral w) * (xn1xn0) / (xo1xo0)
h' = floor $ (fromIntegral h) * (yn1yn0) / (yo1yo0)
x1 = floor $ (fromIntegral w) * (xn0xo0) / (xo1xo0)
y1 = floor $ (fromIntegral h) * (yn0yo0) / (yo1yo0)
ngdimg <- G.newImage (w',h')
G.copyRegion (x1,y1) (w',h') gdimg (0,0) ngdimg
nbstr <- G.savePngByteString ngdimg
let nb64str = encode nbstr
nebdsrc = "data:image/png;base64," <> nb64str
return . Just $ Image nebdsrc (xn0,yn0) (Dim (xn1xn0) (yn1yn0))
rotateImage :: RotateDir -> BBoxed Image -> MainCoroutine ()
rotateImage dir imgbbx = do
xst <- get
let (_cid,cinfobox) = view currentCanvas xst
hdlmodst = view hoodleModeState xst
pnum = (PageNum . forBoth' unboxBiAct (view currentPageNum)) cinfobox
epage = forBoth' unboxBiAct (flip getCurrentPageEitherFromHoodleModeState hdlmodst) cinfobox
case hdlmodst of
ViewAppendState _ -> return ()
SelectState thdl -> do
case epage of
Left _ -> return ()
Right tpage -> do
let img = bbxed_content imgbbx
mimg' <- liftIO (createRotatedImage dir img (getBBox imgbbx))
forM_ mimg' $ \img' -> do
rimg' <- liftIO $ cnstrctRItem (ItemImage img')
let ntpage = replaceSelection rimg' tpage
nthdl <- liftIO $ updateTempHoodleSelectIO thdl ntpage (unPageNum pnum)
commit . set hoodleModeState (SelectState nthdl) =<< (liftIO (updatePageAll (SelectState nthdl) xst))
invalidateAllInBBox Nothing Efficient
return ()
createRotatedImage :: RotateDir -> Image -> BBox -> IO (Maybe Image)
createRotatedImage dir img (BBox (x0,y0) (x1,y1)) = do
let src = img_src img
embed = getByteStringIfEmbeddedPNG src
case embed of
Nothing -> return Nothing
Just bstr -> do
gdimg <- G.loadPngByteString bstr
ngdimg <- G.rotateImage (case dir of CW -> 3 ; CCW -> 1) gdimg
nbstr <- G.savePngByteString ngdimg
let nb64str = encode nbstr
nebdsrc = "data:image/png;base64," <> nb64str
return . Just $ Image nebdsrc (x0,y0) (Dim (y1y0) (x1x0))