module Graphics.Gloss.Internals.Interface.ViewPort.Command
( Command (..)
, defaultCommandConfig
, isCommand )
where
import Graphics.Gloss.Internals.Interface.Backend
import qualified Data.Map as Map
data Command
= CRestore
| CTranslate
| CRotate
| CBumpZoomOut
| CBumpZoomIn
| CBumpLeft
| CBumpRight
| CBumpUp
| CBumpDown
| CBumpClockwise
| CBumpCClockwise
deriving (Show, Eq, Ord)
defaultCommandConfig
= [ (CRestore,
[ (Char 'r', Nothing) ])
, (CTranslate,
[ ( MouseButton LeftButton
, Just (Modifiers { shift = Up, ctrl = Up, alt = Up }))
])
, (CRotate,
[ ( MouseButton RightButton
, Nothing)
, ( MouseButton LeftButton
, Just (Modifiers { shift = Up, ctrl = Down, alt = Up }))
])
, (CBumpZoomOut,
[ (MouseButton WheelDown, Nothing)
, (SpecialKey KeyPageDown, Nothing) ])
, (CBumpZoomIn,
[ (MouseButton WheelUp, Nothing)
, (SpecialKey KeyPageUp, Nothing)] )
, (CBumpLeft,
[ (SpecialKey KeyLeft, Nothing) ])
, (CBumpRight,
[ (SpecialKey KeyRight, Nothing) ])
, (CBumpUp,
[ (SpecialKey KeyUp, Nothing) ])
, (CBumpDown,
[ (SpecialKey KeyDown, Nothing) ])
, (CBumpClockwise,
[ (SpecialKey KeyHome, Nothing) ])
, (CBumpCClockwise,
[ (SpecialKey KeyEnd, Nothing) ])
]
isCommand commands c key keyMods
| Just csMatch <- Map.lookup c commands
= or $ map (isCommand2 c key keyMods) csMatch
| otherwise
= False
isCommand2 _ key keyMods cMatch
| (keyC, mModsC) <- cMatch
, keyC == key
, case mModsC of
Nothing -> True
Just modsC -> modsC == keyMods
= True
| otherwise
= False