|
From: <kr_...@us...> - 2003-01-31 01:02:18
|
Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv18912/port/src/Port
Modified Files:
Menu.hs Types.hs
Log Message:
Replace definition of Key with its own definition from HToolkit
Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Menu.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Menu.hs 30 Jan 2003 23:09:46 -0000 1.3
--- Menu.hs 31 Jan 2003 01:01:42 -0000 1.4
***************
*** 55,70 ****
-- short-cut key should be registered. An event handler for a menu item can be
-- installed with 'registerMenuCommand'.
! addMenuItem :: MenuHandle -> Key -> Modifiers -> String -> IO MenuHandle
! addMenuItem hmenu key mod title
= withCString title $ \ctitle ->
! osAddMenuItem hmenu (toCKey key) (toCModifiers mod) ctitle
foreign import ccall osAddMenuItem :: MenuHandle -> CInt -> CWord -> CString -> IO MenuHandle
-- | Add a checkable menu item. An event handler for a menu item can be
-- installed with 'registerMenuCommand'.
! addMenuCheckItem :: MenuHandle -> Key -> Modifiers -> String -> IO MenuHandle
! addMenuCheckItem hmenu key mod title
= withCString title $ \ctitle ->
! osAddMenuCheckItem hmenu (toCKey key) (toCModifiers mod) ctitle
foreign import ccall osAddMenuCheckItem :: MenuHandle -> CInt -> CWord -> CString -> IO MenuHandle
--- 55,72 ----
-- short-cut key should be registered. An event handler for a menu item can be
-- installed with 'registerMenuCommand'.
! addMenuItem :: MenuHandle -> Key -> String -> IO MenuHandle
! addMenuItem hmenu key title
= withCString title $ \ctitle ->
! let (ckey,cmods) = toCKey key
! in osAddMenuItem hmenu ckey cmods ctitle
foreign import ccall osAddMenuItem :: MenuHandle -> CInt -> CWord -> CString -> IO MenuHandle
-- | Add a checkable menu item. An event handler for a menu item can be
-- installed with 'registerMenuCommand'.
! addMenuCheckItem :: MenuHandle -> Key -> String -> IO MenuHandle
! addMenuCheckItem hmenu key title
= withCString title $ \ctitle ->
! let (ckey,cmods) = toCKey key
! in osAddMenuCheckItem hmenu ckey cmods ctitle
foreign import ccall osAddMenuCheckItem :: MenuHandle -> CInt -> CWord -> CString -> IO MenuHandle
***************
*** 76,83 ****
-- | Change the label (and short-cut key) of a menu item (or checkable menu item).
! setMenuItemLabel :: MenuHandle -> MenuHandle -> Key -> Modifiers -> String -> IO ()
! setMenuItemLabel hparent hmenu key mod title
= withCString title $ \ctitle ->
! osSetMenuItemLabel hparent hmenu (toCKey key) (toCModifiers mod) ctitle
foreign import ccall osSetMenuItemLabel :: MenuHandle -> MenuHandle -> CInt -> CWord -> CString -> IO ()
--- 78,86 ----
-- | Change the label (and short-cut key) of a menu item (or checkable menu item).
! setMenuItemLabel :: MenuHandle -> MenuHandle -> Key -> String -> IO ()
! setMenuItemLabel hparent hmenu key title
= withCString title $ \ctitle ->
! let (ckey,cmods) = toCKey key
! in osSetMenuItemLabel hparent hmenu ckey cmods ctitle
foreign import ccall osSetMenuItemLabel :: MenuHandle -> MenuHandle -> CInt -> CWord -> CString -> IO ()
***************
*** 93,100 ****
= osSetCheckMenuItemState parent item (toCBool enable)
foreign import ccall osSetCheckMenuItemState :: MenuHandle -> MenuHandle -> CBool -> IO ()
-
-
-
-
-
-
--- 96,97 ----
Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Types.hs 30 Jan 2003 23:58:07 -0000 1.11
--- Types.hs 31 Jan 2003 01:01:43 -0000 1.12
***************
*** 75,80 ****
-- ** Keyboard events
! , KeyboardEvent(..), Key(..), keyNull
! , keyboardKey, keyboardModifiers, keyboardRepeat
-- * Primitive Handles
--- 75,80 ----
-- ** Keyboard events
! , KeyboardEvent(..), Key(..), keyModifiers
! , keyboardKey, keyboardRepeat
-- * Primitive Handles
***************
*** 103,107 ****
, withCRect, withCRectResult, fromCRect
- , fromCModifiers, toCModifiers
, fromCKey, toCKey
, fromCMouseEvent
--- 103,106 ----
***************
*** 588,599 ****
KeyboardEvent
-----------------------------------------------------------------------------------------}
! -- | The KeyboardEvent type. Note that the modifiers for 'KeyChar' can only be 'altDown'.
! -- A 'shiftDown' gets translated into an upper-case character and a 'controlDown' in a
! -- control character. Alt-character combinations are normally processed by the system
! -- to handle menu's etc.
data KeyboardEvent
! = KeyDown !Key !Modifiers !IsRepeatKey -- ^ Key is down
! | KeyUp !Key !Modifiers -- ^ Key goes up
! | KeyLost !Key !Modifiers -- ^ The key was down when the widget lost focus
deriving (Eq,Show)
--- 587,595 ----
KeyboardEvent
-----------------------------------------------------------------------------------------}
! -- | The KeyboardEvent type.
data KeyboardEvent
! = KeyDown !Key !IsRepeatKey -- ^ Key is down
! | KeyUp !Key -- ^ Key goes up
! | KeyLost !Key -- ^ The key was down when the widget lost focus
deriving (Eq,Show)
***************
*** 601,625 ****
type IsRepeatKey = Bool
- -- | A /null/ key equals (@KeyChar (toEnum 0)@). It can be used to specify for example
- -- that the menu has no shortcut key.
- keyNull :: Key
- keyNull
- = KeyChar '\0'
-
-- | Extract the key from a 'KeyboardEvent'
keyboardKey :: KeyboardEvent -> Key
keyboardKey event
= case event of
! KeyDown key mod repeat -> key
! KeyUp key mod -> key
! KeyLost key mod -> key
!
! -- | Extract the modifiers from a 'KeyboardEvent'
! keyboardModifiers :: KeyboardEvent -> Modifiers
! keyboardModifiers event
! = case event of
! KeyDown key mod repeat -> mod
! KeyUp key mod -> mod
! KeyLost key mod -> mod
-- | Is this a key that is held down.
--- 597,607 ----
type IsRepeatKey = Bool
-- | Extract the key from a 'KeyboardEvent'
keyboardKey :: KeyboardEvent -> Key
keyboardKey event
= case event of
! KeyDown key repeat -> key
! KeyUp key -> key
! KeyLost key -> key
-- | Is this a key that is held down.
***************
*** 627,756 ****
keyboardRepeat event
= case event of
! KeyDown key mod repeat -> repeat
! other -> False
! -- | Keyboard keys
data Key
! = KeyBegin
! | KeyClear
! | KeyDelete
! | KeyEnd
! | KeyArrowDown
! | KeyArrowLeft
! | KeyArrowRight
! | KeyArrowUp
! | KeyPageDown
! | KeyPageUp
! | KeyEscape
! | KeyEnter
! | KeyTab
! | KeyBackSpace
! | KeyF1
! | KeyF2
! | KeyF3
! | KeyF4
! | KeyF5
! | KeyF6
! | KeyF7
! | KeyF8
! | KeyF9
! | KeyF10
! | KeyF11
! | KeyF12
! | KeyF13
! | KeyF14
! | KeyF15
! | KeyHelp
| KeyChar !Char
deriving (Eq,Show)
- fromCKey :: CInt -> Key
- fromCKey ci
- = case fromCInt ci of
- 8 -> KeyBackSpace
- 9 -> KeyTab
- 13 -> KeyEnter
- 27 -> KeyEscape
- 1003 -> KeyBegin
- 1004 -> KeyClear
- 1005 -> KeyDelete
- 1006 -> KeyArrowDown
- 1007 -> KeyEnd
- 1010 -> KeyF1
- 1011 -> KeyF2
- 1012 -> KeyF3
- 1013 -> KeyF4
- 1014 -> KeyF5
- 1015 -> KeyF6
- 1016 -> KeyF7
- 1017 -> KeyF8
- 1018 -> KeyF9
- 1019 -> KeyF10
- 1020 -> KeyF11
- 1021 -> KeyF12
- 1022 -> KeyF13
- 1023 -> KeyF14
- 1024 -> KeyF15
- 1025 -> KeyHelp
- 1026 -> KeyArrowLeft
- 1027 -> KeyPageDown
- 1028 -> KeyPageUp
- 1029 -> KeyArrowRight
- 1030 -> KeyArrowUp
- i -> KeyChar (toEnum i)
! toCKey :: Key -> CInt
! toCKey key
! = toCInt $
! case key of
! KeyBackSpace -> 8
! KeyTab -> 9
! KeyEnter -> 13
! KeyEscape -> 27
! KeyBegin -> 1003
! KeyClear -> 1004
! KeyDelete -> 1005
! KeyArrowDown -> 1006
! KeyEnd -> 1007
! KeyF1 -> 1010
! KeyF2 -> 1011
! KeyF3 -> 1012
! KeyF4 -> 1013
! KeyF5 -> 1014
! KeyF6 -> 1015
! KeyF7 -> 1016
! KeyF8 -> 1017
! KeyF9 -> 1018
! KeyF10 -> 1019
! KeyF11 -> 1020
! KeyF12 -> 1021
! KeyF13 -> 1022
! KeyF14 -> 1023
! KeyF15 -> 1024
! KeyHelp -> 1025
! KeyArrowLeft -> 1026
! KeyPageDown -> 1027
! KeyPageUp -> 1028
! KeyArrowRight -> 1029
! KeyArrowUp -> 1030
! KeyChar c -> fromEnum c
- adjustKeyAltChar :: Key -> Modifiers -> (Key,Modifiers)
- adjustKeyAltChar (KeyChar c) mods | fromEnum c >= 256
- = (KeyChar (toEnum (fromEnum c - 256)), mods{ altDown = True })
- adjustKeyAltChar key mods
- = (key,mods)
fromCKeyboardEvent :: CInt -> CInt -> CWord -> KeyboardEvent
fromCKeyboardEvent cevent ckey cmodifiers
! = fromCEvent cevent (adjustKeyAltChar (fromCKey ckey) (fromCModifiers cmodifiers))
where
! fromCEvent cevent (key,modifiers)
= case fromCInt cevent of
! 10 -> KeyDown key modifiers False
! 11 -> KeyDown key modifiers True
! 12 -> KeyUp key modifiers
! 13 -> KeyLost key modifiers
--- 609,780 ----
keyboardRepeat event
= case event of
! KeyDown key repeat -> repeat
! other -> False
! -- | Keyboard keys.
! -- A Shift-character combinations gets translated into an upper-case character and a Ctrl-character in a
! -- control character. Alt-character combinations are normally processed by the system
! -- to handle menu's etc.
data Key
! = KeyBegin Modifiers
! | KeyClear Modifiers
! | KeyDelete Modifiers
! | KeyEnd Modifiers
! | KeyArrowDown Modifiers
! | KeyArrowLeft Modifiers
! | KeyArrowRight Modifiers
! | KeyArrowUp Modifiers
! | KeyPageDown Modifiers
! | KeyPageUp Modifiers
! | KeyEscape Modifiers
! | KeyEnter Modifiers
! | KeyTab Modifiers
! | KeyBackSpace Modifiers
! | KeyF1 Modifiers
! | KeyF2 Modifiers
! | KeyF3 Modifiers
! | KeyF4 Modifiers
! | KeyF5 Modifiers
! | KeyF6 Modifiers
! | KeyF7 Modifiers
! | KeyF8 Modifiers
! | KeyF9 Modifiers
! | KeyF10 Modifiers
! | KeyF11 Modifiers
! | KeyF12 Modifiers
! | KeyF13 Modifiers
! | KeyF14 Modifiers
! | KeyF15 Modifiers
! | KeyHelp Modifiers
| KeyChar !Char
+ | KeyAltChar !Char
+ | KeyNull
deriving (Eq,Show)
+
+ -- | Extract the modifiers from a key
+ keyModifiers :: Key -> Modifiers
+ keyModifiers (KeyBegin mods) = mods
+ keyModifiers (KeyClear mods) = mods
+ keyModifiers (KeyDelete mods) = mods
+ keyModifiers (KeyEnd mods) = mods
+ keyModifiers (KeyArrowDown mods) = mods
+ keyModifiers (KeyArrowLeft mods) = mods
+ keyModifiers (KeyArrowRight mods) = mods
+ keyModifiers (KeyArrowUp mods) = mods
+ keyModifiers (KeyPageDown mods) = mods
+ keyModifiers (KeyPageUp mods) = mods
+ keyModifiers (KeyEscape mods) = mods
+ keyModifiers (KeyEnter mods) = mods
+ keyModifiers (KeyTab mods) = mods
+ keyModifiers (KeyBackSpace mods) = mods
+ keyModifiers (KeyF1 mods) = mods
+ keyModifiers (KeyF2 mods) = mods
+ keyModifiers (KeyF3 mods) = mods
+ keyModifiers (KeyF4 mods) = mods
+ keyModifiers (KeyF5 mods) = mods
+ keyModifiers (KeyF6 mods) = mods
+ keyModifiers (KeyF7 mods) = mods
+ keyModifiers (KeyF8 mods) = mods
+ keyModifiers (KeyF9 mods) = mods
+ keyModifiers (KeyF10 mods) = mods
+ keyModifiers (KeyF11 mods) = mods
+ keyModifiers (KeyF12 mods) = mods
+ keyModifiers (KeyF13 mods) = mods
+ keyModifiers (KeyF14 mods) = mods
+ keyModifiers (KeyF15 mods) = mods
+ keyModifiers (KeyHelp mods) = mods
+ keyModifiers (KeyChar _ ) = noModifiers
+ keyModifiers (KeyAltChar _ ) = noModifiers
+ keyModifiers (KeyNull ) = noModifiers
! fromCKey :: CInt -> CWord -> Key
! fromCKey ci cmodifiers =
! let mods = fromCModifiers cmodifiers
! in case fromCInt ci of
! 0 -> KeyNull
! 8 -> KeyBackSpace mods
! 9 -> KeyTab mods
! 13 -> KeyEnter mods
! 27 -> KeyEscape mods
! 1003 -> KeyBegin mods
! 1004 -> KeyClear mods
! 1005 -> KeyDelete mods
! 1006 -> KeyArrowDown mods
! 1007 -> KeyEnd mods
! 1010 -> KeyF1 mods
! 1011 -> KeyF2 mods
! 1012 -> KeyF3 mods
! 1013 -> KeyF4 mods
! 1014 -> KeyF5 mods
! 1015 -> KeyF6 mods
! 1016 -> KeyF7 mods
! 1017 -> KeyF8 mods
! 1018 -> KeyF9 mods
! 1019 -> KeyF10 mods
! 1020 -> KeyF11 mods
! 1021 -> KeyF12 mods
! 1022 -> KeyF13 mods
! 1023 -> KeyF14 mods
! 1024 -> KeyF15 mods
! 1025 -> KeyHelp mods
! 1026 -> KeyArrowLeft mods
! 1027 -> KeyPageDown mods
! 1028 -> KeyPageUp mods
! 1029 -> KeyArrowRight mods
! 1030 -> KeyArrowUp mods
! i -> if i > 256
! then KeyAltChar (toEnum (i-256))
! else KeyChar (toEnum i)
+ toCKey :: Key -> (CInt,CWord)
+ toCKey key = (toCInt keyCode, toCModifiers mods)
+ where
+ (keyCode, mods) = case key of
+ KeyBackSpace mods -> (8, mods)
+ KeyTab mods -> (9, mods)
+ KeyEnter mods -> (13, mods)
+ KeyEscape mods -> (27, mods)
+ KeyBegin mods -> (1003, mods)
+ KeyClear mods -> (1004, mods)
+ KeyDelete mods -> (1005, mods)
+ KeyArrowDown mods -> (1006, mods)
+ KeyEnd mods -> (1007, mods)
+ KeyF1 mods -> (1010, mods)
+ KeyF2 mods -> (1011, mods)
+ KeyF3 mods -> (1012, mods)
+ KeyF4 mods -> (1013, mods)
+ KeyF5 mods -> (1014, mods)
+ KeyF6 mods -> (1015, mods)
+ KeyF7 mods -> (1016, mods)
+ KeyF8 mods -> (1017, mods)
+ KeyF9 mods -> (1018, mods)
+ KeyF10 mods -> (1019, mods)
+ KeyF11 mods -> (1020, mods)
+ KeyF12 mods -> (1021, mods)
+ KeyF13 mods -> (1022, mods)
+ KeyF14 mods -> (1023, mods)
+ KeyF15 mods -> (1024, mods)
+ KeyHelp mods -> (1025, mods)
+ KeyArrowLeft mods -> (1026, mods)
+ KeyPageDown mods -> (1027, mods)
+ KeyPageUp mods -> (1028, mods)
+ KeyArrowRight mods -> (1029, mods)
+ KeyArrowUp mods -> (1030, mods)
+ KeyChar c -> (fromEnum c, noModifiers)
+ KeyAltChar c -> (fromEnum c+256, noModifiers)
+ KeyNull -> (0, noModifiers)
fromCKeyboardEvent :: CInt -> CInt -> CWord -> KeyboardEvent
fromCKeyboardEvent cevent ckey cmodifiers
! = fromCEvent cevent (fromCKey ckey cmodifiers)
where
! fromCEvent cevent key
= case fromCInt cevent of
! 10 -> KeyDown key False
! 11 -> KeyDown key True
! 12 -> KeyUp key
! 13 -> KeyLost key
|