-- Author: Andy Stewart -- Maintainer: Andy Stewart -- -- Copyright (C) 2010 Andy Stewart, all rights reserved. -- -- 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 -- 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 . {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} 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 -- | The intervals of slide show (ms). imageViewSlideShowInterval :: Int imageViewSlideShowInterval = 4000 -- | New image view. imageViewNew :: ImageBuffer -> PagePlugId -> IO ImageView imageViewNew buffer plugId = do -- Create plug id. pId <- newTVarIO plugId -- Create scrolled window. scrolledWindow <- scrolledWindowNew_ -- Load image. view <- I.imageViewNew scrolledWindow `containerAdd` view -- Duplicate broadcast channel. channel <- createViewChannel (imageBufferBroadcastChannel buffer) view -- Build image view. let imageView = ImageView pId scrolledWindow view buffer channel -- Listen broadcast channel. imageViewListenChannel imageView -- Draw. imageViewDraw imageView -- Update zoom status. view `on` I.zoomChanged $ imageViewUpdateZoomStatus imageView return imageView -- | Draw image view. imageViewDraw :: ImageView -> IO () imageViewDraw view = do -- TODO: Need find a way free old pixbuf in GtkImageView after use new pixbuf. -- Otherwise cause memory leak. path <- readTVarIO $ imageBufferPath $ imageViewBuffer view pixbuf <- pixbufNewFromFile (filepathGetDisplayName (fromString path)) I.imageViewSetPixbuf (imageViewView view) (Just pixbuf) True -- | Browse. imageViewBrowse :: ImageView -> FilePath -> IO () imageViewBrowse view path = do -- Update current path in ImageBuffer. writeTVarIO (imageBufferPath $ imageViewBuffer view) path -- Broadcast current path for synchronous in multiple ImageView. writeTChanIO (viewChannel $ imageViewBroadcastChannel view) path -- | Listen broadcast channel for draw view synchronous. imageViewListenChannel :: ImageView -> IO () imageViewListenChannel view = listenViewChannel (imageViewBroadcastChannel view) $ \_ -> imageViewDraw view -- | Handle key action. imageViewHandleKeyAction :: ImageView -> Text -> SerializedEvent -> IO () imageViewHandleKeyAction view keystoke sEvent = case M.lookup keystoke imageViewKeymap of Just action -> action view Nothing -> widgetPropagateEvent (imageViewView view) sEvent -- | Zoom out image. imageViewZoomOut :: ImageView -> IO () imageViewZoomOut = I.imageViewZoomOut . imageViewView -- | Zoom int image. imageViewZoomIn :: ImageView -> IO () imageViewZoomIn = I.imageViewZoomIn . imageViewView -- | Fit the window. imageViewFit :: ImageView -> IO () imageViewFit view = I.imageViewSetFitting (imageViewView view) True -- | View next file. imageViewBrowseNext :: ImageView -> IO () imageViewBrowseNext view = do currentFile <- readTVarIO $ imageBufferPath $ imageViewBuffer view files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view imageViewGetNextFile currentFile files ?>= \file -> imageViewBrowse view file -- | View Prev file. imageViewBrowsePrev :: ImageView -> IO () imageViewBrowsePrev view = do currentFile <- readTVarIO $ imageBufferPath $ imageViewBuffer view files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view imageViewGetPrevFile currentFile files ?>= \file -> imageViewBrowse view file -- | View first file. imageViewBrowseFirst :: ImageView -> IO () imageViewBrowseFirst view = do files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view getFirst files ?>= \ file -> imageViewBrowse view file -- | View last file. imageViewBrowseLast :: ImageView -> IO () imageViewBrowseLast view = do files <- readTVarIO $ imageBufferFiles $ imageViewBuffer view getLast files ?>= \ file -> imageViewBrowse view file -- | Rotate clockwise imageViewRotateClockwise :: ImageView -> IO () imageViewRotateClockwise view = do oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateClockwise I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True -- | Rotate counterclockwise. imageViewRotateCounterclockwise :: ImageView -> IO () imageViewRotateCounterclockwise view = do oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateCounterclockwise I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True -- | Rotate mirror. imageViewRotateMirror :: ImageView -> IO () imageViewRotateMirror view = do oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateUpsidedown I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True -- | Update zoom status. imageViewUpdateZoomStatus :: ImageView -> IO () imageViewUpdateZoomStatus view = do zoom <- liftM (\x -> floor $ formatFloatN x 2 * 100) $ I.imageViewGetZoom $ imageViewView view pageViewUpdateInfoStatus view "Zoom" (" Zoom (" ++ show zoom ++ "%)") -- | Find next image file under current directory. 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 -- Use first image when reach last image. then head files -- Otherwise use next image. else (!!) files (i + 1) Nothing -> Nothing -- | Find previous image file under current directory. imageViewGetPrevFile :: FilePath -> [FilePath] -> Maybe FilePath imageViewGetPrevFile _ [] = Nothing imageViewGetPrevFile _ [_] = Nothing imageViewGetPrevFile currentFile files = case findIndex (== currentFile) files of Just i -> Just $ if i <= 0 -- Use last image when reach first image. then last files -- Otherwise use previous image. else (!!) files (i - 1) Nothing -> Nothing -- | Slide show. imageViewSlideShow :: ImageView -> IO () imageViewSlideShow view@(ImageView {imageViewBuffer = ImageBuffer {imageBufferSlideShowHanlderId = slideShowId}}) = do sId <- readTVarIO slideShowId case sId of -- Stop slide show. Just id -> do pageViewUpdateInfoStatus view "SlideShow" " SlideShow (off)" timeoutRemove id writeTVarIO slideShowId Nothing -- Start slide show. Nothing -> do pageViewUpdateInfoStatus view "SlideShow" " SlideShow (on)" handlerId <- timeoutAdd (imageViewBrowseNext view >> return True) imageViewSlideShowInterval writeTVarIO slideShowId (Just handlerId) -- | Set as background, (just work for gnome). imageViewSetAsBackground :: ImageView -> IO () imageViewSetAsBackground (ImageView {imageViewBuffer = ImageBuffer {imageBufferPath = bufferPath}}) = do -- Get image path. path <- readTVarIO bufferPath setDesktopBackground path 100 Zoom -- | Keymap. 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) ]