module Manatee.Toolkit.Gtk.Gtk where
import Control.Applicative hiding (empty)
import Data.Maybe
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Graphics.UI.Gtk.SourceView.SourceLanguage
import Graphics.UI.Gtk.SourceView.SourceLanguageManager
import Manatee.Toolkit.General.Basic
sourceLanguageForFilename :: SourceLanguageManager -> Maybe String -> IO (Maybe String, Maybe SourceLanguage)
sourceLanguageForFilename lm filename = do
mbLang <-
case filename of
Just f -> sourceLanguageManagerGuessLanguage lm (Just f) Nothing
Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just "text/x-text")
case mbLang of
Nothing -> return (Nothing,Nothing)
Just lang -> do
name <- sourceLanguageGetName lang
return (Just name, Just lang)
windowNewWithWindowGroup :: WindowGroup -> IO Window
windowNewWithWindowGroup windowGroup = do
window <- windowNew
windowGroupAddWindow windowGroup window
return window
rectangleX :: Rectangle -> Int
rectangleX (Rectangle x _ _ _) = x
rectangleY :: Rectangle -> Int
rectangleY (Rectangle _ y _ _) = y
rectangleW :: Rectangle -> Int
rectangleW (Rectangle _ _ w _) = w
rectangleH :: Rectangle -> Int
rectangleH (Rectangle _ _ _ h) = h
socketNew_ :: IO Socket
socketNew_ = do
socket <- socketNew
widgetShow socket
return socket
windowIsFullscreen :: Window -> IO Bool
windowIsFullscreen window =
widgetGetDrawWindow window
>>= drawWindowGetState
>>= \states ->
return $ WindowStateFullscreen `elem` states
frameNewWithShadowType :: Maybe ShadowType -> IO Frame
frameNewWithShadowType Nothing = frameNew
frameNewWithShadowType (Just shadow) = do
frame <- frameNew
frameSetShadowType frame shadow
return frame
widgetRedrawRectangleFrame :: WidgetClass self => self
-> Int
-> Int
-> Int
-> Int
-> Int
-> IO ()
widgetRedrawRectangleFrame widget x y w h lw = do
widgetQueueDrawArea widget x y lw (y + h)
widgetQueueDrawArea widget (x + w lw) y lw (y + h)
widgetQueueDrawArea widget x y (x + w) lw
widgetQueueDrawArea widget x (y + h lw) (x + w) lw
widgetHasParent :: WidgetClass widget => widget -> IO Bool
widgetHasParent widget =
isJust <$> widgetGetParent widget
widgetPropagateEvent :: WidgetClass widget => widget -> SerializedEvent -> IO ()
widgetPropagateEvent widget sEvent = do
drawWindow <- widgetGetDrawWindow widget
postGUIAsync $ deserializeEvent sEvent drawWindow (widgetEvent widget) >> return ()
widgetGetScreenSize :: WidgetClass widget => widget -> IO (Int, Int)
widgetGetScreenSize widget = do
screen <- widgetGetScreen widget
width <- screenGetWidth screen
height <- screenGetHeight screen
return (width, height)
imageNewFromIcon :: String -> Int -> IO Image
imageNewFromIcon iconName size = do
iconTheme <- iconThemeGetDefault
pixbuf <- do
pixbuf <- iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin
case pixbuf of
Just p -> return p
Nothing -> error $ "imageNewFromIcon : search icon " ++ iconName ++ " failed."
imageNewFromPixbuf pixbuf
panedAdjustSize :: PanedClass self => self -> Int -> IO ()
panedAdjustSize paned adjustSize = do
position <- get paned panedPosition
minPosition <- get paned panedMinPosition
maxPosition <- get paned panedMaxPosition
let adjustPosition = position + adjustSize
newPosition
| adjustPosition < minPosition = minPosition
| adjustPosition > maxPosition = maxPosition
| otherwise = adjustPosition
panedSetPosition paned newPosition
colorToRGB :: Color -> (Double, Double, Double)
colorToRGB (Color r g b) =
(integralToDouble r / 65535, integralToDouble g / 65535, integralToDouble b / 65535)