117 lines
4.5 KiB
Haskell
117 lines
4.5 KiB
Haskell
{-# LANGUAGE OverloadedLabels #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module UI (runApp) where
|
|
|
|
import Control.Concurrent.Async (async)
|
|
import Control.Concurrent.STM (TVar, atomically, modifyTVar, newTVarIO, readTVar)
|
|
import Control.Monad (zipWithM)
|
|
import Data.GI.Base (AttrOp (..), on)
|
|
import qualified Data.Text as T
|
|
import EpubParser (EpubEnv (..))
|
|
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 Types (AppState (..), ChapterView (..), UserAction (..), ChapterIndex(..), BookInfo (..))
|
|
|
|
updateUI :: Gtk.ApplicationWindow -> WebKit.WebView -> ChapterView -> ChapterIndex -> Int -> IO ()
|
|
updateUI window webView view (ChapterIndex 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
|
|
|
|
let safeIdx = max 0 (min (ChapterIndex (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 :: (BookInfo a) => a -> TVar AppState -> (UserAction -> IO ()) -> IO ()
|
|
initAppServices env stateTVar actionHandler = do
|
|
_ <- async $ do
|
|
spineResult <- getSpine env
|
|
case spineResult of
|
|
Left err -> putStrLn $ "Failed to load spine: " ++ err
|
|
Right ispine -> do
|
|
chapterResults <- zipWithM (loadChapter env) ispine (map ChapterIndex [0 ..])
|
|
|
|
case sequence chapterResults of
|
|
Left err -> putStrLn $ "Failed to load chapters: " ++ err
|
|
Right allChapters -> do
|
|
let bookTitle = getTitle env
|
|
atomically $ modifyTVar stateTVar $ \s ->
|
|
s { cSpine = ispine, cAllChapters = allChapters, bTitle = bookTitle }
|
|
|
|
_ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do
|
|
maybeSaved <- loadLastRead
|
|
case maybeSaved of
|
|
Just (path, idx) | path == getBookPath env -> actionHandler (LoadSpecific idx)
|
|
_ -> actionHandler (LoadSpecific 0)
|
|
pure False
|
|
pure ()
|
|
pure ()
|
|
|
|
activate :: EpubEnv -> Gtk.Application -> IO ()
|
|
activate env app = 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
|
|
|
|
_ <- 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
|
|
pure ()
|
|
|
|
runApp :: EpubEnv -> IO ()
|
|
runApp env = do
|
|
app <- Gtk.new Gtk.Application [#applicationId := "com.svitak.reader", #flags := [Gio.ApplicationFlagsDefaultFlags]]
|
|
_ <- on app #activate (activate env app)
|
|
_ <- Gio.applicationRun app Nothing -- we're not working with CLI args here, so Nothing can be passed
|
|
pure ()
|