Skip to content

Commit

Permalink
Align tops to upper #104
Browse files Browse the repository at this point in the history
  • Loading branch information
@YoEight
YoEight authored and cchantep committed May 20, 2014
1 parent 5b98208 commit 7e85f22
Show file tree
Hide file tree
Showing 5 changed files with 217 additions and 114 deletions.
171 changes: 96 additions & 75 deletions Dhek/Engine/Interpreter.hs
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
--------------------------------------------------------------------------------
-- |
-- Module : Dhek.Engine.Interpreter
Expand Down Expand Up @@ -40,33 +42,43 @@ import Dhek.Mode.Selection
import Dhek.Types

--------------------------------------------------------------------------------
data Interpreter =
Interpreter
{ _internal :: IORef (Maybe Viewer)
, _state :: IORef EngineState
, _env :: IORef EngineEnv
, _gui :: GUI
}
data Interpreter
= Interpreter
{ _internal :: IORef (Maybe Viewer)
, _state :: IORef EngineState
, _env :: IORef EngineEnv
, _gui :: GUI
, _modes :: Modes
, _curModeMgr :: IORef ModeManager
}

--------------------------------------------------------------------------------
data Modes
= Modes
{ modeDraw :: IO ModeManager
, modeDuplication :: IO ModeManager
, modeSelection :: IO ModeManager
}

--------------------------------------------------------------------------------
drawInterpret :: (DrawEnv -> M a) -> Interpreter -> Pos -> IO ()
drawInterpret k i (x,y) = do
s <- readIORef $ _state i
opt <- readIORef $ _internal i
e <- readIORef $ _env i
mgr <- readIORef $ _curModeMgr i

for_ opt $ \v -> do
let gui = _gui i
ratio = _engineRatio s v
pid = s ^. engineCurPage
ModeManager mode _ = s ^. engineModeMgr
opts = DrawEnv{ drawOverlap = s ^. engineOverlap
, drawPointer = (x/ratio, y/ratio)
, drawRects = getRects s
, drawRatio = ratio
}

s2 <- runMode mode s (k opts)
let gui = _gui i
ratio = _engineRatio s v
pid = s ^. engineCurPage
opts = DrawEnv
{ drawOverlap = s ^. engineOverlap
, drawPointer = (x/ratio, y/ratio)
, drawRects = getRects s
, drawRatio = ratio
}

s2 <- runMode (mgrMode mgr) s (k opts)
writeIORef (_state i) s2
liftIO $ Gtk.widgetQueueDraw $ guiDrawingArea gui

Expand All @@ -75,13 +87,12 @@ engineRunDraw :: Interpreter -> IO ()
engineRunDraw i = do
s <- readIORef $ _state i
opt <- readIORef $ _internal i

mgr <- readIORef $ _curModeMgr i
for_ opt $ \v -> do
let pages = v ^. viewerPages
page = pages ! (s ^. engineCurPage)
ModeManager mode _ = s ^. engineModeMgr
ratio = _engineRatio s v
s2 <- runMode mode s (drawing page ratio)
s2 <- runMode (mgrMode mgr) s (drawing page ratio)
writeIORef (_state i) s2

--------------------------------------------------------------------------------
Expand Down Expand Up @@ -130,20 +141,23 @@ engineDrawingArea = guiDrawingArea . _gui
-- the new @ModeManager@
engineSetMode :: DhekMode -> Interpreter -> IO ()
engineSetMode m i = do
s <- readIORef $ _state i
e <- readIORef $ _env i
let ModeManager _ cleanup = s ^. engineModeMgr
s <- readIORef $ _state i
e <- readIORef $ _env i
prevMgr <- readIORef $ _curModeMgr i
let cleanup = mgrCleanup prevMgr
s2 <- execStateT cleanup s
mgr <- (_engineModes e) ! midx
writeIORef (_state i) (s2 & engineModeMgr .~ mgr)
mgr <- selector modes
writeIORef (_state i) s2
writeIORef (_curModeMgr i) mgr
Gtk.widgetQueueDraw area

where
area = guiDrawingArea $ _gui i
midx = case m of
DhekNormal -> 1
DhekDuplication -> 2
DhekSelection -> 3
modes = _modes i
area = guiDrawingArea $ _gui i
selector = case m of
DhekNormal -> modeDraw
DhekDuplication -> modeDuplication
DhekSelection -> modeSelection

--------------------------------------------------------------------------------
-- | Returns the current page ratio. Returns Nothing if no PDF has been loaded
Expand All @@ -167,52 +181,48 @@ _engineRatio s v =
--------------------------------------------------------------------------------
makeInterpreter :: GUI -> IO Interpreter
makeInterpreter gui = do
let env = envNew gui
let env = EngineEnv { _engineFilename = "" }
eRef <- newIORef env
s <- stateNew gui env
sRef <- newIORef s
sRef <- newIORef stateNew
vRef <- newIORef Nothing
return Interpreter{ _internal = vRef
, _state = sRef
, _env = eRef
, _gui = gui
}

--------------------------------------------------------------------------------
envNew :: GUI -> EngineEnv
envNew gui =
EngineEnv{ _engineFilename = ""
, _engineRects = []
, _engineOverRect = Nothing
, _engineOverArea = Nothing
, _engineModes = modes
}
where
modes = array (1,3) [ (1, normalModeManager gui)
, (2, duplicateModeManager gui)
, (3, selectionModeManager gui)
]
-- Instanciates ModeManagers
let mgrNormal = normalModeManager gui
mgrDuplication = duplicateModeManager gui
mgrSelection = selectionModeManager (withContext sRef) gui
modes = Modes
{ modeDraw = mgrNormal
, modeDuplication = mgrDuplication
, modeSelection = mgrSelection
}

curMgr <- mgrNormal
cRef <- newIORef curMgr
return Interpreter{ _internal = vRef
, _state = sRef
, _env = eRef
, _gui = gui
, _modes = modes
, _curModeMgr = cRef
}

--------------------------------------------------------------------------------
stateNew :: GUI -> EngineEnv -> IO EngineState
stateNew gui env = do
mgr <- modes ! 1
return EngineState{ _engineCurPage = 1
, _engineCurZoom = 3
, _engineRectId = 0
, _engineOverlap = False
, _engineDraw = False
, _enginePropLabel = ""
, _enginePropType = Nothing
, _enginePrevPos = (negate 1, negate 1)
, _engineDrawState = drawStateNew
, _engineBoards = boardsNew 1
, _engineModeMgr = mgr
, _engineBaseWidth = 777
, _engineThick = 1
}
where
modes = _engineModes env
stateNew :: EngineState
stateNew
= EngineState
{ _engineCurPage = 1
, _engineCurZoom = 3
, _engineRectId = 0
, _engineOverlap = False
, _engineDraw = False
, _enginePropLabel = ""
, _enginePropType = Nothing
, _enginePrevPos = (negate 1, negate 1)
, _engineDrawState = drawStateNew
, _engineBoards = boardsNew 1
, _engineBaseWidth = 777
, _engineThick = 1
}

--------------------------------------------------------------------------------
runProgram :: Interpreter -> DhekProgram a -> IO (Maybe a)
Expand All @@ -224,6 +234,13 @@ runProgram i p = do
for opt $ \ v ->
evalStateT (_evalProgram env (_gui i) (_state i) p v) s

--------------------------------------------------------------------------------
withContext :: IORef EngineState -> (forall m. EngineCtx m => m a) -> IO ()
withContext ref state = do
s <- readIORef ref
s' <- execStateT state s
writeIORef ref s'

--------------------------------------------------------------------------------
_evalProgram :: EngineEnv
-> GUI
Expand All @@ -233,7 +250,6 @@ _evalProgram :: EngineEnv
-> StateT EngineState IO a
_evalProgram env gui ref prg v= foldFree end susp prg where
nb = v ^. viewerPageCount
modes = _engineModes env

susp (GetCurPage k) = (use engineCurPage) >>= k
susp (GetPageCount k) = k (v ^. viewerPageCount)
Expand Down Expand Up @@ -453,7 +469,12 @@ loadPdf i path = do
ev <- readIORef $ _env i
case opt of
Nothing -> do
let env = (envNew gui) { _engineFilename = takeFileName path }
let modes = array (1,3)
[ (1, normalModeManager gui)
, (2, duplicateModeManager gui)
, (3, selectionModeManager (withContext $ _state i) gui)
]
env = EngineEnv { _engineFilename = takeFileName path }
name = _engineFilename env
nb = v ^. viewerPageCount
s' = s & engineBoards .~ boardsNew nb
Expand Down
39 changes: 25 additions & 14 deletions Dhek/Engine/Type.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,12 @@ module Dhek.Engine.Type where

--------------------------------------------------------------------------------
import Control.Applicative
import Data.Array (Array)

--------------------------------------------------------------------------------
import Control.Lens
import Control.Monad.State
import Graphics.UI.Gtk (CursorType)
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap as I
import Graphics.UI.Gtk (CursorType)

--------------------------------------------------------------------------------
import Dhek.Types
Expand Down Expand Up @@ -47,15 +47,15 @@ newtype Mode = Mode (forall a. M a -> EngineState -> IO EngineState)
--------------------------------------------------------------------------------
-- | We expect from a cleanup handler to handle @EngineState@ state and
-- IO actions
type ModeCtx m = (MonadIO m, MonadState EngineState m)
type EngineCtx m = (MonadIO m, MonadState EngineState m)

--------------------------------------------------------------------------------
-- | Holds a Engine mode and a cleanup handler. @ModeManager@ manages anything
-- related to a @Mode@ lifecycle
data ModeManager
= ModeManager
{ mgrMode :: Mode
, mgrCleanup :: forall m. ModeCtx m => m ()
, mgrCleanup :: forall m. EngineCtx m => m ()
}

--------------------------------------------------------------------------------
Expand Down Expand Up @@ -101,19 +101,14 @@ data EngineState = EngineState
, _enginePrevPos :: !(Double, Double)
, _engineBoards :: !Boards
, _engineDrawState :: !DrawState
, _engineModeMgr :: !ModeManager
, _engineBaseWidth :: !Int
, _engineThick :: !Double
}

--------------------------------------------------------------------------------
data EngineEnv = EngineEnv
{ _engineFilename :: !String
, _engineRects :: ![Rect]
, _engineOverRect :: !(Maybe Rect)
, _engineOverArea :: !(Maybe Area)
, _engineModes :: !(Array Int (IO ModeManager))
}
data EngineEnv
= EngineEnv
{ _engineFilename :: !String }

--------------------------------------------------------------------------------
-- | Constructors
Expand Down Expand Up @@ -185,3 +180,19 @@ release = M mRelease

drawing :: PageItem -> Ratio -> M ()
drawing p r = M $ mDrawing p r

--------------------------------------------------------------------------------
-- | Helpers
--------------------------------------------------------------------------------
engineStateGetRects :: MonadState EngineState m => m [Rect]
engineStateGetRects = do
pid <- use engineCurPage
use $ engineBoards.boardsMap.at pid.traverse.boardRects.to I.elems

--------------------------------------------------------------------------------
engineStateSetRects :: MonadState EngineState m => [Rect] -> m ()
engineStateSetRects rs = do
pid <- use engineCurPage
forM_ rs $ \r -> do
let rid = r ^. rectId
engineBoards.boardsMap.at pid.traverse.boardRects.at rid ?= r
11 changes: 9 additions & 2 deletions Dhek/GUI.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,6 @@ import qualified Graphics.UI.Gtk as Gtk
import System.FilePath (joinPath, dropFileName)
import System.Environment.Executable (getExecutablePath)

import Debug.Trace (trace)

--------------------------------------------------------------------------------
import Dhek.I18N
import Dhek.Types
Expand Down Expand Up @@ -56,6 +54,7 @@ data GUI =
, guiWindowHBox :: Gtk.HBox
, guiVRulerAdjustment :: Gtk.Adjustment
, guiHRulerAdjustment :: Gtk.Adjustment
, guiModeToolbar :: Gtk.HButtonBox
}

--------------------------------------------------------------------------------
Expand Down Expand Up @@ -175,6 +174,13 @@ makeGUI = do
Gtk.containerAdd toolbar msb
Gtk.boxPackStart vbox align Gtk.PackNatural 0

-- Mode toolbar
mtoolbar <- Gtk.hButtonBoxNew
mtalign <- Gtk.alignmentNew 0 1 0 0
Gtk.containerAdd mtalign mtoolbar
Gtk.boxPackStart vbox mtalign Gtk.PackNatural 0
Gtk.widgetSetSizeRequest mtoolbar (-1) 32

-- Drawing Area
area <- Gtk.drawingAreaNew
vruler <- Gtk.vRulerNew
Expand Down Expand Up @@ -320,6 +326,7 @@ makeGUI = do
, guiWindowHBox = hbox
, guiVRulerAdjustment = vadj
, guiHRulerAdjustment = hadj
, guiModeToolbar = mtoolbar
}

--------------------------------------------------------------------------------
Expand Down
Loading

0 comments on commit 7e85f22

Please sign in to comment.