module Graphics.UI.WXCore.WxcTypes(
Object, objectNull, objectIsNull, objectCast, objectIsManaged
, objectDelete
, objectFromPtr, managedObjectFromPtr
, withObjectPtr, withObjectRef
, withObjectResult, withManagedObjectResult
, objectFinalize, objectNoFinalize
, Id
, Style
, EventId
, fromBool, toBool
, Point, Point2(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull
, Size, Size2D(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull
, Vector, Vector2(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull
, Rect, Rect2D(Rect,rectLeft,rectTop,rectWidth,rectHeight)
, rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight, rectBottom, rectRight
, rect, rectBetween, rectFromSize, rectZero, rectNull, rectSize, rectIsEmpty
, Color(..), rgb, colorRGB, rgba, colorRGBA, colorRed, colorGreen, colorBlue, colorAlpha
, intFromColor, colorFromInt, fromColor, toColor, colorOk, colorIsOk
, withPointResult, withWxPointResult, toCIntPointX, toCIntPointY, fromCPoint, withCPoint
, withPointDoubleResult, toCDoublePointX, toCDoublePointY, fromCPointDouble, withCPointDouble
, withSizeResult, withWxSizeResult, toCIntSizeW, toCIntSizeH, fromCSize, withCSize
, withSizeDoubleResult, toCDoubleSizeW, toCDoubleSizeH, fromCSizeDouble, withCSizeDouble
, withVectorResult, withWxVectorResult, toCIntVectorX, toCIntVectorY, fromCVector, withCVector
, withVectorDoubleResult, toCDoubleVectorX, toCDoubleVectorY, fromCVectorDouble, withCVectorDouble
, withRectResult, withWxRectResult, withWxRectPtr, toCIntRectX, toCIntRectY, toCIntRectW, toCIntRectH, fromCRect, withCRect
, withRectDoubleResult, toCDoubleRectX, toCDoubleRectY, toCDoubleRectW, toCDoubleRectH, fromCRectDouble, withCRectDouble
, withArray, withArrayString, withArrayWString, withArrayInt, withArrayObject
, withArrayIntResult, withArrayStringResult, withArrayWStringResult, withArrayObjectResult
, colourFromColor, colorFromColour
, colourCreate, colourSafeDelete
, TreeItem, treeItemInvalid, treeItemIsOk, treeItemFromInt
, withRefTreeItemId, withTreeItemIdPtr, withTreeItemIdRef, withManagedTreeItemIdResult
, withStringRef, withStringPtr, withManagedStringResult
, withRefColour, withColourRef, withColourPtr, withManagedColourResult
, withRefBitmap, withManagedBitmapResult
, withRefCursor, withManagedCursorResult
, withRefIcon, withManagedIconResult
, withRefPen, withManagedPenResult
, withRefBrush, withManagedBrushResult
, withRefFont, withManagedFontResult
, withRefImage
, withRefListItem
, withRefFontData
, withRefPrintData
, withRefPageSetupDialogData
, withRefPrintDialogData
, withRefDateTime, withManagedDateTimeResult
, withRefGridCellCoordsArray, withManagedGridCellCoordsArrayResult
, CString, withCString, withStringResult
, CWString, withCWString, withWStringResult
, withByteStringResult, withLazyByteStringResult
, CInt, toCInt, fromCInt, withIntResult
, Word
, Word8
, Int64
, CDouble, toCDouble, fromCDouble, withDoubleResult
, CChar, toCChar, fromCChar, withCharResult
, CWchar, toCWchar
, CBool, toCBool, fromCBool, withBoolResult
, Ptr, ptrNull, ptrIsNull, ptrCast, ForeignPtr, FunPtr, toCFunPtr
) where
import Control.Exception
import System.IO.Unsafe( unsafePerformIO )
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils (fromBool, toBool)
import Foreign.ForeignPtr hiding (newForeignPtr,addForeignPtrFinalizer)
import Foreign.Concurrent
import Data.Array.MArray (MArray)
import Data.Array.Unboxed (IArray, UArray)
import Data.Bits( shiftL, shiftR, (.&.), (.|.) )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Char8 as BC (pack)
import qualified Data.ByteString.Lazy.Char8 as LBC (pack)
import Data.Dynamic
import Data.Int
import Data.Word
import Debug.Trace (putTraceMsg)
import Graphics.UI.WXCore.WxcObject
import Graphics.UI.WXCore.WxcClassTypes
type Id = Int
type EventId = Int
type Style = Int
objectDelete :: WxObject a -> IO ()
objectDelete obj
= if objectIsManaged obj
then objectFinalize obj
else withObjectPtr obj $ \p ->
wxObject_SafeDelete p
managedObjectFromPtr :: Ptr (TWxObject a) -> IO (WxObject a)
managedObjectFromPtr p
= do mp <- wxManagedPtr_CreateFromObject p
objectFromManagedPtr mp
withManagedObjectResult :: IO (Ptr (TWxObject a)) -> IO (WxObject a)
withManagedObjectResult io
= do p <- io
managedObjectFromPtr p
withObjectResult :: IO (Ptr a) -> IO (Object a)
withObjectResult io
= do p <- io
return (objectFromPtr p)
withObjectRef :: String -> Object a -> (Ptr a -> IO b) -> IO b
withObjectRef msg obj f
= withObjectPtr obj $ \p ->
withValidPtr msg p f
withValidPtr :: String -> Ptr a -> (Ptr a -> IO b) -> IO b
withValidPtr msg p f
= if (p == nullPtr)
then ioError (userError ("wxHaskell: NULL object" ++ (if null msg then "" else ": " ++ msg)))
else f p
foreign import ccall wxManagedPtr_CreateFromObject :: Ptr (TWxObject a) -> IO (ManagedPtr (TWxObject a))
foreign import ccall wxObject_SafeDelete :: Ptr (TWxObject a) -> IO ()
type Point = Point2 Int
data (Num a) => Point2 a = Point
{ pointX :: !a
, pointY :: !a
}
deriving (Eq,Show,Read,Typeable)
point :: (Num a) => a -> a -> Point2 a
point x y = Point x y
pt :: (Num a) => a -> a -> Point2 a
pt x y = Point x y
pointFromVec :: (Num a) => Vector -> Point2 a
pointFromVec (Vector x y)
= Point (fromIntegral x) (fromIntegral y)
pointFromSize :: (Num a) => Size -> Point2 a
pointFromSize (Size w h)
= Point (fromIntegral w) (fromIntegral h)
pointZero :: (Num a) => Point2 a
pointZero
= Point 0 0
pointNull :: (Num a) => Point2 a
pointNull
= Point (1) (1)
withCPoint :: Point2 Int -> (CInt -> CInt -> IO a) -> IO a
withCPoint (Point x y) f
= f (toCInt x) (toCInt y)
withPointResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO (Point2 Int)
withPointResult f
= alloca $ \px ->
alloca $ \py ->
do f px py
x <- peek px
y <- peek py
return (fromCPoint x y)
toCIntPointX, toCIntPointY :: Point2 Int -> CInt
toCIntPointX (Point x y) = toCInt x
toCIntPointY (Point x y) = toCInt y
fromCPoint :: CInt -> CInt -> Point2 Int
fromCPoint x y
= Point (fromCInt x) (fromCInt y)
withCPointDouble :: Point2 Double -> (CDouble -> CDouble -> IO a) -> IO a
withCPointDouble (Point x y) f
= f (toCDouble x) (toCDouble y)
withPointDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Point2 Double)
withPointDoubleResult f
= alloca $ \px ->
alloca $ \py ->
do f px py
x <- peek px
y <- peek py
return (fromCPointDouble x y)
toCDoublePointX, toCDoublePointY :: Point2 Double -> CDouble
toCDoublePointX (Point x y) = toCDouble x
toCDoublePointY (Point x y) = toCDouble y
fromCPointDouble :: CDouble -> CDouble -> Point2 Double
fromCPointDouble x y
= Point (fromCDouble x) (fromCDouble y)
withWxPointResult :: IO (Ptr (TWxPoint a)) -> IO (Point2 Int)
withWxPointResult io
= do pt <- io
x <- wxPoint_GetX pt
y <- wxPoint_GetY pt
wxPoint_Delete pt
return (fromCPoint x y)
foreign import ccall wxPoint_Delete :: Ptr (TWxPoint a) -> IO ()
foreign import ccall wxPoint_GetX :: Ptr (TWxPoint a) -> IO CInt
foreign import ccall wxPoint_GetY :: Ptr (TWxPoint a) -> IO CInt
type Size = Size2D Int
data (Num a) => Size2D a = Size
{ sizeW :: !a
, sizeH :: !a
}
deriving (Eq,Show,Typeable)
size :: (Num a) => a -> a -> Size2D a
size w h
= Size w h
sz :: (Num a) => a -> a -> Size2D a
sz w h
= Size w h
sizeFromPoint :: (Num a) => Point2 a -> Size2D a
sizeFromPoint (Point x y)
= Size x y
sizeFromVec :: (Num a) => Vector2 a -> Size2D a
sizeFromVec (Vector x y)
= Size x y
sizeZero :: (Num a) => Size2D a
sizeZero
= Size 0 0
sizeNull :: (Num a) => Size2D a
sizeNull
= Size (1) (1)
withCSize :: Size -> (CInt -> CInt -> IO a) -> IO a
withCSize (Size w h) f
= f (toCInt w) (toCInt h)
withSizeResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Size
withSizeResult f
= alloca $ \cw ->
alloca $ \ch ->
do f cw ch
w <- peek cw
h <- peek ch
return (fromCSize w h)
fromCSize :: CInt -> CInt -> Size
fromCSize w h
= Size (fromCInt w) (fromCInt h)
toCIntSizeW, toCIntSizeH :: Size -> CInt
toCIntSizeW (Size w h) = toCInt w
toCIntSizeH (Size w h) = toCInt h
withCSizeDouble :: Size2D Double -> (CDouble -> CDouble -> IO a) -> IO a
withCSizeDouble (Size w h) f
= f (toCDouble w) (toCDouble h)
withSizeDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Size2D Double)
withSizeDoubleResult f
= alloca $ \cw ->
alloca $ \ch ->
do f cw ch
w <- peek cw
h <- peek ch
return (fromCSizeDouble w h)
fromCSizeDouble :: CDouble -> CDouble -> Size2D Double
fromCSizeDouble w h
= Size (fromCDouble w) (fromCDouble h)
toCDoubleSizeW, toCDoubleSizeH :: Size2D Double -> CDouble
toCDoubleSizeW (Size w h) = toCDouble w
toCDoubleSizeH (Size w h) = toCDouble h
withWxSizeResult :: IO (Ptr (TWxSize a)) -> IO Size
withWxSizeResult io
= do sz <- io
w <- wxSize_GetWidth sz
h <- wxSize_GetHeight sz
wxSize_Delete sz
return (fromCSize w h)
foreign import ccall wxSize_Delete :: Ptr (TWxSize a) -> IO ()
foreign import ccall wxSize_GetWidth :: Ptr (TWxSize a) -> IO CInt
foreign import ccall wxSize_GetHeight :: Ptr (TWxSize a) -> IO CInt
type Vector = Vector2 Int
data (Num a) => Vector2 a = Vector
{ vecX :: !a
, vecY :: !a
}
deriving (Eq,Show,Read,Typeable)
vector :: (Num a) => a -> a -> Vector2 a
vector dx dy = Vector dx dy
vec :: (Num a) => a -> a -> Vector2 a
vec dx dy = Vector dx dy
vecZero :: (Num a) => Vector2 a
vecZero
= Vector 0 0
vecNull :: (Num a) => Vector2 a
vecNull
= Vector (1) (1)
vecFromPoint :: (Num a) => Point2 a -> Vector2 a
vecFromPoint (Point x y)
= Vector x y
vecFromSize :: Size -> Vector
vecFromSize (Size w h)
= Vector w h
withCVector :: Vector -> (CInt -> CInt -> IO a) -> IO a
withCVector (Vector x y) f
= f (toCInt x) (toCInt y)
withVectorResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Vector
withVectorResult f
= alloca $ \px ->
alloca $ \py ->
do f px py
x <- peek px
y <- peek py
return (fromCVector x y)
toCIntVectorX, toCIntVectorY :: Vector -> CInt
toCIntVectorX (Vector x y) = toCInt x
toCIntVectorY (Vector x y) = toCInt y
fromCVector :: CInt -> CInt -> Vector
fromCVector x y
= Vector (fromCInt x) (fromCInt y)
withCVectorDouble :: Vector2 Double -> (CDouble -> CDouble -> IO a) -> IO a
withCVectorDouble (Vector x y) f
= f (toCDouble x) (toCDouble y)
withVectorDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Vector2 Double)
withVectorDoubleResult f
= alloca $ \px ->
alloca $ \py ->
do f px py
x <- peek px
y <- peek py
return (fromCVectorDouble x y)
toCDoubleVectorX, toCDoubleVectorY :: Vector2 Double -> CDouble
toCDoubleVectorX (Vector x y) = toCDouble x
toCDoubleVectorY (Vector x y) = toCDouble y
fromCVectorDouble :: CDouble -> CDouble -> Vector2 Double
fromCVectorDouble x y
= Vector (fromCDouble x) (fromCDouble y)
withWxVectorResult :: IO (Ptr (TWxPoint a)) -> IO Vector
withWxVectorResult io
= do pt <- io
x <- wxPoint_GetX pt
y <- wxPoint_GetY pt
wxPoint_Delete pt
return (fromCVector x y)
type Rect = Rect2D Int
data (Num a) => Rect2D a = Rect
{ rectLeft :: !a
, rectTop :: !a
, rectWidth :: !a
, rectHeight :: !a
}
deriving (Eq,Show,Read,Typeable)
rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight :: (Num a) => Rect2D a -> Point2 a
rectTopLeft (Rect l t w h) = Point l t
rectTopRight (Rect l t w h) = Point (l+w) t
rectBottomLeft (Rect l t w h) = Point l (t+h)
rectBottomRight (Rect l t w h) = Point (l+w) (t+h)
rectBottom, rectRight :: (Num a) => Rect2D a -> a
rectBottom (Rect x y w h) = y + h
rectRight (Rect x y w h) = x + w
rect :: (Num a) => Point2 a -> Size2D a -> Rect2D a
rect (Point x y) (Size w h)
= Rect x y w h
rectBetween :: (Num a, Ord a) => Point2 a -> Point2 a -> Rect2D a
rectBetween (Point x0 y0) (Point x1 y1)
= Rect (min x0 x1) (min y0 y1) (abs (x1x0)) (abs (y1y0))
rectZero :: (Num a) => Rect2D a
rectZero
= Rect 0 0 0 0
rectNull :: (Num a) => Rect2D a
rectNull
= Rect (1) (1) (1) (1)
rectSize :: (Num a) => Rect2D a -> Size2D a
rectSize (Rect l t w h)
= Size w h
rectFromSize :: (Num a) => Size2D a -> Rect2D a
rectFromSize (Size w h)
= Rect 0 0 w h
rectIsEmpty :: (Num a) => Rect2D a -> Bool
rectIsEmpty (Rect l t w h)
= (w==0 && h==0)
withCRect :: Rect -> (CInt -> CInt -> CInt -> CInt -> IO a) -> IO a
withCRect (Rect x0 y0 x1 y1) f
= f (toCInt (x0)) (toCInt (y0)) (toCInt (x1)) (toCInt (y1))
withRectResult :: (Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()) -> IO Rect
withRectResult f
= alloca $ \cx ->
alloca $ \cy ->
alloca $ \cw ->
alloca $ \ch ->
do f cx cy cw ch
x <- peek cx
y <- peek cy
w <- peek cw
h <- peek ch
return (fromCRect x y w h)
fromCRect :: CInt -> CInt -> CInt -> CInt -> Rect
fromCRect x y w h
= Rect (fromCInt x) (fromCInt y) (fromCInt w) (fromCInt h)
toCIntRectX, toCIntRectY, toCIntRectW, toCIntRectH :: Rect -> CInt
toCIntRectX (Rect x y w h) = toCInt x
toCIntRectY (Rect x y w h) = toCInt y
toCIntRectW (Rect x y w h) = toCInt w
toCIntRectH (Rect x y w h) = toCInt h
withCRectDouble :: Rect2D Double -> (CDouble -> CDouble -> CDouble -> CDouble -> IO a) -> IO a
withCRectDouble (Rect x0 y0 x1 y1) f
= f (toCDouble (x0)) (toCDouble (y0)) (toCDouble (x1)) (toCDouble (y1))
withRectDoubleResult :: (Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Rect2D Double)
withRectDoubleResult f
= alloca $ \cx ->
alloca $ \cy ->
alloca $ \cw ->
alloca $ \ch ->
do f cx cy cw ch
x <- peek cx
y <- peek cy
w <- peek cw
h <- peek ch
return (fromCRectDouble x y w h)
fromCRectDouble :: CDouble -> CDouble -> CDouble -> CDouble -> Rect2D Double
fromCRectDouble x y w h
= Rect (fromCDouble x) (fromCDouble y) (fromCDouble w) (fromCDouble h)
toCDoubleRectX, toCDoubleRectY, toCDoubleRectW, toCDoubleRectH :: Rect2D Double -> CDouble
toCDoubleRectX (Rect x y w h) = toCDouble x
toCDoubleRectY (Rect x y w h) = toCDouble y
toCDoubleRectW (Rect x y w h) = toCDouble w
toCDoubleRectH (Rect x y w h) = toCDouble h
withWxRectRef :: String -> Rect -> (Ptr (TWxRect r) -> IO a) -> IO a
withWxRectRef msg r f
= withWxRectPtr r $ \p -> withValidPtr msg p f
withWxRectPtr :: Rect -> (Ptr (TWxRect r) -> IO a) -> IO a
withWxRectPtr r f
= bracket (withCRect r wxRect_Create)
(wxRect_Delete)
f
withWxRectResult :: IO (Ptr (TWxRect a)) -> IO Rect
withWxRectResult io
= do rt <- io
x <- wxRect_GetX rt
y <- wxRect_GetY rt
w <- wxRect_GetWidth rt
h <- wxRect_GetHeight rt
wxRect_Delete rt
return (fromCRect x y w h)
foreign import ccall wxRect_Create :: CInt -> CInt -> CInt -> CInt -> IO (Ptr (TWxRect a))
foreign import ccall wxRect_Delete :: Ptr (TWxRect a) -> IO ()
foreign import ccall wxRect_GetX :: Ptr (TWxRect a) -> IO CInt
foreign import ccall wxRect_GetY :: Ptr (TWxRect a) -> IO CInt
foreign import ccall wxRect_GetWidth :: Ptr (TWxRect a) -> IO CInt
foreign import ccall wxRect_GetHeight :: Ptr (TWxRect a) -> IO CInt
withIntResult :: IO CInt -> IO Int
withIntResult io
= do x <- io
return (fromCInt x)
toCInt :: Int -> CInt
toCInt i = fromIntegral i
fromCInt :: CInt -> Int
fromCInt ci
= fromIntegral ci
withDoubleResult :: IO CDouble -> IO Double
withDoubleResult io
= do x <- io
return (fromCDouble x)
toCDouble :: Double -> CDouble
toCDouble d = realToFrac d
fromCDouble :: CDouble -> Double
fromCDouble cd
= realToFrac cd
type CBool = CInt
toCBool :: Bool -> CBool
toCBool = intToCBool . fromBool
withBoolResult :: IO CBool -> IO Bool
withBoolResult io
= do x <- io
return (fromCBool x)
fromCBool :: CBool -> Bool
fromCBool = toBool . cboolToInt
foreign import ccall "intToBool" intToCBool :: Int -> CBool
foreign import ccall "boolToInt" cboolToInt :: CBool -> Int
withStringResult :: (Ptr CChar -> IO CInt) -> IO String
withStringResult f
= do len <- f nullPtr
if (len<=0)
then return ""
else withCString (replicate (fromCInt len) ' ') $ \cstr ->
do f cstr
peekCString cstr
withWStringResult :: (Ptr CWchar -> IO CInt) -> IO String
withWStringResult f
= do len <- f nullPtr
if (len<=0)
then return ""
else withCWString (replicate (fromCInt len) ' ') $ \cstr ->
do f cstr
peekCWString cstr
withByteStringResult :: (Ptr CChar -> IO CInt) -> IO B.ByteString
withByteStringResult f
= do len <- f nullPtr
if (len<=0)
then return $ BC.pack ""
else withCString (replicate (fromCInt len) ' ') $ \cstr ->
do f cstr
B.packCString cstr
withLazyByteStringResult :: (Ptr CChar -> IO CInt) -> IO LB.ByteString
withLazyByteStringResult f
= do str <- withStringResult f
return $ LBC.pack str
withArrayStringResult :: (Ptr (Ptr CChar) -> IO CInt) -> IO [String]
withArrayStringResult f
= do clen <- f nullPtr
let len = fromCInt clen
if (len <= 0)
then return []
else allocaArray len $ \carr ->
do f carr
arr <- peekArray len carr
mapM peekCString arr
withArrayWStringResult :: (Ptr (Ptr CWchar) -> IO CInt) -> IO [String]
withArrayWStringResult f
= do clen <- f nullPtr
let len = fromCInt clen
if (len <= 0)
then return []
else allocaArray len $ \carr ->
do f carr
arr <- peekArray len carr
mapM peekCWString arr
withArrayIntResult :: (Ptr CInt -> IO CInt) -> IO [Int]
withArrayIntResult f
= do clen <- f nullPtr
let len = fromCInt clen
if (len <= 0)
then return []
else allocaArray len $ \carr ->
do f carr
xs <- peekArray len carr
return (map fromCInt xs)
withArrayObjectResult :: (Ptr (Ptr a) -> IO CInt) -> IO [Object a]
withArrayObjectResult f
= do clen <- f nullPtr
let len = fromCInt clen
if (len <= 0)
then return []
else allocaArray len $ \carr ->
do f carr
ps <- peekArray len carr
return (map objectFromPtr ps)
withArrayString :: [String] -> (CInt -> Ptr CString -> IO a) -> IO a
withArrayString xs f
= withCStrings xs [] $ \cxs ->
withArray0 ptrNull cxs $ \carr ->
f (toCInt len) carr
where
len = length xs
withCStrings [] cxs f
= f (reverse cxs)
withCStrings (x:xs) cxs f
= withCString x $ \cx ->
withCStrings xs (cx:cxs) f
withArrayWString :: [String] -> (CInt -> Ptr CWString -> IO a) -> IO a
withArrayWString xs f
= withCWStrings xs [] $ \cxs ->
withArray0 ptrNull cxs $ \carr ->
f (toCInt len) carr
where
len = length xs
withCWStrings [] cxs f
= f (reverse cxs)
withCWStrings (x:xs) cxs f
= withCWString x $ \cx ->
withCWStrings xs (cx:cxs) f
withArrayInt :: [Int] -> (CInt -> Ptr CInt -> IO a) -> IO a
withArrayInt xs f
= withArray0 0 (map toCInt xs) $ \carr ->
f (toCInt (length xs)) carr
withArrayObject :: [Ptr a] -> (CInt -> Ptr (Ptr a) -> IO b) -> IO b
withArrayObject xs f
= withArray0 ptrNull xs $ \carr ->
f (toCInt (length xs)) carr
toCChar :: Char -> CChar
toCChar = castCharToCChar
withCharResult :: (Num a, Integral a) => IO a -> IO Char
withCharResult io
= do x <- io
if (x < 0)
then do putTraceMsg ("Recieved negative unicode: " ++ (show x))
return '\n'
else return (fromCWchar x)
fromCChar :: CChar -> Char
fromCChar = castCCharToChar
toCWchar :: (Num a) => Char -> a
toCWchar = fromIntegral . fromEnum
fromCWchar :: (Num a, Integral a) => a -> Char
fromCWchar = toEnum . fromIntegral
toCFunPtr :: FunPtr a -> Ptr a
toCFunPtr fptr
= castFunPtrToPtr fptr
ptrNull :: Ptr a
ptrNull
= nullPtr
ptrIsNull :: Ptr a -> Bool
ptrIsNull p
= (p == ptrNull)
ptrCast :: Ptr a -> Ptr b
ptrCast p
= castPtr p
type Managed a = ForeignPtr a
createManaged :: IO () -> Ptr a -> IO (Managed a)
createManaged final obj
= newForeignPtr obj final
managedAddFinalizer :: IO () -> Managed a -> IO ()
managedAddFinalizer io managed
= addForeignPtrFinalizer managed io
withManaged :: Managed a -> (Ptr a -> IO b) -> IO b
withManaged fptr f
= withForeignPtr fptr f
managedTouch :: Managed a -> IO ()
managedTouch fptr
= touchForeignPtr fptr
managedNull :: Managed a
managedNull
= unsafePerformIO (createManaged (return ()) ptrNull)
managedIsNull :: Managed a -> Bool
managedIsNull managed
= (managed == managedNull)
managedCast :: Managed a -> Managed b
managedCast fptr
= castForeignPtr fptr
assignRef :: IO (Ptr (TWxObject a)) -> (Ptr (TWxObject a) -> IO ()) -> IO (WxObject a)
assignRef create f
= withManagedObjectResult (assignRefPtr create f)
assignRefPtr :: IO (Ptr a) -> (Ptr a -> IO ()) -> IO (Ptr a)
assignRefPtr create f
= do p <- create
f p
return p
withManagedBitmapResult :: IO (Ptr (TBitmap a)) -> IO (Bitmap a)
withManagedBitmapResult io
= do p <- io
static <- wxBitmap_IsStatic p
if (static)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromBitmap p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromBitmap :: Ptr (TBitmap a) -> IO (ManagedPtr (TBitmap a))
foreign import ccall wxBitmap_IsStatic :: Ptr (TBitmap a) -> IO Bool
withManagedIconResult :: IO (Ptr (TIcon a)) -> IO (Icon a)
withManagedIconResult io
= do p <- io
if (wxIcon_IsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromIcon p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromIcon :: Ptr (TIcon a) -> IO (ManagedPtr (TIcon a))
foreign import ccall wxIcon_IsStatic :: Ptr (TIcon a) -> Bool
withManagedBrushResult :: IO (Ptr (TBrush a)) -> IO (Brush a)
withManagedBrushResult io
= do p <- io
if (wxBrush_IsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromBrush p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromBrush :: Ptr (TBrush a) -> IO (ManagedPtr (TBrush a))
foreign import ccall wxBrush_IsStatic :: Ptr (TBrush a) -> Bool
withManagedCursorResult :: IO (Ptr (TCursor a)) -> IO (Cursor a)
withManagedCursorResult io
= do p <- io
if (wxCursor_IsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromCursor p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromCursor :: Ptr (TCursor a) -> IO (ManagedPtr (TCursor a))
foreign import ccall wxCursor_IsStatic :: Ptr (TCursor a) -> Bool
withManagedFontResult :: IO (Ptr (TFont a)) -> IO (Font a)
withManagedFontResult io
= do p <- io
if (wxFont_IsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromFont p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromFont :: Ptr (TFont a) -> IO (ManagedPtr (TFont a))
foreign import ccall wxFont_IsStatic :: Ptr (TFont a) -> Bool
withManagedPenResult :: IO (Ptr (TPen a)) -> IO (Pen a)
withManagedPenResult io
= do p <- io
if (wxPen_IsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromPen p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromPen :: Ptr (TPen a) -> IO (ManagedPtr (TPen a))
foreign import ccall wxPen_IsStatic :: Ptr (TPen a) -> Bool
withRefBitmap :: (Ptr (TBitmap a) -> IO ()) -> IO (Bitmap a)
withRefBitmap f
= withManagedBitmapResult $ assignRefPtr wxBitmap_Create f
foreign import ccall "wxBitmap_CreateDefault" wxBitmap_Create :: IO (Ptr (TBitmap a))
withRefCursor :: (Ptr (TCursor a) -> IO ()) -> IO (Cursor a)
withRefCursor f
= withManagedCursorResult $ assignRefPtr (wx_Cursor_CreateFromStock 1) f
foreign import ccall "Cursor_CreateFromStock" wx_Cursor_CreateFromStock :: CInt -> IO (Ptr (TCursor a))
withRefIcon :: (Ptr (TIcon a) -> IO ()) -> IO (Icon a)
withRefIcon f
= withManagedIconResult $ assignRefPtr wxIcon_Create f
foreign import ccall "wxIcon_CreateDefault" wxIcon_Create :: IO (Ptr (TIcon a))
withRefImage :: (Ptr (TImage a) -> IO ()) -> IO (Image a)
withRefImage f
= assignRef wxImage_Create f
foreign import ccall "wxImage_CreateDefault" wxImage_Create :: IO (Ptr (TImage a))
withRefFont :: (Ptr (TFont a) -> IO ()) -> IO (Font a)
withRefFont f
= withManagedFontResult $ assignRefPtr wxFont_Create f
foreign import ccall "wxFont_CreateDefault" wxFont_Create :: IO (Ptr (TFont a))
withRefPen :: (Ptr (TPen a) -> IO ()) -> IO (Pen a)
withRefPen f
= withManagedPenResult $ assignRefPtr wxPen_Create f
foreign import ccall "wxPen_CreateDefault" wxPen_Create :: IO (Ptr (TPen a))
withRefBrush :: (Ptr (TBrush a) -> IO ()) -> IO (Brush a)
withRefBrush f
= withManagedBrushResult $ assignRefPtr wxBrush_Create f
foreign import ccall "wxBrush_CreateDefault" wxBrush_Create :: IO (Ptr (TBrush a))
withRefFontData :: (Ptr (TFontData a) -> IO ()) -> IO (FontData a)
withRefFontData f
= assignRef wxFontData_Create f
foreign import ccall "wxFontData_Create" wxFontData_Create :: IO (Ptr (TFontData a))
withRefListItem :: (Ptr (TListItem a) -> IO ()) -> IO (ListItem a)
withRefListItem f
= assignRef wxListItem_Create f
foreign import ccall "wxListItem_Create" wxListItem_Create :: IO (Ptr (TListItem a))
withRefPrintData :: (Ptr (TPrintData a) -> IO ()) -> IO (PrintData a)
withRefPrintData f
= assignRef wxPrintData_Create f
foreign import ccall "wxPrintData_Create" wxPrintData_Create :: IO (Ptr (TPrintData a))
withRefPrintDialogData :: (Ptr (TPrintDialogData a) -> IO ()) -> IO (PrintDialogData a)
withRefPrintDialogData f
= assignRef wxPrintDialogData_Create f
foreign import ccall "wxPrintDialogData_CreateDefault" wxPrintDialogData_Create :: IO (Ptr (TPrintDialogData a))
withRefPageSetupDialogData :: (Ptr (TPageSetupDialogData a) -> IO ()) -> IO (PageSetupDialogData a)
withRefPageSetupDialogData f
= assignRef wxPageSetupDialogData_Create f
foreign import ccall "wxPageSetupDialogData_Create" wxPageSetupDialogData_Create :: IO (Ptr (TPageSetupDialogData a))
withManagedDateTimeResult :: IO (Ptr (TDateTime a)) -> IO (DateTime a)
withManagedDateTimeResult io
= do p <- io
if (p==nullPtr)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromDateTime p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromDateTime :: Ptr (TDateTime a) -> IO (ManagedPtr (TDateTime a))
withRefDateTime :: (Ptr (TDateTime a) -> IO ()) -> IO (DateTime a)
withRefDateTime f
= withManagedDateTimeResult $ assignRefPtr wxDateTime_Create f
foreign import ccall "wxDateTime_Create" wxDateTime_Create :: IO (Ptr (TDateTime a))
withManagedGridCellCoordsArrayResult :: IO (Ptr (TGridCellCoordsArray a)) -> IO (GridCellCoordsArray a)
withManagedGridCellCoordsArrayResult io
= do p <- io
if (p==nullPtr)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromGridCellCoordsArray p
objectFromManagedPtr mp
foreign import ccall wxManagedPtr_CreateFromGridCellCoordsArray :: Ptr (TGridCellCoordsArray a) -> IO (ManagedPtr (TGridCellCoordsArray a))
withRefGridCellCoordsArray :: (Ptr (TGridCellCoordsArray a) -> IO ()) -> IO (GridCellCoordsArray a)
withRefGridCellCoordsArray f
= withManagedGridCellCoordsArrayResult $ assignRefPtr wxGridCellCoordsArray_Create f
foreign import ccall "wxGridCellCoordsArray_Create" wxGridCellCoordsArray_Create :: IO (Ptr (TGridCellCoordsArray a))
newtype TreeItem = TreeItem Int
deriving (Eq,Show,Read)
treeItemInvalid :: TreeItem
treeItemInvalid = TreeItem 0
treeItemIsOk :: TreeItem -> Bool
treeItemIsOk (TreeItem val)
= (val /= 0)
treeItemFromInt :: Int -> TreeItem
treeItemFromInt i
= TreeItem i
withRefTreeItemId :: (Ptr (TTreeItemId ()) -> IO ()) -> IO TreeItem
withRefTreeItemId f
= do item <- assignRefPtr treeItemIdCreate f
val <- treeItemIdGetValue item
treeItemIdDelete item
return (TreeItem val)
withTreeItemIdRef :: String -> TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b
withTreeItemIdRef msg t f
= withTreeItemIdPtr t $ \p -> withValidPtr msg p f
withTreeItemIdPtr :: TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b
withTreeItemIdPtr (TreeItem val) f
= do item <- treeItemIdCreateFromValue val
x <- f item
treeItemIdDelete item
return x
withManagedTreeItemIdResult :: IO (Ptr (TTreeItemId a)) -> IO TreeItem
withManagedTreeItemIdResult io
= do item <- io
val <- treeItemIdGetValue item
treeItemIdDelete item
return (TreeItem val)
foreign import ccall "wxTreeItemId_Create" treeItemIdCreate :: IO (Ptr (TTreeItemId a))
foreign import ccall "wxTreeItemId_GetValue" treeItemIdGetValue :: Ptr (TTreeItemId a) -> IO Int
foreign import ccall "wxTreeItemId_CreateFromValue" treeItemIdCreateFromValue :: Int -> IO (Ptr (TTreeItemId a))
foreign import ccall "wxTreeItemId_Delete" treeItemIdDelete :: Ptr (TTreeItemId a) -> IO ()
withStringRef :: String -> String -> (Ptr (TWxString s) -> IO a) -> IO a
withStringRef msg s f
= withStringPtr s $ \p -> withValidPtr msg p f
withStringPtr :: String -> (Ptr (TWxString s) -> IO a) -> IO a
withStringPtr s f
= withCWString s $ \cstr ->
bracket (wxString_Create cstr)
(wxString_Delete)
f
withManagedStringResult :: IO (Ptr (TWxString a)) -> IO String
withManagedStringResult io
= do wxs <- io
len <- wxString_Length wxs
s <- if (len<=0)
then return ""
else withCWString (replicate (fromCInt len) ' ') $ \cstr ->
do wxString_GetString wxs cstr
peekCWStringLen (cstr, fromCInt len)
wxString_Delete wxs
return s
foreign import ccall wxString_Create :: Ptr CWchar -> IO (Ptr (TWxString a))
foreign import ccall wxString_CreateLen :: Ptr CWchar -> CInt -> IO (Ptr (TWxString a))
foreign import ccall wxString_Delete :: Ptr (TWxString a) -> IO ()
foreign import ccall wxString_GetString :: Ptr (TWxString a) -> Ptr CWchar -> IO CInt
foreign import ccall wxString_Length :: Ptr (TWxString a) -> IO CInt
newtype Color = Color Word
deriving (Eq, Typeable)
instance Show Color where
showsPrec d c
= showParen (d > 0) (showString "rgba(" . shows (colorRed c) .
showChar ',' . shows (colorGreen c) .
showChar ',' . shows (colorBlue c) .
showChar ',' . shows (colorAlpha c) .
showChar ')' )
colorRGB :: (Integral a) => a -> a -> a -> Color
colorRGB r g b = Color (shiftL (fromIntegral r) 24 .|. shiftL (fromIntegral g) 16 .|. shiftL (fromIntegral b) 8 .|. 255)
rgb :: (Integral a) => a -> a -> a -> Color
rgb r g b = colorRGB r g b
colorRGBA :: (Integral a) => a -> a -> a -> a -> Color
colorRGBA r g b a = Color (shiftL (fromIntegral r) 24 .|. shiftL (fromIntegral g) 16 .|. shiftL (fromIntegral b) 8 .|. (fromIntegral a))
rgba :: (Integral a) => a -> a -> a -> a -> Color
rgba r g b a = colorRGBA r g b a
intFromColor :: Color -> Int
intFromColor rgb
= let r = colorRed rgb
g = colorGreen rgb
b = colorBlue rgb
in (shiftL (fromIntegral r) 16 .|. shiftL (fromIntegral g) 8 .|. b)
colorFromInt :: Int -> Color
colorFromInt rgb
= let r = (shiftR rgb 16) .&. 0xFF
g = (shiftR rgb 8) .&. 0xFF
b = rgb .&. 0xFF
in colorRGB r g b
fromColor :: (Num a) => Color -> a
fromColor (Color rgb)
= fromIntegral rgb
toColor :: (Integral a) => a -> Color
toColor
= Color . fromIntegral
colorRed :: (Num a) => Color -> a
colorRed (Color rgba) = fromIntegral ((shiftR rgba 24) .&. 0xFF)
colorGreen :: (Num a) => Color -> a
colorGreen (Color rgba) = fromIntegral ((shiftR rgba 16) .&. 0xFF)
colorBlue :: (Num a) => Color -> a
colorBlue (Color rgba) = fromIntegral ((shiftR rgba 8) .&. 0xFF)
colorAlpha :: (Num a) => Color -> a
colorAlpha (Color rgba) = fromIntegral (rgba .&. 0xFF)
colorNull :: Color
colorNull
= Color (1)
colorOk :: Color -> Bool
colorOk = colorIsOk
colorIsOk :: Color -> Bool
colorIsOk (Color rgb)
= (rgb >= 0)
withRefColour :: (Ptr (TColour a) -> IO ()) -> IO Color
withRefColour f
= withManagedColourResult $
assignRefPtr colourCreate f
withManagedColourResult :: IO (Ptr (TColour a)) -> IO Color
withManagedColourResult io
= do pcolour <- io
color <- do ok <- colourIsOk pcolour
if (ok==0)
then return colorNull
else do rgba <- colourGetUnsignedInt pcolour
return (toColor rgba)
colourSafeDelete pcolour
return color
withColourRef :: String -> Color -> (Ptr (TColour a) -> IO b) -> IO b
withColourRef msg c f
= withColourPtr c $ \p -> withValidPtr msg p f
withColourPtr :: Color -> (Ptr (TColour a) -> IO b) -> IO b
withColourPtr c f
= do pcolour <- colourCreateFromUnsignedInt (fromColor c)
x <- f pcolour
colourSafeDelete pcolour
return x
colourFromColor :: Color -> IO (Colour ())
colourFromColor c
= if (colorOk c)
then do p <- colourCreateFromUnsignedInt (fromColor c)
if (colourIsStatic p)
then return (objectFromPtr p)
else do mp <- wxManagedPtr_CreateFromColour p
objectFromManagedPtr mp
else withObjectResult colourNull
colorFromColour :: Colour a -> IO Color
colorFromColour c
= withObjectRef "colorFromColour" c $ \pcolour ->
do ok <- colourIsOk pcolour
if (ok==0)
then return colorNull
else do rgba <- colourGetUnsignedInt pcolour
return (toColor rgba)
foreign import ccall "wxColour_CreateEmpty" colourCreate :: IO (Ptr (TColour a))
foreign import ccall "wxColour_CreateFromInt" colourCreateFromInt :: CInt -> IO (Ptr (TColour a))
foreign import ccall "wxColour_GetInt" colourGetInt :: Ptr (TColour a) -> IO CInt
foreign import ccall "wxColour_CreateFromUnsignedInt" colourCreateFromUnsignedInt :: Word -> IO (Ptr (TColour a))
foreign import ccall "wxColour_GetUnsignedInt" colourGetUnsignedInt :: Ptr (TColour a) -> IO Word
foreign import ccall "wxColour_SafeDelete" colourSafeDelete :: Ptr (TColour a) -> IO ()
foreign import ccall "wxColour_IsStatic" colourIsStatic :: Ptr (TColour a) -> Bool
foreign import ccall "wxColour_IsOk" colourIsOk :: Ptr (TColour a) -> IO CInt
foreign import ccall "Null_Colour" colourNull :: IO (Ptr (TColour a))
foreign import ccall wxManagedPtr_CreateFromColour :: Ptr (TColour a) -> IO (ManagedPtr (TColour a))