Permalink
Browse files

added intro mode with texture... still appearing as white, though

  • Loading branch information...
Nik Nyby
Nik Nyby committed Mar 4, 2010
1 parent d9397cf commit fec2d5a0e79259733326f2650d4cf90f7f4d971c
Showing with 128 additions and 94 deletions.
  1. +0 −61 Animator.hs
  2. +36 −12 Bindings.hs
  3. +12 −0 Graphics.hs
  4. +39 −11 Main.hs
  5. +19 −5 Render.hs
  6. +22 −5 State.hs
  7. BIN intro.png
View
@@ -1,61 +0,0 @@
-module Animator (
- animator,
-) where
-
-import Data.IORef
-import Graphics.UI.GLUT
-
-import Bindings
-import Graphics
-import Render
-import State
-import Util
-
-animator :: IORef Env -> MmaTexture -> Window -> IO ()
-animator env textures wnd = do
- -- set up callbacks
- displayCallback $= (glRunAs2D $ do
- clearColor $= Color4 1 0 1 1
- clear [ColorBuffer, DepthBuffer]
- e <- readIORef env
- drawWorld e textures
- --readIORef env >>= drawWorld
- flush
- swapBuffers)
-
- idleCallback $= Just (idle env)
-
- let
- moveCursor p = 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
- return ( Position x (conv h - y) )
-
- keyboardMouseCallback $= Just (keyboardMouse wnd env)
-
- motionCallback $= Just (\pos ->
- trans pos >>= motion env)
-
- passiveMotionCallback $= Just (\pos ->
- trans pos >>= moveCursor >> postRedisplay Nothing)
-
- mainLoop
-
-idle :: IORef Env -> IO ()
-idle env = do
- e <- get env
- time <- get elapsedTime
- env $= tick time e
- postRedisplay Nothing
-
--- keep track of how much time has elapsed
-tick :: Int -> Env -> Env
-tick tnew (Env v sprs) = Env v sprs
- {-where
- s = map idleSprite sprs
- elapsed = fromIntegral $ tnew - clock v
- idleSprite z = z-}
View
@@ -2,33 +2,51 @@ module Bindings (
keyboardMouse,
motion,
) where
-
import Data.IORef
-import Data.List
+import Data.List (delete)
import Graphics.UI.GLUT
-import Sprite
import State
+import Sprite
keyboardMouse _ env key state modifiers pos = do
e <- get env
- --print $ sprites e
- env $= userAction e key state
+
+ let
+ dispatchAction = case (mode $ vars $ e) of
+ Intro -> introAction
+ Animator -> animatorAction
+
+ env $= dispatchAction e key state
motion :: IORef Env -> Position -> IO ()
motion env pos = do
e <- get env
- env $= mouseMotion e pos
+ let
+ dispatchMotion = case (mode $ vars $ e) of
+ Intro -> introMotion
+ Animator -> animatorMotion
-userAction :: Env -> Key -> KeyState -> Env
+ env $= dispatchMotion e pos
+
+{-
+ - keyboar/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
-- place a sprite
-userAction e (MouseButton RightButton) Down =
+animatorAction e (MouseButton RightButton) Down =
e { sprites = (makeSprite (mousePos $ vars $ e)) : sprites e }
-- start dragging a sprite
-userAction e (MouseButton LeftButton) Down =
+animatorAction e (MouseButton LeftButton) Down =
if length spritesWithin > 0
then e { sprites =
(toggleSticky selected) : (delete selected (sprites e))
@@ -43,12 +61,18 @@ userAction e (MouseButton LeftButton) Down =
spritesWithin :: [Sprite]
spritesWithin = filter (within pos) (sprites e)
+animatorAction e _ _ = e
+
-userAction e _ _ = e
+{-
+ - mouse motion
+ -}
+introMotion :: Env -> Position -> Env
+introMotion e _ = e
-mouseMotion :: Env -> Position -> Env
-mouseMotion (Env v s) pos = Env v{mousePos = pos}
+animatorMotion :: Env -> Position -> Env
+animatorMotion (Env v s) pos = Env v{mousePos = pos}
$ map updateSprite s
where
-- drag a sprite
View
@@ -1,5 +1,7 @@
module Graphics (
glRunAs2D,
+ loadAllTextures,
+
loadTexture,
freeTexture,
drawTexture,
@@ -51,6 +53,16 @@ loadTexture filepath = do
return (MmaTexture width height textureObj)
+loadAllTextures :: IO MmaTextures
+loadAllTextures = do
+ introtex <- loadTexture "intro.png"
+ playtex <- loadTexture "play.png"
+
+ return ( MmaTextures {
+ introTexture = introtex,
+ playTexture = playtex
+ } )
+
freeTexture :: MmaTexture -> IO ()
freeTexture tex = do
deleteObjectNames ([textureObject tex])
View
50 Main.hs
@@ -1,9 +1,11 @@
import Data.IORef
import Graphics.UI.GLUT
-import Animator
+import Bindings
import Graphics
+import Render
import State
+import Util
main :: IO ()
main = do
@@ -18,22 +20,48 @@ main = do
-- textures need to be in the IO monad, so they aren't part of the Env
-- textures <- initTextures
- textures <- loadTexture "play.png"
+ textures <- loadAllTextures
- intro
- animator env textures wnd
-
-intro :: IO ()
-intro = do
- print "hi"
- {-displayCallback $= (glRunAs2D $ do
+ -- set up callbacks
+ displayCallback $= (glRunAs2D $ do
clearColor $= Color4 1 0 1 1
clear [ColorBuffer, DepthBuffer]
e <- readIORef env
drawWorld e textures
--readIORef env >>= drawWorld
flush
- swapBuffers)-}
+ swapBuffers)
+
+ idleCallback $= Just (idle env)
+
+ let
+ moveCursor p = 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
+ return ( Position x (conv h - y) )
+
+ keyboardMouseCallback $= Just (keyboardMouse wnd env)
+
+ motionCallback $= Just (\pos ->
+ trans pos >>= motion env)
+
+ passiveMotionCallback $= Just (\pos ->
+ trans pos >>= moveCursor >> postRedisplay Nothing)
+
+ mainLoop
+ -- TODO: stop using all the CPU, silly!
- --keyboardMouseCallback $= Just (animator)
+idle :: IORef Env -> IO ()
+idle env = do
+ e <- get env
+ time <- get elapsedTime
+ env $= tick time e
+ postRedisplay Nothing
+-- keep track of how much time has elapsed
+tick :: Int -> Env -> Env
+tick t (Env v sprs) = Env (v {clock=t}) sprs
View
@@ -1,30 +1,44 @@
module Render (
drawWorld,
+ drawIntro,
) where
import Graphics.UI.GLUT
import Graphics
import Sprite
import State
+import Util
-drawWorld :: Env -> MmaTexture -> IO ()
-drawWorld e t = do
+drawWorld :: Env -> MmaTextures -> IO ()
+drawWorld e =
+ case (mode $ vars $ e) of
+ Intro -> do
+ drawIntro e
+ Animator -> do
+ drawAnimator e
+
+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 = drawTexture 0 y (introTexture t) 1
+ where
+ y = (-) 480$ (conv $ clock $ vars $ e) / 10
+
drawSprite :: Sprite -> IO ()
drawSprite s = renderPrimitive Quads $ mapM_ vertex $ spritePoints s
-drawMenu :: MmaMenu -> MmaTexture -> IO ()
+drawMenu :: MmaMenu -> MmaTextures -> IO ()
--drawMenu _ = mapM_ drawButton [0..5]
-drawMenu m t = drawButton (playMmaButton m) t
+drawMenu m t = 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
-
View
@@ -3,10 +3,12 @@ module State (
initialEnvironment,
Vars(..),
+ Mode(..),
MmaMenu(..),
MmaButton(..),
+ MmaTextures(..),
MmaTexture(..),
-- misc functions that belong.... elsewhere???
@@ -23,18 +25,26 @@ data Env = Env
} deriving Show
initialEnvironment :: Env
-initialEnvironment = Env
- ( Vars (Position 0 0) False False initialMenu )
+initialEnvironment =
+ Env ( Vars {
+ clock = 0,
+ mousePos = Position 0 0,
+ menu = initialMenu,
+ mode = Intro }
+ )
[ ]
data Vars = Vars
{
+ clock :: Int,
mousePos :: Position,
- playing :: Bool,
- recording :: Bool,
- menu :: MmaMenu
+ menu :: MmaMenu,
+ mode :: Mode
} deriving Show
+data Mode = Animator | Intro
+ deriving (Show, Eq)
+
data MmaMenu = MmaMenu
{
playMmaButton :: MmaButton
@@ -65,6 +75,13 @@ data MmaButton = MmaButton
buttonState :: Bool
} deriving Show
+-- just a dictionary, really
+data MmaTextures = MmaTextures
+ {
+ introTexture :: MmaTexture,
+ playTexture :: MmaTexture
+ } deriving Show
+
data MmaTexture = MmaTexture
{
textureWidth :: GLsizei,
View
BIN intro.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 fec2d5a

Please sign in to comment.