Menu
▾
▴
[Gtk2hs-commit] (main branch): Use Gdk.EventM replace Gdk.Events, and make demo simpler.
|
From: Andy S. <And...@co...> - 2009-11-23 03:15:05
|
Sun Nov 22 22:11:43 EST 2009 Andy Stewart <laz...@gm...>
* Use Gdk.EventM replace Gdk.Events, and make demo simpler.
Ignore-this: b20fa6438a839a94aa5757eabe07e90c
hunk ./demo/embbeded/Embedded.hs 13
-
-import Event
-import Key
+import Control.Monad.Trans
hunk ./demo/embbeded/Embedded.hs 18
-
-import qualified Graphics.UI.Gtk.Gdk.Events as E
+import Graphics.UI.Gtk.Gdk.EventM
hunk ./demo/embbeded/Embedded.hs 39
- let typeArg = read (head args) :: PlugType -- get Plug type
- idArg = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
-
- case typeArg of
- PlugEditor -> editorPlugMain idArg -- entry eidtor plug main
- PlugTerminal -> terminalPlugMain idArg -- entry terminal plug main
+ let pType = read (head args) :: PlugType -- get Plug type
+ id = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
hunk ./demo/embbeded/Embedded.hs 42
+ plugMain id pType
hunk ./demo/embbeded/Embedded.hs 46
--- | Handle key press.
-handleKeyPress :: E.Event -> Notebook -> IO Bool
-handleKeyPress ev notebook = [_$_]
- case eventTransform ev of
- Nothing -> return False
- Just e -> [_$_]
- case eventGetName e of
- "M-m" -> forkPlugProcess notebook PlugEditor "Editor" >> return True
- "M-n" -> forkPlugProcess notebook PlugTerminal "Terminal" >> return True
- _ -> return False
-
--- | Fork plug process.
-forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
-forkPlugProcess notebook plugType tabName = do
- -- Create new GtkSocket.
- socket <- socketNew
- widgetShow socket -- must show before add GtkSocekt to container
- notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
- id <- socketGetId socket -- get GtkSocket id
-
- -- Fork process to add GtkPlug into GtkSocekt. [_$_]
- forkProcess (do
- path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
- executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
- return ()
-
hunk ./demo/embbeded/Embedded.hs 63
- window `onKeyPress` (\event -> handleKeyPress event notebook)
+ window `on` keyPressEvent $ tryEvent $ do
+ keyModifier <- eventModifier
+ keyName <- eventKeyName
+ liftIO $ when (keyModifier == [Alt]) $ [_$_]
+ case keyName of
+ "m" -> forkPlugProcess notebook PlugEditor "Editor" -- create editor GtkPlug
+ "n" -> forkPlugProcess notebook PlugTerminal "Terminal" -- create terminal GtkPlug
hunk ./demo/embbeded/Embedded.hs 75
--- | Editor plug main.
-editorPlugMain :: NativeWindowId -> IO ()
-editorPlugMain id = do
- -- Create editor.
- textView <- textViewNew
- textBuffer <- textViewGetBuffer textView
- textBufferSetText textBuffer $ show id
-
- plugWrap id textView
+-- | GtkPlug main.
+plugMain :: NativeWindowId -> PlugType -> IO ()
+plugMain id PlugEditor = plugWrap id =<< createEditor
+plugMain id PlugTerminal = plugWrap id =<< createTerminal
hunk ./demo/embbeded/Embedded.hs 80
--- | Terminal plug main.
-terminalPlugMain :: NativeWindowId -> IO ()
-terminalPlugMain id = do
- -- Create terminal.
- terminal <- terminalNew
- terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
+-- | Fork plug process.
+forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
+forkPlugProcess notebook plugType tabName = do
+ -- Create new GtkSocket.
+ socket <- socketNew
+ widgetShow socket -- must show before add GtkSocekt to container
+ notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
+ id <- socketGetId socket -- get GtkSocket id
hunk ./demo/embbeded/Embedded.hs 89
- plugWrap id terminal
+ -- Fork process to add GtkPlug into GtkSocekt. [_$_]
+ path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
+ forkProcess (executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
+ return ()
hunk ./demo/embbeded/Embedded.hs 113
-
hunk ./demo/embbeded/Embedded.hs 114
+-- Create editor widget.
+createEditor :: IO TextView
+createEditor = textViewNew
+ [_$_]
+-- Create terminal widget.
+createTerminal :: IO Terminal [_$_]
+createTerminal = do
+ terminal <- terminalNew
+ terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
+ return terminal
hunk ./demo/embbeded/Event.hs 1
-module Event where
-
-import Data.List
-
-import Key
-
-import qualified Graphics.UI.Gtk.Gdk.Events as E
-
--- | The advanced event.
-data Event = Event Key [Modifier] deriving (Eq)
-
--- | Output event describe.
-eventGetName :: Event -> String
-eventGetName (Event key mods) = concatMap ((++ "-") . keyModifier) mods ++ keyDescribe key
- where [_$_]
- -- Key describe
- keyDescribe (KFun i) = 'F' : show i -- Function key (F1, F2, F3... etc.)
- keyDescribe (KASCII c) = [c] -- Character key ('A', 'B', 'C'... etc.)
- keyDescribe k = tail $ show k -- Control key (Ctrl, Alt, Shift... etc.)
- -- Key modifier
- keyModifier m = [show m !! 1]
-
--- | Transform basic event to advanced event. [_$_]
-eventTransform :: E.Event -> Maybe Event
-eventTransform (E.Key {E.eventKeyName = keyName, [_$_]
- E.eventKeyChar = keyChar,
- E.eventModifier = keyModifier})
- = fmap (\k -> Event k [_$_]
- (nub $ sort $ (if isShift [_$_]
- then filter (/= MShift) [_$_]
- else id) -- key
- $ concatMap eventTransformModifier keyModifier)) -- modifier
- key
- where
- (key, isShift) =
- case keyChar of
- Just c -> (Just $ KASCII c, True) -- character key
- Nothing -> (keyLookup keyName, False) -- other key
-eventTransform _ = Nothing
-
--- | Transform event modifier.
-eventTransformModifier E.Control = [MCtrl]
-eventTransformModifier E.Alt = [MMeta]
-eventTransformModifier E.Shift = [MShift]
-eventTransformModifier E.Super = [MSuper]
-eventTransformModifier _ = [] -- Use underscore so we don't depend on the differences between gtk2hs versions
rmfile ./demo/embbeded/Event.hs
hunk ./demo/embbeded/Key.hs 1
-module Key where
-
-import Data.Map (Map)
-
-import Text.Regex.TDFA
-import Data.Maybe
-
-import qualified Data.Map as M
-
--- | The key modifier for transform event.
-data Modifier = MShift | MCtrl | MMeta | MSuper
- deriving (Show,Eq,Ord)
-
--- | The key type.
-data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
- | KHome | KEnd | KPageUp | KPageDown | KDel | KNP5 | KUp | KMenu
- | KLeft | KDown | KRight | KEnter | KTab [_$_]
- deriving (Eq,Show,Ord)
-
-type Keytable = Map String Key
-
--- | Map GTK long names to Keys
-keyTable :: Keytable
-keyTable = M.fromList
- [("Down", KDown)
- ,("Up", KUp)
- ,("Left", KLeft)
- ,("Right", KRight)
- ,("Home", KHome)
- ,("End", KEnd)
- ,("BackSpace", KBS)
- ,("Delete", KDel)
- ,("Page_Up", KPageUp)
- ,("Page_Down", KPageDown)
- ,("Insert", KIns)
- ,("Escape", KEsc)
- ,("Return", KEnter)
- ,("Tab", KTab)
- ,("ISO_Left_Tab", KTab)]
-
--- | Lookup key name from key table.
-keyLookup :: String -> Maybe Key
-keyLookup keyName = [_$_]
- case key of
- Just k -> Just k -- control key
- Nothing -> if keyName =~ "^F[0-9]+$" :: Bool [_$_]
- then Just $ KFun (read (tail keyName) :: Int) -- function key
- else Nothing -- other key
- where
- key = M.lookup keyName keyTable
rmfile ./demo/embbeded/Key.hs
hunk ./demo/embbeded/Makefile 1
-
hunk ./demo/embbeded/Makefile 2
-SOURCES = Embedded.hs Event.hs Key.hs
+SOURCES = Embedded.hs
|
