Portabilityportable
Stabilityprovisional
Maintainerwxhaskell-devel@lists.sourceforge.net

Graphics.UI.WXCore.WxcTypes

Contents

Description

Basic types and marshaling code for the wxWindows C library.

Synopsis

Object types

data Object a

An Object a is a pointer to an object of type a. The a parameter is used to encode the inheritance relation. When the type parameter is unit (), it denotes an object of exactly that class, when the parameter is a type variable a, it specifies an object that is at least an instance of that class. For example in wxWindows, we have the following class hierarchy:

 EvtHandler
   |- Window
        |- Frame
        |- Control
            |- Button
            |- Radiobox

In wxHaskell, all the creation functions will return objects of exactly that class and use the () type:

 frameCreate :: Window a -> ... -> IO (Frame ())
 buttonCreate :: Window a -> ... -> IO (Button ())
 ...

In contrast, all the this (or self) pointers of methods can take objects of any instance of that class and have a type variable, for example:

 windowSetClientSize :: Window a -> Size -> IO ()
 controlSetLabel     :: Control a -> String -> IO ()
 buttonSetDefault    :: Button a -> IO ()

This means that we can use windowSetClientSize on any window, including buttons and frames, but we can only use controlSetLabel on controls, not includeing frames.

In wxHaskell, this works since a Frame () is actually a type synonym for Window (CFrame ()) (where CFrame is an abstract data type). We can thus pass a value of type Frame () to anything that expects some Window a. For a button this works too, as it is a synonym for Control (CButton ()) which is in turn a synonym for Window (CControl (CButton ())). Note that we can't pass a frame to something that expects a value of type Control a. Of course, a Window a is actually a type synonym for EvtHandler (CWindow a). If you study the documentation in Graphics.UI.WXH.WxcClasses closely, you can discover where this chain ends :-).

Objects are not automatically deleted. Normally you can use a delete function like windowDelete to delete an object. However, almost all objects in the wxWindows library are automatically deleted by the library. The only objects that should be used with care are resources as bitmaps, fonts and brushes.

Instances

Eq (Object a) 
Ord (Object a) 
Show (Object a) 

objectNull :: Object a

A null object. Use with care.

objectIsNull :: Object a -> Bool

Test for null object.

objectCast :: Object a -> Object b

Cast an object to another type. Use with care.

objectIsManaged :: Object a -> Bool

Is this a managed object.

objectDelete :: WxObject a -> IO ()

Delete a wxObject, works for managed and unmanaged objects.

objectFromPtr :: Ptr a -> Object a

Create an unmanaged object.

managedObjectFromPtr :: Ptr (TWxObject a) -> IO (WxObject a)

Create a managed object that will be deleted using |wxObject_SafeDelete|.

withObjectPtr :: Object a -> (Ptr a -> IO b) -> IO b

Do something with the object pointer.

withObjectRef :: String -> Object a -> (Ptr a -> IO b) -> IO b

Extract the object pointer and raise an exception if NULL. Otherwise continue with the valid pointer.

withObjectResult :: IO (Ptr a) -> IO (Object a)

Return an unmanaged object.

withManagedObjectResult :: IO (Ptr (TWxObject a)) -> IO (WxObject a)

Create a managed object that will be deleted using |wxObject_SafeDelete|.

objectFinalize :: Object a -> IO ()

Finalize a managed object manually. (no effect on unmanaged objects)

objectNoFinalize :: Object a -> IO ()

Remove the finalizer on a managed object. (no effect on unmanaged objects)

Type synonyms

type Id = Int

An Id is used to identify objects during event handling.

type Style = Int

A Style is normally used as a flag mask to specify some window style

type EventId = Int

An EventId is identifies specific events.

Basic types

intFromBool :: Bool -> Int

boolFromInt :: Int -> Bool

Point

type Point = Point2 Int

data Num a => Point2 a

A point has an x and y coordinate. Coordinates are normally relative to the upper-left corner of their view frame, where a positive x goes to the right and a positive y to the bottom of the view.

Constructors

Point 

Fields

pointX :: !a

x component of a point.

pointY :: !a

y component of a point.

Instances

Typeable1 Point2 
Num a => Eq (Point2 a) 
(Num a, Ord a) => Ord (Point2 a) 
(Num a, Read a) => Read (Point2 a) 
Num a => Show (Point2 a) 
Ix (Point2 Int) 

point :: Num a => a -> a -> Point2 a

Construct a point.

pt :: Num a => a -> a -> Point2 a

Shorter function to construct a point.

pointFromVec :: Num a => Vector -> Point2 a

pointFromSize :: Num a => Size -> Point2 a

pointZero :: Num a => Point2 a

Point at the origin.

pointNull :: Num a => Point2 a

A null point is not a legal point (x and y are -1) and can be used for some wxWindows functions to select a default point.

Size

type Size = Size2D Int

data Num a => Size2D a

A Size has a width and height.

Constructors

Size 

Fields

sizeW :: !a

the width of a size

sizeH :: !a

the height of a size

Instances

Typeable1 Size2D 
Num a => Eq (Size2D a) 
Num a => Show (Size2D a) 

sz :: Num a => a -> a -> Size2D a

Short function to construct a size

sizeFromPoint :: Num a => Point2 a -> Size2D a

sizeFromVec :: Num a => Vector2 a -> Size2D a

sizeZero :: Num a => Size2D a

sizeNull :: Num a => Size2D a

A null size is not a legal size (width and height are -1) and can be used for some wxWindows functions to select a default size.

Vector

type Vector = Vector2 Int

data Num a => Vector2 a

A vector with an x and y delta.

Constructors

Vector 

Fields

vecX :: !a

delta-x component of a vector

vecY :: !a

delta-y component of a vector

Instances

Typeable1 Vector2 
Num a => Eq (Vector2 a) 
(Num a, Read a) => Read (Vector2 a) 
Num a => Show (Vector2 a) 

vector :: Num a => a -> a -> Vector2 a

Construct a vector.

vec :: Num a => a -> a -> Vector2 a

Short function to construct a vector.

vecFromPoint :: Num a => Point2 a -> Vector2 a

vecZero :: Num a => Vector2 a

A zero vector

vecNull :: Num a => Vector2 a

A null vector has a delta x and y of -1 and can be used for some wxWindows functions to select a default vector.

Rectangle

type Rect = Rect2D Int

data Num a => Rect2D a

A rectangle is defined by the left x coordinate, the top y coordinate, the width and the height.

Constructors

Rect 

Fields

rectLeft :: !a
 
rectTop :: !a
 
rectWidth :: !a
 
rectHeight :: !a
 

Instances

Typeable1 Rect2D 
Num a => Eq (Rect2D a) 
(Num a, Read a) => Read (Rect2D a) 
Num a => Show (Rect2D a) 

rectTopLeft :: Num a => Rect2D a -> Point2 a

rectTopRight :: Num a => Rect2D a -> Point2 a

rectBottomLeft :: Num a => Rect2D a -> Point2 a

rectBottomRight :: Num a => Rect2D a -> Point2 a

rectBottom :: Num a => Rect2D a -> a

rectRight :: Num a => Rect2D a -> a

rect :: Num a => Point2 a -> Size2D a -> Rect2D a

Create a rectangle at a certain (upper-left) point with a certain size.

rectBetween :: (Num a, Ord a) => Point2 a -> Point2 a -> Rect2D a

Construct a (positive) rectangle between two (arbitrary) points.

rectFromSize :: Num a => Size2D a -> Rect2D a

Create a rectangle of a certain size with the upper-left corner at (pt 0 0).

rectZero :: Num a => Rect2D a

An empty rectangle at (0,0).

rectNull :: Num a => Rect2D a

An null rectangle is not a valid rectangle (Rect -1 -1 -1 -1) but can used for some wxWindows functions to select a default rectangle. (i.e. frameCreate).

rectSize :: Num a => Rect2D a -> Size2D a

Get the size of a rectangle.

rectIsEmpty :: Num a => Rect2D a -> Bool

Color

newtype Color

An abstract data type to define colors.

Note: Haddock 0.8 and 0.9 doesn't support GeneralizedNewtypeDeriving. So, This class doesn't have IArray class's unboxed array instance now. If you want to use this type with unboxed array, you must write code like this.

 {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses #-}
 import Graphics.UI.WXCore.WxcTypes
 ...
 deriving instance IArray UArray Color

We can't derive MArray class's unboxed array instance this way. This is a bad point of current MArray class definition.

Constructors

Color Int 

Instances

Eq Color 
Show Color 
Typeable Color 

rgb :: Int -> Int -> Int -> Color

Create a color from a red/green/blue triple.

colorRGB :: Int -> Int -> Int -> Color

Create a color from a red/green/blue triple.

colorRed :: Color -> Int

Returns a red color component

colorGreen :: Color -> Int

Returns a green color component

colorBlue :: Color -> Int

Returns a blue color component

intFromColor :: Color -> Int

Return an Int where the three least significant bytes contain the red, green, and blue component of a color.

colorFromInt :: Int -> Color

Set the color according to an rgb integer. (see rgbIntFromColor).

colorOk :: Color -> Bool

Check of a color is valid (Colour::Ok)

Marshalling

Basic types

withPointResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO (Point2 Int)

fromCPoint :: CInt -> CInt -> Point2 Int

withCPoint :: Point2 Int -> (CInt -> CInt -> IO a) -> IO a

withPointDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Point2 Double)

withCPointDouble :: Point2 Double -> (CDouble -> CDouble -> IO a) -> IO a

withSizeResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Size

withCSize :: Size -> (CInt -> CInt -> IO a) -> IO a

withSizeDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Size2D Double)

withCSizeDouble :: Size2D Double -> (CDouble -> CDouble -> IO a) -> IO a

withVectorResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Vector

withCVector :: Vector -> (CInt -> CInt -> IO a) -> IO a

withVectorDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Vector2 Double)

withCVectorDouble :: Vector2 Double -> (CDouble -> CDouble -> IO a) -> IO a

withRectResult :: (Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()) -> IO Rect

fromCRect :: CInt -> CInt -> CInt -> CInt -> Rect

withCRect :: Rect -> (CInt -> CInt -> CInt -> CInt -> IO a) -> IO a

withRectDoubleResult :: (Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Rect2D Double)

withCRectDouble :: Rect2D Double -> (CDouble -> CDouble -> CDouble -> CDouble -> IO a) -> IO a

withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b

withArrayString :: [String] -> (CInt -> Ptr CString -> IO a) -> IO a

withArrayWString :: [String] -> (CInt -> Ptr CWString -> IO a) -> IO a

withArrayInt :: [Int] -> (CInt -> Ptr CInt -> IO a) -> IO a

withArrayObject :: [Ptr a] -> (CInt -> Ptr (Ptr a) -> IO b) -> IO b

withArrayIntResult :: (Ptr CInt -> IO CInt) -> IO [Int]

withArrayStringResult :: (Ptr (Ptr CChar) -> IO CInt) -> IO [String]

withArrayWStringResult :: (Ptr (Ptr CWchar) -> IO CInt) -> IO [String]

withArrayObjectResult :: (Ptr (Ptr a) -> IO CInt) -> IO [Object a]

colourSafeDelete :: Ptr (TColour a) -> IO ()

Managed object types

data TreeItem

Identifies tree items. Note: Replaces the TreeItemId object and takes automatically care of allocation issues.

Instances

Eq TreeItem 
Read TreeItem 
Show TreeItem 

treeItemInvalid :: TreeItem

Invalid tree item.

treeItemIsOk :: TreeItem -> Bool

Is a tree item ok? (i.e. not invalid).

withRefTreeItemId :: (Ptr (TTreeItemId ()) -> IO ()) -> IO TreeItem

withTreeItemIdPtr :: TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b

withTreeItemIdRef :: String -> TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b

withStringRef :: String -> String -> (Ptr (TWxString s) -> IO a) -> IO a

withStringPtr :: String -> (Ptr (TWxString s) -> IO a) -> IO a

withManagedStringResult :: IO (Ptr (TWxString a)) -> IO String

withRefColour :: (Ptr (TColour a) -> IO ()) -> IO Color

withColourRef :: String -> Color -> (Ptr (TColour a) -> IO b) -> IO b

withColourPtr :: Color -> (Ptr (TColour a) -> IO b) -> IO b

withRefBitmap :: (Ptr (TBitmap a) -> IO ()) -> IO (Bitmap a)

withRefCursor :: (Ptr (TCursor a) -> IO ()) -> IO (Cursor a)

withRefIcon :: (Ptr (TIcon a) -> IO ()) -> IO (Icon a)

withManagedIconResult :: IO (Ptr (TIcon a)) -> IO (Icon a)

withRefPen :: (Ptr (TPen a) -> IO ()) -> IO (Pen a)

withManagedPenResult :: IO (Ptr (TPen a)) -> IO (Pen a)

withRefBrush :: (Ptr (TBrush a) -> IO ()) -> IO (Brush a)

withManagedBrushResult :: IO (Ptr (TBrush a)) -> IO (Brush a)

withRefFont :: (Ptr (TFont a) -> IO ()) -> IO (Font a)

withManagedFontResult :: IO (Ptr (TFont a)) -> IO (Font a)

withRefImage :: (Ptr (TImage a) -> IO ()) -> IO (Image a)

withRefListItem :: (Ptr (TListItem a) -> IO ()) -> IO (ListItem a)

withRefFontData :: (Ptr (TFontData a) -> IO ()) -> IO (FontData a)

withRefPrintData :: (Ptr (TPrintData a) -> IO ()) -> IO (PrintData a)

withRefDateTime :: (Ptr (TDateTime a) -> IO ()) -> IO (DateTime a)

Primitive types

CString

withCString :: String -> (CString -> IO a) -> IO a

withStringResult :: (Ptr CChar -> IO CInt) -> IO String

withCWString :: String -> (CWString -> IO a) -> IO a

withWStringResult :: (Ptr CWchar -> IO CInt) -> IO String

ByteString

withByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString

withLazyByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString

CInt

data CInt

Instances

Bounded CInt 
Enum CInt 
Eq CInt 
Integral CInt 
Num CInt 
Ord CInt 
Read CInt 
Real CInt 
Show CInt 
Typeable CInt 
Storable CInt 
Bits CInt 

toCInt :: Int -> CInt

fromCInt :: CInt -> Int

withIntResult :: IO CInt -> IO Int

8 bit Word

data Word8

Instances

Bounded Word8 
Enum Word8 
Eq Word8 
Integral Word8 
Num Word8 
Ord Word8 
Read Word8 
Real Word8 
Show Word8 
Ix Word8 
Typeable Word8 
Storable Word8 
Bits Word8 
IArray UArray Word8 
MArray (STUArray s) Word8 (ST s) 

64 bit Integer

data Int64

Instances

Bounded Int64 
Enum Int64 
Eq Int64 
Integral Int64 
Num Int64 
Ord Int64 
Read Int64 
Real Int64 
Show Int64 
Ix Int64 
Typeable Int64 
Storable Int64 
Bits Int64 
IArray UArray Int64 
MArray (STUArray s) Int64 (ST s) 

CDouble

data CDouble

Instances

Enum CDouble 
Eq CDouble 
Floating CDouble 
Fractional CDouble 
Num CDouble 
Ord CDouble 
Read CDouble 
Real CDouble 
RealFloat CDouble 
RealFrac CDouble 
Show CDouble 
Typeable CDouble 
Storable CDouble 

toCDouble :: Double -> CDouble

fromCDouble :: CDouble -> Double

withDoubleResult :: IO CDouble -> IO Double

CChar

data CChar

Instances

Bounded CChar 
Enum CChar 
Eq CChar 
Integral CChar 
Num CChar 
Ord CChar 
Read CChar 
Real CChar 
Show CChar 
Typeable CChar 
Storable CChar 
Bits CChar 

toCChar :: Char -> CChar

fromCChar :: CChar -> Char

withCharResult :: (Num a, Integral a) => IO a -> IO Char

data CWchar

Instances

Bounded CWchar 
Enum CWchar 
Eq CWchar 
Integral CWchar 
Num CWchar 
Ord CWchar 
Read CWchar 
Real CWchar 
Show CWchar 
Typeable CWchar 
Storable CWchar 
Bits CWchar 

toCWchar :: Num a => Char -> a

CBool

type CBool = CInt

toCBool :: Bool -> CBool

fromCBool :: CBool -> Bool

withBoolResult :: IO CBool -> IO Bool

Pointers

data Ptr a

Instances

Typeable1 Ptr 
IArray UArray (Ptr a) 
Eq (Ptr a) 
Ord (Ptr a) 
Show (Ptr a) 
Storable (Ptr a) 
MArray (STUArray s) (Ptr a) (ST s) 

ptrNull :: Ptr a

Null pointer, use with care.

ptrIsNull :: Ptr a -> Bool

Test for null.

ptrCast :: Ptr a -> Ptr b

Cast a pointer type, use with care.

data ForeignPtr a

Instances

Typeable1 ForeignPtr 
Eq (ForeignPtr a) 
Ord (ForeignPtr a) 
Show (ForeignPtr a) 

data FunPtr a

Instances

Typeable1 FunPtr 
IArray UArray (FunPtr a) 
Eq (FunPtr a) 
Ord (FunPtr a) 
Show (FunPtr a) 
Storable (FunPtr a) 
MArray (STUArray s) (FunPtr a) (ST s) 

toCFunPtr :: FunPtr a -> Ptr a