Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

added some menu window functionality

  • Loading branch information...
commit 61c8939438a94697563b468db809b45b09584092 1 parent 48feba3
Nik Nyby authored
Showing with 95 additions and 31 deletions.
  1. +62 −21 Bindings.hs
  2. +27 −4 Menu.hs
  3. +6 −6 Sprite.hs
View
83 Bindings.hs
@@ -55,14 +55,68 @@ animatorAction e (MouseButton RightButton) Down =
mkPath :: [Position]
mkPath = replicate (animClock$vars$e) (Position 1000 1000) ++ [(mousePos$vars$e)]
+--
+-- TODO: look at this mess!
+--
animatorAction e (MouseButton LeftButton) Down =
- --
- -- TODO: just look at this mess!
- --
- e { sprites = (updateSelected . updateDragged) (sprites e),
- vars = (vars e) { menu = buttonMap buttonSweep (menu$vars$e) }
- }
+ (handleButtons . handleSprites) e
where
+ handleButtons :: Env -> Env
+ handleButtons env =
+ env {
+ vars = (vars$env) { menu = updateMenu (menu$vars$env) }
+ }
+
+ -- ugh...
+ updateMenu :: MmaMenu -> MmaMenu
+ updateMenu m
+ | Just (playButton m) == thisButton =
+ m { playButton = (playButton m) { buttonState = True } }
+
+ | Just (nextSprtButton m) == thisButton =
+ m { nextSprtButton = (nextSprtButton m) { buttonState = True },
+ sprtWindow = windowInc (sprtWindow m) }
+
+ | Just (prevSprtButton m) == thisButton =
+ m { prevSprtButton = (prevSprtButton m) { buttonState = True },
+ sprtWindow = windowDec (sprtWindow m) }
+
+ | Just (nextBgButton m) == thisButton =
+ m { nextBgButton = (nextBgButton m) { buttonState = True },
+ bgWindow = windowInc (bgWindow m) }
+
+ | Just (prevBgButton m) == thisButton =
+ m { prevBgButton = (prevBgButton m) { buttonState = True },
+ bgWindow = windowInc (bgWindow m) }
+
+ | Just (nextFrameButton m) == thisButton =
+ m { nextFrameButton = (nextFrameButton m) { buttonState = True },
+ frameWindow = windowInc (frameWindow m) }
+
+ | Just (prevFrameButton m) == thisButton =
+ m { prevFrameButton = (prevFrameButton m) { buttonState = True },
+ frameWindow = windowInc (frameWindow m) }
+
+ | Just (saveButton m) == thisButton =
+ m { saveButton = (saveButton m) { buttonState = True } }
+
+ | otherwise = m
+
+ thisButton :: Maybe MmaButton
+ thisButton = if length bs >= 1
+ then Just $ head bs
+ else Nothing
+ where
+ bs :: [MmaButton]
+ bs = filter (within mp . buttonRect)
+ (menuButtons (menu$vars$e))
+
+ handleSprites :: Env -> Env
+ handleSprites env =
+ env {
+ sprites = (updateSelected . updateDragged) (sprites env)
+ }
+
updateSelected :: [Sprite] -> [Sprite]
updateSelected ss = map (\s -> s {selected=True}) (spriteUnder ss) ++
map (\s -> s {selected=False}) (ss \\ (spriteUnder ss))
@@ -72,20 +126,7 @@ animatorAction e (MouseButton LeftButton) Down =
(ss \\ spriteUnder ss)
spriteUnder :: [Sprite] -> [Sprite]
- spriteUnder ss = oneOrNone $ filter ((within mp) . rectangle) ss
-
- buttonSweep :: MmaButton -> MmaButton
- buttonSweep b = if within mp (buttonRect b)
- then updateButton b
- else b
-
- updateButton :: MmaButton -> MmaButton
- updateButton b = b { buttonState = not (buttonState b) }
--- updateButton b = case b of
--- nextSprtButton ->
-
- updateWindow :: MmaWindow -> MmaWindow
- updateWindow w = w
+ spriteUnder ss = oneOrNone $ filter ((within mp) . spriteRect) ss
-- stupid... Maybe I should learn how to use Maybe?
oneOrNone :: [a] -> [a]
@@ -132,4 +173,4 @@ 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
+ $ map (\x -> if sticky x then dragSpriteUpdatingPath p x else x) s
View
31 Menu.hs
@@ -4,7 +4,10 @@ module Menu (
MmaWindow(..),
buttonMap,
initialMenu,
+ menuButtons,
selectButtonRect,
+ windowInc,
+ windowDec,
) where
import Graphics.UI.GLUT
@@ -41,15 +44,14 @@ initialMenu = MmaMenu {
nextSprtButton = MmaButton (Rectangle (m!!2) 105 60 60) False,
prevSprtButton = MmaButton (Rectangle ((m!!2)+70) 105 60 60) False,
- saveButton = MmaButton (Rectangle (m!!3) 105 140 60) False,
-
bgWindow = MmaWindow (Rectangle (m!!0) 35 140 60) [] (-1),
nextBgButton = MmaButton (Rectangle (m!!1) 35 60 60) False,
prevBgButton = MmaButton (Rectangle ((m!!1)+70) 35 60 60) False,
frameWindow = MmaWindow (Rectangle (m!!2) 35 140 60) [] (-1),
nextFrameButton = MmaButton (Rectangle (m!!3) 35 60 60) False,
- prevFrameButton = MmaButton (Rectangle ((m!!3)+70) 35 60 60) False
+ prevFrameButton = MmaButton (Rectangle ((m!!3)+70) 35 60 60) False,
+ saveButton = MmaButton (Rectangle (m!!3) 105 140 60) False
}
where
m = mkMenu 640 140 15
@@ -66,6 +68,18 @@ buttonMap f m = m {
saveButton = f $ saveButton m
}
+menuButtons :: MmaMenu -> [MmaButton]
+menuButtons m = [
+ playButton m,
+ nextSprtButton m,
+ prevSprtButton m,
+ nextBgButton m,
+ prevBgButton m,
+ nextFrameButton m,
+ prevFrameButton m,
+ saveButton m
+ ]
+
-- A list of button x-positions that fit in a window of width wwd. bwd is
-- button width, and sp is space between buttons.
mkMenu :: GLdouble -> GLdouble -> GLdouble -> [GLdouble]
@@ -78,7 +92,7 @@ data MmaButton = MmaButton
--buttonTex :: MmaTexture,
buttonState :: Bool
- } deriving Show
+ } deriving (Show, Eq)
-- calculate a rectangle around the button
selectButtonRect :: MmaButton -> Rectangle
@@ -94,3 +108,12 @@ data MmaWindow = MmaWindow
-- the current texture
windowState :: Int
} deriving Show
+
+windowInc, windowDec :: MmaWindow -> MmaWindow
+windowInc w = if windowState w >= length (windowTextures w) - 1
+ then w { windowState = 0 }
+ else w { windowState = (windowState w) + 1 }
+
+windowDec w = if windowState w <= 0
+ then w { windowState = length (windowTextures w) - 1 }
+ else w { windowState = (windowState w) - 1 }
View
12 Sprite.hs
@@ -14,7 +14,7 @@ import Util
data Sprite =
Sprite {
- rectangle :: Rectangle,
+ spriteRect :: Rectangle,
-- recorded path
spritePath :: [Position],
@@ -34,24 +34,24 @@ makeSprite (Position x y) =
Sprite (Rectangle (conv x) (conv y) 20 20) [] False False (0,0)
spritePoints :: Sprite -> [Vertex2 GLdouble]
-spritePoints s = vertexRect $ rectangle s
+spritePoints s = vertexRect $ spriteRect s
-- calculate a rectangle around the sprite
selectPoints :: Sprite -> [Vertex2 GLdouble]
-selectPoints s = vertexRect $ boxAroundRect (rectangle s) 4.0
+selectPoints s = vertexRect $ boxAroundRect (spriteRect s) 4.0
-- 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) )
+ myPos = ( (rectX$spriteRect$s),(rectY$spriteRect$s) )
dragSprite :: Position -> Sprite -> Sprite
-dragSprite p s = s{ rectangle = newRect }
+dragSprite p s = s{ spriteRect = newRect }
where
newRect :: Rectangle
- newRect = (rectangle s){rectX = newX, rectY = newY}
+ newRect = (spriteRect s){rectX = newX, rectY = newY}
(newX,newY) = posOp (+) (posConv p) (offset s)
Please sign in to comment.
Something went wrong with that request. Please try again.