module Graphics.UI.WXCore.Types(
( # )
, Object, objectNull, objectIsNull, objectCast, objectIsManaged
, objectDelete
, withObjectPtr, withObjectRef
, withObjectResult, withManagedObjectResult
, objectFinalize, objectNoFinalize
, objectFromPtr, managedObjectFromPtr
, Id, idAny, idCreate
, (.+.), (.-.)
, bits
, bitsSet
, unitIO, bracket, bracket_, finally, finalize, when
, Var, varCreate, varGet, varSet, varUpdate, varSwap
, Style
, EventId
, TreeItem, treeItemInvalid, treeItemIsOk
, toCBool, fromCBool
, Color, rgb, colorRGB, colorRed, colorGreen, colorBlue, intFromColor, colorFromInt, colorIsOk, colorOk
, black, darkgrey, dimgrey, mediumgrey, grey, lightgrey, white
, red, green, blue
, cyan, magenta, yellow
, SystemColor(..), colorSystem
, Point, Point2(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull
, pointMove, pointMoveBySize, pointAdd, pointSub, pointScale
, Size, Size2D(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull, sizeEncloses
, sizeMin, sizeMax
, Vector, Vector2(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull
, vecNegate, vecOrtogonal, vecAdd, vecSub, vecScale, vecBetween, vecLength
, vecLengthDouble
, Rect, Rect2D(Rect,rectLeft,rectTop,rectWidth,rectHeight)
, rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight, rectBottom, rectRight
, rect, rectBetween, rectFromSize, rectZero, rectNull, rectSize, rectIsEmpty
, rectContains, rectMoveTo, rectFromPoint, rectCentralPoint, rectCentralRect, rectStretchTo
, rectCentralPointDouble, rectCentralRectDouble
, rectMove, rectOverlaps, rectsDiff, rectUnion, rectOverlap, rectUnions
) where
import Graphics.UI.WXCore.WxcTypes
import Graphics.UI.WXCore.WxcDefs
import Graphics.UI.WXCore.WxcClasses( wxcSystemSettingsGetColour )
import System.IO.Unsafe( unsafePerformIO )
import Data.Bits
import Control.Concurrent.STM
import qualified Control.Exception as CE
import qualified Control.Monad as M
infixl 5 .+.
infixl 5 .-.
infix 5 #
( # ) :: obj -> (obj -> a) -> a
object # method = method object
(.+.) :: Bits a => a -> a -> a
(.+.) i j
= i .|. j
(.-.) :: Bits a => a -> a -> a
(.-.) i j
= i .&. complement j
bits :: (Num a, Bits a) => [a] -> a
bits xs
= foldr (.+.) 0 xs
bitsSet :: Bits a => a -> a -> Bool
bitsSet mask i
= (i .&. mask == mask)
varTopId :: Var Id
varTopId
= unsafePerformIO (varCreate (wxID_HIGHEST+1))
idAny :: Id
idAny
= 1
idCreate :: IO Id
idCreate
= varUpdate varTopId (+1)
unitIO :: IO a -> IO ()
unitIO io
= io >> return ()
when :: Bool -> IO () -> IO ()
when = M.when
bracket :: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracket = CE.bracket
bracket_ :: IO a
-> IO b
-> IO c
-> IO c
bracket_ = CE.bracket_
finally :: IO a
-> IO b
-> IO a
finally = CE.finally
finalize :: IO b
-> IO a
-> IO a
finalize lastComputation firstComputation
= finally firstComputation lastComputation
type Var a = TVar a
varCreate :: a -> IO (Var a)
varCreate x = newTVarIO x
varGet :: Var a -> IO a
varGet v = atomically $ readTVar v
varSet :: Var a -> a -> IO ()
varSet v x = atomically $ writeTVar v x
varSwap :: Var a -> a -> IO a
varSwap v x = atomically $ do
prev <- readTVar v
writeTVar v x
return prev
varUpdate :: Var a -> (a -> a) -> IO a
varUpdate v f = atomically $ do
x <- readTVar v
writeTVar v (f x)
return x
pointMove :: (Num a) => Vector2 a -> Point2 a -> Point2 a
pointMove (Vector dx dy) (Point x y)
= Point (x+dx) (y+dy)
pointMoveBySize :: (Num a) => Point2 a -> Size2D a -> Point2 a
pointMoveBySize (Point x y) (Size w h) = Point (x + w) (y + h)
pointAdd :: (Num a) => Point2 a -> Point2 a -> Point2 a
pointAdd (Point x1 y1) (Point x2 y2) = Point (x1+x2) (y1+y2)
pointSub :: (Num a) => Point2 a -> Point2 a -> Point2 a
pointSub (Point x1 y1) (Point x2 y2) = Point (x1x2) (y1y2)
pointScale :: (Num a) => Point2 a -> a -> Point2 a
pointScale (Point x y) v = Point (v*x) (v*y)
sizeEncloses :: (Num a, Ord a) => Size2D a -> Size2D a -> Bool
sizeEncloses (Size w0 h0) (Size w1 h1)
= (w0 >= w1) && (h0 >= h1)
sizeMin :: (Num a, Ord a) => Size2D a -> Size2D a -> Size2D a
sizeMin (Size w0 h0) (Size w1 h1)
= Size (min w0 w1) (min h0 h1)
sizeMax :: (Num a, Ord a) => Size2D a -> Size2D a -> Size2D a
sizeMax (Size w0 h0) (Size w1 h1)
= Size (max w0 w1) (max h0 h1)
vecNegate :: (Num a) => Vector2 a -> Vector2 a
vecNegate (Vector x y)
= Vector (x) (y)
vecOrtogonal :: (Num a) => Vector2 a -> Vector2 a
vecOrtogonal (Vector x y) = (Vector y (x))
vecAdd :: (Num a) => Vector2 a -> Vector2 a -> Vector2 a
vecAdd (Vector x1 y1) (Vector x2 y2) = Vector (x1+x2) (y1+y2)
vecSub :: (Num a) => Vector2 a -> Vector2 a -> Vector2 a
vecSub (Vector x1 y1) (Vector x2 y2) = Vector (x1x2) (y1y2)
vecScale :: (Num a) => Vector2 a -> a -> Vector2 a
vecScale (Vector x y) v = Vector (v*x) (v*y)
vecBetween :: (Num a) => Point2 a -> Point2 a -> Vector2 a
vecBetween (Point x1 y1) (Point x2 y2) = Vector (x2x1) (y2y1)
vecLength :: Vector -> Double
vecLength (Vector x y)
= sqrt (fromIntegral (x*x + y*y))
vecLengthDouble :: Vector2 Double -> Double
vecLengthDouble (Vector x y)
= sqrt (x*x + y*y)
rectContains :: (Num a, Ord a) => Rect2D a -> Point2 a -> Bool
rectContains (Rect l t w h) (Point x y)
= (x >= l && x <= (l+w) && y >= t && y <= (t+h))
rectMoveTo :: (Num a) => Rect2D a -> Point2 a -> Rect2D a
rectMoveTo r p
= rect p (rectSize r)
rectFromPoint :: (Num a) => Point2 a -> Rect2D a
rectFromPoint (Point x y)
= Rect x y x y
rectCentralPoint :: Rect2D Int -> Point2 Int
rectCentralPoint (Rect l t w h)
= Point (l + div w 2) (t + div h 2)
rectCentralRect :: Rect2D Int -> Size -> Rect2D Int
rectCentralRect r@(Rect _l _t _rw _rh) (Size w h)
= let c = rectCentralPoint r
in Rect (pointX c (w div w 2)) (pointY c (h div h 2)) w h
rectCentralPointDouble :: (Fractional a) => Rect2D a -> Point2 a
rectCentralPointDouble (Rect l t w h)
= Point (l + w/2) (t + h/2)
rectCentralRectDouble :: (Fractional a) => Rect2D a -> Size2D a -> Rect2D a
rectCentralRectDouble r@(Rect _l _t _rw _rh) (Size w h)
= let c = rectCentralPointDouble r
in Rect (pointX c (w w/2)) (pointY c (h h/2)) w h
rectStretchTo :: (Num a) => Rect2D a -> Size2D a -> Rect2D a
rectStretchTo (Rect l t _ _) (Size w h)
= Rect l t w h
rectMove :: (Num a) => Rect2D a -> Vector2 a -> Rect2D a
rectMove (Rect x y w h) (Vector dx dy)
= Rect (x+dx) (y+dy) w h
rectOverlaps :: (Num a, Ord a) => Rect2D a -> Rect2D a -> Bool
rectOverlaps (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2)
= (x1+w1 >= x2 && x1 <= x2+w2) && (y1+h1 >= y2 && y1 <= y2+h2)
rectsDiff :: (Num a, Ord a) => Rect2D a -> Rect2D a -> [Rect2D a]
rectsDiff rect1 rect2
= subtractFittingRect rect1 (rectOverlap rect1 rect2)
where
subtractFittingRect :: (Num a, Ord a) => Rect2D a -> Rect2D a -> [Rect2D a]
subtractFittingRect r1 r2 =
filter (not . rectIsEmpty)
[ rectBetween (rectTopLeft r1) (rectTopRight r2)
, rectBetween (pt (rectLeft r1) (rectTop r2)) (rectBottomLeft r2)
, rectBetween (pt (rectLeft r1) (rectBottom r2)) (pt (rectRight r2) (rectBottom r1))
, rectBetween (rectTopRight r2) (rectBottomRight r1)
]
rectUnion :: (Num a, Ord a) => Rect2D a -> Rect2D a -> Rect2D a
rectUnion r1 r2
= rectBetween (pt (min (rectLeft r1) (rectLeft r2)) (min (rectTop r1) (rectTop r2)))
(pt (max (rectRight r1) (rectRight r2)) (max (rectBottom r1) (rectBottom r2)))
rectUnions :: (Num a, Ord a) => [Rect2D a] -> Rect2D a
rectUnions []
= rectZero
rectUnions (r:rs)
= foldr rectUnion r rs
rectOverlap :: (Num a, Ord a) => Rect2D a -> Rect2D a -> Rect2D a
rectOverlap r1 r2
| rectOverlaps r1 r2 = rectBetween (pt (max (rectLeft r1) (rectLeft r2)) (max (rectTop r1) (rectTop r2)))
(pt (min (rectRight r1) (rectRight r2)) (min (rectBottom r1) (rectBottom r2)))
| otherwise = rectZero
black, darkgrey, dimgrey, mediumgrey, grey, lightgrey, white :: Color
red, green, blue :: Color
cyan, magenta, yellow :: Color
black = colorRGB 0x00 0x00 (0x00 :: Int)
darkgrey = colorRGB 0x2F 0x2F (0x2F :: Int)
dimgrey = colorRGB 0x54 0x54 (0x54 :: Int)
mediumgrey= colorRGB 0x64 0x64 (0x64 :: Int)
grey = colorRGB 0x80 0x80 (0x80 :: Int)
lightgrey = colorRGB 0xC0 0xC0 (0xC0 :: Int)
white = colorRGB 0xFF 0xFF (0xFF :: Int)
red = colorRGB 0xFF 0x00 (0x00 :: Int)
green = colorRGB 0x00 0xFF (0x00 :: Int)
blue = colorRGB 0x00 0x00 (0xFF :: Int)
yellow = colorRGB 0xFF 0xFF (0x00 :: Int)
magenta = colorRGB 0xFF 0x00 (0xFF :: Int)
cyan = colorRGB 0x00 0xFF (0xFF :: Int)
data SystemColor
= ColorScrollBar
| ColorBackground
| ColorActiveCaption
| ColorInactiveCaption
| ColorMenu
| ColorWindow
| ColorWindowFrame
| ColorMenuText
| ColorWindowText
| ColorCaptionText
| ColorActiveBorder
| ColorInactiveBorder
| ColorAppWorkspace
| ColorHighlight
| ColorHighlightText
| ColorBtnFace
| ColorBtnShadow
| ColorGrayText
| ColorBtnText
| ColorInactiveCaptionText
| ColorBtnHighlight
| Color3DDkShadow
| Color3DLight
| ColorInfoText
| ColorInfoBk
| ColorDesktop
| Color3DFace
| Color3DShadow
| Color3DHighlight
| Color3DHilight
| ColorBtnHilight
instance Enum SystemColor where
toEnum _i
= error "Graphics.UI.WXCore.Types.SytemColor.toEnum: can not convert integers to system colors."
fromEnum systemColor
= fromIntegral $
case systemColor of
ColorScrollBar -> wxSYS_COLOUR_SCROLLBAR
ColorBackground -> wxSYS_COLOUR_BACKGROUND
ColorActiveCaption -> wxSYS_COLOUR_ACTIVECAPTION
ColorInactiveCaption -> wxSYS_COLOUR_INACTIVECAPTION
ColorMenu -> wxSYS_COLOUR_MENU
ColorWindow -> wxSYS_COLOUR_WINDOW
ColorWindowFrame -> wxSYS_COLOUR_WINDOWFRAME
ColorMenuText -> wxSYS_COLOUR_MENUTEXT
ColorWindowText -> wxSYS_COLOUR_WINDOWTEXT
ColorCaptionText -> wxSYS_COLOUR_CAPTIONTEXT
ColorActiveBorder -> wxSYS_COLOUR_ACTIVEBORDER
ColorInactiveBorder -> wxSYS_COLOUR_INACTIVEBORDER
ColorAppWorkspace -> wxSYS_COLOUR_APPWORKSPACE
ColorHighlight -> wxSYS_COLOUR_HIGHLIGHT
ColorHighlightText -> wxSYS_COLOUR_HIGHLIGHTTEXT
ColorBtnFace -> wxSYS_COLOUR_BTNFACE
ColorBtnShadow -> wxSYS_COLOUR_BTNSHADOW
ColorGrayText -> wxSYS_COLOUR_GRAYTEXT
ColorBtnText -> wxSYS_COLOUR_BTNTEXT
ColorInactiveCaptionText -> wxSYS_COLOUR_INACTIVECAPTIONTEXT
ColorBtnHighlight -> wxSYS_COLOUR_BTNHIGHLIGHT
Color3DDkShadow -> wxSYS_COLOUR_3DDKSHADOW
Color3DLight -> wxSYS_COLOUR_3DLIGHT
ColorInfoText -> wxSYS_COLOUR_INFOTEXT
ColorInfoBk -> wxSYS_COLOUR_INFOBK
ColorDesktop -> wxSYS_COLOUR_DESKTOP
Color3DFace -> wxSYS_COLOUR_3DFACE
Color3DShadow -> wxSYS_COLOUR_3DSHADOW
Color3DHighlight -> wxSYS_COLOUR_3DHIGHLIGHT
Color3DHilight -> wxSYS_COLOUR_3DHILIGHT
ColorBtnHilight -> wxSYS_COLOUR_BTNHILIGHT
colorSystem :: SystemColor -> Color
colorSystem systemColor
= unsafePerformIO $
wxcSystemSettingsGetColour (fromEnum systemColor)