Add navigation and proper webkit integration with basic chapter display

This commit is contained in:
Marko Andjelic 2026-01-26 04:30:47 +00:00
commit 935dc795d0
5 changed files with 144 additions and 42 deletions

View file

@ -114,4 +114,4 @@ embedImages arch bdir = map processTag
Just entry -> Just entry ->
let rawData = B.toStrict $ fromEntry entry let rawData = B.toStrict $ fromEntry entry
b64 = TE.decodeUtf8 $ B64.encode rawData b64 = TE.decodeUtf8 $ B64.encode rawData
in "data:" <> getMimeType fullPath <> ";base64," <> b64 in "data:" <> getMimeType fullPath <> ";base64," <> b64

View file

@ -1,30 +1,65 @@
{-# LANGUAGE OverloadedStrings, OverloadedLabels #-} {-# LANGUAGE OverloadedStrings, OverloadedLabels #-}
module Gui (runWindow) where module Gui (runReader) where
import qualified GI.Gtk as Gtk import qualified GI.Gtk as Gtk
import qualified GI.Gio as Gio import qualified GI.Gio as Gio
import qualified GI.Gdk as Gdk
import qualified GI.WebKit as WebKit import qualified GI.WebKit as WebKit
import qualified Data.Text as T
runWindow :: String -> IO () import Data.IORef (newIORef, readIORef, writeIORef)
runWindow htmlContent = do import Control.Monad.Reader (runReaderT)
import Text.HTML.TagSoup (renderTags)
import EpubParser (EpubEnv, resolveSpine, getChapter)
runReader :: EpubEnv -> IO ()
runReader env = do
app <- Gtk.applicationNew (Just "com.svitak.reader") [] app <- Gtk.applicationNew (Just "com.svitak.reader") []
_ <- Gtk.on app #activate $ do _ <- Gtk.on app #activate $ do
window <- Gtk.applicationWindowNew app window <- Gtk.applicationWindowNew app
Gtk.windowSetTitle window (Just "Svitak") Gtk.windowSetTitle window (Just "Svitak")
Gtk.windowSetDefaultSize window 800 600 Gtk.windowSetDefaultSize window 800 600
-- Web View
webView <- WebKit.webViewNew webView <- WebKit.webViewNew
WebKit.webViewLoadHtml webView (T.pack htmlContent) (Just "file:///")
Gtk.windowSetChild window (Just webView) Gtk.windowSetChild window (Just webView)
-- Book Data
spine <- runReaderT resolveSpine env
currentChapterIndex <- newIORef 0
let loadChapter index = do
let maxIdx = length spine - 1
-- index to valid range
let safeIdx = max 0 (min index maxIdx)
-- Update state
writeIORef currentChapterIndex safeIdx
let filename = spine !! safeIdx
tags <- runReaderT (getChapter filename) env
WebKit.webViewLoadHtml webView (renderTags tags) (Just "file:///")
loadChapter 0
-- Keyboard Input
keyController <- Gtk.eventControllerKeyNew
Gtk.widgetAddController window keyController
_ <- Gtk.on keyController #keyPressed $ \keyval _ _ -> do
currentIndex <- readIORef currentChapterIndex
case keyval of
Gdk.KEY_Right -> do
loadChapter (currentIndex + 1)
return True
Gdk.KEY_Left -> do
loadChapter (currentIndex - 1)
return True
_ -> return False
#present window #present window
_ <- Gio.applicationRun app Nothing _ <- Gio.applicationRun app Nothing

View file

@ -1,37 +1,16 @@
module Main (main) where module Main where
import System.Environment (getArgs) import System.Environment (getArgs)
import Control.Monad.Reader (runReaderT) import EpubParser (openEpub)
import EpubParser (EpubAction, openEpub, resolveSpine, getChapter) import UI (runApp)
import Gui (runWindow)
import qualified Data.Text as T
import Text.HTML.TagSoup (renderTags)
main :: IO () main :: IO ()
main = do main = do
args <- getArgs args <- getArgs
case args of case args of
[] -> do [path] -> do
putStrLn "Starting GUI..." result <- openEpub path
runWindow "<h1>Welcome to Svitak</h1><p>Please input an epub file.</p>" case result of
Left err -> putStrLn $ "Error: " ++ err
(path:_) -> runSvitak path Right env -> runApp env
_ -> putStrLn "Usage: svitak <file.epub>"
runSvitak :: FilePath -> IO ()
runSvitak path = do
result <- openEpub path
case result of
Left err -> putStrLn $ "Error: " ++ err
Right env -> do
htmlContent <- runReaderT loadBook env
runWindow htmlContent
loadBook :: EpubAction String
loadBook = do
spine <- resolveSpine
case spine of
[] -> pure "<h1>No chapters found</h1>"
(firstChapter:_) -> do
tags <- getChapter firstChapter
pure $ T.unpack $ renderTags tags

86
app/UI.hs Normal file
View file

@ -0,0 +1,86 @@
{-# LANGUAGE OverloadedStrings, OverloadedLabels #-}
module UI (runApp) where
import qualified GI.Gtk as Gtk
import qualified GI.Gdk as Gdk
import qualified GI.Gio as Gio
import qualified GI.WebKit as WebKit
import qualified GI.Gtk.Enums as GtkEnums
import Control.Monad.Reader (runReaderT)
import Data.IORef (newIORef, readIORef, writeIORef)
import Text.HTML.TagSoup (renderTags)
import EpubParser (EpubEnv, resolveSpine, getChapter)
runApp :: EpubEnv -> IO ()
runApp env = do
app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
_ <- Gtk.on app #activate $ do
putStrLn "DEBUG: App Activated"
-- Setup window
window <- Gtk.applicationWindowNew app
Gtk.windowSetTitle window (Just "Svitak")
Gtk.windowSetDefaultSize window 800 600
-- Setup webview
webView <- WebKit.webViewNew
Gtk.windowSetChild window (Just webView)
-- Get the spine
spine <- runReaderT resolveSpine env
let totalChapters = length spine
putStrLn $ "DEBUG: Spine loaded. Total chapters: " ++ show totalChapters
if totalChapters == 0
then putStrLn "ERROR: This book has no chapters!"
else do
currentIndex <- newIORef 0
let loadChapter index = do
let maxIdx = totalChapters - 1
let safeIdx = max 0 (min index maxIdx)
writeIORef currentIndex safeIdx
putStrLn $ "DEBUG: Loading Chapter " ++ show (safeIdx + 1)
let filename = spine !! safeIdx
tags <- runReaderT (getChapter filename) env
let htmlContent = renderTags tags
-- Load HTML
WebKit.webViewLoadHtml webView htmlContent (Just "file:///")
-- Load the first chapter
loadChapter 0
-- Setup keyboard input
keyController <- Gtk.eventControllerKeyNew
Gtk.eventControllerSetPropagationPhase keyController GtkEnums.PropagationPhaseCapture
_ <- Gtk.on keyController #keyPressed $ \keyval _ _ -> do
curr <- readIORef currentIndex
case keyval of
Gdk.KEY_Right -> do
putStrLn "KEY: -> Next"
loadChapter (curr + 1)
return True
Gdk.KEY_Left -> do
putStrLn "KEY: <- Prev"
loadChapter (curr - 1)
return True
_ -> return False
Gtk.widgetAddController window keyController
#present window
putStrLn "DEBUG: Window presented"
_ <- Gio.applicationRun app Nothing
pure ()

View file

@ -58,7 +58,8 @@ executable svitak
main-is: Main.hs main-is: Main.hs
other-modules: EpubParser, other-modules: EpubParser,
Gui Gui,
UI
build-depends: base ^>=4.21.0.0, build-depends: base ^>=4.21.0.0,
bytestring >= 0.12.2.0, bytestring >= 0.12.2.0,
@ -73,6 +74,7 @@ executable svitak
gi-gtk == 4.0.*, gi-gtk == 4.0.*,
gi-webkit == 6.0.*, gi-webkit == 6.0.*,
gi-gio, gi-gio,
gi-gdk4,
haskell-gi-base, haskell-gi-base,
base64-bytestring base64-bytestring