{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Types
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module with miscellaneous types which don\'t really
-- have a good place elsewhere.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Types (
   Window(..),                               -- constructor used only internally
   Relation(..),
   relationToString,                         -- used only internally
   MouseButton(..),
   marshalMouseButton, unmarshalMouseButton  -- used only internally
) where

import Foreign.C.Types
import Graphics.UI.GLUT.Raw

--------------------------------------------------------------------------------

-- | An opaque identifier for a top-level window or a subwindow.

newtype Window = Window CInt
   deriving ( Window -> Window -> Bool
(Window -> Window -> Bool)
-> (Window -> Window -> Bool) -> Eq Window
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c== :: Window -> Window -> Bool
Eq, Eq Window
Eq Window
-> (Window -> Window -> Ordering)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Window)
-> (Window -> Window -> Window)
-> Ord Window
Window -> Window -> Bool
Window -> Window -> Ordering
Window -> Window -> Window
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 :: Window -> Window -> Window
$cmin :: Window -> Window -> Window
max :: Window -> Window -> Window
$cmax :: Window -> Window -> Window
>= :: Window -> Window -> Bool
$c>= :: Window -> Window -> Bool
> :: Window -> Window -> Bool
$c> :: Window -> Window -> Bool
<= :: Window -> Window -> Bool
$c<= :: Window -> Window -> Bool
< :: Window -> Window -> Bool
$c< :: Window -> Window -> Bool
compare :: Window -> Window -> Ordering
$ccompare :: Window -> Window -> Ordering
$cp1Ord :: Eq Window
Ord, Int -> Window -> ShowS
[Window] -> ShowS
Window -> String
(Int -> Window -> ShowS)
-> (Window -> String) -> ([Window] -> ShowS) -> Show Window
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Window] -> ShowS
$cshowList :: [Window] -> ShowS
show :: Window -> String
$cshow :: Window -> String
showsPrec :: Int -> Window -> ShowS
$cshowsPrec :: Int -> Window -> ShowS
Show )

--------------------------------------------------------------------------------

-- | A relation between a 'Graphics.UI.GLUT.Initialization.DisplayCapability'
-- and a numeric value.

data Relation
   = IsEqualTo        -- ^ Equal.
   | IsNotEqualTo     -- ^ Not equal.
   | IsLessThan       -- ^ Less than and preferring larger difference (the least
                      --   is best).
   | IsNotGreaterThan -- ^ Less than or equal and preferring larger difference
                      --   (the least is best).
   | IsGreaterThan    -- ^ Greater than and preferring larger differences (the
                      --   most is best).
   | IsAtLeast        -- ^ Greater than or equal and preferring more instead of
                      --   less. This relation is useful for allocating
                      --   resources like color precision or depth buffer
                      --   precision where the maximum precision is generally
                      --   preferred. Contrast with 'IsNotLessThan' relation.
   | IsNotLessThan    -- ^ Greater than or equal but preferring less instead of
                      --   more. This relation is useful for allocating
                      --   resources such as stencil bits or auxillary color
                      --   buffers where you would rather not over-allocate.
   deriving ( Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation
-> (Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
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 :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
$cp1Ord :: Eq Relation
Ord, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show )

relationToString :: Relation -> String
relationToString :: Relation -> String
relationToString Relation
IsEqualTo        = String
"="
relationToString Relation
IsNotEqualTo     = String
"!="
relationToString Relation
IsLessThan       = String
"<"
relationToString Relation
IsNotGreaterThan = String
"<="
relationToString Relation
IsGreaterThan    = String
">"
relationToString Relation
IsAtLeast        = String
">="
relationToString Relation
IsNotLessThan    = String
"~"

--------------------------------------------------------------------------------

-- | Mouse buttons, including a wheel

data MouseButton
   = LeftButton
   | MiddleButton
   | RightButton
   | WheelUp
   | WheelDown
   | AdditionalButton Int
   deriving ( MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c== :: MouseButton -> MouseButton -> Bool
Eq, Eq MouseButton
Eq MouseButton
-> (MouseButton -> MouseButton -> Ordering)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> MouseButton)
-> (MouseButton -> MouseButton -> MouseButton)
-> Ord MouseButton
MouseButton -> MouseButton -> Bool
MouseButton -> MouseButton -> Ordering
MouseButton -> MouseButton -> MouseButton
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 :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmax :: MouseButton -> MouseButton -> MouseButton
>= :: MouseButton -> MouseButton -> Bool
$c>= :: MouseButton -> MouseButton -> Bool
> :: MouseButton -> MouseButton -> Bool
$c> :: MouseButton -> MouseButton -> Bool
<= :: MouseButton -> MouseButton -> Bool
$c<= :: MouseButton -> MouseButton -> Bool
< :: MouseButton -> MouseButton -> Bool
$c< :: MouseButton -> MouseButton -> Bool
compare :: MouseButton -> MouseButton -> Ordering
$ccompare :: MouseButton -> MouseButton -> Ordering
$cp1Ord :: Eq MouseButton
Ord, Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
(Int -> MouseButton -> ShowS)
-> (MouseButton -> String)
-> ([MouseButton] -> ShowS)
-> Show MouseButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseButton] -> ShowS
$cshowList :: [MouseButton] -> ShowS
show :: MouseButton -> String
$cshow :: MouseButton -> String
showsPrec :: Int -> MouseButton -> ShowS
$cshowsPrec :: Int -> MouseButton -> ShowS
Show )

marshalMouseButton :: MouseButton -> CInt
marshalMouseButton :: MouseButton -> CInt
marshalMouseButton MouseButton
x = case MouseButton
x of
   MouseButton
LeftButton -> CInt
glut_LEFT_BUTTON
   MouseButton
MiddleButton -> CInt
glut_MIDDLE_BUTTON
   MouseButton
RightButton -> CInt
glut_RIGHT_BUTTON
   MouseButton
WheelUp -> CInt
glut_WHEEL_UP
   MouseButton
WheelDown -> CInt
glut_WHEEL_DOWN
   AdditionalButton Int
b -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b

unmarshalMouseButton :: CInt -> MouseButton
unmarshalMouseButton :: CInt -> MouseButton
unmarshalMouseButton CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_LEFT_BUTTON = MouseButton
LeftButton
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_MIDDLE_BUTTON = MouseButton
MiddleButton
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_RIGHT_BUTTON = MouseButton
RightButton
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_WHEEL_UP = MouseButton
WheelUp
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_WHEEL_DOWN = MouseButton
WheelDown
   | Bool
otherwise = Int -> MouseButton
AdditionalButton (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x)

glut_WHEEL_UP :: CInt
glut_WHEEL_UP :: CInt
glut_WHEEL_UP = CInt
3

glut_WHEEL_DOWN :: CInt
glut_WHEEL_DOWN :: CInt
glut_WHEEL_DOWN = CInt
4