run ormolu formatterHEADmaster

1 files changed, 106 insertions, 97 deletions

diff --git a/Graphics/SDL/SDLHelp.hs b/Graphics/SDL/SDLHelp.hs
index 72159d1..40ce820 100644
--- a/Graphics/SDL/SDLHelp.hs
+++ b/Graphics/SDL/SDLHelp.hs
@@ -1,34 +1,37 @@
-{-# LANGUAGE OverloadedStrings, LambdaCase, ViewPatterns, RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+
 module Graphics.SDL.SDLHelp where
 
-import Data.Word
 import Control.Monad
-import Graphics.Glyph.Util
-
-import SDL as SDL
-import SDL.Video.Renderer (SurfacePixelFormat(..))
-
+import Data.Bits
+import Data.Word
+import Foreign.Ptr
+import Foreign.Storable
 import Graphics.GL.Compatibility30
+import Graphics.Glyph.Util
 import Graphics.Rendering.OpenGL as GL
-
-import Foreign.Storable
-import Foreign.Ptr
-import Data.Bits
-
-import System.IO.Unsafe
-import System.Endian
-import System.Exit
+import SDL as SDL
 import SDL.Raw (getSurfaceColorMod)
 import qualified SDL.Raw.Types
+import SDL.Video.Renderer (SurfacePixelFormat (..))
+import System.Endian
+import System.Exit
+import System.IO.Unsafe
 
-data TextureData = TextureData {
-    textureSize :: (Int,Int),
-    textureObject :: TextureObject } deriving Show
-
-data TextureData3D = TextureData3D {
-    textureSize3D :: (Int,Int,Int),
-    textureObject3D :: TextureObject } deriving Show
+data TextureData = TextureData
+  { textureSize :: (Int, Int),
+    textureObject :: TextureObject
+  }
+  deriving (Show)
 
+data TextureData3D = TextureData3D
+  { textureSize3D :: (Int, Int, Int),
+    textureObject3D :: TextureObject
+  }
+  deriving (Show)
 
 bindSurfaceToTexture :: SDL.Surface -> TextureObject -> IO TextureData
 bindSurfaceToTexture surf to = do
@@ -43,74 +46,76 @@ bindSurfaceToTexture surf to = do
     fi :: (Integral a, Integral b) => a -> b
     fi = fromIntegral
 
-textureFromPointer3D :: Ptr Word8 -> (Int,Int,Int) -> TextureObject -> IO TextureData3D
-textureFromPointer3D ptr (w,h,d) to = do
-        textureBinding Texture3D $= Just to
-        glTexImage3D GL_TEXTURE_3D 0 3 (f w) (f h) (f d) 0 GL_RGB GL_UNSIGNED_BYTE ptr
-        return $ TextureData3D (w,h,d) to
-    where f = fromIntegral
+textureFromPointer3D :: Ptr Word8 -> (Int, Int, Int) -> TextureObject -> IO TextureData3D
+textureFromPointer3D ptr (w, h, d) to = do
+  textureBinding Texture3D $= Just to
+  glTexImage3D GL_TEXTURE_3D 0 3 (f w) (f h) (f d) 0 GL_RGB GL_UNSIGNED_BYTE ptr
+  return $ TextureData3D (w, h, d) to
+  where
+    f = fromIntegral
 
 textureFromSurface :: SDL.Surface -> IO TextureData
 textureFromSurface surf = makeTexture >>= (bindSurfaceToTexture surf >=> return)
 
 makeTexture3D :: IO TextureObject
 makeTexture3D = do
-    texobj <- liftM head $ genObjectNames 1
-    textureBinding Texture3D $= Just texobj
-    textureFilter Texture3D $= ((Linear', Nothing), Linear')
-    return texobj
+  texobj <- liftM head $ genObjectNames 1
+  textureBinding Texture3D $= Just texobj
+  textureFilter Texture3D $= ((Linear', Nothing), Linear')
+  return texobj
 
 makeTexture :: IO TextureObject
 makeTexture = do
-    texobj <- liftM head $ genObjectNames 1
-    textureBinding Texture2D $= Just texobj
-    textureFilter Texture2D $= ((Linear', Nothing), Linear')
-    return texobj
+  texobj <- liftM head $ genObjectNames 1
+  textureBinding Texture2D $= Just texobj
+  textureFilter Texture2D $= ((Linear', Nothing), Linear')
+  return texobj
 
 getPixel :: Int -> Int -> SDL.Surface -> IO Word32
 getPixel x y surf = do
-    bpp <- fromIntegral <$> getSurfaceBytesPerPixel surf
-    ptr <- (surfacePixels surf >>= return.castPtr) :: IO (Ptr Word8)
-    (V2 w h) <- SDL.surfaceDimensions surf
-    let newPtr = ptr `plusPtr` (y * bpp * fromIntegral w) `plusPtr` (x * bpp)
-    
-    ret <- case bpp of
-        -- bytes = R G B A
-        1 -> liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word8)
-        2 -> liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word16)
-        3 -> do
-            ord1 <- liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word16)
-            ord2 <- liftM fromIntegral $ peek (castPtr (newPtr `plusPtr` 2) :: Ptr Word8)
-            return $ ((ord1 `shiftL` 16) + (ord2 `shiftL` 8)) + 0xFF
-        4 -> do
-            liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word32)
-        _ -> error "Unrecognized format"
-
-    return $ toBE32 ret
+  bpp <- fromIntegral <$> getSurfaceBytesPerPixel surf
+  ptr <- (surfacePixels surf >>= return . castPtr) :: IO (Ptr Word8)
+  (V2 w h) <- SDL.surfaceDimensions surf
+  let newPtr = ptr `plusPtr` (y * bpp * fromIntegral w) `plusPtr` (x * bpp)
+
+  ret <- case bpp of
+    -- bytes = R G B A
+    1 -> liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word8)
+    2 -> liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word16)
+    3 -> do
+      ord1 <- liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word16)
+      ord2 <- liftM fromIntegral $ peek (castPtr (newPtr `plusPtr` 2) :: Ptr Word8)
+      return $ ((ord1 `shiftL` 16) + (ord2 `shiftL` 8)) + 0xFF
+    4 -> do
+      liftM fromIntegral $ peek (castPtr newPtr :: Ptr Word32)
+    _ -> error "Unrecognized format"
+
+  return $ toBE32 ret
 
 getPixelUnsafe :: Int -> Int -> SDL.Surface -> Word32
 getPixelUnsafe x y surf = unsafePerformIO $ getPixel x y surf
 
 rgbToWord :: Word8 -> Word8 -> Word8 -> Word32
 rgbToWord r g b =
-    let tW32 x = (fromIntegral x) :: Word32 in
-    ( (tW32 r) `shiftL` 24) +
-    ( (tW32 g) `shiftL` 16) +
-    ( (tW32 b) `shiftL`  8) +
-    0xFF 
+  let tW32 x = (fromIntegral x) :: Word32
+   in ((tW32 r) `shiftL` 24)
+        + ((tW32 g) `shiftL` 16)
+        + ((tW32 b) `shiftL` 8)
+        + 0xFF
 
 wordToPixel :: Word32 -> Color4 Word8
 wordToPixel word =
-        Color4 (fromIntegral $ word .&. 0xFF)
-               (fromIntegral $ (word `shiftR` 8) .&. 0xFF)
-               (fromIntegral $ (word `shiftR` 16) .&. 0xFF)
-               (fromIntegral $ (word `shiftR` 24) .&. 0xFF)
+  Color4
+    (fromIntegral $ word .&. 0xFF)
+    (fromIntegral $ (word `shiftR` 8) .&. 0xFF)
+    (fromIntegral $ (word `shiftR` 16) .&. 0xFF)
+    (fromIntegral $ (word `shiftR` 24) .&. 0xFF)
 
 getRGBA :: SDL.Surface -> Int -> Int -> IO (Color4 Word8)
 getRGBA surf x y = liftM wordToPixel $ getPixel x y surf
 
-simpleStartup :: String -> (Int,Int) -> IO SDL.Window
-simpleStartup name' (w,h) = do
+simpleStartup :: String -> (Int, Int) -> IO SDL.Window
+simpleStartup name' (w, h) = do
   SDL.initialize [SDL.InitVideo]
   SDL.HintRenderScaleQuality $= SDL.ScaleLinear
   renderQuality <- SDL.get SDL.HintRenderScaleQuality
@@ -131,47 +136,51 @@ simpleStartup name' (w,h) = do
 
 defaultReshape :: Int -> Int -> a -> IO a
 defaultReshape w h ret = do
-    let size = Size (fromIntegral w) (fromIntegral h)
-    viewport $=(Position 0 0, size)
-    -- _ <- SDL.setVideoMode w h 32 [SDL.OpenGL, SDL.Resizable, SDL.DoubleBuf]
-    return ret
+  let size = Size (fromIntegral w) (fromIntegral h)
+  viewport $= (Position 0 0, size)
+  -- _ <- SDL.setVideoMode w h 32 [SDL.OpenGL, SDL.Resizable, SDL.DoubleBuf]
+  return ret
 
 startPipeline :: forall a. (Int -> Int -> a -> IO a) -> (SDL.EventPayload -> a -> IO a) -> (a -> IO a) -> (a -> IO a) -> a -> IO ()
 startPipeline reshapeH eventH displayH updateH ini = do
-    let pumpEvents' res = do
-          evs <- SDL.pollEvents
-          foldM (\res (SDL.eventPayload -> ev) -> case ev of
-            SDL.QuitEvent -> exitSuccess >> return res
-            _ -> eventH ev res) res evs
-          -- case ev of
-          --     Quit -> do
-          --         putStrLn "Exit event."
-          --         exitSuccess
-          --     SDL.NoEvent -> return res
-          --     VideoResize w h -> reshapeH w h res >>= pumpEvents'
-          --     _ -> eventH ev res >>= pumpEvents'
-        runPipeline val = do
-            res <- pumpEvents' val >>= displayH
-            updateH res >>= runPipeline
-
-    -- -- TODO unhardcode this
-    reshapeH 1920 1080 ini >>= runPipeline
+  let pumpEvents' res = do
+        evs <- SDL.pollEvents
+        foldM
+          ( \res (SDL.eventPayload -> ev) -> case ev of
+              SDL.QuitEvent -> exitSuccess >> return res
+              _ -> eventH ev res
+          )
+          res
+          evs
+      -- case ev of
+      --     Quit -> do
+      --         putStrLn "Exit event."
+      --         exitSuccess
+      --     SDL.NoEvent -> return res
+      --     VideoResize w h -> reshapeH w h res >>= pumpEvents'
+      --     _ -> eventH ev res >>= pumpEvents'
+      runPipeline val = do
+        res <- pumpEvents' val >>= displayH
+        updateH res >>= runPipeline
+
+  -- -- TODO unhardcode this
+  reshapeH 1920 1080 ini >>= runPipeline
 
 setupTexturing :: TextureData -> UniformLocation -> Int -> IO ()
 setupTexturing (TextureData _ to) tu unit = do
-    texture Texture2D $= Enabled
-    activeTexture $= TextureUnit (fromIntegral unit)
-    textureBinding Texture2D $= Just to
-    uniform tu $= Index1 (fromIntegral unit::GLint)
+  texture Texture2D $= Enabled
+  activeTexture $= TextureUnit (fromIntegral unit)
+  textureBinding Texture2D $= Just to
+  uniform tu $= Index1 (fromIntegral unit :: GLint)
 
 setupTexturing3D :: TextureData3D -> UniformLocation -> Int -> IO ()
 setupTexturing3D (TextureData3D _ to) tu unit = do
-    texture Texture3D $= Enabled
-    activeTexture $= TextureUnit (fromIntegral unit)
-    textureBinding Texture3D $= Just to
-    uniform tu $= Index1 (fromIntegral unit::GLint)
+  texture Texture3D $= Enabled
+  activeTexture $= TextureUnit (fromIntegral unit)
+  textureBinding Texture3D $= Just to
+  uniform tu $= Index1 (fromIntegral unit :: GLint)
 
 getSurfaceBytesPerPixel :: SDL.Surface -> IO Word8
 getSurfaceBytesPerPixel (SDL.Surface ptr _) = do
-  SDL.Raw.Types.pixelFormatBytesPerPixel <$>
-    (peek . SDL.Raw.Types.surfaceFormat =<< peek ptr)
+  SDL.Raw.Types.pixelFormatBytesPerPixel
+    <$> (peek . SDL.Raw.Types.surfaceFormat =<< peek ptr)