Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

`-\'

  • Loading branch information...
commit 8a65d2634b8cfbf1968774688b83e9b2907b00d9 1 parent 95a5b01
Nik Nyby authored
Showing with 51 additions and 34 deletions.
  1. +8 −1 Menu.hs
  2. +32 −0 Rectangle.hs
  3. +9 −4 Render.hs
  4. +2 −19 Sprite.hs
  5. +0 −10 Util.hs
View
9 Menu.hs
@@ -3,8 +3,11 @@ module Menu (
MmaMenu(..),
MmaWindow(..),
initialMenu,
- ) where
+ selectButton,
+) where
+import Graphics.UI.GLUT
+import Rectangle
import Util
data MmaMenu = MmaMenu
@@ -57,6 +60,10 @@ data MmaButton = MmaButton
buttonState :: Bool
} deriving Show
+-- calculate a rectangle around the button
+selectButton :: MmaButton -> [Vertex2 GLdouble]
+selectButton b = vertexRect $ boxAroundRect (buttonRect b) 2.0
+
data MmaWindow = MmaWindow
{
windowRect :: Rectangle,
View
32 Rectangle.hs
@@ -0,0 +1,32 @@
+module Rectangle (
+ Rectangle(..),
+ boxAroundRect,
+ vertexRect,
+) where
+import Graphics.UI.GLUT
+
+data Rectangle =
+ Rectangle
+ {
+ rectX :: GLdouble,
+ rectY :: GLdouble,
+ rectWidth :: GLdouble,
+ rectHeight :: GLdouble
+ } deriving (Show, Eq)
+
+-- return a list of four vertices for a rectangle, given position and size
+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))
+ , (Vertex2 (x+w) (y+h))]
+ where
+ w = width / 2
+ h = height / 2
+
+boxAroundRect :: Rectangle -> GLdouble -> Rectangle
+boxAroundRect r i = r {
+ rectWidth = rectWidth r + i,
+ rectHeight = rectHeight r + i
+ }
View
13 Render.hs
@@ -5,6 +5,7 @@ import Graphics.UI.GLUT
import Graphics
import Menu
+import Rectangle
import Sprite
import State
import Util
@@ -28,7 +29,6 @@ drawIntro e t = do
drawTexture 0 0 (introTexture t) 0.25
drawTexture 0 y (introTexture t) 1
-
drawSprite :: Sprite -> IO ()
drawSprite s = do
currentColor $= Color4 0.2 0 0.3 0
@@ -54,7 +54,12 @@ drawMenu m t = do
drawButton (nextFrameButton m) (nextFrameButtonTexture t)
drawButton (prevFrameButton m) (prevFrameButtonTexture t)
-
drawButton :: MmaButton -> MmaTexture -> IO ()
-drawButton (MmaButton r _) tex = do
- drawTexture (rectX r) (rectY r) tex 1
+drawButton b tex = do
+ drawTexture (rectX (buttonRect b)) (rectY (buttonRect b)) tex 1
+
+ if buttonState b
+ then do
+ currentColor $= Color4 0.85 0 0.4 0.2
+ renderPrimitive Quads $ mapM_ vertex $ selectButton b
+ else return ()
View
21 Sprite.hs
@@ -1,17 +1,15 @@
module Sprite (
Sprite(..),
- Rectangle(..),
makeSprite,
spritePoints,
selectPoints,
initDragSprite,
dragSprite,
within,
-
- vertexRect,
) where
import Graphics.UI.GLUT
+import Rectangle
import Util
data Sprite =
@@ -36,12 +34,7 @@ spritePoints s = vertexRect $ rectangle s
-- calculate a rectangle around the sprite
selectPoints :: Sprite -> [Vertex2 GLdouble]
-selectPoints s = vertexRect $ r
- { rectWidth = rectWidth r + 8.0,
- rectHeight = rectHeight r + 8.0
- }
- where
- r = rectangle s
+selectPoints s = vertexRect $ boxAroundRect (rectangle s) 8.0
-- start dragging a sprite
initDragSprite :: Position -> Sprite -> Sprite
@@ -70,13 +63,3 @@ within (Position px py) (Sprite (Rectangle rx ry rw rh) _ _ _ _) =
x = conv px
y = conv py
--- return a list of four vertices for a rectangle, given position and size
-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))
- , (Vertex2 (x+w) (y+h))]
- where
- w = width / 2
- h = height / 2
View
10 Util.hs
@@ -5,7 +5,6 @@ module Util (
Pos,
MmaTexture(..),
MmaTextures(..),
- Rectangle(..),
) where
import Graphics.UI.GLUT
@@ -31,15 +30,6 @@ posConv (Position x y) = (conv x,conv y)
posOp :: (GLdouble -> GLdouble -> GLdouble) -> Pos -> Pos -> Pos
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,
Please sign in to comment.
Something went wrong with that request. Please try again.