GTK: try to fix icon crap
Not sure if this is right, though.
This commit is contained in:
parent
74b83fe2e8
commit
09d8910eae
@ -77,11 +77,6 @@ data MyGUI = MkMyGUI {
|
||||
, statusBar :: Statusbar
|
||||
, clearStatusBar :: Button
|
||||
, settings :: TVar FMSettings
|
||||
, folderPix :: Pixbuf
|
||||
, folderSymPix :: Pixbuf
|
||||
, filePix :: Pixbuf
|
||||
, fileSymPix :: Pixbuf
|
||||
, errorPix :: Pixbuf
|
||||
, scroll :: ScrolledWindow
|
||||
}
|
||||
|
||||
@ -90,6 +85,7 @@ data MyGUI = MkMyGUI {
|
||||
data FMSettings = MkFMSettings {
|
||||
showHidden :: Bool
|
||||
, isLazy :: Bool
|
||||
, iconSize :: Int
|
||||
}
|
||||
|
||||
data FMView = FMTreeView TreeView
|
||||
|
@ -22,6 +22,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module GUI.Gtk.Icons where
|
||||
|
||||
|
||||
import Data.Maybe
|
||||
(
|
||||
fromJust
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import Graphics.UI.Gtk.Gdk.Pixbuf
|
||||
import Paths_hsfm
|
||||
@ -45,10 +49,12 @@ getIcon :: GtkIcon -- ^ icon we want
|
||||
-> IO Pixbuf
|
||||
getIcon icon itheme isize = do
|
||||
let iname = iconToStr icon
|
||||
mpix <- iconThemeLoadIcon itheme iname isize IconLookupUseBuiltin
|
||||
case mpix of
|
||||
Just pix -> return pix
|
||||
Nothing -> pixbufNewFromFile =<< getDataFileName ("data/Gtk/icons/" ++ iname)
|
||||
hasicon <- iconThemeHasIcon itheme iname
|
||||
case hasicon of
|
||||
True -> fromJust <$> iconThemeLoadIcon itheme iname isize
|
||||
IconLookupUseBuiltin
|
||||
False -> pixbufNewFromFile =<< getDataFileName
|
||||
("data/Gtk/icons/" ++ iname ++ ".png")
|
||||
where
|
||||
iconToStr IFolder = "gtk-directory"
|
||||
iconToStr IFile = "gtk-file"
|
||||
|
@ -27,7 +27,6 @@ import Control.Concurrent.STM
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import GUI.Gtk.Icons
|
||||
import Paths_hsfm
|
||||
(
|
||||
getDataFileName
|
||||
@ -45,15 +44,8 @@ import Paths_hsfm
|
||||
createMyGUI :: IO MyGUI
|
||||
createMyGUI = do
|
||||
|
||||
settings <- newTVarIO (MkFMSettings False True)
|
||||
|
||||
-- get the icons
|
||||
iT <- iconThemeGetDefault
|
||||
folderPix <- getIcon IFolder iT 24
|
||||
folderSymPix <- getSymlinkIcon IFolder iT 24
|
||||
filePix <- getIcon IFile iT 24
|
||||
fileSymPix <- getSymlinkIcon IFile iT 24
|
||||
errorPix <- getIcon IError iT 24
|
||||
let settings' = MkFMSettings False True 24
|
||||
settings <- newTVarIO settings'
|
||||
|
||||
builder <- builderNew
|
||||
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
|
||||
|
Loading…
Reference in New Issue
Block a user