Permalink
Browse files

tabs -> spaces :S

  • Loading branch information...
1 parent fec2d5a commit a4cf1ea1032186a420ee83046e836dc6b9c1e276 nik committed Mar 4, 2010
Showing with 234 additions and 235 deletions.
  1. +37 −37 Bindings.hs
  2. +51 −51 Graphics.hs
  3. +40 −40 Main.hs
  4. +15 −16 Render.hs
  5. +28 −28 Sprite.hs
  6. +62 −62 State.hs
  7. +1 −1 Util.hs
View
@@ -1,6 +1,6 @@
module Bindings (
- keyboardMouse,
- motion,
+ keyboardMouse,
+ motion,
) where
import Data.IORef
import Data.List (delete)
@@ -10,25 +10,25 @@ import State
import Sprite
keyboardMouse _ env key state modifiers pos = do
- e <- get env
+ e <- get env
- let
- dispatchAction = case (mode $ vars $ e) of
- Intro -> introAction
- Animator -> animatorAction
+ let
+ dispatchAction = case (mode $ vars $ e) of
+ Intro -> introAction
+ Animator -> animatorAction
- env $= dispatchAction e key state
+ env $= dispatchAction e key state
motion :: IORef Env -> Position -> IO ()
motion env pos = do
- e <- get env
+ e <- get env
- let
- dispatchMotion = case (mode $ vars $ e) of
- Intro -> introMotion
- Animator -> animatorMotion
+ let
+ dispatchMotion = case (mode $ vars $ e) of
+ Intro -> introMotion
+ Animator -> animatorMotion
- env $= dispatchMotion e pos
+ env $= dispatchMotion e pos
{-
@@ -37,30 +37,30 @@ motion env pos = do
introAction :: Env -> Key -> KeyState -> Env
introAction (Env v s) (MouseButton _) Down =
- Env (v {mode = Animator}) s
+ Env (v {mode = Animator}) s
introAction e _ _ = e
animatorAction :: Env -> Key -> KeyState -> Env
-- place a sprite
animatorAction e (MouseButton RightButton) Down =
- e { sprites = (makeSprite (mousePos $ vars $ e)) : sprites e }
+ e { sprites = (makeSprite (mousePos $ vars $ e)) : sprites e }
-- start dragging a sprite
animatorAction e (MouseButton LeftButton) Down =
- if length spritesWithin > 0
- then e { sprites =
- (toggleSticky selected) : (delete selected (sprites e))
- }
- else e
- where
- pos :: Position
- pos = (mousePos $ vars $ e)
-
- selected :: Sprite
- selected = head spritesWithin
-
- spritesWithin :: [Sprite]
- spritesWithin = filter (within pos) (sprites e)
+ if length spritesWithin > 0
+ then e { sprites =
+ (toggleSticky selected) : (delete selected (sprites e))
+ }
+ else e
+ where
+ pos :: Position
+ pos = (mousePos $ vars $ e)
+
+ selected :: Sprite
+ selected = head spritesWithin
+
+ spritesWithin :: [Sprite]
+ spritesWithin = filter (within pos) (sprites e)
animatorAction e _ _ = e
@@ -73,10 +73,10 @@ introMotion e _ = e
animatorMotion :: Env -> Position -> Env
animatorMotion (Env v s) pos = Env v{mousePos = pos}
- $ map updateSprite s
- where
- -- drag a sprite
- updateSprite q =
- if sticky q
- then q{ currentPos = pos }
- else q
+ $ map updateSprite s
+ where
+ -- drag a sprite
+ updateSprite q =
+ if sticky q
+ then q{ currentPos = pos }
+ else q
View
@@ -1,11 +1,11 @@
module Graphics (
- glRunAs2D,
- loadAllTextures,
+ glRunAs2D,
+ loadAllTextures,
- loadTexture,
- freeTexture,
- drawTexture,
- drawTextureFlip,
+ loadTexture,
+ freeTexture,
+ drawTexture,
+ drawTextureFlip,
) where
import Control.Monad
@@ -19,78 +19,78 @@ import Util
glRunAs2D :: IO () -> IO ()
glRunAs2D draw = do
- matrixMode $= Modelview 0
- loadIdentity
+ matrixMode $= Modelview 0
+ loadIdentity
- matrixMode $= Projection
- loadIdentity
+ matrixMode $= Projection
+ loadIdentity
- (_, Size w h) <- get viewport
+ (_, Size w h) <- get viewport
- ortho 0 (conv w) 0 (conv h) (-1000) 1000
+ ortho 0 (conv w) 0 (conv h) (-1000) 1000
- preservingMatrix draw
+ preservingMatrix draw
loadTexture :: String -> IO MmaTexture
loadTexture filepath = do
- surface <- SDLImage.loadTyped filepath SDLImage.PNG
+ surface <- SDLImage.loadTyped filepath SDLImage.PNG
- let width = fromIntegral (surfaceGetWidth surface)
- let height = fromIntegral (surfaceGetHeight surface)
- let surfaceSize = TextureSize2D width height
+ let width = fromIntegral (surfaceGetWidth surface)
+ let height = fromIntegral (surfaceGetHeight surface)
+ let surfaceSize = TextureSize2D width height
- textureObj <- liftM head (genObjectNames 1)
- textureBinding Texture2D $= Just textureObj
- textureWrapMode Texture2D S $= (Repeated, Repeat)
- textureWrapMode Texture2D T $= (Repeated, Repeat)
- textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
- surfacePixels <- surfaceGetPixels surface
+ textureObj <- liftM head (genObjectNames 1)
+ textureBinding Texture2D $= Just textureObj
+ textureWrapMode Texture2D S $= (Repeated, Repeat)
+ textureWrapMode Texture2D T $= (Repeated, Repeat)
+ textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
+ surfacePixels <- surfaceGetPixels surface
- let pixelData = PixelData RGBA UnsignedByte surfacePixels
- texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData
+ let pixelData = PixelData RGBA UnsignedByte surfacePixels
+ texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData
- freeSurface surface
+ freeSurface surface
- return (MmaTexture width height textureObj)
+ return (MmaTexture width height textureObj)
loadAllTextures :: IO MmaTextures
loadAllTextures = do
- introtex <- loadTexture "intro.png"
- playtex <- loadTexture "play.png"
+ introtex <- loadTexture "intro.png"
+ playtex <- loadTexture "play.png"
- return ( MmaTextures {
- introTexture = introtex,
- playTexture = playtex
- } )
+ return ( MmaTextures {
+ introTexture = introtex,
+ playTexture = playtex
+ } )
freeTexture :: MmaTexture -> IO ()
freeTexture tex = do
- deleteObjectNames ([textureObject tex])
+ deleteObjectNames ([textureObject tex])
drawTexture :: GLdouble -> GLdouble -> MmaTexture -> GLdouble -> IO ()
drawTexture x y tex alpha = do
- drawTextureFlip x y tex alpha False
+ drawTextureFlip x y tex alpha False
drawTextureFlip :: GLdouble -> GLdouble -> MmaTexture -> GLdouble -> Bool -> IO ()
drawTextureFlip x y tex alpha flp = do
- texture Texture2D $= Enabled
- textureBinding Texture2D $= Just (textureObject tex)
+ texture Texture2D $= Enabled
+ textureBinding Texture2D $= Just (textureObject tex)
- let
- texWidth = fromIntegral $ textureWidth tex
- texHeight = fromIntegral $ textureHeight tex
+ let
+ texWidth = fromIntegral $ textureWidth tex
+ texHeight = fromIntegral $ textureHeight tex
- texCoord2f = texCoord :: TexCoord2 GLdouble -> IO ()
- vertex3f = vertex :: Vertex3 GLdouble -> IO ()
- color4f = color :: Color4 GLdouble -> IO ()
- col = color4f (Color4 (1.0::GLdouble) (1.0::GLdouble) (1.0::GLdouble) alpha)
+ texCoord2f = texCoord :: TexCoord2 GLdouble -> IO ()
+ vertex3f = vertex :: Vertex3 GLdouble -> IO ()
+ color4f = color :: Color4 GLdouble -> IO ()
+ col = color4f (Color4 (1.0::GLdouble) (1.0::GLdouble) (1.0::GLdouble) alpha)
- texCoordX = if flp then (-1) else 1
+ texCoordX = if flp then (-1) else 1
- renderPrimitive Quads $ do
- texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 x y 0.0); col
- texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 x (y + texHeight) 0.0); col
- texCoord2f (TexCoord2 texCoordX 0); vertex3f (Vertex3 (x + texWidth) (y + texHeight) 0.0); col
- texCoord2f (TexCoord2 texCoordX 1); vertex3f (Vertex3 (x + texWidth) y 0.0); col
+ renderPrimitive Quads $ do
+ texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 x y 0.0); col
+ texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 x (y + texHeight) 0.0); col
+ texCoord2f (TexCoord2 texCoordX 0); vertex3f (Vertex3 (x + texWidth) (y + texHeight) 0.0); col
+ texCoord2f (TexCoord2 texCoordX 1); vertex3f (Vertex3 (x + texWidth) y 0.0); col
- texture Texture2D $= Disabled
+ texture Texture2D $= Disabled
View
80 Main.hs
@@ -9,58 +9,58 @@ import Util
main :: IO ()
main = do
- -- make pointer to world state
- env <- newIORef initialEnvironment
+ -- make pointer to world state
+ env <- newIORef initialEnvironment
- -- make the GL window
- initialWindowSize $= Size 640 480
- (_,_) <- getArgsAndInitialize
- initialDisplayMode $= [DoubleBuffered]
- wnd <- createWindow "Marlon Moonglow's Animator"
+ -- make the GL window
+ initialWindowSize $= Size 640 480
+ (_,_) <- getArgsAndInitialize
+ initialDisplayMode $= [DoubleBuffered]
+ wnd <- createWindow "Marlon Moonglow's Animator"
- -- textures need to be in the IO monad, so they aren't part of the Env
- -- textures <- initTextures
- textures <- loadAllTextures
+ -- textures need to be in the IO monad, so they aren't part of the Env
+ -- textures <- initTextures
+ textures <- loadAllTextures
- -- set up callbacks
- displayCallback $= (glRunAs2D $ do
- clearColor $= Color4 1 0 1 1
- clear [ColorBuffer, DepthBuffer]
- e <- readIORef env
- drawWorld e textures
- --readIORef env >>= drawWorld
- flush
- swapBuffers)
+ -- set up callbacks
+ displayCallback $= (glRunAs2D $ do
+ clearColor $= Color4 1 0 1 1
+ clear [ColorBuffer, DepthBuffer]
+ e <- readIORef env
+ drawWorld e textures
+ --readIORef env >>= drawWorld
+ flush
+ swapBuffers)
- idleCallback $= Just (idle env)
+ idleCallback $= Just (idle env)
- let
- moveCursor p = do
- (Env v sp) <- readIORef env
- --print p
- writeIORef env $ Env v{mousePos = p} sp
- trans :: Position -> IO Position
- trans (Position x y) = do
- (_, Size _ h) <- get viewport
- return ( Position x (conv h - y) )
+ let
+ moveCursor p = do
+ (Env v sp) <- readIORef env
+ --print p
+ writeIORef env $ Env v{mousePos = p} sp
+ trans :: Position -> IO Position
+ trans (Position x y) = do
+ (_, Size _ h) <- get viewport
+ return ( Position x (conv h - y) )
- keyboardMouseCallback $= Just (keyboardMouse wnd env)
+ keyboardMouseCallback $= Just (keyboardMouse wnd env)
- motionCallback $= Just (\pos ->
- trans pos >>= motion env)
+ motionCallback $= Just (\pos ->
+ trans pos >>= motion env)
- passiveMotionCallback $= Just (\pos ->
- trans pos >>= moveCursor >> postRedisplay Nothing)
+ passiveMotionCallback $= Just (\pos ->
+ trans pos >>= moveCursor >> postRedisplay Nothing)
- mainLoop
- -- TODO: stop using all the CPU, silly!
+ mainLoop
+ -- TODO: stop using all the CPU, silly!
idle :: IORef Env -> IO ()
idle env = do
- e <- get env
- time <- get elapsedTime
- env $= tick time e
- postRedisplay Nothing
+ e <- get env
+ time <- get elapsedTime
+ env $= tick time e
+ postRedisplay Nothing
-- keep track of how much time has elapsed
tick :: Int -> Env -> Env
Oops, something went wrong.

0 comments on commit a4cf1ea

Please sign in to comment.