{-# LINE 1 "System/Linux/Input/Event/Constants.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Linux/Input/Event/Constants.hsc" #-}

module System.Linux.Input.Event.Constants where

import Foreign.C.Types
import Data.Word
import Data.Int


{-# LINE 10 "System/Linux/Input/Event/Constants.hsc" #-}

newtype SyncType = SyncType Word16 deriving (Show, Eq)
sync_report       :: SyncType
sync_report       = SyncType 0
sync_config       :: SyncType
sync_config       = SyncType 1
sync_mt_report    :: SyncType
sync_mt_report    = SyncType 2
sync_dropped      :: SyncType
sync_dropped      = SyncType 3

{-# LINE 18 "System/Linux/Input/Event/Constants.hsc" #-}

-- TODO Finish
newtype Key = Key Word16 deriving (Show, Eq)
key_reserved     :: Key
key_reserved     = Key 0
key_esc          :: Key
key_esc          = Key 1
btn_0            :: Key
btn_0            = Key 256
btn_1            :: Key
btn_1            = Key 257
btn_2            :: Key
btn_2            = Key 258
btn_3            :: Key
btn_3            = Key 259
btn_4            :: Key
btn_4            = Key 260
btn_5            :: Key
btn_5            = Key 261
btn_6            :: Key
btn_6            = Key 262
btn_7            :: Key
btn_7            = Key 263
btn_8            :: Key
btn_8            = Key 264
btn_9            :: Key
btn_9            = Key 265

{-# LINE 36 "System/Linux/Input/Event/Constants.hsc" #-}

newtype RelAxis = RelAxis Word16 deriving (Show, Eq)
rel_x             :: RelAxis
rel_x             = RelAxis 0
rel_y             :: RelAxis
rel_y             = RelAxis 1
rel_z             :: RelAxis
rel_z             = RelAxis 2
rel_rx            :: RelAxis
rel_rx            = RelAxis 3
rel_ry            :: RelAxis
rel_ry            = RelAxis 4
rel_rz            :: RelAxis
rel_rz            = RelAxis 5
rel_hWheel        :: RelAxis
rel_hWheel        = RelAxis 6
rel_dial          :: RelAxis
rel_dial          = RelAxis 7
rel_wheel         :: RelAxis
rel_wheel         = RelAxis 8
rel_misc          :: RelAxis
rel_misc          = RelAxis 9

{-# LINE 50 "System/Linux/Input/Event/Constants.hsc" #-}

newtype AbsAxis = AbsAxis Word16 deriving (Show, Eq)
abs_x             :: AbsAxis
abs_x             = AbsAxis 0
abs_y             :: AbsAxis
abs_y             = AbsAxis 1
abs_z             :: AbsAxis
abs_z             = AbsAxis 2
abs_rx            :: AbsAxis
abs_rx            = AbsAxis 3
abs_ry            :: AbsAxis
abs_ry            = AbsAxis 4
abs_rz            :: AbsAxis
abs_rz            = AbsAxis 5

{-# LINE 60 "System/Linux/Input/Event/Constants.hsc" #-}