Menu
▾
▴
[htoolkit-cvs] port/src/Port Canvas.hs,1.10,1.11
|
From: <kr_...@us...> - 2003-02-03 16:53:44
|
Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv13436/port/src/Port
Modified Files:
Canvas.hs
Log Message:
The implementation of Canvas are changed for better performance. setPenColor, setPenBackColor, setPenHatchStyle and all other setPen* functions are replaced with single function which changes all attributes of Canvas in single step.
Index: Canvas.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Canvas.hs,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Canvas.hs 30 Jan 2003 23:07:23 -0000 1.10
--- Canvas.hs 3 Feb 2003 16:53:40 -0000 1.11
***************
*** 15,18 ****
--- 15,19 ----
( -- * Canvas
initCanvas, doneCanvas
+ , changeCanvasPen
-- * Draw
***************
*** 43,60 ****
, Pen(..), defaultPen
- -- ** Attributes
- , setPenSize
- , setPenColor
- , setPenDrawMode
-
- -- ** Styles
- , setPenJoinStyle
- , setPenCapStyle
- , setPenLineStyle
- , setPenHatchStyle
- , setPenBackDrawMode
-
-- ** Font
- , setPenFont
, getPenFontMetrics
, getPenFontCharWidth
--- 44,48 ----
***************
*** 64,72 ****
, mmToVPixels, mmToHPixels
, getResolution, getScaleFactor
-
- -- * Deprecated ? (undraw\/erase)
- , setPenBackColor
- , undrawRect
- , eraseRect
) where
--- 52,55 ----
***************
*** 85,97 ****
-- | The pencil embodies common drawing attributes.
data Pen = Pen
! { penSize :: Int -- ^ Thickness of the pencil
! , penMode :: DrawMode
! , penColor :: Color
! , penFont :: Font
! , penJoinStyle :: JoinStyle
! , penCapStyle :: CapStyle
! , penLineStyle :: LineStyle
! , penHatchStyle :: HatchStyle
! , penBackColor :: Color
}
--- 68,81 ----
-- | The pencil embodies common drawing attributes.
data Pen = Pen
! { penSize :: !Int -- ^ Thickness of the pencil
! , penMode :: !DrawMode
! , penColor :: !Color
! , penBackColor :: !Color
! , penBkDrawMode :: !Bool
! , penFont :: !Font
! , penJoinStyle :: !JoinStyle
! , penCapStyle :: !CapStyle
! , penLineStyle :: !LineStyle
! , penHatchStyle :: !HatchStyle
}
***************
*** 101,105 ****
defaultPen :: Pen
defaultPen
! = Pen 1 DrawCopy black defaultFont JoinRound CapRound LineSolid HatchSolid white
--- 85,89 ----
defaultPen :: Pen
defaultPen
! = Pen 1 DrawCopy black white False defaultFont JoinRound CapRound LineSolid HatchSolid
***************
*** 107,111 ****
-- any of the drawing operations.
initCanvas :: Pen -> BufferMode -> CanvasHandle -> IO ()
! initCanvas pen buffermode canvas
= withCFont (penFont pen) $ \cfont ->
withCLineStyle (penLineStyle pen) $ \cline clinecount clinestyles ->
--- 91,95 ----
-- any of the drawing operations.
initCanvas :: Pen -> BufferMode -> CanvasHandle -> IO ()
! initCanvas pen buffermode canvas
= withCFont (penFont pen) $ \cfont ->
withCLineStyle (penLineStyle pen) $ \cline clinecount clinestyles ->
***************
*** 118,122 ****
(toCCapStyle (penCapStyle pen))
cline clinecount clinestyles
! (toCBool False) -- bk draw mode
chatch chatchbmp
cfont
--- 102,106 ----
(toCCapStyle (penCapStyle pen))
cline clinecount clinestyles
! (toCBool (penBkDrawMode pen))
chatch chatchbmp
cfont
***************
*** 140,148 ****
Pen
-----------------------------------------------------------------------------------------}
! -- | Set the pen font.
! setPenFont :: Font -> CanvasHandle -> IO ()
! setPenFont font canvas
! = withCFont font $ \fhandle -> osSetFont fhandle canvas
! foreign import ccall osSetFont :: FontHandle -> CanvasHandle -> IO ()
-- | The metrics for the current pen font. (See also 'getFontMetrics').
--- 124,156 ----
Pen
-----------------------------------------------------------------------------------------}
!
! changeCanvasPen :: Pen -> CanvasHandle -> IO ()
! changeCanvasPen pen canvas =
! withCFont (penFont pen) $ \cfont ->
! withCLineStyle (penLineStyle pen) $ \cline clinecount clinestyles ->
! withCHatchStyle (penHatchStyle pen) $ \chatch chatchbmp ->
! osChangeCanvasPen (toCInt (penSize pen))
! (toCDrawMode (penMode pen))
! (toCColor (penColor pen))
! (toCColor (penBackColor pen))
! (toCJoinStyle (penJoinStyle pen))
! (toCCapStyle (penCapStyle pen))
! cline clinecount clinestyles
! (toCBool (penBkDrawMode pen))
! chatch chatchbmp
! cfont
! canvas
! foreign import ccall osChangeCanvasPen :: CInt -> CInt -> CWord -> CWord
! -> CInt -> CInt
! -> CInt -> CInt -> Ptr CUChar
! -> CBool
! -> CInt -> BitmapHandle
! -> FontHandle
! -> CanvasHandle -> IO ()
!
!
! {-----------------------------------------------------------------------------------------
! Font & Text metrics
! -----------------------------------------------------------------------------------------}
-- | The metrics for the current pen font. (See also 'getFontMetrics').
***************
*** 168,221 ****
foreign import ccall osGetStringWidth :: CString -> CanvasHandle -> IO CInt
- -- | Set the size of the pen.
- setPenSize :: Int -> CanvasHandle -> IO ()
- setPenSize sz canvas
- = osSetPenSize (toCInt sz) canvas
- foreign import ccall "osSetPenSize" osSetPenSize :: CInt -> CanvasHandle -> IO ()
-
- setPenColor :: Color -> CanvasHandle -> IO ()
- setPenColor c canvas
- = osSetPenColor (toCColor c) canvas
- foreign import ccall "osSetPenColor" osSetPenColor :: CWord -> CanvasHandle -> IO ()
-
- setPenBackColor :: Color -> CanvasHandle -> IO ()
- setPenBackColor c canvas
- = osSetBackColor (toCColor c) canvas
- foreign import ccall "osSetBackColor" osSetBackColor :: CWord -> CanvasHandle -> IO ()
-
- setPenDrawMode :: DrawMode -> CanvasHandle -> IO ()
- setPenDrawMode drawmode canvas
- = osSetDrawMode (toCDrawMode drawmode) canvas
- foreign import ccall "osSetPenFunction" osSetDrawMode :: CInt -> CanvasHandle -> IO ()
-
- -- | When back draw mode is set to @True@ and the hatch style is not solid then
- -- off segments are drawn with background color. When the mode is @False@ then
- -- off segments are trasparent.
- setPenBackDrawMode :: Bool -> CanvasHandle -> IO ()
- setPenBackDrawMode mode canvas
- = osSetBkDrawMode (toCBool mode) canvas
- foreign import ccall osSetBkDrawMode :: CBool -> CanvasHandle -> IO ()
-
- setPenJoinStyle :: JoinStyle -> CanvasHandle -> IO ()
- setPenJoinStyle join canvas
- = osSetPenJoinStyle (toCJoinStyle join) canvas
- foreign import ccall osSetPenJoinStyle :: CInt -> CanvasHandle -> IO ()
-
- setPenCapStyle :: CapStyle -> CanvasHandle -> IO ()
- setPenCapStyle cap canvas
- = osSetPenCapStyle (toCCapStyle cap) canvas
- foreign import ccall osSetPenCapStyle :: CInt -> CanvasHandle -> IO ()
-
- setPenLineStyle :: LineStyle -> CanvasHandle -> IO ()
- setPenLineStyle line canvas
- = withCLineStyle line $ \cstyle ccount cstyles ->
- osSetPenLineStyle cstyle ccount cstyles canvas
- foreign import ccall osSetPenLineStyle :: CInt -> CInt -> Ptr CUChar -> CanvasHandle -> IO ()
-
- setPenHatchStyle :: HatchStyle -> CanvasHandle -> IO ()
- setPenHatchStyle hatch canvas
- = withCHatchStyle hatch $ \cstyle cbitmap ->
- osSetPenHatchStyle cstyle cbitmap canvas
- foreign import ccall osSetPenHatchStyle :: CInt -> BitmapHandle -> CanvasHandle -> IO ()
{-----------------------------------------------------------------------------------------
--- 176,179 ----
***************
*** 312,326 ****
= withCRect rect $ \x0 y0 x1 y1 -> osFillRect x0 y0 x1 y1 canvas
foreign import ccall osFillRect :: CInt -> CInt -> CInt -> CInt -> CanvasHandle -> IO ()
-
- undrawRect :: Rect -> CanvasHandle -> IO ()
- undrawRect rect canvas
- = withCRect rect $ \x0 y0 x1 y1 -> osUndrawRect x0 y0 x1 y1 canvas
- foreign import ccall osUndrawRect :: CInt -> CInt -> CInt -> CInt -> CanvasHandle -> IO ()
-
- eraseRect :: Rect -> CanvasHandle -> IO ()
- eraseRect rect canvas
- = withCRect rect $ \x0 y0 x1 y1 -> osEraseRect x0 y0 x1 y1 canvas
- foreign import ccall osEraseRect :: CInt -> CInt -> CInt -> CInt -> CanvasHandle -> IO ()
-
{-----------------------------------------------------------------------------------------
--- 270,273 ----
|
