SFML 0.2.0.0 → 2.3.2

raw patch · 50 files changed

+1158/−696 lines, 50 filessetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• SFML.cabal +38/−9
• Setup.hs +1/−0
• cbits/SFML/Audio/Listener_helper.c +12/−0
• cbits/SFML/Graphics/Font_helper.c +5/−0
• cbits/SFML/Window/Joystick_helper.c +7/−0
• src/SFML/Audio/Listener.hs +35/−5
• src/SFML/Audio/Music.hs +7/−14
• src/SFML/Audio/SFSoundRecorder.hs +6/−4
• src/SFML/Audio/SoundBuffer.hs +7/−15
• src/SFML/Audio/SoundBufferRecorder.hs +10/−16
• src/SFML/Audio/SoundRecorder.hs +110/−19
• src/SFML/Audio/SoundStream.hsc +27/−27
• src/SFML/Graphics.hs +4/−2
• src/SFML/Graphics/BlendMode.hs +0/−36
• src/SFML/Graphics/BlendMode.hsc +123/−0
• src/SFML/Graphics/CircleShape.hs +5/−13
• src/SFML/Graphics/Color.hsc +18/−13
• src/SFML/Graphics/ConvexShape.hs +5/−13
• src/SFML/Graphics/Font.hs +68/−24
• src/SFML/Graphics/FontInfo.hsc +30/−0
• src/SFML/Graphics/Glyph.hsc +7/−7
• src/SFML/Graphics/Image.hs +3/−11
• src/SFML/Graphics/Rect.hsc +17/−18
• src/SFML/Graphics/RectangleShape.hs +5/−13
• src/SFML/Graphics/RenderStates.hsc +15/−15
• src/SFML/Graphics/RenderTexture.hs +3/−11
• src/SFML/Graphics/RenderWindow.hs +67/−46
• src/SFML/Graphics/SFDrawable.hs +31/−0
• src/SFML/Graphics/SFTransformable.hs +93/−0
• src/SFML/Graphics/Shader.hs +10/−18
• src/SFML/Graphics/Shape.hs +2/−2
• src/SFML/Graphics/Sprite.hs +5/−13
• src/SFML/Graphics/Text.hs +26/−28
• src/SFML/Graphics/Texture.hs +11/−19
• src/SFML/Graphics/Transform.hsc +25/−25
• src/SFML/Graphics/Transformable.hs +0/−93
• src/SFML/Graphics/Types.hs +5/−5
• src/SFML/Graphics/Vertex.hsc +7/−7
• src/SFML/SFException.hs +9/−0
• src/SFML/System/InputStream.hsc +10/−10
• src/SFML/System/Vector2.hsc +16/−18
• src/SFML/System/Vector3.hsc +7/−7
• src/SFML/Window/ContextSettings.hsc +41/−14
• src/SFML/Window/Event.hsc +62/−61
• src/SFML/Window/Joystick.hsc +24/−3
• src/SFML/Window/JoystickIdentification.hsc +41/−0
• src/SFML/Window/Mouse.hsc +21/−4
• src/SFML/Window/SFWindow.hs +17/−0
• src/SFML/Window/VideoMode.hsc +7/−8
• src/SFML/Window/Window.hsc +53/−30

@@ -1,8 +1,8 @@ name:                SFML-version:             0.2.0.0+version:             2.3.2 synopsis:            SFML bindings description:-    Low level bindings for SFML 2.0.+    Low level bindings for SFML 2.3.2. license:             MIT license-file:        LICENSE author:              Marc Sunet@@ -13,6 +13,15 @@ build-type:          Simple cabal-version:       >=1.8 +source-repository head+  type:     git+  location: https://github.com/SFML-haskell++Flag OfficialCSFMLForWindows+  Description: Use the official CSFML bundle for Windows from http://www.sfml-dev.org/download/csfml/+  default: False++ library   hs-source-dirs:       src@@ -40,6 +49,7 @@       SFML.Graphics.Color       SFML.Graphics.ConvexShape       SFML.Graphics.Font+      SFML.Graphics.FontInfo       SFML.Graphics.Glyph       SFML.Graphics.Image       SFML.Graphics.PrimitiveType@@ -50,12 +60,14 @@       SFML.Graphics.RenderWindow       SFML.Graphics.SFBindable       SFML.Graphics.SFBounded+      SFML.Graphics.SFDrawable       SFML.Graphics.SFCoordSpace       SFML.Graphics.SFRenderTarget       SFML.Graphics.SFShape       SFML.Graphics.SFShapeResizable       SFML.Graphics.SFSmoothTexture       SFML.Graphics.SFTexturable+      SFML.Graphics.SFTransformable       SFML.Graphics.SFViewable       SFML.Graphics.Shader       SFML.Graphics.Shape@@ -63,12 +75,13 @@       SFML.Graphics.Text       SFML.Graphics.Texture       SFML.Graphics.Transform-      SFML.Graphics.Transformable SFML.Graphics.Types+      SFML.Graphics.Types       SFML.Graphics.Vertex       SFML.Graphics.VertexArray       SFML.Graphics.View       SFML.SFCopyable       SFML.SFDisplayable+      SFML.SFException       SFML.SFResource       SFML.System.Clock       SFML.System.InputStream@@ -81,6 +94,7 @@       SFML.Window.ContextSettings       SFML.Window.Event       SFML.Window.Joystick+      SFML.Window.JoystickIdentification       SFML.Window.Keyboard       SFML.Window.Mouse       SFML.Window.SFWindow@@ -112,6 +126,7 @@       cbits/SFML/System/Clock_helper.c       cbits/SFML/System/Time_helper.c       cbits/SFML/System/Sleep_helper.c+      cbits/SFML/Window/Joystick_helper.c       cbits/SFML/Window/VideoMode_helper.c       cbits/SFML/Window/Window_helper.c @@ -123,10 +138,24 @@    extensions:       ForeignFunctionInterface+      DeriveDataTypeable -  extra-libraries:-      csfml-window,-      csfml-system,-      csfml-graphics,-      csfml-network,-      csfml-audio+  if os(windows)+      extra-libraries:+          csfml-window,+          csfml-system,+          csfml-graphics,+          csfml-network,+          csfml-audio+  else+      extra-libraries:+          csfml-window,+          csfml-system,+          csfml-graphics,+          csfml-network,+          csfml-audio,+          sfml-window,+          sfml-system,+          sfml-graphics,+          sfml-network,+          sfml-audio

@@ -1,2 +1,3 @@ import Distribution.Simple main = defaultMain+

@@ -24,3 +24,15 @@     *direction = sfListener_getDirection (); } ++void sfListener_setUpVector_helper (sfVector3f* upVector)+{+    sfListener_setUpVector (*upVector);+}+++void sfListener_getUpVector_helper (sfVector3f* upVector)+{+    *upVector = sfListener_getUpVector ();+}+

@@ -6,3 +6,8 @@     *glyph = sfFont_getGlyph (font, codePoint, characterSize, bold); } ++void sfFont_getInfo_helper (sfFont* font, sfFontInfo* info)+{+    *info = sfFont_getInfo (font);+}

@@ -0,0 +1,7 @@+#include <SFML/Window/Joystick.h>+++void sfJoystick_getIdentification_helper (unsigned int joystick, sfJoystickIdentification* ident)+{+    *ident = sfJoystick_getIdentification(joystick);+}

@@ -6,6 +6,8 @@ ,   getListenerPosition ,   setListenerDirection ,   getListenerDirection+,   setListenerUpVector+,   getListenerUpVector ) where @@ -70,13 +72,15 @@ --CSFML_AUDIO_API sfVector3f sfListener_getPosition();  --- | Set the orientation of the listener in the scene.+-- | Set the orientation of the forward vector in the scene. ----- The orientation defines the 3D axes of the listener--- (left, up, front) in the scene. The orientation vector--- doesn't have to be normalized.+-- The direction (also called "at vector") is the vector+-- pointing forward from the listener's perspective. Together+-- with the up vector, it defines the 3D orientation of the+-- listener in the scene. The direction vector doesn't+-- have to be normalized. ----- The default listener's orientation is (0, 0, -1).+-- The default listener's direction is (0, 0, -1). setListenerDirection :: Vec3f -> IO () setListenerDirection dir = with dir sfListener_setDirection_helper @@ -95,3 +99,29 @@  --CSFML_AUDIO_API sfVector3f sfListener_getDirection(); ++-- | Set the upward vector of the listener in the scene+--+-- The up vector is the vector that points upward from the+-- listener's perspective. Together with the direction, it+-- defines the 3D orientation of the listener in the scene.+-- The up vector doesn't have to be normalized.+-- The default listener's up vector is (0, 1, 0). It is usually+-- not necessary to change it, especially in 2D scenarios.+setListenerUpVector :: Vec3f -> IO ()+setListenerUpVector dir = with dir sfListener_setUpVector_helper++foreign import ccall unsafe "sfListener_setUpVector_helper"+    sfListener_setUpVector_helper :: Ptr Vec3f -> IO ()++--CSFML_AUDIO_API void sfListener_setUpVector(sfVector3f upVector);+++-- | Get the current upward vector (unnormalised) of the listener in the scene.+getListenerUpVector :: IO Vec3f+getListenerUpVector = alloca $ \ptr -> sfListener_getUpVector_helper ptr >> peek ptr++foreign import ccall unsafe "sfListener_getUpVector_helper"+    sfListener_getUpVector_helper :: Ptr Vec3f -> IO ()++--CSFML_AUDIO_API sfVector3f sfListener_getUpVector();

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Audio.Music (     module SFML.Utils-,   MusicException(..) ,   musicFromFile ,   musicFromMemory ,   musicFromStream@@ -39,15 +37,14 @@ import SFML.Audio.SFSoundBuffer import SFML.Audio.SoundStatus import SFML.Audio.Types+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.System.Time import SFML.System.Vector3 import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.Marshal.Utils (with) import Foreign.Marshal.Alloc (alloca) import Foreign.C.String@@ -60,11 +57,7 @@ checkNull music@(Music ptr) = if ptr == nullPtr then Nothing else Just music  -data MusicException = MusicException String deriving (Show, Typeable) -instance Exception MusicException-- -- | Create a new music and load it from a file. --  -- This function doesn't start playing the music (call@@ -73,9 +66,9 @@ -- Here is a complete list of all the supported audio formats: -- ogg, wav, flac, aiff, au, raw, paf, svx, nist, voc, ircam, -- w64, mat4, mat5 pvf, htk, sds, avr, sd2, caf, wve, mpc2k, rf64.-musicFromFile :: FilePath -> IO (Either MusicException Music)+musicFromFile :: FilePath -> IO (Either SFException Music) musicFromFile path =-    let err = MusicException $ "Failed loading music from file " ++ path+    let err = SFException $ "Failed loading music from file " ++ path     in withCAString path $ \cstr -> sfMusic_createFromFile cstr >>= return . tagErr err . checkNull  foreign import ccall unsafe "sfMusic_createFromFile"@@ -97,10 +90,10 @@ musicFromMemory     :: Ptr a -- ^ Pointer to the file data in memory     -> Int   -- ^ Size of the data to load, in bytes-    -> IO (Either MusicException Music)+    -> IO (Either SFException Music)  musicFromMemory ptr size =-    let err = MusicException $ "Failed loading music from memory address " ++ show ptr+    let err = SFException $ "Failed loading music from memory address " ++ show ptr     in fmap (tagErr err . checkNull) $ sfMusic_createFromMemory ptr (fromIntegral size)  foreign import ccall unsafe "sfMusic_createFromMemory"@@ -119,9 +112,9 @@ -- Here is a complete list of all the supported audio formats: -- ogg, wav, flac, aiff, au, raw, paf, svx, nist, voc, ircam, -- w64, mat4, mat5 pvf, htk, sds, avr, sd2, caf, wve, mpc2k, rf64.-musicFromStream :: InputStream -> IO (Either MusicException Music)+musicFromStream :: InputStream -> IO (Either SFException Music) musicFromStream is =-    let err = MusicException $ "Failed loading music from input stream " ++ show is+    let err = SFException $ "Failed loading music from input stream " ++ show is     in with is $ \ptr -> sfMusic_createFromStream ptr >>= return . tagErr err . checkNull  foreign import ccall unsafe "sfMusic_createFromStream"

@@ -3,7 +3,7 @@   class SFSoundRecorder a where-    +     -- | Start the capture of a sound recorder.     --     -- The sample rate parameter defines the number of audio samples@@ -12,13 +12,15 @@     --     -- This function uses its own thread so that it doesn't block     -- the rest of the program while the capture runs.-    -- +    --     -- Please note that only one capture can happen at the same time.+    --+    -- Return 'True' if start of capture was successful, 'False' otherwise.     startRecording         :: a         -> Int -- ^ Desired capture rate, in number of samples per second-        -> IO ()-    +        -> IO Bool+     -- | Stop the capture of a sound recorder.     stopRecording :: a -> IO () 

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Audio.SoundBuffer (     module SFML.Utils-,   SoundBufferException(..) ,   soundBufferFromFile ,   soundBufferFromMemory ,   soundBufferFromStream@@ -22,14 +20,13 @@ import SFML.Audio.SFSampled import SFML.Audio.SFSoundBuffer import SFML.Audio.Types+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.System.Time import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca)@@ -42,19 +39,14 @@ checkNull buf@(SoundBuffer ptr) = if ptr == nullPtr then Nothing else Just buf  -data SoundBufferException = SoundBufferException String deriving (Show, Typeable)--instance Exception SoundBufferException-- -- | Create a new sound buffer and load it from a file. -- -- Here is a complete list of all the supported audio formats: -- ogg, wav, flac, aiff, au, raw, paf, svx, nist, voc, ircam, -- w64, mat4, mat5 pvf, htk, sds, avr, sd2, caf, wve, mpc2k, rf64.-soundBufferFromFile :: FilePath -> IO (Either SoundBufferException SoundBuffer)+soundBufferFromFile :: FilePath -> IO (Either SFException SoundBuffer) soundBufferFromFile path =-    let err = SoundBufferException $ "Failed loading sound buffer from file: " ++ show path+    let err = SFException $ "Failed loading sound buffer from file: " ++ show path     in fmap (tagErr err . checkNull) $ withCAString path sfSoundBuffer_createFromFile  foreign import ccall unsafe "sfSoundBuffer_createFromFile"@@ -73,10 +65,10 @@ soundBufferFromMemory     :: Ptr a -- ^ Pointer to the file data in memory     -> Int   -- ^ Size of the data to load, in bytes-    -> IO (Either SoundBufferException SoundBuffer) -- ^ A new sfSoundBuffer object ('Nothing' if failed)+    -> IO (Either SFException SoundBuffer) -- ^ A new sfSoundBuffer object ('Nothing' if failed)  soundBufferFromMemory ptr size =-    let err = SoundBufferException $ "Failed loading sound buffer from memory address " ++ show ptr+    let err = SFException $ "Failed loading sound buffer from memory address " ++ show ptr     in sfSoundBuffer_createFromMemory ptr (fromIntegral size) >>= return . tagErr err . checkNull  foreign import ccall unsafe "sfSoundBuffer_createFromMemory"@@ -92,10 +84,10 @@ -- w64, mat4, mat5 pvf, htk, sds, avr, sd2, caf, wve, mpc2k, rf64. soundBufferFromStream     :: InputStream-    -> IO (Either SoundBufferException SoundBuffer) -- ^ A new sfSoundBuffer object ('Nothing' if failed)+    -> IO (Either SFException SoundBuffer) -- ^ A new sfSoundBuffer object ('Nothing' if failed)  soundBufferFromStream is =-    let err = SoundBufferException $ "Failed loading sound buffer from input stream " ++ show is+    let err = SFException $ "Failed loading sound buffer from input stream " ++ show is     in with is sfSoundBuffer_createFromStream >>= return . tagErr err . checkNull  foreign import ccall unsafe "sfSoundBuffer_createFromStream"

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Audio.SoundBufferRecorder (     module SFML.Utils-,   SoundBufferRecorderException(..) ,   createSoundBufferRecorder ,   destroy ,   startRecording@@ -16,12 +14,13 @@ import SFML.Audio.SFSampled import SFML.Audio.SFSoundRecorder import SFML.Audio.Types+import SFML.SFException import SFML.SFResource import SFML.Utils +import Control.Applicative ((<$>), (<*>)) import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.Types import Foreign.Ptr (nullPtr) @@ -30,15 +29,10 @@ checkNull sbr@(SoundBufferRecorder ptr) = if ptr == nullPtr then Nothing else Just sbr  -data SoundBufferRecorderException = SoundBufferRecorderException String deriving (Show, Typeable)--instance Exception SoundBufferRecorderException-- -- | Create a new sound buffer recorder.-createSoundBufferRecorder :: IO (Either SoundBufferRecorderException SoundBufferRecorder)+createSoundBufferRecorder :: IO (Either SFException SoundBufferRecorder) createSoundBufferRecorder =-    let err = SoundBufferRecorderException $ "Failed creating sound buffer recorder"+    let err = SFException $ "Failed creating sound buffer recorder"     in fmap (tagErr err . checkNull) sfSoundBufferRecorder_create  foreign import ccall unsafe "sfSoundBufferRecorder_create"@@ -50,7 +44,7 @@   instance SFResource SoundBufferRecorder where-    +     {-# INLINABLE destroy #-}     destroy = sfSoundBufferRecorder_destroy @@ -61,16 +55,16 @@   instance SFSoundRecorder SoundBufferRecorder where-    +     {-# INLINABLE startRecording #-}-    startRecording rec rate = sfSoundBufferRecorder_start rec (fromIntegral rate)-    +    startRecording rec rate = ((/=0) . fromIntegral) <$> sfSoundBufferRecorder_start rec (fromIntegral rate)+     {-# INLINABLE stopRecording #-}     stopRecording = sfSoundBufferRecorder_stop   foreign import ccall unsafe "sfSoundBufferRecorder_start"-    sfSoundBufferRecorder_start :: SoundBufferRecorder -> CUInt -> IO ()+    sfSoundBufferRecorder_start :: SoundBufferRecorder -> CUInt -> IO CInt  -- CSFML_AUDIO_API void sfSoundBufferRecorder_start(sfSoundBufferRecorder* soundBufferRecorder, unsigned int sampleRate); @@ -81,7 +75,7 @@   instance SFSampled SoundBufferRecorder where-    +     {-# INLINABLE getSampleRate #-}     getSampleRate = sfSoundBufferRecorder_getSampleRate >=> return . fromIntegral 

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Audio.SoundRecorder (     module SFML.Utils-,   SoundRecorderException(..) ,   SoundRecorderStartCallback ,   SoundRecorderProcessCallback ,   SoundRecorderStopCallback@@ -12,6 +10,11 @@ ,   stopRecording ,   getSampleRate ,   isSoundRecorderAvailable+,   setProcessingInterval+,   getAvailableSoundRecordingDevices+,   getDefaultSoundRecordingDevice+,   setSoundRecordingDevice+,   getSoundRecordingDevice ) where @@ -19,26 +22,26 @@ import SFML.Audio.SFSampled import SFML.Audio.SFSoundRecorder import SFML.Audio.Types+import SFML.SFException import SFML.SFResource+import SFML.System.Time import SFML.Utils -import Control.Exception-import Control.Monad ((>=>))-import Data.Typeable+import Control.Applicative ((<$>), (<*>))+import Control.Monad ((>=>), forM) import Data.Word (Word16)+import Foreign.C.String import Foreign.C.Types-import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (advancePtr)+import Foreign.Storable+import Foreign.Ptr   checkNull :: SoundRecorder -> Maybe SoundRecorder checkNull sr@(SoundRecorder ptr) = if ptr == nullPtr then Nothing else Just sr  -data SoundRecorderException = SoundRecorderException String deriving (Show, Typeable)--instance Exception SoundRecorderException-- -- | Type of the callback used when starting a capture. type SoundRecorderStartCallback a = Ptr a -> IO CInt @@ -62,10 +65,10 @@     -> Ptr (SoundRecorderProcessCallback a) -- ^ (onProcess) Callback function which will be called each time there's audio data to process     -> Ptr (SoundRecorderStopCallback a)    -- ^ (onStop) Callback function which will be called when the current capture stops (can be NULL)     -> Ptr a -- ^ Data to pass to the callback function (can be NULL)-    -> IO (Either SoundRecorderException SoundRecorder) -- ^ A new 'SoundRecorder' object ('Nothing' if failed)+    -> IO (Either SFException SoundRecorder) -- ^ A new 'SoundRecorder' object ('Nothing' if failed)  createSoundRecorder c1 c2 c3 d =-    let err = SoundRecorderException $+    let err = SFException $             "Failed creating sound recorder: onStart = " ++ show c1 ++                                            " onProcess = " ++ show c2 ++                                            " onStop = " ++ show c3 ++@@ -84,7 +87,7 @@   instance SFResource SoundRecorder where-    +     {-# INLINABLE destroy #-}     destroy = sfSoundRecorder_destroy @@ -95,16 +98,16 @@   instance SFSoundRecorder SoundRecorder where-    +     {-# INLINABLE startRecording #-}-    startRecording rec rate = sfSoundRecorder_start rec (fromIntegral rate)-    +    startRecording rec rate = ((/=0) . fromIntegral) <$> sfSoundRecorder_start rec (fromIntegral rate)+     {-# INLINABLE stopRecording #-}     stopRecording = sfSoundRecorder_stop   foreign import ccall unsafe "sfSoundRecorder_start"-    sfSoundRecorder_start :: SoundRecorder -> CUInt -> IO ()+    sfSoundRecorder_start :: SoundRecorder -> CUInt -> IO CInt  -- CSFML_AUDIO_API void sfSoundRecorder_start(sfSoundRecorder* soundRecorder, unsigned int sampleRate); @@ -115,7 +118,7 @@   instance SFSampled SoundRecorder where-    +     {-# INLINABLE getSampleRate #-}     getSampleRate = sfSoundRecorder_getSampleRate >=> return . fromIntegral @@ -138,4 +141,92 @@     sfSoundRecorder_isAvailable :: IO CInt  -- CSFML_AUDIO_API sfBool sfSoundRecorder_isAvailable(void);+++-- | Set the processing interval.+--+-- The processing interval controls the period+-- between calls to the onProcessSamples function. You may+-- want to use a small interval if you want to process the+-- recorded data in real time, for example.+--+-- Note: this is only a hint, the actual period may vary.+-- So don't rely on this parameter to implement precise timing.+--+-- The default processing interval is 100 ms.+setProcessingInterval+    :: SoundRecorder+    -> Time -- ^ Processing interval+    -> IO ()++setProcessingInterval = sfSoundRecorder_setProcessingInterval++foreign import ccall unsafe "sfSoundRecorder_setProcessingInterval"+    sfSoundRecorder_setProcessingInterval :: SoundRecorder -> Time -> IO ()++--CSFML_AUDIO_API void sfSoundRecorder_setProcessingInterval(sfSoundRecorder* soundRecorder, sfTime interval);+++-- | Get a list of the names of all availabe audio capture devices.+--+-- This function returns an array of strings (null terminated),+-- containing the names of all availabe audio capture devices.+-- If no devices are available then 'Nothing' is returned.+getAvailableSoundRecordingDevices :: IO [String]+getAvailableSoundRecordingDevices = alloca $ \pCount -> do+    pNames <- sfSoundRecorder_getAvailableDevices pCount+    count  <- fromIntegral <$> peek pCount :: IO Int+    forM [1..count] $ peekCString . advancePtr (castPtr pNames)++foreign import ccall unsafe "sfSoundRecorder_getAvailableDevices"+    sfSoundRecorder_getAvailableDevices :: Ptr CSize -> IO (Ptr CString)++--CSFML_AUDIO_API const char** sfSoundRecorder_getAvailableDevices(size_t* count);+++-- | Get the name of the default audio capture device.+--+-- This function returns the name of the default audio+-- capture device. If none is available, NULL is returned.++getDefaultSoundRecordingDevice :: IO String+getDefaultSoundRecordingDevice = sfSoundRecorder_getDefaultDevice >>= peekCString++foreign import ccall unsafe "sfSoundRecorder_getDefaultDevice"+    sfSoundRecorder_getDefaultDevice :: IO CString++--CSFML_AUDIO_API const char* sfSoundRecorder_getDefaultDevice();+++-- | Set the audio capture device.+--+-- This function sets the audio capture device to the device+-- with the given name. It can be called on the fly (i.e:+-- while recording). If you do so while recording and+-- opening the device fails, it stops the recording.+--+-- Return 'True if it was able to set the requested device, 'False' otherwise.+setSoundRecordingDevice+    :: SoundRecorder+    -> String -- ^ The name of the audio capture device+    -> IO Bool++setSoundRecordingDevice rec name = withCString name $ \cname ->+    ((/=0) . fromIntegral) <$> sfSoundRecorder_setDevice rec cname++foreign import ccall unsafe "sfSoundRecorder_setDevice"+    sfSoundRecorder_setDevice :: SoundRecorder -> CString -> IO CInt++--CSFML_AUDIO_API sfBool sfSoundRecorder_setDevice(sfSoundRecorder* soundRecorder, const char* name);+++-- | Get the name of the current audio capture device.+getSoundRecordingDevice :: SoundRecorder -> IO String+getSoundRecordingDevice rec = sfSoundRecorder_getDevice rec >>= peekCString++foreign import ccall unsafe "sfSoundRecorder_getDevice"+    sfSoundRecorder_getDevice :: SoundRecorder -> IO CString++--CSFML_AUDIO_API const char* sfSoundRecorder_getDevice(sfSoundRecorder* soundRecorder);+ 

@@ -36,6 +36,7 @@ import SFML.System.Time import SFML.System.Vector3 +import Control.Applicative ((<$>), (<*>)) import Control.Monad ((>=>)) import Data.Word (Word16) import Foreign.C.Types@@ -70,12 +71,11 @@ instance Storable SoundStreamChunk where     sizeOf _ = size_SoundStreamChunk     alignment _ = alignment (undefined :: CInt)-    -    peek ptr = do-        samples <- #{peek sfSoundStreamChunk, samples} ptr-        sampleCount <- #{peek sfSoundStreamChunk, sampleCount} ptr :: IO CUInt-        return $ SoundStreamChunk samples (fromIntegral sampleCount)-    ++    peek ptr = SoundStreamChunk+            <$> #{peek sfSoundStreamChunk, samples} ptr+            <*> fmap fromIntegral (#{peek sfSoundStreamChunk, sampleCount} ptr :: IO CUInt)+     poke ptr (SoundStreamChunk samples sampleCount) = do         #{poke sfSoundStreamChunk, samples} ptr samples         #{poke sfSoundStreamChunk, sampleCount} ptr (fromIntegral sampleCount :: CUInt)@@ -120,7 +120,7 @@   instance SFResource SoundStream where-    +     {-# INLINABLE destroy #-}     destroy = sfSoundStream_destroy @@ -131,64 +131,64 @@   instance SFSound SoundStream where-    +     {-# INLINABLE play #-}     play = sfSoundStream_play-    +     {-# INLINABLE pause #-}     pause = sfSoundStream_pause-    +     {-# INLINABLE stop #-}     stop = sfSoundStream_stop-    +     {-# INLINABLE getAttenuation #-}     getAttenuation = sfSoundStream_getAttenuation >=> return . realToFrac-    +     {-# INLINABLE getLoop #-}     getLoop music = fmap (toEnum . fromIntegral) $ sfSoundStream_getLoop music-    +     {-# INLINABLE getMinDistance #-}     getMinDistance = sfSoundStream_getMinDistance >=> return . realToFrac-    +     {-# INLINABLE getPitch #-}     getPitch = sfSoundStream_getPitch >=> return . realToFrac-    +     {-# INLINABLE getPlayingOffset #-}     getPlayingOffset music = alloca $ \ptr -> sfSoundStream_getPlayingOffset_helper music ptr >> peek ptr-    +     {-# INLINABLE getPosition #-}     getPosition music = alloca $ \ptr -> sfSoundStream_getPosition_helper music ptr >> peek ptr-    +     {-# INLINABLE getStatus #-}     getStatus = sfSoundStream_getStatus >=> return . toEnum . fromIntegral-    +     {-# INLINABLE getVolume #-}     getVolume = sfSoundStream_getVolume >=> return . realToFrac-    +     {-# INLINABLE isRelativeToListener #-}     isRelativeToListener = sfSoundStream_isRelativeToListener >=> return . toEnum . fromIntegral-    +     {-# INLINABLE setAttenuation #-}     setAttenuation m a = sfSoundStream_setAttenuation m (realToFrac a)-    +     {-# INLINABLE setLoop #-}     setLoop music val = sfSoundStream_setLoop music (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setMinDistance #-}     setMinDistance m d = sfSoundStream_setMinDistance m (realToFrac d)-    +     {-# INLINABLE setPitch #-}     setPitch m p = sfSoundStream_setPitch m (realToFrac p)-    +     {-# INLINABLE setPlayingOffset #-}     setPlayingOffset = sfSoundStream_setPlayingOffset-    +     {-# INLINABLE setPosition #-}     setPosition music pos = with pos $ sfSoundStream_setPosition_helper music-    +     {-# INLINABLE setRelativeToListener #-}     setRelativeToListener music val = sfSoundStream_setRelativeToListener music (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setVolume #-}     setVolume m v = sfSoundStream_setVolume m (realToFrac v) 

@@ -16,11 +16,13 @@ ,   module SFML.Graphics.SFBindable ,   module SFML.Graphics.SFBounded ,   module SFML.Graphics.SFCoordSpace+,	module SFML.Graphics.SFDrawable ,   module SFML.Graphics.SFRenderTarget ,   module SFML.Graphics.SFShape ,   module SFML.Graphics.SFShapeResizable ,   module SFML.Graphics.SFSmoothTexture ,   module SFML.Graphics.SFTexturable+,   module SFML.Graphics.SFTransformable ,   module SFML.Graphics.SFViewable ,   module SFML.Graphics.Shader ,   module SFML.Graphics.Shape@@ -28,7 +30,6 @@ ,   module SFML.Graphics.Text ,   module SFML.Graphics.Texture ,   module SFML.Graphics.Transform-,   module SFML.Graphics.Transformable ,   module SFML.Graphics.Types ,   module SFML.Graphics.Vertex ,   module SFML.Graphics.VertexArray@@ -53,11 +54,13 @@ import SFML.Graphics.SFBindable import SFML.Graphics.SFBounded import SFML.Graphics.SFCoordSpace+import SFML.Graphics.SFDrawable import SFML.Graphics.SFRenderTarget import SFML.Graphics.SFShape import SFML.Graphics.SFShapeResizable import SFML.Graphics.SFSmoothTexture import SFML.Graphics.SFTexturable+import SFML.Graphics.SFTransformable import SFML.Graphics.SFViewable import SFML.Graphics.Shader import SFML.Graphics.Shape@@ -65,7 +68,6 @@ import SFML.Graphics.Text import SFML.Graphics.Texture import SFML.Graphics.Transform-import SFML.Graphics.Transformable import SFML.Graphics.Types import SFML.Graphics.Vertex import SFML.Graphics.VertexArray

@@ -1,36 +0,0 @@-module SFML.Graphics.BlendMode-(-    BlendMode(..)-)-where---import Foreign.C.Types (CInt)-import Foreign.Ptr-import Foreign.Storable----- | Available blending modes for drawing.-data BlendMode-    = BlendAlpha     -- ^ Pixel = Src * a + Dest * (1 - a)-    | BlendAdd       -- ^ Pixel = Src + Dest-    | BlendMultiply  -- ^ Pixel = Src * Dest-    | BlendNone      -- ^ No blending-    deriving (Eq, Enum, Bounded, Show)---instance Storable BlendMode where-    sizeOf _ = sizeOf (undefined :: CInt)-    alignment _ = alignment (undefined :: CInt)-    -    peek ptr = fmap (toEnum . fromIntegral) $ peek (castPtr ptr :: Ptr CInt)-    poke ptr bm = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ bm)--{-typedef enum -{-    sfBlendAlpha,    ///< Pixel = Src * a + Dest * (1 - a)-    sfBlendAdd,      ///< Pixel = Src + Dest-    sfBlendMultiply, ///< Pixel = Src * Dest-    sfBlendNone      ///< No blending-} sfBlendMode;-}-

@@ -0,0 +1,123 @@+module SFML.Graphics.BlendMode+(+    BlendFactor(..)+,   BlendEquation(..)+,   BlendMode(..)+,   blendAlpha+,   blendAdd+,   blendMultiply+,   blendNone+)+where+++import Control.Applicative ((<$>), (<*>))+import Foreign.C.Types (CInt)+import Foreign.Ptr+import Foreign.Storable++#include <SFML/Graphics/BlendMode.h>+++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)+++-- | Enumeration of the blending factors+data BlendFactor+    = BlendFactorZero             -- ^ (0, 0, 0, 0)+    | BlendFactorOne              -- ^ (1, 1, 1, 1)+    | BlendFactorSrcColor         -- ^ (src.r, src.g, src.b, src.a)+    | BlendFactorOneMinusSrcColor -- ^ (1, 1, 1, 1) - (src.r, src.g, src.b, src.a)+    | BlendFactorDstColor         -- ^ (dst.r, dst.g, dst.b, dst.a)+    | BlendFactorOneMinusDstColor -- ^ (1, 1, 1, 1) - (dst.r, dst.g, dst.b, dst.a)+    | BlendFactorSrcAlpha         -- ^ (src.a, src.a, src.a, src.a)+    | BlendFactorOneMinusSrcAlpha -- ^ (1, 1, 1, 1) - (src.a, src.a, src.a, src.a)+    | BlendFactorDstAlpha         -- ^ (dst.a, dst.a, dst.a, dst.a)+    | BlendFactorOneMinusDstAlpha -- ^ (1, 1, 1, 1) - (dst.a, dst.a, dst.a, dst.a)+    deriving (Eq, Enum, Bounded, Show)+++-- | Enumeration of the blending equations+data BlendEquation+    = BlendEquationAdd      -- ^ Pixel = Src * SrcFactor + Dst * DstFactor+    | BlendEquationSubtract -- ^ Pixel = Src * SrcFactor - Dst * DstFactor+    deriving (Eq, Enum, Bounded, Show)+++-- | Available blending modes for drawing.+data BlendMode+    = BlendMode+    { colorSrcFactor :: BlendFactor    -- ^ Source blending factor for the color channels+    , colorDstFactor :: BlendFactor    -- ^ Destination blending factor for the color channels+    , colorEquation  :: BlendEquation  -- ^ Blending equation for the color channels+    , alphaSrcFactor :: BlendFactor    -- ^ Source blending factor for the alpha channel+    , alphaDstFactor :: BlendFactor    -- ^ Destination blending factor for the alpha channel+    , alphaEquation  :: BlendEquation  -- ^ Blending equation for the alpha channel+    } deriving (Eq, Show)+++instance Storable BlendFactor where+    sizeOf _ = #{size sfBlendFactor}+    alignment _ = #{alignment sfBlendFactor}++    peek ptr = fmap (toEnum . fromIntegral) $ peek (castPtr ptr :: Ptr CInt)+    poke ptr bm = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ bm)+++instance Storable BlendEquation where+    sizeOf _ = #{size sfBlendEquation}+    alignment _ = #{alignment sfBlendEquation}++    peek ptr = fmap (toEnum . fromIntegral) $ peek (castPtr ptr :: Ptr CInt)+    poke ptr bm = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ bm)+++instance Storable BlendMode where+    sizeOf _ = #{size sfBlendMode}+    alignment _ = #{alignment sfBlendMode}++    peek ptr = BlendMode <$> #{peek sfBlendMode, colorSrcFactor}  ptr+                         <*> #{peek sfBlendMode, colorDstFactor}  ptr+                         <*> #{peek sfBlendMode, colorEquation}   ptr+                         <*> #{peek sfBlendMode, alphaSrcFactor}  ptr+                         <*> #{peek sfBlendMode, alphaDstFactor}  ptr+                         <*> #{peek sfBlendMode, alphaEquation}   ptr+    poke ptr bm = do+        #{poke sfBlendMode, colorSrcFactor} ptr (colorSrcFactor bm)+        #{poke sfBlendMode, colorDstFactor} ptr (colorDstFactor bm)+        #{poke sfBlendMode, colorEquation}  ptr (colorEquation  bm)+        #{poke sfBlendMode, alphaSrcFactor} ptr (alphaSrcFactor bm)+        #{poke sfBlendMode, alphaDstFactor} ptr (alphaDstFactor bm)+        #{poke sfBlendMode, alphaEquation}  ptr (alphaEquation  bm)+++blendAlpha = BlendMode BlendFactorSrcAlpha+                       BlendFactorOneMinusSrcAlpha+                       BlendEquationAdd+                       BlendFactorOne+                       BlendFactorOneMinusSrcAlpha+                       BlendEquationAdd+++blendAdd = BlendMode BlendFactorSrcAlpha+                     BlendFactorOne+                     BlendEquationAdd+                     BlendFactorOne+                     BlendFactorOne+                     BlendEquationAdd+++blendMultiply = BlendMode BlendFactorDstColor+                          BlendFactorZero+                          BlendEquationAdd+                          BlendFactorDstColor+                          BlendFactorZero+                          BlendEquationAdd+++blendNone = BlendMode BlendFactorOne+                      BlendFactorZero+                      BlendEquationAdd+                      BlendFactorOne+                      BlendFactorZero+                      BlendEquationAdd

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.CircleShape (     module SFML.Utils-,   CircleShapeException(..) ,   createCircleShape ,   copy ,   destroy@@ -47,16 +45,15 @@ import SFML.Graphics.SFShapeResizable import SFML.Graphics.SFTexturable import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.Types import Foreign.Ptr (Ptr, nullPtr) import Foreign.Marshal.Alloc (alloca)@@ -72,15 +69,10 @@ checkNullTexture tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex  -data CircleShapeException = CircleShapeException String deriving (Show, Typeable)--instance Exception CircleShapeException-- -- | Create a new circle shape.-createCircleShape :: IO (Either CircleShapeException CircleShape)+createCircleShape :: IO (Either SFException CircleShape) createCircleShape =-    let err = CircleShapeException "Failed creating circle shape"+    let err = SFException "Failed creating circle shape"     in fmap (tagErr err . checkNull) sfCircleShape_create  foreign import ccall unsafe "sfCircleShape_create"@@ -114,7 +106,7 @@ --CSFML_GRAPHICS_API void sfCircleShape_destroy(sfCircleShape* shape);  -instance Transformable CircleShape where+instance SFTransformable CircleShape where      {-# INLINABLE setPosition #-}     setPosition c p = with p $ sfCircleShape_setPosition_helper c

@@ -14,7 +14,9 @@ where  -import Data.Word (Word8)+import Control.Applicative ((<$>), (<*>))+import Data.Bits ((.&.), shiftR)+import Data.Word (Word8, Word32) import Foreign.Storable  #include <SFML/Graphics/Color.h>@@ -33,14 +35,13 @@ instance Storable Color where     sizeOf _ = 4 * sizeOf (undefined :: Word8)     alignment _ = alignment (undefined :: Word8)-    -    peek ptr = do-        r <- #{peek sfColor, r} ptr-        g <- #{peek sfColor, g} ptr-        b <- #{peek sfColor, b} ptr-        a <- #{peek sfColor, a} ptr-        return $ Color r g b a-    ++    peek ptr = Color+            <$> #{peek sfColor, r} ptr+            <*> #{peek sfColor, g} ptr+            <*> #{peek sfColor, b} ptr+            <*> #{peek sfColor, a} ptr+     poke ptr (Color r g b a) = do         #{poke sfColor, r} ptr r         #{poke sfColor, g} ptr g@@ -60,13 +61,17 @@   instance Num Color where-    +     (Color r1 g1 b1 a1) + (Color r2 g2 b2 a2) = Color (r1+r2) (g1+g2) (b1+b2) (a1+a2)     (Color r1 g1 b1 a1) - (Color r2 g2 b2 a2) = Color (r1-r2) (g1-g2) (b1-b2) (a1-a2)     (Color r1 g1 b1 a1) * (Color r2 g2 b2 a2) = Color (r1*r2) (g1*g2) (b1*b2) (a1*a2)     negate (Color r g b a) = Color (-r) (-g) (-b) (-a)     abs (Color r g b a) = Color (abs r) (abs g) (abs b) (abs a)     signum (Color r g b a) = Color (signum r) (signum g) (signum b) (signum a)-    fromInteger i = let i' = fromIntegral i in Color i' i' i' i'--+    fromInteger i' =+        let i = fromIntegral i' :: Word32+            r = fromIntegral $ (i .&. 0xFF000000) `shiftR` 24+            g = fromIntegral $ (i .&. 0x00FF0000) `shiftR` 16+            b = fromIntegral $ (i .&. 0x0000FF00) `shiftR` 8+            a = fromIntegral $  i .&. 0x000000FF+        in Color r g b a

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.ConvexShape (     module SFML.Utils-,   ConvexShapeException(..) ,   createConvexShape ,   copy ,   destroy@@ -46,16 +44,15 @@ import SFML.Graphics.SFShapeResizable import SFML.Graphics.SFTexturable import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.Types import Foreign.Ptr (Ptr, nullPtr) import Foreign.Marshal.Alloc (alloca)@@ -71,15 +68,10 @@ checkNullTexture tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex  -data ConvexShapeException = ConvexShapeException String deriving (Show, Typeable)--instance Exception ConvexShapeException-- -- | Create a new convex shape.-createConvexShape :: IO (Either ConvexShapeException ConvexShape)+createConvexShape :: IO (Either SFException ConvexShape) createConvexShape =-    let err = ConvexShapeException "Failed creating convex shape"+    let err = SFException "Failed creating convex shape"     in fmap (tagErr err . checkNull) sfConvexShape_create  foreign import ccall unsafe "sfConvexShape_create"@@ -113,7 +105,7 @@ --CSFML_GRAPHICS_API void sfConvexShape_destroy(sfConvexShape* shape);  -instance Transformable ConvexShape where+instance SFTransformable ConvexShape where      {-# INLINABLE setPosition #-}     setPosition c p = with p $ sfConvexShape_setPosition_helper c

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Font (     module SFML.Utils-,   FontException(..) ,   fontFromFile ,   fontFromMemory ,   fontFromStream@@ -11,20 +9,23 @@ ,   getGlyph ,   getKerning ,   getLineSpacing+,   getUnderlinePosition+,   getUnderlineThickness ,   getFontTexture+,   getInfo ) where  +import SFML.Graphics.FontInfo import SFML.Graphics.Glyph import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.Utils -import Control.Exception-import Data.Typeable import Data.Word import Foreign.C.String import Foreign.C.Types@@ -38,15 +39,10 @@ checkNull font@(Font ptr) = if ptr == nullPtr then Nothing else Just font  -data FontException = FontException String deriving (Show, Typeable)--instance Exception FontException-- -- | Create a new font from a file.-fontFromFile :: FilePath -> IO (Either FontException Font)+fontFromFile :: FilePath -> IO (Either SFException Font) fontFromFile path =-    let err = FontException $ "Failed loading font from file " ++ show path+    let err = SFException $ "Failed loading font from file " ++ show path     in fmap (tagErr err . checkNull) $ withCAString path sfFont_createFromFile  foreign import ccall unsafe "sfFont_createFromFile"@@ -61,10 +57,10 @@ fontFromMemory     :: Ptr Char -- ^ Pointer to the file data in memory     -> Int -- ^ Size of the data to load, in bytes-    -> IO (Either FontException Font)+    -> IO (Either SFException Font)  fontFromMemory pixels size =-    let err = FontException $ "Failed loading font from memory address " ++ show pixels+    let err = SFException $ "Failed loading font from memory address " ++ show pixels     in fmap (tagErr err . checkNull) $ sfFont_createFromMemory pixels (fromIntegral size)  foreign import ccall unsafe "sfFont_createFromMemory"@@ -76,9 +72,9 @@   -- | Create a new image font a custom stream.-fontFromStream :: InputStream -> IO (Either FontException Font)+fontFromStream :: InputStream -> IO (Either SFException Font) fontFromStream stream =-    let err = FontException $ "Failed loading font from stream " ++ show stream+    let err = SFException $ "Failed loading font from stream " ++ show stream     in fmap (tagErr err . checkNull) $ with stream sfFont_createFromStream  foreign import ccall "sfFont_createFromStream"@@ -90,7 +86,7 @@   instance SFCopyable Font where-    +     {-# INLINABLE copy #-}     copy = sfFont_copy @@ -102,7 +98,7 @@   instance SFResource Font where-    +     {-# INLINABLE destroy #-}     destroy = sfFont_destroy @@ -138,13 +134,13 @@     -> Int  -- ^ Unicode code point of the first character     -> Int  -- ^ Unicode code point of the second characte.r     -> Int  -- ^ Character size, in pixels-    -> IO Int+    -> IO Float  getKerning font first second size =-    fmap fromIntegral $ sfFont_getKerning font (fromIntegral first) (fromIntegral second) (fromIntegral size)+    fmap realToFrac $ sfFont_getKerning font (fromIntegral first) (fromIntegral second) (fromIntegral size)  foreign import ccall unsafe "sfFont_getKerning"-    sfFont_getKerning :: Font -> Word32 -> Word32 -> CUInt -> IO CInt+    sfFont_getKerning :: Font -> Word32 -> Word32 -> CUInt -> IO CFloat  --CSFML_GRAPHICS_API int sfFont_getKerning(sfFont* font, sfUint32 first, sfUint32 second, unsigned int characterSize); @@ -152,17 +148,52 @@ -- | Get the line spacing value. getLineSpacing     :: Font -- ^ Source font-    -> Int    -- ^ Character size, in pixels-    -> IO Int+    -> Int  -- ^ Character size, in pixels+    -> IO Float -getLineSpacing font size = fmap fromIntegral $ sfFont_getLineSpacing font (fromIntegral size)+getLineSpacing font size = fmap realToFrac $ sfFont_getLineSpacing font (fromIntegral size)  foreign import ccall unsafe "sfFont_getLineSpacing"-    sfFont_getLineSpacing :: Font -> CUInt -> IO CInt+    sfFont_getLineSpacing :: Font -> CUInt -> IO CFloat  --CSFML_GRAPHICS_API int sfFont_getLineSpacing(sfFont* font, unsigned int characterSize);  +-- | Get the position of the underline.+--+-- Underline position is the vertical offset to apply between the+-- baseline and the underline.+getUnderlinePosition+    :: Font -- ^ Source font+    -> Int  -- ^ Reference character size+    -> IO Float++getUnderlinePosition font size+    = fmap realToFrac $ sfFont_getUnderlinePosition font (fromIntegral size)++foreign import ccall unsafe "sfFont_getUnderlinePosition"+    sfFont_getUnderlinePosition :: Font -> CUInt -> IO CFloat++--CSFML_GRAPHICS_API float sfFont_getUnderlinePosition(sfFont* font, unsigned int characterSize);+++-- | Get the thickness of the underline.+--+-- Underline thickness is the vertical size of the underline.+getUnderlineThickness+    :: Font -- ^ Source font+    -> Int  -- ^ Reference character size+    -> IO Float++getUnderlineThickness font size+    = fmap realToFrac $ sfFont_getUnderlineThickness font (fromIntegral size)++foreign import ccall unsafe "sfFont_getUnderlineThickness"+    sfFont_getUnderlineThickness :: Font -> CUInt -> IO CFloat++--CSFML_GRAPHICS_API float sfFont_getUnderlineThickness(sfFont* font, unsigned int characterSize);++ -- | Get the texture containing the glyphs of a given size in a font. getFontTexture     :: Font -- ^ Source font@@ -176,3 +207,16 @@  --CSFML_GRAPHICS_API const sfTexture* sfFont_getTexture(sfFont* font, unsigned int characterSize); ++-- | Get the font information.+--+-- The returned structure will remain valid only if the font+-- is still valid. If the font is invalid an invalid structure+-- is returned.+getInfo :: Font -> IO FontInfo+getInfo font = alloca $ \ptr -> sfFont_getInfo_helper font ptr >> peek ptr++foreign import ccall unsafe "sfFont_getInfo_helper"+    sfFont_getInfo_helper :: Font -> Ptr FontInfo -> IO ()++--CSFML_GRAPHICS_API sfFontInfo sfFont_getInfo(const sfFont* font);

@@ -0,0 +1,30 @@+module SFML.Graphics.FontInfo
+(
+    FontInfo(..)
+)
+where
+
+import Control.Applicative ((<$>), (<*>))
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Storable
+
+#include <SFML/Graphics/FontInfo.h>
+
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)
+
+
+data FontInfo
+    = FontInfo
+    { family :: String
+    } deriving (Show)
+
+
+instance Storable FontInfo where
+    sizeOf _ = #{size sfFontInfo}
+    alignment _ = #{alignment sfFontInfo}
+
+    peek ptr = FontInfo <$> peekCString (castPtr ptr)
+
+    poke ptr fontInfo = withCString (family fontInfo) $ \cstring -> poke (castPtr ptr) cstring

@@ -8,6 +8,7 @@  import SFML.Graphics.Rect +import Control.Applicative ((<$>), (<*>)) import Foreign.C.Types import Foreign.Storable @@ -29,13 +30,12 @@ instance Storable Glyph where     sizeOf _ = sizeInt + 2*sizeIntRect     alignment _ = alignment (undefined :: IntRect)-    -    peek ptr = do-        advance <- #{peek sfGlyph, advance} ptr :: IO CInt-        bounds  <- #{peek sfGlyph, bounds} ptr-        rect    <- #{peek sfGlyph, textureRect} ptr-        return $ Glyph (fromIntegral advance) bounds rect-    ++    peek ptr = Glyph+            <$> fmap fromIntegral (#{peek sfGlyph, advance} ptr :: IO CInt)+            <*> #{peek sfGlyph, bounds} ptr+            <*> #{peek sfGlyph, textureRect} ptr+     poke ptr (Glyph advance bounds rect) = do         #{poke sfGlyph, advance} ptr (fromIntegral advance :: CInt)         #{poke sfGlyph, bounds} ptr bounds

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Image (     module SFML.Utils-,   ImageException(..) ,   createImage ,   imageFromColor ,   imageFromPixels@@ -28,13 +26,12 @@ import SFML.Graphics.Rect import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.System.Vector2 import SFML.Utils -import Control.Exception-import Data.Typeable import Data.Word (Word8) import Foreign.Ptr import Foreign.C.String@@ -48,21 +45,16 @@ checkNull img@(Image ptr) = if ptr == nullPtr then Nothing else Just img  -data ImageException = ImageException String deriving (Show, Typeable)--instance Exception ImageException-- -- | Create an image. -- -- This image is filled with black pixels. createImage     :: Int -- ^ Width of the image     -> Int -- ^ Height of the image-    -> IO (Either ImageException Image)+    -> IO (Either SFException Image)  createImage w h =-    let err = ImageException "Failed creating image"+    let err = SFException "Failed creating image"     in fmap (tagErr err . checkNull) $ sfImage_create (fromIntegral w) (fromIntegral h)  foreign import ccall unsafe "sfImage_create"

@@ -10,6 +10,7 @@ where  +import Control.Applicative ((<$>), (<*>)) import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (with)@@ -36,14 +37,13 @@ instance Storable FloatRect where     sizeOf _ = 4 * sizeFloat     alignment _ = alignment (undefined :: CFloat)-    -    peek ptr = do-        l <- fmap realToFrac (#{peek sfFloatRect, left} ptr :: IO CFloat)-        t <- fmap realToFrac (#{peek sfFloatRect, top} ptr :: IO CFloat)-        w <- fmap realToFrac (#{peek sfFloatRect, width} ptr :: IO CFloat)-        h <- fmap realToFrac (#{peek sfFloatRect, height} ptr :: IO CFloat)-        return $ FloatRect l t w h-    ++    peek ptr = FloatRect+            <$> fmap realToFrac (#{peek sfFloatRect, left} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfFloatRect, top} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfFloatRect, width} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfFloatRect, height} ptr :: IO CFloat)+     poke ptr (FloatRect l t w h) = do         #{poke sfFloatRect, left} ptr (realToFrac l :: CFloat)         #{poke sfFloatRect, top} ptr (realToFrac t :: CFloat)@@ -63,14 +63,13 @@ instance Storable IntRect where     sizeOf _ = 4 * sizeInt     alignment _ = alignment (undefined :: CInt)-    -    peek ptr = do-        l <- #{peek sfIntRect, left} ptr   :: IO CInt-        t <- #{peek sfIntRect, top} ptr    :: IO CInt-        w <- #{peek sfIntRect, width} ptr  :: IO CInt-        h <- #{peek sfIntRect, height} ptr :: IO CInt-        return $ IntRect (fromIntegral l) (fromIntegral t) (fromIntegral w) (fromIntegral h)-    ++    peek ptr = IntRect+            <$> fmap fromIntegral (#{peek sfIntRect, left} ptr   :: IO CInt)+            <*> fmap fromIntegral (#{peek sfIntRect, top} ptr    :: IO CInt)+            <*> fmap fromIntegral (#{peek sfIntRect, width} ptr  :: IO CInt)+            <*> fmap fromIntegral (#{peek sfIntRect, height} ptr :: IO CInt)+     poke ptr (IntRect l t w h) = do         #{poke sfIntRect, left} ptr (fromIntegral l :: CInt)         #{poke sfIntRect, top} ptr (fromIntegral t :: CInt)@@ -118,7 +117,7 @@   instance Rect FloatRect where-    +     intersectRect r1 r2 = unsafeDupablePerformIO $         alloca $ \ptr1 ->         alloca $ \ptr2 ->@@ -138,7 +137,7 @@   instance Rect IntRect where-    +     intersectRect r1 r2 = unsafeDupablePerformIO $         alloca $ \ptr1 ->         alloca $ \ptr2 ->

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.RectangleShape (     module SFML.Utils-,   RectangleShapeException(..) ,   createRectangleShape ,   copy ,   destroy@@ -47,16 +45,15 @@ import SFML.Graphics.SFShapeResizable import SFML.Graphics.SFTexturable import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.Types import Foreign.Ptr (Ptr, nullPtr) import Foreign.Marshal.Alloc (alloca)@@ -72,15 +69,10 @@ checkNullTexture tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex  -data RectangleShapeException = RectangleShapeException String deriving (Show, Typeable)--instance Exception RectangleShapeException-- -- | Create a new rectangle shape.-createRectangleShape :: IO (Either RectangleShapeException RectangleShape)+createRectangleShape :: IO (Either SFException RectangleShape) createRectangleShape =-    let err = RectangleShapeException "Failed creating rectangle shape"+    let err = SFException "Failed creating rectangle shape"     in fmap (tagErr err . checkNull) sfRectangleShape_create  foreign import ccall unsafe "sfRectangleShape_create"@@ -113,7 +105,7 @@  --CSFML_GRAPHICS_API void sfRectangleShape_destroy(sfRectangleShape* shape); -instance Transformable RectangleShape where+instance SFTransformable RectangleShape where      {-# INLINABLE setPosition #-}     setPosition c p = with p $ sfRectangleShape_setPosition_helper c

@@ -11,13 +11,17 @@ import SFML.Graphics.Transform import SFML.Graphics.Types -import Foreign.C.Types (CFloat)+import Control.Applicative ((<$>), (<*>))+import Foreign.C.Types (CIntPtr) import Foreign.Ptr (nullPtr) import Foreign.Storable  #include <SFML/Graphics/RenderStates.h>  +#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)++ -- | Define the states used for drawing to a RenderTarget. data RenderStates = RenderStates     { blendMode :: BlendMode@@ -28,15 +32,14 @@   instance Storable RenderStates where-    sizeOf _ = size_sfRenderStates-    alignment _ = alignment (undefined :: CFloat)+    sizeOf _ = #{size sfRenderStates}+    alignment _ = #{alignment sfRenderStates} -    peek ptr = do-        bm <- #{peek sfRenderStates, blendMode} ptr-        tr <- #{peek sfRenderStates, transform} ptr-        tx <- #{peek sfRenderStates, texture} ptr-        sh <- #{peek sfRenderStates, shader} ptr-        return $ RenderStates bm tr tx sh+    peek ptr = RenderStates+            <$> #{peek sfRenderStates, blendMode} ptr+            <*> #{peek sfRenderStates, transform} ptr+            <*> #{peek sfRenderStates, texture} ptr+            <*> #{peek sfRenderStates, shader} ptr      poke ptr (RenderStates bm tr tx sh) = do         #{poke sfRenderStates, blendMode} ptr  bm@@ -44,20 +47,17 @@         #{poke sfRenderStates, texture} ptr tx         #{poke sfRenderStates, shader} ptr sh --size_sfRenderStates = #{size sfRenderStates}- -- | Default render states, defined as -- -- @--- renderStates = RenderStates 'BlendAlpha' 'idTransform' (Texture 'nullPtr') (Shader 'nullPtr')+-- renderStates = RenderStates 'blendAlpha' 'idTransform' (Texture 'nullPtr') (Shader 'nullPtr') -- @ -- -- This constant tries to mimic the C++ RenderStates default constructor to ease -- the construction of render states. For example, instead of typing -- -- @--- states = RenderStates BlendAlpha idTransform tex (Shader nullptr)+-- states = RenderStates blendAlpha idTransform tex (Shader nullptr) -- @ -- -- Now we can simply type@@ -65,7 +65,7 @@ -- @ -- states = renderStates { texture = tex } -- @-renderStates = RenderStates BlendAlpha idTransform (Texture nullPtr) (Shader nullPtr)+renderStates = RenderStates blendAlpha idTransform (Texture nullPtr) (Shader nullPtr)  {-typedef struct {

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.RenderTexture (     module SFML.Utils-,   RenderTextureException(..) ,   createRenderTexture ,   destroy ,   getTextureSize@@ -45,12 +43,11 @@ import SFML.Graphics.SFSmoothTexture import SFML.Graphics.Vertex import SFML.SFDisplayable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception-import Data.Typeable import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (withArray)@@ -63,20 +60,15 @@ checkNull tex@(RenderTexture ptr) = if ptr == nullPtr then Nothing else Just tex  -data RenderTextureException = RenderTextureException String deriving (Show, Typeable)--instance Exception RenderTextureException-- -- | Construct a new render texture. createRenderTexture     :: Int -- ^ Width of the render texture     -> Int -- ^ Height of the render texture     -> Bool -- ^ Do you want a depth-buffer attached? (useful only if you're doing 3D OpenGL on the render texture)-    -> IO (Either RenderTextureException RenderTexture)+    -> IO (Either SFException RenderTexture)  createRenderTexture w h d =-    let err = RenderTextureException "Failed creating render texture"+    let err = SFException "Failed creating render texture"     in fmap (tagErr err . checkNull) $ sfRenderTexture_create (fromIntegral w) (fromIntegral h) (fromIntegral . fromEnum $ d)  foreign import ccall unsafe "sfRenderTexture_create"

@@ -20,6 +20,8 @@ ,   setVSync ,   setKeyRepeat ,   setWindowActive+,   requestFocus+,   hasFocus ,   display ,   setFramerateLimit ,   setJoystickThreshold@@ -68,6 +70,7 @@ import SFML.SFResource import SFML.System.Vector2 +import Control.Applicative ((<$>), (<*>)) import Data.Bits ((.|.)) import Data.List (foldl') import Foreign.C.String@@ -117,7 +120,7 @@   instance SFResource RenderWindow where-    +     {-# INLINABLE destroy #-}     destroy = sfRenderWindow_destroy @@ -128,22 +131,22 @@   instance SFDisplayable RenderWindow where-    +     {-# INLINABLE display #-}     display = sfRenderWindow_display   instance SFWindow RenderWindow where-    -    {-# INLINABLE close #-}    ++    {-# INLINABLE close #-}     close = sfRenderWindow_close-    +     {-# INLINABLE isWindowOpen #-}     isWindowOpen = fmap (/=0) . sfRenderWindow_isOpen-    +     {-# INLINABLE getWindowSettings #-}     getWindowSettings wnd = alloca $ \ptr -> sfRenderWindow_getSettings_helper wnd ptr >> peek ptr-    +     {-# INLINABLE pollEvent #-}     pollEvent wnd =         alloca $ \ptr -> do@@ -151,7 +154,7 @@         case result of             0 -> return Nothing             _ -> peek ptr >>= return . Just-    +     {-# INLINABLE waitEvent #-}     waitEvent wnd =         alloca $ \ptr -> do@@ -159,62 +162,68 @@         case result of             0 -> return Nothing             _ -> peek ptr >>= return . Just-    +     {-# INLINABLE getWindowPosition #-}     getWindowPosition wnd = alloca $ \ptr -> sfRenderWindow_getPosition_helper wnd ptr >> peek ptr-    +     {-# INLINABLE setWindowPosition #-}     setWindowPosition wnd pos = with pos $ sfRenderWindow_setPosition_helper wnd-    +     {-# INLINABLE getWindowSize #-}     getWindowSize wnd = alloca $ \ptr -> sfRenderWindow_getSize_helper wnd ptr >> peek ptr-    +     {-# INLINABLE setWindowSize #-}     setWindowSize wnd size = with size $ sfRenderWindow_setSize_helper wnd-    +     {-# INLINABLE setWindowTitle #-}     setWindowTitle wnd title = withCAString title $ sfRenderWindow_setTitle wnd-    +     {-# INLINABLE setWindowIcon #-}     setWindowIcon wnd w h pixels =         sfRenderWindow_setIcon wnd (fromIntegral w) (fromIntegral h) pixels-    +     {-# INLINABLE setWindowVisible #-}     setWindowVisible wnd val = sfRenderWindow_setVisible wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setMouseVisible #-}     setMouseVisible wnd val = sfRenderWindow_setMouseCursorVisible wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setVSync #-}     setVSync wnd val = sfRenderWindow_setVerticalSyncEnabled wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setKeyRepeat #-}     setKeyRepeat wnd val = sfRenderWindow_setKeyRepeatEnabled wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setWindowActive #-}     setWindowActive wnd val =         fmap (toEnum . fromIntegral) $ sfRenderWindow_setActive wnd (fromIntegral . fromEnum $ val)-    ++    {-# INLINABLE requestFocus #-}+    requestFocus wnd = sfRenderWindow_requestFocus wnd++    {-# INLINABLE hasFocus #-}+    hasFocus wnd = ((/=0) . fromIntegral) <$> sfRenderWindow_hasFocus wnd+     {-# INLINABLE setFramerateLimit #-}     setFramerateLimit wnd fps = sfRenderWindow_setFramerateLimit wnd (fromIntegral fps)-    +     {-# INLINABLE setJoystickThreshold #-}     setJoystickThreshold w t = sfRenderWindow_setJoystickThreshold w (realToFrac t)-    +     {-# INLINABLE getSystemHandle #-}     getSystemHandle = sfRenderWindow_getSystemHandle-    +     {-# INLINABLE getMousePosition #-}     getMousePosition Nothing =         alloca $ \ptr -> sfMouse_getPositionRenderWindow_helper (RenderWindow nullPtr) ptr >> peek ptr-    +     getMousePosition (Just wnd) =         alloca $ \ptr -> sfMouse_getPositionRenderWindow_helper wnd ptr >> peek ptr-    +     {-# INLINABLE setMousePosition #-}     setMousePosition pos Nothing =         with pos $ \ptr -> sfMouse_setPositionRenderWindow_helper ptr (RenderWindow nullPtr)-    +     setMousePosition pos (Just wnd) =         with pos $ \ptr -> sfMouse_setPositionRenderWindow_helper ptr wnd @@ -310,8 +319,8 @@     sfRenderWindow_setKeyRepeatEnabled :: RenderWindow -> CInt -> IO ()  --CSFML_GRAPHICS_API void sfRenderWindow_setKeyRepeatEnabled(sfRenderWindow* renderWindow, sfBool enabled);-     + foreign import ccall unsafe "sfRenderWindow_setActive"     sfRenderWindow_setActive :: RenderWindow -> CInt -> IO CInt @@ -320,6 +329,18 @@ --CSFML_GRAPHICS_API sfBool sfRenderWindow_setActive(sfRenderWindow* renderWindow, sfBool active);  +foreign import ccall unsafe "sfRenderWindow_requestFocus"+    sfRenderWindow_requestFocus :: RenderWindow -> IO ()++--CSFML_GRAPHICS_API void sfRenderWindow_requestFocus(sfRenderWindow* renderWindow);+++foreign import ccall unsafe "sfRenderWindow_hasFocus"+    sfRenderWindow_hasFocus :: RenderWindow -> IO CInt++--CSFML_GRAPHICS_API sfBool sfRenderWindow_hasFocus(const sfRenderWindow* renderWindow);++ foreign import ccall unsafe "sfRenderWindow_display"     sfRenderWindow_display :: RenderWindow -> IO () @@ -330,8 +351,8 @@     sfRenderWindow_setFramerateLimit :: RenderWindow -> CInt -> IO ()  --CSFML_GRAPHICS_API void sfRenderWindow_setFramerateLimit(sfRenderWindow* renderWindow, unsigned int limit);-     + foreign import ccall unsafe "sfRenderWindow_setJoystickThreshold"     sfRenderWindow_setJoystickThreshold :: RenderWindow -> CFloat -> IO () @@ -371,16 +392,16 @@   instance SFViewable RenderWindow where-    +     {-# INLINABLE setView #-}     setView = sfRenderWindow_setView      {-# INLINABLE getView #-}     getView = sfRenderWindow_getView-    +     {-# INLINABLE getDefaultView #-}     getDefaultView = sfRenderWindow_getDefaultView-    +     {-# INLINABLE getViewport #-}     getViewport wnd view = alloca $ \ptr -> sfRenderWindow_getViewport_helper wnd view ptr >> peek ptr @@ -407,7 +428,7 @@   instance SFCoordSpace RenderWindow where-    +     {-# INLINABLE mapPixelToCoords #-}     mapPixelToCoords wnd p view =         alloca $ \ptr ->@@ -424,58 +445,58 @@   instance SFRenderTarget RenderWindow where-    +     {-# INLINABLE drawSprite #-}     drawSprite wnd sprite Nothing   = sfRenderWindow_drawSprite wnd sprite nullPtr     drawSprite wnd sprite (Just rs) = with rs $ sfRenderWindow_drawSprite wnd sprite-    +     {-# INLINABLE drawText #-}     drawText wnd text Nothing   = sfRenderWindow_drawText wnd text nullPtr     drawText wnd text (Just rs) = with rs $ sfRenderWindow_drawText wnd text-    +     {-# INLINABLE drawShape #-}     drawShape wnd shape Nothing   = sfRenderWindow_drawShape wnd shape nullPtr     drawShape wnd shape (Just rs) = with rs $ sfRenderWindow_drawShape wnd shape-    +     {-# INLINABLE drawCircle #-}     drawCircle wnd circle Nothing   = sfRenderWindow_drawCircleShape wnd circle nullPtr     drawCircle wnd circle (Just rs) = with rs $ sfRenderWindow_drawCircleShape wnd circle-    +     {-# INLINABLE drawConvexShape #-}     drawConvexShape wnd shape Nothing   = sfRenderWindow_drawConvexShape wnd shape nullPtr     drawConvexShape wnd shape (Just rs) = with rs $ sfRenderWindow_drawConvexShape wnd shape-    +     {-# INLINABLE drawRectangle #-}     drawRectangle wnd rect Nothing   = sfRenderWindow_drawRectangleShape wnd rect nullPtr     drawRectangle wnd rect (Just rs) = with rs $ sfRenderWindow_drawRectangleShape wnd rect-    +     {-# INLINABLE drawVertexArray #-}     drawVertexArray wnd va Nothing   = sfRenderWindow_drawVertexArray wnd va nullPtr     drawVertexArray wnd va (Just rs) = with rs $ sfRenderWindow_drawVertexArray wnd va-    +     {-# INLINABLE drawPrimitives #-}     drawPrimitives wnd verts prim Nothing =         let n = length verts         in withArray verts $ \ptr ->             sfRenderWindow_drawPrimitives wnd ptr (fromIntegral n) (fromIntegral . fromEnum $ prim) nullPtr-    +     drawPrimitives wnd verts prim (Just r) =         let n = length verts         in withArray verts $ \ptr ->             with r $ sfRenderWindow_drawPrimitives wnd ptr (fromIntegral n) (fromIntegral . fromEnum $ prim)-    +     drawPrimitives' wnd verts n prim Nothing =         sfRenderWindow_drawPrimitives wnd verts (fromIntegral n) (fromIntegral . fromEnum $ prim) nullPtr-    +     drawPrimitives' wnd verts n prim (Just r) =         with r $ sfRenderWindow_drawPrimitives wnd verts (fromIntegral n) (fromIntegral . fromEnum $ prim)-    +     {-# INLINABLE pushGLStates #-}     pushGLStates = sfRenderWindow_pushGLStates-    +     {-# INLINABLE popGLStates #-}     popGLStates = sfRenderWindow_popGLStates-    +     {-# INLINABLE resetGLStates #-}     resetGLStates = sfRenderWindow_resetGLStates 

@@ -0,0 +1,31 @@+module SFML.Graphics.SFDrawable where++import SFML.Graphics.CircleShape+import SFML.Graphics.ConvexShape+import SFML.Graphics.RenderStates+import SFML.Graphics.Shape+import SFML.Graphics.SFRenderTarget+import SFML.Graphics.Text+import SFML.Graphics.Types+import SFML.Graphics.VertexArray++class SFDrawable a where+    draw :: SFRenderTarget t => t -> a -> Maybe RenderStates -> IO ()++instance SFDrawable Sprite where+    draw = drawSprite++instance SFDrawable Text where+    draw = drawText++instance SFDrawable Shape where+    draw = drawShape++instance SFDrawable CircleShape where+    draw = drawCircle++instance SFDrawable ConvexShape where+    draw = drawConvexShape++instance SFDrawable VertexArray where+    draw = drawVertexArray

@@ -0,0 +1,93 @@+module SFML.Graphics.SFTransformable+where+++import SFML.Graphics.Transform+import SFML.System.Vector2+++class SFTransformable a where++    -- | Set the position of a transformable.+    --+    -- This function completely overwrites the previous position.+    --+    -- See 'move' to apply an offset based on the previous position instead.+    --+    -- The default position of a transformable object is (0, 0).+    setPosition :: a -> Vec2f -> IO ()++    -- | Set the orientation of a transformable.+    --+    -- This function completely overwrites the previous rotation.+    --+    -- See 'rotate' to add an angle based on the previous rotation instead.+    --+    -- The default rotation of a transformable SFTransformable object is 0.+    setRotation+        :: a+        -> Float -- ^ New rotation, in degrees+        -> IO ()++    -- | Set the scale factors of a transformable.+    --+    -- This function completely overwrites the previous scale.+    --+    -- See 'scale' to add a factor based on the previous scale instead.+    --+    -- The default scale of a transformable SFTransformable object is (1, 1).+    setScale :: a -> Vec2f -> IO ()++    -- | Set the local origin of a transformable.+    --+    -- The origin of an object defines the center point for+    -- all transformations (position, scale, rotation).+    --+    -- The coordinates of this point must be relative to the+    -- top-left corner of the object, and ignore all+    -- transformations (position, scale, rotation).+    --+    -- The default origin of a transformable SFTransformable object is (0, 0).+    setOrigin :: a -> Vec2f -> IO ()++    -- | Get the position of a transformable.+    getPosition :: a -> IO Vec2f++    -- | Get the orientation of a transformable.+    getRotation+        :: a+        -> IO Float -- ^ Current rotation, in degrees++    -- | Get the current scale of a transformable+    getScale :: a -> IO Vec2f++    -- | Get the local origin of a transformable.+    getOrigin :: a -> IO Vec2f++    -- | Move a transformable by a given offset+    --+    -- This function adds to the current position of the object,+    -- unlike 'setPosition' which overwrites it.+    move :: a -> Vec2f -> IO ()++    -- | Rotate a transformable.+    --+    -- This function adds to the current rotation of the object,+    -- unlike 'setRotation' which overwrites it.+    rotate+        :: a+        -> Float -- ^ Angle of rotation, in degrees+        -> IO ()++    -- | Scale a transformable.+    --+    -- This function multiplies the current scale of the object,+    -- unlike 'setScale' which overwrites it.+    scale :: a -> Vec2f -> IO ()++    -- | Get the combined transform of a transformable.+    getTransform :: a -> IO Transform++    -- | Get the inverse of the combined transform of a transformable.+    getInverseTransform :: a -> IO Transform+

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Shader (     module SFML.Utils-,   ShaderException(..) ,   nullShader ,   shaderFromFile ,   shaderFromMemory@@ -28,14 +26,13 @@ import SFML.Graphics.Transform import SFML.Graphics.Types import SFML.Graphics.SFBindable+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.System.Vector2 import SFML.System.Vector3 import SFML.Utils -import Control.Exception-import Data.Typeable import Foreign.C.Types import Foreign.C.String import Foreign.Marshal.Utils (with)@@ -46,19 +43,14 @@ checkNull shader@(Shader ptr) = if ptr == nullPtr then Nothing else Just shader  -data ShaderException = ShaderException String deriving (Show, Typeable)--instance Exception ShaderException---exf :: Show a => Maybe a -> Maybe a -> ShaderException-exf vs fs = ShaderException $ "Failed loading shader program from files " ++ show vs ++ ", " ++ show fs+exf :: Show a => Maybe a -> Maybe a -> SFException+exf vs fs = SFException $ "Failed loading shader program from files " ++ show vs ++ ", " ++ show fs -exs :: Show a => Maybe a -> Maybe a -> ShaderException-exs vs fs = ShaderException $ "Failed loading shader program from sources " ++ show vs ++ ", " ++ show fs+exs :: Show a => Maybe a -> Maybe a -> SFException+exs vs fs = SFException $ "Failed loading shader program from sources " ++ show vs ++ ", " ++ show fs -exi :: Show a => Maybe a -> Maybe a -> ShaderException-exi vs fs = ShaderException $ "Failed loading shader program from input streams " ++ show vs ++ ", " ++ show fs+exi :: Show a => Maybe a -> Maybe a -> SFException+exi vs fs = SFException $ "Failed loading shader program from input streams " ++ show vs ++ ", " ++ show fs  nullstr = Nothing :: Maybe String nullis  = Nothing :: Maybe InputStream@@ -81,7 +73,7 @@ shaderFromFile     :: Maybe FilePath -- ^ Path of the vertex shader file to load, or 'Nothing' to skip this shader     -> Maybe FilePath -- ^ Path of the fragment shader file to load, or 'Nothing' to skip this shader-    -> IO (Either ShaderException Shader)+    -> IO (Either SFException Shader)  shaderFromFile Nothing Nothing = fmap (tagErr (exf nullstr nullstr) . checkNull) $ sfShader_createFromFile nullPtr nullPtr @@ -115,7 +107,7 @@ shaderFromMemory     :: Maybe String -- ^ String containing the source code of the vertex shader, or 'Nothing' to skip this shader     -> Maybe String -- ^ String containing the source code of the fragment shader, or 'Nothing' to skip this shader-    -> IO (Either ShaderException Shader)+    -> IO (Either SFException Shader)  shaderFromMemory Nothing Nothing     = fmap (tagErr (exs nullstr nullstr) . checkNull) $ sfShader_createFromMemory nullPtr nullPtr@@ -150,7 +142,7 @@ shaderFromStream     :: Maybe InputStream -- ^ Source stream to read the vertex shader from, or 'Nothing' to skip this shader     -> Maybe InputStream -- ^ Source stream to read the fragment shader from, or 'Nothing' to skip this shader-    -> IO (Either ShaderException Shader)+    -> IO (Either SFException Shader)  shaderFromStream Nothing Nothing     = fmap (tagErr (exi nullis nullis) . checkNull) $ sfShader_createFromStream nullPtr nullPtr

@@ -42,7 +42,7 @@ import SFML.Graphics.SFShapeResizable import SFML.Graphics.SFTexturable import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFResource import SFML.System.Vector2@@ -85,7 +85,7 @@ --CSFML_GRAPHICS_API void sfShape_destroy(sfShape* shape);  -instance Transformable Shape where+instance SFTransformable Shape where      {-# INLINABLE setPosition #-}     setPosition c p = with p $ sfShape_setPosition_helper c

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Sprite (     module SFML.Utils-,   SpriteException(..) ,   createSprite ,   copy ,   destroy@@ -37,16 +35,15 @@ import SFML.Graphics.Rect import SFML.Graphics.SFTexturable import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception import Control.Monad ((>=>))-import Data.Typeable import Foreign.C.Types import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (with)@@ -62,15 +59,10 @@ checkNullTexture tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex  -data SpriteException = SpriteException String deriving (Show, Typeable)--instance Exception SpriteException-- -- | Create a new sprite.-createSprite :: IO (Either SpriteException Sprite)+createSprite :: IO (Either SFException Sprite) createSprite =-    let err = SpriteException "Failed creating sprite"+    let err = SFException "Failed creating sprite"     in fmap (tagErr err . checkNull) sfSprite_create  foreign import ccall unsafe "sfSprite_create"@@ -104,7 +96,7 @@ --CSFML_GRAPHICS_API void sfSprite_destroy(sfSprite* sprite);  -instance Transformable Sprite where+instance SFTransformable Sprite where      {-# INLINABLE setPosition #-}     setPosition sprite pos = with pos $ sfSprite_setPosition_helper sprite

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Text (     module SFML.Utils-,   TextException(..) ,   TextStyle(..) ,   createText ,   copy@@ -29,21 +27,22 @@ import SFML.Graphics.Color import SFML.Graphics.Rect import SFML.Graphics.Transform-import SFML.Graphics.Transformable+import SFML.Graphics.SFTransformable import SFML.Graphics.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.Vector2 import SFML.Utils -import Control.Exception import Control.Monad-import Data.Typeable import Data.Bits ((.|.)) import Data.List (foldl')+import Data.Word import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (peekArray0, withArray0) import Foreign.Marshal.Utils (with) import Foreign.Ptr import Foreign.Storable@@ -51,29 +50,27 @@  -- | Text styles. data TextStyle-    = TextRegular    -- ^ Regular characters, no style-    | TextBold       -- ^ Characters are bold-    | TextItalic     -- ^ Characters are in italic-    | TextUnderlined -- ^ Characters are underlined+    = TextRegular       -- ^ Regular characters, no style+    | TextBold          -- ^ Characters are bold+    | TextItalic        -- ^ Characters are in italic+    | TextUnderlined    -- ^ Characters are underlined+    | TextStrikeThrough -- ^ Strike through characters     deriving (Eq, Bounded, Show)   instance Enum TextStyle where     -    fromEnum TextRegular    = 0-    fromEnum TextBold       = 1-    fromEnum TextItalic     = 2-    fromEnum TextUnderlined = 4+    fromEnum TextRegular       = 0+    fromEnum TextBold          = 1+    fromEnum TextItalic        = 2+    fromEnum TextUnderlined    = 4+    fromEnum TextStrikeThrough = 8          toEnum 0 = TextRegular     toEnum 1 = TextBold     toEnum 2 = TextItalic     toEnum 4 = TextUnderlined---data TextException = TextException String deriving (Show, Typeable)--instance Exception TextException+    toEnum 8 = TextStrikeThrough   checkNull :: Text -> Maybe Text@@ -85,9 +82,9 @@   -- | Create a new text.-createText :: IO (Either TextException Text)+createText :: IO (Either SFException Text) createText =-    let err = TextException "Failed creating text"+    let err = SFException "Failed creating text"     in fmap (tagErr err . checkNull) sfText_create  foreign import ccall unsafe "sfText_create"@@ -121,7 +118,7 @@ --CSFML_GRAPHICS_API void sfText_destroy(sfText* text);  -instance Transformable Text where+instance SFTransformable Text where      {-# INLINABLE setPosition #-}     setPosition text pos = with pos $ sfText_setPosition_helper text@@ -243,12 +240,12 @@  -- | Set the string of a text (from a unicode string). setTextStringU :: Text -> String -> IO ()---- withCString is locale dependent. SFML expects UTF-32. Needs fix.-setTextStringU text str = withCString str $ sfText_setUnicodeString text+setTextStringU text str = withArray0 0 str' $ sfText_setUnicodeString text+        where+            str' = map (fromIntegral . fromEnum) str  foreign import ccall unsafe "sfText_setUnicodeString"-    sfText_setUnicodeString :: Text -> CString -> IO ()+    sfText_setUnicodeString :: Text -> Ptr Word32 -> IO ()  --CSFML_GRAPHICS_API void sfText_setUnicodeString(sfText* text, const sfUint32* string); @@ -326,11 +323,12 @@  -- | Get the string of a text as a UTF-32 string. getTextUnicodeString :: Text -> IO String--- Fix: peekCString is locale-dependent. SFML will return a UTF-32 string.-getTextUnicodeString = sfText_getString >=> peekCString+getTextUnicodeString = liftM toString . peekArray0 0 <=< sfText_getUnicodeString+    where+        toString = map $ toEnum . fromIntegral  foreign import ccall unsafe "sfText_getUnicodeString"-    sfText_getUnicodeString :: Text -> IO CString+    sfText_getUnicodeString :: Text -> IO (Ptr Word32)  --CSFML_GRAPHICS_API const sfUint32* sfText_getUnicodeString(const sfText* text); 

@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} module SFML.Graphics.Texture (     module SFML.Utils-,   TextureException(..) ,   nullTexture ,   createTexture ,   textureFromFile@@ -33,13 +31,12 @@ import SFML.Graphics.Types import SFML.Window.Types import SFML.SFCopyable+import SFML.SFException import SFML.SFResource import SFML.System.InputStream import SFML.System.Vector2 import SFML.Utils -import Control.Exception-import Data.Typeable import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca)@@ -53,11 +50,6 @@ checkNull tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex  -data TextureException = TextureException String deriving (Show, Typeable)--instance Exception TextureException-- -- | A null texture. nullTexture = Texture nullPtr @@ -66,10 +58,10 @@ createTexture     :: Int -- ^ Texture width     -> Int -- ^ Texture height-    -> IO (Either TextureException Texture)+    -> IO (Either SFException Texture)  createTexture w h =-    let err = TextureException "Failed creating texture"+    let err = SFException "Failed creating texture"     in fmap (tagErr err . checkNull) $ sfTexture_create (fromIntegral w) (fromIntegral h)  foreign import ccall unsafe "sfTexture_create"@@ -84,10 +76,10 @@ textureFromFile     :: FilePath -- ^ Path of the image file to load     -> Maybe IntRect  -- ^ Area of the source image to load ('Nothing' to load the entire image)-    -> IO (Either TextureException Texture)+    -> IO (Either SFException Texture)  textureFromFile path rect =-    let err = TextureException $ "Failed loading texture from file " ++ show path+    let err = SFException $ "Failed loading texture from file " ++ show path     in withCAString path $ \cpath ->        fmap (tagErr err . checkNull) $            case rect of@@ -107,10 +99,10 @@     :: Ptr a   -- ^ Pointer to the file data in memory     -> Int     -- ^ Size of the data to load, in bytes     -> Maybe IntRect -- ^ Area of the source image to load ('Nothing' to load the entire image)-    -> IO (Either TextureException Texture)+    -> IO (Either SFException Texture)  textureFromMemory pixels size rect =-    let err = TextureException $ "Failed creating texture from memory address " ++ show pixels+    let err = SFException $ "Failed creating texture from memory address " ++ show pixels     in fmap (tagErr err . checkNull) $ case rect of            Nothing -> sfTexture_createFromMemory pixels (fromIntegral size) nullPtr            Just r  -> with r $ sfTexture_createFromMemory pixels (fromIntegral size)@@ -127,10 +119,10 @@ textureFromStream     :: InputStream -- ^ Source stream to read from     -> Maybe IntRect     -- ^ Area of the source image to load ('Nothing' to load the entire image)-    -> IO (Either TextureException Texture)+    -> IO (Either SFException Texture)  textureFromStream stream rect =-    let err = TextureException $ "Failed creating texture from input stream " ++ show stream+    let err = SFException $ "Failed creating texture from input stream " ++ show stream     in fmap (tagErr err . checkNull) $        with stream $ \streamPtr ->        case rect of@@ -149,11 +141,11 @@ textureFromImage     :: Image -- ^ Image to upload to the texture     -> Maybe IntRect -- ^ Area of the source image to load ('Nothing' to load the entire image)-    -> IO (Either TextureException Texture)+    -> IO (Either SFException Texture)  textureFromImage image rect =     let (Image addr) = image-        err = TextureException $ "Failed creating texture from image " ++ show addr+        err = SFException $ "Failed creating texture from image " ++ show addr     in fmap (tagErr err . checkNull) $ case rect of            Nothing -> sfTexture_createFromImage image nullPtr            Just r  -> with r $ sfTexture_createFromImage image

@@ -25,6 +25,7 @@ import SFML.Graphics.Types import SFML.System.Vector2 +import Control.Applicative ((<$>), (<*>)) import Data.List (foldl') import Foreign.C.Types import Foreign.Storable@@ -35,28 +36,27 @@  -- | Encapsulate a 3x3 transform matrix. data Transform = Transform-    { m00 :: !Float, m10 :: !Float, m20 :: !Float-    , m01 :: !Float, m11 :: !Float, m21 :: !Float-    , m02 :: !Float, m12 :: !Float, m22 :: !Float+    { m00 :: Float, m10 :: Float, m20 :: Float+    , m01 :: Float, m11 :: Float, m21 :: Float+    , m02 :: Float, m12 :: Float, m22 :: Float     }   instance Storable Transform where     sizeOf _ = 9 * sizeFloat     alignment _ = alignment (undefined :: CFloat)-    -    peek ptr = do-        m00 <- fmap realToFrac $ (peekByteOff ptr 0 :: IO CFloat)-        m01 <- fmap realToFrac $ (peekByteOff ptr sizeFloat :: IO CFloat)-        m02 <- fmap realToFrac $ (peekByteOff ptr $ 2*sizeFloat :: IO CFloat)-        m10 <- fmap realToFrac $ (peekByteOff ptr $ 3*sizeFloat :: IO CFloat)-        m11 <- fmap realToFrac $ (peekByteOff ptr $ 4*sizeFloat :: IO CFloat)-        m12 <- fmap realToFrac $ (peekByteOff ptr $ 5*sizeFloat :: IO CFloat)-        m20 <- fmap realToFrac $ (peekByteOff ptr $ 6*sizeFloat :: IO CFloat)-        m21 <- fmap realToFrac $ (peekByteOff ptr $ 7*sizeFloat :: IO CFloat)-        m22 <- fmap realToFrac $ (peekByteOff ptr $ 8*sizeFloat :: IO CFloat)-        return $ Transform m00 m01 m02 m10 m11 m12 m20 m21 m22-    ++    peek ptr = Transform+            <$> fmap realToFrac (peekByteOff ptr 0 :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 2*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 3*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 4*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 5*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 6*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 7*sizeFloat :: IO CFloat)+            <*> fmap realToFrac (peekByteOff ptr $ 8*sizeFloat :: IO CFloat)+     poke ptr (Transform m00 m01 m02 m10 m11 m12 m20 m21 m22) = do         pokeByteOff ptr 0 (realToFrac m00 :: CFloat)         pokeByteOff ptr sizeFloat (realToFrac m01 :: CFloat)@@ -75,35 +75,35 @@             = Transform (a00 + b00) (a01 + b01) (a02 + b02)                         (a03 + b03) (a04 + b04) (a05 + b05)                         (a06 + b06) (a07 + b07) (a08 + b08)-    +     (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08)         - (Transform b00 b01 b02 b03 b04 b05 b06 b07 b08)             = Transform (a00 - b00) (a01 - b01) (a02 - b02)                         (a03 - b03) (a04 - b04) (a05 - b05)                         (a06 - b06) (a07 - b07) (a08 - b08)-    +     (Transform a00 a10 a20 a01 a11 a21 a02 a12 a22)         * (Transform b00 b10 b20 b01 b11 b21 b02 b12 b22)             = Transform (a00 * b00 + a10 * b01 + a20 * b02)                         (a00 * b10 + a10 * b11 + a20 * b12)                         (a00 * b20 + a10 * b21 + a20 * b22)-                        +                         (a01 * b00 + a11 * b01 + a21 * b02)                         (a01 * b10 + a11 * b11 + a21 * b12)                         (a01 * b20 + a11 * b21 + a21 * b22)-                        +                         (a02 * b00 + a12 * b01 + a22 * b02)                         (a02 * b10 + a12 * b11 + a22 * b12)                         (a02 * b20 + a12 * b21 + a22 * b22)-    +     abs (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08) =         (Transform (abs a00) (abs a01) (abs a02) (abs a03)             (abs a04) (abs a05) (abs a06) (abs a07) (abs a08))-    +     signum (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08) =         (Transform (signum a00) (signum a01) (signum a02) (signum a03)             (signum a04) (signum a05) (signum a06) (signum a07) (signum a08))-    +     fromInteger i = Transform i' i' i' i' i' i' i' i' i' where i' = fromInteger i  @@ -288,12 +288,12 @@         p1@(Vec2f p1x p1y) = transformPoint transf (Vec2f l $ t + h)         p2@(Vec2f p2x p2y) = transformPoint transf (Vec2f (l + w) t)         p3@(Vec2f p3x p3y) = transformPoint transf (Vec2f (l + w) (t + h))-        +         left   = p0x;         top    = p0y;         right  = p0x;         bottom = p0y;-        +         l' = min p3x $ min p2x $ min p1x p0x         t' = min p3y $ min p2y $ min p1y p0y         r' = max p3x $ max p2x $ max p1x p0x

@@ -1,93 +0,0 @@-module SFML.Graphics.Transformable-where---import SFML.Graphics.Transform-import SFML.System.Vector2---class Transformable a where-    -    -- | Set the position of a transformable.-    ---    -- This function completely overwrites the previous position.-    ---    -- See 'move' to apply an offset based on the previous position instead.-    ---    -- The default position of a transformable object is (0, 0).-    setPosition :: a -> Vec2f -> IO ()-    -    -- | Set the orientation of a transformable.-    ---    -- This function completely overwrites the previous rotation.-    ---    -- See 'rotate' to add an angle based on the previous rotation instead.-    ---    -- The default rotation of a transformable Transformable object is 0.-    setRotation-        :: a-        -> Float -- ^ New rotation, in degrees-        -> IO ()-    -    -- | Set the scale factors of a transformable.-    ---    -- This function completely overwrites the previous scale.-    ---    -- See 'scale' to add a factor based on the previous scale instead.-    ---    -- The default scale of a transformable Transformable object is (1, 1).-    setScale :: a -> Vec2f -> IO ()-    -    -- | Set the local origin of a transformable.-    ---    -- The origin of an object defines the center point for-    -- all transformations (position, scale, rotation).-    ---    -- The coordinates of this point must be relative to the-    -- top-left corner of the object, and ignore all-    -- transformations (position, scale, rotation).-    ---    -- The default origin of a transformable Transformable object is (0, 0).-    setOrigin :: a -> Vec2f -> IO ()-    -    -- | Get the position of a transformable.-    getPosition :: a -> IO Vec2f-    -    -- | Get the orientation of a transformable.-    getRotation-        :: a-        -> IO Float -- ^ Current rotation, in degrees-    -    -- | Get the current scale of a transformable-    getScale :: a -> IO Vec2f-    -    -- | Get the local origin of a transformable.-    getOrigin :: a -> IO Vec2f-    -    -- | Move a transformable by a given offset-    ---    -- This function adds to the current position of the object,-    -- unlike 'setPosition' which overwrites it.-    move :: a -> Vec2f -> IO ()-    -    -- | Rotate a transformable.-    ---    -- This function adds to the current rotation of the object,-    -- unlike 'setRotation' which overwrites it.-    rotate-        :: a-        -> Float -- ^ Angle of rotation, in degrees-        -> IO ()-    -    -- | Scale a transformable.-    ---    -- This function multiplies the current scale of the object,-    -- unlike 'setScale' which overwrites it.-    scale :: a -> Vec2f -> IO ()-    -    -- | Get the combined transform of a transformable.-    getTransform :: a -> IO Transform-    -    -- | Get the inverse of the combined transform of a transformable.-    getInverseTransform :: a -> IO Transform-

@@ -2,7 +2,7 @@ where  -import Foreign.C.Types (CInt)+import Foreign.C.Types (CIntPtr) import Foreign.Ptr import Foreign.Storable @@ -24,16 +24,16 @@   instance Storable Texture where-    sizeOf _ = sizeOf (undefined :: CInt)-    alignment _ = alignment (undefined :: CInt)+    sizeOf _ = sizeOf (undefined :: CIntPtr)+    alignment _ = alignment (undefined :: CIntPtr)          peek ptr = peek (castPtr ptr) >>= return . Texture     poke ptr (Texture p) = poke (castPtr ptr) p   instance Storable Shader where-    sizeOf _ = sizeOf (undefined :: CInt)-    alignment _ = alignment (undefined :: CInt)+    sizeOf _ = sizeOf (undefined :: CIntPtr)+    alignment _ = alignment (undefined :: CIntPtr)          peek ptr = peek (castPtr ptr) >>= return . Shader     poke ptr (Shader p) = poke (castPtr ptr) p

@@ -9,6 +9,7 @@ import SFML.Graphics.Color import SFML.System.Vector2 +import Control.Applicative ((<$>), (<*>)) import Foreign.C.Types (CFloat) import Foreign.Storable @@ -27,13 +28,12 @@ instance Storable Vertex where     sizeOf _ = size_sfVertex     alignment _ = alignment (undefined :: CFloat)-    -    peek ptr = do-        pos <- #{peek sfVertex, position} ptr-        col <- #{peek sfVertex, color} ptr-        tex <- #{peek sfVertex, texCoords} ptr-        return $ Vertex pos col tex-    ++    peek ptr = Vertex+            <$> #{peek sfVertex, position} ptr+            <*> #{peek sfVertex, color} ptr+            <*> #{peek sfVertex, texCoords} ptr+     poke ptr (Vertex pos col tex) = do         #{poke sfVertex, position} ptr pos         #{poke sfVertex, color} ptr col

@@ -0,0 +1,9 @@+{-# LANGUAGE DeriveDataTypeable #-}
+module SFML.SFException where
+
+import Control.Exception
+import Data.Typeable
+
+data SFException = SFException String deriving (Show, Typeable)
+
+instance Exception SFException

@@ -10,6 +10,7 @@ where  +import Control.Applicative ((<$>), (<*>)) import Data.Word (Word64) import Foreign.C.Types (CInt) import Foreign.Ptr (Ptr)@@ -55,15 +56,14 @@ instance Storable InputStream where     sizeOf _ = size_InputStream     alignment _ = alignment (undefined :: CInt)-    -    peek ptr = do-        read  <- #{peek sfInputStream, read} ptr-        seek  <- #{peek sfInputStream, seek} ptr-        tell  <- #{peek sfInputStream, tell} ptr-        gets  <- #{peek sfInputStream, getSize} ptr-        udata <- #{peek sfInputStream, userData} ptr-        return $ InputStream read seek tell gets udata-    ++    peek ptr = InputStream+            <$> #{peek sfInputStream, read} ptr+            <*> #{peek sfInputStream, seek} ptr+            <*> #{peek sfInputStream, tell} ptr+            <*> #{peek sfInputStream, getSize} ptr+            <*> #{peek sfInputStream, userData} ptr+     poke ptr (InputStream read seek tell gets udata) = do         #{poke sfInputStream, read} ptr read         #{poke sfInputStream, seek} ptr seek@@ -76,7 +76,7 @@   instance Show InputStream where-    +     show (InputStream read seek tell getSize userData) =         "InputStream { read = " ++ show read ++                     ", seek = " ++ show seek ++

@@ -8,6 +8,7 @@ where  +import Control.Applicative ((<$>), (<*>)) import Data.Word import Foreign.C.Types import Foreign.Storable@@ -25,12 +26,11 @@ instance Storable Vec2i where     sizeOf _ = 2*sizeInt     alignment _ = alignment (undefined :: CInt)-    -    peek ptr = do-        x <- #{peek sfVector2i, x} ptr :: IO CInt-        y <- #{peek sfVector2i, y} ptr :: IO CInt-        return $ Vec2i (fromIntegral x) (fromIntegral y)-    ++    peek ptr = Vec2i+            <$> fmap fromIntegral (#{peek sfVector2i, x} ptr :: IO CInt)+            <*> fmap fromIntegral (#{peek sfVector2i, y} ptr :: IO CInt)+     poke ptr (Vec2i x y) = do         #{poke sfVector2i, x} ptr (fromIntegral x :: CInt)         #{poke sfVector2i, y} ptr (fromIntegral y :: CInt)@@ -51,12 +51,11 @@ instance Storable Vec2u where     sizeOf _ = 2*sizeInt     alignment _ = alignment (undefined :: CUInt)-    -    peek ptr = do-        x <- #{peek sfVector2u, x} ptr :: IO CUInt-        y <- #{peek sfVector2u, y} ptr :: IO CUInt-        return $ Vec2u (fromIntegral x) (fromIntegral y)-    ++    peek ptr = Vec2u+            <$> fmap fromIntegral (#{peek sfVector2u, x} ptr :: IO CUInt)+            <*> fmap fromIntegral (#{peek sfVector2u, y} ptr :: IO CUInt)+     poke ptr (Vec2u x y) = do         #{poke sfVector2u, x} ptr (fromIntegral x :: CUInt)         #{poke sfVector2u, y} ptr (fromIntegral y :: CUInt)@@ -77,12 +76,11 @@ instance Storable Vec2f where     sizeOf _ = 2*sizeFloat     alignment _ = alignment (undefined :: CFloat)-    -    peek ptr = do-        x <- fmap realToFrac (#{peek sfVector2f, x} ptr :: IO CFloat)-        y <- fmap realToFrac (#{peek sfVector2f, y} ptr :: IO CFloat)-        return $ Vec2f x y-    ++    peek ptr = Vec2f+            <$> fmap realToFrac (#{peek sfVector2f, x} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfVector2f, y} ptr :: IO CFloat)+     poke ptr (Vec2f x y) = do         #{poke sfVector2f, x} ptr (realToFrac x :: CFloat)         #{poke sfVector2f, y} ptr (realToFrac y :: CFloat)

@@ -6,6 +6,7 @@ where  +import Control.Applicative ((<$>), (<*>)) import Foreign.C.Types import Foreign.Storable @@ -21,13 +22,12 @@ instance Storable Vec3f where     sizeOf _ = 3*sizeFloat     alignment _ = alignment (undefined :: CFloat)-    -    peek ptr = do-        x <- fmap realToFrac (#{peek sfVector3f, x} ptr :: IO CFloat)-        y <- fmap realToFrac (#{peek sfVector3f, y} ptr :: IO CFloat)-        z <- fmap realToFrac (#{peek sfVector3f, z} ptr :: IO CFloat)-        return $ Vec3f x y z-    ++    peek ptr = Vec3f+            <$> fmap realToFrac (#{peek sfVector3f, x} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfVector3f, y} ptr :: IO CFloat)+            <*> fmap realToFrac (#{peek sfVector3f, z} ptr :: IO CFloat)+     poke ptr (Vec3f x y z) = do         #{poke sfVector3f, x} ptr (realToFrac x :: CFloat)         #{poke sfVector3f, y} ptr (realToFrac y :: CFloat)

@@ -2,10 +2,13 @@ module SFML.Window.ContextSettings (     ContextSettings(..)+,   ContextAttribute(..) ) where  +import Control.Applicative ((<$>), (<*>))+import Data.Word (Word32) import Foreign.C.Types import Foreign.Storable @@ -13,7 +16,7 @@ #include <SFML/Window/Window.h>  -sizeInt = #{size int}+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)   data ContextSettings = ContextSettings@@ -22,27 +25,51 @@     , antialiasingLevel :: Int -- ^ Level of antialiasing     , majorVersion      :: Int -- ^ Major number of the context version to create     , minorVersion      :: Int -- ^ Minor number of the context version to create+    , attributeFlags    :: [ContextAttribute] -- ^ The attribute flags to create the context with     }     deriving (Show)   instance Storable ContextSettings where-    sizeOf _ = 5*sizeInt-    alignment _ = alignment (undefined :: CUInt)-    -    peek ptr = do-        db <- #{peek sfContextSettings, depthBits} ptr :: IO CInt-        sb <- #{peek sfContextSettings, stencilBits} ptr :: IO CInt-        al <- #{peek sfContextSettings, antialiasingLevel} ptr :: IO CInt-        ma <- #{peek sfContextSettings, majorVersion} ptr :: IO CInt-        mi <- #{peek sfContextSettings, minorVersion} ptr :: IO CInt-        return $ ContextSettings (fromIntegral db) (fromIntegral sb) (fromIntegral al)-            (fromIntegral ma) (fromIntegral mi)-    -    poke ptr (ContextSettings db sb al ma mi) = do+    sizeOf _ = #{size sfContextSettings}+    alignment _ = #{alignment sfContextSettings}++    peek ptr = ContextSettings+            <$> fmap fromIntegral (#{peek sfContextSettings, depthBits} ptr :: IO CInt)+            <*> fmap fromIntegral (#{peek sfContextSettings, stencilBits} ptr :: IO CInt)+            <*> fmap fromIntegral (#{peek sfContextSettings, antialiasingLevel} ptr :: IO CInt)+            <*> fmap fromIntegral (#{peek sfContextSettings, majorVersion} ptr :: IO CInt)+            <*> fmap fromIntegral (#{peek sfContextSettings, minorVersion} ptr :: IO CInt)+            <*> fmap (toFlags . fromIntegral) (#{peek sfContextSettings, attributeFlags} ptr :: IO Word32)++    poke ptr (ContextSettings db sb al ma mi af) = do         #{poke sfContextSettings, depthBits} ptr (fromIntegral db :: CInt)         #{poke sfContextSettings, stencilBits} ptr (fromIntegral sb :: CInt)         #{poke sfContextSettings, antialiasingLevel} ptr (fromIntegral al :: CInt)         #{poke sfContextSettings, majorVersion} ptr (fromIntegral ma :: CInt)         #{poke sfContextSettings, minorVersion} ptr (fromIntegral mi :: CInt)+        #{poke sfContextSettings, attributeFlags} ptr ((fromIntegral . fromFlags) af :: Word32) ++data ContextAttribute+    = ContextDefault -- ^ Non-debug, compatibility context (this and the core attribute are mutually exclusive)+    | ContextCore    -- ^ Core attribute+    | ContextDebug   -- ^ Debug attribute+    deriving (Eq, Show)+++instance Enum ContextAttribute where++    fromEnum ContextDefault = 0+    fromEnum ContextCore    = 1+    fromEnum ContextDebug   = 2++    toEnum 0 = ContextDefault+    toEnum 1 = ContextCore+    toEnum 2 = ContextDebug++fromFlags :: [ContextAttribute] -> Int+fromFlags = sum . map fromEnum++toFlags :: Int -> [ContextAttribute]+toFlags = return . toEnum

@@ -10,6 +10,7 @@ import SFML.Window.Keyboard import SFML.Window.Mouse +import Control.Applicative ((<$>), (<*>)) import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Array@@ -45,10 +46,16 @@     , sys   :: Bool     }     | SFEvtMouseWheelMoved-    { delta :: Int-    , x     :: Int-    , y     :: Int+    { moveDelta :: Int+    , x         :: Int+    , y         :: Int     }+    | SFEvtMouseWheelScrolled+    { wheel       :: MouseWheel+    , scrollDelta :: Float+    , x           :: Int+    , y           :: Int+    }     | SFEvtMouseButtonPressed     { button :: MouseButton     , x      :: Int@@ -84,6 +91,7 @@     | SFEvtJoystickDisconnected     { joystickId :: Int     }+    deriving (Eq, Show)   sizeInt = #{size int}@@ -93,7 +101,7 @@ instance Storable SFEvent where     sizeOf _ = #{size sfEvent}     alignment _ = alignment (undefined :: CInt)-    +     peek ptr' =         let ptr'' = castPtr ptr' :: Ptr CInt         in do@@ -101,65 +109,58 @@             eventType <- peek ptr'' :: IO CInt             case eventType of                 0  -> return SFEvtClosed-                1  -> do-                    w <- #{peek sfSizeEvent, width} ptr  :: IO CUInt-                    h <- #{peek sfSizeEvent, height} ptr :: IO CUInt-                    return $ SFEvtResized (fromIntegral w) (fromIntegral h)+                1  -> SFEvtResized+                   <$> fmap fromIntegral (#{peek sfSizeEvent, width}  ptr :: IO CUInt)+                   <*> fmap fromIntegral (#{peek sfSizeEvent, height} ptr :: IO CUInt)                 2  -> return SFEvtLostFocus                 3  -> return SFEvtGainedFocus                 4  -> peekCAString (plusPtr ptr sizeInt) >>= return . SFEvtTextEntered-                5  -> do-                    code  <- #{peek sfKeyEvent, code} ptr-                    alt   <- #{peek sfKeyEvent, alt} ptr :: IO CInt-                    ctrl  <- #{peek sfKeyEvent, control} ptr :: IO CInt-                    shift <- #{peek sfKeyEvent, shift} ptr :: IO CInt-                    sys   <- #{peek sfKeyEvent, system} ptr :: IO CInt-                    return $ SFEvtKeyPressed code (toEnum . fromIntegral $ alt) (toEnum . fromIntegral $ ctrl)-                               (toEnum . fromIntegral $ shift) (toEnum . fromIntegral $ sys)-                6  -> do-                    code  <- #{peek sfKeyEvent, code} ptr-                    alt   <- #{peek sfKeyEvent, alt} ptr :: IO CInt-                    ctrl  <- #{peek sfKeyEvent, control} ptr :: IO CInt-                    shift <- #{peek sfKeyEvent, shift} ptr :: IO CInt-                    sys   <- #{peek sfKeyEvent, system} ptr :: IO CInt-                    return $ SFEvtKeyReleased code (toEnum . fromIntegral $ alt) (toEnum . fromIntegral $ ctrl)-                               (toEnum . fromIntegral $ shift) (toEnum . fromIntegral $ sys)-                7  -> do-                    delta <- #{peek sfMouseWheelEvent, delta} ptr :: IO CInt-                    x     <- #{peek sfMouseWheelEvent, x} ptr :: IO CInt-                    y     <- #{peek sfMouseWheelEvent, y} ptr :: IO CInt-                    return $ SFEvtMouseWheelMoved (fromIntegral delta) (fromIntegral x) (fromIntegral y)-                8  -> do-                    button <- #{peek sfMouseButtonEvent, button} ptr-                    x      <- #{peek sfMouseButtonEvent, x} ptr :: IO CInt-                    y      <- #{peek sfMouseButtonEvent, y} ptr :: IO CInt-                    return $ SFEvtMouseButtonPressed button (fromIntegral x) (fromIntegral y)-                9  -> do-                    button <- #{peek sfMouseButtonEvent, button} ptr-                    x      <- #{peek sfMouseButtonEvent, x} ptr :: IO CInt-                    y      <- #{peek sfMouseButtonEvent, y} ptr :: IO CInt-                    return $ SFEvtMouseButtonReleased button (fromIntegral x) (fromIntegral y)-                10 -> do-                    x <- #{peek sfMouseMoveEvent, x} ptr :: IO CInt-                    y <- #{peek sfMouseMoveEvent, y} ptr :: IO CInt-                    return $ SFEvtMouseMoved (fromIntegral x) (fromIntegral y)-                11 -> return SFEvtMouseEntered-                12 -> return SFEvtMouseLeft-                13 -> do-                    j  <- #{peek sfJoystickButtonEvent, joystickId} ptr :: IO CUInt-                    bt <- #{peek sfJoystickButtonEvent, button} ptr :: IO CUInt-                    return $ SFEvtJoystickButtonPressed (fromIntegral j) (fromIntegral bt)-                14 -> do-                    j  <- #{peek sfJoystickButtonEvent, joystickId} ptr :: IO CUInt-                    bt <- #{peek sfJoystickButtonEvent, button} ptr :: IO CUInt-                    return $ SFEvtJoystickButtonReleased (fromIntegral j) (fromIntegral bt)-                15 -> do-                    j    <- #{peek sfJoystickMoveEvent, joystickId} ptr :: IO CUInt-                    axis <- #{peek sfJoystickMoveEvent, axis} ptr-                    pos  <- fmap realToFrac (#{peek sfJoystickMoveEvent, position} ptr :: IO CFloat)-                    return $ SFEvtJoystickMoved (fromIntegral j) axis pos-                16 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickConnected-                17 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickDisconnected-    +                5  -> SFEvtKeyPressed+                   <$> #{peek sfKeyEvent, code} ptr+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, alt} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, control} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, shift} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, system} ptr :: IO CInt)+                6  -> SFEvtKeyReleased+                   <$> #{peek sfKeyEvent, code} ptr+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, alt} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, control} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, shift} ptr :: IO CInt)+                   <*> fmap (toEnum . fromIntegral) (#{peek sfKeyEvent, system} ptr :: IO CInt)+                7  -> SFEvtMouseWheelMoved+                   <$> fmap fromIntegral (#{peek sfMouseWheelEvent, delta} ptr :: IO CInt)+                   <*> fmap fromIntegral (#{peek sfMouseWheelEvent, x} ptr :: IO CInt)+                   <*> fmap fromIntegral (#{peek sfMouseWheelEvent, y} ptr :: IO CInt)+                8 -> SFEvtMouseWheelScrolled+                  <$> (#{peek sfMouseWheelScrollEvent, wheel} ptr :: IO MouseWheel)+                  <*> fmap realToFrac   (#{peek sfMouseWheelScrollEvent, delta} ptr :: IO CFloat)+                  <*> fmap fromIntegral (#{peek sfMouseWheelScrollEvent, x} ptr :: IO CInt)+                  <*> fmap fromIntegral (#{peek sfMouseWheelScrollEvent, y} ptr :: IO CInt)+                9  -> SFEvtMouseButtonPressed+                   <$> #{peek sfMouseButtonEvent, button} ptr+                   <*> fmap fromIntegral (#{peek sfMouseButtonEvent, x} ptr :: IO CInt)+                   <*> fmap fromIntegral (#{peek sfMouseButtonEvent, y} ptr :: IO CInt)+                10 -> SFEvtMouseButtonReleased+                   <$> #{peek sfMouseButtonEvent, button} ptr+                   <*> fmap fromIntegral (#{peek sfMouseButtonEvent, x} ptr :: IO CInt)+                   <*> fmap fromIntegral (#{peek sfMouseButtonEvent, y} ptr :: IO CInt)+                11 -> SFEvtMouseMoved+                   <$> fmap fromIntegral (#{peek sfMouseMoveEvent, x} ptr :: IO CInt)+                   <*> fmap fromIntegral (#{peek sfMouseMoveEvent, y} ptr :: IO CInt)+                12 -> return SFEvtMouseEntered+                13 -> return SFEvtMouseLeft+                14 -> SFEvtJoystickButtonPressed+                   <$> fmap fromIntegral (#{peek sfJoystickButtonEvent, joystickId} ptr :: IO CUInt)+                   <*> fmap fromIntegral (#{peek sfJoystickButtonEvent, button} ptr :: IO CUInt)+                15 -> SFEvtJoystickButtonReleased+                   <$> fmap fromIntegral (#{peek sfJoystickButtonEvent, joystickId} ptr :: IO CUInt)+                   <*> fmap fromIntegral (#{peek sfJoystickButtonEvent, button} ptr :: IO CUInt)+                16 -> SFEvtJoystickMoved+                   <$> fmap fromIntegral (#{peek sfJoystickMoveEvent, joystickId} ptr :: IO CUInt)+                   <*> #{peek sfJoystickMoveEvent, axis} ptr+                   <*> fmap realToFrac (#{peek sfJoystickMoveEvent, position} ptr :: IO CFloat)+                17 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickConnected+                18 -> peekByteOff ptr sizeInt >>= return . SFEvtJoystickDisconnected+     poke ptr evt = return () 

@@ -8,12 +8,16 @@ ,   hasAxis ,   isJoystickButtonPressed ,   getAxisPosition+,   getJoystickIdentification ,   updateJoystick ) where  +import SFML.Window.JoystickIdentification+ import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca) import Foreign.Storable import Foreign.Ptr (Ptr, castPtr) @@ -27,11 +31,11 @@   instance Enum JoystickCap where-    +     fromEnum JoystickCount       = 8     fromEnum JoystickButtonCount = 32     fromEnum JoystickAxisCount   = 8-    +     toEnum 8  = JoystickCount     toEnum 32 = JoystickButtonCount     --toEnum 8  = JoystickAxisCount@@ -56,7 +60,7 @@ instance Storable JoystickAxis where     sizeOf _ = sizeInt     alignment _ = alignment (undefined :: CInt)-    +     peek ptr = peek (castPtr ptr :: Ptr CInt) >>= return . toEnum . fromIntegral     poke ptr bt = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ bt) @@ -135,6 +139,23 @@     sfJoystick_getAxisPosition :: CUInt -> CUInt -> IO CFloat  --CSFML_WINDOW_API float sfJoystick_getAxisPosition(unsigned int joystick, sfJoystickAxis axis);+++-- | Get the joystick information.+--+-- The result of this function will only remain valid until+-- the next time the function is called.+getJoystickIdentification+    :: Int -- ^ Index of the joystick+    -> IO JoystickIdentification++getJoystickIdentification j+    = alloca $ \ptr -> sfJoystick_getIdentification_helper (fromIntegral j) ptr >> peek ptr++foreign import ccall unsafe "sfJoystick_getIdentification_helper"+    sfJoystick_getIdentification_helper :: CUInt -> Ptr JoystickIdentification -> IO ()++--CSFML_WINDOW_API sfJoystickIdentification sfJoystick_getIdentification(unsigned int joystick);   -- | Update the states of all joysticks.

@@ -0,0 +1,41 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+module SFML.Window.JoystickIdentification+(+    JoystickIdentification(..)+)+where+++import Control.Applicative ((<$>), (<*>))+import Foreign.C.String+import Foreign.C.Types+import Foreign.Storable+import Foreign.Ptr (Ptr, castPtr)++#include <SFML/Window/JoystickIdentification.h>+++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)+++-- | Joystick's identification+data JoystickIdentification = JoystickIdentification+    { name      :: String+    , vendorId  :: Int+    , productId :: Int+    } deriving (Eq, Show)+++instance Storable JoystickIdentification where+    sizeOf _ = #{size sfJoystickIdentification}+    alignment _ = #{alignment sfJoystickIdentification}++    peek ptr = JoystickIdentification+            <$> (#{peek sfJoystickIdentification, name} ptr >>= peekCString)+            <*> fmap fromIntegral (#{peek sfJoystickIdentification, vendorId} ptr :: IO CUInt)+            <*> fmap fromIntegral (#{peek sfJoystickIdentification, productId} ptr :: IO CUInt)++    poke ptr ji = do+        withCString (name ji) $ #{poke sfJoystickIdentification, name} ptr+        #{poke sfJoystickIdentification, vendorId}  ptr ((fromIntegral . vendorId)  ji :: CUInt)+        #{poke sfJoystickIdentification, productId} ptr ((fromIntegral . productId) ji :: CUInt)

@@ -2,6 +2,7 @@ module SFML.Window.Mouse (     MouseButton(..)+,   MouseWheel(..) ,   isMouseButtonPressed ) where@@ -15,7 +16,12 @@ import Foreign.Ptr import Foreign.Storable +#include <SFML/Window/Mouse.h> ++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)++ data MouseButton     = MouseLeft     | MouseRight@@ -25,13 +31,24 @@     deriving (Eq, Enum, Bounded, Show)  -sizeInt = #{size int}+data MouseWheel+    = MouseVerticalWheel   -- ^ The vertical mouse wheel+    | MouseHorizontalWheel -- ^ The horizontal mouse wheel+    deriving (Eq, Enum, Bounded, Show)  +instance Storable MouseWheel where+    sizeOf _ = #{size sfMouseWheel}+    alignment _ = #{alignment sfMouseWheel}++    peek ptr = peek (castPtr ptr :: Ptr CInt) >>= return . toEnum . fromIntegral+    poke ptr mw = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ mw)++ instance Storable MouseButton where-    sizeOf _ = sizeInt-    alignment _ = alignment (undefined :: CInt)-    +    sizeOf _ = #{size sfMouseButton}+    alignment _ = #{alignment sfMouseButton}+     peek ptr = peek (castPtr ptr :: Ptr CInt) >>= return . toEnum . fromIntegral     poke ptr bt = poke (castPtr ptr :: Ptr CInt) (fromIntegral . fromEnum $ bt) 

@@ -124,6 +124,23 @@     -- Only one window can be active on a thread at a time, thus     -- the window previously active (if any) automatically gets deactivated.     setWindowActive :: a -> Bool -> IO ()+    +    -- | Request the current window to be made the active foreground window.+    --+    -- At any given time, only one window may have the input focus+    -- to receive input events such as keystrokes or mouse events.+    -- If a window requests focus, it only hints to the operating+    -- system, that it would like to be focused. The operating system+    -- is free to deny the request.+    -- This is not to be confused with 'setWindowActive'.+    requestFocus :: a -> IO ()+    +    -- | Check whether the render window has the input focus.+    --+    -- At any given time, only one window may have the input focus+    -- to receive input events such as keystrokes or most mouse+    -- events.+    hasFocus :: a -> IO Bool              -- | Limit the framerate to a maximum fixed frequency.     --

@@ -9,7 +9,7 @@ where  -import Control.Applicative+import Control.Applicative ((<$>), (<*>), (*>), liftA2) import Foreign.C.Types import Foreign.Ptr import Foreign.Marshal.Alloc (alloca)@@ -34,13 +34,12 @@ instance Storable VideoMode where     sizeOf _ = 3*sizeInt     alignment _ = alignment (undefined :: CInt)-    -    peek ptr = do-        w <- #{peek sfVideoMode, width} ptr :: IO CUInt-        h <- #{peek sfVideoMode, height} ptr :: IO CUInt-        b <- #{peek sfVideoMode, bitsPerPixel} ptr :: IO CUInt-        return $ VideoMode (fromIntegral w) (fromIntegral h) (fromIntegral b)-    ++    peek ptr = VideoMode+        <$> fmap fromIntegral (#{peek sfVideoMode, width} ptr :: IO CUInt)+        <*> fmap fromIntegral (#{peek sfVideoMode, height} ptr :: IO CUInt)+        <*> fmap fromIntegral (#{peek sfVideoMode, bitsPerPixel} ptr :: IO CUInt)+     poke ptr (VideoMode w h b) = do         #{poke sfVideoMode, width} ptr (fromIntegral w :: CUInt)         #{poke sfVideoMode, height} ptr (fromIntegral h :: CUInt)

@@ -22,6 +22,8 @@ ,   setVSync ,   setKeyRepeat ,   setWindowActive+,   requestFocus+,   hasFocus ,   display ,   setFramerateLimit ,   setJoystickThreshold@@ -32,6 +34,7 @@ where  +import Control.Applicative ((<$>), (<*>)) import SFML.SFDisplayable import SFML.SFResource import SFML.System.Vector2@@ -65,14 +68,14 @@   instance Enum WindowStyle where-    +     fromEnum SFNone         = 0     fromEnum SFTitlebar     = 1     fromEnum SFResize       = 2     fromEnum SFClose        = 4     fromEnum SFFullscreen   = 8     fromEnum SFDefaultStyle = 7-    +     toEnum 0 = SFNone     toEnum 1 = SFTitlebar     toEnum 2 = SFResize@@ -80,7 +83,6 @@     toEnum 8 = SFFullscreen     toEnum 7 = SFDefaultStyle - -- | Construct a new window. -- -- This function creates the window with the size and pixel@@ -140,7 +142,7 @@   instance SFResource Window where-    +     {-# INLINABLE destroy #-}     destroy = sfWindow_destroy @@ -151,25 +153,25 @@   instance SFDisplayable Window where-    +     {-# INLINABLE display #-}     display = sfWindow_display   instance SFWindow Window where-    +     {-# INLINABLE close #-}     close = sfWindow_close-    +     {-# INLINABLE isWindowOpen #-}     isWindowOpen wnd = sfWindow_isOpen wnd >>= return . (/=0)-    +     {-# INLINABLE getWindowSettings #-}     getWindowSettings wnd =         alloca $ \ptrCtxSettings -> do         sfWindow_getSettings_helper wnd ptrCtxSettings         peek ptrCtxSettings-    +     {-# INLINABLE pollEvent #-}     pollEvent wnd =         alloca $ \ptrEvt -> do@@ -177,7 +179,7 @@         case result of             True  -> peek ptrEvt >>= return . Just             False -> return Nothing-    +     {-# INLINABLE waitEvent #-}     waitEvent wnd =         alloca $ \ptr -> do@@ -185,53 +187,59 @@         case result of             0 -> return Nothing             _ -> peek ptr >>= return . Just-    +     {-# INLINABLE getWindowPosition #-}     getWindowPosition wnd = alloca $ \vecPtr -> sfWindow_getPosition_helper wnd vecPtr >> peek vecPtr-    +     {-# INLINABLE setWindowPosition #-}     setWindowPosition wnd pos = with pos $ \posPtr -> sfWindow_setPosition_helper wnd posPtr-    +     {-# INLINABLE getWindowSize #-}     getWindowSize wnd = alloca $ \vecPtr -> sfWindow_getSize_helper wnd vecPtr >> peek vecPtr-    +     {-# INLINABLE setWindowSize #-}     setWindowSize wnd size = with size $ \ptrSize -> sfWindow_setSize_helper wnd ptrSize-    +     {-# INLINABLE setWindowTitle #-}     setWindowTitle wnd title = withCAString title $ \ptrTitle -> sfWindow_setTitle wnd ptrTitle-    +     {-# INLINABLE setWindowIcon #-}     setWindowIcon = sfWindow_setIcon-    +     {-# INLINABLE setWindowVisible #-}     setWindowVisible wnd val = sfWindow_setVisible wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setMouseVisible #-}     setMouseVisible wnd val = sfWindow_setMouseCursorVisible wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setVSync #-}     setVSync wnd val = sfWindow_setVerticalSyncEnabled wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setKeyRepeat #-}     setKeyRepeat wnd val = sfWindow_setKeyRepeatEnabled wnd (fromIntegral . fromEnum $ val)-    +     {-# INLINABLE setWindowActive #-}     setWindowActive wnd val = sfWindow_setActive wnd (fromIntegral . fromEnum $ val)-    ++    {-# INLINABLE requestFocus #-}+    requestFocus wnd = sfWindow_requestFocus wnd++    {-# INLINABLE hasFocus #-}+    hasFocus wnd = ((/=0) . fromIntegral) <$> sfWindow_hasFocus wnd+     {-# INLINABLE setFramerateLimit #-}     setFramerateLimit wnd val = sfWindow_setFramerateLimit wnd (fromIntegral val)-    +     {-# INLINABLE setJoystickThreshold #-}     setJoystickThreshold w t = sfWindow_setJoystickThreshold w (realToFrac t)-    +     {-# INLINABLE getSystemHandle #-}     getSystemHandle = sfWindow_getSystemHandle-    +     {-# INLINABLE getMousePosition #-}     getMousePosition Nothing    = alloca $ \ptr -> sfMouse_getPosition_helper (Window nullPtr) ptr >> peek ptr     getMousePosition (Just wnd) = alloca $ \ptr -> sfMouse_getPosition_helper wnd ptr >> peek ptr-    +     {-# INLINABLE setMousePosition #-}     setMousePosition pos Nothing    = with pos $ \ptr -> sfMouse_setPosition_helper ptr (Window nullPtr)     setMousePosition pos (Just wnd) = with pos $ \ptr -> sfMouse_setPosition_helper ptr wnd@@ -307,29 +315,43 @@  --CSFML_WINDOW_API void sfWindow_setVisible(sfWindow* window, sfBool visible); + foreign import ccall unsafe "sfWindow_setMouseCursorVisible"     sfWindow_setMouseCursorVisible :: Window -> CChar -> IO ()  --CSFML_WINDOW_API void sfWindow_setMouseCursorVisible(sfWindow* window, sfBool visible); + foreign import ccall unsafe "sfWindow_setVerticalSyncEnabled"     sfWindow_setVerticalSyncEnabled :: Window -> CChar -> IO ()  --CSFML_WINDOW_API void sfWindow_setVerticalSyncEnabled(sfWindow* window, sfBool enabled);  +foreign import ccall unsafe "sfWindow_setKeyRepeatEnabled"+    sfWindow_setKeyRepeatEnabled :: Window -> CChar -> IO ()++--CSFML_WINDOW_API void sfWindow_setKeyRepeatEnabled(sfWindow* window, sfBool enabled);++ foreign import ccall unsafe "sfWindow_setActive"     sfWindow_setActive :: Window -> CChar -> IO ()  --CSFML_WINDOW_API sfBool sfWindow_setActive(sfWindow* window, sfBool active);  -foreign import ccall unsafe "sfWindow_setKeyRepeatEnabled"-    sfWindow_setKeyRepeatEnabled :: Window -> CChar -> IO ()+foreign import ccall unsafe "sfWindow_requestFocus"+    sfWindow_requestFocus :: Window -> IO () ---CSFML_WINDOW_API void sfWindow_setKeyRepeatEnabled(sfWindow* window, sfBool enabled);+-- CSFML_WINDOW_API void sfWindow_requestFocus(sfWindow* window);  +foreign import ccall unsafe "sfWindow_hasFocus"+    sfWindow_hasFocus :: Window -> IO CInt++--CSFML_WINDOW_API sfBool sfWindow_hasFocus(const sfWindow* window);++ foreign import ccall unsafe "sfWindow_display"     sfWindow_display :: Window -> IO () @@ -347,6 +369,7 @@  --CSFML_WINDOW_API void sfWindow_setJoystickThreshold(sfWindow* window, float threshold); + foreign import ccall unsafe "sfWindow_getSystemHandle"     sfWindow_getSystemHandle :: Window -> IO WindowHandle @@ -358,8 +381,8 @@  --CSFML_WINDOW_API sfVector2i sfMouse_getPosition(const sfWindow* relativeTo); + foreign import ccall unsafe "sfMouse_setPosition_helper"     sfMouse_setPosition_helper :: Ptr Vec2i -> Window -> IO ()  --CSFML_WINDOW_API void sfMouse_setPosition(sfVector2i position, const sfWindow* relativeTo);-