From: <kr_...@us...> - 2003-01-30 23:09:50
|
Update of /cvsroot/htoolkit/port/src/Port In directory sc8-pr-cvs1:/tmp/cvs-serv13141/src/Port Modified Files: Handlers.hs Menu.hs Types.hs Log Message: Types fix Index: Handlers.hs =================================================================== RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Handlers.hs 27 Jan 2003 21:18:30 -0000 1.5 --- Handlers.hs 30 Jan 2003 23:09:46 -0000 1.6 *************** *** 535,539 **** = unregister hwnd handlersWindowMouse ! handleWindowMouse :: WindowHandle -> CInt -> CInt -> CInt -> CInt -> IO () handleWindowMouse hwnd cevent cx cy cmodifiers = invokeHandler hwnd handlersWindowMouse (\f -> f (fromCMouseEvent cevent cx cy cmodifiers)) --- 535,539 ---- = unregister hwnd handlersWindowMouse ! handleWindowMouse :: WindowHandle -> CInt -> CInt -> CInt -> CWord -> IO () handleWindowMouse hwnd cevent cx cy cmodifiers = invokeHandler hwnd handlersWindowMouse (\f -> f (fromCMouseEvent cevent cx cy cmodifiers)) *************** *** 553,557 **** = unregister hwnd handlersWindowKeyboard ! handleWindowKeyboard :: WindowHandle -> CInt -> CInt -> CInt -> IO () handleWindowKeyboard hwnd cevent ckey cmodifiers = invokeHandler hwnd handlersWindowKeyboard (\f -> f (fromCKeyboardEvent cevent ckey cmodifiers)) --- 553,557 ---- = unregister hwnd handlersWindowKeyboard ! handleWindowKeyboard :: WindowHandle -> CInt -> CInt -> CWord -> IO () handleWindowKeyboard hwnd cevent ckey cmodifiers = invokeHandler hwnd handlersWindowKeyboard (\f -> f (fromCKeyboardEvent cevent ckey cmodifiers)) *************** *** 641,646 **** foreign export ccall handleWindowResize :: WindowHandle -> CInt -> CInt -> IO () foreign export ccall handleWindowScroll :: WindowHandle -> CInt -> CInt -> IO () ! foreign export ccall handleWindowMouse :: WindowHandle -> CInt -> CInt -> CInt -> CInt -> IO () ! foreign export ccall handleWindowKeyboard :: WindowHandle -> CInt -> CInt -> CInt -> IO () foreign export ccall handleWindowDeactivate :: WindowHandle -> IO () foreign export ccall handleWindowActivate :: WindowHandle -> IO () --- 641,646 ---- foreign export ccall handleWindowResize :: WindowHandle -> CInt -> CInt -> IO () foreign export ccall handleWindowScroll :: WindowHandle -> CInt -> CInt -> IO () ! foreign export ccall handleWindowMouse :: WindowHandle -> CInt -> CInt -> CInt -> CWord -> IO () ! foreign export ccall handleWindowKeyboard :: WindowHandle -> CInt -> CInt -> CWord -> IO () foreign export ccall handleWindowDeactivate :: WindowHandle -> IO () foreign export ccall handleWindowActivate :: WindowHandle -> IO () Index: Menu.hs =================================================================== RCS file: /cvsroot/htoolkit/port/src/Port/Menu.hs,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Menu.hs 20 Jan 2003 12:22:59 -0000 1.2 --- Menu.hs 30 Jan 2003 23:09:46 -0000 1.3 *************** *** 59,63 **** = withCString title $ \ctitle -> osAddMenuItem hmenu (toCKey key) (toCModifiers mod) ctitle ! foreign import ccall osAddMenuItem :: MenuHandle -> CInt -> CInt -> CString -> IO MenuHandle -- | Add a checkable menu item. An event handler for a menu item can be --- 59,63 ---- = 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 *************** *** 67,71 **** = withCString title $ \ctitle -> osAddMenuCheckItem hmenu (toCKey key) (toCModifiers mod) ctitle ! foreign import ccall osAddMenuCheckItem :: MenuHandle -> CInt -> CInt -> CString -> IO MenuHandle -- | Add a menu item separator line. --- 67,71 ---- = withCString title $ \ctitle -> osAddMenuCheckItem hmenu (toCKey key) (toCModifiers mod) ctitle ! foreign import ccall osAddMenuCheckItem :: MenuHandle -> CInt -> CWord -> CString -> IO MenuHandle -- | Add a menu item separator line. *************** *** 80,84 **** = withCString title $ \ctitle -> osSetMenuItemLabel hparent hmenu (toCKey key) (toCModifiers mod) ctitle ! foreign import ccall osSetMenuItemLabel :: MenuHandle -> MenuHandle -> CInt -> CInt -> CString -> IO () -- | Enable or disable a menu item. --- 80,84 ---- = withCString title $ \ctitle -> osSetMenuItemLabel hparent hmenu (toCKey key) (toCModifiers mod) ctitle ! foreign import ccall osSetMenuItemLabel :: MenuHandle -> MenuHandle -> CInt -> CWord -> CString -> IO () -- | Enable or disable a menu item. Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Types.hs 30 Jan 2003 20:04:36 -0000 1.9 --- Types.hs 30 Jan 2003 23:09:46 -0000 1.10 *************** *** 244,255 **** pointMoveBySize (Size w h) (Point x y) = Point (x + w) (y + h) ! pointAdd :: Vector -> Vector -> Vector ! pointAdd (Vector x1 y1) (Vector x2 y2) = Vector (x1+x2) (y1+y2) ! pointSub :: Vector -> Vector -> Vector ! pointSub (Vector x1 y1) (Vector x2 y2) = Vector (x1-x2) (y1-y2) ! pointScale :: Int -> Vector -> Vector ! pointScale v (Vector x y) = Vector (v*x) (v*y) --- 244,255 ---- pointMoveBySize (Size w h) (Point x y) = Point (x + w) (y + h) ! pointAdd :: Point -> Point -> Point ! pointAdd (Point x1 y1) (Point x2 y2) = Point (x1+x2) (y1+y2) ! pointSub :: Point -> Point -> Point ! pointSub (Point x1 y1) (Point x2 y2) = Point (x1-x2) (y1-y2) ! pointScale :: Int -> Point -> Point ! pointScale v (Point x y) = Point (v*x) (v*y) *************** *** 380,384 **** centralPoint :: Rect -> Point ! centralPoint (Rect l t r b) = Point ((l + r) `div` 2) ((t + b) `div` 2) centralRect :: Rect -> Size -> Rect --- 380,384 ---- centralPoint :: Rect -> Point ! centralPoint (Rect l t r b) = Point ((l + r) `quot` 2) ((t + b) `quot` 2) centralRect :: Rect -> Size -> Rect *************** *** 387,394 **** u = r - l v = b - t ! x = (r + l) `div` 2 ! y = (b + t) `div` 2 ! dx = (min w u) `div` 2 ! dy = (min h v) `div` 2 in Rect (x - dx) (y - dy) (x + dx) (y + dy) --- 387,394 ---- u = r - l v = b - t ! x = (r + l) `quot` 2 ! y = (b + t) `quot` 2 ! dx = (min w u) `quot` 2 ! dy = (min h v) `quot` 2 in Rect (x - dx) (y - dy) (x + dx) (y + dy) *************** *** 468,482 **** ! fromCModifiers :: CInt -> Modifiers fromCModifiers ci = Modifiers (bitsSet i 0x01) (bitsSet i 0x02) (bitsSet i 0x04) where ! i = fromCInt ci ! bitsSet x mask = odd (x `div` mask) ! ! toCModifiers :: Modifiers -> CInt toCModifiers (Modifiers shift control alt) ! = toCInt ((mask 0x01 shift) + (mask 0x02 control) + (mask 0x04 alt)) where mask m test = if test then m else 0 --- 468,481 ---- ! fromCModifiers :: CWord -> Modifiers fromCModifiers ci = Modifiers (bitsSet i 0x01) (bitsSet i 0x02) (bitsSet i 0x04) where ! i = fromCWord ci ! bitsSet x mask = x .&. 0x01 /= 0 ! toCModifiers :: Modifiers -> CWord toCModifiers (Modifiers shift control alt) ! = toCWord ((mask 0x01 shift) + (mask 0x02 control) + (mask 0x04 alt)) where mask m test = if test then m else 0 *************** *** 497,501 **** | MouseDoubleClick !Point !Modifiers -- ^ Mouse left button is double clicked | MouseDrag !Point !Modifiers -- ^ Mouse is moved over the client area of the window and its left button is down - | MouseUnknown !Int !Point !Modifiers -- ^ Unknown mouse event with identifier. deriving (Eq,Show) --- 496,499 ---- *************** *** 513,517 **** MouseDoubleClick p m-> p MouseDrag p m -> p - MouseUnknown i p m -> p -- | Extract the modifiers from a 'MouseEvent'. --- 511,514 ---- *************** *** 528,534 **** MouseDoubleClick p m-> m MouseDrag p m -> m - MouseUnknown i p m -> m ! fromCMouseEvent :: CInt -> CInt -> CInt -> CInt -> MouseEvent fromCMouseEvent cevent cx cy cmodifiers = fromCEvent cevent (fromCPoint cx cy) (fromCModifiers cmodifiers) --- 525,530 ---- MouseDoubleClick p m-> m MouseDrag p m -> m ! fromCMouseEvent :: CInt -> CInt -> CInt -> CWord -> MouseEvent fromCMouseEvent cevent cx cy cmodifiers = fromCEvent cevent (fromCPoint cx cy) (fromCModifiers cmodifiers) *************** *** 545,549 **** 8 -> MouseLeftUp 9 -> MouseRightUp - _ -> MouseUnknown (fromIntegral cevent) {----------------------------------------------------------------------------------------- --- 541,544 ---- *************** *** 558,562 **** | KeyUp !Key !Modifiers -- ^ Key goes up | KeyLost !Key !Modifiers -- ^ The key was down when the widget lost focus - | KeyUnknown !Key !Modifiers -- ^ Unknown keyboard event deriving (Eq,Show) --- 553,556 ---- *************** *** 577,581 **** KeyUp key mod -> key KeyLost key mod -> key - KeyUnknown key mod -> key -- | Extract the modifiers from a 'KeyboardEvent' --- 571,574 ---- *************** *** 586,590 **** KeyUp key mod -> mod KeyLost key mod -> mod - KeyUnknown key mod -> mod -- | Is this a key that is held down. --- 579,582 ---- *************** *** 708,712 **** = (key,mods) ! fromCKeyboardEvent :: CInt -> CInt -> CInt -> KeyboardEvent fromCKeyboardEvent cevent ckey cmodifiers = fromCEvent cevent (adjustKeyAltChar (fromCKey ckey) (fromCModifiers cmodifiers)) --- 700,704 ---- = (key,mods) ! fromCKeyboardEvent :: CInt -> CInt -> CWord -> KeyboardEvent fromCKeyboardEvent cevent ckey cmodifiers = fromCEvent cevent (adjustKeyAltChar (fromCKey ckey) (fromCModifiers cmodifiers)) *************** *** 718,722 **** 12 -> KeyUp key modifiers 13 -> KeyLost key modifiers - _ -> KeyUnknown key modifiers --- 710,713 ---- *************** *** 785,789 **** | LineDashDot -- ^ Dash - Dot pattern. | LineDashDotDot -- ^ Dash - Dot - Dot pattern. ! | LineCustomStyle [Int] -- ^ Custom pattern: each element specifies the pixel length of a dash (between 0 and 127). deriving (Eq,Show) --- 776,780 ---- | LineDashDot -- ^ Dash - Dot pattern. | LineDashDotDot -- ^ Dash - Dot - Dot pattern. ! | LineCustomStyle [Word8] -- ^ Custom pattern: each element specifies the pixel length of a dash. deriving (Eq,Show) *************** *** 799,809 **** -> let n = length xs in do pstyles <- mallocArray n ! pokeArray pstyles (map (fromIntegral . bounded 0 127) xs) f 5 (toCInt n) pstyles -- freed by library ! where ! bounded low high x ! | x < low = low ! | x > high = high ! | otherwise = x -- | The 'HatchStyle' is applied when filling an object. --- 790,796 ---- -> let n = length xs in do pstyles <- mallocArray n ! pokeArray pstyles (map fromIntegral xs) f 5 (toCInt n) pstyles -- freed by library ! -- | The 'HatchStyle' is applied when filling an object. |