forked from marko/svitak
break up UI into different functions
This commit is contained in:
parent
de7a64cade
commit
eb479d0ae3
2 changed files with 76 additions and 62 deletions
|
|
@ -3,6 +3,7 @@ module Types
|
|||
ChapterView(..),
|
||||
Chapter(..),
|
||||
AppState(..),
|
||||
UserAction(..),
|
||||
EpubAction
|
||||
)
|
||||
where
|
||||
|
|
@ -47,3 +48,10 @@ data AppState = AppState
|
|||
}
|
||||
|
||||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
data UserAction
|
||||
= NextChapter
|
||||
| PrevChapter
|
||||
| ZoomIn
|
||||
| ZoomOut
|
||||
| LoadSpecific Int
|
||||
|
|
|
|||
130
app/UI.hs
130
app/UI.hs
|
|
@ -5,7 +5,8 @@ module UI (runApp) where
|
|||
|
||||
import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType)
|
||||
import Control.Concurrent.Async (async)
|
||||
import Control.Concurrent.STM (atomically, modifyTVar, newTVarIO, readTVar)
|
||||
import Control.Concurrent.STM (TVar, atomically, modifyTVar, newTVarIO, readTVar)
|
||||
import Control.Monad (zipWithM)
|
||||
import Control.Monad.Reader (runReaderT)
|
||||
import Data.GI.Base (AttrOp (..))
|
||||
import Data.List (find)
|
||||
|
|
@ -20,82 +21,87 @@ import qualified GI.Gtk.Enums as GtkEnums
|
|||
import qualified GI.WebKit as WebKit
|
||||
import Persistence (loadLastRead, saveLastRead)
|
||||
import State (initialState, prepareView)
|
||||
import Types (AppState(..), ChapterView(..))
|
||||
import Control.Monad (zipWithM)
|
||||
import Types (AppState (..), ChapterView (..), UserAction (..))
|
||||
|
||||
updateUI :: Gtk.ApplicationWindow -> WebKit.WebView -> ChapterView -> IO ()
|
||||
updateUI window webView view = do
|
||||
Gtk.set window [#title := viewTitle view]
|
||||
WebKit.webViewLoadHtml webView (viewHtml view) Nothing
|
||||
|
||||
handleAction :: TVar AppState -> Gtk.ApplicationWindow -> WebKit.WebView -> UserAction -> IO ()
|
||||
handleAction stateTVar window webView action = do
|
||||
st <- atomically $ readTVar stateTVar
|
||||
case action of
|
||||
ZoomIn -> updateZoom stateTVar webView (zoomlvl st + 0.1)
|
||||
ZoomOut -> updateZoom stateTVar webView (max 0.1 (zoomlvl st - 0.1))
|
||||
_ -> do
|
||||
let nextIdx = case action of
|
||||
NextChapter -> cIdx st + 1
|
||||
PrevChapter -> cIdx st - 1
|
||||
LoadSpecific i -> i
|
||||
_ -> cIdx st
|
||||
|
||||
case prepareView st nextIdx of
|
||||
Nothing -> pure ()
|
||||
Just view -> do
|
||||
updateUI window webView view
|
||||
atomically $ modifyTVar stateTVar $ \s -> s {cIdx = viewIdx view}
|
||||
_ <- async $ saveLastRead (bookPath (cEnv st)) (viewIdx view)
|
||||
pure ()
|
||||
|
||||
updateZoom :: TVar AppState -> WebKit.WebView -> Double -> IO ()
|
||||
updateZoom stateTVar webView level = do
|
||||
atomically $ modifyTVar stateTVar $ \s -> s {zoomlvl = level}
|
||||
WebKit.webViewSetZoomLevel webView level
|
||||
|
||||
initAppServices :: EpubEnv -> TVar AppState -> (UserAction -> IO ()) -> IO ()
|
||||
initAppServices env stateTVar actionHandler = do
|
||||
_ <- async $ do
|
||||
ispine <- runReaderT resolveSpine env
|
||||
allChapters <- runReaderT (zipWithM getChapter ispine [0 ..]) env
|
||||
|
||||
let titles = metaTitles (eMetadata env)
|
||||
let bookTitle = case find (\t -> titleType t == Just "main") titles of
|
||||
Just t -> titleText t
|
||||
Nothing -> if null titles then "Unknown" else titleText (head titles)
|
||||
|
||||
atomically $ modifyTVar stateTVar $ \s ->
|
||||
s {cSpine = ispine, cAllChapters = allChapters, bTitle = T.pack bookTitle}
|
||||
|
||||
_ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do
|
||||
maybeSaved <- loadLastRead
|
||||
case maybeSaved of
|
||||
Just (path, idx) | path == bookPath env -> actionHandler (LoadSpecific idx)
|
||||
_ -> actionHandler (LoadSpecific 0)
|
||||
pure False
|
||||
pure ()
|
||||
pure ()
|
||||
|
||||
runApp :: EpubEnv -> IO ()
|
||||
runApp env' = do
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
|
||||
runApp env = do
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader.v3") []
|
||||
|
||||
_ <- Gtk.on app #activate $ do
|
||||
stateTVar <- newTVarIO (initialState env')
|
||||
|
||||
stateTVar <- newTVarIO (initialState env)
|
||||
window <- Gtk.applicationWindowNew app
|
||||
webView <- WebKit.webViewNew
|
||||
Gtk.set window [#defaultWidth := 800, #defaultHeight := 600, #child := webView]
|
||||
|
||||
-- load all chapters on another thread
|
||||
let loadChapter index = do
|
||||
st <- atomically $ readTVar stateTVar
|
||||
case prepareView st index of
|
||||
Nothing -> pure ()
|
||||
Just view -> do
|
||||
Gtk.set window [#title := viewTitle view]
|
||||
WebKit.webViewLoadHtml webView (viewHtml view) Nothing
|
||||
let dispatch = handleAction stateTVar window webView
|
||||
|
||||
atomically $ modifyTVar stateTVar $ \s -> s {cIdx = viewIdx view}
|
||||
_ <- async $ saveLastRead (bookPath env') (viewIdx view)
|
||||
pure ()
|
||||
|
||||
-- keyboard handling
|
||||
keyCtrl <- Gtk.eventControllerKeyNew
|
||||
Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
|
||||
|
||||
_ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do
|
||||
stNow <- atomically $ readTVar stateTVar
|
||||
case keyval of
|
||||
Gdk.KEY_Right -> loadChapter (cIdx stNow + 1) >> pure True
|
||||
Gdk.KEY_Left -> loadChapter (cIdx stNow - 1) >> pure True
|
||||
Gdk.KEY_equal -> do
|
||||
let newZ = zoomlvl stNow + 0.1
|
||||
atomically $ modifyTVar stateTVar $ \s -> s {zoomlvl = newZ}
|
||||
WebKit.webViewSetZoomLevel webView newZ
|
||||
pure True
|
||||
Gdk.KEY_minus -> do
|
||||
let newZ = max 0.1 (zoomlvl stNow - 0.1)
|
||||
atomically $ modifyTVar stateTVar $ \s -> s {zoomlvl = newZ}
|
||||
WebKit.webViewSetZoomLevel webView newZ
|
||||
pure True
|
||||
_ -> pure False
|
||||
_ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> case keyval of
|
||||
Gdk.KEY_Right -> dispatch NextChapter >> pure True
|
||||
Gdk.KEY_Left -> dispatch PrevChapter >> pure True
|
||||
Gdk.KEY_equal -> dispatch ZoomIn >> pure True
|
||||
Gdk.KEY_minus -> dispatch ZoomOut >> pure True
|
||||
_ -> pure False
|
||||
|
||||
Gtk.widgetAddController window keyCtrl
|
||||
#present window
|
||||
|
||||
-- start eager parse
|
||||
_ <- async $ do
|
||||
ispine <- runReaderT resolveSpine env'
|
||||
allChapters <- runReaderT (zipWithM getChapter ispine[0..]) env'
|
||||
|
||||
let titles = metaTitles (eMetadata env')
|
||||
let rawT = case find (\t -> titleType t == Just "main") titles of
|
||||
Just t -> titleText t
|
||||
Nothing -> if null titles then "Unknown" else titleText (head titles)
|
||||
|
||||
atomically $ modifyTVar stateTVar $ \s ->
|
||||
s
|
||||
{ cSpine = ispine,
|
||||
cAllChapters = allChapters,
|
||||
bTitle = T.pack rawT
|
||||
}
|
||||
|
||||
_ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do
|
||||
maybeSaved <- loadLastRead
|
||||
case maybeSaved of
|
||||
Just (path, idx) | path == bookPath env' -> loadChapter idx
|
||||
_ -> loadChapter 0
|
||||
pure False
|
||||
pure ()
|
||||
pure ()
|
||||
initAppServices env stateTVar dispatch
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
pure ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue