hsfm/src/HSFM/GUI/Gtk/Icons.hs

76 lines
2.1 KiB
Haskell
Raw Normal View History

2015-12-24 17:25:05 +00:00
{--
HSFM, a filemanager written in Haskell.
2016-03-30 22:28:23 +00:00
Copyright (C) 2016 Julian Ospald
2015-12-24 17:25:05 +00:00
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 #-}
-- |Module for Gtk icon handling.
2016-03-30 18:16:34 +00:00
module HSFM.GUI.Gtk.Icons where
2015-12-17 03:42:22 +00:00
2016-05-30 11:52:37 +00:00
import Control.Applicative
(
(<$>)
)
import Data.Maybe
(
fromJust
)
2015-12-17 03:42:22 +00:00
import Graphics.UI.Gtk
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
hasicon <- iconThemeHasIcon itheme iname
case hasicon of
True -> fromJust <$> iconThemeLoadIcon itheme iname isize
IconLookupUseBuiltin
False -> pixbufNewFromFile =<< getDataFileName
("data/Gtk/icons/" ++ iname ++ ".png")
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