Interface.hs

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

module Phoityne.IO.GUI.GTK.Interface (
  module Phoityne.IO.GUI.GTK.ConsoleView
, module Phoityne.IO.GUI.GTK.BindingTable
, module Phoityne.IO.GUI.GTK.BreakPointTable 
, module Phoityne.IO.GUI.GTK.TextEditor
, module Phoityne.IO.GUI.GTK.TraceTable
, module Phoityne.IO.GUI.GTK.FolderTree
, module Phoityne.IO.GUI.GTK.SearchResultTable

-- Main
, WidgetStore
, MainWindowCloseEventHandler
, MainWindowKeyPressEventHandler
, CallbackHandlerId
, getBuilder
, start
, setupMainWindow
, addCallback
, delCallback

-- ToolButton
, DebugStartBTClickedEventHandler
, DebugStopBTClickedEventHandler
, StepOverBTClickedEventHandler
, StepInBTClickedEventHandler
, BuildBTClickedEventHandler
, SaveBTClickedEventHandler
, IndentBTClickedEventHandler
, UnIndentBTClickedEventHandler
, CommentBTClickedEventHandler
, UnCommentBTClickedEventHandler
, setupToolButton
, setupDebugButtonOn
, setupDebugButtonOff
, setupBuildButtonOn
, setupBuildButtonOff
, isDebugStart
, isBuildStart

-- Dialog
, getNameByFolderTreeDialog
, getSearchKeyBySearchDialog
, getSearchKeyFromSearchDialog
, getReplaceByReplaceDialog
, initSearchDialog
, initReplaceDialog
) where

-- モジュール
import Phoityne.IO.GUI.GTK.Constant
import Phoityne.IO.GUI.GTK.BreakPointTable
import Phoityne.IO.GUI.GTK.TextEditor
import Phoityne.IO.GUI.GTK.BindingTable
import Phoityne.IO.GUI.GTK.TraceTable
import Phoityne.IO.GUI.GTK.FolderTree
import Phoityne.IO.GUI.GTK.SearchResultTable
import Phoityne.IO.GUI.GTK.ConsoleView

-- システム
import Paths_phoityne
import Data.Maybe
import Control.Monad.IO.Class
import Graphics.UI.Gtk
import qualified Data.Text as T

-- |
--
--
type WidgetStore = Builder

type DebugStartBTClickedEventHandler = IO ()

type DebugStopBTClickedEventHandler = IO ()

type StepOverBTClickedEventHandler = IO ()

type StepInBTClickedEventHandler = IO ()

type ContinueBTClickedEventHandler = IO ()

type BuildBTClickedEventHandler = IO ()

type SaveBTClickedEventHandler = IO ()

type IndentBTClickedEventHandler = IO ()

type UnIndentBTClickedEventHandler = IO ()

type CommentBTClickedEventHandler = IO ()

type UnCommentBTClickedEventHandler = IO ()


-- |
--
--
type CallbackHandlerId = HandlerId



-- |=====================================================================
--  Main
--

-- |
--   priorityHighIdle
--   priorityDefaultIdle
--
addCallback :: IO Bool -> IO CallbackHandlerId
addCallback f = idleAdd f priorityDefaultIdle


-- |
--
--
delCallback :: CallbackHandlerId -> IO ()
delCallback = idleRemove 


-- |
--
--
getGladeFile :: IO String
getGladeFile = getDataFileName _GLADE_FILE


-- |
--
--
getBuilder :: IO Builder
getBuilder = do
  initGUI

  builder <- builderNew
  gfile   <- getGladeFile
  builderAddFromFile builder gfile

  return builder


-- |
--
--
start :: Builder -> IO ()
start builder = do
  window <- builderGetObject builder castToWindow _WINDOW_NAME
  widgetShowAll window
  mainGUI


-- |
--
--
type MainWindowCloseEventHandler = IO ()
type MainWindowKeyPressEventHandler = String -> Bool -> Bool -> IO Bool
setupMainWindow :: Builder
                -> MainWindowCloseEventHandler
                -> MainWindowKeyPressEventHandler
                -> IO ()
setupMainWindow builder closeEvt keyEvt = do

  settings <- fromJust <$> settingsGetDefault
  settingsSetStringProperty settings "gtk-font-name" _FONT_DESC ""
  settingsSetStringProperty settings "gtk-menu-bar-accel" "" ""

  window <- builderGetObject builder castToWindow _WINDOW_NAME

  on window deleteEvent   $ mainWindowCloseEventHandler window closeEvt
  on window keyPressEvent $ mainWindowKeyPressEventHandler window keyEvt

  mainPaned <- builderGetObject builder castToPaned _NAME_MAIN_PANED
  panedSetPosition mainPaned 200

  codePaned <- builderGetObject builder castToPaned _NAME_CODE_PANED
  panedSetPosition codePaned 350


-- |
--  Event Handler
--
mainWindowCloseEventHandler :: Window -> MainWindowCloseEventHandler -> EventM EAny Bool
mainWindowCloseEventHandler self proc = liftIO $ do
  proc
  widgetDestroy self
  mainQuit

  return True


-- |
--  Event Handler
--
mainWindowKeyPressEventHandler :: Window -> MainWindowKeyPressEventHandler -> EventM EKey Bool
mainWindowKeyPressEventHandler _ evh = do
  name <- eventKeyName
  mods <- eventModifier

  liftIO $ evh (T.unpack name) (elem Shift mods) (elem Control mods)

-- |
--
--
isDebugStart :: Builder -> IO Bool
isDebugStart builder = do
  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetGetSensitive bt

-- |
--
--
isBuildStart :: Builder -> IO Bool
isBuildStart builder = do
  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetGetSensitive bt >>= return . not


-- |=====================================================================
--  Dialog 
--

-- |
--
--
getNameByFolderTreeDialog :: Builder -> String -> String -> String -> Bool -> IO (Maybe String)
getNameByFolderTreeDialog builder title msg value isEnabled = do
  dialog <- builderGetObject builder castToDialog "TreeFolderCreateFolderDialog"
  entry  <- builderGetObject builder castToEntry "TreeFolderCreateFolderEntry"
  label  <- builderGetObject builder castToLabel "TreeFolderCreateFolderLabel"

  entrySetText entry value
  set dialog [windowTitle := title]
  set entry [entryEditable := isEnabled]

  if isEnabled then widgetShowAll entry else widgetHide entry

  labelSetText label msg

  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      name <- entryGetText entry
                      return $ if null name then Nothing else Just name
    _              -> return Nothing

  widgetHide dialog

  return res


-- |
--
--
getSearchKeyBySearchDialog :: Builder -> String -> IO (Maybe String)
getSearchKeyBySearchDialog builder defaultStr = do
  dialog <- builderGetObject builder castToDialog "SearchDialog"
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entrySetText entry defaultStr

  widgetGrabFocus entry
  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      value <- entryGetText entry
                      return $ if null value then Nothing else Just value
    _              -> return Nothing

  widgetHide dialog

  return res

-- |
--
--
getSearchKeyFromSearchDialog :: Builder -> IO String
getSearchKeyFromSearchDialog builder = do
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entryGetText entry

-- |
--
--
getReplaceByReplaceDialog :: Builder  -> IO (Maybe (String, String))
getReplaceByReplaceDialog builder = do
  initReplaceDialog builder
  dialog <- builderGetObject builder castToDialog "ReplaceDialog"
  searchEntry  <- builderGetObject builder castToEntry "ReplaceDialogSearchEntry"
  replaceEntry <- builderGetObject builder castToEntry "ReplaceDialogReplaceEntry"

  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      searchVal <- entryGetText searchEntry
                      replaceVal <- entryGetText replaceEntry
                      getResult searchVal replaceVal
    _              -> return Nothing

  widgetHide dialog
  return res
  
  where
    getResult sVal rVal
      | null sVal && null rVal = return Nothing
      | otherwise = return $ Just (sVal, rVal)

-- |
--
--
initSearchDialog :: Builder -> IO ()
initSearchDialog builder = do
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entrySetText entry ""

-- |
--
--
initReplaceDialog :: Builder -> IO ()
initReplaceDialog builder = do
  searchEntry  <- builderGetObject builder castToEntry "ReplaceDialogSearchEntry"
  replaceEntry <- builderGetObject builder castToEntry "ReplaceDialogReplaceEntry"
  entrySetText searchEntry ""
  entrySetText replaceEntry ""


-- |=====================================================================
--  
--


-- |
--
--
setupToolButton :: Builder
                -> DebugStartBTClickedEventHandler
                -> DebugStopBTClickedEventHandler
                -> StepOverBTClickedEventHandler
                -> StepInBTClickedEventHandler
                -> ContinueBTClickedEventHandler
                -> BuildBTClickedEventHandler
                -> DeleteAllBreakBTClickedEventHandler
                -> SaveBTClickedEventHandler
                -> IndentBTClickedEventHandler
                -> UnIndentBTClickedEventHandler
                -> CommentBTClickedEventHandler
                -> UnCommentBTClickedEventHandler
                -> IO ()
setupToolButton builder debugStartEvh debugStopEvh stepOverEvh stepInEvh continueEvh buildEvh deleteEvh saveEvh indentEvh unIndentEvh commentEvh unCommentEvh = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  onToolButtonClicked bt debugStartEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  onToolButtonClicked bt debugStopEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  onToolButtonClicked bt stepOverEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  onToolButtonClicked bt stepInEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  onToolButtonClicked bt continueEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  onToolButtonClicked bt buildEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DELETE
  onToolButtonClicked bt deleteEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_SAVE
  onToolButtonClicked bt saveEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_INDENT
  onToolButtonClicked bt indentEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_UNINDENT
  onToolButtonClicked bt unIndentEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_COMMENT
  onToolButtonClicked bt commentEvh

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_UNCOMMENT
  onToolButtonClicked bt unCommentEvh

  setupDebugButtonOff builder

  return ()



-- |
--
--
setupDebugButtonOn :: Builder -> IO ()
setupDebugButtonOn builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

-- |
--
--
setupDebugButtonOff :: Builder -> IO ()
setupDebugButtonOff builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt True


-- |
--
--
setupBuildButtonOn :: Builder -> IO ()
setupBuildButtonOn builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt True

-- |
--
--
setupBuildButtonOff :: Builder -> IO ()
setupBuildButtonOff builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False


-- |=====================================================================
--  
--