diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,15 @@ +CHANGELOG for Haskell Pdf Presenter +======================================== + +0.2.2 + * Fixes to cabal meta-data + * Make sure all version numbers are up to date + * Spell checking and proof reading + +0.2.1 + * Added support for closing files + * Added better time parsing + * Added CHANGELOG + +0.2 + * Initial release diff --git a/HaskellPdfPresenter.glade b/HaskellPdfPresenter.glade new file mode 100644 --- /dev/null +++ b/HaskellPdfPresenter.glade @@ -0,0 +1,1736 @@ + + + + + + False + 5 + True + dialog + Haskell Pdf Presenter + Version 0.2.2 + Copyright 2012-2013, Michael D. Adams + http://michaeldadams.org + http://michaeldadams.org + + + False + vertical + 2 + + + False + end + + + False + True + end + 0 + + + + + True + False + 18 + 5 + 4 + 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + True + False + 0 + Keybindings + + + + + + + 5 + + + + + True + False + 0 + Ctrl-G + + + 1 + 2 + 8 + 9 + + + + + True + False + 0 + Go to slide: + + + 8 + 9 + + + + + True + False + 0 + End + + + 1 + 2 + 7 + 8 + + + + + True + False + 0 + Last slide: + + + 7 + 8 + + + + + True + False + 0 + Home + + + 1 + 2 + 6 + 7 + + + + + True + False + 0 + First slide: + + + 6 + 7 + + + + + True + False + 0 + Backspace, Page up, +Left arrow, Up arrow + + + 1 + 2 + 4 + 6 + + + + + True + False + 0 + Prev slide: + + + 4 + 6 + + + + + True + False + 0 + Space, Enter, Page down, +Right arrow, Down arrow + + + 1 + 2 + 2 + 4 + + + + + True + False + 0 + Toggle overview: + + + 3 + 4 + 12 + 13 + + + + + True + False + 0 + Tab + + + 4 + 5 + 12 + 13 + + + + + True + False + 0 + F, F11, Alt-Enter, Ctrl-L +Escape (exit only) + + + 4 + 5 + 8 + 9 + + + + + True + False + 0 + Ctrl-Q + + + 4 + 5 + 3 + 4 + + + + + True + False + 0 + Toggle fullscreen: + + + 3 + 4 + 7 + 9 + + + + + True + False + 0 + Quit: + + + 3 + 4 + 3 + 4 + + + + + True + False + 0 + Video mute: + + + 3 + 4 + 7 + 8 + + + + + True + False + 0 + B (black), W (white) + + + 4 + 5 + 7 + 8 + + + + + True + False + 0 + Move divider left: + + + 3 + 4 + 14 + 15 + + + + + True + False + 0 + Move divider right: + + + 3 + 4 + 15 + 16 + + + + + True + False + 0 + [, Shift-[ (small adjustments) + + + 4 + 5 + 14 + 15 + + + + + True + False + 0 + ], Shift-] (small adjustments) + + + 4 + 5 + 15 + 16 + + + + + True + False + 0 + Divider to auto-stops: + + + 3 + 4 + 13 + 14 + + + + + True + False + 0 + = + + + 4 + 5 + 13 + 14 + + + + + True + False + 0 + Toggle pause: + + + 12 + 13 + + + + + True + False + 0 + Toggle modes: + + + 14 + 15 + + + + + True + False + 0 + P, Pause + + + 1 + 2 + 12 + 13 + + + + + True + False + 0 + C + + + 1 + 2 + 14 + 15 + + + + + True + False + 0 + Adjustment dialog: + + + 16 + 17 + + + + + True + False + 0 + Ctrl-C + + + 1 + 2 + 16 + 17 + + + + + True + False + 0 + Next slide: + + + 2 + 4 + + + + + True + False + 0 + Slide control + + + + + + 1 + 2 + + + + + True + False + 0 + Presenter view + + + + + + 3 + 4 + 11 + 12 + + + + + True + False + 0 + Reload file: + + + 3 + 4 + 5 + 6 + + + + + True + False + 0 + Ctrl-R + + + 4 + 5 + 5 + 6 + + + + + True + False + 0 + Open file: + + + 3 + 4 + 4 + 5 + + + + + True + False + 0 + Ctrl-O + + + 4 + 5 + 4 + 5 + + + + + True + False + 0 + Help: + + + 3 + 4 + 2 + 3 + + + + + True + False + 0 + H, ?, Ctrl-H, Ctrl-? + + + 4 + 5 + 2 + 3 + + + + + True + False + 0 + System commands + + + + + + 3 + 4 + 1 + 2 + + + + + True + False + 0 + Clock/timer control + + + + + + 11 + 12 + + + + + True + False + + + + 2 + 3 + 10 + 11 + + + + + True + False + 0 + Reset timer: + + + 15 + 16 + + + + + True + False + 0 + Shift-C + + + 1 + 2 + 15 + 16 + + + + + True + False + 0 + Slide history: + + + 9 + 10 + + + + + True + False + 0 + Alt-Left arrow, Alt-Right arrow +(w/ Shift = move by 10) + + + 1 + 2 + 9 + 10 + + + + + True + False + 0 + Move windows +beween monitors: + + + 3 + 4 + 9 + 10 + + + + + True + False + 0 + S, Shift-S (reverse) +(w/ Ctrl = move only presenter window) +(w/ Alt = move only audience window) + + + 4 + 5 + 9 + 10 + + + + + True + False + 0 + Toggle stop: + + + 13 + 14 + + + + + True + False + 0 + Shift-P + + + 1 + 2 + 13 + 14 + + + + + True + False + 0 + Close file: + + + 3 + 4 + 6 + 7 + + + + + True + False + 0 + Shift-Q + + + 4 + 5 + 6 + 7 + + + + + False + True + 2 + + + + + + + False + Audience Window - Haskell Pdf Presenter + 600 + 450 + + + + + + 1 + 1 + 1 + 1 + 10 + + + False + 5 + Goto Slide - Haskell Pdf Presenter + True + True + dialog + + + False + vertical + 2 + + + False + end + + + gtk-cancel + True + True + True + True + True + + + False + True + 0 + + + + + gtk-ok + True + True + True + True + True + True + + + False + True + 1 + + + + + False + True + end + 0 + + + + + True + False + 2 + + + True + False + Go to slide (1-1): + + + False + True + 0 + + + + + True + True + • + True + 1 + pageDialogAdjustment + + + False + True + 1 + + + + + False + True + 1 + + + + + + pageDialogCancelButton + pageDialogOkButton + + + + False + Presenter Window - Haskell Pdf Presenter + 800 + 400 + + + True + True + + + True + True + False + False + + + True + True + + + + + + + + + + + + + + True + + + False + + + + + 1 + + + + + + + + + + + + + + True + True + + + + + True + False + 3 + 7 + + + False + False + + + True + False + ☼ + center + + + + + + + + + 1 + 2 + + + + + + + False + False + + + False + ◧ + center + + + + + + + + + 1 + 2 + 1 + 2 + + + + + + + False + False + + + True + False + 0 + + + + + + + + + 1 + 3 + 2 + 3 + + + + + + + False + False + + + True + False + ▮▮ + center + 6 + + + + + + + + + 2 + 3 + + + + + + + False + False + + + True + False + 1 + 1 + + + + + + + + + 6 + 7 + 1 + 3 + + + + + + + 60 + False + + + 5 + 6 + 2 + 3 + + + + + + + 60 + False + + + 3 + 4 + 2 + 3 + + + + + + + False + + + 4 + + + + + + 60 + False + + + 5 + 7 + + + + + + False + False + False + + + 1 + 1 + True + False + False + + + True + False + + + + + + + + + + + + + + True + False + True + + + 1 + False + + + + + + + + + + + + + + 4 + 5 + 3 + + + + + True + False + 1 + 0 + + + 4 + False + False + + + + + 2 + 6 + 1 + 3 + + + + + False + False + + + + + + + False + 5 + Clock Settings - Haskell Pdf Presenter + dialog + + + False + vertical + 2 + + + False + end + + + gtk-cancel + True + True + True + True + True + + + False + True + 0 + + + + + gtk-ok + True + True + True + True + True + True + + + False + True + 1 + + + + + False + True + end + 0 + + + + + True + False + 10 + + + True + False + 5 + + + True + False + 1 + _Elapsed Time: + True + elapsedTimeEntry + True + + + 1 + 2 + + + + + True + True + • + True + 8 + 1 + True + + + 1 + 1 + 2 + + + + + True + False + 1 + _Remaining Time: + True + remainingTimeEntry + True + + + + + True + True + • + True + 8 + 1 + True + + + 1 + + + + + True + False + 1 + S_tart Time: + True + startTimeEntry + True + + + 3 + + + + + + + + True + False + 1 + _Warn Time: + True + warnTimeEntry + True + + + 3 + 1 + + + + + True + False + 1 + E_nd Time: + True + endTimeEntry + True + + + 3 + 2 + + + + + + + + + + + + + + True + True + • + True + 8 + 1 + True + + + 4 + + + + + True + True + • + True + 8 + 1 + True + + + 4 + 1 + + + + + True + True + • + True + 8 + 1 + True + + + 4 + 2 + + + + + True + False + + + + 2 + + + + + False + True + 0 + + + + + True + False + 5 + + + True + False + 1 + Timer Mode: + True + + + + + True + False + 1 + Display Mode: + True + + + 1 + + + + + Re_maining Time (⌛) + False + dummyAction + True + True + False + True + 0 + True + True + + + 1 + 1 + + + + + _12 Hour Clock + False + dummyAction + True + True + False + True + 0 + True + True + remainingTimeRadio + + + 1 + 2 + + + + + + + + E_lapsed Time (⌚) + False + dummyAction + True + True + False + True + 0 + True + True + remainingTimeRadio + + + 2 + 1 + + + + + _24 Hour Clock + False + dummyAction + True + True + False + True + 0 + True + True + remainingTimeRadio + + + 2 + 2 + + + + + True + False + 5 + + + R_unning (▶) + False + dummyAction + True + True + False + True + 0 + True + True + + + False + True + 0 + + + + + _Paused (▮▮) + False + dummyAction + True + True + False + True + 0 + True + True + runningRadio + + + False + True + 1 + + + + + _Stopped (■) + False + dummyAction + True + True + False + True + 0 + True + True + runningRadio + + + False + True + 2 + + + + + 1 + 3 + + + + + False + True + 1 + + + + + False + True + 1 + + + + + + timerDialogCancelButton + timerDialogOkButton + + + + False + + + + + diff --git a/HaskellPdfPresenter.hs b/HaskellPdfPresenter.hs new file mode 100644 --- /dev/null +++ b/HaskellPdfPresenter.hs @@ -0,0 +1,978 @@ +{-# LANGUAGE TemplateHaskell, PatternGuards, TupleSections #-} +import Codec.Compression.Zlib.Raw +import Control.Exception (catch) +import Control.Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Unsafe as BSU +import Data.Char (toLower, isSpace) +import Data.IORef +import Data.List (sort, sortBy, nub) +import qualified Data.Map as Map +import Data.Ord (comparing) +import Data.Time.LocalTime (getCurrentTimeZone, utcToLocalTime) +import Data.Time.Clock (getCurrentTime) +import qualified Data.Time.Format (formatTime) +import Foreign.Ptr (castPtr) +import Graphics.Rendering.Cairo +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Gdk.GC +import Graphics.UI.Gtk.Poppler.Document +import Graphics.UI.Gtk.Poppler.Page +import Language.Haskell.TH (Exp(LitE), Lit(StringL), runIO) +import Language.Haskell.TH.Syntax (addDependentFile) +import System.Console.GetOpt +import System.Directory (canonicalizePath) +import System.Exit (exitSuccess, exitFailure) +import System.FilePath (takeFileName) +import System.Glib +import System.Locale (defaultTimeLocale) +import Text.Printf (printf) + +data TimerState = + Counting Integer{-starting microseconds-} Integer{-ending microseconds-} | + Stopped Bool{-soft pause-} Integer{-elapsed microseconds-} Integer{-remaining microseconds-} +data VideoMuteState = MuteOff | MuteBlack | MuteWhite deriving (Eq) +data ClockState = RemainingTime | ElapsedTime | WallTime12 | WallTime24 + +data State = State +-- Settings that are used only at program initialization + { initSlide :: IORef Int + , initPreviewPercentage :: IORef Int + , initPresenterMonitor :: IORef Int + , initAudienceMonitor :: IORef Int + , initTimerMode :: IORef (TimerState -> IO TimerState) + +-- Settable on command line + , startTime :: IORef Integer{-microseconds-} + , warningTime :: IORef Integer{-microseconds-} + , endTime :: IORef Integer{-microseconds-} + , documentURL :: IORef (Maybe String) + , compression :: IORef Int + +-- Dynamic State + , timer :: IORef TimerState -- 'Maybe' for "dont" display or haven't started counting yet? Or as a seperate flag? + , clock :: IORef ClockState + , videoMute :: IORef VideoMuteState + , fullscreen :: IORef Bool + , mouseTimeout :: IORef Integer + , history :: IORef ([Int]{-back-}, [Int]{-forward-}) + +-- UI State + , builder :: Builder + +-- Render State + , views :: IORef (Map.Map Widget (Int{-width-}, Int{-height-})) + , document :: IORef (Maybe Document) + , pages :: IORef (Map.Map (Int{-page number-}, Int{-width-}, Int{-height-}) + (BSL.ByteString, Int{-width-}, Int{-height-}, Int{-stride-})) + , pageAdjustment :: Adjustment +} + +header = "Haskell Pdf Presenter, version 0.2.2, \nUsage: hpdfp [OPTION...] file" +options = [ + Option "h?" ["help"] (NoArg (const $ putStr (usageInfo header options) >> exitSuccess)) "Display usage message" + , Option "s" ["slide"] (argOption initSlide "slide" maybeRead "INT") "Initial slide number (default 1)" + , Option "t" ["start-time", "starting-time"] (argOption startTime "start-time" parseTime "TIME") + "Start time (default 10:00)" + , Option "w" ["warn-time", "warning-time"] (argOption warningTime "warning-time" parseTime "TIME") + "Warning time (default 5:00)" + , Option "e" ["end-time", "ending-time"] (argOption endTime "end-time" parseTime "TIME") + "End time (default 0:00)" + , Option "f" ["fullscreen"] (setOption fullscreen True) "Start in full screen mode" + , Option "p" ["preview-percentage"] (argOption initPreviewPercentage "preview-percentage" maybeRead "INT") + "Initial preview splitter percentage (default 50)" + , Option "" ["presenter-monitor"] (argOption initPresenterMonitor "presenter-monitor" maybeRead "INT") + "Initial monitor for presenter window (default 0)" + , Option "" ["audience-monitor"] (argOption initAudienceMonitor "audience-monitor" maybeRead "INT") + "Initial monitor for audience window (default 1)" + , Option "" ["video-mute"] (enumOption videoMute "mute" [("black", MuteBlack), ("white", MuteWhite), ("off", MuteOff)] "MODE") + "Initial video mute mode: \"black\", \"white\" or \"off\" (default)" + , Option "" ["clock-mode"] (enumOption clock "clock-mode" [("remaining", RemainingTime), ("elapsed", ElapsedTime), ("12hour", WallTime12), ("24hour", WallTime24)] "MODE") + "Initial clock mode: \"remaining\" (default), \"elapsed\", \"12hour\" or \"24hour\"" + , Option "" ["timer-mode"] (enumOption initTimerMode "timer-mode" ( + map (,startTimer) ["play", "playing", "running", "start", "started"] ++ + map (,pauseTimer) ["pause", "paused"] ++ map (,stopTimer) ["stop", "stopped"]) "MODE") + "Initial timer mode: \"play\", \"pause\" (default) or \"stop\"" + , Option "" ["compression"] (argOption compression "compression" (maybeRead >=> maybeRange 0 9) "[0-9]") + "Cache compression level: 0 is none, 1 is fastest (default), 9 is best" + ] + +---------------- +-- Utils and constants +---------------- + +-- TODO: cleanup +heightFromWidth w = w * 3 `div` 4 +numColumns = 4 +textSize = 60 +mouseTimeoutDelay = 3 * 1000 * 1000 {-microseconds-} +appName = "Haskell Pdf Presenter" + +-- Color constants +red = Color 0xffff 0x0000 0x0000 +purple = Color 0x8888 0x3333 0xffff +white = Color 0xffff 0xffff 0xffff +black = Color 0x0000 0x0000 0x0000 + +incMod x n = (x + 1) `mod` n +decMod x n = (x - 1) `mod` n + +-- Like "read" but returns "Nothing" instead of throwing an exception +maybeRead :: (Read a) => String -> Maybe a +maybeRead str | [(n, "")] <- reads str = Just n + | otherwise = Nothing + +-- Like "Just" but returns "Nothing" if a value is outside a range +maybeRange :: Int -> Int -> Int -> Maybe Int +maybeRange lo hi x | lo <= x && x <= hi = Just x + | otherwise = Nothing + +-- A list of the top level windows +-- NOTE: Order of windows effects which window is on top in fullscreen +mainWindows state = mapM ($ state) [presenterWindow, audienceWindow] +-- mapM (builderGetObject (builder state) castToWindow) [presenterWindow, audienceWindow] +presenterWindow state = builderGetObject (builder state) castToWindow "presenterWindow" +audienceWindow state = builderGetObject (builder state) castToWindow "audienceWindow" + +-- Set an option to a given value when a command line flag is set +setOption opt val = NoArg $ \state -> writeIORef (opt state) val + +-- Set an option based on the argument given to a command line +argOption :: (State -> IORef a) -> String -> (String -> Maybe a) -> String -> ArgDescr (State -> IO ()) +argOption opt name f = ReqArg (\val state -> case f val of + Nothing -> putStrLn ("ERROR: Invalid argument to option \""++name++"\": "++show val) >> + putStr ("\n" ++ usageInfo header options) >> exitFailure + Just val' -> writeIORef (opt state) val') + +-- Set an option from a list of valid option values +enumOption :: (State -> IORef a) -> String -> [(String, a)] -> String -> ArgDescr (State -> IO ()) +enumOption opt name optList = argOption opt name (`lookup` optList) + +---------------- +-- Main Program +---------------- + +main :: IO () +main = do + -- Set initialize application and get program arguments + setApplicationName appName + args <- initGUI + + -- Initialize shared state + state <- return State + `ap` newIORef 1 {-init slide-} + `ap` newIORef 50 {-init preview percentage-} + `ap` newIORef 0 {-init presenter monitor-} + `ap` newIORef 1 {-init audience monitor-} + `ap` newIORef pauseTimer + + `ap` newIORef (10 * 60 * 1000 * 1000) {-startTime-} + `ap` newIORef (5 * 60 * 1000 * 1000) {-warningTime-} + `ap` newIORef (0 * 60 * 1000 * 1000) {-20 * 60 * 1000 * 1000-} {-endTime-} + `ap` newIORef Nothing {-file uri-} + `ap` newIORef 1 {-compression-} + + `ap` newIORef (error "internal error: undefined timer state") + `ap` newIORef RemainingTime + `ap` newIORef MuteOff {-videoMute-} + `ap` newIORef False {-fullscreen-} + `ap` newIORef 0 {-mouseTimeout-} + `ap` newIORef ([], []) {-history-} + + `ap` builderNew + + `ap` newIORef Map.empty {-views-} + `ap` newIORef Nothing {-document-} + `ap` newIORef Map.empty {-pages-} + `ap` adjustmentNew 0 0 0 1 10 1 {-pageAdjustment-} + + -- Parse command line options and call guiMain + case getOpt Permute options args of + (opts, [], []) -> mapM_ ($ state) opts >> guiMain state + (opts, [file], []) -> do + mapM_ ($ state) opts + file' <- canonicalizePath file + postGUIAsync (void $ openDoc state ("file://"++file')) + guiMain state + (_, [_,_], []) -> putStrLn "Error: Multiple files on command line" >> putStr (usageInfo header options) + (_, _, errors) -> putStrLn (concat errors) >> putStr (usageInfo header options) + +guiMain :: State -> IO () +guiMain state = do + -- Load and setup the GUI + builderAddFromString (builder state) + $(let f = "HaskellPdfPresenter.glade" in addDependentFile f >> liftM (LitE . StringL) (runIO $ readFile f)) + + -- Finish setting up the state and configure gui to match state + pageAdjustment state `set` [adjustmentUpper :=> liftM fromIntegral (readIORef (initSlide state)), + adjustmentValue :=> liftM fromIntegral (readIORef (initSlide state))] + modifyTimerState state (const $ liftM (Stopped True 0) (readIORef (startTime state))) + modifyTimerState state =<< readIORef (initTimerMode state) + modifyVideoMute state return + + -- Connect the widgets to their events + -- * Audience Window + do window <- audienceWindow state + view <- makeView state id (postDrawVideoMute state) + window `containerAdd` view + + -- * Presenter window + -- ** Views + -- *** Previews + do paned <- builderGetObject (builder state) castToPaned "preview.paned" + view1 <- makeView state id postDrawNone + view2 <- makeView state (+1) postDrawNone + panedPack1 paned view1 True True + panedPack2 paned view2 True True + + -- *** Thumbnails + do oldWidth <- newIORef 0 + layout <- builderGetObject (builder state) castToLayout "thumbnails.layout" + layout `onSizeAllocate` (\(Graphics.UI.Gtk.Rectangle _ _ newWidth _) -> do + oldWidth' <- readIORef oldWidth + writeIORef oldWidth newWidth + when (oldWidth' /= newWidth) $ recomputeThumbnails state newWidth) + pageAdjustment state `onAdjChanged` (readIORef oldWidth >>= recomputeThumbnails state) + + -- Set a handler that scrolls to keep the current slide visible + adjustment <- scrolledWindowGetVAdjustment =<< + builderGetObject (builder state) castToScrolledWindow "thumbnails.scrolled" + let update = do p <- liftM round $ pageAdjustment state `get` adjustmentValue + let row = (p-1) `div` numColumns + height <- liftM (heightFromWidth . (`div` numColumns)) $ readIORef oldWidth + adjustmentClampPage adjustment (fromIntegral $ row*height) (fromIntegral $ row*height+height) + pageAdjustment state `onValueChanged` update + pageAdjustment state `onAdjChanged` update + + -- ** Meta-data + -- *** Current time + do eventBox <- builderGetObject (builder state) castToEventBox "timeEventBox" + eventBox `on` buttonPressEvent $ tryEvent $ + do DoubleClick <- eventClick; liftIO $ timerDialog state + timeoutAdd (displayTime state >> return True) 100{-milliseconds-} + -- ^ Really this should be run on redraw, but because the + -- computation triggers more redraws, we have it here. This + -- may result in a 1/10 second lag before the label resizes. + + -- *** Current slide number + do eventBox <- builderGetObject (builder state) castToEventBox "slideEventBox" + eventBox `on` buttonPressEvent $ tryEvent $ + do DoubleClick <- eventClick; liftIO $ gotoSlideDialog state + slideNum <- builderGetObject (builder state) castToLabel "slideLabel" + let update = do p <- liftM round $ pageAdjustment state `get` adjustmentValue + n <- liftM round $ pageAdjustment state `get` adjustmentUpper + l <- liftM round $ pageAdjustment state `get` adjustmentLower + slideNum `set` [ + labelText := if (l :: Integer) == 0 then "" else show (p :: Integer) ++ "/" ++ show (n :: Integer), + labelAttributes := [AttrSize 0 (negate 1) textSize, -- TODO: we have to do this to get the right font??? + AttrForeground 0 (negate 1) white]] + pageAdjustment state `onValueChanged` update + pageAdjustment state `onAdjChanged` update + + -- Setup the top-level windows + do let setupWindow window = do + -- Make the window fullscreen if needed + f <- readIORef (fullscreen state) + when f $ windowFullscreen window + -- Make background black + widgetModifyBg window StateNormal (Color 0 0 0) + -- Add event handlers + window `onDestroy` mainQuit + window `on` keyPressEvent $ do + mods <- eventModifier + name <- eventKeyName + b <- liftIO $ handleKey state mods (map toLower name) + liftIO $ mapM_ widgetQueueDraw =<< mainWindows state + return b + -- Redraw the window when we switch slides. Most (though not all) + -- of it needs to be redrawn so we redraw the entire window. + pageAdjustment state `onValueChanged` widgetQueueDraw window + pageAdjustment state `onAdjChanged` widgetQueueDraw window + -- Show the window + widgetShowAll window + mapM_ setupWindow =<< mainWindows state + + -- * Put windows on correct monitors + join $ return moveWindow `ap` presenterWindow state `ap` readIORef (initPresenterMonitor state) + join $ return moveWindow `ap` audienceWindow state `ap` readIORef (initAudienceMonitor state) + + -- * Adjust the preview splitter (must be done after windows are shown) + do paned <- builderGetObject (builder state) castToPaned "preview.paned" + maxPos <- paned `get` panedMaxPosition + percentage <- readIORef (initPreviewPercentage state) + paned `set` [panedPosition := maxPos * percentage `div` 100] + + -- * Setup about dialog + do dialog <- builderGetObject (builder state) castToAboutDialog "aboutDialog" + dialog `on` response $ const $ widgetHideAll dialog + dialog `on` deleteEvent $ liftIO (widgetHideAll dialog) >> return True + + -- * Make sure the screen saver doesn't start by moving the cursor. + -- Since we move the mouse by zero pixels, this shouldn't effect the user. + -- Also set up the handler for hiding the mouse after a delay. + do w <- audienceWindow state + dw <- widgetGetDrawWindow w + blankCursor <- cursorNew BlankCursor + timeoutAdd (do -- Move the cursor by zero pixels + display <- screenGetDisplay =<< windowGetScreen w + (screen, _, x, y) <- displayGetPointer display + displayWarpPointer display screen x y + -- Hide the mouse if needed. + mouseTimeout' <- readIORef (mouseTimeout state) + currTime <- getMicroseconds + fullscreen' <- readIORef (fullscreen state) + when (fullscreen' && currTime > mouseTimeout') $ + dw `drawWindowSetCursor` Just blankCursor + return True) (5000{-milliseconds-}) + w `widgetAddEvents` [PointerMotionMask] + oldCoordRef <- newIORef (0, 0) + let update = do dw `drawWindowSetCursor` Nothing + writeIORef (mouseTimeout state) =<< liftM (+ mouseTimeoutDelay) getMicroseconds + w `on` enterNotifyEvent $ liftIO update >> return False + -- Reset the timeout if the user moves the mouse + w `on` motionNotifyEvent $ do + coord <- eventRootCoordinates + oldCoord <- liftIO $ readIORef oldCoordRef + liftIO $ writeIORef oldCoordRef coord + when (oldCoord /= coord) $ liftIO update + return False + + -- Schedule rendering, and start main loop + startRenderThread state =<< builderGetObject (builder state) castToProgressBar "renderingProgressbar" + mainGUI + +-- Recompute thumbnails when sizes need to change +recomputeThumbnails state newWidth = do + layout <- builderGetObject (builder state) castToLayout "thumbnails.layout" + -- Remove the old thumbnails + containerForeach layout (containerRemove layout) + -- Figure out how big the thumbnails and thumbnail panel should be + numPages <- pageAdjustment state `get` adjustmentUpper + let width = newWidth `div` numColumns + height = heightFromWidth width + numRows = round numPages `div` numColumns + 1 + layoutSetSize layout newWidth (height*numRows) + -- Add thumbnails for the new sizes + sequence_ [ do + let page = numColumns*row+col+1 + view <- makeView state (const page) (postDrawBorder page state) + widgetSetSizeRequest view width height + layoutPut layout view (col*width) (row*height) + view `widgetAddEvents` [ButtonPressMask, ButtonReleaseMask] + view `on` buttonReleaseEvent $ tryEvent $ liftIO $ gotoPage state (const page) + --view `set` [widgetTooltipText := Just ("Slide " ++ show page)] -- TODO: this triggers a bug where window drawing does not update + | row <- [0..numRows-1], col <- [0..numColumns-1]] + widgetShowAll layout + +-- Apply "f" to the current page number +gotoPage state f = do + oldPage <- liftM round $ pageAdjustment state `get` adjustmentValue + pageAdjustment state `set` [adjustmentValue := fromIntegral ((f :: Int -> Int) oldPage)] + newPage <- liftM round $ pageAdjustment state `get` adjustmentValue + -- Update the history if needed + when (oldPage /= newPage) $ do + (back, _) <- readIORef (history state) + writeIORef (history state) (oldPage : back, []) + +------------------------ +-- User Event handling +------------------------ + +-- Handler for key presses from the user +handleKey :: State -> [Modifier] -> String -> IO Bool +handleKey state [Control] "q" = mainQuit >> return True +handleKey state _ "h" = builderGetObject (builder state) castToAboutDialog "aboutDialog" >>= widgetShowAll >> return True +handleKey state _ "question" = builderGetObject (builder state) castToAboutDialog "aboutDialog" >>= widgetShowAll >> return True + +-- Switching slides +handleKey state [] key | key `elem` ["left", "up", "page_up", "backspace"] = + gotoPage state (+(-1)) >> modifyTimerState state unpauseTimer >> return True +handleKey state [] key | key `elem` ["right", "down", "page_down", "right", "space", "return"] = + gotoPage state (+1) >> modifyTimerState state unpauseTimer >> return True +handleKey state [Shift] key | key `elem` ["left", "up", "page_up", "backspace"] = + gotoPage state (+(-10)) >> modifyTimerState state unpauseTimer >> return True +handleKey state [Shift] key | key `elem` ["right", "down", "page_down", "right", "space", "return"] = + gotoPage state (+10) >> modifyTimerState state unpauseTimer >> return True +handleKey state [] "home" = gotoPage state (const 0) >> return True +handleKey state [] "end" = + do p <- pageAdjustment state `get` adjustmentUpper; gotoPage state (const (round p)); return True +handleKey state [Control] "g" = gotoSlideDialog state >> return True +handleKey state [Alt] "left" = historyBack state >> return True +handleKey state [] "xf86back" = historyBack state >> return True +handleKey state [Alt] "right" = historyForward state >> return True +handleKey state [] "xf86forward" = historyForward state >> return True + +-- Clock/timer control +handleKey state [] "p" = modifyTimerState state togglePauseTimer >> return True +handleKey state [Shift] "p" = modifyTimerState state toggleStopTimer >> return True +handleKey state [Control] "p" = modifyTimerState state toggleStopTimer >> return True +handleKey state [] "pause" = modifyTimerState state togglePauseTimer >> return True +handleKey state [] "c" = modifyClockState state (\c -> case c of + RemainingTime -> ElapsedTime + ElapsedTime -> WallTime12 + WallTime12 -> WallTime24 + WallTime24 -> RemainingTime) >> return True +handleKey state [Shift] "c" = modifyTimerState state (const $ liftM (Stopped True 0) (readIORef (startTime state))) >> return True +handleKey state [Control] "c" = timerDialog state >> return True + +-- Video mute +handleKey state [] "b" = modifyVideoMute state (\b -> return $ if b == MuteBlack then MuteOff else MuteBlack) >> return True +handleKey state [] "w" = modifyVideoMute state (\b -> return $ if b == MuteWhite then MuteOff else MuteWhite) >> return True + +-- Presenter screen +handleKey state [] "tab" = + builderGetObject (builder state) castToNotebook "presenter.notebook" >>= + (`set` [notebookCurrentPage :~ (`mod` 2) . (+ 1)]) >> return True +handleKey state [] "bracketleft" = + builderGetObject (builder state) castToPaned "preview.paned" >>= (`set` [panedPosition :~ max 0 . (+(-20))]) >> return True +handleKey state [] "bracketright" = + builderGetObject (builder state) castToPaned "preview.paned" >>= (`set` [panedPosition :~ (+20)]) >> return True +handleKey state [Shift] "braceleft" = + builderGetObject (builder state) castToPaned "preview.paned" >>= (`set` [panedPosition :~ max 0 . (+(-1))]) >> return True +handleKey state [Shift] "braceright" = + builderGetObject (builder state) castToPaned "preview.paned" >>= (`set` [panedPosition :~ (+1)]) >> return True +handleKey state [] "equal" = panedStops state >> return True + +-- Files +handleKey state [Shift] "q" = setDocument state makeTitle 0 0 Nothing Nothing where + makeTitle t = t ++ " Window - " ++ appName +handleKey state [Control] "r" = readIORef (documentURL state) >>= + maybe (errorDialog "Cannot open file: No file selected" >> return False) (openDoc state) >> return True +handleKey state [Control] "o" = openFileDialog state >> return True + +-- Window control +handleKey state [] "escape" = do f <- readIORef (fullscreen state); when f (toggleFullScreen state); return True +handleKey state [] "f" = toggleFullScreen state >> return True +handleKey state [] "f11" = toggleFullScreen state >> return True +handleKey state [Alt] "return" = toggleFullScreen state >> return True +handleKey state [Control] "l" = toggleFullScreen state >> return True +handleKey state [] "s" = changeMonitors state f where + f mP mA n = if mA `incMod` n == mP then (mP `incMod` n, mP `incMod` n) else (mP, mA `incMod` n) +handleKey state [Shift] "s" = changeMonitors state f where + f mP mA n = if mA == mP then (mP `decMod` n, mP `decMod` n `decMod` n) else (mP, mA `decMod` n) +handleKey state [Control] "s" = changeMonitors state f where f mP mA n = (mP `incMod` n, mA) +handleKey state [Shift,Control] "s" = changeMonitors state f where f mP mA n = (mP `decMod` n, mA) +handleKey state [Alt] "s" = changeMonitors state f where f mP mA n = (mP, mA `incMod` n) +handleKey state [Shift,Alt] "s" = changeMonitors state f where f mP mA n = (mP, mA `decMod` n) + +handleKey _ _ name | name `elem` [ -- Ignore modifier keys + "shift_l", "shift_r", "control_l", "control_r", "alt_l", "alt_r", + "super_l", "super_r", "caps_lock", "menu", "xf86wakeup"] + = return True +handleKey state mods name = putStrLn ("Unknown key \""++name++"\" with mods "++show mods) >> return False + +-- Move back one slide in the history +historyBack state = do + (back, forward) <- readIORef (history state) + currPage <- liftM round $ pageAdjustment state `get` adjustmentValue + case back of + [] -> return () + prevPage : back -> do pageAdjustment state `set` [adjustmentValue := fromIntegral prevPage] + writeIORef (history state) (back, currPage : forward) + +-- Move forward one slide in the history +historyForward state = do + (back, forward) <- readIORef (history state) + currPage <- liftM round $ pageAdjustment state `get` adjustmentValue + case forward of + [] -> return () + nextPage : forward -> do pageAdjustment state `set` [adjustmentValue := fromIntegral nextPage] + writeIORef (history state) (currPage : back, forward) + +-- Toggle whether we are in fullscreen mode +toggleFullScreen state = do + f <- readIORef (fullscreen state) + mapM_ (if f then windowUnfullscreen else windowFullscreen) =<< mainWindows state + writeIORef (fullscreen state) $ not f + +-- Move the divider on the preview window to the next logical division point. +-- These points are: +-- - All the way to the left +-- - Perfectly fit the right preview +-- - 1/3 of the way from the left +-- - Centered +-- - 1/3 of the way from the right +-- - Perfectly fit the left preview +-- - All the way to the right +panedStops state = do + -- Get the current position and size of the divider + paned <- builderGetObject (builder state) castToPaned "preview.paned" + maxPos <- liftM fromIntegral $ paned `get` panedMaxPosition + oldPos <- liftM fromIntegral $ paned `get` panedPosition + (_, panedHeight) <- widgetGetSize paned + -- Get the page number of the current and last pages + p <- liftM round $ pageAdjustment state `get` adjustmentValue + pLast <- liftM round $ pageAdjustment state `get` adjustmentUpper + -- Compute where do divide to get perfect fits and store them in "stops" + document <- readIORef (document state) + stops <- case document of + Nothing -> return [] -- If there is no document, then there are no stops + Just document -> do + (pageWidth1, pageHeight1) <- pageGetSize =<< documentGetPage document (p - 1) + (pageWidth2, pageHeight2) <- pageGetSize =<< documentGetPage document (p `min` pLast - 1) + return [round (fromIntegral panedHeight * pageWidth1 / pageHeight1), + maxPos - round (fromIntegral panedHeight * pageWidth2 / pageHeight2)] + -- Store the other divisions in stops' + let stops' = [maxPos `div` 3, maxPos `div` 2, maxPos * 2 `div` 3, maxPos] + -- Move to the next stop greater than the current stop. + paned `set` [panedPosition := case sort $ filter (> oldPos) $ stops ++ stops' of + [] -> 0 -- If no more stops, go fully left + (x:_) -> x] + +-- Move the windows between the available monitors according to the +-- provided f function. For forwards movement, the order is that we +-- always move the audience view first, but if the audience view would +-- move to the same monitor as the presenter view then we advance the +-- presenter view and also move the audience view to that monitor. +changeMonitors state f = do + wP <- presenterWindow state + wA <- audienceWindow state + screenP <- wP `get` windowScreen + screenA <- wA `get` windowScreen + if screenP /= screenA + then do errorDialog ("Cannot move windows as the presenter and audience windows are on different screens.\n\n"++ + "Contact the developer if you want support for this.") + return True + else do + dwP <- widgetGetDrawWindow wP + dwA <- widgetGetDrawWindow wA + mP <- screenGetMonitorAtWindow screenP dwP + mA <- screenGetMonitorAtWindow screenA dwA + -- There are render glitches if we move the windows while in full screen + -- so we have to move out of full screen before moving. + -- It would be nice if we could move back into full screen after moving + -- but that also triggers render errors. I don't know why. + readIORef (fullscreen state) >>= flip when (toggleFullScreen state) + n <- screenGetNMonitors screenP + let (mP', mA') = f mP mA n + moveWindow wP mP' + moveWindow wA mA' + return True + +-- Move a window to a given monitor (mod the number of monitors) if it is not already there +moveWindow w m = do + screen <- w `get` windowScreen + dw <- widgetGetDrawWindow w + m' <- screenGetMonitorAtWindow screen dw + n <- screenGetNMonitors screen + when (m' /= m `mod` n) $ do + Rectangle x y _ _ <- screenGetMonitorGeometry screen (m `mod` n) + windowMove w x y + +---------------- +-- Dialogs +---------------- + +timerDialog state = do + -- Get dialog and text fields from GUI builder + dialog <- builderGetObject (builder state) castToDialog "timerDialog" + [remainingTimeEntry, elapsedTimeEntry, startTimeEntry, warningTimeEntry, endTimeEntry] <- + mapM (builderGetObject (builder state) castToEntry) + ["remainingTimeEntry", "elapsedTimeEntry", "startTimeEntry", "warnTimeEntry", "endTimeEntry"] + [running, paused, stopped] <- + mapM (builderGetObject (builder state) castToRadioButton) ["runningRadio", "pausedRadio", "stoppedRadio"] + [remainingTimeRadio, elapsedTimeRadio, h12ClockRadio, h24ClockRadio] <- + mapM (builderGetObject (builder state) castToRadioButton) + ["remainingTimeRadio", "elapsedTimeRadio", "12HourClockRadio", "24HourClockRadio"] + + -- Populate the GUI elements based on the state + clock' <- readIORef (clock state) + (case clock' of RemainingTime -> remainingTimeRadio; ElapsedTime -> elapsedTimeRadio; + WallTime12 -> h12ClockRadio; WallTime24 -> h24ClockRadio) `set` [toggleButtonActive := True] + + timer' <- readIORef (timer state) + (case timer' of Stopped False _ _ -> stopped; Stopped True _ _ -> paused; + Counting {} -> running) `set` [toggleButtonActive := True] + + Stopped True timeElapsed timeRemaining <- pauseTimer =<< readIORef (timer state) + -- ^ Get the amount of time remaining, don't actually pause anything + remainingTimeEntry `set` [entryText := formatTime timeRemaining] + elapsedTimeEntry `set` [entryText := formatTime (timeElapsed+1000*1000-1{-microseconds-})] + -- ^ Compensate for rounding to we keep elapsed + remaining = total + + startTimeEntry `set` [entryText :=> liftM formatTime (readIORef (startTime state))] + warningTimeEntry `set` [entryText :=> liftM formatTime (readIORef (warningTime state))] + endTimeEntry `set` [entryText :=> liftM formatTime (readIORef (endTime state))] + + -- Set the default keyboard focus and display the dialog + widgetGrabFocus remainingTimeEntry + loopDialog dialog $ do -- NOTE: The "do" block runs when the user clicks "Okay" + -- Get the values of the test fields + [remainingTime'', elapsedTime'', startTime'', warningTime'', endTime''] <- + mapM (`get` entryText) [remainingTimeEntry, elapsedTimeEntry, startTimeEntry, warningTimeEntry, endTimeEntry] + -- Parse the time fields and report errors if needed + case (parseTime remainingTime'', parseTime elapsedTime'', parseTime startTime'', + parseTime warningTime'', parseTime endTime'') of + (Nothing, _, _, _, _) -> errorDialog ("Error parsing remaining time: "++remainingTime'') >> return False + (_, Nothing, _, _, _) -> errorDialog ("Error parsing elapsed time: "++elapsedTime'') >> return False + (_, _, Nothing, _, _) -> errorDialog ("Error parsing start time: "++startTime'') >> return False + (_, _, _, Nothing, _) -> errorDialog ("Error parsing warning time: "++warningTime'') >> return False + (_, _, _, _, Nothing) -> errorDialog ("Error parsing end time: "++warningTime'') >> return False + (Just remain, Just elapsed, Just start, Just warn, Just end) -> do + -- Save the parsed time value to the state + writeIORef (startTime state) start + writeIORef (warningTime state) warn + writeIORef (endTime state) end + -- Set the timer state based the selected radio button + do [r,p,s] <- mapM (`get` toggleButtonActive) [running, paused, stopped] + when r $ modifyTimerState state (const $ return $ Stopped True elapsed remain) >> + modifyTimerState state startTimer + when p $ modifyTimerState state (const $ return $ Stopped True elapsed remain) + when s $ modifyTimerState state (const $ return $ Stopped False elapsed remain) + -- Set the clock mode based on the selected radio button + do [r,e,h12,h24] <- mapM (`get` toggleButtonActive) [ + remainingTimeRadio, elapsedTimeRadio, h12ClockRadio, h24ClockRadio] + modifyClockState state (const $ if r then RemainingTime + else if e then ElapsedTime + else if h12 then WallTime12 + else if h24 then WallTime24 + else error "INTERNAL ERROR: No clock radio active") + return True + -- Close the dialog + widgetHide dialog + +gotoSlideDialog state = do + -- Get dialog and text fields from GUI builder + dialog <- builderGetObject (builder state) castToDialog "pageDialog" + entry <- builderGetObject (builder state) castToSpinButton "pageDialogSpinButton" + adjustment <- builderGetObject (builder state) castToAdjustment "pageDialogAdjustment" + label <- builderGetObject (builder state) castToLabel "pageDialogLabel" + + -- Set the dialog spinner and label to correspond to the current and max page number of the document + pageNum <- pageAdjustment state `get` adjustmentValue + pageMax <- pageAdjustment state `get` adjustmentUpper + adjustment `set` [adjustmentValue := pageNum, adjustmentUpper := pageMax] + label `set` [labelText := "Go to slide (1-" ++ show (round pageMax :: Integer) ++ "):"] + + -- Show the dialog + widgetShowAll dialog + widgetGrabFocus entry + r <- dialogRun dialog + + -- When the dialog closes, get the spinner value and set the current page + value <- entry `get` spinButtonValue + when (r == ResponseOk) $ gotoPage state (const (round value)) + widgetHide dialog + +-- Open and run a modal file selection dialog and set load the PDF document that is selected. +openFileDialog state = do + dialog <- fileChooserDialogNew (Just $ "Open - " ++ appName) Nothing FileChooserActionOpen + [(stockOpen, ResponseOk), (stockCancel, ResponseCancel)] + maybe (return ()) (void . fileChooserSetURI dialog) =<< readIORef (documentURL state) + loopDialog dialog (openDoc state . head =<< fileChooserGetURIs dialog) + widgetDestroy dialog + return True + +-- Set the video mute state and the text of the video mute status label +modifyVideoMute state f = do + mute <- f =<< readIORef (videoMute state) + builderGetObject (builder state) castToLabel "videoMuteStatusLabel" >>= (`set` case mute of + MuteOff -> [labelText := "\x2600", -- U+2600 = Black sun with rays (solid center) + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) black]] + MuteWhite -> [labelText := "\x2600", -- U+2600 = Black sun with rays (solid center) + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) white]] + MuteBlack -> [labelText := "\x263C", -- U+263C = White sun with rays (hollow center) + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) white]]) + writeIORef (videoMute state) mute + +-- Open and run a modal error dialog with a textual message. +errorDialog msg = do + dialog <- messageDialogNew Nothing [DialogModal, DialogDestroyWithParent] MessageError ButtonsClose msg + dialogRun dialog + widgetDestroy dialog + +-- Keep running a dialog until the user clicks "Okay" and "m" returns "True" +loopDialog d m = do + r <- dialogRun d + when (r == ResponseOk) $ do + m' <- m + unless m' $ loopDialog d m + +------------------------ +-- Views +------------------------ + +-- Make a widget that displays a slide. +-- - offset: computes the slide to display from the current slide number +-- - postDraw: extra drawing that should be done at the end +makeView :: State -> (Int -> Int) -> (DrawWindow -> GC -> DrawingArea -> EventM EExpose ()) -> IO DrawingArea +makeView state offset postDraw = do + area <- drawingAreaNew + widgetModifyBg area StateNormal black + area `on` exposeEvent $ tryEvent $ drawView state offset postDraw area + area `on` sizeAllocate $ \(Graphics.UI.Gtk.Rectangle _ _ width height) -> + liftIO $ modifyIORef (views state) (Map.insert (castToWidget area) (width, height)) + area `on` unrealize $ + liftIO $ modifyIORef (views state) (Map.delete (castToWidget area)) + return area + +-- Event handler for drawing a view +-- - offset: computes the slide to display from the current slide number +-- - postDraw: extra drawing that should be done at the end +-- - area: the widget that needs to be redrawn +drawView state offset postDraw area = do + -- Get the maximum and current slide number + n <- liftIO $ liftM round $ pageAdjustment state `get` adjustmentUpper + p <- liftIO $ liftM (offset . round) $ pageAdjustment state `get` adjustmentValue + -- Don't render if not in range. Needed b/c the preview panel may + -- go out of range when on the last slide. + when (p <= n && p >= 1) $ do + drawWindow <- eventWindow + (w, h) <- liftIO $ widgetGetSize area + cache' <- liftIO $ readIORef (pages state) + gc <- liftIO $ gcNew drawWindow + case Map.lookup (p, w, h) cache' of + -- If we haven't rendered the slide yet, then use placeholder text + Nothing -> do + pc <- liftIO $ widgetGetPangoContext area + doc <- liftIO $ readIORef (document state) + layout <- liftIO $ layoutText pc $ case doc of + Nothing -> "" -- No document so no text needed + Just _ -> "Rendering slide "++show p++" of "++show n++"..." + liftIO $ layoutSetAttributes layout [AttrForeground 0 (negate 1) white, + AttrWeight 0 (negate 1) WeightBold, + AttrSize 0 (negate 1) 24] + liftIO $ drawLayout drawWindow gc 0 0 layout + return () + -- If we have already rendered the slide, then uncompress and draw the data + Just (pixels, width', height', stride) -> do + (width, height) <- liftIO $ drawableGetSize drawWindow + liftIO $ BSU.unsafeUseAsCString + (BS.concat (BSL.toChunks (decompressWith (defaultDecompressParams { decompressBufferSize = height' * stride }) pixels))) + (\pixelPtr -> + withImageSurfaceForData (castPtr pixelPtr) FormatRGB24 width' height' stride (\surface -> + renderWithDrawable drawWindow $ do + translate (fromIntegral $ (width - width') `div` 2) (fromIntegral $ (height - height') `div` 2) + setSourceSurface surface 0 0 + paint)) + return () + postDraw drawWindow gc area + +-- The following functions are postDraw functions to be passed to drawView + +-- No extra drawing to be done (used by preview views) +postDrawNone _ _ _ = return () + +-- Draw a border if the current slide is the shown slide (used by thumbnails) +postDrawBorder p state drawWindow gc area = do + p' <- liftIO $ liftM round $ pageAdjustment state `get` adjustmentValue + when (p == p') $ liftIO $ do + color <- widgetGetStyle area >>= flip styleGetBackground StateSelected + gcGetValues gc >>= \v -> gcSetValues gc (v { foreground = color, lineWidth = 6 }) + (width, height) <- drawableGetSize drawWindow + drawRectangle drawWindow gc False 0 0 width height + +-- Draw a blank screen if video mute is enabled (used by audience view) +postDrawVideoMute state drawWindow _gc _area = do + videoMute' <- liftIO $ readIORef (videoMute state) + case videoMute' of + MuteOff -> return () + MuteBlack -> liftIO $ renderWithDrawable drawWindow (setSourceRGB 0.0 0.0 0.0 >> paint) + MuteWhite -> liftIO $ renderWithDrawable drawWindow (setSourceRGB 1.0 1.0 1.0 >> paint) + --MuteFreeze n -> drawView state (const n) postDrawNone area + +------------------------ +-- Clock/timer rendering and control +------------------------ + +-- Set the clock mode (e.g., 12 vs 24 hour) +modifyClockState state f = modifyIORef (clock state) f >> displayTime state + +-- Functions that are used as parameter to modifyTimerState +startTimer (Counting start end) = return (Counting start end) +startTimer (Stopped _ elapsed remaining) = getMicroseconds >>= \t -> return (Counting (t-elapsed) (t+remaining)) + +pauseTimer (Counting start end) = getMicroseconds >>= \t -> return (Stopped True (t-start) (end-t)) +pauseTimer (Stopped _ elapsed remaining) = return (Stopped True elapsed remaining) + +stopTimer (Counting start end) = getMicroseconds >>= \t -> return (Stopped False (t-start) (end-t)) +stopTimer (Stopped _ elapsed remaining) = return (Stopped False elapsed remaining) + +unpauseTimer (Stopped False elapsed remaining) = return (Stopped False elapsed remaining) +unpauseTimer t = startTimer t + +togglePauseTimer t@(Stopped True _ _) = startTimer t +togglePauseTimer t = pauseTimer t + +toggleStopTimer t@(Stopped False _ _) = startTimer t +toggleStopTimer t = stopTimer t + +-- Modifies the current timer state. "f" should be one of 'startTimer', etc. +modifyTimerState state f = do + timerState <- f =<< readIORef (timer state) + builderGetObject (builder state) castToLabel "timerStatusLabel" >>= (`set` case timerState of + Stopped True _ _ -> [labelText := "\x25AE\x25AE", -- U+25AE = One bar of pause icon + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) white]] + Stopped False _ _ -> [labelText := "\x25A0", -- U+25A0 = Stop + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) white]] + Counting _ _ -> [labelText := "\x25B6", -- U+25B6 = Play + labelAttributes := [AttrSize 0 (negate 1) 30, AttrForeground 0 (negate 1) black]]) + writeIORef (timer state) timerState + +-- Render the clock/timer +displayTime state = do + -- Compute foreground and background colors based on timer status and times + timer' <- readIORef (timer state) + (elapsed, remaining) <- case timer' of + Stopped _ elapsed remaining -> return (elapsed, remaining) + Counting start end -> getMicroseconds >>= \t -> return (t - start, end - t) + warningTime' <- readIORef (warningTime state) + endTime' <- readIORef (endTime state) + let (fg_color, bg_color) | remaining < endTime' = (white, red) + | remaining < warningTime' = (white, purple) + | otherwise = (white, black) + + -- Get time string based on clock mode + clockMode <- readIORef (clock state) + let clockStr = case clockMode of + RemainingTime -> " \x231B" -- U+231B = Hour glass + ElapsedTime -> " \x231A" -- U+231A = Wall clock + WallTime12 -> "" + WallTime24 -> " (24H)" + time <- case clockMode of + RemainingTime -> return (formatTime remaining) + ElapsedTime -> return (formatTime elapsed) + WallTime12 -> getTime "%I:%M %p" + WallTime24 -> getTime "%H:%M" + + -- Function for setting the text of a label at a given size + let setLabel attrSize size label = label `set` [ + labelText := time++clockStr, + labelAttributes := [attrSize 0 (length time) size, -- The first text is at full size + attrSize (length time) (negate 1) (size / 2), -- The second test is at half size + AttrForeground 0 (negate 1) fg_color, + AttrBackground 0 (negate 1) bg_color]] + + -- Set the hidden label so we maintain a minimum size + setLabel AttrSize textSize =<< builderGetObject (builder state) castToLabel "hiddenTimeLabel" + -- TODO: Why is AttrSize a different font than what the GUI builder makes? + + -- Initially set the size based on height + label <- builderGetObject (builder state) castToLabel "timeLabel" + (w, h) <- widgetGetSize label + setLabel AttrAbsSize (fromIntegral h) label + + -- Then rescale the text to ensure it is not too wide + (_, PangoRectangle _ _ iw _) <- layoutGetExtents =<< labelGetLayout label + setLabel AttrAbsSize (fromIntegral (h `min` (h * w `div` round iw))) label + +------------------------ +-- Time formatting +------------------------ + +-- Parse time entered by the user. +-- The accepted format is "-* ((float :)? float :)? float" but whitespace is allowed anywhere. +-- I'd really prefer to use standard code for this, but I couldn't find any +parseTime :: String -> Maybe Integer{-microseconds-} +parseTime str = go (filter (not . isSpace) str) where + go ('-' : str) = liftM negate (go str) + go str = do + let (sc, sc') = break (':'==) (reverse str) + (mn, mn') = break (':'==) (if null sc' then "0" else drop 1 sc') + hr = if null mn' then "0" else drop 1 mn' + [Just h, Just m, Just s] <- return $ map (maybeRead . reverse) [hr, mn, sc] + return $ round (1000 * 1000 * (s + 60 * (m + 60 * h)) :: Double) + +-- Format time for display to user. Format: H:MM:SS or -H:MM:SS +formatTime :: Integer -> String +formatTime microseconds = printf "%d:%02d:%02d" hours (abs minutes) (abs seconds) where + ((((hours, minutes), seconds), _tenths), _) = id // 60 // 60 // 10 // (100*1000) $ microseconds + (//) f base val = (f q, r) where (q, r) = val `quotRem` base + +-- Return current time in microseconds +getMicroseconds :: IO Integer +getMicroseconds = do + GTimeVal { gTimeValSec = sec, gTimeValUSec = usec } <- gGetCurrentTime + return (fromIntegral sec * 1000 * 1000 + fromIntegral usec) + +-- Return the time of day according to "format" +getTime format = do + tz <- getCurrentTimeZone + utc <- getCurrentTime + return $ Data.Time.Format.formatTime defaultTimeLocale format (utcToLocalTime tz utc) + +------------------------ +-- Loading and Rendering the PDF document +------------------------ + +-- Load a new PDF document +openDoc state uri = do + doc <- catch (documentNewFromFile uri Nothing) + (\x -> errorDialog ("Error opening \"" ++ uri ++ "\": " ++ show (x :: GError)) >> return Nothing) + case doc of + Nothing -> errorDialog ("Unknown error opening \"" ++ uri ++ "\"") >> return True + Just doc -> do + -- Use the document title or filename as the window title + title <- doc `get` documentTitle + let makeTitle t = (if null title then takeFileName uri else title) ++ " (" ++ t ++ " Window) - " ++ appName + upper <- liftM fromIntegral (documentGetNPages doc) + setDocument state makeTitle 1 upper (Just uri) (Just doc) + +-- Set state variables for a new PDF document +setDocument state makeTitle lower upper uri doc = do + audienceWindow state >>= (`windowSetTitle` makeTitle "Audience") + presenterWindow state >>= (`windowSetTitle` makeTitle "Presenter") + -- Ensure that the current page number is in bounds for the new document + -- NOTE: we increment the current page number by 0 to trigger the range clamping on pageAdjustment + pageAdjustment state `set` [adjustmentLower := lower, adjustmentUpper := upper, adjustmentValue :~ (+0)] + -- Save the new state and return + writeIORef (pages state) Map.empty + writeIORef (documentURL state) uri + writeIORef (document state) doc + return True + +-- We render in a timeout to keep the GUI responsive. We move to a +-- slower timeout when everything is already rendered to avoid hogging +-- the CPU. We avoid using a separate thread because that would +-- require using postGUISync which causes delays that slow down the +-- rendering. +startRenderThread state progress = renderThreadSoon where + renderThreadSoon = widgetShow progress >> void (timeoutAdd (renderThread >> return False) 1{-milliseconds-}) + renderThreadDelayed = widgetHide progress >> void (timeoutAdd (renderThread >> return False) 100{-milliseconds-}) + renderThread = do + doc <- readIORef (document state) + case doc of + Nothing -> renderThreadDelayed -- We have no document to render + Just doc -> do + numPages <- liftM round $ pageAdjustment state `get` adjustmentUpper + currPage <- liftM round $ pageAdjustment state `get` adjustmentValue + -- Get the sizes of views and clean the cache of sizes with no views + views <- liftM (nub . Map.elems) $ readIORef (views state) + cache <- liftM (Map.filterWithKey (\(_, w, h) _ -> (w, h) `elem` views)) $ readIORef (pages state) + -- Select a page to be rendered for a view that is not in the cache. + -- Choose the view close to the current page if possible. + case [(page,w,h) | + page <- sortBy (comparing (\i -> max (i - currPage) (2 * (currPage - i)))) [1..numPages], + (w,h) <- sortBy (flip compare) views, + (page,w,h) `Map.notMember` cache] of + -- If nothing to be rendered, then move to the slower timeout to avoid hogging the CPU. + [] -> renderThreadDelayed + -- Otherwise, render that page and store a compressed copy in the cache. + work@((pageNum, width, height) : _) -> do + progressBarSetFraction progress (1 - fromIntegral (length work) / fromIntegral (numPages * length views)) + page <- documentGetPage doc (pageNum-1) + (docWidth, docHeight) <- pageGetSize page + -- Find a scaling factor that fits in the view while preserving aspect ratio + let scaleFactor = min (fromIntegral width / docWidth) + (fromIntegral height / docHeight) + -- Render the page to an image surface + -- NOTE: we use 24 bits instead of 32 to cut down on size and time + (pixels, w, h, stride) <- withImageSurface FormatRGB24 + (round $ scaleFactor * docWidth) (round $ scaleFactor * docHeight) (\surface -> do + renderWith surface $ do scale scaleFactor scaleFactor + setSourceRGB 1.0 1.0 1.0 >> paint -- draw a white page background + pageRender page -- draw page + return (,,,) `ap` imageSurfaceGetData surface + `ap` imageSurfaceGetWidth surface + `ap` imageSurfaceGetHeight surface + `ap` imageSurfaceGetStride surface) + -- Compress the data stored in the image surface + compression' <- readIORef (compression state) + let pixels' = compressWith (defaultCompressParams { compressLevel = compressionLevel compression' }) + (BSL.fromChunks [pixels]) + BSL.length pixels' `seq` return () -- avoid memory leak due to not being strict enough + writeIORef (pages state) (Map.insert (pageNum,width,height) (pixels', w, h, stride) cache) + -- Redraw the windows and re-enter the render thread quickly in case their is more to render + mainWindows state >>= mapM_ widgetQueueDraw + renderThreadSoon diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,675 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. + diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,23 @@ +all: + @echo !!! This Makefile is for development purposes only. !!! + @echo !!! Users should instead use Setup.hs or cabal. !!! + @echo + @echo Development targets: std prof lint clean + @exit 1 + +WARNING_FLAGS=-W -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-unused-do-bind -fno-warn-missing-signatures +GHC=ghc $(WARNING_FLAGS) -rtsopts + +std: + $(GHC) --make HaskellPdfPresenter.hs + +# Two stage profile build, due to Template Haskell not playing nice with profiling. +# See: http://www.haskell.org/ghc/docs/6.12.1/html/users_guide/template-haskell.html#id3029367 +prof: std + $(GHC) --make HaskellPdfPresenter.hs -prof -osuf p_o + +lint: + hlint HaskellPdfPresenter.hs + +clean: + rm -f HaskellPdfPresenter HaskellPdfPresenter.hi HaskellPdfPresenter.hp HaskellPdfPresenter.o HaskellPdfPresenter.p_o diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,190 @@ +************************************* +*** *** +*** Haskell Pdf Presenter (hpdfp) *** +*** *** +************************************* + +This application is a viewer for PDF-based presentations such as those +generated by Beamer. Unlike standard PDF viewers it has features +specifically for presentations such as a visual clock/timer and a +preview showing the next slide to the person delivering the talk. + +For basic use of the program, simply pass the path to the PDF as an +argument as in the following: + + $ hpdfp [filename] + +For help with the command line use the "--help" flag. + +For help with the GUI press the "?" key when the program is running. + +There are a lot of features that may not be immediately obvious so +please be sure to look at those bits of documentation. + +You can also visit the project home page for example use cases: + http://michaeldadams.org/projects/haskell-pdf-presenter/ + +*********** +WARNING: This application intentionally disables both the screen saver +and automatic screen dimming. This is to avoid having the screen saver +start in the middle of your presentation. +*********** + +================ +Features +================ +- Rendering + - Slides are pre-rendered in the background + - Pre-rendered slides are compressed to memory usage is low + (e.g., my dissertation defense with 95 slides takes only 60MB at max resolution) + - slide number or file name until rendered + - Renders slide close to current slide first (at a rate of two forward per one backward). + - Cache is filtered and wiped when the screen resizes + - Since poppler is not thread safe (see https://bugs.freedesktop.org/show_bug.cgi?id=50992), + we avoid using a separate thread for rendering, but it is still done incrementally + so the GUI is still responsive. + +- Compatible with most remote clickers + +- Disables screen saver when running in fullscreen mode + - WARNING: This is done by programatically giggling the mouse by zero pixels (even when running in the background). + This may lead to other programs thinking the mouse is constantly moving + (e.g. a video player may not dim the background or hide the mouse). + I haven't found any programs where this is an actual problem, but it is a possibility. + +- Audience view + - Mouse hides after ~3 seconds + - Shows on top if there is only one monitor + - Automatically placed on auxiliary monitor/projector if present + - Both black and white video mute + +- Presenter view + - Meta-data: + - A small progress bar is shown at the bottom while pre-rendering, + but since pre-rendering is done in the background, the GUI is + still be responsive and you do not have to wait for + pre-rendering to complete. + - Fonts are big (60pt = 5 * 12pt) + - Resizeable + - Timer: + - Both stopped and paused mode: + - Paused automatically starts on slide forward or back + - Stopped says stopped until user explicitly changes it + - Four different modes: count down, count up, 12 hour and 24 hour + - Grows to fit size (useful for session chairs) + - Colors: white, red (warning), purple (overtime) + Yeah, these colors are a bit strange, but I've chosen them to + be easily distinguishable even in peripheral vision or at a + glance. I don't know how well they work for color-blind + people. Feedback is welcome. + - Double click to configure timer + - Current remaining time + - Initial time + - Warning time + - Slide counter + - Double click to go to slide + - Mute status + - Timer status + - Multiple modes: Count down, count up, wall clock (12 or 24 hr) + - When paused (but not stopped) automatically goes to running if user + goes forward or backward one slide. Changing slide in other ways does not unpause. + - NOTE: to start timer but stay on first slide, just hit the back key + - Progress bar when doing rendering in the background + - Preview + - Thumbnails + - Current slide highlighted + - Tooltips show slide number (Currently disabled due to a bug in GTK) + - Click to go to slide + - Mouse wheel scrolls instead of changes slide + +- Times specified in dialogues or command line are parsed according to + the format "-* ((float:)? float:)? float" with whitespace + allowed anywhere. The following are some examples. + 1:30:05 (1 hour, 30 min and 5 seconds) + 30:00 (30 min) + 90 (90 seconds) + 0 (0 seconds) + -1:30 (negative 1 minute and 30 seconds = negative 90 seconds) + 1:0:0 (1 hour) + 1:-5:0 (1 hour minus 5 minutes = 55 minutes) + 1.5:0:0 (1.5 hours) + +- Key bindings: + (Note that the keys are far apart on a Qwerty keyboard and irreversible + actions (e.g., resetting the timer) all use a modifier key.) + + - Help/About dialog: H, ? + - Quit: Alt-F4, Ctrl-Q + - Switching slides: + - Forward slide and unpause (shift moves by 10): space, page down, enter, right arrow, down arrow + - Backward slide and unpause (shift moves by 10): back space, page up, left arrow, up arrow + - First slide: home + - Last slide: end + - Goto slide number: Ctrl-G, double-click slide number + - History back: Alt-L, XF86Back + - History forward: Alt-R, XF86Forward + - Clock/timer control: + - Toggle pause: P, pause + - Toggle stop: Shift-P + - Reset timer: C + - Open timer dialog: Ctrl-C + - Mute: + - Toggle white: W + - Toggle black: B + - Presenter screen: + - Switch views: Tab + - Change preview percentage: [, ], Shift-[ (minor), Shift-] (minor), = (standard stops) + - Standard stops: 0, best-fit on left, 1/3, 1/2, 2/3, best-fit on right, 1 + - Files: + - Reload file: Ctrl-R + - Open file: Ctrl-O + - Close file: Shift-Q + - Window control: + - Enter fullscreen: F, F11, Alt-Enter, Control-L + - Exit fullscreen: Escape, F, F11, Alt-Enter, Control-L + - Move between monitors: S, Shift-S (reverse) + - Move presenter window between monitors: Ctrl-S, Shift-Ctrl-S (reverse) + - Move audience window between monitors: Alt-S, Shift-Alt-S (reverse) + +- Command line: + - Zero or one files as argument + (NOTE: Zero files is useful for creating a simple timer with no slides) + - Options: + -h, -? --help Display usage message + -s INT --slide=INT Initial slide number (default 1) + -t TIME --start-time=TIME, --starting-time=TIME Start time (default 10:00) + -w TIME --warn-time=TIME, --warning-time=TIME Warning time (default 5:00) + -e TIME --end-time=TIME, --ending-time=TIME End time (default 0:00) + -f --fullscreen Start in full screen mode + -p INT --preview-percentage=INT Initial preview percentage (default 50) + --presenter-monitor=INT Initial monitor for presenter window (default 0) + --audience-monitor=INT Initial monitor for audience window (default 1) + --video-mute=MODE Initial video mute mode: "black", "white" or "off" (default) + --clock-mode=MODE Initial clock mode: "remaining" (default), "elapsed", "12hour" or "24hour" + --timer-mode=MODE Initial timer mode: "play", "pause" (default) or "stop" + --compression=[0-9] Compression level (default 1). 0 is none. 1 is fastest. 9 is best. + +================ +Inspired by +================ + +* pdfpc: http://davvil.github.com/pdfpc/ + +* pdf-presenter-console: http://westhoffswelt.de/projects/pdf_presenter_console.html + +* pympress: http://pympress.org/ + +================ +Known Bugs +================ + +If you + (1) are in full screen mode, + (2) are displaying to two monitors, + (3) have the presenter toggled to show thumbnails, and + (4) hover the mouse over the vertical scroll bar, +then the rendering will glitch and show older versions of the screen. +I don't know why this happens, but I'm guessing it is a bug in GTK. +A similar bug happens if you put tooltips on the thumbnails (which +are currently disabled to avoid that bug). Any help in solving +this bug would be appreciated. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/haskell-pdf-presenter.cabal b/haskell-pdf-presenter.cabal new file mode 100644 --- /dev/null +++ b/haskell-pdf-presenter.cabal @@ -0,0 +1,79 @@ +-- The name of the package. +Name: haskell-pdf-presenter + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.2.2 + +-- A short (one-line) description of the package. +Synopsis: Tool for presenting PDF-based presentations. + +-- A longer description of the package. +Description: The Haskell Pdf Presenter ("hpdfp") is a tool for presenting PDF-based + slide shows. It has many features and niceties that make delivering + a presentation easier. For example, as a + presenter, it is useful to see the next slide before it is shown to + the audience as well as how much allotted time remains. + . + There are a lot of features that may not be immediately obvious so + please be sure to look at the documentation. + For help with the command line, use the "--help" flag. + For help with the GUI, press the "?" key when the program is running. + The "README" contains a terse summary of all the features. + . + For more information and example uses, please visit the project home page. + +-- URL for the project homepage. +Homepage: http://michaeldadams.org/projects/haskell-pdf-presenter/ + +-- The license under which the package is released. +License: GPL-3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Michael D. Adams + +-- An email address to which users can send suggestions, bug reports, and patches. +Maintainer: Michael D. Adams + +-- A copyright notice. +Copyright: (c) 2012-2013, Michael D. Adams + +Category: Application, Graphics, Image Viewer, PDF + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a README. +Extra-source-files: README, CHANGELOG, HaskellPdfPresenter.glade, Makefile + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + +Executable hpdfp + -- .hs or .lhs file containing the Main module. + Main-is: HaskellPdfPresenter.hs + + -- Packages needed in order to build this package. + Build-depends: base == 4.*, bytestring >= 0.9, containers >= 0.1, directory >= 1.0, + filepath >= 1.0, template-haskell >= 2.2, zlib == 0.5.*, + old-locale, time >= 1.1.2.0, + glib, poppler == 0.12.2.*, gtk >= 0.12.2, cairo + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + +-- URL for the project repository. +Source-repository head + Type: mercurial + Location: http://michaeldadams.org/repos-pub/hg/haskell-pdf-presenter/ + +Source-repository this + Type: mercurial + Location: http://michaeldadams.org/repos-pub/hg/haskell-pdf-presenter/ + Tag: v0.2.2