GLUT 2.5.0.2 → 2.5.1.0
raw patch · 12 files changed
+531/−342 lines, 12 files
Files
- GLUT.cabal +1/−1
- Graphics/UI/GLUT/Callbacks/Registration.hs +4/−2
- Graphics/UI/GLUT/Callbacks/Window.hs +157/−4
- Graphics/UI/GLUT/Fonts.hs +7/−70
- Graphics/UI/GLUT/Menu.hs +25/−11
- Graphics/UI/GLUT/Objects.hs +34/−191
- Graphics/UI/GLUT/Raw/Callbacks.hs +45/−3
- Graphics/UI/GLUT/Raw/Fonts.hs +66/−2
- Graphics/UI/GLUT/Raw/Functions.hs +83/−51
- Graphics/UI/GLUT/Raw/Tokens.hs +30/−0
- Graphics/UI/GLUT/State.hs +70/−6
- Graphics/UI/GLUT/Window.hs +9/−1
GLUT.cabal view
@@ -1,5 +1,5 @@ name: GLUT-version: 2.5.0.2+version: 2.5.1.0 license: BSD3 license-file: LICENSE maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>
Graphics/UI/GLUT/Callbacks/Registration.hs view
@@ -40,8 +40,10 @@ | SpaceballButtonCB | ButtonBoxCB | DialsCB | TabletMotionCB | TabletButtonCB | JoystickCB | MenuStatusCB | IdleCB- | CloseCB -- freeglut only- | MouseWheelCB -- freeglut only+ -- freeglut-only callback types+ | CloseCB | MouseWheelCB | PositionCB+ | MultiEntryCB | MultiMotionCB | MultiButtonCB+ | MultiPassiveCB | InitContextCB | AppStatusCB deriving ( Eq, Ord ) isGlobal :: CallbackType -> Bool
Graphics/UI/GLUT/Callbacks/Window.hs view
@@ -17,6 +17,9 @@ -- * Reshape callback ReshapeCallback, reshapeCallback, + -- * Position callback+ PositionCallback, positionCallback,+ -- * Callbacks for visibility changes Visibility(..), VisibilityCallback, visibilityCallback, WindowState(..), WindowStateCallback, windowStateCallback,@@ -24,6 +27,10 @@ -- * Window close callback CloseCallback, closeCallback, + -- * Life cycle callbacks for mobile platforms+ InitContextCallback, initContextCallback,+ AppStatus(..), AppStatusCallback, appStatusCallback,+ -- * Keyboard callback KeyboardCallback, keyboardCallback, keyboardUpCallback, @@ -57,15 +64,21 @@ -- * Joystick callback JoystickButtons(..), JoystickPosition(..),- JoystickCallback, joystickCallback+ JoystickCallback, joystickCallback,++ -- * Multi-touch support+ TouchID,+ MultiMouseCallback, multiMouseCallback,+ MultiCrossingCallback, multiCrossingCallback,+ MultiMotionCallback, multiMotionCallback, multiPassiveMotionCallback+ ) where import Data.Bits hiding ( shift ) import Data.Char import Data.Maybe import Foreign.C.Types-import Graphics.Rendering.OpenGL ( Position(..), Size(..)- , SettableStateVar, makeSettableStateVar )+import Graphics.Rendering.OpenGL import Graphics.UI.GLUT.Callbacks.Registration import Graphics.UI.GLUT.Raw import Graphics.UI.GLUT.State@@ -190,6 +203,21 @@ -------------------------------------------------------------------------------- +-- | A position callback++type PositionCallback = Position -> IO ()++-- | (/freeglut only/) Controls the position callback for the /current window./+-- The position callback for a window is called when the position of a window+-- changes.++positionCallback :: SettableStateVar (Maybe PositionCallback)+positionCallback = makeSettableStateVar $+ setCallback PositionCB glutPositionFunc (makePositionFunc . unmarshal)+ where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------+ -- | The visibility state of the /current window/ data Visibility@@ -277,15 +305,62 @@ -------------------------------------------------------------------------------- +-- | A window close callback+ type CloseCallback = IO () +-- | Controls the window close callback for the /current window/.+ closeCallback :: SettableStateVar (Maybe CloseCallback) closeCallback = makeSettableStateVar $ setCallback CloseCB glutCloseFunc makeCloseFunc -------------------------------------------------------------------------------- +-- | An initialize context callback++type InitContextCallback = IO ()++-- | (/freeglut only/) Controls the initialize context callback for the /current+-- window/.++initContextCallback :: SettableStateVar (Maybe InitContextCallback)+initContextCallback = makeSettableStateVar $+ setCallback InitContextCB glutInitContextFunc makeInitContextFunc++--------------------------------------------------------------------------------++-- | The application status of the /current window/++data AppStatus+ = AppStatusPause+ | AppStatusResume+ deriving ( Eq, Ord, Show )++unmarshalAppStatus :: CInt -> AppStatus+unmarshalAppStatus x+ | x == glut_APPSTATUS_PAUSE = AppStatusPause+ | x == glut_APPSTATUS_RESUME = AppStatusResume+ | otherwise = error ("unmarshalAppStatus: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | An application status callback++type AppStatusCallback = AppStatus -> IO ()++-- | Controls the application status callback for the /current window./++appStatusCallback :: SettableStateVar (Maybe AppStatusCallback)+appStatusCallback = makeSettableStateVar $+ setCallback AppStatusCB glutAppStatusFunc+ (makeAppStatusFunc . unmarshal)+ where unmarshal cb = cb . unmarshalAppStatus++--------------------------------------------------------------------------------+ -- | A keyboard callback+ type KeyboardCallback = Char -> Position -> IO () setKeyboardCallback :: Maybe KeyboardCallback -> IO ()@@ -296,6 +371,7 @@ -- | Controls the keyboard callback for the /current window/. This is -- activated only when a key is pressed.+ keyboardCallback :: SettableStateVar (Maybe KeyboardCallback) keyboardCallback = makeSettableStateVar setKeyboardCallback @@ -310,8 +386,10 @@ -- | Controls the keyboard callback for the /current window/. This is -- activated only when a key is released.+ keyboardUpCallback :: SettableStateVar (Maybe KeyboardCallback) keyboardUpCallback = makeSettableStateVar setKeyboardUpCallback+ -------------------------------------------------------------------------------- -- | Special keys@@ -341,7 +419,15 @@ | KeyNumLock | KeyBegin | KeyDelete- | KeyUnknown Int+ | KeyShiftL+ | KeyShiftR+ | KeyCtrlL+ | KeyCtrlR+ | KeyAltL+ | KeyAltR+ | KeyUnknown Int -- ^ You should actually never encounter this value, it is+ -- just here as a safeguard against future changes in the+ -- native GLUT library. deriving ( Eq, Ord, Show ) unmarshalSpecialKey :: CInt -> SpecialKey@@ -370,11 +456,18 @@ | x == glut_KEY_NUM_LOCK = KeyNumLock | x == glut_KEY_BEGIN = KeyBegin | x == glut_KEY_DELETE = KeyDelete+ | x == glut_KEY_SHIFT_L = KeyShiftL+ | x == glut_KEY_SHIFT_R = KeyShiftR+ | x == glut_KEY_CTRL_L = KeyCtrlL+ | x == glut_KEY_CTRL_R = KeyCtrlR+ | x == glut_KEY_ALT_L = KeyAltL+ | x == glut_KEY_ALT_R = KeyAltR | otherwise = KeyUnknown (fromIntegral x) -------------------------------------------------------------------------------- -- | A special key callback+ type SpecialCallback = SpecialKey -> Position -> IO () setSpecialCallback :: Maybe SpecialCallback -> IO ()@@ -385,8 +478,10 @@ -- | Controls the special key callback for the /current window/. This is -- activated only when a special key is pressed.+ specialCallback :: SettableStateVar (Maybe SpecialCallback) specialCallback = makeSettableStateVar setSpecialCallback+ -------------------------------------------------------------------------------- setSpecialUpCallback :: Maybe SpecialCallback -> IO ()@@ -397,8 +492,10 @@ -- | Controls the special key callback for the /current window/. This is -- activated only when a special key is released.+ specialUpCallback :: SettableStateVar (Maybe SpecialCallback) specialUpCallback = makeSettableStateVar setSpecialUpCallback+ -------------------------------------------------------------------------------- -- | The current state of a key or button@@ -417,6 +514,7 @@ -------------------------------------------------------------------------------- -- | A mouse callback+ type MouseCallback = MouseButton -> KeyState -> Position -> IO () setMouseCallback :: Maybe MouseCallback -> IO ()@@ -427,8 +525,10 @@ (Position (fromIntegral x) (fromIntegral y)) -- | Controls the mouse callback for the /current window/.+ mouseCallback :: SettableStateVar (Maybe MouseCallback) mouseCallback = makeSettableStateVar setMouseCallback+ -------------------------------------------------------------------------------- -- | The state of the keyboard modifiers@@ -836,3 +936,56 @@ (JoystickPosition (fromIntegral x) (fromIntegral y) (fromIntegral z))++--------------------------------------------------------------------------------++-- | A description where the multi-touch event is coming from, the freeglut+-- specs are very vague about the actual semantics. It contains the device ID+-- and\/or the cursor\/finger ID.++type TouchID = Int++-- | A multi-touch variant of 'MouseCallback'.++type MultiMouseCallback = TouchID -> MouseCallback++-- | (/freeglut only/) A multi-touch variant of 'mouseCallback'.++multiMouseCallback :: SettableStateVar (Maybe MultiMouseCallback)+multiMouseCallback = makeSettableStateVar $+ setCallback MultiButtonCB glutMultiButtonFunc (makeMultiButtonFunc . unmarshal)+ where unmarshal cb d x y b s = cb (fromIntegral d)+ (unmarshalMouseButton b)+ (unmarshalKeyState s)+ (Position (fromIntegral x) (fromIntegral y))++-- | A multi-touch variant of 'CrossingCallback'.++type MultiCrossingCallback = TouchID -> CrossingCallback++-- | (/freeglut only/) A multi-touch variant of 'crossingCallback'.++multiCrossingCallback :: SettableStateVar (Maybe MultiCrossingCallback)+multiCrossingCallback = makeSettableStateVar $+ setCallback MultiEntryCB glutMultiEntryFunc (makeMultiEntryFunc . unmarshal)+ where unmarshal cb d c = cb (fromIntegral d) (unmarshalCrossing c)++-- | A multi-touch variant of 'MotionCallback'.++type MultiMotionCallback = TouchID -> MotionCallback++-- | (/freeglut only/) A multi-touch variant of 'motionCallback'.++multiMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)+multiMotionCallback = makeSettableStateVar $+ setCallback MultiMotionCB glutMultiMotionFunc (makeMultiMotionFunc . unmarshal)+ where unmarshal cb d x y =+ cb (fromIntegral d) (Position (fromIntegral x) (fromIntegral y))++-- | (/freeglut only/) A multi-touch variant of 'passiveMotionCallback'.++multiPassiveMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)+multiPassiveMotionCallback = makeSettableStateVar $+ setCallback MultiPassiveCB glutMultiPassiveFunc (makeMultiPassiveFunc . unmarshal)+ where unmarshal cb d x y =+ cb (fromIntegral d) (Position (fromIntegral x) (fromIntegral y))
Graphics/UI/GLUT/Fonts.hs view
@@ -26,7 +26,7 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Ptr-import Graphics.Rendering.OpenGL ( GLint, GLfloat )+import Graphics.Rendering.OpenGL import Graphics.UI.GLUT.Raw --------------------------------------------------------------------------------@@ -72,72 +72,9 @@ -------------------------------------------------------------------------------- --- | The bitmap fonts available in GLUT. The exact bitmap to be used is--- defined by the standard X glyph bitmaps for the X font with the given name.--data BitmapFont- = Fixed8By13 -- ^ A fixed width font with every character fitting in an 8- -- by 13 pixel rectangle.- -- (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)- | Fixed9By15 -- ^ A fixed width font with every character fitting in an 9- -- by 15 pixel rectangle.- -- (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)- | TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.- -- (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)- | TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.- -- (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)- | Helvetica10 -- ^ A 10-point proportional spaced Helvetica font.- -- (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)- | Helvetica12 -- ^ A 12-point proportional spaced Helvetica font.- -- (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)- | Helvetica18 -- ^ A 18-point proportional spaced Helvetica font.- -- (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)- deriving ( Eq, Ord, Show )---- Alas, fonts in GLUT are not denoted by some integral value, but by opaque--- pointers on the C side. Even worse: For WinDoze, they are simply small ints,--- casted to void*, for other platforms addresses of global variables are used.--- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable--- way is using integers on the Haskell side and doing the marshaling via some--- small C wrappers around those macros. *sigh*-type GLUTbitmapFont = Ptr ()--marhshalBitmapFont :: BitmapFont -> IO GLUTbitmapFont-marhshalBitmapFont x = case x of- Fixed8By13 -> hs_GLUT_marshalBitmapFont 0- Fixed9By15 -> hs_GLUT_marshalBitmapFont 1- TimesRoman10 -> hs_GLUT_marshalBitmapFont 2- TimesRoman24 -> hs_GLUT_marshalBitmapFont 3- Helvetica10 -> hs_GLUT_marshalBitmapFont 4- Helvetica12 -> hs_GLUT_marshalBitmapFont 5- Helvetica18 -> hs_GLUT_marshalBitmapFont 6-------------------------------------------------------------------------------------- | The stroke fonts available in GLUT.-data StrokeFont- = Roman -- ^ A proportionally spaced Roman Simplex font for ASCII- -- characters 32 through 127. The maximum top character in the- -- font is 119.05 units; the bottom descends 33.33 units.- | MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as- -- 'Roman') for ASCII characters 32 through 127. The maximum- -- top character in the font is 119.05 units; the bottom- -- descends 33.33 units. Each character is 104.76 units wide.- deriving ( Eq, Ord, Show )---- Same remarks as for GLUTbitmapFont-type GLUTstrokeFont = Ptr ()--marhshalStrokeFont :: StrokeFont -> IO GLUTstrokeFont-marhshalStrokeFont x = case x of- Roman -> hs_GLUT_marshalStrokeFont 0- MonoRoman -> hs_GLUT_marshalStrokeFont 1----------------------------------------------------------------------------------- bitmapString :: BitmapFont -> String -> IO () bitmapString f s = do- i <- marhshalBitmapFont f+ i <- marshalBitmapFont f mapM_ (\c -> withChar c (glutBitmapCharacter i)) s withChar :: Char -> (CInt -> IO a) -> IO a@@ -147,7 +84,7 @@ strokeString :: StrokeFont -> String -> IO () strokeString f s = do- i <- marhshalStrokeFont f+ i <- marshalStrokeFont f mapM_ (\c -> withChar c (glutStrokeCharacter i)) s --------------------------------------------------------------------------------@@ -157,7 +94,7 @@ -- bits). -> IO GLint -- ^ Width in pixels. bitmapLength f s = do- i <- marhshalBitmapFont f+ i <- marshalBitmapFont f fmap fromIntegral $ withCString s (glutBitmapLength i . castPtr) --------------------------------------------------------------------------------@@ -167,17 +104,17 @@ -- bits). -> IO GLint -- ^ Width in units. strokeLength f s = do- i <- marhshalStrokeFont f+ i <- marshalStrokeFont f fmap fromIntegral $ withCString s (glutStrokeLength i . castPtr) -------------------------------------------------------------------------------- bitmapHeight :: BitmapFont -- ^ Bitmap font to use. -> IO GLfloat -- ^ Height in pixels.-bitmapHeight f = fmap fromIntegral $ glutBitmapHeight =<< marhshalBitmapFont f+bitmapHeight f = fmap fromIntegral $ glutBitmapHeight =<< marshalBitmapFont f -------------------------------------------------------------------------------- strokeHeight :: StrokeFont -- ^ Stroke font to use. -> IO GLfloat -- ^ Height in units.-strokeHeight f = glutStrokeHeight =<< marhshalStrokeFont f+strokeHeight f = glutStrokeHeight =<< marshalStrokeFont f
Graphics/UI/GLUT/Menu.hs view
@@ -24,15 +24,13 @@ import Data.Array import Data.IORef-import qualified Data.Map as Map ( empty, lookup, insert, delete )+import qualified Data.Map as Map import Control.Monad import Data.Map ( Map ) import Foreign.C.String import Foreign.C.Types import Foreign.Ptr-import Graphics.Rendering.OpenGL ( get, ($=), StateVar- , makeStateVar, GettableStateVar- , makeGettableStateVar )+import Graphics.Rendering.OpenGL import Graphics.UI.GLUT.Callbacks.Registration import Graphics.UI.GLUT.QueryUtils import Graphics.UI.GLUT.Raw@@ -40,9 +38,19 @@ -------------------------------------------------------------------------------- --- | A menu is simply a list of menu items.-newtype Menu = Menu [MenuItem]+-- | A menu is simply a list of menu items, possibly with an associated font.+data Menu+ = Menu [MenuItem]+ | MenuWithFont BitmapFont [MenuItem] +menuFont :: Menu -> Maybe BitmapFont+menuFont (Menu _) = Nothing+menuFont (MenuWithFont font _) = Just font++menuItems :: Menu -> [MenuItem]+menuItems (Menu items) = items+menuItems (MenuWithFont _ items) = items+ -- | A single item within a menu can either be a plain menu entry or a sub-menu -- entry, allowing for arbitrarily deep nested menus. data MenuItem@@ -69,11 +77,11 @@ -- are available. attachMenu :: MouseButton -> Menu -> IO ()-attachMenu mouseButton menu@(Menu items) = do+attachMenu mouseButton menu = do win <- getCurrentWindow "attachMenu" let hook = MenuHook win mouseButton detachMenu hook- unless (null items) $ do+ unless (null (menuItems menu)) $ do (_, destructor) <- traverseMenu menu addToMenuTable hook destructor attachMenu_ mouseButton@@ -88,10 +96,12 @@ deleteFromMenuTable hook traverseMenu :: Menu -> IO (MenuID, Destructor)-traverseMenu (Menu items) = do- let callbackArray = listArray (1, length items) (map makeCallback items)+traverseMenu menu = do+ let items = menuItems menu+ callbackArray = listArray (1, length items) (map makeCallback items) cb <- makeMenuFunc (\i -> callbackArray ! (fromIntegral i)) menuID <- glutCreateMenu cb+ maybe (return ()) (setMenuFont menuID) (menuFont menu) destructors <- zipWithM addMenuItem items [1..] let destructor = do sequence_ destructors glutDestroyMenu menuID@@ -231,7 +241,6 @@ -- will be popped up when the user presses the specified button. Note that the -- menu is attached to the button by identifier, not by reference. - attachMenu_ :: MouseButton -> IO () attachMenu_ = glutAttachMenu . marshalMouseButton @@ -246,3 +255,8 @@ numMenuItems :: GettableStateVar Int numMenuItems = makeGettableStateVar $ simpleGet fromIntegral glut_MENU_NUM_ITEMS++--------------------------------------------------------------------------------++setMenuFont :: MenuID -> BitmapFont -> IO ()+setMenuFont menuID font = glutSetMenuFont menuID =<< marshalBitmapFont font
Graphics/UI/GLUT/Objects.hs view
@@ -15,7 +15,11 @@ -- recognizable objects. These routines can be implemented as pure OpenGL -- rendering routines. The routines do not generate display lists for the -- objects they create. The routines generate normals appropriate for lighting--- but do not generate texture coordinates (except for the teapot).+-- but do not generate texture coordinates (except for the solid teapot, teacup+-- and teaspoon). If VBOs should be used instead of the fixed function pipeline,+-- specify at least one of the attribute locations+-- 'Graphics.UI.GLUT.State.vertexAttribCoord3' or+-- 'Graphics.UI.GLUT.State.vertexAttribNormal'. -- -------------------------------------------------------------------------------- @@ -36,7 +40,7 @@ import Foreign.C.Types import Foreign.Marshal.Utils import Foreign.Ptr-import Graphics.Rendering.OpenGL ( Height, Radius, Slices, Stacks, GLint, GLdouble, Vertex3(..) )+import Graphics.Rendering.OpenGL import Graphics.UI.GLUT.Raw --------------------------------------------------------------------------------@@ -62,9 +66,8 @@ -- -- * Approximations to rounded objects. ----- * The classic teapot modeled by Martin Newell in 1975. Both surface normals--- and texture coordinates for the teapot are generated. The teapot is--- generated with OpenGL evaluators.+-- * The classic teaset modeled by Martin Newell in 1975. Both surface normals+-- and texture coordinates for the teaset are generated. -- -- * A Sierpinski sponge, see -- <http://mathworld.wolfram.com/Tetrix.html>.@@ -113,6 +116,10 @@ Torus Radius Radius Sides Rings | -- | A teapot with a given relative size. Teapot Height+ | -- |(/freeglut only/) A teacup with a given relative size.+ Teacup Height+ | -- |(/freeglut only/) A teaspoon with a given relative size.+ Teaspoon Height | -- |(/freeglut only/) A Sierpinski sponge of a given level, where a level -- 0 sponge is the same as a 'Tetrahedron'. SierpinskiSponge NumLevels@@ -129,198 +136,34 @@ -- | Render an object in the given flavour. renderObject :: Flavour -> Object -> IO ()-renderObject Solid (Cube h) = solidCube h-renderObject Wireframe (Cube h) = wireCube h-renderObject Solid Dodecahedron = solidDodecahedron-renderObject Wireframe Dodecahedron = wireDodecahedron-renderObject Solid Icosahedron = solidIcosahedron-renderObject Wireframe Icosahedron = wireIcosahedron-renderObject Solid Octahedron = solidOctahedron-renderObject Wireframe Octahedron = wireOctahedron-renderObject Solid Tetrahedron = solidTetrahedron-renderObject Wireframe Tetrahedron = wireTetrahedron+renderObject Solid (Cube h) = glutSolidCube h+renderObject Wireframe (Cube h) = glutWireCube h+renderObject Solid Dodecahedron = glutSolidDodecahedron+renderObject Wireframe Dodecahedron = glutWireDodecahedron+renderObject Solid Icosahedron = glutSolidIcosahedron+renderObject Wireframe Icosahedron = glutWireIcosahedron+renderObject Solid Octahedron = glutSolidOctahedron+renderObject Wireframe Octahedron = glutWireOctahedron+renderObject Solid Tetrahedron = glutSolidTetrahedron+renderObject Wireframe Tetrahedron = glutWireTetrahedron renderObject Solid RhombicDodecahedron = glutSolidRhombicDodecahedron renderObject Wireframe RhombicDodecahedron = glutWireRhombicDodecahedron-renderObject Solid (Sphere' r s t) = solidSphere r s t-renderObject Wireframe (Sphere' r s t) = wireSphere r s t-renderObject Solid (Cone r h s t) = solidCone r h s t-renderObject Wireframe (Cone r h s t) = wireCone r h s t+renderObject Solid (Sphere' r s t) = glutSolidSphere r s t+renderObject Wireframe (Sphere' r s t) = glutWireSphere r s t+renderObject Solid (Cone r h s t) = glutSolidCone r h s t+renderObject Wireframe (Cone r h s t) = glutWireCone r h s t renderObject Solid (Cylinder' r h s t) = glutSolidCylinder r h s t renderObject Wireframe (Cylinder' r h s t) = glutWireCylinder r h s t-renderObject Solid (Torus i o s r) = solidTorus i o s r-renderObject Wireframe (Torus i o s r) = wireTorus i o s r-renderObject Solid (Teapot h) = solidTeapot h-renderObject Wireframe (Teapot h) = wireTeapot h+renderObject Solid (Torus i o s r) = glutSolidTorus i o s r+renderObject Wireframe (Torus i o s r) = glutWireTorus i o s r+renderObject Solid (Teapot h) = glutSolidTeapot h+renderObject Wireframe (Teapot h) = glutWireTeapot h+renderObject Solid (Teacup h) = glutSolidTeacup h+renderObject Wireframe (Teacup h) = glutWireTeacup h+renderObject Solid (Teaspoon h) = glutSolidTeaspoon h+renderObject Wireframe (Teaspoon h) = glutWireTeaspoon h renderObject Solid (SierpinskiSponge n) = solidSierpinskiSponge n renderObject Wireframe (SierpinskiSponge n) = wireSierpinskiSponge n-------------------------------------------------------------------------------------- | Render a solid cube centered at the modeling coordinates origin with sides--- of the given length.--solidCube- :: Height -- ^ Length of the cube sides- -> IO ()-solidCube = glutSolidCube---- | Render a wireframe cube centered at the modeling coordinates origin with--- sides of the given length.--wireCube- :: Height -- ^ Length of the cube sides- -> IO ()-wireCube = glutWireCube-------------------------------------------------------------------------------------- | Render a solid dodecahedron (12-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--solidDodecahedron :: IO ()-solidDodecahedron = glutSolidDodecahedron---- | Render a wireframe dodecahedron (12-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--wireDodecahedron :: IO ()-wireDodecahedron = glutWireDodecahedron-------------------------------------------------------------------------------------- | Render a solid icosahedron (20-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--wireIcosahedron :: IO ()-wireIcosahedron = glutWireIcosahedron---- | Render a wireframe icosahedron (20-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--solidIcosahedron :: IO ()-solidIcosahedron = glutSolidIcosahedron-------------------------------------------------------------------------------------- | Render a solid octahedron (8-sided regular solid) centered at the modeling--- coordinates origin with a radius of 1.0.--solidOctahedron :: IO ()-solidOctahedron = glutSolidOctahedron---- | Render a wireframe octahedron (8-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--wireOctahedron :: IO ()-wireOctahedron = glutWireOctahedron-------------------------------------------------------------------------------------- | Render a solid tetrahedron (4-sided regular solid) centered at the modeling--- coordinates origin with a radius of @sqrt 3@.--wireTetrahedron :: IO ()-wireTetrahedron = glutWireTetrahedron---- | Render a wireframe tetrahedron (4-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--solidTetrahedron :: IO ()-solidTetrahedron = glutSolidTetrahedron-------------------------------------------------------------------------------------- | Render a solid sphere centered at the modeling coordinates origin of the--- specified radius. The sphere is subdivided around the Z axis into slices--- and along the Z axis into stacks.--solidSphere- :: Radius -- ^ Radius of the sphere.- -> Slices -- ^ Number of subdivisions (slices) around the Z axis, similar- -- to lines of longitude.- -> Stacks -- ^ The number of subdivisions (stacks) along the Z axis,- -- similar to lines of latitude.- -> IO ()-solidSphere = glutSolidSphere---- | Render a wireframe sphere centered at the modeling coordinates origin of--- the specified radius. The sphere is subdivided around the Z axis into slices--- and along the Z axis into stacks.--wireSphere- :: Radius -- ^ Radius of the sphere.- -> Slices -- ^ Number of subdivisions (slices) around the Z axis, similar- -- to lines of longitude.- -> Stacks -- ^ The number of subdivisions (stacks) along the Z axis,- -- similar to lines of latitude.- -> IO ()-wireSphere = glutWireSphere-------------------------------------------------------------------------------------- | Render a solid cone oriented along the Z axis. The base of the cone is--- placed at Z = 0, and the top at Z = height. The cone is subdivided around the--- Z axis into slices, and along the Z axis into stacks.--solidCone- :: Radius -- ^ Radius of the base of the cone.- -> Height -- ^ Height of the cone.- -> Slices -- ^ Number of subdivisions around the Z axis.- -> Stacks -- ^ The number of subdivisions along the Z axis.- -> IO ()-solidCone = glutSolidCone---- | Render a wireframe cone oriented along the Z axis. The base of the cone is--- placed at Z = 0, and the top at Z = height. The cone is subdivided around the--- Z axis into slices, and along the Z axis into stacks.--wireCone- :: Radius -- ^ Radius of the base of the cone.- -> Height -- ^ Height of the cone.- -> Slices -- ^ Number of subdivisions around the Z axis.- -> Stacks -- ^ The number of subdivisions along the Z axis.- -> IO ()-wireCone = glutWireCone-------------------------------------------------------------------------------------- | Render a solid torus (doughnut) centered at the modeling coordinates origin--- whose axis is aligned with the Z axis.--solidTorus- :: Radius -- ^ Inner radius of the torus.- -> Radius -- ^ Outer radius of the torus.- -> Slices -- ^ Number of sides for each radial section.- -> Stacks -- ^ Number of radial divisions for the torus.- -> IO ()-solidTorus = glutSolidTorus---- | Render a wireframe torus (doughnut) centered at the modeling coordinates--- origin whose axis is aligned with the Z axis.--wireTorus- :: Radius -- ^ Inner radius of the torus.- -> Radius -- ^ Outer radius of the torus.- -> Slices -- ^ Number of sides for each radial section.- -> Stacks -- ^ Number of radial divisions for the torus.- -> IO ()-wireTorus = glutWireTorus-------------------------------------------------------------------------------------- | Render a solid teapot.--solidTeapot- :: Height -- ^ Relative size of the teapot- -> IO ()-solidTeapot = glutSolidTeapot---- | Render a wireframe teapot.--wireTeapot- :: Height -- ^ Relative size of the teapot- -> IO ()-wireTeapot = glutWireTeapot --------------------------------------------------------------------------------
Graphics/UI/GLUT/Raw/Callbacks.hs view
@@ -15,24 +15,31 @@ ----------------------------------------------------------------------------- module Graphics.UI.GLUT.Raw.Callbacks (- MenuFunc, makeMenuFunc,+ AppStatusFunc, makeAppStatusFunc, ButtonBoxFunc, makeButtonBoxFunc, CloseFunc, makeCloseFunc, DialsFunc, makeDialsFunc, DisplayFunc, makeDisplayFunc, EntryFunc, makeEntryFunc, IdleFunc, makeIdleFunc,+ InitContextFunc, makeInitContextFunc, JoystickFunc, makeJoystickFunc, KeyboardFunc, makeKeyboardFunc, KeyboardUpFunc, makeKeyboardUpFunc, MenuDestroyFunc, makeMenuDestroyFunc,+ MenuFunc, makeMenuFunc, MenuStateFunc, makeMenuStateFunc, MenuStatusFunc, makeMenuStatusFunc, MotionFunc, makeMotionFunc, MouseFunc, makeMouseFunc, MouseWheelFunc, makeMouseWheelFunc,+ MultiButtonFunc, makeMultiButtonFunc,+ MultiEntryFunc, makeMultiEntryFunc,+ MultiMotionFunc, makeMultiMotionFunc,+ MultiPassiveFunc, makeMultiPassiveFunc, OverlayDisplayFunc, makeOverlayDisplayFunc, PassiveMotionFunc, makePassiveMotionFunc,+ PositionFunc, makePositionFunc, ReshapeFunc, makeReshapeFunc, SpaceballButtonFunc, makeSpaceballButtonFunc, SpaceballMotionFunc, makeSpaceballMotionFunc,@@ -50,10 +57,10 @@ import Foreign.C.Types import Foreign.Ptr -type MenuFunc = CInt -> IO ()+type AppStatusFunc = CInt -> IO () foreign import ccall "wrapper"- makeMenuFunc :: MenuFunc -> IO (FunPtr MenuFunc)+ makeAppStatusFunc :: AppStatusFunc -> IO (FunPtr AppStatusFunc) type ButtonBoxFunc = CInt -> CInt -> IO () @@ -85,6 +92,11 @@ foreign import ccall "wrapper" makeIdleFunc :: IdleFunc -> IO (FunPtr IdleFunc) +type InitContextFunc = IO ()++foreign import ccall "wrapper"+ makeInitContextFunc :: InitContextFunc -> IO (FunPtr InitContextFunc)+ type JoystickFunc = CUInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "wrapper"@@ -105,6 +117,11 @@ foreign import ccall "wrapper" makeMenuDestroyFunc :: MenuDestroyFunc -> IO (FunPtr MenuDestroyFunc) +type MenuFunc = CInt -> IO ()++foreign import ccall "wrapper"+ makeMenuFunc :: MenuFunc -> IO (FunPtr MenuFunc)+ type MenuStateFunc = CInt -> IO () foreign import ccall "wrapper"@@ -130,6 +147,26 @@ foreign import ccall "wrapper" makeMouseWheelFunc :: MouseWheelFunc -> IO (FunPtr MouseWheelFunc) +type MultiButtonFunc = CInt -> CInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+ makeMultiButtonFunc :: MultiButtonFunc -> IO (FunPtr MultiButtonFunc)++type MultiEntryFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+ makeMultiEntryFunc :: MultiEntryFunc -> IO (FunPtr MultiEntryFunc)++type MultiMotionFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+ makeMultiMotionFunc :: MultiMotionFunc -> IO (FunPtr MultiMotionFunc)++type MultiPassiveFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+ makeMultiPassiveFunc :: MultiPassiveFunc -> IO (FunPtr MultiPassiveFunc)+ type OverlayDisplayFunc = IO () foreign import ccall "wrapper"@@ -139,6 +176,11 @@ foreign import ccall "wrapper" makePassiveMotionFunc :: PassiveMotionFunc -> IO (FunPtr PassiveMotionFunc)++type PositionFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+ makePositionFunc :: PositionFunc -> IO (FunPtr PositionFunc) type ReshapeFunc = CInt -> CInt -> IO ()
Graphics/UI/GLUT/Raw/Fonts.hs view
@@ -15,15 +15,79 @@ ----------------------------------------------------------------------------- module Graphics.UI.GLUT.Raw.Fonts (- hs_GLUT_marshalBitmapFont,- hs_GLUT_marshalStrokeFont+ BitmapFont(..), GLUTbitmapFont, marshalBitmapFont,+ StrokeFont(..), GLUTstrokeFont, marshalStrokeFont ) where import Foreign.C.Types import Foreign.Ptr +--------------------------------------------------------------------------------++-- | The bitmap fonts available in GLUT. The exact bitmap to be used is+-- defined by the standard X glyph bitmaps for the X font with the given name.++data BitmapFont+ = Fixed8By13 -- ^ A fixed width font with every character fitting in an 8+ -- by 13 pixel rectangle.+ -- (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)+ | Fixed9By15 -- ^ A fixed width font with every character fitting in an 9+ -- by 15 pixel rectangle.+ -- (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)+ | TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.+ -- (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)+ | TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.+ -- (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)+ | Helvetica10 -- ^ A 10-point proportional spaced Helvetica font.+ -- (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)+ | Helvetica12 -- ^ A 12-point proportional spaced Helvetica font.+ -- (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)+ | Helvetica18 -- ^ A 18-point proportional spaced Helvetica font.+ -- (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)+ deriving ( Eq, Ord, Show )++-- Alas, fonts in GLUT are not denoted by some integral value, but by opaque+-- pointers on the C side. Even worse: For WinDoze, they are simply small ints,+-- casted to void*, for other platforms addresses of global variables are used.+-- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable+-- way is using integers on the Haskell side and doing the marshaling via some+-- small C wrappers around those macros. *sigh*+type GLUTbitmapFont = Ptr ()++marshalBitmapFont :: BitmapFont -> IO GLUTbitmapFont+marshalBitmapFont x = case x of+ Fixed8By13 -> hs_GLUT_marshalBitmapFont 0+ Fixed9By15 -> hs_GLUT_marshalBitmapFont 1+ TimesRoman10 -> hs_GLUT_marshalBitmapFont 2+ TimesRoman24 -> hs_GLUT_marshalBitmapFont 3+ Helvetica10 -> hs_GLUT_marshalBitmapFont 4+ Helvetica12 -> hs_GLUT_marshalBitmapFont 5+ Helvetica18 -> hs_GLUT_marshalBitmapFont 6++ foreign import ccall unsafe "hs_GLUT_marshalBitmapFont" hs_GLUT_marshalBitmapFont :: CInt -> IO (Ptr a)++--------------------------------------------------------------------------------++-- | The stroke fonts available in GLUT.+data StrokeFont+ = Roman -- ^ A proportionally spaced Roman Simplex font for ASCII+ -- characters 32 through 127. The maximum top character in the+ -- font is 119.05 units; the bottom descends 33.33 units.+ | MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as+ -- 'Roman') for ASCII characters 32 through 127. The maximum+ -- top character in the font is 119.05 units; the bottom+ -- descends 33.33 units. Each character is 104.76 units wide.+ deriving ( Eq, Ord, Show )++-- Same remarks as for GLUTbitmapFont+type GLUTstrokeFont = Ptr ()++marshalStrokeFont :: StrokeFont -> IO GLUTstrokeFont+marshalStrokeFont x = case x of+ Roman -> hs_GLUT_marshalStrokeFont 0+ MonoRoman -> hs_GLUT_marshalStrokeFont 1 foreign import ccall unsafe "hs_GLUT_marshalStrokeFont" hs_GLUT_marshalStrokeFont :: CInt -> IO (Ptr a)
Graphics/UI/GLUT/Raw/Functions.hs view
@@ -15,50 +15,48 @@ ----------------------------------------------------------------------------- module Graphics.UI.GLUT.Raw.Functions (- glutGetProcAddress,- glutGetColor,- glutStrokeHeight,- glutBitmapHeight,- glutBitmapLength,- glutBitmapWidth,- glutCreateMenu,- glutCreateSubWindow,- glutCreateWindow,- glutDeviceGet,- glutEnterGameMode,- glutExtensionSupported,- glutGameModeGet,- glutGet,- glutGetMenu,- glutGetModifiers,- glutGetWindow,- glutLayerGet,- glutStrokeLength,- glutStrokeWidth,- glutVideoResizeGet,- glutGetModeValues, glutAddMenuEntry, glutAddSubMenu,+ glutAppStatusFunc, glutAttachMenu, glutBitmapCharacter,+ glutBitmapHeight,+ glutBitmapLength, glutBitmapString,+ glutBitmapWidth, glutButtonBoxFunc, glutChangeToMenuEntry, glutChangeToSubMenu, glutCloseFunc, glutCopyColormap,+ glutCreateMenu,+ glutCreateSubWindow,+ glutCreateWindow, glutDestroyMenu, glutDestroyWindow, glutDetachMenu,+ glutDeviceGet, glutDialsFunc, glutDisplayFunc,+ glutEnterGameMode, glutEntryFunc, glutEstablishOverlay, glutExit,+ glutExtensionSupported, glutForceJoystickFunc, glutFullScreen, glutFullScreenToggle,+ glutGameModeGet, glutGameModeString,+ glutGet,+ glutGetColor,+ glutGetMenu,+ glutGetMenuData,+ glutGetModeValues,+ glutGetModifiers,+ glutGetProcAddress,+ glutGetWindow,+ glutGetWindowData, glutHideOverlay, glutHideWindow, glutIconifyWindow,@@ -66,8 +64,9 @@ glutIgnoreKeyRepeat, glutInit, glutInitContextFlags,- glutInitContextVersion,+ glutInitContextFunc, glutInitContextProfile,+ glutInitContextVersion, glutInitDisplayMode, glutInitDisplayString, glutInitWindowPosition,@@ -75,6 +74,8 @@ glutJoystickFunc, glutKeyboardFunc, glutKeyboardUpFunc,+ glutLayerGet,+ glutLeaveFullScreen, glutLeaveGameMode, glutLeaveMainLoop, glutMainLoop,@@ -85,9 +86,14 @@ glutMotionFunc, glutMouseFunc, glutMouseWheelFunc,+ glutMultiButtonFunc,+ glutMultiEntryFunc,+ glutMultiMotionFunc,+ glutMultiPassiveFunc, glutOverlayDisplayFunc, glutPassiveMotionFunc, glutPopWindow,+ glutPositionFunc, glutPositionWindow, glutPostOverlayRedisplay, glutPostRedisplay,@@ -105,7 +111,11 @@ glutSetKeyRepeat, glutSetMenu, glutSetMenuData,+ glutSetMenuFont, glutSetOption,+ glutSetVertexAttribCoord3,+ glutSetVertexAttribNormal,+ glutSetVertexAttribTexCoord2, glutSetWindow, glutSetWindowData, glutSetWindowTitle,@@ -121,7 +131,9 @@ glutSolidRhombicDodecahedron, glutSolidSierpinskiSponge, glutSolidSphere,+ glutSolidTeacup, glutSolidTeapot,+ glutSolidTeaspoon, glutSolidTetrahedron, glutSolidTorus, glutSpaceballButtonFunc,@@ -131,7 +143,10 @@ glutSpecialUpFunc, glutStopVideoResizing, glutStrokeCharacter,+ glutStrokeHeight,+ glutStrokeLength, glutStrokeString,+ glutStrokeWidth, glutSwapBuffers, glutTabletButtonFunc, glutTabletMotionFunc,@@ -139,6 +154,7 @@ glutUseLayer, glutVideoPan, glutVideoResize,+ glutVideoResizeGet, glutVisibilityFunc, glutWMCloseFunc, glutWarpPointer,@@ -152,11 +168,11 @@ glutWireRhombicDodecahedron, glutWireSierpinskiSponge, glutWireSphere,+ glutWireTeacup, glutWireTeapot,+ glutWireTeaspoon, glutWireTetrahedron,- glutWireTorus,- glutGetMenuData,- glutGetWindowData+ glutWireTorus ) where import Foreign.C.Types@@ -167,50 +183,48 @@ #include "HsGLUTExt.h" -API_ENTRY(glutGetProcAddress,Ptr CChar -> IO (FunPtr a))-API_ENTRY(glutGetColor,CInt -> CInt -> IO GLfloat)-API_ENTRY(glutStrokeHeight,Ptr a -> IO GLfloat)-API_ENTRY(glutBitmapHeight,Ptr a -> IO CInt)-API_ENTRY(glutBitmapLength,Ptr a -> Ptr CUChar -> IO CInt)-API_ENTRY(glutBitmapWidth,Ptr a -> CInt -> IO CInt)-API_ENTRY(glutCreateMenu,FunPtr MenuFunc -> IO CInt)-API_ENTRY(glutCreateSubWindow,CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt)-API_ENTRY(glutCreateWindow,Ptr CChar -> IO CInt)-API_ENTRY(glutDeviceGet,GLenum -> IO CInt)-API_ENTRY(glutEnterGameMode,IO CInt)-API_ENTRY(glutExtensionSupported,Ptr CChar -> IO CInt)-API_ENTRY(glutGameModeGet,GLenum -> IO CInt)-API_ENTRY(glutGet,GLenum -> IO CInt)-API_ENTRY(glutGetMenu,IO CInt)-API_ENTRY(glutGetModifiers,IO CInt)-API_ENTRY(glutGetWindow,IO CInt)-API_ENTRY(glutLayerGet,GLenum -> IO CInt)-API_ENTRY(glutStrokeLength,Ptr a -> Ptr CUChar -> IO CInt)-API_ENTRY(glutStrokeWidth,Ptr a -> CInt -> IO CInt)-API_ENTRY(glutVideoResizeGet,GLenum -> IO CInt)-API_ENTRY(glutGetModeValues,GLenum -> Ptr CInt -> IO (Ptr CInt)) API_ENTRY(glutAddMenuEntry,Ptr CChar -> CInt -> IO ()) API_ENTRY(glutAddSubMenu,Ptr CChar -> CInt -> IO ())+API_ENTRY(glutAppStatusFunc,FunPtr AppStatusFunc -> IO ()) API_ENTRY(glutAttachMenu,CInt -> IO ()) API_ENTRY(glutBitmapCharacter,Ptr a -> CInt -> IO ())+API_ENTRY(glutBitmapHeight,Ptr a -> IO CInt)+API_ENTRY(glutBitmapLength,Ptr a -> Ptr CUChar -> IO CInt) API_ENTRY(glutBitmapString,Ptr a -> Ptr CUChar -> IO ())+API_ENTRY(glutBitmapWidth,Ptr a -> CInt -> IO CInt) API_ENTRY(glutButtonBoxFunc,FunPtr ButtonBoxFunc -> IO ()) API_ENTRY(glutChangeToMenuEntry,CInt -> Ptr CChar -> CInt -> IO ()) API_ENTRY(glutChangeToSubMenu,CInt -> Ptr CChar -> CInt -> IO ()) API_ENTRY(glutCloseFunc,FunPtr CloseFunc -> IO ()) API_ENTRY(glutCopyColormap,CInt -> IO ())+API_ENTRY(glutCreateMenu,FunPtr MenuFunc -> IO CInt)+API_ENTRY(glutCreateSubWindow,CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt)+API_ENTRY(glutCreateWindow,Ptr CChar -> IO CInt) API_ENTRY(glutDestroyMenu,CInt -> IO ()) API_ENTRY(glutDestroyWindow,CInt -> IO ()) API_ENTRY(glutDetachMenu,CInt -> IO ())+API_ENTRY(glutDeviceGet,GLenum -> IO CInt) API_ENTRY(glutDialsFunc,FunPtr DialsFunc -> IO ()) API_ENTRY(glutDisplayFunc,FunPtr DisplayFunc -> IO ())+API_ENTRY(glutEnterGameMode,IO CInt) API_ENTRY(glutEntryFunc,FunPtr EntryFunc -> IO ()) API_ENTRY_SAFE(glutEstablishOverlay,IO ()) API_ENTRY(glutExit,IO ())+API_ENTRY(glutExtensionSupported,Ptr CChar -> IO CInt) API_ENTRY(glutForceJoystickFunc,IO ()) API_ENTRY(glutFullScreen,IO ()) API_ENTRY(glutFullScreenToggle,IO ())+API_ENTRY(glutGameModeGet,GLenum -> IO CInt) API_ENTRY(glutGameModeString,Ptr CChar -> IO ())+API_ENTRY(glutGet,GLenum -> IO CInt)+API_ENTRY(glutGetColor,CInt -> CInt -> IO GLfloat)+API_ENTRY(glutGetMenu,IO CInt)+API_ENTRY(glutGetMenuData,IO (Ptr a))+API_ENTRY(glutGetModeValues,GLenum -> Ptr CInt -> IO (Ptr CInt))+API_ENTRY(glutGetModifiers,IO CInt)+API_ENTRY(glutGetProcAddress,Ptr CChar -> IO (FunPtr a))+API_ENTRY(glutGetWindow,IO CInt)+API_ENTRY(glutGetWindowData,IO (Ptr a)) API_ENTRY_SAFE(glutHideOverlay,IO ()) API_ENTRY(glutHideWindow,IO ()) API_ENTRY(glutIconifyWindow,IO ())@@ -218,8 +232,9 @@ API_ENTRY(glutIgnoreKeyRepeat,CInt -> IO ()) API_ENTRY(glutInit,Ptr CInt -> Ptr (Ptr CChar) -> IO ()) API_ENTRY(glutInitContextFlags,CInt -> IO ())-API_ENTRY(glutInitContextVersion,CInt -> CInt -> IO ())+API_ENTRY(glutInitContextFunc,FunPtr InitContextFunc -> IO ()) API_ENTRY(glutInitContextProfile,CInt -> IO ())+API_ENTRY(glutInitContextVersion,CInt -> CInt -> IO ()) API_ENTRY(glutInitDisplayMode,CUInt -> IO ()) API_ENTRY(glutInitDisplayString,Ptr CChar -> IO ()) API_ENTRY(glutInitWindowPosition,CInt -> CInt -> IO ())@@ -227,6 +242,8 @@ API_ENTRY(glutJoystickFunc,FunPtr JoystickFunc -> CInt -> IO ()) API_ENTRY(glutKeyboardFunc,FunPtr KeyboardFunc -> IO ()) API_ENTRY(glutKeyboardUpFunc,FunPtr KeyboardUpFunc -> IO ())+API_ENTRY(glutLayerGet,GLenum -> IO CInt)+API_ENTRY(glutLeaveFullScreen,IO ()) API_ENTRY(glutLeaveGameMode,IO ()) API_ENTRY_SAFE(glutLeaveMainLoop,IO ()) API_ENTRY_SAFE(glutMainLoop,IO ())@@ -237,9 +254,14 @@ API_ENTRY(glutMotionFunc,FunPtr MotionFunc -> IO ()) API_ENTRY(glutMouseFunc,FunPtr MouseFunc -> IO ()) API_ENTRY(glutMouseWheelFunc,FunPtr MouseWheelFunc -> IO ())+API_ENTRY(glutMultiButtonFunc,FunPtr MultiButtonFunc -> IO ())+API_ENTRY(glutMultiEntryFunc,FunPtr MultiEntryFunc -> IO ())+API_ENTRY(glutMultiMotionFunc,FunPtr MultiMotionFunc -> IO ())+API_ENTRY(glutMultiPassiveFunc,FunPtr MultiPassiveFunc -> IO ()) API_ENTRY(glutOverlayDisplayFunc,FunPtr OverlayDisplayFunc -> IO ()) API_ENTRY(glutPassiveMotionFunc,FunPtr PassiveMotionFunc -> IO ()) API_ENTRY(glutPopWindow,IO ())+API_ENTRY(glutPositionFunc,FunPtr PositionFunc -> IO ()) API_ENTRY(glutPositionWindow,CInt -> CInt -> IO ()) API_ENTRY_SAFE(glutPostOverlayRedisplay,IO ()) API_ENTRY(glutPostRedisplay,IO ())@@ -257,7 +279,11 @@ API_ENTRY(glutSetKeyRepeat,CInt -> IO ()) API_ENTRY(glutSetMenu,CInt -> IO ()) API_ENTRY(glutSetMenuData,Ptr a -> IO ())+API_ENTRY(glutSetMenuFont,GLint -> Ptr a -> IO ()) API_ENTRY(glutSetOption,GLenum -> CInt -> IO ())+API_ENTRY(glutSetVertexAttribCoord3,GLint -> IO ())+API_ENTRY(glutSetVertexAttribNormal,GLint -> IO ())+API_ENTRY(glutSetVertexAttribTexCoord2,GLint -> IO ()) API_ENTRY(glutSetWindow,CInt -> IO ()) API_ENTRY(glutSetWindowData,Ptr a -> IO ()) API_ENTRY(glutSetWindowTitle,Ptr CChar -> IO ())@@ -273,7 +299,9 @@ API_ENTRY(glutSolidRhombicDodecahedron,IO ()) API_ENTRY(glutSolidSierpinskiSponge,CInt -> Ptr GLdouble -> GLdouble -> IO ()) API_ENTRY(glutSolidSphere,GLdouble -> GLint -> GLint -> IO ())+API_ENTRY(glutSolidTeacup,GLdouble -> IO ()) API_ENTRY(glutSolidTeapot,GLdouble -> IO ())+API_ENTRY(glutSolidTeaspoon,GLdouble -> IO ()) API_ENTRY(glutSolidTetrahedron,IO ()) API_ENTRY(glutSolidTorus,GLdouble -> GLdouble -> GLint -> GLint -> IO ()) API_ENTRY(glutSpaceballButtonFunc,FunPtr SpaceballButtonFunc -> IO ())@@ -283,7 +311,10 @@ API_ENTRY(glutSpecialUpFunc,FunPtr SpecialUpFunc -> IO ()) API_ENTRY(glutStopVideoResizing,IO ()) API_ENTRY(glutStrokeCharacter,Ptr a -> CInt -> IO ())+API_ENTRY(glutStrokeHeight,Ptr a -> IO GLfloat)+API_ENTRY(glutStrokeLength,Ptr a -> Ptr CUChar -> IO CInt) API_ENTRY(glutStrokeString,Ptr a -> Ptr CUChar -> IO ())+API_ENTRY(glutStrokeWidth,Ptr a -> CInt -> IO CInt) API_ENTRY(glutSwapBuffers,IO ()) API_ENTRY(glutTabletButtonFunc,FunPtr TabletButtonFunc -> IO ()) API_ENTRY(glutTabletMotionFunc,FunPtr TabletMotionFunc -> IO ())@@ -291,6 +322,7 @@ API_ENTRY_SAFE(glutUseLayer,GLenum -> IO ()) API_ENTRY(glutVideoPan,CInt -> CInt -> CInt -> CInt -> IO ()) API_ENTRY(glutVideoResize,CInt -> CInt -> CInt -> CInt -> IO ())+API_ENTRY(glutVideoResizeGet,GLenum -> IO CInt) API_ENTRY(glutVisibilityFunc,FunPtr VisibilityFunc -> IO ()) API_ENTRY(glutWMCloseFunc,FunPtr WMCloseFunc -> IO ()) API_ENTRY(glutWarpPointer,CInt -> CInt -> IO ())@@ -304,8 +336,8 @@ API_ENTRY(glutWireRhombicDodecahedron,IO ()) API_ENTRY(glutWireSierpinskiSponge,CInt -> Ptr GLdouble -> GLdouble -> IO ()) API_ENTRY(glutWireSphere,GLdouble -> GLint -> GLint -> IO ())+API_ENTRY(glutWireTeacup,GLdouble -> IO ()) API_ENTRY(glutWireTeapot,GLdouble -> IO ())+API_ENTRY(glutWireTeaspoon,GLdouble -> IO ()) API_ENTRY(glutWireTetrahedron,IO ()) API_ENTRY(glutWireTorus,GLdouble -> GLdouble -> GLint -> GLint -> IO ())-API_ENTRY(glutGetMenuData,IO (Ptr a))-API_ENTRY(glutGetWindowData,IO (Ptr a))
Graphics/UI/GLUT/Raw/Tokens.hs view
@@ -48,6 +48,12 @@ glut_ALPHA :: CUInt glut_ALPHA = 0x0008 +glut_APPSTATUS_PAUSE :: CInt+glut_APPSTATUS_PAUSE = 0x0001++glut_APPSTATUS_RESUME :: CInt+glut_APPSTATUS_RESUME = 0x0002+ glut_AUX :: GLenum glut_AUX = 0x1000 @@ -219,6 +225,9 @@ glut_GAME_MODE_WIDTH :: GLenum glut_GAME_MODE_WIDTH = 0x0002 +glut_GEOMETRY_VISUALIZE_NORMALS :: GLenum+glut_GEOMETRY_VISUALIZE_NORMALS = 0x0205+ glut_GREEN :: CInt glut_GREEN = 0x0001 @@ -300,9 +309,21 @@ glut_JOYSTICK_POLL_RATE :: GLenum glut_JOYSTICK_POLL_RATE = 0x0268 +glut_KEY_ALT_L :: CInt+glut_KEY_ALT_L = 0x0074++glut_KEY_ALT_R :: CInt+glut_KEY_ALT_R = 0x0075+ glut_KEY_BEGIN :: CInt glut_KEY_BEGIN = 0x006E +glut_KEY_CTRL_L :: CInt+glut_KEY_CTRL_L = 0x0072++glut_KEY_CTRL_R :: CInt+glut_KEY_CTRL_R = 0x0073+ glut_KEY_DELETE :: CInt glut_KEY_DELETE = 0x006F @@ -378,6 +399,12 @@ glut_KEY_RIGHT :: CInt glut_KEY_RIGHT = 0x0066 +glut_KEY_SHIFT_L :: CInt+glut_KEY_SHIFT_L = 0x0070++glut_KEY_SHIFT_R :: CInt+glut_KEY_SHIFT_R = 0x0071+ glut_KEY_UP :: CInt glut_KEY_UP = 0x0065 @@ -476,6 +503,9 @@ glut_SINGLE :: CUInt glut_SINGLE = 0x0000++glut_SKIP_STALE_MOTION_EVENTS :: GLenum+glut_SKIP_STALE_MOTION_EVENTS = 0x0204 glut_SRGB :: CUInt glut_SRGB = 0x1000
Graphics/UI/GLUT/State.hs view
@@ -15,17 +15,27 @@ module Graphics.UI.GLUT.State ( -- * State of all windows- windowBorderWidth, windowHeaderHeight,+ windowBorderWidth, windowHeaderHeight, skipStaleMotionEvents, -- * State of the /current window/++ -- ** Framebuffer state rgba, BufferDepth, rgbaBufferDepths, colorBufferDepth, doubleBuffered, stereo, accumBufferDepths, depthBufferDepth, stencilBufferDepth, SampleCount, sampleCount, formatID,++ -- ** Full screen state fullScreenMode, - -- * GLUT state pertaining to the layers of the /current window/+ -- ** Object rendering state+ geometryVisualizeNormals,++ -- ** Vertex attribute state+ vertexAttribCoord3, vertexAttribNormal, vertexAttribTexCoord2,++ -- ** Layer state damaged, -- * Timing@@ -53,9 +63,7 @@ import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable-import Graphics.Rendering.OpenGL ( GLenum, Size(..)- , StateVar, makeStateVar- , GettableStateVar, makeGettableStateVar )+import Graphics.Rendering.OpenGL import Graphics.UI.GLUT.Overlay import Graphics.UI.GLUT.QueryUtils import Graphics.UI.GLUT.Raw@@ -168,6 +176,47 @@ -------------------------------------------------------------------------------- +-- | (/freeglut only/) Controls if vectors representing the normals should be+-- drawn, too, when objects are drawn.++geometryVisualizeNormals :: StateVar Bool+geometryVisualizeNormals =+ makeStateVar+ (simpleGet i2b glut_GEOMETRY_VISUALIZE_NORMALS)+ (glutSetOption glut_GEOMETRY_VISUALIZE_NORMALS . b2i)+++--------------------------------------------------------------------------------++-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both+-- contain 'Nothing', the fixed function pipeline is used to draw+-- objects. Otherwise VBOs are used and the coordinates are passed via 'Just'+-- this attribute location (for a vec3).++vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)+vertexAttribCoord3 = setVertexAttribWith glutSetVertexAttribCoord3++setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)+setVertexAttribWith f = makeSettableStateVar $ f . getLocation+ where getLocation = maybe (-1) (\(AttribLocation l) -> fromIntegral l)++-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both+-- contain 'Nothing', the fixed function pipeline is used to draw+-- objects. Otherwise VBOs are used and the normals are passed via 'Just' this+-- attribute location (for a vec3).++vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)+vertexAttribNormal = setVertexAttribWith glutSetVertexAttribNormal++-- | (/freeglut only/) If VBOs are used to draw objects (controlled via+-- 'vertexAttribCoord3' and 'vertexAttribNormal'), the texture coordinates are+-- passed via 'Just' this attribute location (for a vec2).++vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)+vertexAttribTexCoord2 = setVertexAttribWith glutSetVertexAttribTexCoord2++--------------------------------------------------------------------------------+ -- | Contains the number of milliseconds since -- 'Graphics.UI.GLUT.Initialization.initialize' was called. @@ -316,11 +365,15 @@ fmap (map fromIntegral) $ peekArray (fromIntegral size) valuesBuffer ----------------------------------------------------------------------------------- Convenience unmarshalers+-- Convenience (un-)marshalers i2b :: CInt -> Bool i2b = (/= 0) +b2i :: Bool -> CInt+b2i False = 0+b2i True = 1+ -------------------------------------------------------------------------------- getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)@@ -369,6 +422,17 @@ windowHeaderHeight :: GettableStateVar Int windowHeaderHeight = makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_HEADER_HEIGHT)++-----------------------------------------------------------------------------++-- | (/freeglut on X11 only/) Controls if all but the last motion event should+-- be discarded.++skipStaleMotionEvents :: StateVar Bool+skipStaleMotionEvents =+ makeStateVar+ (simpleGet i2b glut_SKIP_STALE_MOTION_EVENTS)+ (glutSetOption glut_SKIP_STALE_MOTION_EVENTS . b2i) -----------------------------------------------------------------------------
Graphics/UI/GLUT/Window.hs view
@@ -33,7 +33,7 @@ -- * Changing the window geometry -- $ChangingTheWindowGeometry- windowPosition, windowSize, fullScreen, fullScreenToggle,+ windowPosition, windowSize, fullScreen, fullScreenToggle, leaveFullScreen, -- * Manipulating the stacking order @@ -295,6 +295,14 @@ fullScreenToggle :: IO () fullScreenToggle = glutFullScreenToggle++--------------------------------------------------------------------------------++-- | (/freeglut only/) If we are in full screen mode, resize the current window+-- back to its original size.++leaveFullScreen :: IO ()+leaveFullScreen = glutLeaveFullScreen --------------------------------------------------------------------------------