Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fixed selection

  • Loading branch information...
commit e7decd32b396c9a65fe0739cd7096b8951b255bc 1 parent 729ff4b
Nik Nyby authored
Showing with 36 additions and 31 deletions.
  1. +22 −22 Bindings.hs
  2. +14 −9 Render.hs
View
44 Bindings.hs
@@ -37,42 +37,42 @@ 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 }
animatorAction e (MouseButton LeftButton) Down =
- e { sprites = (map (initDragSprite mp) spritesUnder ++ theRest) }
+ e { sprites = (updateSelected . updateDragged) (sprites e) }
where
-- TODO: just look at this mess!
- mp :: Position
- mp = mousePos $ vars $ e
+ updateSelected :: [Sprite] -> [Sprite]
+ --updateSelected ss = map (\s -> s {selected=True}) (spritesUnder ss)
+ -- ++ map (\s -> s {selected=False}) (theRest ss)
+ updateSelected ss = map (\s -> s {selected=True}) (spriteUnder ss) ++ map (\s -> s {selected=False}) (ss \\ (spriteUnder ss))
- spritesUnder :: [Sprite]
- spritesUnder = filter (within mp) (sprites e)
+ updateDragged :: [Sprite] -> [Sprite]
+ --updateDragged ss = map (initDragSprite mp) (spritesUnder ss) ++ (theRest ss)
+ updateDragged ss = map (initDragSprite mp) (spriteUnder ss) ++ (ss \\ spriteUnder ss)
- theRest :: [Sprite]
- theRest = (sprites e) \\ spritesUnder
-
-animatorAction e (MouseButton LeftButton) Up =
- Env (vars e) $ unsticky $ (map (\s -> s{selected=True}) spritesUnder
- ++ map (\s -> s{selected=False}) theRest)
- where
- mp :: Position
- mp = mousePos $ vars $ e
+ spriteUnder :: [Sprite] -> [Sprite]
+ spriteUnder ss = oneOrNone $ filter (within mp) ss
- spritesUnder :: [Sprite]
- spritesUnder = filter (within mp) (sprites e)
+ -- stupid... Maybe I should learn how to use Maybe?
+ oneOrNone :: [a] -> [a]
+ oneOrNone x = if length x >= 1 then [head x] else []
- theRest :: [Sprite]
- theRest = (sprites e) \\ spritesUnder
+ mp :: Position
+ mp = mousePos $ vars $ e
- unsticky :: [Sprite] -> [Sprite]
- unsticky = map (\s -> s {sticky = False})
+animatorAction e (MouseButton LeftButton) Up =
+ e { sprites = unsticky (sprites e) }
+ where
+ unsticky :: [Sprite] -> [Sprite]
+ unsticky = map (\s -> s {sticky = False})
animatorAction e _ _ = e
View
23 Render.hs
@@ -10,17 +10,17 @@ import Util
drawWorld :: Env -> MmaTextures -> IO ()
drawWorld e =
- case (mode $ vars $ e) of
- Intro -> do
- drawIntro e
- Animator -> do
- drawAnimator e
+ case (mode $ vars $ e) of
+ Intro -> do
+ drawIntro e
+ Animator -> do
+ drawAnimator e
drawAnimator :: Env -> MmaTextures -> IO ()
drawAnimator e t = do
- currentColor $= Color4 0.2 0 0.3 0
- mapM_ (drawSprite) $ sprites e
- drawMenu (menu $ vars $ e) t
+ --currentColor $= Color4 0.2 0 0.3 0
+ mapM_ (drawSprite) $ sprites e
+ drawMenu (menu $ vars $ e) t
drawIntro :: Env -> MmaTextures -> IO ()
drawIntro e t = do
@@ -32,7 +32,12 @@ drawIntro e t = do
drawSprite :: Sprite -> IO ()
-drawSprite s = renderPrimitive Quads $ mapM_ vertex $ spritePoints s
+drawSprite s = do
+ currentColor $= if selected s
+ then Color4 1 0.7 0.5 0
+ else Color4 0.2 0 0.3 0
+
+ renderPrimitive Quads $ mapM_ vertex $ spritePoints s
drawMenu :: MmaMenu -> MmaTextures -> IO ()
drawMenu m t = do
Please sign in to comment.
Something went wrong with that request. Please try again.