{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Phoityne.IO.GUI.GTK.ConsoleView ( ConsoleDoubleClickedHandler , setupConsoleView , putStrConsole , putStrLnConsole , clearConsole ) where -- モジュール import Phoityne.Constant import Phoityne.IO.GUI.GTK.Constant import Phoityne.IO.GUI.GTK.Utility -- システム import GHC.Float import Graphics.UI.Gtk import Control.Monad.IO.Class import System.Log.Logger import Data.String.Utils import qualified Data.Text as T -- | -- -- type ConsoleDoubleClickedHandler = String -> IO () -- | -- -- setupConsoleView :: Builder -> ConsoleDoubleClickedHandler -> IO () setupConsoleView builder evh = do textView <- builderGetObject builder castToTextView _NAME_CONSOLE_TEXT_VIEW _ <- on textView buttonPressEvent $ consoleDoubleClickedHandler textView evh _ <- on textView keyPressEvent $ eventKeyName >>= \k->if k==T.pack("F7") then return True else return False return () -- | -- -- consoleDoubleClickedHandler :: TextView -> ConsoleDoubleClickedHandler -> EventM EButton Bool consoleDoubleClickedHandler self evh = eventClick >>= \case DoubleClick -> doubleClicked >> return True _ -> return False where doubleClicked = do (_, posYd) <- eventCoordinates liftIO $ do scrollY <- textViewGetVadjustment self >>= adjustmentGetValue let posY = scrollY + posYd (stIter, _) <- textViewGetLineAtY self $ double2Int posY edIter <- textIterCopy stIter _ <- textViewForwardDisplayLineEnd self edIter buf <- textViewGetBuffer self str <- textBufferGetText buf stIter edIter True evh str -- | -- -- clearConsole :: Builder -> IO () clearConsole builder = do view <- builderGetObject builder castToTextView _NAME_CONSOLE_TEXT_VIEW buf <- textViewGetBuffer view textBufferSetText buf (""::String) -- | -- -- putStrConsole :: Builder -> String -> IO () putStrConsole = append2Console -- | -- -- putStrLnConsole :: Builder -> String -> IO () putStrLnConsole builder str = append2Console builder (str ++ "\n") -- | -- -- append2Console :: Builder -> String -> IO () append2Console builder msg = do debugM _LOG_NAME $ strip msg textView <- builderGetObject builder castToTextView _NAME_CONSOLE_TEXT_VIEW buf <- textViewGetBuffer textView iter <- textBufferGetEndIter buf textBufferInsert buf iter msg window <- builderGetObject builder castToWindow _WINDOW_NAME widgetShowAll window scroll <- builderGetObject builder castToScrolledWindow _NAME_CONSOLE_SCROLLED_WINDOW widgetShowAll scroll forceEvent lineNum <- textBufferGetLineCount buf iter <- textBufferGetIterAtLine buf lineNum _ <- textViewScrollToIter textView iter 0.0 Nothing forceEvent return ()