Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

changed x-lens to _x-lens and cabal-info

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-04-07 17:32:13 +02:00
parent d59e13e64f
commit 5ec9db8534
3 changed files with 35 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Pioneers.cabal
View File

@ -1,6 +1,6 @@
name: Pioneers name: Pioneers
version: 0.1 version: 0.1
cabal-version: >=1.2 cabal-version: >= 1.18
build-type: Simple build-type: Simple
author: sdressel author: sdressel
@ -32,14 +32,15 @@ executable Pioneers
text >=0.11, text >=0.11,
array >=0.4, array >=0.4,
random >=1.0.1, random >=1.0.1,
transformers >=0.3.0 && <0.4, transformers >=0.3.0,
mtl >=2.1.2, mtl >=2.1.2,
stm >=2.4.2, stm >=2.4.2,
vector >=0.10.9 && <0.11, vector >=0.10.9 && <0.11,
distributive >=0.3.2 && <0.4, distributive >=0.3.2,
linear >=1.3.1 && <1.4, linear >=1.3.1,
lens >=3.10.1 && <3.11, lens >=4.0,
SDL2 >= 0.1.0, SDL2 >= 0.1.0,
time >=1.4.0 && <1.5, time >=1.4.0 && <1.5,
GLUtil >= 0.7 GLUtil >= 0.7
Default-Language: Haskell2010

56
src/Main.hs
View File

@ -5,16 +5,13 @@ import Data.Int (Int8)
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureSize2D) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureSize2D)
import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..)) import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D)
import Control.Monad (liftM)
import Foreign.Marshal.Array (pokeArray)
import Foreign.Marshal.Alloc (allocaBytes)
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter) import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter)
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D)) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D))
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding)
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (TextureFilter(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (TextureFilter(..))
-- Monad-foo and higher functional stuff -- Monad-foo and higher functional stuff
import Control.Monad (unless, void, when, join) import Control.Monad (unless, void, when, join, liftM)
import Control.Arrow ((***)) import Control.Arrow ((***))
-- data consistency/conversion -- data consistency/conversion
@ -31,11 +28,13 @@ import Data.Distributive (distribute, collect)
import Foreign (Ptr, castPtr, with, sizeOf) import Foreign (Ptr, castPtr, with, sizeOf)
import Foreign.C (CFloat) import Foreign.C (CFloat)
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Foreign.Marshal.Array (pokeArray)
import Foreign.Marshal.Alloc (allocaBytes)
import Data.Word (Word8) import Data.Word (Word8)
-- Math -- Math
import Control.Lens ((^.), (.~), (%~)) import Control.Lens ((^.), (.~), (%~))
import Linear as L import qualified Linear as L
-- GUI -- GUI
import Graphics.UI.SDL as SDL import Graphics.UI.SDL as SDL
@ -100,7 +99,7 @@ main = do
--generate map vertices --generate map vertices
(mapBuffer, vert) <- getMapBufferObject (mapBuffer, vert) <- getMapBufferObject
(mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo, mapTex) <- initMapShader (mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo, mapTex) <- initMapShader
putStrLn $ show window print window
eventQueue <- newTQueueIO :: IO (TQueue Event) eventQueue <- newTQueueIO :: IO (TQueue Event)
putStrLn "foo" putStrLn "foo"
now <- getCurrentTime now <- getCurrentTime
@ -160,8 +159,8 @@ main = do
, _zDist = 10 , _zDist = 10
, _frustum = frust , _frustum = frust
, _camPosition = Types.Position , _camPosition = Types.Position
{ Types._x = 25 { Types.__x = 25
, Types._y = 25 , Types.__y = 25
} }
} }
, _io = IOState , _io = IOState
@ -175,8 +174,8 @@ main = do
, _dragStartXAngle = 0 , _dragStartXAngle = 0
, _dragStartYAngle = 0 , _dragStartYAngle = 0
, _mousePosition = Types.Position , _mousePosition = Types.Position
{ Types._x = 5 { Types.__x = 5
, Types._y = 5 , Types.__y = 5
} }
} }
, _keyboard = KeyboardState , _keyboard = KeyboardState
@ -222,16 +221,13 @@ draw = do
numVert = state ^. gl.glMap.mapVert numVert = state ^. gl.glMap.mapVert
map' = state ^. gl.glMap.stateMap map' = state ^. gl.glMap.stateMap
frust = state ^. camera.frustum frust = state ^. camera.frustum
camX = state ^. camera.camPosition.x camX = state ^. camera.camPosition._x
camY = state ^. camera.camPosition.y camY = state ^. camera.camPosition._y
zDist' = state ^. camera.zDist zDist' = state ^. camera.zDist
tessFac = state ^. gl.glMap.stateTessellationFactor tessFac = state ^. gl.glMap.stateTessellationFactor
window = env ^. windowObject window = env ^. windowObject
rb = state ^. gl.glRenderbuffer rb = state ^. gl.glRenderbuffer
if state ^. ui.uiHasChanged then when (state ^. ui . uiHasChanged) prepareGUI
prepareGUI
else
return ()
liftIO $ do liftIO $ do
--bind renderbuffer and set sample 0 as target --bind renderbuffer and set sample 0 as target
--GL.bindRenderbuffer GL.Renderbuffer GL.$= rb --GL.bindRenderbuffer GL.Renderbuffer GL.$= rb
@ -278,23 +274,23 @@ draw = do
checkError "setting up buffer" checkError "setting up buffer"
--set up projection (= copy from state) --set up projection (= copy from state)
with (distribute frust) $ \ptr -> with (distribute frust) $ \ptr ->
glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (L.M44 CFloat)))
checkError "copy projection" checkError "copy projection"
--set up camera --set up camera
let ! cam = getCam (camX,camY) zDist' xa ya let ! cam = getCam (camX,camY) zDist' xa ya
with (distribute cam) $ \ptr -> with (distribute cam) $ \ptr ->
glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (L.M44 CFloat)))
checkError "copy cam" checkError "copy cam"
--set up normal--Mat transpose((model*camera)^-1) --set up normal--Mat transpose((model*camera)^-1)
let normal = (case inv33 (fmap (^. _xyz) cam ^. _xyz) of let normal = (case L.inv33 (fmap (^. L._xyz) cam ^. L._xyz) of
(Just a) -> a (Just a) -> a
Nothing -> eye3) :: M33 CFloat Nothing -> L.eye3) :: L.M33 CFloat
nmap = collect id normal :: M33 CFloat --transpose... nmap = collect id normal :: L.M33 CFloat --transpose...
with (distribute nmap) $ \ptr -> with (distribute nmap) $ \ptr ->
glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat))) glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (L.M33 CFloat)))
checkError "nmat" checkError "nmat"
@ -379,8 +375,8 @@ run = do
sody = state ^. mouse.dragStartY sody = state ^. mouse.dragStartY
sodxa = state ^. mouse.dragStartXAngle sodxa = state ^. mouse.dragStartXAngle
sodya = state ^. mouse.dragStartYAngle sodya = state ^. mouse.dragStartYAngle
x' = state ^. mouse.mousePosition.x x' = state ^. mouse.mousePosition._x
y' = state ^. mouse.mousePosition.y y' = state ^. mouse.mousePosition._y
myrot = (x' - sodx) / 2 myrot = (x' - sodx) / 2
mxrot = (y' - sody) / 2 mxrot = (y' - sody) / 2
newXAngle = curb (pi/12) (0.45*pi) newXAngle' newXAngle = curb (pi/12) (0.45*pi) newXAngle'
@ -404,8 +400,8 @@ run = do
- 0.2 * kyrot * mults - 0.2 * kyrot * mults
mody y' = y' + 0.2 * kxrot * mults mody y' = y' + 0.2 * kxrot * mults
- 0.2 * kyrot * multc - 0.2 * kyrot * multc
modify $ (camera.camPosition.x %~ modx) modify $ (camera.camPosition._x %~ modx)
. (camera.camPosition.y %~ mody) . (camera.camPosition._y %~ mody)
{- {-
--modify the state with all that happened in mt time. --modify the state with all that happened in mt time.
@ -510,8 +506,8 @@ processEvent e = do
Closing -> Closing ->
modify $ window.shouldClose .~ True modify $ window.shouldClose .~ True
Resized {windowResizedTo=size} -> do Resized {windowResizedTo=size} -> do
modify $ (window.width .~ (sizeWidth size)) modify $ (window . width .~ sizeWidth size)
. (window.height .~ (sizeHeight size)) . (window . height .~ sizeHeight size)
adjustWindow adjustWindow
SizeChanged -> SizeChanged ->
adjustWindow adjustWindow
@ -557,8 +553,8 @@ processEvent e = do
. (mouse.dragStartXAngle .~ (state ^. camera.xAngle)) . (mouse.dragStartXAngle .~ (state ^. camera.xAngle))
. (mouse.dragStartYAngle .~ (state ^. camera.yAngle)) . (mouse.dragStartYAngle .~ (state ^. camera.yAngle))
modify $ (mouse.mousePosition. Types.x .~ (fromIntegral x)) modify $ (mouse.mousePosition. Types._x .~ (fromIntegral x))
. (mouse.mousePosition. Types.y .~ (fromIntegral y)) . (mouse.mousePosition. Types._y .~ (fromIntegral y))
MouseButton _ mouseId button state (SDL.Position x y) -> MouseButton _ mouseId button state (SDL.Position x y) ->
case button of case button of
LeftButton -> do LeftButton -> do

4
src/Types.hs
View File

@ -26,8 +26,8 @@ data Env = Env
--Mutable State --Mutable State
data Position = Position data Position = Position
{ _x :: !Double { __x :: !Double
, _y :: !Double , __y :: !Double
} }
data WindowState = WindowState data WindowState = WindowState