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 |