Permalink
Browse files

added menu texture, cleaned up sprite selection

  • Loading branch information...
1 parent 5d9cf92 commit 0480755057f7fff0e3354656850acbf2e407e52c Nik Nyby committed Mar 5, 2010
Showing with 26 additions and 29 deletions.
  1. +8 −19 Bindings.hs
  2. +3 −1 Graphics.hs
  3. +5 −7 Render.hs
  4. +7 −0 Sprite.hs
  5. +3 −2 State.hs
  6. BIN menu.png
View
@@ -3,12 +3,11 @@ module Bindings (
motion,
) where
import Data.IORef
-import Data.List (delete)
+import Data.List ((\\))
import Graphics.UI.GLUT
import State
import Sprite
-import Util
keyboardMouse _ env key state modifiers pos = do
e <- get env
@@ -46,27 +45,17 @@ animatorAction :: Env -> Key -> KeyState -> Env
animatorAction e (MouseButton RightButton) Down =
e { sprites = (makeSprite (mousePos $ vars $ e)) : sprites e }
--- start dragging a sprite
+
animatorAction e (MouseButton LeftButton) Down =
- if length spritesWithin > 0
- then e { sprites =
- (selected{ sticky = not (sticky selected),
- offset = posOp (-) selectedPos (posConv pos)
- }) : (delete selected (sprites e))
- }
- else e
+ e { sprites = (map (selectSprite mp) spritesUnder ++ theRest) }
where
- pos :: Position
- pos = (mousePos $ vars $ e)
-
- selected :: Sprite
- selected = head spritesWithin
+ mp :: Position
+ mp = mousePos $ vars $ e
- selectedPos :: Pos
- selectedPos = ( (rectX$rectangle$selected),(rectY$rectangle$selected) )
+ spritesUnder :: [Sprite]
+ spritesUnder = filter (within mp) (sprites e)
- spritesWithin :: [Sprite]
- spritesWithin = filter (within pos) (sprites e)
+ theRest = (sprites e) \\ spritesUnder
animatorAction e (MouseButton LeftButton) Up =
Env (vars e) $ map (\s -> s {sticky = False}) (sprites e)
View
@@ -57,10 +57,12 @@ loadAllTextures :: IO MmaTextures
loadAllTextures = do
introtex <- loadTexture "intro.png"
playtex <- loadTexture "play.png"
+ menutex <- loadTexture "menu.png"
return ( MmaTextures {
introTexture = introtex,
- playTexture = playtex
+ playTexture = playtex,
+ menuTexture = menutex
} )
freeTexture :: MmaTexture -> IO ()
View
@@ -20,27 +20,25 @@ drawAnimator :: Env -> MmaTextures -> IO ()
drawAnimator e t = do
currentColor $= Color4 0.2 0 0.3 0
mapM_ (drawSprite) $ sprites e
- --currentColor $= Color4 0.8 0.1 0.65 0
drawMenu (menu $ vars $ e) t
drawIntro :: Env -> MmaTextures -> IO ()
drawIntro e t = do
(_, Size _ h) <- get viewport
let y = conv $ (conv h) -
(((clock $ vars $ e) `div` 10) `mod` (conv h*2))
+ drawTexture 0 0 (introTexture t) 0.25
drawTexture 0 y (introTexture t) 1
drawSprite :: Sprite -> IO ()
drawSprite s = renderPrimitive Quads $ mapM_ vertex $ spritePoints s
drawMenu :: MmaMenu -> MmaTextures -> IO ()
---drawMenu _ = mapM_ drawButton [0..5]
-drawMenu m t = drawButton (playMmaButton m) (playTexture t)
+drawMenu m t = do
+ drawTexture 0 0 (menuTexture t) 1
+ drawButton (playMmaButton m) (playTexture t)
drawButton :: MmaButton -> MmaTexture -> IO ()
drawButton (MmaButton r _) tex = do
- drawTexture (rectX r) (rectY r) tex 1
-
- --loadIdentity
- --renderPrimitive Quads $ mapM_ vertex $ vertexRect (conv i*85+60,50) 80 55
+ drawTexture (rectX r) (rectY r) tex 1
View
@@ -3,6 +3,7 @@ module Sprite (
Rectangle(..),
makeSprite,
spritePoints,
+ selectSprite,
dragSprite,
within,
@@ -39,6 +40,12 @@ makeSprite (Position x y) =
spritePoints :: Sprite -> [Vertex2 GLdouble]
spritePoints s = vertexRect (rectangle s)
+selectSprite :: Position -> Sprite -> Sprite
+selectSprite offs s =
+ s { sticky = True, offset = posOp (-) myPos (posConv offs) }
+ where
+ myPos = ( (rectX$rectangle$s),(rectY$rectangle$s) )
+
dragSprite :: Position -> Sprite -> Sprite
dragSprite p s =
if sticky s
View
@@ -61,7 +61,7 @@ data MmaMenu = MmaMenu
initialMenu :: MmaMenu
initialMenu = MmaMenu b
where
- b = MmaButton (Rectangle 20 20 50 70) False
+ b = MmaButton (Rectangle 20 15 50 70) False
data MmaButton = MmaButton
{
@@ -76,7 +76,8 @@ data MmaButton = MmaButton
data MmaTextures = MmaTextures
{
introTexture :: MmaTexture,
- playTexture :: MmaTexture
+ playTexture :: MmaTexture,
+ menuTexture :: MmaTexture
} deriving Show
data MmaTexture = MmaTexture
View
BIN menu.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.

0 comments on commit 0480755

Please sign in to comment.