module Application.HXournal.ModelAction.Select where import Application.HXournal.Type.Enum import Application.HXournal.Type.Canvas import Application.HXournal.Draw import Data.Xournal.Simple import Data.Xournal.Generic import Data.Xournal.BBox import Graphics.Xournal.Render.Type import Graphics.Xournal.Render.BBoxMapPDF import Graphics.Xournal.Render.HitTest import Graphics.UI.Gtk hiding (get,set) import Data.Strict.Tuple import qualified Data.IntMap as M import qualified Data.Map as Map import Control.Category import Data.Label import Prelude hiding ((.),id) isBBoxDeltaSmallerThan :: Double ->CanvasPageGeometry -> ZoomMode -> BBox -> BBox -> Bool isBBoxDeltaSmallerThan delta cpg zmode (BBox (x11,y11) (x12,y12)) (BBox (x21,y21) (x22,y22)) = let (x11',y11') = pageToCanvasCoord cpg zmode (x11,y11) (x12',y12') = pageToCanvasCoord cpg zmode (x12,y12) (x21',y21') = pageToCanvasCoord cpg zmode (x21,y21) (x22',y22') = pageToCanvasCoord cpg zmode (x22,y22) in (x11'-x21' > (-delta) && x11'-x21' < delta) && (y11'-y21' > (-delta) && y11'-y21' < delta) && (x12'-x22' > (-delta) && x12'-x22' < delta) && (y11'-y21' > (-delta) && y12'-y22' < delta) changeStrokeByOffset :: (Double,Double) -> StrokeBBox -> StrokeBBox changeStrokeByOffset (offx,offy) (StrokeBBox t c w ds bbox) = let offset ( x :!: y ) = (x+offx) :!: (y+offy) newds = map offset ds BBox (x1,y1) (x2,y2) = bbox newbbox = BBox (x1+offx,y1+offy) (x2+offx,y2+offy) in StrokeBBox t c w newds newbbox changeSelectionByOffset :: TTempPageSelectPDFBuf -> (Double,Double) -> TTempPageSelectPDFBuf changeSelectionByOffset tpage off = let ls = glayers tpage slayer = gselectedlayerbuf ls buf = get g_buffer slayer activelayer = unTEitherAlterHitted . get g_bstrokes $ slayer in case activelayer of Left _ -> tpage Right alist -> let alist' =fmapAL id (Hitted . map (changeStrokeByOffset off) . unHitted) alist layer' = GLayerBuf buf . TEitherAlterHitted . Right $ alist' in tpage { glayers = ls { gselectedlayerbuf = layer' }} updateTempXournalSelect :: TTempXournalSelectPDFBuf -> TTempPageSelectPDFBuf -> Int -> TTempXournalSelectPDFBuf updateTempXournalSelect txoj tpage pagenum = let pgs = gselectAll txoj pgs' = M.adjust (const (gcast tpage)) pagenum pgs in set g_selectAll pgs' . set g_selectSelected (Just (pagenum,tpage)) $ txoj hitInSelection :: TTempPageSelectPDFBuf -> (Double,Double) -> Bool hitInSelection tpage point = let activelayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . glayers $ tpage in case activelayer of Left _ -> False Right alist -> let bboxes = map strokebbox_bbox . takeHittedStrokes $ alist in any (flip hitTestBBoxPoint point) bboxes takeHittedStrokes :: AlterList [StrokeBBox] (Hitted StrokeBBox) -> [StrokeBBox] takeHittedStrokes = concatMap unHitted . getB isAnyHitted :: AlterList [StrokeBBox] (Hitted StrokeBBox) -> Bool isAnyHitted = not . null . takeHittedStrokes toggleCutCopyDelete :: UIManager -> Bool -> IO () toggleCutCopyDelete ui b = do agr <- uiManagerGetActionGroups ui >>= \x -> case x of [] -> error "No action group?" y:_ -> return y Just deletea <- actionGroupGetAction agr "DELETEA" Just copya <- actionGroupGetAction agr "COPYA" Just cuta <- actionGroupGetAction agr "CUTA" let copycutdeletea = [copya,cuta,deletea] mapM_ (flip actionSetSensitive b) copycutdeletea togglePaste :: UIManager -> Bool -> IO () togglePaste ui b = do agr <- uiManagerGetActionGroups ui >>= \x -> case x of [] -> error "No action group?" y:_ -> return y Just pastea <- actionGroupGetAction agr "PASTEA" actionSetSensitive pastea b changeStrokeColor :: PenColor -> StrokeBBox -> StrokeBBox changeStrokeColor pcolor str = let Just cname = Map.lookup pcolor penColorNameMap in str { strokebbox_color = cname } changeStrokeWidth :: Double -> StrokeBBox -> StrokeBBox changeStrokeWidth pwidth str = str { strokebbox_width = pwidth }