module Termbox.Bindings.Hs.Internal.InputMode
  ( Tb_input_mode (Tb_input_mode),
    _TB_INPUT_ALT,
    _TB_INPUT_ESC,
    _TB_INPUT_MOUSE,
  )
where

import Data.Bits (Bits, (.|.))
import Data.Coerce (coerce)
import Foreign.C.Types (CInt)
import qualified Termbox.Bindings.C as Termbox

-- | The input mode.
newtype Tb_input_mode
  = Tb_input_mode CInt
  deriving stock (Tb_input_mode -> Tb_input_mode -> Bool
(Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Bool) -> Eq Tb_input_mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tb_input_mode -> Tb_input_mode -> Bool
== :: Tb_input_mode -> Tb_input_mode -> Bool
$c/= :: Tb_input_mode -> Tb_input_mode -> Bool
/= :: Tb_input_mode -> Tb_input_mode -> Bool
Eq)
  deriving newtype (Eq Tb_input_mode
Tb_input_mode
Eq Tb_input_mode =>
(Tb_input_mode -> Tb_input_mode -> Tb_input_mode)
-> (Tb_input_mode -> Tb_input_mode -> Tb_input_mode)
-> (Tb_input_mode -> Tb_input_mode -> Tb_input_mode)
-> (Tb_input_mode -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> Tb_input_mode
-> (Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Bool)
-> (Tb_input_mode -> Maybe Int)
-> (Tb_input_mode -> Int)
-> (Tb_input_mode -> Bool)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int -> Tb_input_mode)
-> (Tb_input_mode -> Int)
-> Bits Tb_input_mode
Int -> Tb_input_mode
Tb_input_mode -> Bool
Tb_input_mode -> Int
Tb_input_mode -> Maybe Int
Tb_input_mode -> Tb_input_mode
Tb_input_mode -> Int -> Bool
Tb_input_mode -> Int -> Tb_input_mode
Tb_input_mode -> Tb_input_mode -> Tb_input_mode
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
.&. :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
$c.|. :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
.|. :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
$cxor :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
xor :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
$ccomplement :: Tb_input_mode -> Tb_input_mode
complement :: Tb_input_mode -> Tb_input_mode
$cshift :: Tb_input_mode -> Int -> Tb_input_mode
shift :: Tb_input_mode -> Int -> Tb_input_mode
$crotate :: Tb_input_mode -> Int -> Tb_input_mode
rotate :: Tb_input_mode -> Int -> Tb_input_mode
$czeroBits :: Tb_input_mode
zeroBits :: Tb_input_mode
$cbit :: Int -> Tb_input_mode
bit :: Int -> Tb_input_mode
$csetBit :: Tb_input_mode -> Int -> Tb_input_mode
setBit :: Tb_input_mode -> Int -> Tb_input_mode
$cclearBit :: Tb_input_mode -> Int -> Tb_input_mode
clearBit :: Tb_input_mode -> Int -> Tb_input_mode
$ccomplementBit :: Tb_input_mode -> Int -> Tb_input_mode
complementBit :: Tb_input_mode -> Int -> Tb_input_mode
$ctestBit :: Tb_input_mode -> Int -> Bool
testBit :: Tb_input_mode -> Int -> Bool
$cbitSizeMaybe :: Tb_input_mode -> Maybe Int
bitSizeMaybe :: Tb_input_mode -> Maybe Int
$cbitSize :: Tb_input_mode -> Int
bitSize :: Tb_input_mode -> Int
$cisSigned :: Tb_input_mode -> Bool
isSigned :: Tb_input_mode -> Bool
$cshiftL :: Tb_input_mode -> Int -> Tb_input_mode
shiftL :: Tb_input_mode -> Int -> Tb_input_mode
$cunsafeShiftL :: Tb_input_mode -> Int -> Tb_input_mode
unsafeShiftL :: Tb_input_mode -> Int -> Tb_input_mode
$cshiftR :: Tb_input_mode -> Int -> Tb_input_mode
shiftR :: Tb_input_mode -> Int -> Tb_input_mode
$cunsafeShiftR :: Tb_input_mode -> Int -> Tb_input_mode
unsafeShiftR :: Tb_input_mode -> Int -> Tb_input_mode
$crotateL :: Tb_input_mode -> Int -> Tb_input_mode
rotateL :: Tb_input_mode -> Int -> Tb_input_mode
$crotateR :: Tb_input_mode -> Int -> Tb_input_mode
rotateR :: Tb_input_mode -> Int -> Tb_input_mode
$cpopCount :: Tb_input_mode -> Int
popCount :: Tb_input_mode -> Int
Bits)

instance Show Tb_input_mode where
  show :: Tb_input_mode -> String
show Tb_input_mode
mode
    | Tb_input_mode
mode Tb_input_mode -> Tb_input_mode -> Bool
forall a. Eq a => a -> a -> Bool
== Tb_input_mode
_TB_INPUT_ESC = String
"_TB_INPUT_ESC"
    | Tb_input_mode
mode Tb_input_mode -> Tb_input_mode -> Bool
forall a. Eq a => a -> a -> Bool
== Tb_input_mode
_TB_INPUT_ALT = String
"_TB_INPUT_ALT"
    | Tb_input_mode
mode Tb_input_mode -> Tb_input_mode -> Bool
forall a. Eq a => a -> a -> Bool
== Tb_input_mode
_TB_INPUT_ESC Tb_input_mode -> Tb_input_mode -> Tb_input_mode
forall a. Semigroup a => a -> a -> a
<> Tb_input_mode
_TB_INPUT_MOUSE = String
"_TB_INPUT_ESC <> _TB_INPUT_MOUSE"
    | Tb_input_mode
mode Tb_input_mode -> Tb_input_mode -> Bool
forall a. Eq a => a -> a -> Bool
== Tb_input_mode
_TB_INPUT_ALT Tb_input_mode -> Tb_input_mode -> Tb_input_mode
forall a. Semigroup a => a -> a -> a
<> Tb_input_mode
_TB_INPUT_MOUSE = String
"_TB_INPUT_ALT <> _TB_INPUT_MOUSE"
    | Bool
otherwise = String
"Tb_input_mode " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @CInt Tb_input_mode
mode)

instance Semigroup Tb_input_mode where
  <> :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
(<>) = (CInt -> CInt -> CInt)
-> Tb_input_mode -> Tb_input_mode -> Tb_input_mode
forall a b. Coercible a b => a -> b
coerce (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) :: CInt -> CInt -> CInt)

_TB_INPUT_ALT :: Tb_input_mode
_TB_INPUT_ALT :: Tb_input_mode
_TB_INPUT_ALT =
  CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox._TB_INPUT_ALT

_TB_INPUT_ESC :: Tb_input_mode
_TB_INPUT_ESC :: Tb_input_mode
_TB_INPUT_ESC =
  CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox._TB_INPUT_ESC

_TB_INPUT_MOUSE :: Tb_input_mode
_TB_INPUT_MOUSE :: Tb_input_mode
_TB_INPUT_MOUSE =
  CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox._TB_INPUT_MOUSE