packages feed

manatee-imageviewer-0.1.0: Manatee/Extension/ImageViewer/ImageView.hs

-- Author:     Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
-- 
-- Copyright (C) 2010 ~ 2011 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 <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Manatee.Extension.ImageViewer.ImageView where

import Control.Applicative
import Control.Concurrent.STM 
import Control.Monad
import Data.ByteString.UTF8 hiding (length)
import Data.List
import Data.Map (Map)
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)
import Manatee.Core.Config
import Manatee.Core.PageFrame
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Extension.ImageViewer.ImageBuffer
import Manatee.Toolkit.GConf.GConf
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Misc
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gio.Gio
import Manatee.Toolkit.Gtk.Concurrent
import Manatee.Toolkit.Gtk.ScrolledWindow
import Paths_manatee_imageviewer
import System.FilePath

import qualified Graphics.UI.Gtk.ImageView.ImageView as I
import qualified Data.Map as M

data ImageView =
    ImageView {imageViewPlugId          :: TVar PagePlugId
              ,imageViewFrame           :: PageFrame
              ,imageViewView            :: I.ImageView
              ,imageViewBuffer          :: ImageBuffer
              ,imageViewDirection       :: TVar ImageDirection
              ,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
  pageBufferPackageName _       = fmap takeFileName getDataDir

instance PageView ImageView where
    pageViewBuffer               = PageBufferWrap . imageViewBuffer
    pageViewPlugId               = imageViewPlugId
    pageViewFrame                = imageViewFrame
    pageViewLocalKeymap _        = imageViewLocalKeymap
    pageViewLocalCommandMap _    = imageViewLocalCommandMap
    pageViewFocus                = widgetGrabFocus . imageViewView
    pageViewPropagateWidget      = castToWidget . imageViewView
    pageViewSaveState view       = imageViewSaveState view Nothing
    pageViewRestoreState view    = imageViewRestoreState view Nothing
    pageViewWriteState view path = imageViewSaveState view (Just path)
    pageViewReadState view path  = imageViewRestoreState view (Just path)

-- | 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.
  pFrame <- pageFrameNewWithModeName (pageModeName $ imageBufferMode buffer)
  
  -- Load image.
  view <- I.imageViewNew
  pageFrameAddChild pFrame view

  -- Init direction.
  direction <- newTVarIO DirectionUp

  -- Duplicate broadcast channel.
  channel <- createViewChannel (imageBufferBroadcastChannel buffer) view

  -- Build image view.
  let imageView = ImageView pId pFrame view buffer direction channel

  -- Listen broadcast channel.
  imageViewListenChannel imageView

  -- Update zoom status.
  view `on` I.zoomChanged $ imageViewUpdateZoomStatus imageView

  return imageView

-- | Draw image view.
imageViewDraw :: ImageView -> ImageDirection -> IO ()
imageViewDraw view direction = do
  path <- readTVarIO $ imageBufferPath $ imageViewBuffer view
  oldPixbuf <- pixbufNewFromFile (filepathGetDisplayName (fromString path))
  newPixbuf <- 
      case direction of
        DirectionUp     -> return oldPixbuf
        DirectionRight  -> pixbufRotateSimple oldPixbuf PixbufRotateClockwise
        DirectionLeft   -> pixbufRotateSimple oldPixbuf PixbufRotateCounterclockwise
        DirectionDown   -> pixbufRotateSimple oldPixbuf PixbufRotateUpsidedown
  writeTVarIO (imageViewDirection view) direction
  I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) 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 DirectionUp

-- | 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

-- | Update direction.
imageViewUpdateDirection :: ImageView -> RotateAction -> IO ()  
imageViewUpdateDirection ImageView {imageViewDirection = directionTVar}
                         action = do
  -- Get old direction.
  direction <- readTVarIO directionTVar
  
  -- Get new direction.
  let newDirection = 
          case action of
            RotateCounterclockwise ->
                case direction of
                  DirectionUp    -> DirectionLeft
                  DirectionRight -> DirectionUp
                  DirectionDown  -> DirectionRight
                  DirectionLeft  -> DirectionDown
            RotateClockwise ->
                case direction of
                  DirectionUp    -> DirectionRight
                  DirectionRight -> DirectionDown
                  DirectionDown  -> DirectionLeft
                  DirectionLeft  -> DirectionUp
            RotateMirror ->
                case direction of
                  DirectionUp    -> DirectionDown
                  DirectionRight -> DirectionLeft
                  DirectionDown  -> DirectionUp
                  DirectionLeft  -> DirectionRight

  -- Update direction.
  writeTVarIO directionTVar newDirection

-- | Rotate clockwise
imageViewRotateClockwise :: ImageView -> IO ()
imageViewRotateClockwise view = do
  oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
  newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateClockwise
  I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
  imageViewUpdateDirection view RotateClockwise
  
-- | Rotate counterclockwise.
imageViewRotateCounterclockwise :: ImageView -> IO ()
imageViewRotateCounterclockwise view = do
  oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
  newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateCounterclockwise
  I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
  imageViewUpdateDirection view RotateCounterclockwise
  
-- | Rotate mirror.
imageViewRotateMirror :: ImageView -> IO ()
imageViewRotateMirror view = do
  oldPixbuf <- I.imageViewGetPixbuf $ imageViewView view
  newPixbuf <- pixbufRotateSimple oldPixbuf PixbufRotateUpsidedown
  I.imageViewSetPixbuf (imageViewView view) (Just newPixbuf) True
  imageViewUpdateDirection view RotateMirror

-- | Update zoom status.
imageViewUpdateZoomStatus :: ImageView -> IO ()
imageViewUpdateZoomStatus view = do
  zoom <- liftM (\x -> floor $ formatFloatN x 2 * 100) $ I.imageViewGetZoom $ imageViewView view
  pageViewUpdateStatusbar 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
      pageViewUpdateStatusbar view "SlideShow" " SlideShow (off)"
      timeoutRemove id
      writeTVarIO slideShowId Nothing
    -- Start slide show.
    Nothing -> do
      pageViewUpdateStatusbar 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.
imageViewLocalKeymap :: Map Text Text
imageViewLocalKeymap = 
    M.fromList [("j",           "Scroll step up")
               ,("k",           "Scroll step down")
               ,("Down",        "Scroll step up")
               ,("Up",          "Scroll step down")
               ,("h",           "Scroll step right")
               ,("l",           "Scroll step left")
               ,("Right",       "Scroll step right")
               ,("Left",        "Scroll step left")
               ,(" ",           "Scroll page up")
               ,("b",           "Scroll page down")
               ,("PageDown",    "Scroll page up")
               ,("PageUp",      "Scroll page down")
               ,("J",           "Scroll to bottom")
               ,("K",           "Scroll to top")
               ,("End",         "Scroll to bottom")
               ,("Home",        "Scroll to top")
               ,(",",           "Zoom out")
               ,(".",           "Zoom in")
               ,("-",           "Zoom out")
               ,("=",           "Zoom in")
               ,("m",           "Fit size")
               ,("n",           "Browse next")
               ,("Return",      "Browse previous")
               ,("p",           "Browse previous")
               ,("N",           "Browse last")
               ,("P",           "Browse first")
               ,("<",           "Rotate counterclockwise")
               ,(">",           "Rotate clockwise")
               ,("/",           "Rotate mirror")
               ,("s",           "Slide show")
               ,("B",           "Set as background")
               ]

-- | Keymap.
imageViewLocalCommandMap :: Map Text (ImageView -> IO ())
imageViewLocalCommandMap = 
    M.fromList [("Scroll step up",              pageViewScrollStepUp)
               ,("Scroll step down",            pageViewScrollStepDown)
               ,("Scroll step right",           pageViewScrollStepRight)
               ,("Scroll step left",            pageViewScrollStepLeft)
               ,("Scroll page up",              pageViewScrollPageUp)
               ,("Scroll page down",            pageViewScrollPageDown)
               ,("Scroll to bottom",            pageViewScrollToBottom)
               ,("Scroll to top",               pageViewScrollToTop)
               ,("Zoom out",                    imageViewZoomOut)
               ,("Zoom in",                     imageViewZoomIn)
               ,("Fit size",                    imageViewFit)
               ,("Browse next",                 imageViewBrowseNext)
               ,("Browse previous",             imageViewBrowsePrev)
               ,("Browse last",                 imageViewBrowseLast)
               ,("Browse first",                imageViewBrowseFirst)
               ,("Rotate counterclockwise",     imageViewRotateCounterclockwise)
               ,("Rotate clockwise",            imageViewRotateClockwise)
               ,("Rotate mirror",               imageViewRotateMirror)
               ,("Slide show",                  imageViewSlideShow)
               ,("Set as background",           imageViewSetAsBackground)
               ]

-- | Scrolled window.
imageViewScrolledWindow :: ImageView -> ScrolledWindow
imageViewScrolledWindow =
  pageFrameScrolledWindow . imageViewFrame

-- | Save state.
imageViewSaveState :: ImageView -> Maybe FilePath -> IO ()
imageViewSaveState view@(ImageView {imageViewBuffer     = buffer
                                   ,imageViewView       = imageView
                                   ,imageViewDirection  = directionTVar}) 
                   statePath = do
  -- Get direction.
  direction <- readTVarIO directionTVar

  -- Get zoom level.
  zoom <- I.imageViewGetZoom imageView

  -- Get scroll position.
  scrolledWindowPosition <- scrolledWindowGetValue (imageViewScrolledWindow view)

  -- Save state.
  let state = ImageState direction (Just zoom) scrolledWindowPosition
  case statePath of
    Nothing   -> writeTVarIO (imageBufferState buffer) state
    Just path -> writeConfigPath path state

-- | Restore state.
imageViewRestoreState :: ImageView -> Maybe FilePath -> IO ()
imageViewRestoreState view@(ImageView {imageViewBuffer  = buffer
                                      ,imageViewView    = imageView})
                      statePath = do
  bufferState <- readTVarIO (imageBufferState buffer)
  (ImageState direction zoom scrolledWindowPosition) <- 
      case statePath of
        Just path -> readConfigPath path bufferState
        Nothing   -> return bufferState

  -- Restore direction.
  imageViewDraw view direction

  -- Restore zoom level.
  zoom ?>= (I.imageViewSetZoom imageView)

  -- Restore scroll position.
  scrolledWindowSetValue (imageViewScrolledWindow view) scrolledWindowPosition