124 lines
4.6 KiB
Haskell
124 lines
4.6 KiB
Haskell
{-# LANGUAGE OverloadedLabels #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module UI (runApp) where
|
|
|
|
import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType)
|
|
import Control.Concurrent.Async (async)
|
|
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)
|
|
import qualified Data.Text as T
|
|
import EpubParser (EpubEnv (..), getChapter, resolveSpine)
|
|
import qualified GI.GLib as GLib
|
|
import qualified GI.GLib.Constants as GLibConst
|
|
import qualified GI.Gdk as Gdk
|
|
import qualified GI.Gio as Gio
|
|
import qualified GI.Gtk as Gtk
|
|
import qualified GI.Gtk.Enums as GtkEnums
|
|
import qualified GI.WebKit as WebKit
|
|
import Persistence (loadLastRead, saveLastRead)
|
|
import State (initialState, prepareView)
|
|
import Text.HTML.Scalpel (Scraper, attr, chroots, text)
|
|
import Types (AppState (..), ChapterView (..), UserAction (..))
|
|
|
|
updateUI :: Gtk.ApplicationWindow -> WebKit.WebView -> ChapterView -> Int -> Int -> IO ()
|
|
updateUI window webView view currentIdx totalCount = do
|
|
let ttext = T.pack (show (currentIdx + 1)) <> "/ " <> T.pack (show totalCount) <> ": " <> viewTitle view
|
|
Gtk.set window [#title := ttext]
|
|
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
|
|
let totalChapters = length (cAllChapters st)
|
|
|
|
case action of
|
|
ZoomIn -> updateZoom stateTVar webView (zoomlvl st + 0.1)
|
|
ZoomOut -> updateZoom stateTVar webView (max 0.1 (zoomlvl st - 0.1))
|
|
_ -> do
|
|
if null (cAllChapters st)
|
|
then pure ()
|
|
else do
|
|
let nextIdx = case action of
|
|
NextChapter -> cIdx st + 1
|
|
PrevChapter -> cIdx st - 1
|
|
LoadSpecific i -> i
|
|
_ -> cIdx st
|
|
|
|
let safeIdx = max 0 (min (totalChapters - 1) nextIdx)
|
|
|
|
case prepareView st safeIdx of
|
|
Nothing -> pure ()
|
|
Just view -> do
|
|
updateUI window webView view safeIdx totalChapters
|
|
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 ()
|
|
|
|
ncxScraper :: Scraper T.Text [(FilePath, T.Text)]
|
|
ncxScraper = chroots "navPoint" $ do
|
|
path <- T.unpack . T.takeWhile (/= '#') <$> attr "src" "content"
|
|
title <- T.strip <$> text "navLabel"
|
|
|
|
pure (path, title)
|
|
|
|
runApp :: EpubEnv -> IO ()
|
|
runApp env = do
|
|
app <- Gtk.applicationNew (Just "com.svitak.reader.v3") []
|
|
|
|
_ <- Gtk.on app #activate $ do
|
|
stateTVar <- newTVarIO (initialState env)
|
|
window <- Gtk.applicationWindowNew app
|
|
webView <- WebKit.webViewNew
|
|
|
|
Gtk.set window [#defaultWidth := 800, #defaultHeight := 600, #child := webView]
|
|
|
|
let dispatch = handleAction stateTVar window webView
|
|
|
|
initAppServices env stateTVar dispatch
|
|
|
|
keyCtrl <- Gtk.eventControllerKeyNew
|
|
Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
|
|
|
|
_ <- 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
|
|
_ <- Gio.applicationRun app Nothing
|
|
pure ()
|