2015-12-24 17:25:05 +00:00
|
|
|
{--
|
|
|
|
HSFM, a filemanager written in Haskell.
|
|
|
|
Copyright (C) 2015 Julian Ospald
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
|
|
modify it under the terms of the GNU General Public License
|
|
|
|
version 2 as published by the Free Software Foundation.
|
|
|
|
|
|
|
|
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, write to the Free Software
|
|
|
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
|
--}
|
|
|
|
|
2015-12-17 03:42:22 +00:00
|
|
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
|
2015-12-19 15:13:48 +00:00
|
|
|
-- |Module for Gtk icon handling.
|
2015-12-17 03:42:22 +00:00
|
|
|
module GUI.Gtk.Icons where
|
|
|
|
|
|
|
|
|
|
|
|
import Graphics.UI.Gtk
|
|
|
|
import Graphics.UI.Gtk.Gdk.Pixbuf
|
2015-12-28 23:48:54 +00:00
|
|
|
import Paths_hsfm
|
|
|
|
(
|
|
|
|
getDataFileName
|
|
|
|
)
|
2015-12-17 03:42:22 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Icon type we use in our GUI.
|
|
|
|
data GtkIcon = IFolder
|
2015-12-26 20:11:23 +00:00
|
|
|
| SymL
|
2015-12-17 03:42:22 +00:00
|
|
|
| IFile
|
|
|
|
| IError
|
|
|
|
|
|
|
|
|
|
|
|
-- |Gets an icon from the default icon theme and falls back to project-icons
|
|
|
|
-- if not found. The requested icon size is not guaranteed.
|
|
|
|
getIcon :: GtkIcon -- ^ icon we want
|
2015-12-26 20:11:23 +00:00
|
|
|
-> IconTheme -- ^ which icon theme to get the icon from
|
2015-12-17 03:42:22 +00:00
|
|
|
-> Int -- ^ requested icon size
|
|
|
|
-> IO Pixbuf
|
2015-12-26 20:11:23 +00:00
|
|
|
getIcon icon itheme isize = do
|
2015-12-17 03:42:22 +00:00
|
|
|
let iname = iconToStr icon
|
2015-12-26 20:11:23 +00:00
|
|
|
mpix <- iconThemeLoadIcon itheme iname isize IconLookupUseBuiltin
|
2015-12-17 03:42:22 +00:00
|
|
|
case mpix of
|
|
|
|
Just pix -> return pix
|
2015-12-28 23:48:54 +00:00
|
|
|
Nothing -> pixbufNewFromFile =<< getDataFileName ("data/Gtk/icons/" ++ iname)
|
2015-12-17 03:42:22 +00:00
|
|
|
where
|
|
|
|
iconToStr IFolder = "gtk-directory"
|
|
|
|
iconToStr IFile = "gtk-file"
|
|
|
|
iconToStr IError = "error"
|
2015-12-26 20:11:23 +00:00
|
|
|
iconToStr SymL = "emblem-symbolic-link"
|
|
|
|
|
|
|
|
|
|
|
|
getSymlinkIcon :: GtkIcon -> IconTheme -> Int -> IO Pixbuf
|
|
|
|
getSymlinkIcon icon itheme isize = do
|
|
|
|
pix <- pixbufCopy =<< getIcon icon itheme isize
|
|
|
|
sympix <- getIcon SymL itheme isize
|
|
|
|
|
|
|
|
pixbufScale sympix pix 0 0 12 12 0 0 0.5 0.5 InterpNearest
|
|
|
|
|
|
|
|
return pix
|