module Hoodle.Type.HoodleState
( HoodleState(..)
, HoodleModeState(..)
, IsOneTimeSelectMode(..)
, Settings(..)
, UIComponentSignalHandler(..)
, hoodleModeState
, hoodleFileControl
, cvsInfoMap
, currentCanvas
, frameState
, rootWindow
, rootContainer
, rootOfRootWindow
, currentPenDraw
, callBack
, deviceList
, penInfo
, selectInfo
, gtkUIManager
, isSaved
, undoTable
, backgroundStyle
, isFullScreen
, settings
, uiComponentSignalHandler
, isOneTimeSelectMode
, lastTimeCanvasConfigure
, hookSet
, tempLog
, tempQueue
, hoodleFileName
, doesUseXInput
, doesSmoothScroll
, doesUsePopUpMenu
, doesEmbedImage
, doesEmbedPDF
, penModeSignal
, pageModeSignal
, penPointSignal
, penColorSignal
, emptyHoodleState
, defaultSettings
, defaultUIComponentSignalHandler
, getHoodle
, getCanvasInfoMap
, setCanvasInfoMap
, getCurrentCanvasId
, setCurrentCanvasId
, currentCanvasInfo
, resetHoodleModeStateBuffers
, getCanvasInfo
, setCanvasInfo
, updateFromCanvasInfoAsCurrentCanvas
, setCanvasId
, modifyCanvasInfo
, hoodleModeStateEither
, getCurrentPageFromHoodleModeState
, getCurrentPageDimFromHoodleModeState
, showCanvasInfoMapViewPortBBox
) where
import Control.Category
import Control.Lens
import Control.Monad.State hiding (get,modify)
import qualified Data.IntMap as M
import Data.Maybe
import Data.Time.Clock
import Graphics.UI.Gtk hiding (Clipboard, get,set)
import Control.Monad.Trans.Crtn.Event
import Control.Monad.Trans.Crtn.Queue
import Data.Hoodle.Generic
import Data.Hoodle.Select
import Graphics.Hoodle.Render
import Graphics.Hoodle.Render.Type
import Hoodle.Device
import Hoodle.Script.Hook
import Hoodle.Type.Enum
import Hoodle.Type.Event
import Hoodle.Type.Canvas
import Hoodle.Type.Window
import Hoodle.Type.Undo
import Hoodle.Type.Alias
import Hoodle.Type.PageArrangement
import Hoodle.Util
import Prelude hiding ((.), id)
data HoodleModeState = ViewAppendState { unView :: RHoodle }
| SelectState { tempSelect :: HHoodle }
data IsOneTimeSelectMode = NoOneTimeSelectMode
| YesBeforeSelect
| YesAfterSelect
deriving (Show,Eq,Ord)
data HoodleState =
HoodleState { _hoodleModeState :: HoodleModeState
, _hoodleFileControl :: HoodleFileControl
, _cvsInfoMap :: CanvasInfoMap
, _currentCanvas :: (CanvasId,CanvasInfoBox)
, _frameState :: WindowConfig
, _rootWindow :: Widget
, _rootContainer :: Box
, _rootOfRootWindow :: Window
, _currentPenDraw :: PenDraw
, _callBack :: MyEvent -> IO ()
, _deviceList :: DeviceList
, _penInfo :: PenInfo
, _selectInfo :: SelectInfo
, _gtkUIManager :: UIManager
, _isSaved :: Bool
, _undoTable :: UndoTable HoodleModeState
, _backgroundStyle :: BackgroundStyle
, _isFullScreen :: Bool
, _settings :: Settings
, _uiComponentSignalHandler :: UIComponentSignalHandler
, _isOneTimeSelectMode :: IsOneTimeSelectMode
, _lastTimeCanvasConfigure :: Maybe UTCTime
, _hookSet :: Maybe Hook
, _tempQueue :: Queue (Either (ActionOrder MyEvent) MyEvent)
, _tempLog :: String -> String
}
hoodleModeState :: Simple Lens HoodleState HoodleModeState
hoodleModeState = lens _hoodleModeState (\f a -> f { _hoodleModeState = a } )
hoodleFileControl :: Simple Lens HoodleState HoodleFileControl
hoodleFileControl = lens _hoodleFileControl (\f a -> f { _hoodleFileControl = a })
cvsInfoMap :: Simple Lens HoodleState CanvasInfoMap
cvsInfoMap = lens _cvsInfoMap (\f a -> f { _cvsInfoMap = a } )
currentCanvas :: Simple Lens HoodleState (CanvasId,CanvasInfoBox)
currentCanvas = lens _currentCanvas (\f a -> f { _currentCanvas = a } )
frameState :: Simple Lens HoodleState WindowConfig
frameState = lens _frameState (\f a -> f { _frameState = a } )
rootWindow :: Simple Lens HoodleState Widget
rootWindow = lens _rootWindow (\f a -> f { _rootWindow = a } )
rootContainer :: Simple Lens HoodleState Box
rootContainer = lens _rootContainer (\f a -> f { _rootContainer = a } )
rootOfRootWindow :: Simple Lens HoodleState Window
rootOfRootWindow = lens _rootOfRootWindow (\f a -> f { _rootOfRootWindow = a } )
currentPenDraw :: Simple Lens HoodleState PenDraw
currentPenDraw = lens _currentPenDraw (\f a -> f { _currentPenDraw = a } )
callBack :: Simple Lens HoodleState (MyEvent -> IO ())
callBack = lens _callBack (\f a -> f { _callBack = a } )
deviceList :: Simple Lens HoodleState DeviceList
deviceList = lens _deviceList (\f a -> f { _deviceList = a } )
penInfo :: Simple Lens HoodleState PenInfo
penInfo = lens _penInfo (\f a -> f { _penInfo = a } )
selectInfo :: Simple Lens HoodleState SelectInfo
selectInfo = lens _selectInfo (\f a -> f { _selectInfo = a } )
gtkUIManager :: Simple Lens HoodleState UIManager
gtkUIManager = lens _gtkUIManager (\f a -> f { _gtkUIManager = a } )
isSaved :: Simple Lens HoodleState Bool
isSaved = lens _isSaved (\f a -> f { _isSaved = a } )
undoTable :: Simple Lens HoodleState (UndoTable HoodleModeState)
undoTable = lens _undoTable (\f a -> f { _undoTable = a } )
backgroundStyle :: Simple Lens HoodleState BackgroundStyle
backgroundStyle = lens _backgroundStyle (\f a -> f { _backgroundStyle = a } )
isFullScreen :: Simple Lens HoodleState Bool
isFullScreen = lens _isFullScreen (\f a -> f { _isFullScreen = a } )
settings :: Simple Lens HoodleState Settings
settings = lens _settings (\f a -> f { _settings = a } )
uiComponentSignalHandler :: Simple Lens HoodleState UIComponentSignalHandler
uiComponentSignalHandler = lens _uiComponentSignalHandler (\f a -> f { _uiComponentSignalHandler = a })
isOneTimeSelectMode :: Simple Lens HoodleState IsOneTimeSelectMode
isOneTimeSelectMode = lens _isOneTimeSelectMode (\f a -> f { _isOneTimeSelectMode = a } )
lastTimeCanvasConfigure :: Simple Lens HoodleState (Maybe UTCTime)
lastTimeCanvasConfigure = lens _lastTimeCanvasConfigure (\f a -> f { _lastTimeCanvasConfigure = a } )
hookSet :: Simple Lens HoodleState (Maybe Hook)
hookSet = lens _hookSet (\f a -> f { _hookSet = a } )
tempQueue :: Simple Lens HoodleState (Queue (Either (ActionOrder MyEvent) MyEvent))
tempQueue = lens _tempQueue (\f a -> f { _tempQueue = a } )
tempLog :: Simple Lens HoodleState (String -> String)
tempLog = lens _tempLog (\f a -> f { _tempLog = a } )
data HoodleFileControl =
HoodleFileControl { _hoodleFileName :: Maybe FilePath }
hoodleFileName :: Simple Lens HoodleFileControl (Maybe FilePath)
hoodleFileName = lens _hoodleFileName (\f a -> f { _hoodleFileName = a } )
data UIComponentSignalHandler =
UIComponentSignalHandler{ _penModeSignal :: Maybe (ConnectId RadioAction)
, _pageModeSignal :: Maybe (ConnectId RadioAction)
, _penPointSignal :: Maybe (ConnectId RadioAction)
, _penColorSignal :: Maybe (ConnectId RadioAction)
}
penModeSignal :: Simple Lens UIComponentSignalHandler (Maybe (ConnectId RadioAction))
penModeSignal = lens _penModeSignal (\f a -> f { _penModeSignal = a } )
pageModeSignal :: Simple Lens UIComponentSignalHandler (Maybe (ConnectId RadioAction))
pageModeSignal = lens _pageModeSignal (\f a -> f { _pageModeSignal = a } )
penPointSignal :: Simple Lens UIComponentSignalHandler (Maybe (ConnectId RadioAction))
penPointSignal = lens _penPointSignal (\f a -> f { _penPointSignal = a } )
penColorSignal :: Simple Lens UIComponentSignalHandler (Maybe (ConnectId RadioAction))
penColorSignal = lens _penColorSignal (\f a -> f { _penColorSignal = a } )
data Settings =
Settings { _doesUseXInput :: Bool
, _doesSmoothScroll :: Bool
, _doesUsePopUpMenu :: Bool
, _doesEmbedImage :: Bool
, _doesEmbedPDF :: Bool
}
doesUseXInput :: Simple Lens Settings Bool
doesUseXInput = lens _doesUseXInput (\f a -> f { _doesUseXInput = a } )
doesSmoothScroll :: Simple Lens Settings Bool
doesSmoothScroll = lens _doesSmoothScroll (\f a -> f { _doesSmoothScroll = a } )
doesUsePopUpMenu :: Simple Lens Settings Bool
doesUsePopUpMenu = lens _doesUsePopUpMenu (\f a -> f { _doesUsePopUpMenu = a } )
doesEmbedImage :: Simple Lens Settings Bool
doesEmbedImage = lens _doesEmbedImage (\f a -> f { _doesEmbedImage = a } )
doesEmbedPDF :: Simple Lens Settings Bool
doesEmbedPDF = lens _doesEmbedPDF (\f a -> f { _doesEmbedPDF = a } )
emptyHoodleState :: IO HoodleState
emptyHoodleState = do
hdl <- emptyGHoodle
return $
HoodleState
{ _hoodleModeState = ViewAppendState hdl
, _hoodleFileControl = emptyHoodleFileControl
, _cvsInfoMap = error "emptyHoodleState.cvsInfoMap"
, _currentCanvas = error "emtpyHoodleState.currentCanvas"
, _frameState = error "emptyHoodleState.frameState"
, _rootWindow = error "emtpyHoodleState.rootWindow"
, _rootContainer = error "emptyHoodleState.rootContainer"
, _rootOfRootWindow = error "emptyHoodleState.rootOfRootWindow"
, _currentPenDraw = emptyPenDraw
, _callBack = error "emtpyHoodleState.callBack"
, _deviceList = error "emtpyHoodleState.deviceList"
, _penInfo = defaultPenInfo
, _selectInfo = SelectInfo SelectRectangleWork
, _gtkUIManager = error "emptyHoodleState.gtkUIManager"
, _isSaved = False
, _undoTable = emptyUndo 1
, _backgroundStyle = BkgStyleLined
, _isFullScreen = False
, _settings = defaultSettings
, _uiComponentSignalHandler = defaultUIComponentSignalHandler
, _isOneTimeSelectMode = NoOneTimeSelectMode
, _lastTimeCanvasConfigure = Nothing
, _hookSet = Nothing
, _tempQueue = emptyQueue
, _tempLog = id
}
emptyHoodleFileControl :: HoodleFileControl
emptyHoodleFileControl =
HoodleFileControl { _hoodleFileName = Nothing }
defaultUIComponentSignalHandler :: UIComponentSignalHandler
defaultUIComponentSignalHandler =
UIComponentSignalHandler{ _penModeSignal = Nothing
, _pageModeSignal = Nothing
, _penPointSignal = Nothing
, _penColorSignal = Nothing
}
defaultSettings :: Settings
defaultSettings =
Settings
{ _doesUseXInput = False
, _doesSmoothScroll = False
, _doesUsePopUpMenu = True
, _doesEmbedImage = True
, _doesEmbedPDF = True
}
getHoodle :: HoodleState -> Hoodle EditMode
getHoodle = either id gSelect2GHoodle . hoodleModeStateEither . view hoodleModeState
getCurrentCanvasId :: HoodleState -> CanvasId
getCurrentCanvasId = fst . _currentCanvas
setCurrentCanvasId :: CanvasId -> HoodleState -> Maybe HoodleState
setCurrentCanvasId a f = do
cinfobox <- M.lookup a (_cvsInfoMap f)
return (f { _currentCanvas = (a,cinfobox) })
getCanvasInfoMap :: HoodleState -> CanvasInfoMap
getCanvasInfoMap = _cvsInfoMap
setCanvasInfoMap :: CanvasInfoMap -> HoodleState -> Maybe HoodleState
setCanvasInfoMap cmap xstate
| M.null cmap = Nothing
| otherwise =
let (cid,_) = _currentCanvas xstate
(cidmax,cinfomax) = M.findMax cmap
mcinfobox = M.lookup cid cmap
in Just . maybe (xstate {_currentCanvas=(cidmax,cinfomax), _cvsInfoMap = cmap})
(\cinfobox -> xstate {_currentCanvas = (cid,cinfobox)
,_cvsInfoMap = cmap })
$ mcinfobox
currentCanvasInfo :: Simple Lens HoodleState CanvasInfoBox
currentCanvasInfo = lens getter setter
where
getter = snd . _currentCanvas
setter f a =
let cid = fst . _currentCanvas $ f
cmap' = M.adjust (const a) cid (_cvsInfoMap f)
in f { _currentCanvas = (cid,a), _cvsInfoMap = cmap' }
resetHoodleModeStateBuffers :: HoodleModeState -> IO HoodleModeState
resetHoodleModeStateBuffers hdlmodestate1 =
case hdlmodestate1 of
ViewAppendState hdl -> liftIO . liftM ViewAppendState . updateHoodleBuf $ hdl
_ -> return hdlmodestate1
getCanvasInfo :: CanvasId -> HoodleState -> CanvasInfoBox
getCanvasInfo cid xstate =
let cinfoMap = getCanvasInfoMap xstate
maybeCvs = M.lookup cid cinfoMap
in maybeError' ("no canvas with id = " ++ show cid) maybeCvs
setCanvasInfo :: (CanvasId,CanvasInfoBox) -> HoodleState -> HoodleState
setCanvasInfo (cid,cinfobox) xstate =
let cmap = getCanvasInfoMap xstate
cmap' = M.insert cid cinfobox cmap
in maybe xstate id $ setCanvasInfoMap cmap' xstate
updateFromCanvasInfoAsCurrentCanvas :: CanvasInfoBox -> HoodleState -> HoodleState
updateFromCanvasInfoAsCurrentCanvas cinfobox xstate =
let cid = unboxGet canvasId cinfobox
cmap = getCanvasInfoMap xstate
cmap' = M.insert cid cinfobox cmap
in xstate { _currentCanvas = (cid,cinfobox)
, _cvsInfoMap = cmap' }
setCanvasId :: CanvasId -> CanvasInfoBox -> CanvasInfoBox
setCanvasId cid = insideAction4CvsInfoBox (set canvasId cid)
modifyCanvasInfo :: CanvasId -> (CanvasInfoBox -> CanvasInfoBox) -> HoodleState
-> HoodleState
modifyCanvasInfo cid f xstate =
maybe xstate id . flip setCanvasInfoMap xstate
. M.adjust f cid . getCanvasInfoMap
$ xstate
hoodleModeStateEither :: HoodleModeState -> Either (Hoodle EditMode) (Hoodle SelectMode)
hoodleModeStateEither hdlmodst = case hdlmodst of
ViewAppendState hdl -> Left hdl
SelectState thdl -> Right thdl
getCurrentPageFromHoodleModeState :: (ViewMode a) => CanvasInfo a
-> HoodleModeState -> Page EditMode
getCurrentPageFromHoodleModeState cinfo hdlmodst =
let cpn = view currentPageNum cinfo
pagemap = getPageMapFromHoodleModeState hdlmodst
in maybeError' "updatePageFromCanvasToHoodle" $ M.lookup cpn pagemap
getCurrentPageDimFromHoodleModeState :: (ViewMode a) => CanvasInfo a
-> HoodleModeState -> PageDimension
getCurrentPageDimFromHoodleModeState cinfo =
PageDimension . view gdimension . getCurrentPageFromHoodleModeState cinfo
getPageMapFromHoodleModeState :: HoodleModeState -> M.IntMap (Page EditMode)
getPageMapFromHoodleModeState = either (view gpages) (view gselAll) . hoodleModeStateEither
showCanvasInfoMapViewPortBBox :: HoodleState -> IO ()
showCanvasInfoMapViewPortBBox xstate = do
let cmap = getCanvasInfoMap xstate
print . map (unboxGet (viewInfo.pageArrangement.viewPortBBox)) . M.elems $ cmap