{- unused options -#include <X11/Xlib.h> -#include <X11/Xutil.h> -fvia-C -}
-- -optc-I/usr/X11R6/include
module XCallTypes
 --(module XCallTypes,newCharArray,MutableByteArray(..))
 where

import Data.Bits
import Data.Word(Word32)
import Control.Applicative
import Control.Monad(foldM)
--import MyForeign(Int32)

import Utils(number)
import Xtypes
import Geometry
--import Ap(foldR)
--import PackedString(unpackPS,byteArrayToPS{-,packCString-})

-- #include "structs.h"

getEnum :: p -> a -> Int
getEnum p
bla = forall a. Enum a => a -> Int
fromEnum
toEnum' :: p -> Int -> a
toEnum' p
bla = forall a. Enum a => Int -> a
toEnum
{-
toEnum' s = (a!)
  where a = listArray (0,length l - 1) l
        l = [s..]

getEnum s = (a!)
  where a = listArray (s,last [s..]) [(0::Int)..]
-}

class ToC a where toC :: a -> Int
class ToCl a where toCl :: [a] -> Int
class FromC a where fromC :: Int -> a

class ToXID a where toXID :: a -> XID
--class FromXID a where fromXID :: XID -> a

instance (ToCl a) => ToC [a] where toC :: [a] -> Int
toC = forall a. ToCl a => [a] -> Int
toCl

instance ToCl EventMask where 
   toCl :: [EventMask] -> Int
toCl = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. (Bits a, Enum a) => a -> a -> a
getE (Word32
0::Word32)
     where
       getE :: a -> a -> a
getE a
e a
m = forall a. Bits a => a -> Int -> a
setBit a
m (forall a. Enum a => a -> Int
fromEnum a
e)

instance ToC Bool where toC :: Bool -> Int
toC Bool
False = Int
0
                        toC Bool
True = Int
1

instance FromC Bool where fromC :: Int -> Bool
fromC Int
0 = Bool
False
                          fromC Int
_ = Bool
True


instance ToXID PixmapId where toXID :: PixmapId -> XID
toXID (PixmapId XID
p) = XID
p
instance ToC Pixel where toC :: Pixel -> Int
toC (Pixel Word
p) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
p
instance ToXID ColormapId where toXID :: ColormapId -> XID
toXID (ColormapId XID
p) = XID
p
instance ToXID CursorId where toXID :: CursorId -> XID
toXID (CursorId XID
p) = XID
p
instance ToXID FontId where toXID :: FontId -> XID
toXID (FontId XID
p) = XID
p
--instance ToC WindowId where toC (WindowId p) = p
--instance ToC Display where toC (Display p) = p
--instance ToC Width where toC (Width p) = p
--instance ToC Atom where toC (Atom p) = p
--instance ToC PropertyMode where toC (PropertyMode p) = p

--pIoCmd x = primIOToIO x :: IO ()
--pIoCmd x = stToIO x :: IO ()
ioCmd :: IO () -> IO ()
ioCmd IO ()
x = IO ()
x :: IO ()

getValues :: m a -> (a -> a -> (m a, b)) -> t a -> m (a, b)
getValues m a
new a -> a -> (m a, b)
getValue t a
vl = do
  a
vs <- m a
new
  let maskf :: b -> a -> m b
maskf b
mask a
val = do m a
set; forall (m :: * -> *) a. Monad m => a -> m a
return (b
mask forall a. Bits a => a -> a -> a
.|. b
m)
                  where (m a
set,b
m) = a -> a -> (m a, b)
getValue a
vs a
val
  b
mask <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM b -> a -> m b
maskf b
0 t a
vl
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
vs,b
mask)

failu :: String -> IO a
failu :: forall a. String -> IO a
failu = forall a. IOError -> IO a
ioError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError

--unpackCharArray len a = fmap (take len . unpackPS . byteArrayToPS) $
--    stToIO $ unsafeFreezeByteArray a

--cstring :: Addr -> String -- This type looks a bit suspicious... /TH 990211
--cstring = unpackCString

getArray :: (Int -> m a) -> (a -> (Int, a) -> m b) -> [a] -> m (a, Int)
getArray Int -> m a
new a -> (Int, a) -> m b
mod [a]
l = do
       a
arr <- Int -> m a
new Int
size
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a -> (Int, a) -> m b
mod a
arr) (forall a. Int -> [a] -> [(Int, a)]
number Int
0 [a]
l)
       forall (m :: * -> *) a. Monad m => a -> m a
return (a
arr,Int
size)
   where size :: Int
size = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l


{-
H_ARRAY(int)
newInt = newintArray 1
readInt i = CINDEX(int) (i::Cint) (0::Int) :: IO Int
writeInt i v = SINDEX(int,i::Cint,0::Int,v::Int)
-}

mkPoint :: f Int -> f Int -> f Point
mkPoint f Int
x f Int
y = Int -> Int -> Point
Point forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Int
y
mkRect :: f Int -> f Int -> f Int -> f Int -> f Rect
mkRect f Int
x f Int
y f Int
w f Int
h = Point -> Point -> Rect
Rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *}. Applicative f => f Int -> f Int -> f Point
mkPoint f Int
x f Int
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {f :: * -> *}. Applicative f => f Int -> f Int -> f Point
mkPoint f Int
w f Int
h

--mkAtom a = fmap Atom a
--mkSelection s t p = Selection <$> mkAtom s <*> mkAtom t <*> mkAtom p
--mkSelection s t p = Selection <$> s <*> t <*> p

instance FromC ModState where 
 fromC :: Int -> ModState
fromC Int
ni = [forall a. Enum a => Int -> a
toEnum Int
i|Int
i<-[Int
15,Int
14..Int
0],forall a. Bits a => a -> Int -> Bool
testBit Int
ni Int
i]
{-
     concatMap toModifier [15,14..0]
   where
     toModifier i = [toEnum i|testBit ni i]
--   toe = toEnum' Shift -- . fromIntegral
--   n = fromIntegral ni :: Word32
-}

notImplemented :: a -> String
notImplemented a
x = forall a. Int -> [a] -> [a]
take Int
79 (String
"Not implemented: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show a
x)forall a. [a] -> [a] -> [a]
++String
"\n"