    {-# OPTIONS_HADDOCK hide #-}
    {-# OPTIONS -fno-warn-missing-signatures #-}
    {-# LANGUAGE PatternGuards #-}

    module Graphics.Gloss.Internals.Interface.ViewPort.Command
    	( Command (..)
    	, defaultCommandConfig
    	, isCommand )
    where
    import Graphics.Gloss.Internals.Interface.Backend
    import qualified Data.Map			as Map

    -- | The commands suported by the view controller
    data Command
    	= CRestore

    	| CTranslate
    	| CRotate

    	-- bump zoom
    	| CBumpZoomOut
    	| CBumpZoomIn

    	-- bump translate
    	| CBumpLeft
    	| CBumpRight
    	| CBumpUp
    	| CBumpDown

    	-- bump rotate
    	| CBumpClockwise
    	| CBumpCClockwise
    	deriving (Show, Eq, Ord)

    -- | The default commands
    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 }))
    	 	])

    	-- bump zoom
    	, (CBumpZoomOut,
    		[ (MouseButton WheelDown,	Nothing)
    		, (SpecialKey  KeyPageDown,	Nothing) ])

    	, (CBumpZoomIn,
    		[ (MouseButton WheelUp, 	Nothing)
    		, (SpecialKey  KeyPageUp,	Nothing)] )

    	-- bump translate
    	, (CBumpLeft,
    		[ (SpecialKey  KeyLeft,	        Nothing) ])

    	, (CBumpRight,
    		[ (SpecialKey  KeyRight,	Nothing) ])

    	, (CBumpUp,
    		[ (SpecialKey  KeyUp,		Nothing) ])

    	, (CBumpDown,
    		[ (SpecialKey  KeyDown,	        Nothing) ])

    	-- bump rotate
    	, (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