svitak/app/UI.hs

86 lines
2.9 KiB
Haskell

{-# 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 ()