Permalink
Browse files

some progress on spritePath

  • Loading branch information...
1 parent fa60f7d commit d5872faa743307eb4440937d6d785f7987bd0021 Nik Nyby committed Apr 27, 2010
Showing with 73 additions and 44 deletions.
  1. +44 −27 Bindings.hs
  2. +4 −5 Render.hs
  3. +15 −10 Sprite.hs
  4. +10 −2 State.hs
View
@@ -12,14 +12,17 @@ import State
import Sprite
keyboardMouse :: Window -> IORef Env -> Key -> KeyState -> Modifiers -> Position
- -> IO ()
+ -> IO ()
keyboardMouse _ env key state _ _ = do
e <- get env
+ -- TODO: put these modes in different files, maybe
let
- dispatchAction = case (mode $ vars $ e) of
- Intro -> introAction
+ dispatchAction = case (mode$vars$e) of
Animator -> animatorAction
+ Intro -> introAction
+ Play -> playAction
+ Record -> recordAction
env $= dispatchAction e key state
@@ -28,9 +31,11 @@ motion env pos = do
e <- get env
let
- dispatchMotion = case (mode $ vars $ e) of
- Intro -> introMotion
+ dispatchMotion = case (mode$vars$e) of
Animator -> animatorMotion
+ Intro -> introMotion
+ Play -> playMotion
+ Record -> recordMotion
env $= dispatchMotion e pos
@@ -39,19 +44,22 @@ motion env pos = do
- keyboard/mouse buttons
-}
-introAction :: Env -> Key -> KeyState -> Env
-introAction (Env v s) (MouseButton _) Down =
- Env (v {mode = Animator}) s
-introAction e _ _ = e
-
-animatorAction :: Env -> Key -> KeyState -> Env
+animatorAction, introAction, playAction, recordAction :: 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)) { spritePath = mkPath } )
+ : sprites e }
+ where
+ -- Make the initial animation path for this sprite, using (1000,1000) as
+ -- a dummy value for "not visible"
+ mkPath :: [Position]
+ mkPath = replicate (animClock$vars$e) (Position 1000 1000) ++ [(mousePos$vars$e)]
animatorAction e (MouseButton LeftButton) Down =
+ --
+ -- TODO: just look at this mess!
+ --
e { sprites = (updateSelected . updateDragged) (sprites e),
-
-- TODO: map over MmaMenu?
vars = (vars e) { menu = MmaMenu {
playButton = updateButton $ (playButton$menu$vars$e),
@@ -72,11 +80,7 @@ animatorAction e (MouseButton LeftButton) Down =
}
}
}
-
where
- --
- -- TODO: just look at this mess!
- --
updateSelected :: [Sprite] -> [Sprite]
updateSelected ss = map (\s -> s {selected=True}) (spriteUnder ss) ++
map (\s -> s {selected=False}) (ss \\ (spriteUnder ss))
@@ -88,10 +92,6 @@ animatorAction e (MouseButton LeftButton) Down =
spriteUnder :: [Sprite] -> [Sprite]
spriteUnder ss = oneOrNone $ filter ((within mp) . rectangle) ss
- -- stupid... Maybe I should learn how to use Maybe?
- oneOrNone :: [a] -> [a]
- oneOrNone x = if length x >= 1 then [head x] else []
-
updateButton :: MmaButton -> MmaButton
updateButton b = b { buttonState = if within mp (buttonRect b)
then not $ buttonState b
@@ -100,6 +100,10 @@ animatorAction e (MouseButton LeftButton) Down =
updateWindow :: MmaWindow -> MmaWindow
updateWindow w = w
+ -- stupid... Maybe I should learn how to use Maybe?
+ oneOrNone :: [a] -> [a]
+ oneOrNone x = if length x >= 1 then [head x] else []
+
mp :: Position
mp = mousePos $ vars $ e
@@ -111,16 +115,29 @@ animatorAction e (MouseButton LeftButton) Up =
animatorAction e _ _ = e
+introAction (Env v s) (MouseButton _) Down =
+ Env (v {mode = Animator}) s
+introAction e _ _ = e
+
+playAction e _ _ = e
+
+recordAction e _ _ = e
{-
- - mouse motion
+ - mouse motion (mouse button held down)
-}
-introMotion :: Env -> Position -> Env
-introMotion e _ = e
-
-- drag a sprite
-animatorMotion :: Env -> Position -> Env
+animatorMotion, introMotion, playMotion, recordMotion :: Env -> Position -> Env
animatorMotion (Env v s) p =
-- update mouse position and any sticky sprites
- Env v{mousePos = p} $ map (dragSprite p) s
+ Env v{mousePos = p} $ map (\x -> if sticky x then dragSprite p x else x) s
+
+introMotion e _ = e
+
+playMotion e _ = e
+
+recordMotion (Env v s) p =
+ -- update mouse position and any sticky sprites
+ Env v{mousePos = p}
+ $ map (\x -> if sticky x then dragSpriteUpdatingPath p x else x) s
View
@@ -31,16 +31,15 @@ drawIntro e t = do
drawSprite :: Sprite -> IO ()
drawSprite s = do
- currentColor $= Color4 0.2 0 0.3 0
- renderPrimitive Quads $ mapM_ vertex $ spritePoints s
-
- -- TODO: why isn't this transparent?
if selected s
then do
- currentColor $= Color4 0.85 0 0.4 0.8
+ currentColor $= Color4 0.85 0 0.4 0
renderPrimitive Quads $ mapM_ vertex $ selectPoints s
else return ()
+ currentColor $= Color4 0.2 0 0.3 0
+ renderPrimitive Quads $ mapM_ vertex $ spritePoints s
+
-- TODO: is there a better way????
drawMenu :: MmaMenu -> MmaTextures -> IO ()
drawMenu m t = do
View
@@ -5,6 +5,7 @@ module Sprite (
selectPoints,
initDragSprite,
dragSprite,
+ dragSpriteUpdatingPath,
) where
import Graphics.UI.GLUT
@@ -14,12 +15,16 @@ import Util
data Sprite =
Sprite {
rectangle :: Rectangle,
+
-- recorded path
spritePath :: [Position],
+
-- is it being dragged?
sticky :: Bool,
+
-- is it selected?
selected :: Bool,
+
-- mouse offset for dragging
offset :: Pos
} deriving (Show, Eq)
@@ -33,7 +38,7 @@ spritePoints s = vertexRect $ rectangle s
-- calculate a rectangle around the sprite
selectPoints :: Sprite -> [Vertex2 GLdouble]
-selectPoints s = vertexRect $ boxAroundRect (rectangle s) 8.0
+selectPoints s = vertexRect $ boxAroundRect (rectangle s) 4.0
-- start dragging a sprite
initDragSprite :: Position -> Sprite -> Sprite
@@ -43,12 +48,12 @@ initDragSprite offs s =
myPos = ( (rectX$rectangle$s),(rectY$rectangle$s) )
dragSprite :: Position -> Sprite -> Sprite
-dragSprite p s =
- if sticky s
- then s{ rectangle = newRect }
- else s
- where
- newRect :: Rectangle
- newRect = (rectangle s){rectX = newX, rectY = newY}
-
- (newX,newY) = posOp (+) (posConv p) (offset s)
+dragSprite p s = s{ rectangle = newRect }
+ where
+ newRect :: Rectangle
+ newRect = (rectangle s){rectX = newX, rectY = newY}
+
+ (newX,newY) = posOp (+) (posConv p) (offset s)
+
+dragSpriteUpdatingPath :: Position -> Sprite -> Sprite
+dragSpriteUpdatingPath p s = dragSprite p s { spritePath = spritePath s ++ [p] }
View
@@ -19,6 +19,7 @@ initialEnvironment :: Env
initialEnvironment =
Env ( Vars {
clock = 0,
+ animClock = 0,
mousePos = Position 0 0,
menu = initialMenu,
mode = Intro }
@@ -27,11 +28,18 @@ initialEnvironment =
data Vars = Vars
{
+ -- the uptime
clock :: Int,
+
+ -- current position of the Animator's clock
+ animClock :: Int,
+
mousePos :: Position,
+
menu :: MmaMenu,
+
mode :: Mode
} deriving Show
-data Mode = Animator | Intro
- deriving (Show, Eq)
+data Mode = Animator | Intro | Play | Record
+ deriving (Show, Eq)

0 comments on commit d5872fa

Please sign in to comment.