BindingTable.hs

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

module Phoityne.IO.GUI.GTK.BindingTable (
  BindingListStore
, BindingData(..)
, BindingTableDoubleClickedHandler
, setupBindingTable
, createBindingListStore
, updateBindingTable
) where

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

-- システム
import Graphics.UI.Gtk
import Control.Monad.IO.Class

-- |
--
--
type BindingListStore = ListStore BindingData

-- |
--
--
type BindingTableDoubleClickedHandler = BindingData -> IO ()

-- |
--  
-- 
data BindingData = BindingData {
    varNameBindingData :: String
  , modNameBindingData :: String
  , valueBindingData :: String
  } deriving (Show, Read, Eq, Ord)


-- |
--  
-- 
updateBindingTable :: ListStore BindingData -> [BindingData] -> IO ()
updateBindingTable store dats= do
  listStoreClear store
  mapM_ (listStoreAppend store) dats


-- |
--
--
createBindingListStore :: IO BindingListStore
createBindingListStore = listStoreNew ([] :: [BindingData])

-- |
--
--
setupBindingTable :: Builder
                  -> BindingListStore
                  -> BindingTableDoubleClickedHandler
                  -> IO ()
setupBindingTable builder store evh = do

  treeView <- builderGetObject builder castToTreeView "BindingsTreeView"

  col <- builderGetObject builder castToTreeViewColumn ("BindingsCol1" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := varNameBindingData cell
    , cellTextFont := _FONT_DESC
    , cellTextSize := 9
    ]
  _ <- treeViewSetModel treeView store

  col <- builderGetObject builder castToTreeViewColumn ("BindingsCol2" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := modNameBindingData cell
    , cellTextFont := _FONT_DESC
    , cellTextSize := 9
    ]
  _ <- treeViewSetModel treeView store

  col <- builderGetObject builder castToTreeViewColumn ("BindingsCol3" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := valueBindingData cell
    , cellTextFont := _FONT_DESC
    , cellTextSize := 9
    ]
  _ <- treeViewSetModel treeView store

  _ <- on treeView buttonPressEvent $ bindingTableDoubleClickedHandler treeView store evh

  sel <- treeViewGetSelection treeView
  treeSelectionSetMode sel SelectionSingle

  setFont treeView
  widgetShowAll treeView

-- |
--
--
bindingTableDoubleClickedHandler :: TreeView -> ListStore BindingData -> BindingTableDoubleClickedHandler -> EventM EButton Bool
bindingTableDoubleClickedHandler self listStore evh = eventClick >>= \case
  DoubleClick -> liftIO $ do
    sel <- treeViewGetSelection self
    treeSelectionGetSelected sel >>= \case
      Nothing   -> return False
      Just iter -> do
        let idx = listStoreIterToIndex iter
        bpDat <- listStoreGetValue listStore idx
        evh bpDat
        return False

  _ -> return False