{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: WildBind.Input.NumPad
-- Description: Types about number pads
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- Input types for number pad keys.
module WildBind.Input.NumPad
    ( -- * NumLock disabled
      NumPadUnlocked (..)
      -- * NumLock enabled
    , NumPadLocked (..)
    ) where

import           WildBind.Description (Describable (describe))

-- | Number pad key input with NumLock disabled.
data NumPadUnlocked = NumInsert | NumEnd | NumDown | NumPageDown | NumLeft | NumCenter | NumRight | NumHome | NumUp | NumPageUp | NumDivide | NumMulti | NumMinus | NumPlus | NumEnter | NumDelete deriving
    ( NumPadUnlocked
forall a. a -> a -> Bounded a
maxBound :: NumPadUnlocked
$cmaxBound :: NumPadUnlocked
minBound :: NumPadUnlocked
$cminBound :: NumPadUnlocked
Bounded
    , Int -> NumPadUnlocked
NumPadUnlocked -> Int
NumPadUnlocked -> [NumPadUnlocked]
NumPadUnlocked -> NumPadUnlocked
NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromThenTo :: NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFromTo :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromTo :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFromThen :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromThen :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFrom :: NumPadUnlocked -> [NumPadUnlocked]
$cenumFrom :: NumPadUnlocked -> [NumPadUnlocked]
fromEnum :: NumPadUnlocked -> Int
$cfromEnum :: NumPadUnlocked -> Int
toEnum :: Int -> NumPadUnlocked
$ctoEnum :: Int -> NumPadUnlocked
pred :: NumPadUnlocked -> NumPadUnlocked
$cpred :: NumPadUnlocked -> NumPadUnlocked
succ :: NumPadUnlocked -> NumPadUnlocked
$csucc :: NumPadUnlocked -> NumPadUnlocked
Enum
    , NumPadUnlocked -> NumPadUnlocked -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c/= :: NumPadUnlocked -> NumPadUnlocked -> Bool
== :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c== :: NumPadUnlocked -> NumPadUnlocked -> Bool
Eq
    , Eq NumPadUnlocked
NumPadUnlocked -> NumPadUnlocked -> Bool
NumPadUnlocked -> NumPadUnlocked -> Ordering
NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
$cmin :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
max :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
$cmax :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
>= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c>= :: NumPadUnlocked -> NumPadUnlocked -> Bool
> :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c> :: NumPadUnlocked -> NumPadUnlocked -> Bool
<= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c<= :: NumPadUnlocked -> NumPadUnlocked -> Bool
< :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c< :: NumPadUnlocked -> NumPadUnlocked -> Bool
compare :: NumPadUnlocked -> NumPadUnlocked -> Ordering
$ccompare :: NumPadUnlocked -> NumPadUnlocked -> Ordering
Ord
    , Int -> NumPadUnlocked -> ShowS
[NumPadUnlocked] -> ShowS
NumPadUnlocked -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NumPadUnlocked] -> ShowS
$cshowList :: [NumPadUnlocked] -> ShowS
show :: NumPadUnlocked -> [Char]
$cshow :: NumPadUnlocked -> [Char]
showsPrec :: Int -> NumPadUnlocked -> ShowS
$cshowsPrec :: Int -> NumPadUnlocked -> ShowS
Show
    )

instance Describable NumPadUnlocked where
  describe :: NumPadUnlocked -> ActionDescription
describe NumPadUnlocked
input = case NumPadUnlocked
input of
    NumPadUnlocked
NumHome     -> ActionDescription
"Home"
    NumPadUnlocked
NumUp       -> ActionDescription
"↑"
    NumPadUnlocked
NumPageUp   -> ActionDescription
"PageUp"
    NumPadUnlocked
NumLeft     -> ActionDescription
"←"
    NumPadUnlocked
NumCenter   -> ActionDescription
""
    NumPadUnlocked
NumRight    -> ActionDescription
"→"
    NumPadUnlocked
NumEnd      -> ActionDescription
"End"
    NumPadUnlocked
NumDown     -> ActionDescription
"↓"
    NumPadUnlocked
NumPageDown -> ActionDescription
"PageDown"
    NumPadUnlocked
NumDivide   -> ActionDescription
"/"
    NumPadUnlocked
NumMulti    -> ActionDescription
"*"
    NumPadUnlocked
NumMinus    -> ActionDescription
"-"
    NumPadUnlocked
NumPlus     -> ActionDescription
"+"
    NumPadUnlocked
NumEnter    -> ActionDescription
"Enter"
    NumPadUnlocked
NumInsert   -> ActionDescription
"Insert"
    NumPadUnlocked
NumDelete   -> ActionDescription
"Delete"


-- | Number pad key input with NumLock enabled.
data NumPadLocked = NumL0 | NumL1 | NumL2 | NumL3 | NumL4 | NumL5 | NumL6 | NumL7 | NumL8 | NumL9 | NumLDivide | NumLMulti | NumLMinus | NumLPlus | NumLEnter | NumLPeriod deriving
    ( NumPadLocked
forall a. a -> a -> Bounded a
maxBound :: NumPadLocked
$cmaxBound :: NumPadLocked
minBound :: NumPadLocked
$cminBound :: NumPadLocked
Bounded
    , Int -> NumPadLocked
NumPadLocked -> Int
NumPadLocked -> [NumPadLocked]
NumPadLocked -> NumPadLocked
NumPadLocked -> NumPadLocked -> [NumPadLocked]
NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromThenTo :: NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFromTo :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromTo :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFromThen :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromThen :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFrom :: NumPadLocked -> [NumPadLocked]
$cenumFrom :: NumPadLocked -> [NumPadLocked]
fromEnum :: NumPadLocked -> Int
$cfromEnum :: NumPadLocked -> Int
toEnum :: Int -> NumPadLocked
$ctoEnum :: Int -> NumPadLocked
pred :: NumPadLocked -> NumPadLocked
$cpred :: NumPadLocked -> NumPadLocked
succ :: NumPadLocked -> NumPadLocked
$csucc :: NumPadLocked -> NumPadLocked
Enum
    , NumPadLocked -> NumPadLocked -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumPadLocked -> NumPadLocked -> Bool
$c/= :: NumPadLocked -> NumPadLocked -> Bool
== :: NumPadLocked -> NumPadLocked -> Bool
$c== :: NumPadLocked -> NumPadLocked -> Bool
Eq
    , Eq NumPadLocked
NumPadLocked -> NumPadLocked -> Bool
NumPadLocked -> NumPadLocked -> Ordering
NumPadLocked -> NumPadLocked -> NumPadLocked
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumPadLocked -> NumPadLocked -> NumPadLocked
$cmin :: NumPadLocked -> NumPadLocked -> NumPadLocked
max :: NumPadLocked -> NumPadLocked -> NumPadLocked
$cmax :: NumPadLocked -> NumPadLocked -> NumPadLocked
>= :: NumPadLocked -> NumPadLocked -> Bool
$c>= :: NumPadLocked -> NumPadLocked -> Bool
> :: NumPadLocked -> NumPadLocked -> Bool
$c> :: NumPadLocked -> NumPadLocked -> Bool
<= :: NumPadLocked -> NumPadLocked -> Bool
$c<= :: NumPadLocked -> NumPadLocked -> Bool
< :: NumPadLocked -> NumPadLocked -> Bool
$c< :: NumPadLocked -> NumPadLocked -> Bool
compare :: NumPadLocked -> NumPadLocked -> Ordering
$ccompare :: NumPadLocked -> NumPadLocked -> Ordering
Ord
    , Int -> NumPadLocked -> ShowS
[NumPadLocked] -> ShowS
NumPadLocked -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NumPadLocked] -> ShowS
$cshowList :: [NumPadLocked] -> ShowS
show :: NumPadLocked -> [Char]
$cshow :: NumPadLocked -> [Char]
showsPrec :: Int -> NumPadLocked -> ShowS
$cshowsPrec :: Int -> NumPadLocked -> ShowS
Show
    )

instance Describable NumPadLocked where
  describe :: NumPadLocked -> ActionDescription
describe NumPadLocked
input = case NumPadLocked
input of
    NumPadLocked
NumL0      -> ActionDescription
"0"
    NumPadLocked
NumL1      -> ActionDescription
"1"
    NumPadLocked
NumL2      -> ActionDescription
"2"
    NumPadLocked
NumL3      -> ActionDescription
"3"
    NumPadLocked
NumL4      -> ActionDescription
"4"
    NumPadLocked
NumL5      -> ActionDescription
"5"
    NumPadLocked
NumL6      -> ActionDescription
"6"
    NumPadLocked
NumL7      -> ActionDescription
"7"
    NumPadLocked
NumL8      -> ActionDescription
"8"
    NumPadLocked
NumL9      -> ActionDescription
"9"
    NumPadLocked
NumLDivide -> ActionDescription
"/"
    NumPadLocked
NumLMulti  -> ActionDescription
"*"
    NumPadLocked
NumLMinus  -> ActionDescription
"-"
    NumPadLocked
NumLPlus   -> ActionDescription
"+"
    NumPadLocked
NumLEnter  -> ActionDescription
"Enter"
    NumPadLocked
NumLPeriod -> ActionDescription
"."