99 lines
3.4 KiB
Haskell
99 lines
3.4 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 (atomically, modifyTVar, newTVarIO, readTVar)
|
|
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 (AppState (..), ChapterView (..), initialState, prepareView)
|
|
|
|
runApp :: EpubEnv -> IO ()
|
|
runApp env' = do
|
|
app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
|
|
|
|
_ <- 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]
|
|
|
|
-- 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
|
|
|
|
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.widgetAddController window keyCtrl
|
|
#present window
|
|
|
|
-- start eager parse
|
|
_ <- async $ do
|
|
ispine <- runReaderT resolveSpine env'
|
|
allChapters <- runReaderT (mapM getChapter ispine) 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 ()
|
|
|
|
_ <- Gio.applicationRun app Nothing
|
|
pure ()
|