Permalink
Browse files

fixed dragging (added case for mousebutton release)

  • Loading branch information...
1 parent a4cf1ea commit 12425e70e6b4ea16ab8c5f3d350eb61571fb810b Nik Nyby committed Mar 4, 2010
Showing with 69 additions and 64 deletions.
  1. +1 −0 .gitignore
  2. +28 −24 Bindings.hs
  3. +40 −40 Main.hs
View
@@ -2,3 +2,4 @@
*.o
mma
*.swp
+\#*\#
View
@@ -10,29 +10,29 @@ 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
{-
- - keyboar/mouse buttons
+ - keyboard/mouse buttons
-}
introAction :: Env -> Key -> KeyState -> Env
@@ -47,20 +47,24 @@ animatorAction e (MouseButton RightButton) Down =
-- start dragging a sprite
animatorAction e (MouseButton LeftButton) Down =
- if length spritesWithin > 0
- then e { sprites =
- (toggleSticky selected) : (delete selected (sprites e))
- }
- else e
+ if length spritesWithin > 0
+ then e { sprites =
+ (toggleSticky selected) : (delete selected (sprites e))
+ }
+ else e
where
- pos :: Position
- pos = (mousePos $ vars $ e)
+ pos :: Position
+ pos = (mousePos $ vars $ e)
- selected :: Sprite
- selected = head spritesWithin
+ selected :: Sprite
+ selected = head spritesWithin
+
+ spritesWithin :: [Sprite]
+ spritesWithin = filter (within pos) (sprites e)
+
+animatorAction e (MouseButton LeftButton) Up =
+ Env (vars e) $ map (\s -> s {sticky = False}) (sprites e)
- spritesWithin :: [Sprite]
- spritesWithin = filter (within pos) (sprites e)
animatorAction e _ _ = e
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

0 comments on commit 12425e7

Please sign in to comment.