{-# LINE 1 "src/SFML/Window/Event.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/SFML/Window/Event.hsc" #-}
module SFML.Window.Event
(
    SFEvent(..)
)
where


import SFML.Window.Joystick
import SFML.Window.Keyboard
import SFML.Window.Mouse

import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable


{-# LINE 20 "src/SFML/Window/Event.hsc" #-}


data SFEvent
    = SFEvtClosed
    | SFEvtResized
    { width  :: Int
    , height :: Int
    }
    | SFEvtLostFocus
    | SFEvtGainedFocus
    | SFEvtTextEntered
    { text :: String
    }
    | SFEvtKeyPressed
    { code  :: KeyCode
    , alt   :: Bool
    , ctrl  :: Bool
    , shift :: Bool
    , sys   :: Bool
    }
    | SFEvtKeyReleased
    { code  :: KeyCode
    , alt   :: Bool
    , ctrl  :: Bool
    , shift :: Bool
    , sys   :: Bool
    }
    | SFEvtMouseWheelMoved
    { delta :: Int
    , x     :: Int
    , y     :: Int
    }
    | SFEvtMouseButtonPressed
    { button :: MouseButton
    , x      :: Int
    , y      :: Int
    }
    | SFEvtMouseButtonReleased
    { button :: MouseButton
    , x      :: Int
    , y      :: Int
    }
    | SFEvtMouseMoved
    { x :: Int
    , y :: Int
    }
    | SFEvtMouseEntered
    | SFEvtMouseLeft
    | SFEvtJoystickButtonPressed
    { joystickId :: Int
    , joystickBt :: Int
    }
    | SFEvtJoystickButtonReleased
    { joystickId :: Int
    , joystickBt :: Int
    }
    | SFEvtJoystickMoved
    { joystickId   :: Int
    , joystickAxis :: JoystickAxis
    , position     :: Float
    }
    | SFEvtJoystickConnected
    { joystickId :: Int
    }
    | SFEvtJoystickDisconnected
    { joystickId :: Int
    }


sizeInt = (4)
{-# LINE 90 "src/SFML/Window/Event.hsc" #-}
sizeChar = (1)
{-# LINE 91 "src/SFML/Window/Event.hsc" #-}


instance Storable SFEvent where
    sizeOf _ = (24)
{-# LINE 95 "src/SFML/Window/Event.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    
    peek ptr' =
        let ptr'' = castPtr ptr' :: Ptr CInt
        in do
            let ptr = castPtr ptr''
            eventType <- peek ptr'' :: IO CInt
            case eventType of
                0  -> return SFEvtClosed
                1  -> do
                    w <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr  :: IO CUInt
{-# LINE 106 "src/SFML/Window/Event.hsc" #-}
                    h <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CUInt
{-# LINE 107 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtResized (fromIntegral w) (fromIntegral h)
                2  -> return SFEvtLostFocus
                3  -> return SFEvtGainedFocus
                4  -> peekCAString (plusPtr ptr sizeInt) >>= return . SFEvtTextEntered
                5  -> do
                    code  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 113 "src/SFML/Window/Event.hsc" #-}
                    alt   <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 114 "src/SFML/Window/Event.hsc" #-}
                    ctrl  <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 115 "src/SFML/Window/Event.hsc" #-}
                    shift <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr :: IO CInt
{-# LINE 116 "src/SFML/Window/Event.hsc" #-}
                    sys   <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr :: IO CInt
{-# LINE 117 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtKeyPressed code (toEnum . fromIntegral $ alt) (toEnum . fromIntegral $ ctrl)
                               (toEnum . fromIntegral $ shift) (toEnum . fromIntegral $ sys)
                6  -> do
                    code  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 121 "src/SFML/Window/Event.hsc" #-}
                    alt   <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 122 "src/SFML/Window/Event.hsc" #-}
                    ctrl  <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 123 "src/SFML/Window/Event.hsc" #-}
                    shift <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr :: IO CInt
{-# LINE 124 "src/SFML/Window/Event.hsc" #-}
                    sys   <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr :: IO CInt
{-# LINE 125 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtKeyReleased code (toEnum . fromIntegral $ alt) (toEnum . fromIntegral $ ctrl)
                               (toEnum . fromIntegral $ shift) (toEnum . fromIntegral $ sys)
                7  -> do
                    delta <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt
{-# LINE 129 "src/SFML/Window/Event.hsc" #-}
                    x     <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 130 "src/SFML/Window/Event.hsc" #-}
                    y     <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 131 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtMouseWheelMoved (fromIntegral delta) (fromIntegral x) (fromIntegral y)
                8  -> do
                    button <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 134 "src/SFML/Window/Event.hsc" #-}
                    x      <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 135 "src/SFML/Window/Event.hsc" #-}
                    y      <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 136 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtMouseButtonPressed button (fromIntegral x) (fromIntegral y)
                9  -> do
                    button <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 139 "src/SFML/Window/Event.hsc" #-}
                    x      <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 140 "src/SFML/Window/Event.hsc" #-}
                    y      <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 141 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtMouseButtonReleased button (fromIntegral x) (fromIntegral y)
                10 -> do
                    x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt
{-# LINE 144 "src/SFML/Window/Event.hsc" #-}
                    y <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 145 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtMouseMoved (fromIntegral x) (fromIntegral y)
                11 -> return SFEvtMouseEntered
                12 -> return SFEvtMouseLeft
                13 -> do
                    j  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CUInt
{-# LINE 150 "src/SFML/Window/Event.hsc" #-}
                    bt <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CUInt
{-# LINE 151 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtJoystickButtonPressed (fromIntegral j) (fromIntegral bt)
                14 -> do
                    j  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CUInt
{-# LINE 154 "src/SFML/Window/Event.hsc" #-}
                    bt <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CUInt
{-# LINE 155 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtJoystickButtonReleased (fromIntegral j) (fromIntegral bt)
                15 -> do
                    j    <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CUInt
{-# LINE 158 "src/SFML/Window/Event.hsc" #-}
                    axis <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 159 "src/SFML/Window/Event.hsc" #-}
                    pos  <- fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CFloat)
{-# LINE 160 "src/SFML/Window/Event.hsc" #-}
                    return $ SFEvtJoystickMoved (fromIntegral j) axis pos
                16 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickConnected
                17 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickDisconnected
    
    poke ptr evt = return ()