Permalink
Browse files

Refactored Window to WindowState so that we can keep track of

its size in the window resize callbacks. This is the same as
what can be seend with WorldState.

Note: GL.. etc have been added in front of functions so that
we can clearly see what needs to be refactored and generalised.

Signed-off-by: Edward Tate <cmalune@gmail.com>
  • Loading branch information...
1 parent d62980d commit e0aeb4dc4746999cf5c627531f0a74b77c6a7114 Edward Tate committed Jul 22, 2011
Showing with 108 additions and 62 deletions.
  1. +86 −50 Main.hs
  2. +21 −12 Resurrection/Window.hs
  3. +1 −0 resurrection.cabal
View
136 Main.hs
@@ -1,104 +1,140 @@
{-| -}
module Main where
-import Control.Concurrent (threadDelay)
-import Control.Applicative
+import Control.Concurrent (threadDelay)
+import Control.Applicative
-import Graphics.UI.GLUT
-import Graphics.Rendering.OpenGL
-import Graphics.Rendering.FTGL
+import qualified Graphics.UI.GLUT as GLUT
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.FTGL as FTGL
-import Foreign.ForeignPtr
-import Foreign.Ptr
-import Foreign.Storable
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Storable
-import Data.Array.Storable
-import System.Exit (exitWith, ExitCode(ExitSuccess))
-import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
+import Data.Array.Storable
+import System.Exit (exitWith, ExitCode(ExitSuccess))
+import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
+import Data.StateVar (get)
-import Resurrection.GL.Projection (set2dProjection, set3dProjection)
-import Resurrection.Window (initWindow, defaultWindow)
+import Resurrection.GL.Projection
+import Resurrection.Window (windowSize, initWindow, defaultWindowState)
------------------------------------------------------------------------------
-- | Initialize a font.
initFont path = do
- font <- createExtrudeFont path
- setFontFaceSize font 12 73
+ font <- FTGL.createExtrudeFont path
+ FTGL.setFontFaceSize font 12 73
+ FTGL.setFontDepth font 2
return font
------------------------------------------------------------------------------
-- |
-setProjections s@(Size w h) = do
+setWindowSize windowState s@(GLUT.Size w h) = do
+ size <- get $ windowSize windowState
+ (windowSize windowState) $= s
+
set2dProjection w h
set3dProjection w h
------------------------------------------------------------------------------
-- |
-tick angle = do
+data WorldState = WorldState {
+ triangleAngle :: IORef GL.GLfloat
+ , textAngle :: IORef GL.GLfloat
+ }
+
+
+------------------------------------------------------------------------------
+-- |
+incRef r n = do
+ x <- get r
+ r $= x + n
+
+
+--------------------------------------------------------------------------------
+-- |
+tick ws = do
threadDelay 10000
- a <- get angle
- angle $= a + (0.1 :: GLfloat)
- postRedisplay Nothing
+ incRef (triangleAngle ws) 1.0
+ incRef (textAngle ws) (0.017 * 100)
+ GLUT.postRedisplay Nothing
------------------------------------------------------------------------------
-- |
-renderTriangle angle = do
- a <- get angle
- rotate a (Vector3 (1.0 :: GLfloat) (0.0 :: GLfloat) (1.0 :: GLfloat))
- renderPrimitive Triangles $ do
- color (Color3 (1.0 :: GLfloat) (0.0 :: GLfloat) (0.0 :: GLfloat))
- vertex (Vertex3 (0.0 :: GLfloat) (0.0 :: GLfloat) (0.0 :: GLfloat))
- color (Color3 (0.0 :: GLfloat) (1.0 :: GLfloat) (0.0 :: GLfloat))
- vertex (Vertex3 (1.0 :: GLfloat) (0.0 :: GLfloat) (0.0 :: GLfloat))
- color (Color3 (0.0 :: GLfloat) (0.0 :: GLfloat) (1.0 :: GLfloat))
- vertex (Vertex3 (1.0 :: GLfloat) (1.0 :: GLfloat) (0.0 :: GLfloat))
+redColour :: GL.Color3 GL.GLfloat
+redColour = GL.Color3 1.0 0.0 0.0
+
+greenColour :: GL.Color3 GL.GLfloat
+greenColour = GL.Color3 0.0 1.0 0.0
+
+blueColour :: GL.Color3 GL.GLfloat
+blueColour = GL.Color3 0.0 0.0 1.0
+
+renderTriangle ws = do
+ a <- get (triangleAngle ws)
+ GL.rotate a (GL.Vector3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (1.0 :: GL.GLfloat))
+ GL.renderPrimitive GL.Triangles $ do
+ GL.color redColour
+ GL.vertex (GL.Vertex3 (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ GL.color greenColour
+ GL.vertex (GL.Vertex3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ GL.color blueColour
+ GL.vertex (GL.Vertex3 (1.0 :: GL.GLfloat) (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
------------------------------------------------------------------------------
-- |
-render2dProjection font = do
- translate (Vector3 (-5.0 :: GLfloat) (0.0 :: GLfloat) (-5.0 :: GLfloat))
- color (Color3 (1.0 :: GLfloat) (0.0 :: GLfloat) (0.0 :: GLfloat))
- renderFont font "Some text..." All
+render2dProjection ws font = do
+ GL.translate (GL.Vector3 (-90.0 :: GL.GLfloat) (90.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ a <- get (textAngle ws)
+ GL.rotate a (GL.Vector3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ GL.color (GL.Color3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ FTGL.renderFont font "Some text..." FTGL.All
------------------------------------------------------------------------------
-- |
-render3dProjection angle = do
- translate (Vector3 (0.0 :: GLfloat) (0.0 :: GLfloat) ((- 2.0) :: GLfloat))
- renderTriangle angle
+render3dProjection ws = do
+ GL.translate (GL.Vector3 (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) ((- 2.0) :: GL.GLfloat))
+ renderTriangle ws
------------------------------------------------------------------------------
-- |
-render angle font = do
- clear [ColorBuffer, DepthBuffer]
- loadIdentity
+render ws font = do
+ GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+ GL.loadIdentity
set2dProjection 640 480
- render2dProjection font
+ render2dProjection ws font
set3dProjection 640 480
- render3dProjection angle
+ render3dProjection ws
- swapBuffers
+ GLUT.swapBuffers
------------------------------------------------------------------------------
-- |
main = do
- initWindow defaultWindow
+ windowState <- defaultWindowState
+ initWindow windowState
font <- initFont "asset/font/cousine/regularLatin.ttf"
- angle <- newIORef (0.0 :: GLfloat)
- clearColor $= Color4 0.5 0.5 0.8 0.5
+ worldState <- WorldState <$>
+ newIORef 0.0 <*>
+ newIORef 0.0
+
+ GL.clearColor $= GL.Color4 0.5 0.5 0.8 0.5
- displayCallback $= (render angle font)
- idleCallback $= Just (tick angle)
- reshapeCallback $= Just setProjections
- mainLoop
+ GLUT.displayCallback $= render worldState font
+ GLUT.idleCallback $= Just (tick worldState)
+ GLUT.reshapeCallback $= Just (setWindowSize windowState)
+ GLUT.mainLoop
View
@@ -2,36 +2,45 @@
module Resurrection.Window
(
-- * Window utility functions
- Window
+ WindowState(..)
, initWindow
- , defaultWindow
+ , defaultWindowState
) where
+import Control.Applicative
import qualified Graphics.UI.GLUT as GLUT
import Graphics.UI.GLUT (($=))
+import Data.IORef (IORef(..), newIORef)
+import Data.Functor ((<$>))
+import Data.StateVar (get)
------------------------------------------------------------------------------
-- | Exports a default window for convenience.
-defaultWindow :: Window
-defaultWindow = Window "Default Title" (GLUT.Size 640 480)
+defaultWindowState :: IO WindowState
+defaultWindowState =
+ WindowState <$>
+ (newIORef "Default Title") <*>
+ (newIORef $ GLUT.Size 640 480)
------------------------------------------------------------------------------
--- |
-data Window = Window {
- windowTitle :: String
- , windowSize :: GLUT.Size
- } deriving (Show)
+-- | Keeps track of the current state of the window
+data WindowState = WindowState {
+ windowTitle :: IORef String
+ , windowSize :: IORef GLUT.Size
+ }
------------------------------------------------------------------------------
-- |
-initWindow window = do
+initWindow w = do
+ title <- get $ windowTitle w
+ size <- get $ windowSize w
GLUT.initialDisplayMode $= [GLUT.DoubleBuffered]
- GLUT.initialWindowSize $= windowSize defaultWindow
+ GLUT.initialWindowSize $= size
(progname, _) <- GLUT.getArgsAndInitialize
- GLUT.createWindow $ windowTitle defaultWindow
+ GLUT.createWindow title
View
@@ -54,6 +54,7 @@ Executable resurrection
Build-depends:
base >= 4.3.1.0
, array >= 0.3.0.2
+ , StateVar >= 1.0.0.0
, GLUT >= 2.2.2.0
, FTGL >= 1.333
, OpenGL >= 2.4.0.1

0 comments on commit e0aeb4d

Please sign in to comment.