Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fixed intro and sprite dragging

  • Loading branch information...
commit 5d9cf92343713ac21aba21ef98a95d7fc1902b03 1 parent 12425e7
Nik Nyby authored
View
1  .gitignore
@@ -3,3 +3,4 @@
mma
*.swp
\#*\#
+.\#*
View
20 Bindings.hs
@@ -8,6 +8,7 @@ import Graphics.UI.GLUT
import State
import Sprite
+import Util
keyboardMouse _ env key state modifiers pos = do
e <- get env
@@ -49,7 +50,9 @@ animatorAction e (MouseButton RightButton) Down =
animatorAction e (MouseButton LeftButton) Down =
if length spritesWithin > 0
then e { sprites =
- (toggleSticky selected) : (delete selected (sprites e))
+ (selected{ sticky = not (sticky selected),
+ offset = posOp (-) selectedPos (posConv pos)
+ }) : (delete selected (sprites e))
}
else e
where
@@ -59,6 +62,9 @@ animatorAction e (MouseButton LeftButton) Down =
selected :: Sprite
selected = head spritesWithin
+ selectedPos :: Pos
+ selectedPos = ( (rectX$rectangle$selected),(rectY$rectangle$selected) )
+
spritesWithin :: [Sprite]
spritesWithin = filter (within pos) (sprites e)
@@ -75,12 +81,8 @@ animatorAction e _ _ = e
introMotion :: Env -> Position -> Env
introMotion e _ = e
+-- drag a sprite
animatorMotion :: Env -> Position -> Env
-animatorMotion (Env v s) pos = Env v{mousePos = pos}
- $ map updateSprite s
- where
- -- drag a sprite
- updateSprite q =
- if sticky q
- then q{ currentPos = pos }
- else q
+animatorMotion (Env v s) p =
+ -- update mouse position and any sticky sprites
+ Env v{mousePos = p} $ map (dragSprite p) s
View
6 Main.hs
@@ -39,6 +39,7 @@ main = do
(Env v sp) <- readIORef env
--print p
writeIORef env $ Env v{mousePos = p} sp
+
trans :: Position -> IO Position
trans (Position x y) = do
(_, Size _ h) <- get viewport
@@ -49,8 +50,9 @@ main = do
motionCallback $= Just (\pos ->
trans pos >>= motion env)
- passiveMotionCallback $= Just (\pos ->
- trans pos >>= moveCursor >> postRedisplay Nothing)
+ passiveMotionCallback $=
+ Just (\pos ->
+ trans pos >>= moveCursor >> postRedisplay Nothing)
mainLoop
-- TODO: stop using all the CPU, silly!
View
11 Render.hs
@@ -1,5 +1,5 @@
module Render (
- drawWorld,
+ drawWorld,
) where
import Graphics.UI.GLUT
@@ -24,9 +24,12 @@ drawAnimator e t = do
drawMenu (menu $ vars $ e) t
drawIntro :: Env -> MmaTextures -> IO ()
-drawIntro e t = drawTexture 0 y (introTexture t) 1
- where
- y = (-) 480$ (conv $ clock $ vars $ e) / 10
+drawIntro e t = do
+ (_, Size _ h) <- get viewport
+ let y = conv $ (conv h) -
+ (((clock $ vars $ e) `div` 10) `mod` (conv h*2))
+ drawTexture 0 y (introTexture t) 1
+
drawSprite :: Sprite -> IO ()
drawSprite s = renderPrimitive Quads $ mapM_ vertex $ spritePoints s
View
86 Sprite.hs
@@ -1,42 +1,67 @@
module Sprite (
- Sprite(..),
- makeSprite,
- spritePoints,
- toggleSticky,
- vertexRect,
- vertexRect',
- within,
+ Sprite(..),
+ Rectangle(..),
+ makeSprite,
+ spritePoints,
+ dragSprite,
+ within,
+
+ vertexRect,
) where
import Graphics.UI.GLUT
import Util
data Sprite =
- Square {
- currentPos :: Position,
-
- size :: GLdouble,
-
- -- recorded path
- spritePath :: [Position],
-
- -- is it being dragged?
- sticky :: Bool
+ Sprite {
+ rectangle :: Rectangle,
+ -- recorded path
+ spritePath :: [Position],
+ -- is it being dragged?
+ sticky :: Bool,
+ -- mouse offset for dragging
+ offset :: Pos
} deriving (Show, Eq)
+data Rectangle =
+ Rectangle
+ {
+ rectX :: GLdouble,
+ rectY :: GLdouble,
+ rectWidth :: GLdouble,
+ rectHeight :: GLdouble
+ } deriving (Show, Eq)
+
makeSprite :: Position -> Sprite
-makeSprite pos = Square pos 10 [] False
+makeSprite (Position x y) =
+ Sprite (Rectangle (conv x) (conv y) 20 20) [] False (0,0)
spritePoints :: Sprite -> [Vertex2 GLdouble]
-spritePoints s = vertexRect' (currentPos s) 10 10
+spritePoints s = vertexRect (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)
-toggleSticky :: Sprite -> Sprite
-toggleSticky (Square pos sz path s) = Square pos sz path $ not 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) _ _ _) =
+ (x <= (rx+(rw/2))) && (x >= (rx-(rw/2)))
+ && (y <= (ry+(rh/2))) && (y >= (ry-(rh/2)))
+ where
+ x = conv px
+ y = conv py
-- return a list of four vertices for a rectangle, given position and size
-vertexRect :: (GLdouble,GLdouble) -> GLdouble -> GLdouble
- -> [Vertex2 GLdouble]
-vertexRect (x,y) width height =
+vertexRect :: Rectangle -> [Vertex2 GLdouble]
+vertexRect (Rectangle x y width height) =
[(Vertex2 (x-w) (y+h))
, (Vertex2 (x-w) (y-h))
, (Vertex2 (x+w) (y-h))
@@ -44,16 +69,3 @@ vertexRect (x,y) width height =
where
w = width / 2
h = height / 2
-
--- same thing with different point format
-vertexRect' :: Position -> GLdouble -> GLdouble -> [Vertex2 GLdouble]
-vertexRect' (Position x y) w h = vertexRect (conv x,conv y) w h
-
--- returns True if the point lies within the sprite's area
-within :: Position -> Sprite -> Bool
-within (Position ppx ppy) s = (sx >= px - sz) && (sx <= px + sz)
- && (sy >= py - sz) && (sy <= py + sz)
- where
- sx = conv csx; sy = conv csy; px = conv ppx; py = conv ppy
- (Position csx csy) = currentPos s
- sz = size s
View
11 State.hs
@@ -10,9 +10,6 @@ module State (
MmaTextures(..),
MmaTexture(..),
-
- -- misc functions that belong.... elsewhere???
- Rectangle(..),
) where
import Graphics.UI.GLUT
@@ -88,11 +85,3 @@ data MmaTexture = MmaTexture
textureHeight :: GLsizei,
textureObject :: TextureObject
} deriving Show
-
-data Rectangle = Rectangle
- {
- rectX :: GLdouble,
- rectY :: GLdouble,
- rectWidth :: GLdouble,
- rectHeight :: GLdouble
- } deriving (Show, Eq)
View
23 Util.hs
@@ -1,7 +1,30 @@
module Util (
conv,
+
+ Pos,
+ posConv,
+ posOp,
) where
+import Graphics.UI.GLUT
-- generalize an Integral
conv :: (Integral a, Num b) => a -> b
conv = fromInteger . toInteger
+
+
+{- TODO: GL uses `Position' but I don't know how to get the x and y values out
+ - of a Position without pattern matching, because it's defined as:
+ - data Position = Position !GLint !GLint
+ - So I made a tuple type for co-ordinates but I'm worried it's unnecessary and
+ - it's annoying to have another type to worry about converting to and from.
+ -}
+
+type Pos = (GLdouble,GLdouble)
+
+-- convert from a GL Position
+posConv :: Position -> Pos
+posConv (Position x y) = (conv x,conv y)
+
+-- apply a binary function over Pos
+posOp :: (GLdouble -> GLdouble -> GLdouble) -> Pos -> Pos -> Pos
+posOp op (a,b) (x,y) = (a `op` x, b `op` y)
Please sign in to comment.
Something went wrong with that request. Please try again.