Add navigation and proper webkit integration with basic chapter display
This commit is contained in:
parent
396a9cdb16
commit
935dc795d0
5 changed files with 144 additions and 42 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
53
app/Gui.hs
53
app/Gui.hs
|
|
@ -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
|
||||||
|
|
|
||||||
43
app/Main.hs
43
app/Main.hs
|
|
@ -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
86
app/UI.hs
Normal 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 ()
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue