{- 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 = a -> Int
forall a. Enum a => a -> Int
fromEnum
toEnum' :: p -> Int -> a
toEnum' p
bla = Int -> a
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 = [a] -> Int
forall a. ToCl a => [a] -> Int
toCl

instance ToCl EventMask where 
   toCl :: [EventMask] -> Int
toCl = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> ([EventMask] -> Word32) -> [EventMask] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventMask -> Word32 -> Word32) -> Word32 -> [EventMask] -> Word32
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EventMask -> Word32 -> Word32
forall a a. (Bits a, Enum a) => a -> a -> a
getE (Word32
0::Word32)
     where
       getE :: a -> a -> a
getE a
e a
m = a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
m (a -> Int
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) = Word -> Int
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 -> p -> (m a, b)) -> t p -> m (a, b)
getValues m a
new a -> p -> (m a, b)
getValue t p
vl = do
  a
vs <- m a
new
  let maskf :: b -> p -> m b
maskf b
mask p
val = do m a
set; b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b
mask b -> b -> b
forall a. Bits a => a -> a -> a
.|. b
m)
                  where (m a
set,b
m) = a -> p -> (m a, b)
getValue a
vs p
val
  b
mask <- (b -> p -> m b) -> b -> t p -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM b -> p -> m b
maskf b
0 t p
vl
  (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
vs,b
mask)

failu :: String -> IO a
failu :: String -> IO a
failu = IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (String -> IOError) -> String -> IO a
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
       ((Int, a) -> m b) -> [(Int, a)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a -> (Int, a) -> m b
mod a
arr) (Int -> [a] -> [(Int, a)]
forall a. Int -> [a] -> [(Int, a)]
number Int
0 [a]
l)
       (a, Int) -> m (a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
arr,Int
size)
   where size :: Int
size = [a] -> Int
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 (Int -> Int -> Point) -> f Int -> f (Int -> Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
x f (Int -> Point) -> f Int -> f Point
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 (Point -> Point -> Rect) -> f Point -> f (Point -> Rect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int -> f Int -> f Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint f Int
x f Int
y f (Point -> Rect) -> f Point -> f Rect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Int -> f Int -> f Point
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 = [Int -> Modifiers
forall a. Enum a => Int -> a
toEnum Int
i|Int
i<-[Int
15,Int
14..Int
0],Int -> Int -> Bool
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 = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
79 (String
"Not implemented: "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
x)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"