Skip to content
Browse files

working on menu

  • Loading branch information...
1 parent dd32214 commit 8e06d6991d29b8d3a064f90174cb4176877af9cd Nik Nyby committed Apr 10, 2010
Showing with 150 additions and 104 deletions.
  1. +17 −4 Graphics.hs
  2. +69 −0 Menu.hs
  3. +4 −5 Render.hs
  4. +0 −9 Sprite.hs
  5. +24 −82 State.hs
  6. +36 −4 Util.hs
  7. BIN downarrow.png
  8. BIN save.png
  9. BIN uparrow.png
View
21 Graphics.hs
@@ -14,7 +14,6 @@ import Graphics.UI.SDL.Image as SDLImage
import Graphics.UI.SDL.Types
import Graphics.UI.SDL.Video (freeSurface)
-import State
import Util
glRunAs2D :: IO () -> IO ()
@@ -56,13 +55,27 @@ loadTexture filepath = do
loadAllTextures :: IO MmaTextures
loadAllTextures = do
introtex <- loadTexture "intro.png"
- playtex <- loadTexture "play.png"
menutex <- loadTexture "menu.png"
+ playtex <- loadTexture "play.png"
+ savetex <- loadTexture "save.png"
+ uparrow <- loadTexture "uparrow.png"
+ downarrow <- loadTexture "downarrow.png"
return ( MmaTextures {
introTexture = introtex,
- playTexture = playtex,
- menuTexture = menutex
+ menuTexture = menutex,
+ playButtonTexture = playtex,
+
+ saveButtonTexture = savetex,
+
+ nextSprtButtonTexture = uparrow,
+ prevSprtButtonTexture = downarrow,
+
+ nextBgButtonTexture = uparrow,
+ prevBgButtonTexture = downarrow,
+
+ nextFrameButtonTexture = uparrow,
+ prevFramButtonTexture = downarrow
} )
freeTexture :: MmaTexture -> IO ()
View
69 Menu.hs
@@ -0,0 +1,69 @@
+module Menu (
+ MmaButton(..),
+ MmaMenu(..),
+ MmaWindow(..),
+ initialMenu,
+ ) where
+
+import Util
+
+data MmaMenu = MmaMenu
+ {
+ playButton :: MmaButton,
+
+ -- sprite chooser
+ sprtWindow :: MmaWindow,
+ nextSprtButton :: MmaButton,
+ prevSprtButton :: MmaButton,
+
+ -- background chooser
+ bgWindow :: MmaWindow,
+ nextBgButton :: MmaButton,
+ prevBgButton :: MmaButton,
+
+ -- stepper
+ frameWindow :: MmaWindow,
+ prevFrameButton :: MmaButton,
+ nextFrameButton :: MmaButton,
+
+ saveButton :: MmaButton
+ } deriving Show
+
+initialMenu :: MmaMenu
+initialMenu = MmaMenu {
+ playButton = MmaButton (Rectangle 15 95 140 70) False,
+
+ sprtWindow = MmaWindow (Rectangle 165 95 140 70) [] (-1),
+ nextSprtButton = MmaButton (Rectangle 315 95 60 70) False,
+ prevSprtButton = MmaButton (Rectangle 385 95 60 70) False,
+
+ saveButton = MmaButton (Rectangle 455 95 140 70) False,
+
+ bgWindow = MmaWindow (Rectangle 15 15 140 70) [] (-1),
+ nextBgButton = MmaButton (Rectangle 165 15 60 70) False,
+ prevBgButton = MmaButton (Rectangle 235 15 60 70) False,
+
+ frameWindow = MmaWindow (Rectangle 315 15 140 70) [] (-1),
+ nextFrameButton = MmaButton (Rectangle 465 15 60 70) False,
+ prevFrameButton = MmaButton (Rectangle 535 15 60 70) False
+ }
+
+data MmaButton = MmaButton
+ {
+ buttonRect :: Rectangle,
+
+ --buttonTex :: MmaTexture,
+
+ buttonState :: Bool
+ } deriving Show
+
+data MmaWindow = MmaWindow
+ {
+ windowRect :: Rectangle,
+
+ -- all possible textures for this window
+ windowTextures :: [MmaTexture],
+
+ -- the current texture
+ windowState :: Int
+ } deriving Show
View
9 Render.hs
@@ -4,17 +4,16 @@ module Render (
import Graphics.UI.GLUT
import Graphics
+import Menu
import Sprite
import State
import Util
drawWorld :: Env -> MmaTextures -> IO ()
drawWorld e =
case (mode $ vars $ e) of
- Intro -> do
- drawIntro e
- Animator -> do
- drawAnimator e
+ Intro -> drawIntro e
+ Animator -> drawAnimator e
drawAnimator :: Env -> MmaTextures -> IO ()
drawAnimator e t = do
@@ -45,7 +44,7 @@ drawSprite s = do
drawMenu :: MmaMenu -> MmaTextures -> IO ()
drawMenu m t = do
drawTexture 0 0 (menuTexture t) 1
- drawButton (playMmaButton m) (playTexture t)
+ drawButton (playButton m) (playButtonTexture t)
drawButton :: MmaButton -> MmaTexture -> IO ()
drawButton (MmaButton r _) tex = do
View
9 Sprite.hs
@@ -27,15 +27,6 @@ data Sprite =
offset :: Pos
} deriving (Show, Eq)
-data Rectangle =
- Rectangle
- {
- rectX :: GLdouble,
- rectY :: GLdouble,
- rectWidth :: GLdouble,
- rectHeight :: GLdouble
- } deriving (Show, Eq)
-
makeSprite :: Position -> Sprite
makeSprite (Position x y) =
Sprite (Rectangle (conv x) (conv y) 20 20) [] False False (0,0)
View
106 State.hs
@@ -1,95 +1,37 @@
module State (
- Env(..),
- initialEnvironment,
-
- Vars(..),
- Mode(..),
-
- MmaMenu(..),
- MmaButton(..),
-
- MmaTextures(..),
- MmaTexture(..),
-) where
+ Env(..),
+ initialEnvironment,
+ Vars(..),
+ Mode(..),
+ ) where
import Graphics.UI.GLUT
+import Menu
import Sprite
data Env = Env
- {
- vars :: Vars,
- sprites :: [Sprite]
- } deriving Show
+ {
+ vars :: Vars,
+ sprites :: [Sprite]
+ } deriving Show
initialEnvironment :: Env
initialEnvironment =
- Env ( Vars {
- clock = 0,
- mousePos = Position 0 0,
- menu = initialMenu,
- mode = Intro }
- )
- [ ]
+ Env ( Vars {
+ clock = 0,
+ mousePos = Position 0 0,
+ menu = initialMenu,
+ mode = Intro }
+ )
+ [ ]
data Vars = Vars
- {
- clock :: Int,
- mousePos :: Position,
- menu :: MmaMenu,
- mode :: Mode
- } deriving Show
+ {
+ clock :: Int,
+ mousePos :: Position,
+ menu :: MmaMenu,
+ mode :: Mode
+ } deriving Show
data Mode = Animator | Intro
- deriving (Show, Eq)
-
-data MmaMenu = MmaMenu
- {
- playMmaButton :: MmaButton
- {-
- -- sprite chooser
- sprtWindow :: MmaWindow,
- nextSprtButton :: MmaButton,
- prevSprtButton :: MmaButton,
-
- -- background chooser
- bgWindow :: MmaWindow,
- nextBgButton :: MmaButton,
- prevBgButton :: MmaButton,
-
- -- stepper
- frameWindow :: MmaWindow,
- prevFrameButton :: MmaButton,
- nextFrameButton :: MmaButton,
-
- saveButton :: MmaButton
- -}
- } deriving Show
-
-initialMenu :: MmaMenu
-initialMenu = MmaMenu b
- where
- b = MmaButton (Rectangle 20 15 50 70) False
-
-data MmaButton = MmaButton
- {
- buttonRect :: Rectangle,
-
- --buttonTex :: MmaTexture,
-
- buttonState :: Bool
- } deriving Show
-
--- just a dictionary, really
-data MmaTextures = MmaTextures
- {
- introTexture :: MmaTexture,
- playTexture :: MmaTexture,
- menuTexture :: MmaTexture
- } deriving Show
-
-data MmaTexture = MmaTexture
- {
- textureWidth :: GLsizei,
- textureHeight :: GLsizei,
- textureObject :: TextureObject
- } deriving Show
+ deriving (Show, Eq)
View
40 Util.hs
@@ -1,9 +1,11 @@
module Util (
conv,
-
- Pos,
posConv,
posOp,
+ Pos,
+ MmaTexture(..),
+ MmaTextures(..),
+ Rectangle(..),
) where
import Graphics.UI.GLUT
@@ -25,6 +27,36 @@ type Pos = (GLdouble,GLdouble)
posConv :: Position -> Pos
posConv (Position x y) = (conv x,conv y)
--- apply a binary function over Pos
+-- apply a binary function on a Pos
posOp :: (GLdouble -> GLdouble -> GLdouble) -> Pos -> Pos -> Pos
-posOp op (a,b) (x,y) = (a `op` x, b `op` y)
+posOp op (a,b) (x,y) = (a `op` x, b `op` y)
+
+data Rectangle =
+ Rectangle
+ {
+ rectX :: GLdouble,
+ rectY :: GLdouble,
+ rectWidth :: GLdouble,
+ rectHeight :: GLdouble
+ } deriving (Show, Eq)
+
+data MmaTexture = MmaTexture
+ {
+ textureWidth :: GLsizei,
+ textureHeight :: GLsizei,
+ textureObject :: TextureObject
+ } deriving Show
+
+data MmaTextures = MmaTextures
+ {
+ introTexture :: MmaTexture,
+ menuTexture :: MmaTexture,
+ playButtonTexture :: MmaTexture,
+ saveButtonTexture :: MmaTexture,
+ nextSprtButtonTexture :: MmaTexture,
+ prevSprtButtonTexture :: MmaTexture,
+ nextBgButtonTexture :: MmaTexture,
+ prevBgButtonTexture :: MmaTexture,
+ nextFrameButtonTexture :: MmaTexture,
+ prevFramButtonTexture :: MmaTexture
+ } deriving Show
View
BIN downarrow.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN save.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN uparrow.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 8e06d69

Please sign in to comment.
Something went wrong with that request. Please try again.