From 935dc795d0245e2718390008f74ca2448c011eb9 Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Mon, 26 Jan 2026 04:30:47 +0000 Subject: [PATCH] Add navigation and proper webkit integration with basic chapter display --- app/EpubParser.hs | 2 +- app/Gui.hs | 53 ++++++++++++++++++++++++----- app/Main.hs | 43 ++++++------------------ app/UI.hs | 86 +++++++++++++++++++++++++++++++++++++++++++++++ svitak.cabal | 4 ++- 5 files changed, 145 insertions(+), 43 deletions(-) create mode 100644 app/UI.hs diff --git a/app/EpubParser.hs b/app/EpubParser.hs index 6884345..177ab73 100644 --- a/app/EpubParser.hs +++ b/app/EpubParser.hs @@ -114,4 +114,4 @@ embedImages arch bdir = map processTag Just entry -> let rawData = B.toStrict $ fromEntry entry b64 = TE.decodeUtf8 $ B64.encode rawData - in "data:" <> getMimeType fullPath <> ";base64," <> b64 + in "data:" <> getMimeType fullPath <> ";base64," <> b64 diff --git a/app/Gui.hs b/app/Gui.hs index 9a62106..ed91ce1 100644 --- a/app/Gui.hs +++ b/app/Gui.hs @@ -1,30 +1,65 @@ {-# LANGUAGE OverloadedStrings, OverloadedLabels #-} -module Gui (runWindow) where +module Gui (runReader) where import qualified GI.Gtk as Gtk import qualified GI.Gio as Gio +import qualified GI.Gdk as Gdk import qualified GI.WebKit as WebKit -import qualified Data.Text as T -runWindow :: String -> IO () -runWindow htmlContent = do +import Data.IORef (newIORef, readIORef, writeIORef) +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") [] _ <- Gtk.on app #activate $ do - window <- Gtk.applicationWindowNew app Gtk.windowSetTitle window (Just "Svitak") - Gtk.windowSetDefaultSize window 800 600 + -- Web View webView <- WebKit.webViewNew - - WebKit.webViewLoadHtml webView (T.pack htmlContent) (Just "file:///") - 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 _ <- Gio.applicationRun app Nothing diff --git a/app/Main.hs b/app/Main.hs index 99bb368..ec552cf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,37 +1,16 @@ -module Main (main) where +module Main where import System.Environment (getArgs) -import Control.Monad.Reader (runReaderT) -import EpubParser (EpubAction, openEpub, resolveSpine, getChapter) -import Gui (runWindow) -import qualified Data.Text as T -import Text.HTML.TagSoup (renderTags) +import EpubParser (openEpub) +import UI (runApp) main :: IO () main = do - args <- getArgs - case args of - [] -> do - putStrLn "Starting GUI..." - runWindow "

Welcome to Svitak

Please input an epub file.

" - - (path:_) -> runSvitak path - -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 "

No chapters found

" - (firstChapter:_) -> do - tags <- getChapter firstChapter - pure $ T.unpack $ renderTags tags - + args <- getArgs + case args of + [path] -> do + result <- openEpub path + case result of + Left err -> putStrLn $ "Error: " ++ err + Right env -> runApp env + _ -> putStrLn "Usage: svitak " diff --git a/app/UI.hs b/app/UI.hs new file mode 100644 index 0000000..892a44b --- /dev/null +++ b/app/UI.hs @@ -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 () diff --git a/svitak.cabal b/svitak.cabal index 81eccf5..05ebcd4 100644 --- a/svitak.cabal +++ b/svitak.cabal @@ -58,7 +58,8 @@ executable svitak main-is: Main.hs other-modules: EpubParser, - Gui + Gui, + UI build-depends: base ^>=4.21.0.0, bytestring >= 0.12.2.0, @@ -73,6 +74,7 @@ executable svitak gi-gtk == 4.0.*, gi-webkit == 6.0.*, gi-gio, + gi-gdk4, haskell-gi-base, base64-bytestring