hashirama/svitak
Watch
1
0
Fork
You've already forked svitak
 0
forked from marko/svitak
Code Pull requests Activity

allow loading of new epub through file picker

Browse source 
ctxRender changed to a TVar to allow mutability of the render

make loadBook reset stCache and stIndex

write render TVar right before handing off to main thread

remove everything from the sidebar ListBox before populating it again
This commit is contained in:
Marko Andjelic 2026-07-01 20:05:04 +01:00
commit f6ec5c20d8
Signed by: marko
GPG key ID: 9C5E99C8C682FB59
1 changed files with 46 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

57
app/UI.hs
View file

@ -7,13 +7,14 @@
module UI (runApp) where
import Control.Concurrent.Async (async)
import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO)
import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO, writeTVar)
import Control.Monad (unless, void, when)
import Data.GI.Base (AttrOp (..), on)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Word (Word32)
import EpubParser (EpubEnv) -- brings the `BookInfo EpubEnv` instance into scope
import Control.Exception (SomeException, try)
import EpubParser (EpubEnv, openEpub)
import qualified GI.GLib as GLib
import qualified GI.GLib.Constants as GLibConst
import qualified GI.Gdk as Gdk
@ -38,7 +39,8 @@ import Types
data AppWidgets = AppWidgets
{ appWindow :: Gtk.ApplicationWindow,
appWebView :: WebKit.WebView,
appSidebar :: Gtk.ListBox
appSidebar :: Gtk.ListBox,
appFileBttn :: Gtk.Button
}
-- | Everything an action handler needs: shared state, widgets, and a way to
@ -46,7 +48,7 @@ data AppWidgets = AppWidgets
data Ctx = Ctx
{ ctxState :: TVar AppState,
ctxWidgets :: AppWidgets,
ctxRender :: ChapterRef -> IO (Either String Chapter)
ctxRender :: TVar (ChapterRef -> IO (Either String Chapter))
}
--------------------------------------------------------------------------------
@ -55,10 +57,12 @@ data Ctx = Ctx
buildLayout :: Gtk.Application -> IO AppWidgets
buildLayout app = do
window <- Gtk.applicationWindowNew app
window <- Gtk.applicationWindowNew app
webView <- WebKit.webViewNew
sidebar <- Gtk.listBoxNew
header <- Gtk.headerBarNew
header <- Gtk.headerBarNew
fileBttn <- Gtk.buttonNew
Gtk.listBoxSetSelectionMode sidebar GtkEnums.SelectionModeSingle
Gtk.widgetAddCssClass sidebar "toc"
@ -72,10 +76,12 @@ buildLayout app = do
Gtk.panedSetEndChild paned (Just webView)
Gtk.panedSetResizeStartChild paned False
Gtk.headerBarPackStart header fileBttn
Gtk.set window [#defaultWidth := 1000, #defaultHeight := 700, #child := paned]
Gtk.windowSetTitlebar window $ Just header
applyStyles window
pure (AppWidgets window webView sidebar)
pure (AppWidgets window webView sidebar fileBttn)
-- | Install the app-wide stylesheet (sidebar rows, selection, headings).
applyStyles :: Gtk.ApplicationWindow -> IO ()
@ -143,8 +149,10 @@ wireEvents ctx = do
Gdk.KEY_equal -> dispatch ZoomIn >> pure True
Gdk.KEY_minus -> dispatch ZoomOut >> pure True
_ -> pure False
Gtk.widgetAddController (appWindow (ctxWidgets ctx)) keyCtrl
_ <- on (appFileBttn (ctxWidgets ctx)) #clicked $ epPicker (Just (appWindow (ctxWidgets ctx))) ctx
_ <- on (appSidebar (ctxWidgets ctx)) #rowActivated $ \row -> do
i <- Gtk.listBoxRowGetIndex row
st <- readTVarIO (ctxState ctx)
@ -166,8 +174,15 @@ loadBook env ctx = void $
case result of
Left err -> putStrLn ("Failed to load book: " ++ err)
Right (BookStructure refs toc) -> do
atomically $ modifyTVar' (ctxState ctx) $ \s -> s {stRefs = refs, stToc = toc}
atomically $ do
modifyTVar' (ctxState ctx) $ \s ->
s { stRefs = refs,
stToc = toc,
stCache = M.empty,
stIndex = ChapterIndex 0 }
writeTVar (ctxRender ctx) (renderChapter env)
postGtk $ do
Gtk.listBoxRemoveAll (appSidebar (ctxWidgets ctx))
populateSidebar (appSidebar (ctxWidgets ctx)) (displayRows refs toc)
saved <- loadLastRead
let start = case saved of
@ -175,6 +190,23 @@ loadBook env ctx = void $
_ -> ChapterIndex 0
handleAction ctx (GoToChapter start "")
epPicker :: Maybe Gtk.ApplicationWindow -> Ctx -> IO ()
epPicker window ctx = do
dg <- Gtk.fileDialogNew
Gtk.fileDialogOpen dg window (Nothing :: Maybe Gio.Cancellable) $ Just $ \_ result -> do
outcome <- try (Gtk.fileDialogOpenFinish dg result) :: IO (Either SomeException Gio.File)
case outcome of
Left _err -> putStrLn "picker cancelled or failed"
Right file -> do
mp <- Gio.fileGetPath file
case mp of
Nothing -> putStrLn "selected file has no local path"
Just path -> do
env <- openEpub path
case env of
Left err -> putStrLn ("open failed: " ++ err)
Right e -> loadBook e ctx
--------------------------------------------------------------------------------
-- Navigation + rendering
--------------------------------------------------------------------------------
@ -208,7 +240,8 @@ goto ctx target frag = do
Nothing -> do
showLoading ctx ref
void $ async $ do
rendered <- ctxRender ctx ref
renderFn <- readTVarIO (ctxRender ctx)
rendered <- renderFn ref
case rendered of
Left err -> putStrLn ("render failed: " ++ err)
Right chapter -> do
@ -234,7 +267,8 @@ cacheRef ctx refs n = do
unless (M.member idx (stCache st)) $
void $
async $ do
rendered <- ctxRender ctx (refs !! n)
renderFn <- readTVarIO (ctxRender ctx)
rendered <- renderFn (refs !! n)
case rendered of
Right chapter -> atomically $ modifyTVar' (ctxState ctx) $ \s -> s {stCache = M.insert idx chapter (stCache s)}
Left _ -> pure ()
@ -294,8 +328,9 @@ postGtk act = void $ GLib.idleAdd GLibConst.PRIORITY_DEFAULT (act >> pure False)
activate :: EpubEnv -> Gtk.Application -> IO ()
activate env app = do
stateTVar <- newTVarIO (initialState (bookTitle env) (bookFilePath env))
renderVar <- newTVarIO (renderChapter env)
widgets <- buildLayout app
let ctx = Ctx stateTVar widgets (renderChapter env)
let ctx = Ctx stateTVar widgets renderVar
wireEvents ctx
loadBook env ctx
#present (appWindow widgets)