|
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.
|