module Manatee.Extension.ImageViewer.ImageView where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import Data.List
import Data.Map (Map)
import Data.ByteString.UTF8 hiding (length)
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Extension.ImageViewer.ImageBuffer
import Manatee.Toolkit.GConf.GConf
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Misc
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Concurrent
import Manatee.Toolkit.Gtk.Gtk
import Manatee.Toolkit.Gio.Gio
import Manatee.Toolkit.Gtk.ScrolledWindow
import qualified Graphics.UI.Gtk.ImageView.ImageView as I
import qualified Data.Map as M
data ImageView =
ImageView {imageViewPlugId :: TVar PagePlugId
,imageViewScrolledWindow :: ScrolledWindow
,imageViewView :: I.ImageView
,imageViewBuffer :: ImageBuffer
,imageViewBroadcastChannel:: ViewChannel String}
deriving Typeable
instance PageBuffer ImageBuffer where
pageBufferGetName = readTVarIO . imageBufferPath
pageBufferSetName a = writeTVarIO (imageBufferPath a)
pageBufferClient = imageBufferClient
pageBufferCreateView a pId = PageViewWrap <$> imageViewNew a pId
pageBufferMode = imageBufferMode
instance PageView ImageView where
pageViewBuffer = PageBufferWrap . imageViewBuffer
pageViewPlugId = imageViewPlugId
pageViewFocus = widgetGrabFocus . imageViewView
pageViewScrolledWindow = imageViewScrolledWindow
pageViewHandleKeyAction = imageViewHandleKeyAction
imageViewSlideShowInterval :: Int
imageViewSlideShowInterval = 4000
imageViewNew :: ImageBuffer -> PagePlugId -> IO ImageView
imageViewNew buffer plugId = do
pId <- newTVarIO plugId
scrolledWindow <- scrolledWindowNew_
view <- I.imageViewNew
scrolledWindow `containerAdd` view
channel <- createViewChannel (imageBufferBroadcastChannel buffer) view
let imageView = ImageView pId scrolledWindow view buffer channel
imageViewListenChannel imageView
imageViewDraw imageView
view `on` I.zoomChanged $ imageViewUpdateZoomStatus imageView
return imageView
imageViewDraw :: ImageView -> IO ()
imageViewDraw view = do
path <- readTVarIO $ imageBufferPath $ imageViewBuffer view
pixbuf <- pixbufNewFromFile (filepathGetDisplayName (fromString path))
I.imageViewSetPixbuf (imageViewView view) (Just pixbuf) True
imageViewBrowse :: ImageView -> FilePath -> IO ()
imageViewBrowse view path = do
writeTVarIO (imageBufferPath $ imageViewBuffer view) path
writeTChanIO (viewChannel $ imageViewBroadcastChannel view) path
imageViewListenChannel :: ImageView -> IO ()
imageViewListenChannel view =
listenViewChannel (imageViewBroadcastChannel view) $ \_ ->
imageViewDraw view
imageViewHandleKeyAction :: ImageView -> Text -> SerializedEvent -> IO ()
imageViewHandleKeyAction view keystoke sEvent =
case M.lookup keystoke imageViewKeymap of
Just action -> action view
Nothing -> widgetPropagateEvent (imageViewView view) sEvent
imageViewZoomOut :: ImageView -> IO ()
imageViewZoomOut = I.imageViewZoomOut . imageViewView
imageViewZoomIn :: ImageView -> IO ()
imageViewZoomIn = I.imageViewZoomIn . imageViewView
imageViewFit :: ImageView -> IO ()
imageViewFit view =
I.imageViewSetFitting (imageViewView view) True
imageViewBrowseNext :: ImageView -> IO ()
imageViewBrowseNext view = do
currentFile <- readTVarIO $ imageBufferPath $ imageViewBuffer view
files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view
imageViewGetNextFile currentFile files ?>= \file ->
imageViewBrowse view file
imageViewBrowsePrev :: ImageView -> IO ()
imageViewBrowsePrev view = do
currentFile <- readTVarIO $ imageBufferPath $ imageViewBuffer view
files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view
imageViewGetPrevFile currentFile files ?>= \file ->
imageViewBrowse view file
imageViewBrowseFirst :: ImageView -> IO ()
imageViewBrowseFirst view = do
files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view
getFirst files ?>= \ file -> imageViewBrowse view file
imageViewBrowseLast :: ImageView -> IO ()
imageViewBrowseLast view = do
files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view
getLast files ?>= \ file -> imageViewBrowse view file
imageViewRotateClockwise :: ImageView -> IO ()
imageViewRotateClockwise view = do
oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateClockwise
I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
imageViewRotateCounterclockwise :: ImageView -> IO ()
imageViewRotateCounterclockwise view = do
oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateCounterclockwise
I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
imageViewRotateMirror :: ImageView -> IO ()
imageViewRotateMirror view = do
oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateUpsidedown
I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
imageViewUpdateZoomStatus :: ImageView -> IO ()
imageViewUpdateZoomStatus view = do
zoom <- liftM (\x -> floor $ formatFloatN x 2 * 100) $ I.imageViewGetZoom $ imageViewView view
pageViewUpdateInfoStatus view "Zoom" (" Zoom (" ++ show zoom ++ "%)")
imageViewGetNextFile :: FilePath -> [FilePath] -> Maybe FilePath
imageViewGetNextFile _ [] = Nothing
imageViewGetNextFile _ [_] = Nothing
imageViewGetNextFile currentFile files =
case findIndex (== currentFile) files of
Just i ->
Just $ if i >= length files 1
then head files
else (!!) files (i + 1)
Nothing -> Nothing
imageViewGetPrevFile :: FilePath -> [FilePath] -> Maybe FilePath
imageViewGetPrevFile _ [] = Nothing
imageViewGetPrevFile _ [_] = Nothing
imageViewGetPrevFile currentFile files =
case findIndex (== currentFile) files of
Just i ->
Just $ if i <= 0
then last files
else (!!) files (i 1)
Nothing -> Nothing
imageViewSlideShow :: ImageView -> IO ()
imageViewSlideShow view@(ImageView {imageViewBuffer =
ImageBuffer {imageBufferSlideShowHanlderId = slideShowId}}) = do
sId <- readTVarIO slideShowId
case sId of
Just id -> do
pageViewUpdateInfoStatus view "SlideShow" " SlideShow (off)"
timeoutRemove id
writeTVarIO slideShowId Nothing
Nothing -> do
pageViewUpdateInfoStatus view "SlideShow" " SlideShow (on)"
handlerId <- timeoutAdd (imageViewBrowseNext view >> return True) imageViewSlideShowInterval
writeTVarIO slideShowId (Just handlerId)
imageViewSetAsBackground :: ImageView -> IO ()
imageViewSetAsBackground (ImageView {imageViewBuffer =
ImageBuffer {imageBufferPath = bufferPath}}) = do
path <- readTVarIO bufferPath
setDesktopBackground path 100 Zoom
imageViewKeymap :: Map Text (ImageView -> IO ())
imageViewKeymap =
M.fromList [("j", pageViewScrollStepUp)
,("k", pageViewScrollStepDown)
,("Down", pageViewScrollStepUp)
,("Up", pageViewScrollStepDown)
,("h", pageViewScrollStepRight)
,("l", pageViewScrollStepLeft)
,("Right", pageViewScrollStepRight)
,("Left", pageViewScrollStepLeft)
,(" ", pageViewScrollPageUp)
,("b", pageViewScrollPageDown)
,("PageDown", pageViewScrollPageUp)
,("PageUp", pageViewScrollPageDown)
,("J", pageViewScrollToBottom)
,("K", pageViewScrollToTop)
,("End", pageViewScrollToBottom)
,("Home", pageViewScrollToTop)
,(",", imageViewZoomOut)
,(".", imageViewZoomIn)
,("-", imageViewZoomOut)
,("=", imageViewZoomIn)
,("m", imageViewFit)
,("n", imageViewBrowseNext)
,("Return", imageViewBrowseNext)
,("p", imageViewBrowsePrev)
,("N", imageViewBrowseLast)
,("P", imageViewBrowseFirst)
,("<", imageViewRotateCounterclockwise)
,(">", imageViewRotateClockwise)
,("/", imageViewRotateMirror)
,("s", imageViewSlideShow)
,("B", imageViewSetAsBackground)
]