Permalink
Browse files

added selection

  • Loading branch information...
1 parent 0480755 commit 729ff4b0ba341d78efde6bc7a05c03380d239c28 Nik Nyby committed Mar 23, 2010
Showing with 25 additions and 9 deletions.
  1. +17 −3 Bindings.hs
  2. +0 −1 Main.hs
  3. +8 −5 Sprite.hs
View
@@ -45,20 +45,34 @@ animatorAction :: Env -> Key -> KeyState -> Env
animatorAction e (MouseButton RightButton) Down =
e { sprites = (makeSprite (mousePos $ vars $ e)) : sprites e }
-
animatorAction e (MouseButton LeftButton) Down =
- e { sprites = (map (selectSprite mp) spritesUnder ++ theRest) }
+ e { sprites = (map (initDragSprite mp) spritesUnder ++ theRest) }
where
+ -- TODO: just look at this mess!
mp :: Position
mp = mousePos $ vars $ e
spritesUnder :: [Sprite]
spritesUnder = filter (within mp) (sprites e)
+ theRest :: [Sprite]
theRest = (sprites e) \\ spritesUnder
animatorAction e (MouseButton LeftButton) Up =
- Env (vars e) $ map (\s -> s {sticky = False}) (sprites e)
+ Env (vars e) $ unsticky $ (map (\s -> s{selected=True}) spritesUnder
+ ++ map (\s -> s{selected=False}) theRest)
+ where
+ mp :: Position
+ mp = mousePos $ vars $ e
+
+ spritesUnder :: [Sprite]
+ spritesUnder = filter (within mp) (sprites e)
+
+ theRest :: [Sprite]
+ theRest = (sprites e) \\ spritesUnder
+
+ unsticky :: [Sprite] -> [Sprite]
+ unsticky = map (\s -> s {sticky = False})
animatorAction e _ _ = e
View
@@ -28,7 +28,6 @@ main = do
clear [ColorBuffer, DepthBuffer]
e <- readIORef env
drawWorld e textures
- --readIORef env >>= drawWorld
flush
swapBuffers)
View
@@ -3,7 +3,7 @@ module Sprite (
Rectangle(..),
makeSprite,
spritePoints,
- selectSprite,
+ initDragSprite,
dragSprite,
within,
@@ -20,6 +20,8 @@ data Sprite =
spritePath :: [Position],
-- is it being dragged?
sticky :: Bool,
+ -- is it selected?
+ selected :: Bool,
-- mouse offset for dragging
offset :: Pos
} deriving (Show, Eq)
@@ -35,13 +37,14 @@ data Rectangle =
makeSprite :: Position -> Sprite
makeSprite (Position x y) =
- Sprite (Rectangle (conv x) (conv y) 20 20) [] False (0,0)
+ Sprite (Rectangle (conv x) (conv y) 20 20) [] False False (0,0)
spritePoints :: Sprite -> [Vertex2 GLdouble]
spritePoints s = vertexRect (rectangle s)
-selectSprite :: Position -> Sprite -> Sprite
-selectSprite offs s =
+-- start dragging a sprite
+initDragSprite :: Position -> Sprite -> Sprite
+initDragSprite offs s =
s { sticky = True, offset = posOp (-) myPos (posConv offs) }
where
myPos = ( (rectX$rectangle$s),(rectY$rectangle$s) )
@@ -59,7 +62,7 @@ dragSprite p s =
-- returns True if the point lies within the sprite's area
within :: Position -> Sprite -> Bool
-within (Position px py) (Sprite (Rectangle rx ry rw rh) _ _ _) =
+within (Position px py) (Sprite (Rectangle rx ry rw rh) _ _ _ _) =
(x <= (rx+(rw/2))) && (x >= (rx-(rw/2)))
&& (y <= (ry+(rh/2))) && (y >= (ry-(rh/2)))
where

0 comments on commit 729ff4b

Please sign in to comment.