Utility.hs

{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE BinaryLiterals      #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable  #-}

module Phoityne.IO.GUI.GTK.Utility
  where

-- モジュール
import Phoityne.IO.GUI.GTK.Constant

-- システム
import Graphics.UI.Gtk
import qualified Control.Exception as E
import qualified Data.List as L
import qualified Data.Text as T

-- |
--
--
isContainer :: GObjectClass cls => cls -> IO Bool
isContainer w = flip E.catches handlers $ do
  _ <- containerGetChildren $ castToContainer w
  return True

  where
    handlers = [ E.Handler someExcept ]
    someExcept (_ :: E.SomeException) = return False

-- |
--
--
setFont :: GObjectClass cls => cls -> IO ()
setFont w = do
  fontDesc <- fontDescriptionNew
  fontDescriptionSetFamily fontDesc _FONT_DESC
  widgetOverrideFont (castToWidget w) (Just fontDesc)
  isContainer w >>= \case
    True -> do
      childs <- containerGetChildren $ castToContainer w
      mapM_ setFont childs
    False -> return ()

-- |
--  
-- 
add2ListStore :: Eq a => ListStore a -> a -> IO ()
add2ListStore store item = do
  listDat <- listStoreToList store
  if True == L.elem item listDat then return ()
    else listStoreAppend store item >> return ()

-- |
--  
-- 
deleteFromListStore :: Eq a => ListStore a -> a -> IO ()
deleteFromListStore store item =
  listStoreToList store >>= deleteFromList
  where
    deleteFromList listDat 
      | True == L.elem item listDat = treeModelForeach (castToTreeModel store) deleteData
      | otherwise = return ()

    deleteData iter = do
      let idx = listStoreIterToIndex iter
      val <- listStoreGetValue store idx
      if val == item then listStoreRemove store idx >> return False
        else return False

-- |
--
--
forceEvent :: IO ()
forceEvent = eventsPending >>= go
  where
    go c | 0 < c = mainIterationDo True >> forceEvent
         | otherwise = return ()

-- |
--  
-- 
imageNewFromIcon :: T.Text -> Int -> IO (Maybe Image)
imageNewFromIcon iconName size = do
  iconTheme <- iconThemeGetDefault
  iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin >>= \case
    Just p  -> imageNewFromPixbuf p >>= return . Just
    Nothing -> return Nothing

-- |
--
--
deleteTagAtTextIter :: TextIter -> IO ()
deleteTagAtTextIter iter = do
  textBuf  <- textIterGetBuffer iter
  tagTable <- textBufferGetTagTable textBuf
  tags     <- textIterGetTags iter
  mapM_ (textTagTableRemove tagTable) tags

-- |
--
--
forwardTextIter :: TextIter -> Int -> IO (Maybe TextIter)
forwardTextIter iter 0 = return $ Just iter 
forwardTextIter iter count = textIterForwardChar iter >>= \case
  False -> return Nothing
  True  -> forwardTextIter iter (count-1)