diff --git a/hxournal.cabal b/hxournal.cabal
--- a/hxournal.cabal
+++ b/hxournal.cabal
@@ -1,5 +1,5 @@
Name: hxournal
-Version: 0.6.4.3
+Version: 0.6.5
Synopsis: A pen notetaking program written in haskell
Description: notetaking program written in haskell and gtk2hs
Homepage: http://ianwookim.org/hxournal
@@ -48,10 +48,10 @@
cairo == 0.12.*,
monad-coroutine == 0.7.*,
transformers == 0.2.*,
- xournal-types >= 0.3.2 && < 0.4,
- xournal-parser >= 0.3.0.2 && < 0.4,
- xournal-render >= 0.5.1 && < 0.6,
- xournal-builder >= 0.1.0.2 && < 0.2,
+ xournal-types == 0.4.*,
+ xournal-parser == 0.4.*,
+ xournal-render == 0.6.*,
+ xournal-builder >= 0.1.1 && < 0.2,
containers == 0.4.*,
template-haskell == 2.*,
bytestring == 0.9.*,
@@ -63,7 +63,6 @@
time == 1.2.*,
TypeCompose == 0.9.*,
Diff == 0.1.*
-
else
Build-Depends: base == 4.*,
mtl == 2.*,
@@ -74,10 +73,10 @@
cairo == 0.12.*,
monad-coroutine == 0.7.*,
transformers == 0.2.*,
- xournal-types >= 0.3.1.999 && < 0.4,
- xournal-parser >= 0.3.0.2 && < 0.4,
- xournal-render >= 0.5.1 && < 0.6,
- xournal-builder >= 0.1.0.2 && < 0.2,
+ xournal-types == 0.4.*,
+ xournal-parser == 0.4.*,
+ xournal-render == 0.6.*,
+ xournal-builder >= 0.1.1 && < 0.2,
containers == 0.4.*,
template-haskell == 2.*,
bytestring == 0.9.*,
diff --git a/lib/Application/HXournal/Accessor.hs b/lib/Application/HXournal/Accessor.hs
--- a/lib/Application/HXournal/Accessor.hs
+++ b/lib/Application/HXournal/Accessor.hs
@@ -15,8 +15,6 @@
module Application.HXournal.Accessor where
import Application.HXournal.Type
-import Application.HXournal.View.Draw
-import Application.HXournal.ModelAction.Page
import Control.Applicative
import Control.Monad
import qualified Control.Monad.State as St
@@ -26,20 +24,15 @@
import Data.Label
import Prelude hiding ((.),id)
import Graphics.UI.Gtk hiding (get,set)
-import qualified Graphics.UI.Gtk as Gtk (get,set)
+import qualified Graphics.UI.Gtk as Gtk (set)
import Data.Xournal.BBox
import Data.Xournal.Generic
-import Application.HXournal.Util
import Application.HXournal.ModelAction.Layer
import Application.HXournal.Type.Alias
-import Application.HXournal.Type.Event
import Application.HXournal.Type.PageArrangement
-import Application.HXournal.Type.Coroutine
import Application.HXournal.View.Coordinate
-import Application.HXournal.Type.XournalState
-import Control.Monad.Coroutine
-import Control.Monad.Coroutine.SuspensionFunctors
+
-- | get HXournalState
getSt :: MainCoroutine HXournalState
@@ -58,7 +51,7 @@
-- |
-getPenType :: MainCoroutine PenType -- Iteratee MyEvent XournalStateIO PenType
+getPenType :: MainCoroutine PenType
getPenType = get (penType.penInfo) <$> lift (St.get)
-- |
@@ -92,7 +85,7 @@
let cpn = get currentPageNum cinfo
page = getCurrentPageFromXojState cinfo xojstate
in case xojstate of
- ViewAppendState xoj -> Left page
+ ViewAppendState _xoj -> Left page
SelectState txoj ->
case get g_selectSelected txoj of
Nothing -> Left page
@@ -147,15 +140,15 @@
liftIO $ maybe (return ()) signalBlock mconnid
agr <- liftIO $ uiManagerGetActionGroups ui
Just ra1 <- liftIO $ actionGroupGetAction (head agr) "ONEPAGEA"
- let wra1 = castToRadioAction ra1
+ -- let wra1 = castToRadioAction ra1
selectBoxAction (fsingle ra1) (fcont ra1) cinfobox
liftIO $ maybe (return ()) signalUnblock mconnid
return ()
- where fsingle ra1 cinfo = do
+ where fsingle ra1 _cinfo = do
let wra1 = castToRadioAction ra1
liftIO $ Gtk.set wra1 [radioActionCurrentValue := 1 ]
- fcont ra1 cinfo = do
- let wra1 = castToRadioAction ra1
+ fcont ra1 _cinfo = do
+ -- let wra1 = castToRadioAction ra1
-- liftIO $ wra1 `on` radioActionChanged $ const (putStrLn "hellowworld2" >> return ())
liftIO $ Gtk.set (castToRadioAction ra1) [radioActionCurrentValue := 0 ]
@@ -239,7 +232,7 @@
let cinfobox = getCanvasInfo cid xstate
cpn = PageNum . unboxGet currentPageNum $ cinfobox
canvas = unboxGet drawArea cinfobox
- xojstate = get xournalstate xstate
+ -- xojstate = get xournalstate xstate
fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry
fsingle = flip (makeCanvasGeometry cpn) canvas
. get (pageArrangement.viewInfo)
@@ -252,7 +245,7 @@
let cinfobox = get currentCanvasInfo xstate
cpn = PageNum . unboxGet currentPageNum $ cinfobox
canvas = unboxGet drawArea cinfobox
- xojstate = get xournalstate xstate
+ -- xojstate = get xournalstate xstate
fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry
fsingle = flip (makeCanvasGeometry cpn) canvas
. get (pageArrangement.viewInfo)
diff --git a/lib/Application/HXournal/Coroutine/Commit.hs b/lib/Application/HXournal/Coroutine/Commit.hs
--- a/lib/Application/HXournal/Coroutine/Commit.hs
+++ b/lib/Application/HXournal/Coroutine/Commit.hs
@@ -14,7 +14,6 @@
import Application.HXournal.Type.XournalState
import Application.HXournal.Type.Coroutine
-import Application.HXournal.Type.Event
import Application.HXournal.Type.Undo
import Application.HXournal.Coroutine.Draw
import Application.HXournal.ModelAction.File
diff --git a/lib/Application/HXournal/Coroutine/Default.hs b/lib/Application/HXournal/Coroutine/Default.hs
--- a/lib/Application/HXournal/Coroutine/Default.hs
+++ b/lib/Application/HXournal/Coroutine/Default.hs
@@ -38,7 +38,6 @@
-- import Application.HXournal.Coroutine.Network
import Application.HXournal.Coroutine.Layer
import Application.HXournal.ModelAction.Window
-import Application.HXournal.ModelAction.Page
import Application.HXournal.Type.Window
import Application.HXournal.Device
import Control.Applicative ((<$>))
@@ -54,7 +53,6 @@
import Data.IORef
import Application.HXournal.Type.PageArrangement
import Data.Xournal.Simple (Dimension(..))
-import Data.Xournal.BBox
import Data.Xournal.Generic
-- |
@@ -122,7 +120,7 @@
st2 = set frameState (Node 1)
. updateFromCanvasInfoAsCurrentCanvas initcvsbox
$ st1 { _cvsInfoMap = M.empty }
- (st3,cvs,wconf) <- constructFrame st2 (get frameState st2)
+ (st3,cvs,_wconf) <- constructFrame st2 (get frameState st2)
(st4,wconf') <- eventConnect st3 (get frameState st3)
let startingXstate = set frameState wconf' . set rootWindow cvs $ st4
@@ -154,12 +152,17 @@
viewAppendMode = do
r1 <- await
case r1 of
- PenDown cid pcoord -> do
+ PenDown cid pbtn pcoord -> do
ptype <- getPenType
- case ptype of
- PenWork -> penStart cid pcoord
- EraserWork -> eraserStart cid pcoord
- HighlighterWork -> highlighterStart cid pcoord
+ case (ptype,pbtn) of
+ (PenWork,PenButton1) -> penStart cid pcoord
+ (PenWork,PenButton2) -> eraserStart cid pcoord
+ (PenWork,PenButton3) -> do
+ updateXState (return . set isOneTimeSelectMode YesBeforeSelect)
+ modeChange ToSelectMode
+ selectLassoStart cid pcoord
+ (EraserWork,_) -> eraserStart cid pcoord
+ (HighlighterWork,_) -> highlighterStart cid pcoord
_ -> return ()
_ -> defaultEventProcess r1
@@ -167,7 +170,7 @@
selectMode = do
r1 <- await
case r1 of
- PenDown cid pcoord -> do
+ PenDown cid _pbtn pcoord -> do
ptype <- return . get (selectType.selectInfo) =<< lift St.get
case ptype of
SelectRectangleWork -> selectRectStart cid pcoord
@@ -185,8 +188,9 @@
defaultEventProcess (HScrollBarMoved cid v) = hscrollBarMoved cid v
defaultEventProcess (VScrollBarMoved cid v) = vscrollBarMoved cid v
defaultEventProcess (VScrollBarStart cid _v) = vscrollStart cid
+defaultEventProcess PaneMoveStart = paneMoveStart
defaultEventProcess (CanvasConfigure cid w' h') =
- canvasConfigure cid (CanvasDimension (Dim w' h'))
+ doCanvasConfigure cid (CanvasDimension (Dim w' h'))
defaultEventProcess ToViewAppendMode = modeChange ToViewAppendMode
defaultEventProcess ToSelectMode = modeChange ToSelectMode
@@ -265,6 +269,18 @@
then mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsAll]) canvases
else mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsNone] ) canvases
+menuEventProcess MenuPressureSensitivity = updateXState pressSensAction
+ where pressSensAction xstate = do
+ let ui = get gtkUIManager xstate
+ agr <- liftIO ( uiManagerGetActionGroups ui >>= \x ->
+ case x of
+ [] -> error "No action group? "
+ y:_ -> return y )
+ pressrsensa <- liftIO (actionGroupGetAction agr "PRESSRSENSA")
+ >>= maybe (error "MenuPressureSensitivity")
+ (return . castToToggleAction)
+ b <- liftIO $ toggleActionGetActive pressrsensa
+ return (set (variableWidthPen.penInfo) b xstate)
menuEventProcess m = liftIO $ putStrLn $ "not implemented " ++ show m
diff --git a/lib/Application/HXournal/Coroutine/Draw.hs b/lib/Application/HXournal/Coroutine/Draw.hs
--- a/lib/Application/HXournal/Coroutine/Draw.hs
+++ b/lib/Application/HXournal/Coroutine/Draw.hs
@@ -28,12 +28,9 @@
import Control.Category
import Data.Label
import Prelude hiding ((.),id)
-import Data.Xournal.Generic
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk hiding (get,set)
-import Application.HXournal.View.Coordinate
import Application.HXournal.Type.Alias
-import Application.HXournal.ModelAction.Page
data DrawingFunctionSet =
DrawingFunctionSet { singleEditDraw :: DrawingFunction SinglePage EditMode
@@ -134,9 +131,9 @@
xst <- getSt
selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst
where fsingle xstate cvsInfo = do
- page <- getCurrentPageCvsId cid
+ -- page <- getCurrentPageCvsId cid
let canvas = get drawArea cvsInfo
- vinfo = get viewInfo cvsInfo
+ -- vinfo = get viewInfo cvsInfo
pnum = PageNum . get currentPageNum $ cvsInfo
geometry <- liftIO $ getCanvasGeometry xstate
win <- liftIO $ widgetGetDrawWindow canvas
@@ -157,9 +154,9 @@
xst <- getSt
selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst
where fsingle xstate cvsInfo = do
- page <- getCurrentPageCvsId cid
+ -- page <- getCurrentPageCvsId cid
let canvas = get drawArea cvsInfo
- vinfo = get viewInfo cvsInfo
+ -- vinfo = get viewInfo cvsInfo
geometry <- liftIO $ getCanvasGeometry xstate
win <- liftIO $ widgetGetDrawWindow canvas
let xformfunc = cairoXform4PageCoordinate geometry pnum
diff --git a/lib/Application/HXournal/Coroutine/Eraser.hs b/lib/Application/HXournal/Coroutine/Eraser.hs
--- a/lib/Application/HXournal/Coroutine/Eraser.hs
+++ b/lib/Application/HXournal/Coroutine/Eraser.hs
@@ -33,7 +33,6 @@
import Data.Xournal.BBox
import Graphics.Xournal.Render.HitTest
-import Graphics.Xournal.Render.BBox
import Graphics.Xournal.Render.BBoxMapPDF
import Control.Monad.Coroutine.SuspensionFunctors
import Control.Monad.Trans
@@ -69,7 +68,7 @@
(moveact xstate cvsInfo) upact
defact = eraserProcess cid pnum geometry connidup connidmove strs (x0,y0)
upact _ = disconnect connidmove >> disconnect connidup >> invalidateAll
- moveact xstate cvsInfo (x,y) = do
+ moveact xstate cvsInfo (_pcoord,(x,y)) = do
let line = ((x0,y0),(x,y))
hittestbbox = mkHitTestBBox line strs
(hitteststroke,hitState) =
diff --git a/lib/Application/HXournal/Coroutine/EventConnect.hs b/lib/Application/HXournal/Coroutine/EventConnect.hs
--- a/lib/Application/HXournal/Coroutine/EventConnect.hs
+++ b/lib/Application/HXournal/Coroutine/EventConnect.hs
@@ -46,7 +46,7 @@
callbk <- get callBack <$> getSt
dev <- get deviceList <$> getSt
liftIO (c `on` motionNotifyEvent $ tryEvent $ do
- p <- getPointer dev
+ (_,p) <- getPointer dev
liftIO (callbk (PenMove cid p)))
connPenUp :: (WidgetClass w) => w -> CanvasId -> MainCoroutine (ConnectId w)
@@ -54,5 +54,5 @@
callbk <- get callBack <$> getSt
dev <- get deviceList <$> getSt
liftIO (c `on` buttonReleaseEvent $ tryEvent $ do
- p <- getPointer dev
+ (_,p) <- getPointer dev
liftIO (callbk (PenMove cid p)))
diff --git a/lib/Application/HXournal/Coroutine/File.hs b/lib/Application/HXournal/Coroutine/File.hs
--- a/lib/Application/HXournal/Coroutine/File.hs
+++ b/lib/Application/HXournal/Coroutine/File.hs
@@ -12,7 +12,6 @@
module Application.HXournal.Coroutine.File where
-import Application.HXournal.Type.Event
import Application.HXournal.Type.Coroutine
import Application.HXournal.Type.XournalState
import Application.HXournal.Accessor
diff --git a/lib/Application/HXournal/Coroutine/Layer.hs b/lib/Application/HXournal/Coroutine/Layer.hs
--- a/lib/Application/HXournal/Coroutine/Layer.hs
+++ b/lib/Application/HXournal/Coroutine/Layer.hs
@@ -24,7 +24,6 @@
import Application.HXournal.ModelAction.Page
import Application.HXournal.Coroutine.Commit
import Control.Monad.Trans
-
import qualified Data.IntMap as M
import Data.Xournal.Generic
import Data.Xournal.Select
@@ -34,7 +33,6 @@
import Data.Label
import Prelude hiding ((.),id)
import Data.IORef
-import qualified Data.Sequence as Seq
import Graphics.UI.Gtk hiding (get,set)
layerAction :: (XournalState -> Int -> Page EditMode -> MainCoroutine XournalState)
@@ -44,7 +42,6 @@
selectBoxAction (fsingle xst) (fsingle xst) . get currentCanvasInfo $ xst
where
fsingle xstate cvsInfo = do
- let xojstate = get xournalstate xstate
let epage = getCurrentPageEitherFromXojState cvsInfo xojstate
cpn = get currentPageNum cvsInfo
xojstate = get xournalstate xstate
@@ -75,8 +72,8 @@
case mlyrzipper of
Nothing -> liftIO $ putStrLn "Nothing"
Just _ -> liftIO $ putStrLn "Just"
- let Select (O (Just ll)) = get g_layers npage
- SZ (_,(x1,x2)) = ll
+ -- let Select (O (Just ll)) = get g_layers npage
+ -- SZ (_,(x1,x2)) = ll
return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate
gotoPrevLayer :: MainCoroutine ()
@@ -86,8 +83,8 @@
Select (O (Just lyrzipper)) = get g_layers currpage
let mlyrzipper = moveLeft lyrzipper
npage = maybe currpage (\x -> set g_layers (Select (O (Just x))) currpage) mlyrzipper
- let Select (O (Just ll)) = get g_layers npage
- SZ (_,(x1,x2)) = ll
+ -- let Select (O (Just ll)) = get g_layers npage
+ -- SZ (_,(x1,x2)) = ll
case mlyrzipper of
Nothing -> liftIO $ putStrLn "Nothing"
Just _ -> liftIO $ putStrLn "Just"
@@ -101,8 +98,8 @@
Select (O (Just lyrzipper)) = get g_layers currpage
let mlyrzipper = moveTo n lyrzipper
npage = maybe currpage (\x -> set g_layers (Select (O (Just x))) currpage) mlyrzipper
- let Select (O (Just ll)) = get g_layers npage
- SZ (_,(x1,x2)) = ll
+ -- let Select (O (Just ll)) = get g_layers npage
+ -- SZ (_,(_x1,_x2)) = ll
return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate
diff --git a/lib/Application/HXournal/Coroutine/Mode.hs b/lib/Application/HXournal/Coroutine/Mode.hs
--- a/lib/Application/HXournal/Coroutine/Mode.hs
+++ b/lib/Application/HXournal/Coroutine/Mode.hs
@@ -22,25 +22,23 @@
import Application.HXournal.Type.Canvas
import Application.HXournal.View.Coordinate
import Application.HXournal.Accessor
-import Application.HXournal.ModelAction.Page
import Application.HXournal.Coroutine.Scroll
import Application.HXournal.Coroutine.Draw
-import Data.Traversable
import Control.Applicative
import Control.Monad.Trans
import Control.Category
import Data.Label
-import Data.Xournal.Simple (Dimension(..))
+import qualified Data.IntMap as M
import Data.Xournal.BBox
import Data.Xournal.Generic
import Graphics.Xournal.Render.BBoxMapPDF
-import Graphics.UI.Gtk (adjustmentSetUpper,adjustmentGetValue,adjustmentSetValue)
+import Graphics.UI.Gtk (adjustmentGetValue)
import Prelude hiding ((.),id, mapM_, mapM)
modeChange :: MyEvent -> MainCoroutine ()
modeChange command = case command of
- ToViewAppendMode -> updateXState select2edit
- ToSelectMode -> updateXState edit2select
+ ToViewAppendMode -> updateXState select2edit >> invalidateAll
+ ToSelectMode -> updateXState edit2select >> invalidateAll
_ -> return ()
where select2edit xst =
either (noaction xst) (whenselect xst) . xojstateEither . get xournalstate $ xst
@@ -49,15 +47,25 @@
noaction :: HXournalState -> a -> MainCoroutine HXournalState
noaction xstate = const (return xstate)
whenselect :: HXournalState -> Xournal SelectMode -> MainCoroutine HXournalState
- whenselect xstate txoj = return . flip (set xournalstate) xstate
- . ViewAppendState . GXournal (get g_selectTitle txoj)
- =<< liftIO (mapM resetPageBuffers (get g_selectAll txoj))
+ whenselect xstate txoj = do
+ let pages = get g_selectAll txoj
+ mselect = get g_selectSelected txoj
+ npages <- maybe (return pages)
+ (\(spgn,spage) -> do
+ npage <- liftIO $ resetPageBuffers (gcast spage)
+ return $ M.adjust (const npage) spgn pages )
+ mselect
+ return . flip (set xournalstate) xstate
+ . ViewAppendState . GXournal (get g_selectTitle txoj) $ npages
whenedit :: HXournalState -> Xournal EditMode -> MainCoroutine HXournalState
whenedit xstate xoj = return . flip (set xournalstate) xstate
. SelectState
$ GSelect (get g_title xoj) (gpages xoj) Nothing
+-- M.adjust (const (
+-- =<< liftIO (mapM resetPageBuffers (get g_selectAll txoj))
+-- |
viewModeChange :: MyEvent -> MainCoroutine ()
viewModeChange command = do
@@ -102,7 +110,7 @@
whensing xstate cinfo = do
cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate
- page <- getCurrentPageCurr
+ -- page <- getCurrentPageCurr
let zmode = get (zoomMode.viewInfo) cinfo
canvas = get drawArea cinfo
cpn = PageNum . get currentPageNum $ cinfo
@@ -111,7 +119,7 @@
let arr = makeContinuousSingleArrangement zmode cdim (getXournal xstate)
(cpn, PageCoord (xpos,ypos))
- ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr
+ -- ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr
geometry <- liftIO $ makeCanvasGeometry cpn arr canvas
let DeskCoord (nxpos,nypos) = page2Desktop geometry (cpn,PageCoord (xpos,ypos))
let vinfo = get viewInfo cinfo
diff --git a/lib/Application/HXournal/Coroutine/Page.hs b/lib/Application/HXournal/Coroutine/Page.hs
--- a/lib/Application/HXournal/Coroutine/Page.hs
+++ b/lib/Application/HXournal/Coroutine/Page.hs
@@ -18,7 +18,6 @@
import Application.HXournal.Type.PageArrangement
import Application.HXournal.Type.XournalState
import Application.HXournal.Util
-import Application.HXournal.View.Draw
import Application.HXournal.View.Coordinate
import Application.HXournal.Accessor
import Application.HXournal.Coroutine.Draw
@@ -27,15 +26,11 @@
-- import Application.HXournal.ModelAction.Adjustment
import Application.HXournal.ModelAction.Page
import Application.HXournal.Type.Alias
-import Graphics.Xournal.Render.BBoxMapPDF
import Data.Xournal.Generic
-import Graphics.UI.Gtk hiding (get,set)
import Control.Monad.Trans
import Control.Category
import Data.Label
import Prelude hiding ((.), id)
-import Data.Xournal.Simple (Dimension(..))
-import Data.Xournal.BBox
import qualified Data.IntMap as M
-- | change page of current canvas using a modify function
@@ -50,8 +45,8 @@
let xojst = get xournalstate $ xstate
npgnum = modifyfn (get currentPageNum cvsInfo)
cid = get canvasId cvsInfo
- (b,npgnum',selectedpage,xojst') = changePageInXournalState npgnum xojst
- Dim w h = get g_dimension selectedpage
+ (b,npgnum',_selectedpage,xojst') = changePageInXournalState npgnum xojst
+ -- Dim w h = get g_dimension selectedpage
xstate' <- liftIO $ updatePageAll xojst' xstate
ncvsInfo <- liftIO $ setPage xstate' (PageNum npgnum') cid
xstatefinal <- return . modifyCurrentCanvasInfo (const ncvsInfo) $ xstate'
@@ -62,8 +57,8 @@
let xojst = get xournalstate $ xstate
npgnum = modifyfn (get currentPageNum cvsInfo)
cid = get canvasId cvsInfo
- (b,npgnum',selectedpage,xojst') = changePageInXournalState npgnum xojst
- Dim w h = get g_dimension selectedpage
+ (b,npgnum',_selectedpage,xojst') = changePageInXournalState npgnum xojst
+ -- Dim w h = get g_dimension selectedpage
xstate' <- liftIO $ updatePageAll xojst' xstate
ncvsInfo <- liftIO $ setPage xstate' (PageNum npgnum') cid
xstatefinal <- return . modifyCurrentCanvasInfo (const ncvsInfo) $ xstate'
@@ -90,11 +85,53 @@
in (False,npg,pg,exoj)
in (isChanged,npgnum',npage',either ViewAppendState SelectState exoj')
+-- |
+canvasZoomUpdateGenRenderCvsId :: MainCoroutine ()
+ -> CanvasId
+ -> Maybe ZoomMode
+ -> MainCoroutine ()
+canvasZoomUpdateGenRenderCvsId renderfunc cid mzmode
+ = updateXState zoomUpdateAction
+ >> adjustScrollbarWithGeometryCvsId cid
+ >> renderfunc
+ where zoomUpdateAction xst =
+ selectBoxAction (fsingle xst) (fcont xst) . getCanvasInfo cid $ xst
+ fsingle xstate cinfo = do
+ geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo
+ page <- getCurrentPageCvsId cid
+ let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode
+ pdim = PageDimension $ get g_dimension page
+ cdim = canvasDim geometry
+ narr = makeSingleArrangement zmode pdim cdim (0,0)
+ ncinfobox = CanvasInfoBox
+ . set (pageArrangement.viewInfo) narr
+ . set (zoomMode.viewInfo) zmode $ cinfo
+ return . modifyCanvasInfo cid (const ncinfobox) $ xstate
+ fcont xstate cinfo = do
+ geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo
+ -- page <- getCurrentPageCvsId cid
+ let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode
+ cpn = PageNum $ get currentPageNum cinfo
+ -- pdim = PageDimension $ get g_dimension page
+ cdim = canvasDim geometry
+ xoj = getXournal xstate
+ narr = makeContinuousSingleArrangement zmode cdim xoj (cpn,PageCoord (0,0))
+ ncinfobox = CanvasInfoBox
+ . set (pageArrangement.viewInfo) narr
+ . set (zoomMode.viewInfo) zmode $ cinfo
+ return . modifyCanvasInfo cid (const ncinfobox) $ xstate
+
+
-- |
-canvasZoomUpdateCvsId :: CanvasId -> Maybe ZoomMode -> MainCoroutine ()
-canvasZoomUpdateCvsId cid mzmode = updateXState zoomUpdateAction
+canvasZoomUpdateCvsId :: CanvasId
+ -> Maybe ZoomMode
+ -> MainCoroutine ()
+canvasZoomUpdateCvsId = canvasZoomUpdateGenRenderCvsId invalidateAll
+
+{-
+ cid mzmode = updateXState zoomUpdateAction
>> adjustScrollbarWithGeometryCvsId cid
>> invalidateAll
where zoomUpdateAction xst =
@@ -125,7 +162,17 @@
. set (pageArrangement.viewInfo) narr
. set (zoomMode.viewInfo) zmode $ cinfo
return . modifyCanvasInfo cid (const ncinfobox) $ xstate
+-}
+-- |
+
+canvasZoomUpdateBufAll :: MainCoroutine ()
+canvasZoomUpdateBufAll = do
+ klst <- liftM (M.keys . getCanvasInfoMap) getSt
+ mapM_ updatefunc klst
+ where
+ updatefunc cid
+ = canvasZoomUpdateGenRenderCvsId (invalidateWithBuf cid) cid Nothing
-- |
canvasZoomUpdateAll :: MainCoroutine ()
diff --git a/lib/Application/HXournal/Coroutine/Pen.hs b/lib/Application/HXournal/Coroutine/Pen.hs
--- a/lib/Application/HXournal/Coroutine/Pen.hs
+++ b/lib/Application/HXournal/Coroutine/Pen.hs
@@ -30,18 +30,14 @@
import Application.HXournal.ModelAction.Page
import Application.HXournal.View.Coordinate
import Application.HXournal.View.Draw
-import Application.HXournal.Type.Alias
import Application.HXournal.Util
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Coroutine.SuspensionFunctors
import Data.Xournal.Predefined
-import Data.Xournal.Generic
import Data.Xournal.BBox
-import Graphics.Xournal.Render.BBox
import Data.Sequence hiding (filter)
import qualified Data.Map as M
-import qualified Data.IntMap as IM
import Data.Maybe
import Control.Category
import Data.Label
@@ -56,7 +52,7 @@
putSt xst
return cinfo'
where switchact xst = do
- let xoj = getXournal xst
+ let -- xoj = getXournal xst
ncinfo = set currentPageNum (unPageNum pgn) cinfo
mfunc = const (return . CanvasInfoBox $ ncinfo)
return . (,ncinfo) =<< modifyCurrCvsInfoM mfunc xst
@@ -95,13 +91,14 @@
-- | enter pen drawing mode
penStart :: CanvasId -> PointerCoord -> MainCoroutine ()
-penStart cid = commonPenStart penAction cid
+penStart cid pcoord = commonPenStart penAction cid pcoord
where penAction :: forall b. (ViewMode b) => CanvasInfo b -> PageNum -> CanvasGeometry -> (ConnectId DrawingArea, ConnectId DrawingArea) -> (Double,Double) -> MainCoroutine ()
- penAction cinfo pnum geometry (cidmove,cidup) (x,y) = do
+ penAction _cinfo pnum geometry (cidmove,cidup) (x,y) = do
xstate <- getSt
+ let PointerCoord _ _ _ z = pcoord
let currxoj = unView . get xournalstate $ xstate
pinfo = get penInfo xstate
- pdraw <-penProcess cid pnum geometry cidmove cidup (empty |> (x,y)) (x,y)
+ pdraw <-penProcess cid pnum geometry cidmove cidup (empty |> (x,y,z)) ((x,y),z)
(newxoj,bbox) <- liftIO $ addPDraw pinfo currxoj pnum pdraw
commit . set xournalstate (ViewAppendState newxoj)
=<< (liftIO (updatePageAll (ViewAppendState newxoj) xstate))
@@ -119,19 +116,21 @@
penProcess :: CanvasId -> PageNum
-> CanvasGeometry
-> ConnectId DrawingArea -> ConnectId DrawingArea
- -> Seq (Double,Double) -> (Double,Double)
- -> MainCoroutine (Seq (Double,Double))
-penProcess cid pnum geometry connidmove connidup pdraw (x0,y0) = do
+ -> Seq (Double,Double,Double) -> ((Double,Double),Double)
+ -> MainCoroutine (Seq (Double,Double,Double))
+penProcess cid pnum geometry connidmove connidup pdraw ((x0,y0),z0) = do
r <- await
xst <- getSt
- selectBoxAction (fsingle r xst) (fsingle r xst) . getCanvasInfo cid $ xst
+ boxAction (fsingle r xst) . getCanvasInfo cid $ xst
where
fsingle :: forall b. (ViewMode b) =>
- MyEvent -> HXournalState -> CanvasInfo b -> MainCoroutine (Seq (Double,Double))
+ MyEvent -> HXournalState -> CanvasInfo b
+ -> MainCoroutine (Seq (Double,Double,Double))
fsingle r xstate cvsInfo =
penMoveAndUpOnly r pnum geometry
- (penProcess cid pnum geometry connidmove connidup pdraw (x0,y0))
- (\(x,y) -> do
+ (penProcess cid pnum geometry connidmove connidup pdraw ((x0,y0),z0))
+ (\(pcoord,(x,y)) -> do
+ let PointerCoord _ _ _ z = pcoord
let canvas = get drawArea cvsInfo
ptype = get (penType.penInfo) xstate
pcolor = get (penColor.currentTool.penInfo) xstate
@@ -141,8 +140,12 @@
HighlighterWork -> predefined_highlighter_opacity
_ -> 1.0
pcolRGBA = (pcr,pcg,pcb,pca*opacity)
- liftIO $ drawCurvebit canvas geometry pwidth pcolRGBA pnum (x0,y0) (x,y)
- penProcess cid pnum geometry connidmove connidup (pdraw |> (x,y)) (x,y) )
+ let pressureType = case get (variableWidthPen.penInfo) xstate of
+ True -> Pressure
+ False -> NoPressure
+ liftIO $ drawCurvebitGen pressureType canvas geometry
+ pwidth pcolRGBA pnum ((x0,y0),z0) ((x,y),z)
+ penProcess cid pnum geometry connidmove connidup (pdraw |> (x,y,z)) ((x,y),z) )
(\_ -> disconnect connidmove >> disconnect connidup >> return pdraw )
-- |
@@ -150,11 +153,11 @@
skipIfNotInSamePage :: Monad m =>
PageNum -> CanvasGeometry -> PointerCoord
-> m a
- -> ((Double,Double) -> m a)
+ -> ((PointerCoord,(Double,Double)) -> m a)
-> m a
skipIfNotInSamePage pgn geometry pcoord skipaction ordaction =
switchActionEnteringDiffPage pgn geometry pcoord
- skipaction (\_ _ -> skipaction ) (\_ (_,PageCoord xy)->ordaction xy)
+ skipaction (\_ _ -> skipaction ) (\_ (_,PageCoord xy)->ordaction (pcoord,xy))
-- |
@@ -178,7 +181,7 @@
-> PageNum
-> CanvasGeometry
-> m a
- -> ((Double,Double) -> m a)
+ -> ((PointerCoord,(Double,Double)) -> m a)
-> (PointerCoord -> m a)
-> m a
penMoveAndUpOnly r pgn geometry defact moveaction upaction =
diff --git a/lib/Application/HXournal/Coroutine/Scroll.hs b/lib/Application/HXournal/Coroutine/Scroll.hs
--- a/lib/Application/HXournal/Coroutine/Scroll.hs
+++ b/lib/Application/HXournal/Coroutine/Scroll.hs
@@ -98,7 +98,7 @@
xst <- getSt
geometry <- liftIO (getCanvasGeometry xst)
case ev of
- VScrollBarMoved cid' v -> do
+ VScrollBarMoved _cid' v -> do
updateXState $ return.modifyCurrentCanvasInfo
(selectBox (scrollmovecanvas v) (scrollmovecanvasCont geometry v))
invalidateWithBuf cid
diff --git a/lib/Application/HXournal/Coroutine/Select.hs b/lib/Application/HXournal/Coroutine/Select.hs
--- a/lib/Application/HXournal/Coroutine/Select.hs
+++ b/lib/Application/HXournal/Coroutine/Select.hs
@@ -33,13 +33,11 @@
import Application.HXournal.ModelAction.Page
import Application.HXournal.ModelAction.Select
import Application.HXournal.ModelAction.Layer
-import Application.HXournal.Util
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Coroutine.SuspensionFunctors
import Control.Category
-import Control.Applicative
import Data.Label
import Prelude hiding ((.), id)
import Data.Xournal.Simple (Dimension(..))
@@ -56,7 +54,6 @@
import Graphics.Xournal.Render.BBoxMapPDF
import Graphics.Xournal.Render.HitTest
import Graphics.Xournal.Render.BBox
-import Graphics.Xournal.Render.Simple
import Graphics.Xournal.Render.Generic
-- |
@@ -77,6 +74,19 @@
return tempselection
+-- | For Selection mode from pen mode with 2nd pen button
+
+dealWithOneTimeSelectMode :: MainCoroutine () -> MainCoroutine ()
+dealWithOneTimeSelectMode action = do
+ xstate <- getSt
+ case get isOneTimeSelectMode xstate of
+ NoOneTimeSelectMode -> action
+ YesBeforeSelect ->
+ action >> updateXState (return . set isOneTimeSelectMode YesAfterSelect)
+ YesAfterSelect -> do
+ updateXState (return . set isOneTimeSelectMode NoOneTimeSelectMode)
+ modeChange ToViewAppendMode
+
-- | main mouse pointer click entrance in rectangular selection mode.
-- choose either starting new rectangular selection or move previously
-- selected selection.
@@ -86,11 +96,12 @@
where rectaction cinfo pnum geometry (cidup,cidmove) (x,y) = do
strs <- getAllStrokeBBoxInCurrentLayer
ctime <- liftIO $ getCurrentTime
- let newSelectAction page = do
- tsel <- createTempSelectRender pnum geometry page []
- newSelectRectangle cid pnum geometry cidmove cidup strs
- (x,y) ((x,y),ctime) tsel
- surfaceFinish (tempSurface tsel)
+ let newSelectAction page =
+ dealWithOneTimeSelectMode $ do
+ tsel <- createTempSelectRender pnum geometry page []
+ newSelectRectangle cid pnum geometry cidmove cidup strs
+ (x,y) ((x,y),ctime) tsel
+ surfaceFinish (tempSurface tsel)
let
action (Right tpage) | hitInHandle tpage (x,y) =
case getULBBoxFromSelected tpage of
@@ -131,7 +142,7 @@
(moveact xstate cinfo) (upact xstate cinfo)
defact = newSelectRectangle cid pnum geometry connidmove connidup strs orig
(prev,otime) tempselection
- moveact xstate cinfo (x,y) = do
+ moveact _xstate _cinfo (_pcoord,(x,y)) = do
let bbox = BBox orig (x,y)
hittestbbox = mkHitTestInsideBBox bbox strs
hittedstrs = concat . map unHitted . getB $ hittestbbox
@@ -162,14 +173,15 @@
(ncoord,ntime)
tempselection { tempSelectInfo = hittedstrs }
upact xstate cinfo pcoord = do
- let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
- (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return
+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
+ (_,(x,y)) = runIdentity $
+ skipIfNotInSamePage pnum geometry pcoord
+ (return (pcoord,prev)) return
let epage = getCurrentPageEitherFromXojState cinfo (get xournalstate xstate)
cpn = get currentPageNum cinfo
let bbox = BBox orig (x,y)
hittestbbox = mkHitTestInsideBBox bbox strs
selectstrs = fmapAL unNotHitted id hittestbbox
- xstate <- getSt
let SelectState txoj = get xournalstate xstate
newpage = case epage of
Left pagebbox -> makePageSelectMode pagebbox selectstrs
@@ -229,7 +241,7 @@
penMoveAndUpInterPage r pnum geometry defact (moveact xstate cinfo) (upact xstate cinfo)
defact = moveSelect cid pnum geometry connidmove connidup orig (prev,otime)
tempselection
- moveact xstate cinfo oldpgn pcpair@(newpgn,pgxy@(PageCoord (px,py))) = do
+ moveact _xstate _cinfo oldpgn pcpair@(newpgn,PageCoord (px,py)) = do
let (x,y)
| oldpgn == newpgn = (px,py)
| otherwise =
@@ -248,17 +260,12 @@
(b1',b2') = xform (sfunc (0,1))
(b1,b2) = (b1'-c1,b2'-c2)
xformmat = Mat.Matrix a1 a2 b1 b2 c1 c2
-{- (c1,c2) = (x-x0,y-y0)
- (a1,a2) = (1,0)
- (b1,b2) = (0,1)
- xformmat = Mat.Matrix a1 a2 b1 b2 c1 c2 -}
invalidateTempBasePage cid (tempSurface tempselection) pnum
(drawTempSelectImage geometry tempselection xformmat)
- -- (translate (x-x0) (y-y0)))
moveSelect cid pnum geometry connidmove connidup orig (ncoord,ntime)
tempselection
upact :: (ViewMode a) => HXournalState -> CanvasInfo a -> PointerCoord -> MainCoroutine ()
- upact xst cinfo pcoord =
+ upact xst cinfo pcoord =
switchActionEnteringDiffPage pnum geometry pcoord (return ())
(chgaction xst cinfo)
(ordaction xst cinfo)
@@ -360,7 +367,7 @@
fsingle r xstate cinfo = penMoveAndUpOnly r pnum geometry defact (moveact xstate cinfo) (upact xstate cinfo)
defact = resizeSelect handle cid pnum geometry connidmove connidup
origbbox (prev,otime) tempselection
- moveact xstate cinfo (x,y) = do
+ moveact _xstate _cinfo (_pcoord,(x,y)) = do
(willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y)
when willUpdate $ do
let newbbox = getNewBBoxFromHandlePos handle origbbox (x,y)
@@ -379,8 +386,10 @@
resizeSelect handle cid pnum geometry connidmove connidup
origbbox (ncoord,ntime) tempselection
upact xstate cinfo pcoord = do
- let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
- (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return
+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
+ (_,(x,y)) = runIdentity $
+ skipIfNotInSamePage pnum geometry pcoord
+ (return (pcoord,prev)) return
newbbox = getNewBBoxFromHandlePos handle origbbox (x,y)
xojstate@(SelectState txoj) = get xournalstate xstate
epage = getCurrentPageEitherFromXojState cinfo xojstate
@@ -528,11 +537,12 @@
where lassoAction cinfo pnum geometry (cidup,cidmove) (x,y) = do
strs <- getAllStrokeBBoxInCurrentLayer
ctime <- liftIO $ getCurrentTime
- let newSelectAction page = do
- tsel <- createTempSelectRender pnum geometry page []
- newSelectLasso cinfo pnum geometry cidmove cidup strs
- (x,y) ((x,y),ctime) (Sq.empty |> (x,y)) tsel
- surfaceFinish (tempSurface tsel)
+ let newSelectAction page =
+ dealWithOneTimeSelectMode $ do
+ tsel <- createTempSelectRender pnum geometry page []
+ newSelectLasso cinfo pnum geometry cidmove cidup strs
+ (x,y) ((x,y),ctime) (Sq.empty |> (x,y)) tsel
+ surfaceFinish (tempSurface tsel)
let action (Right tpage) | hitInSelection tpage (x,y) =
startMoveSelect cid pnum geometry cidmove cidup ((x,y),ctime) tpage
action (Right tpage) | hitInHandle tpage (x,y) =
@@ -551,8 +561,6 @@
let epage = getCurrentPageEitherFromXojState cinfo xojstate
action epage
-
-
-- |
newSelectLasso :: (ViewMode a) => CanvasInfo a
@@ -573,7 +581,7 @@
(moveact cinfo) (upact cinfo)
defact = newSelectLasso cvsInfo pnum geometry cidmove cidup strs orig
(prev,otime) lasso tsel
- moveact cinfo (x,y) = do
+ moveact cinfo (_pcoord,(x,y)) = do
let nlasso = lasso |> (x,y)
(willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y)
when willUpdate $ do
@@ -582,16 +590,17 @@
(ncoord,ntime) nlasso tsel
upact cinfo pcoord = do
xstate <- getSt
- let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
- (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return
+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord
+ (_,(x,y)) = runIdentity $
+ skipIfNotInSamePage pnum geometry pcoord
+ (return (pcoord,prev)) return
nlasso = lasso |> (x,y)
xojstate = get xournalstate xstate
- let epage = getCurrentPageEitherFromXojState cinfo xojstate
+ epage = getCurrentPageEitherFromXojState cinfo xojstate
cpn = get currentPageNum cinfo
- let hittestlasso = mkHitTestAL (hitLassoStroke (nlasso |> orig)) strs
+ hittestlasso = mkHitTestAL (hitLassoStroke (nlasso |> orig)) strs
selectstrs = fmapAL unNotHitted id hittestlasso
- xstate <- getSt
- let SelectState txoj = get xournalstate xstate
+ SelectState txoj = get xournalstate xstate
newpage = case epage of
Left pagebbox ->
let (mcurrlayer,npagebbox) = getCurrentLayerOrSet pagebbox
diff --git a/lib/Application/HXournal/Coroutine/Window.hs b/lib/Application/HXournal/Coroutine/Window.hs
--- a/lib/Application/HXournal/Coroutine/Window.hs
+++ b/lib/Application/HXournal/Coroutine/Window.hs
@@ -15,10 +15,12 @@
module Application.HXournal.Coroutine.Window where
import Application.HXournal.Type.Canvas
+import Application.HXournal.Type.Event
import Application.HXournal.Type.Window
import Application.HXournal.Type.XournalState
import Application.HXournal.Type.Coroutine
import Application.HXournal.Type.PageArrangement
+import Application.HXournal.Type.Predefined
import Application.HXournal.Util
import Control.Monad.Trans
import Application.HXournal.ModelAction.Window
@@ -26,39 +28,74 @@
import Application.HXournal.Coroutine.Page
import Application.HXournal.Coroutine.Draw
import Application.HXournal.Accessor
+import Control.Monad.Coroutine.SuspensionFunctors
import Control.Category
import Data.Label
import Graphics.UI.Gtk hiding (get,set)
-import Graphics.Rendering.Cairo
import qualified Data.IntMap as M
import Data.Maybe
+import Data.Time.Clock
import Data.Xournal.Simple (Dimension(..))
import Data.Xournal.Generic
import Prelude hiding ((.),id)
--- |
+-- | canvas configure with general zoom update func
-canvasConfigure :: CanvasId -> CanvasDimension -> MainCoroutine ()
-canvasConfigure cid cdim@(CanvasDimension (Dim w' h')) = do
- xstate <- getSt
- let cinfobox = getCanvasInfo cid xstate
- xstate' <- selectBoxAction (fsingle xstate) (fcont xstate) cinfobox
- putSt xstate'
- canvasZoomUpdateAll
- where cdim = CanvasDimension (Dim w' h')
- fsingle :: HXournalState -> CanvasInfo SinglePage -> MainCoroutine HXournalState
- fsingle xstate cinfo = do
+canvasConfigureGenUpdate :: MainCoroutine ()
+ -> CanvasId
+ -> CanvasDimension
+ -> MainCoroutine ()
+canvasConfigureGenUpdate updatefunc cid cdim
+ = (updateXState $ selectBoxAction fsingle fcont . getCanvasInfo cid )
+ >> updatefunc
+ -- canvasZoomUpdateAll
+ where -- cdim = CanvasDimension (Dim w' h')
+ fsingle cinfo = do
+ xstate <- getSt
let cinfo' = updateCanvasDimForSingle cdim cinfo
return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate
- fcont xstate cinfo = do
+ fcont cinfo = do
+ xstate <- getSt
page <- getCurrentPageCvsId cid
let pdim = PageDimension (get g_dimension page)
let cinfo' = updateCanvasDimForContSingle pdim cdim cinfo
return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate
+
+-- |
+doCanvasConfigure :: CanvasId
+ -> CanvasDimension
+ -> MainCoroutine ()
+doCanvasConfigure = canvasConfigureGenUpdate canvasZoomUpdateAll
+
+ -- fsingle :: CanvasInfo SinglePage -> MainCoroutine HXournalState
+ {- xstate <- getSt
+ let cinfobox = getCanvasInfo cid xstate -}
+ {- xstate' <- -}
+ -- putSt xstate'
+
+
-- |
+canvasConfigure' :: CanvasId -> CanvasDimension -> MainCoroutine ()
+canvasConfigure' cid cdim = do -- @(CanvasDimension (Dim w' h')) = do
+ xstate <- getSt
+ ctime <- liftIO getCurrentTime
+ maybe defaction (chkaction ctime) (get lastTimeCanvasConfigure xstate)
+ where defaction = do
+ ntime <- liftIO getCurrentTime
+ doCanvasConfigure cid cdim
+ updateXState (return . set lastTimeCanvasConfigure (Just ntime))
+ chkaction ctime otime = do
+ let dtime = diffUTCTime ctime otime
+ if dtime > predefinedWinReconfTimeBound
+ then defaction
+ else return ()
+
+
+-- |
+
eitherSplit :: SplitType -> MainCoroutine ()
eitherSplit stype = do
xstate <- getSt
@@ -84,7 +121,7 @@
putSt xstate3
liftIO $ boxPackEnd rtcntr win PackGrow 0
liftIO $ widgetShowAll rtcntr
- (xstate4,wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)
+ (xstate4,_wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)
xstate5 <- liftIO $ updatePageAll (get xournalstate xstate4) xstate4
putSt xstate5
canvasZoomUpdateAll
@@ -105,7 +142,7 @@
Right Nothing -> return ()
Right (Just fstate') -> do
case maybeError "deleteCanvas" (M.lookup currcid cmap) of
- CanvasInfoBox oldcinfo -> do
+ CanvasInfoBox _oldcinfo -> do
let cmap' = M.delete currcid cmap
newcurrcid = maximum (M.keys cmap')
xstate0 <- changeCurrentCanvasId newcurrcid
@@ -121,9 +158,32 @@
putSt xstate3
liftIO $ boxPackEnd rtcntr win PackGrow 0
liftIO $ widgetShowAll rtcntr
- (xstate4,wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)
+ (xstate4,_wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)
canvasZoomUpdateAll
xstate5 <- liftIO $ updatePageAll (get xournalstate xstate4) xstate4
putSt xstate5
invalidateAll
+-- |
+
+paneMoveStart :: MainCoroutine ()
+paneMoveStart = do
+ ev <- await
+ case ev of
+ UpdateCanvas cid -> invalidateWithBuf cid >> paneMoveStart
+ PaneMoveEnd -> return ()
+ CanvasConfigure cid w' h'->
+ canvasConfigureGenUpdate canvasZoomUpdateBufAll cid (CanvasDimension (Dim w' h'))
+ >> paneMoveStart
+ _ -> paneMoveStart
+
+
+
+-- |
+
+paneMoved :: MainCoroutine ()
+paneMoved = do
+ liftIO $ putStrLn "pane moved called"
+
+
+
diff --git a/lib/Application/HXournal/Device.hsc b/lib/Application/HXournal/Device.hsc
--- a/lib/Application/HXournal/Device.hsc
+++ b/lib/Application/HXournal/Device.hsc
@@ -19,38 +19,49 @@
import Application.HXournal.Config
import Data.Configurator.Types
-
import Control.Applicative
import Control.Monad.Reader
-
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.C
import Foreign.Storable
-
import Graphics.UI.Gtk
-
-
import Data.Int
+-- |
+
data PointerType = Core | Stylus | Eraser
deriving (Show,Eq,Ord)
+-- |
+
+data PenButton = PenButton1 | PenButton2 | PenButton3
+ deriving (Show,Eq,Ord)
+
+-- |
+
data DeviceList = DeviceList { dev_core :: CInt
, dev_stylus :: CInt
, dev_eraser :: CInt }
deriving Show
+-- |
+
data PointerCoord = PointerCoord { pointerType :: PointerType
, pointerX :: Double
- , pointerY :: Double }
+ , pointerY :: Double
+ , pointerZ :: Double
+ }
| NoPointerCoord
deriving (Show,Eq,Ord)
+-- |
foreign import ccall "c_initdevice.h initdevice" c_initdevice
:: Ptr CInt -> Ptr CInt -> Ptr CInt -> CString -> CString -> CString -> IO ()
+-- |
+
initDevice :: Config -> IO DeviceList
initDevice cfg = do
(mcore,mstylus,meraser) <- getPenDevConfig cfg
@@ -75,16 +86,22 @@
eraser_val <- peek peraser
return $ DeviceList core_val stylus_val eraser_val
+-- |
-getPointer :: DeviceList -> EventM t PointerCoord
+getPointer :: DeviceList -> EventM t (Maybe PenButton,PointerCoord)
getPointer devlst = do
ptr <- ask
- (_ty,x,y,mdev,maxf) <- liftIO (getInfo ptr)
+ (_ty,btn,x,y,mdev,maxf) <- liftIO (getInfo ptr)
+ let rbtn | btn == 0 = Nothing
+ | btn == 1 = Just PenButton1
+ | btn == 2 = Just PenButton2
+ | btn == 3 = Just PenButton3
+ | otherwise = Nothing
case mdev of
- Nothing -> return (PointerCoord Core x y)
+ Nothing -> return (rbtn,PointerCoord Core x y 1.0)
Just dev -> case maxf of
- Nothing -> return (PointerCoord Core x y)
- Just axf -> liftIO $ coord ptr x y dev axf
+ Nothing -> return (rbtn,PointerCoord Core x y 1.0)
+ Just axf -> (,) rbtn <$> (liftIO $ coord ptr x y dev axf)
where
getInfo ptr = do
(ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr)
@@ -95,44 +112,49 @@
then do
(x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, x} ptr
(y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, y} ptr
+ (btn :: #{gtk2hs_type gint}) <- #{peek GdkEventButton, button} ptr
(dev :: CInt) <- #{peek GdkEventButton, device} ptr
let axisfunc = #{peek GdkEventButton, axes}
- return (ty,realToFrac x,realToFrac y,Just dev,Just axisfunc)
+ return (ty,btn,realToFrac x,realToFrac y,Just dev,Just axisfunc)
else if ty `elem` [ #{const GDK_SCROLL} ]
then do
(x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, x} ptr
(y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, y} ptr
(dev :: CInt) <- #{peek GdkEventScroll, device} ptr
- return (ty,realToFrac x, realToFrac y,Just dev,Nothing)
+ return (ty,0,realToFrac x, realToFrac y,Just dev,Nothing)
else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ]
then do
(x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, x} ptr
(y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, y} ptr
(dev :: CInt) <- #{peek GdkEventMotion, device} ptr
let axisfunc = #{peek GdkEventMotion, axes}
- return (ty,realToFrac x, realToFrac y,Just dev,Just axisfunc)
+ return (ty,0,realToFrac x, realToFrac y,Just dev,Just axisfunc)
else if ty `elem` [ #{const GDK_ENTER_NOTIFY},
#{const GDK_LEAVE_NOTIFY}]
then do
(x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, x} ptr
(y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, y} ptr
- return (ty, realToFrac x, realToFrac y,Nothing,Nothing)
+ return (ty,0,realToFrac x, realToFrac y,Nothing,Nothing)
else error ("eventCoordinates: none for event type "++show ty)
coord ptr x y device axf
- | device == dev_core devlst = return $ PointerCoord Core x y
+ | device == dev_core devlst = return $ PointerCoord Core x y 1.0
| device == dev_stylus devlst = do
(ptrax :: Ptr CDouble ) <- axf ptr
(wacomx :: Double) <- peekByteOff ptrax 0
(wacomy :: Double) <- peekByteOff ptrax 8
- return $ PointerCoord Stylus wacomx wacomy
+ (wacomz :: Double) <- peekByteOff ptrax 16
+ return $ PointerCoord Stylus wacomx wacomy wacomz
| device == dev_eraser devlst = do
(ptrax :: Ptr CDouble ) <- axf ptr
(wacomx :: Double) <- peekByteOff ptrax 0
(wacomy :: Double) <- peekByteOff ptrax 8
- return $ PointerCoord Eraser wacomx wacomy
- | otherwise = return $ PointerCoord Core x y
+ (wacomz :: Double) <- peekByteOff ptrax 16
+ return $ PointerCoord Eraser wacomx wacomy wacomz
+ | otherwise = return $ PointerCoord Core x y 1.0
+-- |
+
wacomCoordConvert :: WidgetClass self => self
-> (Double,Double)
-> IO (Double,Double)
@@ -142,6 +164,8 @@
screen <- widgetGetScreen canvas
(ws,hs) <- (,) <$> screenGetWidth screen <*> screenGetHeight screen
return (fromIntegral ws*x-fromIntegral x0,fromIntegral hs*y-fromIntegral y0)
+
+-- |
wacomPConvert :: WidgetClass self => self
-> PointerCoord
diff --git a/lib/Application/HXournal/GUI.hs b/lib/Application/HXournal/GUI.hs
--- a/lib/Application/HXournal/GUI.hs
+++ b/lib/Application/HXournal/GUI.hs
@@ -10,6 +10,7 @@
-- Stability : experimental
-- Portability : GHC
--
+-----------------------------------------------------------------------------
module Application.HXournal.GUI where
@@ -26,21 +27,16 @@
import Application.HXournal.Coroutine
-- import Application.HXournal.GUI.Menu
import Application.HXournal.ModelAction.File
-import Application.HXournal.ModelAction.Page
import Application.HXournal.ModelAction.Window
-
import Graphics.UI.Gtk hiding (get,set)
-
-import Control.Applicative
import Control.Monad.Trans
-
import Data.IORef
import Data.Maybe
-
import Control.Category
import Data.Label
import Prelude hiding ((.),id)
+-- |
startGUI :: Maybe FilePath -> IO ()
startGUI mfname = do
diff --git a/lib/Application/HXournal/GUI/Menu.hs b/lib/Application/HXournal/GUI/Menu.hs
--- a/lib/Application/HXournal/GUI/Menu.hs
+++ b/lib/Application/HXournal/GUI/Menu.hs
@@ -10,6 +10,7 @@
-- Stability : experimental
-- Portability : GHC
--
+-----------------------------------------------------------------------------
module Application.HXournal.GUI.Menu where
@@ -157,7 +158,8 @@
-
+
+
@@ -292,7 +294,8 @@
, RadioActionEntry "PENFINEA" "Fine" (Just "mythin") Nothing Nothing 1
, RadioActionEntry "PENTHICKA" "Thick" (Just "mythick") Nothing Nothing 3
- , RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4
+ , RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4
+ , RadioActionEntry "PENULTRATHICKA" "Ultra Thick" Nothing Nothing Nothing 5
, RadioActionEntry "PENMEDIUMA" "Medium" (Just "mymedium") Nothing Nothing 2
]
@@ -455,7 +458,14 @@
-- AndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput)
dcrdcorea <- actionNewAndRegister "DCRDCOREA" "Discard Core Events" (Just "Just a Stub") Nothing (justMenu MenuDiscardCoreEvents)
ersrtipa <- actionNewAndRegister "ERSRTIPA" "Eraser Tip" (Just "Just a Stub") Nothing (justMenu MenuEraserTip)
- pressrsensa <- actionNewAndRegister "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing (justMenu MenuPressureSensitivity)
+ pressrsensa <- toggleActionNew "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing
+ pressrsensa `on` actionToggled $ do
+ bouncecallback tref sref (Menu MenuPressureSensitivity)
+-- AndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput)
+
+
+
+
pghilta <- actionNewAndRegister "PGHILTA" "Page Highlight" (Just "Just a Stub") Nothing (justMenu MenuPageHighlight)
mltpgvwa <- actionNewAndRegister "MLTPGVWA" "Multiple Page View" (Just "Just a Stub") Nothing (justMenu MenuMultiplePageView)
mltpga <- actionNewAndRegister "MLTPGA" "Multiple Pages" (Just "Just a Stub") Nothing (justMenu MenuMultiplePages)
@@ -489,7 +499,7 @@
, shpreca, rulera, clra, penopta
, erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta
, setdefopta
- , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa
+ , dcrdcorea, ersrtipa, pghilta, mltpgvwa
, mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea
, lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa
, abouta
@@ -497,6 +507,8 @@
]
actionGroupAddAction agr uxinputa
+ actionGroupAddAction agr pressrsensa
+
-- actionGroupAddRadioActions agr viewmods 0 (assignViewMode tref sref)
actionGroupAddRadioActions agr viewmods 0 (const (return ()))
@@ -515,7 +527,7 @@
, shpreca, rulera
, erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta
, setdefopta
- , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa
+ , dcrdcorea, ersrtipa, pghilta, mltpgvwa
, mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea
, lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa
, abouta
@@ -633,21 +645,25 @@
int2Point PenWork 2 = predefined_medium
int2Point PenWork 3 = predefined_thick
int2Point PenWork 4 = predefined_verythick
+int2Point PenWork 5 = predefined_ultrathick
int2Point HighlighterWork 0 = predefined_highlighter_veryfine
int2Point HighlighterWork 1 = predefined_highlighter_fine
int2Point HighlighterWork 2 = predefined_highlighter_medium
int2Point HighlighterWork 3 = predefined_highlighter_thick
int2Point HighlighterWork 4 = predefined_highlighter_verythick
+int2Point HighlighterWork 5 = predefined_highlighter_ultrathick
int2Point EraserWork 0 = predefined_eraser_veryfine
int2Point EraserWork 1 = predefined_eraser_fine
int2Point EraserWork 2 = predefined_eraser_medium
int2Point EraserWork 3 = predefined_eraser_thick
int2Point EraserWork 4 = predefined_eraser_verythick
+int2Point EraserWork 5 = predefined_eraser_ultrathick
int2Point TextWork 0 = predefined_veryfine
int2Point TextWork 1 = predefined_fine
int2Point TextWork 2 = predefined_medium
int2Point TextWork 3 = predefined_thick
int2Point TextWork 4 = predefined_verythick
+int2Point TextWork 5 = predefined_ultrathick
int2Point _ _ = error "No such point"
int2Color :: Int -> PenColor
diff --git a/lib/Application/HXournal/ModelAction/Eraser.hs b/lib/Application/HXournal/ModelAction/Eraser.hs
--- a/lib/Application/HXournal/ModelAction/Eraser.hs
+++ b/lib/Application/HXournal/ModelAction/Eraser.hs
@@ -1,4 +1,3 @@
-
-----------------------------------------------------------------------------
-- |
-- Module : Application.HXournal.ModelAction.Eraser
@@ -9,10 +8,11 @@
-- Stability : experimental
-- Portability : GHC
--
+-----------------------------------------------------------------------------
+
module Application.HXournal.ModelAction.Eraser where
import Control.Monad.State
-
import Data.Xournal.BBox
import Graphics.Xournal.Render.Type
import Graphics.Xournal.Render.HitTest
diff --git a/lib/Application/HXournal/ModelAction/File.hs b/lib/Application/HXournal/ModelAction/File.hs
--- a/lib/Application/HXournal/ModelAction/File.hs
+++ b/lib/Application/HXournal/ModelAction/File.hs
@@ -15,28 +15,16 @@
module Application.HXournal.ModelAction.File where
import Application.HXournal.Type.XournalState
-import Application.HXournal.Type.Canvas
-import Application.HXournal.ModelAction.Page
-import Application.HXournal.Type.PageArrangement
-import Application.HXournal.Util
-import Data.Xournal.BBox
-import qualified Text.Xournal.Parse as P
-import qualified Data.IntMap as M
+import qualified Text.Xournal.Parse.Enumerator as PE
import Data.Maybe
-
import Control.Monad
import Control.Category
import Data.Label
import Prelude hiding ((.),id)
-
import Data.Xournal.Simple
-import Data.Xournal.Generic
-
import Graphics.Xournal.Render.BBoxMapPDF
import Graphics.Xournal.Render.PDFBackground
-
import Graphics.UI.Gtk hiding (get,set)
-
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
@@ -51,9 +39,14 @@
-> HXournalState
-> IO HXournalState
getFileContent (Just fname) xstate = do
- xojcontent <- P.read_xournal fname
- nxstate <- constructNewHXournalStateFromXournal xojcontent xstate
- return $ set currFileName (Just fname) nxstate
+ -- xojcontent <- P.read_xournal fname
+ PE.parseXojFile fname >>= \x -> case x of
+ Left str -> do
+ putStrLn $ "file reading error : " ++ str
+ return xstate
+ Right xojcontent -> do
+ nxstate <- constructNewHXournalStateFromXournal xojcontent xstate
+ return $ set currFileName (Just fname) nxstate
getFileContent Nothing xstate = do
newxoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF
$ defaultXournal
@@ -61,30 +54,30 @@
xstate' = set currFileName Nothing
. set xournalstate newxojstate
$ xstate
+ return xstate'
+
-- let dim = get g_dimension . maybeError "getFileContent" . M.lookup 0 . get g_pages
-- $ newxoj
-- let cvschange = setPage xstate' 0
-- modifyCurrCvsInfoM cvschange xstate'
- return xstate'
-- |
constructNewHXournalStateFromXournal :: Xournal -> HXournalState -> IO HXournalState
constructNewHXournalStateFromXournal xoj' xstate = do
xoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF $ xoj'
- let dim = get g_dimension . maybeError "constructNewHxournalStateFromXournal" . M.lookup 0
- . get g_pages $ xoj
- startingxojstate = ViewAppendState xoj
- -- forSingle = set (pageDimension.pageArrangement.viewInfo) (PageDimension dim)
- -- . set currentPageNum 0
-
+ let startingxojstate = ViewAppendState xoj
return $ set xournalstate startingxojstate xstate
--- cvschange = setPage xstate' 0
--- modifyCurrCvsInfoM cvschange xstate'
-
- -- rentCanvasInfo (selectBox forSingle (error "construct..."))
- -- return $ setPage xstate' 0 xstate'
+
+ -- dim = get g_dimension . maybeError "constructNewHxournalStateFromXournal" . M.lookup 0
+ -- . get g_pages $ xoj
+ -- forSingle = set (pageDimension.pageArrangement.viewInfo) (PageDimension dim)
+ -- . set currentPageNum 0
+ -- cvschange = setPage xstate' 0
+ -- modifyCurrCvsInfoM cvschange xstate'
+ -- rentCanvasInfo (selectBox forSingle (error "construct..."))
+ -- return $ setPage xstate' 0 xstate'
-- |
diff --git a/lib/Application/HXournal/ModelAction/Page.hs b/lib/Application/HXournal/ModelAction/Page.hs
--- a/lib/Application/HXournal/ModelAction/Page.hs
+++ b/lib/Application/HXournal/ModelAction/Page.hs
@@ -23,7 +23,7 @@
import Control.Applicative
import Control.Monad (liftM)
-import Data.Xournal.BBox (moveBBoxToOrigin)
+-- import Data.Xournal.BBox (moveBBoxToOrigin)
import Data.Xournal.Simple (Dimension(..))
import Data.Xournal.Generic
import Data.Xournal.Select
@@ -131,8 +131,8 @@
let ulcoord = maybeError "updateCvsFromXoj" $
desktop2Page geometry (DeskCoord (xdesk,ydesk))
let cdim = canvasDim geometry
- pg = getPageFromGXournalMap pagenum xoj
- pdim = PageDimension $ get g_dimension pg
+ -- pg = getPageFromGXournalMap pagenum xoj
+ -- pdim = PageDimension $ get g_dimension pg
let arr = makeContinuousSingleArrangement zmode cdim xoj ulcoord
ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr
adjustmentSetUpper hadj w
@@ -154,19 +154,10 @@
updatePage :: XournalState -> CanvasInfoBox -> IO CanvasInfoBox
updatePage (ViewAppendState xojbbox) cinfobox = updateCvsInfoFrmXoj xojbbox cinfobox
updatePage (SelectState txoj) cinfobox = selectBoxAction fsingle fcont cinfobox
- where getselectedpage :: CanvasInfo a -> Either (Page EditMode) (Page SelectMode)
- getselectedpage cinfo =
- let pagenum = get currentPageNum cinfo
- pgs = get g_selectAll txoj
- pg = maybeError "??" (M.lookup pagenum pgs)
- spg = case get g_selectSelected txoj of
- Nothing -> Left pg
- Just (spnum,tpg) -> if spnum == pagenum then Right tpg else Left pg
- in spg
- fsingle cinfo = do
+ where fsingle _cinfo = do
let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj)
updateCvsInfoFrmXoj xoj cinfobox
- fcont cinfo = do
+ fcont _cinfo = do
let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj)
updateCvsInfoFrmXoj xoj cinfobox
@@ -174,6 +165,17 @@
{-
+-- getselectedpage :: CanvasInfo a -> Either (Page EditMode) (Page SelectMode)
+ -- getselectedpage cinfo =
+ -- let pagenum = get currentPageNum cinfo
+ -- pgs = get g_selectAll txoj
+ -- pg = maybeError "??" (M.lookup pagenum pgs)
+ -- spg = case get g_selectSelected txoj of
+ -- Nothing -> Left pg
+ -- Just (spnum,tpg) -> if spnum == pagenum then Right tpg else Left pg
+ -- in spg
+
+
let pagenum = unboxGet currentPageNum cinfobox
mspage = get g_selectSelected txoj
@@ -229,7 +231,7 @@
let xoj = getXournal xstate
geometry <- getCvsGeomFrmCvsInfo cinfo
let cdim = canvasDim geometry
- let pg = getPageFromGXournalMap (unPageNum pnum) xoj
+ let -- pg = getPageFromGXournalMap (unPageNum pnum) xoj
zmode = get (zoomMode.viewInfo) cinfo
arr = makeContinuousSingleArrangement zmode cdim xoj (pnum,PageCoord (0,0))
return $ set currentPageNum (unPageNum pnum)
@@ -252,7 +254,7 @@
newPageBeforeAction xoj (_cid,cinfo) = do
let cpn = get currentPageNum cinfo
let pagelst = M.elems . get g_pages $ xoj
- pagekeylst = M.keys . get g_pages $ xoj
+ -- pagekeylst = M.keys . get g_pages $ xoj
(pagesbefore,pagesafter) = splitAt cpn pagelst
npage = newSinglePageFromOld (head pagesafter)
npagelst = pagesbefore ++ (npage : pagesafter)
diff --git a/lib/Application/HXournal/ModelAction/Pen.hs b/lib/Application/HXournal/ModelAction/Pen.hs
--- a/lib/Application/HXournal/ModelAction/Pen.hs
+++ b/lib/Application/HXournal/ModelAction/Pen.hs
@@ -33,12 +33,13 @@
import Data.Xournal.Generic
import Data.Xournal.BBox
import Graphics.Xournal.Render.BBoxMapPDF
-import Application.HXournal.View.Coordinate
+-- |
+
addPDraw :: PenInfo
-> TXournalBBoxMapPDFBuf
-> PageNum
- -> Seq (Double,Double)
+ -> Seq (Double,Double,Double)
-> IO (TXournalBBoxMapPDFBuf,BBox)
-- ^ new xournal and bbox in page coordinate
addPDraw pinfo xoj (PageNum pgnum) pdraw = do
@@ -46,16 +47,25 @@
pcolor = get (penColor.currentTool) pinfo
pcolname = fromJust (M.lookup pcolor penColorNameMap)
pwidth = get (penWidth.currentTool) pinfo
+ pvwpen = get variableWidthPen pinfo
(mcurrlayer,currpage) = getCurrentLayerOrSet (getPageFromGXournalMap pgnum xoj)
currlayer = maybe (error "something wrong in addPDraw") id mcurrlayer
- newstroke = Stroke { stroke_tool = case ptype of
- PenWork -> "pen"
- HighlighterWork -> "highlighter"
- _ -> error "error in addPDraw"
- , stroke_color = pcolname
- , stroke_width = pwidth
- , stroke_data = map (uncurry (:!:)) . toList $ pdraw
- }
+ ptool = case ptype of
+ PenWork -> "pen"
+ HighlighterWork -> "highlighter"
+ _ -> error "error in addPDraw"
+ newstroke =
+ case pvwpen of
+ False -> Stroke { stroke_tool = ptool
+ , stroke_color = pcolname
+ , stroke_width = pwidth
+ , stroke_data = map (\(x,y,_)->x:!:y) . toList $ pdraw
+ }
+ True -> VWStroke { stroke_tool = ptool
+ , stroke_color = pcolname
+ , stroke_vwdata = map (\(x,y,z)->(x,y,pwidth*z)) . toList $ pdraw
+ }
+
newstrokebbox = mkStrokeBBoxFromStroke newstroke
bbox = strokebbox_bbox newstrokebbox
newlayerbbox <- updateLayerBuf (Just bbox)
diff --git a/lib/Application/HXournal/ModelAction/Select.hs b/lib/Application/HXournal/ModelAction/Select.hs
--- a/lib/Application/HXournal/ModelAction/Select.hs
+++ b/lib/Application/HXournal/ModelAction/Select.hs
@@ -13,10 +13,9 @@
module Application.HXournal.ModelAction.Select where
import Application.HXournal.Type.Enum
-import Application.HXournal.Type.Canvas
import Application.HXournal.Type.Alias
+import Application.HXournal.Type.Predefined
import Application.HXournal.Type.PageArrangement
-import Application.HXournal.View.Draw
import Application.HXournal.View.Coordinate
import Application.HXournal.Util
import Application.HXournal.ModelAction.Layer
@@ -25,14 +24,14 @@
import Data.Monoid
import Data.Xournal.Generic
import Data.Xournal.BBox
-import Data.Xournal.Simple (Dimension(..))
+import Data.Xournal.Simple hiding (Page,Xournal)
import Graphics.Xournal.Render.Type
import Graphics.Xournal.Render.BBox
import Graphics.Xournal.Render.BBoxMapPDF
import Graphics.Xournal.Render.HitTest
import Graphics.Xournal.Render.Simple
import Graphics.Rendering.Cairo
-import Graphics.Rendering.Cairo.Matrix (Matrix, invert, transformPoint )
+import Graphics.Rendering.Cairo.Matrix ( invert, transformPoint )
import Graphics.UI.Gtk hiding (get,set)
import Data.Time.Clock
import Control.Monad
@@ -81,13 +80,23 @@
-- | modify stroke using a function
changeStrokeBy :: ((Double,Double)->(Double,Double)) -> StrokeBBox -> StrokeBBox
-changeStrokeBy func (StrokeBBox t c w ds _bbox) =
+changeStrokeBy func (StrokeBBox (Stroke t c w ds) _bbox) =
let change ( x :!: y ) = let (nx,ny) = func (x,y)
in nx :!: ny
newds = map change ds
- newbbox = mkbbox newds
- in StrokeBBox t c w newds newbbox
+ nstrk = Stroke t c w newds
+ newbbox = bboxFromStroke nstrk
+ in StrokeBBox nstrk newbbox
+changeStrokeBy func (StrokeBBox (VWStroke t c ds) _bbox) =
+ let change (x,y,z) = let (nx,ny) = func (x,y)
+ in (nx,ny,z)
+ newds = map change ds
+ nstrk = VWStroke t c newds
+ newbbox = bboxFromStroke nstrk
+ in StrokeBBox nstrk newbbox
+
+
getActiveLayer :: Page SelectMode -> Either [StrokeBBox] (TAlterHitted StrokeBBox)
getActiveLayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . get g_layers
@@ -240,11 +249,17 @@
changeStrokeColor :: PenColor -> StrokeBBox -> StrokeBBox
changeStrokeColor pcolor str =
let Just cname = Map.lookup pcolor penColorNameMap
- in str { strokebbox_color = cname }
+ strsmpl = strokebbox_stroke str
+ in str { strokebbox_stroke = set s_color cname strsmpl }
changeStrokeWidth :: Double -> StrokeBBox -> StrokeBBox
-changeStrokeWidth pwidth str = str { strokebbox_width = pwidth }
+changeStrokeWidth pwidth str =
+ let nstrsmpl = case strokebbox_stroke str of
+ Stroke t c _w d -> Stroke t c pwidth d
+ VWStroke t c d -> Stroke t c pwidth (map (\(x,y,_z) -> (x:!:y)) d)
+ in str { strokebbox_stroke = nstrsmpl }
+-- str { strokebbox_width = pwidth }
newtype CmpStrokeBBox = CmpStrokeBBox { unCmpStrokeBBox :: StrokeBBox }
deriving Show
@@ -329,7 +344,7 @@
hitLassoPoint lst = odd . mappingDegree lst
hitLassoStroke :: Seq (Double,Double) -> StrokeBBox -> Bool
-hitLassoStroke lst strk = all (\(x :!: y)-> hitLassoPoint lst (x,y)) $ strokebbox_data strk
+hitLassoStroke lst = all (hitLassoPoint lst) . getXYtuples . strokebbox_stroke
data TempSelectRender a = TempSelectRender { tempSurface :: Surface
@@ -347,10 +362,10 @@
-- |
mkStrokesNImage :: CanvasGeometry -> Page SelectMode -> IO StrokesNImage
-mkStrokesNImage geometry tpage = do
+mkStrokesNImage _geometry tpage = do
let strs = getSelectedStrokes tpage
drawselection = mapM_ (drawOneStroke.gToStroke) strs
- Dim cw ch = get g_dimension tpage -- unCanvasDimension . canvasDim $ geometry
+ Dim cw ch = get g_dimension tpage
mbbox = case getULBBoxFromSelected tpage of
Middle bbox -> Just bbox
_ -> Nothing
@@ -407,9 +422,8 @@
fill
renderfunc
-dtime_bound :: NominalDiffTime
-dtime_bound = realToFrac (picosecondsToDiffTime 100000000000)
-
+-- |
+
getNewCoordTime :: ((Double,Double),UTCTime)
-> (Double,Double)
-> IO (Bool,((Double,Double),UTCTime))
diff --git a/lib/Application/HXournal/ModelAction/Window.hs b/lib/Application/HXournal/ModelAction/Window.hs
--- a/lib/Application/HXournal/ModelAction/Window.hs
+++ b/lib/Application/HXournal/ModelAction/Window.hs
@@ -57,7 +57,7 @@
-- | only creating windows
minimalCanvasInfo :: ViewMode a => HXournalState -> CanvasId -> IO (CanvasInfo a)
-minimalCanvasInfo xstate cid = do
+minimalCanvasInfo _xstate cid = do
canvas <- drawingAreaNew
scrwin <- scrolledWindowNew Nothing Nothing
containerAdd scrwin canvas
@@ -82,19 +82,20 @@
hadj = _horizAdjustment cinfo
vadj = _vertAdjustment cinfo
- sizereq <- canvas `on` sizeRequest $ return (Requisition 800 400)
+ _sizereq <- canvas `on` sizeRequest $ return (Requisition 800 400)
- bpevent <- canvas `on` buttonPressEvent $ tryEvent $ do
- p <- getPointer dev
- liftIO (callback (PenDown cid p))
- confevent <- canvas `on` configureEvent $ tryEvent $ do
+ _bpevent <- canvas `on` buttonPressEvent $ tryEvent $ do
+ (mbtn,p) <- getPointer dev
+ let pbtn = maybe PenButton1 id mbtn
+ liftIO (callback (PenDown cid pbtn p))
+ _confevent <- canvas `on` configureEvent $ tryEvent $ do
(w,h) <- eventSize
liftIO $ callback
(CanvasConfigure cid (fromIntegral w) (fromIntegral h))
- brevent <- canvas `on` buttonReleaseEvent $ tryEvent $ do
- p <- getPointer dev
+ _brevent <- canvas `on` buttonReleaseEvent $ tryEvent $ do
+ (_,p) <- getPointer dev
liftIO (callback (PenUp cid p))
- exposeev <- canvas `on` exposeEvent $ tryEvent $ do
+ _exposeev <- canvas `on` exposeEvent $ tryEvent $ do
liftIO $ callback (UpdateCanvas cid)
{-
@@ -125,11 +126,11 @@
v <- adjustmentGetValue vadj
callback (VScrollBarMoved cid v)
Just vscrbar <- scrolledWindowGetVScrollbar scrwin
- bpevtvscrbar <- vscrbar `on` buttonPressEvent $ do
+ _bpevtvscrbar <- vscrbar `on` buttonPressEvent $ do
v <- liftIO $ adjustmentGetValue vadj
liftIO (callback (VScrollBarStart cid v))
return False
- brevtvscrbar <- vscrbar `on` buttonReleaseEvent $ do
+ _brevtvscrbar <- vscrbar `on` buttonReleaseEvent $ do
v <- liftIO $ adjustmentGetValue vadj
liftIO (callback (VScrollBarEnd cid v))
return False
@@ -197,7 +198,7 @@
-> IO (HXournalState,Widget,WindowConfig)
constructFrame' template oxstate (Node cid) = do
let ocmap = getCanvasInfoMap oxstate
- (cinfobox,cmap,xstate) <- case M.lookup cid ocmap of
+ (cinfobox,_cmap,xstate) <- case M.lookup cid ocmap of
Just cinfobox' -> return (cinfobox',ocmap,oxstate)
Nothing -> do
let cinfobox' = setCanvasId cid template
@@ -212,7 +213,14 @@
constructFrame' template xstate (HSplit wconf1 wconf2) = do
(xstate',win1,wconf1') <- constructFrame' template xstate wconf1
(xstate'',win2,wconf2') <- constructFrame' template xstate' wconf2
+ let callback = get callBack xstate''
hpane' <- hPanedNew
+ hpane' `on` buttonPressEvent $ do
+ liftIO (callback PaneMoveStart)
+ return False
+ hpane' `on` buttonReleaseEvent $ do
+ liftIO (callback PaneMoveEnd)
+ return False
panedPack1 hpane' win1 True False
panedPack2 hpane' win2 True False
widgetShowAll hpane'
@@ -220,7 +228,14 @@
constructFrame' template xstate (VSplit wconf1 wconf2) = do
(xstate',win1,wconf1') <- constructFrame' template xstate wconf1
(xstate'',win2,wconf2') <- constructFrame' template xstate' wconf2
+ let callback = get callBack xstate''
vpane' <- vPanedNew
+ vpane' `on` buttonPressEvent $ do
+ liftIO (callback PaneMoveStart)
+ return False
+ vpane' `on` buttonReleaseEvent $ do
+ liftIO (callback PaneMoveEnd)
+ return False
panedPack1 vpane' win1 True False
panedPack2 vpane' win2 True False
widgetShowAll vpane'
diff --git a/lib/Application/HXournal/Type/Canvas.hs b/lib/Application/HXournal/Type/Canvas.hs
--- a/lib/Application/HXournal/Type/Canvas.hs
+++ b/lib/Application/HXournal/Type/Canvas.hs
@@ -58,6 +58,7 @@
, currText
, penType
, penSet
+, variableWidthPen
-- * for box
, getDrawAreaFromBox
, unboxGet
@@ -74,37 +75,39 @@
) where
import Application.HXournal.Type.Enum
-import Application.HXournal.Type.Alias
import Data.Sequence
import qualified Data.IntMap as M
import Control.Applicative ((<*>),(<$>))
import Control.Category
import Data.Label
import Prelude hiding ((.), id)
-
import Graphics.UI.Gtk hiding (get,set)
import Data.Xournal.Simple (Dimension(..))
import Data.Xournal.BBox
-import Data.Xournal.Generic
import Data.Xournal.Predefined
import Application.HXournal.Type.PageArrangement
-
import Control.Monad.Identity (Identity(..))
type CanvasId = Int
+-- |
+
data PenDraw = PenDraw { _points :: Seq (Double,Double) }
deriving (Show)
-emptyPenDraw :: PenDraw
-emptyPenDraw = PenDraw empty
-
+-- |
data ViewInfo a = (ViewMode a) =>
ViewInfo { _zoomMode :: ZoomMode
, _pageArrangement :: PageArrangement a }
+-- |
+
+emptyPenDraw :: PenDraw
+emptyPenDraw = PenDraw empty
+
+
-- | default view info with single page mode
defaultViewInfoSinglePage :: ViewInfo SinglePage
@@ -284,7 +287,9 @@
-- |
data PenInfo = PenInfo { _penType :: PenType
- , _penSet :: PenHighlighterEraserSet }
+ , _penSet :: PenHighlighterEraserSet
+ , _variableWidthPen :: Bool
+ }
deriving (Show)
-- |
@@ -333,6 +338,7 @@
, _currHighlighter = defaultHighligherWCS
, _currEraser = defaultEraserWCS
, _currText = defaultTextWCS }
+ , _variableWidthPen = False
}
$(mkLabels [''PenDraw, ''ViewInfo, ''PenInfo, ''PenHighlighterEraserSet, ''WidthColorStyle ])
@@ -351,7 +357,7 @@
-> CanvasInfo SinglePage
updateCanvasDimForSingle cdim@(CanvasDimension (Dim w' h')) cinfo =
let zmode = get (zoomMode.viewInfo) cinfo
- arr@(SingleArrangement _ pdim vbbox@(ViewPortBBox bbox))
+ SingleArrangement _ pdim (ViewPortBBox bbox)
= get (pageArrangement.viewInfo) cinfo
(x,y) = bbox_upperleft bbox
(sinvx,sinvy) = getRatioPageCanvas zmode pdim cdim
@@ -367,7 +373,7 @@
-> CanvasInfo ContinuousSinglePage
updateCanvasDimForContSingle pdim cdim@(CanvasDimension (Dim w' h')) cinfo =
let zmode = get (zoomMode.viewInfo) cinfo
- arr@(ContinuousSingleArrangement _ ddim func vbbox@(ViewPortBBox bbox))
+ ContinuousSingleArrangement _ ddim func (ViewPortBBox bbox)
= get (pageArrangement.viewInfo) cinfo
(x,y) = bbox_upperleft bbox
-- dim = get g_dimension . getPage $ cinfo
diff --git a/lib/Application/HXournal/Type/Event.hs b/lib/Application/HXournal/Type/Event.hs
--- a/lib/Application/HXournal/Type/Event.hs
+++ b/lib/Application/HXournal/Type/Event.hs
@@ -16,10 +16,11 @@
import Application.HXournal.Device
import Graphics.UI.Gtk
+
data MyEvent = Initialized
| CanvasConfigure Int Double Double
| UpdateCanvas Int
- | PenDown Int PointerCoord
+ | PenDown Int PenButton PointerCoord
| PenMove Int PointerCoord
| PenUp Int PointerCoord
| PenColorChanged PenColor
@@ -28,6 +29,8 @@
| VScrollBarMoved Int Double
| VScrollBarStart Int Double
| VScrollBarEnd Int Double
+ | PaneMoveStart
+ | PaneMoveEnd
| ToViewAppendMode
| ToSelectMode
| ToSinglePage
diff --git a/lib/Application/HXournal/Type/PageArrangement.hs b/lib/Application/HXournal/Type/PageArrangement.hs
--- a/lib/Application/HXournal/Type/PageArrangement.hs
+++ b/lib/Application/HXournal/Type/PageArrangement.hs
@@ -125,7 +125,7 @@
makeContinuousSingleArrangement zmode cdim@(CanvasDimension (Dim cw ch))
xoj (pnum,PageCoord (xpos,ypos)) =
let PageOrigin (_,y0) = maybeError "makeContSingleArr" $ pageArrFuncContSingle xoj pnum
- dim@(Dim pw ph) = get g_dimension . head . gToList . get g_pages $ xoj
+ dim = get g_dimension . head . gToList . get g_pages $ xoj
(sinvx,sinvy) = getRatioPageCanvas zmode (PageDimension dim) cdim
vport = ViewPortBBox (BBox (xpos,ypos+y0) (xpos+cw/sinvx,ypos+y0+ch/sinvy))
in ContinuousSingleArrangement cdim (deskDimContSingle xoj) (pageArrFuncContSingle xoj) vport
@@ -133,7 +133,7 @@
-- |
pageArrFuncContSingle :: Xournal EditMode -> PageNum -> Maybe PageOrigin
-pageArrFuncContSingle xoj pnum@(PageNum n)
+pageArrFuncContSingle xoj (PageNum n)
| n < 0 = Nothing
| n >= len = Nothing
| otherwise = Just (PageOrigin (0,ys !! n))
diff --git a/lib/Application/HXournal/Type/Predefined.hs b/lib/Application/HXournal/Type/Predefined.hs
--- a/lib/Application/HXournal/Type/Predefined.hs
+++ b/lib/Application/HXournal/Type/Predefined.hs
@@ -12,6 +12,16 @@
module Application.HXournal.Type.Predefined where
+import Data.Time.Clock
+
+
+
+dtime_bound :: NominalDiffTime
+dtime_bound = realToFrac (picosecondsToDiffTime 100000000000)
+
+predefinedWinReconfTimeBound :: NominalDiffTime
+predefinedWinReconfTimeBound = realToFrac (picosecondsToDiffTime 50000000000)
+
predefinedLassoColor :: (Double,Double,Double,Double)
predefinedLassoColor = (1.0,116.0/255.0,0,0.8)
diff --git a/lib/Application/HXournal/Type/Window.hs b/lib/Application/HXournal/Type/Window.hs
--- a/lib/Application/HXournal/Type/Window.hs
+++ b/lib/Application/HXournal/Type/Window.hs
@@ -14,7 +14,7 @@
import Application.HXournal.Type.Canvas
-import Graphics.UI.Gtk hiding (get,set)
+-- |
data WindowConfig = Node CanvasId
| HSplit WindowConfig WindowConfig
diff --git a/lib/Application/HXournal/Type/XournalState.hs b/lib/Application/HXournal/Type/XournalState.hs
--- a/lib/Application/HXournal/Type/XournalState.hs
+++ b/lib/Application/HXournal/Type/XournalState.hs
@@ -16,6 +16,7 @@
( XournalStateIO
, XournalState(..)
, HXournalState(..)
+, IsOneTimeSelectMode(..)
-- | labels
, xournalstate
, currFileName
@@ -35,7 +36,9 @@
, isSaved
, undoTable
, isEventBlocked
+, isOneTimeSelectMode
, pageModeSignal
+, lastTimeCanvasConfigure
-- | others
, emptyHXournalState
, getXournal
@@ -75,8 +78,8 @@
import Control.Monad.State hiding (get,modify)
import Graphics.UI.Gtk hiding (Clipboard, get,set)
import Data.Maybe
+import Data.Time.Clock
import Data.Label
-import qualified Data.Label.Maybe as ML
import Data.Xournal.Generic
import qualified Data.IntMap as M
@@ -88,6 +91,10 @@
data XournalState = ViewAppendState { unView :: TXournalBBoxMapPDFBuf }
| SelectState { tempSelect :: TTempXournalSelectPDFBuf }
+data IsOneTimeSelectMode = NoOneTimeSelectMode
+ | YesBeforeSelect
+ | YesAfterSelect
+ deriving (Show,Eq,Ord)
data HXournalState =
HXournalState { _xournalstate :: XournalState
@@ -108,7 +115,9 @@
, _isSaved :: Bool
, _undoTable :: UndoTable XournalState
, _isEventBlocked :: Bool
+ , _isOneTimeSelectMode :: IsOneTimeSelectMode
, _pageModeSignal :: Maybe (ConnectId RadioAction)
+ , _lastTimeCanvasConfigure :: Maybe UTCTime
-- , _networkClipboardInfo :: Maybe HXournalClipClientConfiguration
}
@@ -136,7 +145,9 @@
, _isSaved = False
, _undoTable = emptyUndo 1
, _isEventBlocked = False
+ , _isOneTimeSelectMode = NoOneTimeSelectMode
, _pageModeSignal = Nothing
+ , _lastTimeCanvasConfigure = Nothing
-- , _networkClipboardInfo = Nothing
}
diff --git a/lib/Application/HXournal/View/Coordinate.hs b/lib/Application/HXournal/View/Coordinate.hs
--- a/lib/Application/HXournal/View/Coordinate.hs
+++ b/lib/Application/HXournal/View/Coordinate.hs
@@ -31,9 +31,6 @@
import Application.HXournal.Type.PageArrangement
import Application.HXournal.Type.Alias
-import Debug.Trace
-
-
-- | data structure for transformation among screen, canvas, desktop and page coordinates
data CanvasGeometry =
@@ -101,7 +98,7 @@
makeDesktop2Page :: (PageNum -> Maybe PageOrigin) -> DesktopCoordinate
-> Maybe (PageNum, PageCoordinate)
makeDesktop2Page pfunc (DeskCoord (x,y)) =
- let (prev,next) = break (y<) . map (snd.unPageOrigin) . catMaybes
+ let (prev,_next) = break (y<) . map (snd.unPageOrigin) . catMaybes
. takeWhile isJust . map (pfunc.PageNum) $ [0..]
in Just (PageNum (length prev-1),PageCoord (x,y- last prev))
@@ -159,12 +156,12 @@
-- |
device2Desktop :: CanvasGeometry -> PointerCoord -> DesktopCoordinate
-device2Desktop geometry (PointerCoord typ x y) =
+device2Desktop geometry (PointerCoord typ x y _z) =
case typ of
Core -> core2Desktop geometry (x,y)
Stylus -> wacom2Desktop geometry (x,y)
Eraser -> wacom2Desktop geometry (x,y)
-device2Desktop geometry NoPointerCoord = error "NoPointerCoordinate device2Desktop"
+device2Desktop _geometry NoPointerCoord = error "NoPointerCoordinate device2Desktop"
-- |
@@ -177,7 +174,7 @@
pgcheck n pg = let Dim w h = get g_dimension pg
DeskCoord ul = page2Desktop geometry (PageNum n,PageCoord (0,0))
DeskCoord lr = page2Desktop geometry (PageNum n,PageCoord (w,h))
- nbbox = BBox ul lr
+ -- nbbox = BBox ul lr
inbbox = Intersect (Middle (BBox ul lr))
result = ivbbox `mappend` inbbox
in case result of
@@ -189,29 +186,14 @@
-- |
getCvsGeomFrmCvsInfo :: (ViewMode a) =>
- -- Page EditMode ->
CanvasInfo a -> IO CanvasGeometry
getCvsGeomFrmCvsInfo cinfo = do
- let -- page = getPage cinfo
- cpn = PageNum . get currentPageNum $ cinfo
+ let cpn = PageNum . get currentPageNum $ cinfo
canvas = get drawArea cinfo
arr = get (pageArrangement.viewInfo) cinfo
- makeCanvasGeometry cpn arr canvas -- EditMode (cpn,page) arr canvas
+ makeCanvasGeometry cpn arr canvas
-
-
-
-
- -- contained (ViewPortBBox bbox) (DeskCoord (x,y)) = hitTestBBoxPoint bbox (x,y)
- {- contained vbbox ul || contained vbbox ur
- || contained vbbox ll || contained vbbox lr -}
- -- ur = page2Desktop geometry (PageNum n,PageCoord (w,0))
- -- ll = page2Desktop geometry (PageNum n,PageCoord (0,h))
-{- trace (show n ++ ": " ++ show (intersectBBox bbox nbbox)
- ++ "\nivbbox = " ++ show ivbbox
- ++ "\ninbbox = " ++ show inbbox
- ++ "\nresult = " ++ show result) $ -}
diff --git a/lib/Application/HXournal/View/Draw.hs b/lib/Application/HXournal/View/Draw.hs
--- a/lib/Application/HXournal/View/Draw.hs
+++ b/lib/Application/HXournal/View/Draw.hs
@@ -16,10 +16,8 @@
import Graphics.UI.Gtk hiding (get)
import Graphics.Rendering.Cairo
-
-import Control.Applicative
-import Control.Category (id,(.))
-import Control.Monad (liftM,(<=<),when)
+import Control.Category ((.))
+import Control.Monad (when)
import Data.Label
import Prelude hiding ((.),id,mapM_,concatMap)
import Data.Foldable
@@ -28,6 +26,7 @@
import Data.Monoid
import Data.Sequence
import Data.Xournal.Simple (Dimension(..))
+import Data.Xournal.Predefined
import Data.Xournal.Generic
import Data.Xournal.BBox
import Graphics.Xournal.Render.Type
@@ -37,19 +36,18 @@
import Graphics.Xournal.Render.Generic
import Application.HXournal.Type.Canvas
import Application.HXournal.Type.Alias
-import Application.HXournal.Device
import Application.HXournal.Util
import Application.HXournal.Type.PageArrangement
import Application.HXournal.Type.Predefined
import Application.HXournal.Type.Enum
import Application.HXournal.View.Coordinate
-import Application.HXournal.ModelAction.Page
-
--- type DrawingFunction = forall a. (ViewMode a) => ViewInfo a -> Maybe BBox -> IO ()
+-- |
type family DrawingFunction v :: * -> *
+-- |
+
newtype SinglePageDraw a =
SinglePageDraw { unSinglePageDraw :: Bool
-> DrawingArea
@@ -58,6 +56,7 @@
-> Maybe BBox
-> IO () }
+-- |
newtype ContPageDraw a =
ContPageDraw
@@ -67,7 +66,12 @@
-> Xournal a
-> IO () }
+-- |
+
type instance DrawingFunction SinglePage = SinglePageDraw
+
+-- |
+
type instance DrawingFunction ContinuousSinglePage = ContPageDraw
-- |
@@ -82,32 +86,25 @@
-- |
getBBoxInPageCoord :: CanvasGeometry -> PageNum -> BBox -> BBox
-getBBoxInPageCoord geometry pnum bbox@(BBox (x1,y1) (x2,y2)) =
+getBBoxInPageCoord geometry pnum bbox =
let DeskCoord (x0,y0) = page2Desktop geometry (pnum,PageCoord (0,0))
in moveBBoxByOffset (-x0,-y0) bbox
-- |
getViewableBBox :: CanvasGeometry
- -- -> Maybe (PageNum, Maybe BBox) -- ^ in page coordinate
-> Maybe BBox -- ^ in desktop coordinate
-> IntersectBBox
- -- Maybe BBox -- ^ in desktop coordinate
-getViewableBBox geometry mbbox = -- (Just (pnum,mbbox)) =
+getViewableBBox geometry mbbox =
let ViewPortBBox vportbbox = getCanvasViewPort geometry
in (fromMaybe mbbox :: IntersectBBox) `mappend` (Intersect (Middle vportbbox))
-{- getViewableBBox geometry Nothing =
- let ViewPortBBox vportbbox = getCanvasViewPort geometry
- in (Just vportbbox) -}
-
-
-- | common routine for double buffering
doubleBufferDraw :: DrawWindow -> CanvasGeometry -> Render () -> Render ()
-> IntersectBBox
-> IO ()
-doubleBufferDraw win geometry xform rndr (Intersect ibbox) = do
+doubleBufferDraw win geometry _xform rndr (Intersect ibbox) = do
let Dim cw ch = unCanvasDimension . canvasDim $ geometry
mbbox' = case ibbox of
Top -> Just (BBox (0,0) (cw,ch))
@@ -141,31 +138,51 @@
translate x0 y0
scale sx sy
+-- |
+
+data PressureMode = NoPressure | Pressure
+
-- |
-drawCurvebit :: DrawingArea
- -> CanvasGeometry
- -> Double
- -> (Double,Double,Double,Double)
- -> PageNum
- -> (Double,Double)
- -> (Double,Double)
- -> IO ()
-drawCurvebit canvas geometry wdth (r,g,b,a) pnum (x0,y0) (x,y) = do
+drawCurvebitGen :: PressureMode
+ -> DrawingArea
+ -> CanvasGeometry
+ -> Double
+ -> (Double,Double,Double,Double)
+ -> PageNum
+ -> ((Double,Double),Double)
+ -> ((Double,Double),Double)
+ -> IO ()
+drawCurvebitGen pmode canvas geometry wdth (r,g,b,a) pnum ((x0,y0),z0) ((x,y),z) = do
win <- widgetGetDrawWindow canvas
renderWithDrawable win $ do
cairoXform4PageCoordinate geometry pnum
setSourceRGBA r g b a
- setLineWidth wdth
- moveTo x0 y0
- lineTo x y
- stroke
+ case pmode of
+ NoPressure -> do
+ setLineWidth wdth
+ moveTo x0 y0
+ lineTo x y
+ stroke
+ Pressure -> do
+ -- setLineWidth wdth
+ let wx0 = 0.5*(fst predefinedPenShapeAspectXY)*wdth*z0
+ wy0 = 0.5*(snd predefinedPenShapeAspectXY)*wdth*z0
+ wx = 0.5*(fst predefinedPenShapeAspectXY)*wdth*z
+ wy = 0.5*(snd predefinedPenShapeAspectXY)*wdth*z
+ moveTo (x0-wx0) (y0-wy0)
+ lineTo (x0+wx0) (y0+wy0)
+ lineTo (x+wx) (y+wy)
+ lineTo (x-wx) (y-wy)
+ fill
+ -- stroke
+
-- |
drawFuncGen :: (GPageable em) => em ->
((PageNum,Page em) -> Maybe BBox -> Render ()) -> DrawingFunction SinglePage em
-drawFuncGen typ render = SinglePageDraw func
+drawFuncGen _typ render = SinglePageDraw func
where func isCurrentCvs canvas (pnum,page) vinfo mbbox = do
let arr = get pageArrangement vinfo
geometry <- makeCanvasGeometry pnum arr canvas