From a32da62b52b6f0e4039ae4226e3e2867880ca05c Mon Sep 17 00:00:00 2001 From: Joshua Rahm Date: Sun, 27 Apr 2014 20:39:00 -0600 Subject: hacky first person stuff --- Resources.hs | 110 ++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 79 insertions(+), 31 deletions(-) (limited to 'Resources.hs') diff --git a/Resources.hs b/Resources.hs index 30d129b..ddffb9c 100644 --- a/Resources.hs +++ b/Resources.hs @@ -39,6 +39,8 @@ import TileShow import Data.Array import qualified Data.StateVar as SV +import Data.Time.Clock.POSIX +import Control.Concurrent {- Types of terrain which are possible -} data TileType = Forest | Beach | Water | Grass | Jungle | Mountains | @@ -74,17 +76,49 @@ data Resources = Resources { routines :: [ResourcesClosure -> IO ()], - speed :: GLfloat, timeSpeed :: Int, time :: Int, heightMap :: Array (Int,Int) Tile, positionUpdate :: (Resources -> IO Resources), + + {- Smaller if in first person -} speedFactor :: GLfloat, + {- Higher if shift is held -} + speedMultiplier :: GLfloat, + {- Direction -} + speedDirection :: Vec3 GLfloat, + dDown :: GLfloat, - waterArray :: ArrIO.IOArray (Int,Int) GLfloat + waterArray :: ArrIO.IOArray (Int,Int) GLfloat, + headBob :: GLfloat, + mode :: CameraMode } +getSpeed :: Resources -> GLfloat +getSpeed res =speedFactor res * speedMultiplier res + +cameraForward :: CameraPosition -> Vec3 GLfloat +cameraForward (CameraPosition _ th ph) = Vec3 $ toEuclidian (1,th,ph) + +cameraUp :: CameraPosition -> Vec3 GLfloat +cameraUp (CameraPosition _ _ ph) = + if ph' >= 90 && ph' < 270 then Vec3 (0,-1,0) else Vec3 (0,1,0) + where ph' = (floor ph::Int) `mod` 360 + +cameraRight :: CameraPosition -> Vec3 GLfloat +cameraRight cam = cameraUp cam × cameraForward cam + + +getVelocity :: Resources -> Vec3 GLfloat +getVelocity res = + let dir = speedDirection res + camdir = cameraForward $ rPosition res + truedir = dir <-> (Vec3 (0,0,1) <-> camdir) in + getSpeed res `vScale` (norm dir `vScale` V.normalize truedir) + +data CameraMode = Oracle | FirstPerson deriving Eq + {- Central data type for rendering each frame -} data ResourcesClosure = ResourcesClosure { rcMVMatrix :: Mat4 GLfloat @@ -104,7 +138,7 @@ $(declareSetters ''Resources) - person -} firstPerson :: Resources -> IO Resources firstPerson res = - let (CameraPosition (Vec3 (x,curh,y)) th ph) = rPosition res + let camera@(CameraPosition (Vec3 (x,curh,y)) th ph) = rPosition res (_,(w,h)) = bounds $ heightMap res (!!!) arr (x',y') = if x' < 0 || y' < 0 || x' > w || y' > h then -1000 else elevation (arr ! (x',y')) h1 = ((/10.0).fromIntegral) (heightMap res !!! (floor x, floor y) ) @@ -115,19 +149,19 @@ firstPerson res = v = y - (int $ (floor y::Int)) mixu1 = mix h3 h1 u mixu2 = mix h4 h2 u - newh = mix mixu2 mixu1 v + 0.2 + newh = mix mixu2 mixu1 v droph = curh - dDown res + jitter = (max 0 $ getSpeed res - 0.029) ** 0.1 / 2 + dy = sin (headBob res*2) * jitter + dx = realToFrac $ cos (headBob res) * jitter in do - return $ - if (newh+0.2 > droph) then - setRPosition (CameraPosition (Vec3 (x,newh,y)) th ph) $ - setDDown 0 $ - if speed res > speedFactor res then - (setSpeed <..> speedFactor) res - else res + return $ ((setHeadBob.(+ jitter)) <..> headBob) $ + if (newh+0.3 > droph) then + setRPosition (CameraPosition (Vec3 (x,newh+0.2,y)) (th + asin dx) (ph - asin dy)) $ + setDDown 0 res else setRPosition (CameraPosition (Vec3 (x, droph, y)) th ph) $ - setDDown (dDown res + 0.05) res + setDDown (dDown res + 0.03) res {- A function which will explode if a uniform - does not exist for the shader given, otherwis, @@ -145,11 +179,9 @@ getUniformsSafe prog uniforms = {- Builds an model view matrix given the - camera position of the scene -} buildMVMatrix :: CameraPosition -> Mat4 GLfloat -buildMVMatrix (CameraPosition eye th ph) = - let up = if ph' >= 90 && ph' < 270 then Vec3 (0,-1,0) else Vec3 (0,1,0) - where ph' = (floor ph::Int) `mod` 360 in - let lookat = eye <+> (Vec3 $ toEuclidian (1,th,ph)) in - lookAtMatrix eye lookat up +buildMVMatrix camera@(CameraPosition eye _ _) = + let lookat = eye <+> cameraForward camera in + lookAtMatrix eye lookat (cameraUp camera) {- Called after each frame to crunch throught the - events -} @@ -184,28 +216,30 @@ eventHandle event res = do return $ setRDPosition (CameraPosition eye (th+1) ph) res MouseMotion _ _ x y -> do - return $ setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res + return $ + setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res KeyDown (Keysym SDLK_w _ _) -> - return $ setSpeed (speed res + speedFactor res) res + return $ setSpeedDirection (Vec3 (0,0,1)) res KeyDown (Keysym SDLK_s _ _) -> - return $ setSpeed (speed res - speedFactor res) res + return $ setSpeedDirection (Vec3 (0,0,-1)) res KeyUp (Keysym SDLK_w _ _) -> - return $ setSpeed 0 res + return $ setSpeedDirection (Vec3 (0,0,0)) res KeyUp (Keysym SDLK_s _ _) -> - return $ setSpeed 0 res + return $ setSpeedDirection (Vec3 (0,0,0)) res KeyUp (Keysym SDLK_q _ _) -> let getY (Vec3 (_,y,_)) = y in return $ setPositionUpdate firstPerson $ - setSpeedFactor 0.1 $ + setSpeedFactor 0.03 $ + setMode FirstPerson $ (setDDown <..> (negate . getY . resourcesVelocity)) res KeyUp (Keysym SDLK_e _ _) -> return $ setPositionUpdate return $ setSpeedFactor 1 $ - if speed res > 0 then setSpeed 1 res else res + setMode Oracle res KeyUp (Keysym SDLK_f _ _) -> do ret <- reshape 1920 1080 res @@ -219,18 +253,21 @@ eventHandle event res = do return res KeyDown (Keysym SDLK_SPACE _ _) -> do - return $ setDDown (-0.3) res + return $ setDDown (-0.2) res KeyDown (Keysym SDLK_LSHIFT _ _) -> do - return $ (setSpeed <..> ((*3) . speed)) res + return $ setSpeedMultiplier 4 res + KeyUp (Keysym SDLK_LSHIFT _ _) -> do - return $ (setSpeed <..> ((/3) . speed)) res + return $ setSpeedMultiplier 1 res _ -> return res + where oracle = if (mode res == FirstPerson) then 1 else 3 {- Callback for the display -} displayHandle :: Resources -> IO Resources displayHandle resources = do + time1 <- getPOSIXTime let cameraPos@(CameraPosition loc _ _) = rPosition resources let lighty = ((/10) . fromIntegral . time) resources let logist c = (1 / (1 + 2.71828**(-c*x))) * 0.9 + 0.1 @@ -263,13 +300,21 @@ displayHandle resources = do in mapM_ (Prelude.$rc) $ routines resources SDL.glSwapBuffers + time2 <- getPOSIXTime + + let diff = 0.033 - (time2 - time1) + when (diff > 0) (threadDelay $ round $ diff * 1000000) + time3 <- getPOSIXTime + + putStrLn $ "FPS: " ++! (1/ (time3 - time1)) + return resources cameraToEuclidian :: CameraPosition -> Vec3 GLfloat cameraToEuclidian (CameraPosition _ ph th) = V.normalize $ Vec3 $ toEuclidian (1,ph,th) resourcesVelocity :: Resources -> Vec3 GLfloat -resourcesVelocity res = speed res `vScale` cameraToEuclidian (rPosition res) +resourcesVelocity res = getSpeed res `vScale` cameraToEuclidian (rPosition res) resourcesUnderWater :: Resources -> IO Bool resourcesUnderWater res = do @@ -285,8 +330,8 @@ updateHandle res = do let new = ((+) `on` (Prelude.$ res)) timeSpeed time in setTime new res where (CameraPosition x y z) `cAdd` (CameraPosition _ y' z') = - let x' = speed res `vScale` (V.normalize $ Vec3 $ toEuclidian (1,y, z)) in - (CameraPosition (x <+> x') (y + y') (z + z')) + let x' = getVelocity res in + CameraPosition (x <+> x') (y + y') (z + z') reshape :: Int -> Int -> Resources -> IO Resources reshape w h res = @@ -506,14 +551,17 @@ makeResources surf builder forestB jungleB water arr waterarr = do <*> pure pMatrix' <*> pure pMatrix' <*> l_routines - <*> pure 0 <*> pure 1 <*> pure 0 <*> pure arr <*> pure return <*> pure 1 + <*> pure 1 + <*> pure (Vec3 (0,0,0)) <*> pure 0 <*> pure waterarr + <*> pure 0 + <*> pure Oracle printErrors :: String -> IO () printErrors ctx = -- cgit From 2407f9f400875b2162c93527f95f49b69ca98dd1 Mon Sep 17 00:00:00 2001 From: Joshua Rahm Date: Sun, 27 Apr 2014 23:51:51 -0600 Subject: made first person motion work well with strafing. Added king of hill map. --- Resources.hs | 40 +++++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 13 deletions(-) (limited to 'Resources.hs') diff --git a/Resources.hs b/Resources.hs index ddffb9c..9f0806f 100644 --- a/Resources.hs +++ b/Resources.hs @@ -41,6 +41,8 @@ import Data.Array import qualified Data.StateVar as SV import Data.Time.Clock.POSIX import Control.Concurrent +import Text.Printf +import System.IO {- Types of terrain which are possible -} data TileType = Forest | Beach | Water | Grass | Jungle | Mountains | @@ -96,7 +98,7 @@ data Resources = Resources { } getSpeed :: Resources -> GLfloat -getSpeed res =speedFactor res * speedMultiplier res +getSpeed res =speedFactor res * speedMultiplier res * norm (speedDirection res) cameraForward :: CameraPosition -> Vec3 GLfloat cameraForward (CameraPosition _ th ph) = Vec3 $ toEuclidian (1,th,ph) @@ -114,8 +116,8 @@ getVelocity :: Resources -> Vec3 GLfloat getVelocity res = let dir = speedDirection res camdir = cameraForward $ rPosition res - truedir = dir <-> (Vec3 (0,0,1) <-> camdir) in - getSpeed res `vScale` (norm dir `vScale` V.normalize truedir) + truedir = coordinateConvert camdir (Vec3 (0,1,0)) dir in + getSpeed res `vScale` maybeNormalize truedir data CameraMode = Oracle | FirstPerson deriving Eq @@ -151,13 +153,14 @@ firstPerson res = mixu2 = mix h4 h2 u newh = mix mixu2 mixu1 v droph = curh - dDown res - jitter = (max 0 $ getSpeed res - 0.029) ** 0.1 / 2 + speed = getSpeed res + jitter = (max 0 $ speed - 0.029) ** 0.1 / 2 dy = sin (headBob res*2) * jitter dx = realToFrac $ cos (headBob res) * jitter in do return $ ((setHeadBob.(+ jitter)) <..> headBob) $ if (newh+0.3 > droph) then - setRPosition (CameraPosition (Vec3 (x,newh+0.2,y)) (th + asin dx) (ph - asin dy)) $ + setRPosition (CameraPosition (Vec3 (x,newh+0.2,y)) (th + (asin dx) * speed * 15) (ph - (asin dy) * speed * 15)) $ setDDown 0 res else setRPosition (CameraPosition (Vec3 (x, droph, y)) th ph) $ @@ -189,6 +192,7 @@ eventHandle :: SDL.Event -> Resources -> IO Resources eventHandle event res = do let (CameraPosition eye th ph) = rDPosition res let (CameraPosition peye pth pph) = rPosition res + case event of KeyDown (Keysym SDLK_ESCAPE _ _) -> exitSuccess @@ -220,13 +224,22 @@ eventHandle event res = do setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res KeyDown (Keysym SDLK_w _ _) -> - return $ setSpeedDirection (Vec3 (0,0,1)) res + return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res KeyDown (Keysym SDLK_s _ _) -> - return $ setSpeedDirection (Vec3 (0,0,-1)) res + return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res + KeyDown (Keysym SDLK_d _ _) -> + return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res + KeyDown (Keysym SDLK_a _ _) -> + return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res + KeyUp (Keysym SDLK_w _ _) -> - return $ setSpeedDirection (Vec3 (0,0,0)) res + return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res KeyUp (Keysym SDLK_s _ _) -> - return $ setSpeedDirection (Vec3 (0,0,0)) res + return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res + KeyUp (Keysym SDLK_d _ _) -> + return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res + KeyUp (Keysym SDLK_a _ _) -> + return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res KeyUp (Keysym SDLK_q _ _) -> let getY (Vec3 (_,y,_)) = y in @@ -306,7 +319,7 @@ displayHandle resources = do when (diff > 0) (threadDelay $ round $ diff * 1000000) time3 <- getPOSIXTime - putStrLn $ "FPS: " ++! (1/ (time3 - time1)) + putStr $ printf "FPS: %.2f\r" (realToFrac $ 1/ (time3 - time1) :: Double) return resources @@ -521,6 +534,7 @@ makeResources :: SDL.Surface -> BuilderM GLfloat b -> BuilderM GLfloat a -> Array (Int,Int) Tile -> ArrIO.IOArray (Int,Int) GLfloat -> IO Resources makeResources surf builder forestB jungleB water arr waterarr = do + hSetBuffering stdout NoBuffering let pMatrix' = perspectiveMatrix 50 1.8 0.1 100 let l_routines = sequence [ @@ -533,15 +547,15 @@ makeResources surf builder forestB jungleB water arr waterarr = do blend $= Enabled cullFace $= Just Back blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha)), + buildWaterObject water, buildForestObject forestB "tree.obj" "textures/wood_low.png", - buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png", - buildWaterObject water + buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png" -- cloudProgram ] Resources <$> pure surf <*> do CameraPosition - <$> pure (Vec3 (10,10,2)) + <$> pure (Vec3 (10,10,-10)) <*> pure 0 <*> pure 0 <*> do CameraPosition -- cgit From 41d2402f004bd446c6c4975caa5211fd44d302f5 Mon Sep 17 00:00:00 2001 From: Joshua Rahm Date: Mon, 28 Apr 2014 03:23:51 -0600 Subject: renamed and updated kingofhill to goliath. Added "leap" to jump. Added self-correcting frame rate --- Resources.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) (limited to 'Resources.hs') diff --git a/Resources.hs b/Resources.hs index 9f0806f..e5cb528 100644 --- a/Resources.hs +++ b/Resources.hs @@ -94,7 +94,8 @@ data Resources = Resources { dDown :: GLfloat, waterArray :: ArrIO.IOArray (Int,Int) GLfloat, headBob :: GLfloat, - mode :: CameraMode + mode :: CameraMode, + threadDiff :: Double } getSpeed :: Resources -> GLfloat @@ -160,6 +161,7 @@ firstPerson res = in do return $ ((setHeadBob.(+ jitter)) <..> headBob) $ if (newh+0.3 > droph) then + setSpeedFactor 0.03 $ setRPosition (CameraPosition (Vec3 (x,newh+0.2,y)) (th + (asin dx) * speed * 15) (ph - (asin dy) * speed * 15)) $ setDDown 0 res else @@ -245,7 +247,6 @@ eventHandle event res = do let getY (Vec3 (_,y,_)) = y in return $ setPositionUpdate firstPerson $ - setSpeedFactor 0.03 $ setMode FirstPerson $ (setDDown <..> (negate . getY . resourcesVelocity)) res KeyUp (Keysym SDLK_e _ _) -> @@ -266,7 +267,9 @@ eventHandle event res = do return res KeyDown (Keysym SDLK_SPACE _ _) -> do - return $ setDDown (-0.2) res + return $ + setDDown (-0.2) $ + setSpeedFactor 0.05 res KeyDown (Keysym SDLK_LSHIFT _ _) -> do return $ setSpeedMultiplier 4 res @@ -315,13 +318,17 @@ displayHandle resources = do SDL.glSwapBuffers time2 <- getPOSIXTime - let diff = 0.033 - (time2 - time1) + let diff = threadDiff resources - (realToFrac $ time2 - time1) when (diff > 0) (threadDelay $ round $ diff * 1000000) time3 <- getPOSIXTime + let fps = realToFrac $ 1 / (time3 - time1) :: Double - putStr $ printf "FPS: %.2f\r" (realToFrac $ 1/ (time3 - time1) :: Double) + putStr $ printf "FPS: %.2f\r" fps - return resources + return $ + if' (fps < 30) + ((setThreadDiff.(subtract 0.0001)) <..> threadDiff) + ((setThreadDiff.(+0.0001)) <..> threadDiff) resources cameraToEuclidian :: CameraPosition -> Vec3 GLfloat cameraToEuclidian (CameraPosition _ ph th) = V.normalize $ Vec3 $ toEuclidian (1,ph,th) @@ -576,6 +583,7 @@ makeResources surf builder forestB jungleB water arr waterarr = do <*> pure waterarr <*> pure 0 <*> pure Oracle + <*> pure 0.033 printErrors :: String -> IO () printErrors ctx = -- cgit From 6c9d984c054d634d2873fa3a74c41d2436f7fd53 Mon Sep 17 00:00:00 2001 From: Joshua Rahm Date: Mon, 28 Apr 2014 14:40:02 -0600 Subject: added ability to get control of cursor with c. Updated goliath map --- Resources.hs | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'Resources.hs') diff --git a/Resources.hs b/Resources.hs index e5cb528..c0a947c 100644 --- a/Resources.hs +++ b/Resources.hs @@ -261,6 +261,10 @@ eventHandle event res = do SDL.showCursor False SDL.grabInput True return ret + KeyUp (Keysym SDLK_c _ _) -> do + SDL.showCursor True + SDL.grabInput False + return res KeyUp (Keysym SDLK_g _ _) -> do SDL.showCursor False SDL.grabInput True -- cgit From a60702dd882768e7f5b7fcadd39253ac8de9114f Mon Sep 17 00:00:00 2001 From: Joshua Rahm Date: Tue, 29 Apr 2014 03:57:40 -0600 Subject: added cheesey snow --- Resources.hs | 43 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 40 insertions(+), 3 deletions(-) (limited to 'Resources.hs') diff --git a/Resources.hs b/Resources.hs index c0a947c..a04afa7 100644 --- a/Resources.hs +++ b/Resources.hs @@ -43,6 +43,7 @@ import Data.Time.Clock.POSIX import Control.Concurrent import Text.Printf import System.IO +import System.Random {- Types of terrain which are possible -} data TileType = Forest | Beach | Water | Grass | Jungle | Mountains | @@ -282,7 +283,6 @@ eventHandle event res = do return $ setSpeedMultiplier 1 res _ -> return res - where oracle = if (mode res == FirstPerson) then 1 else 3 {- Callback for the display -} displayHandle :: Resources -> IO Resources @@ -448,6 +448,41 @@ buildTerrainObject builder = do -- uniform lightposU $= rcLightPos rc -- setupTexturing3D density densityU 0 +buildSnowVal :: Array (Int,Int) Tile -> StdGen -> BuilderM GLfloat () +buildSnowVal arr gen = + let (_,(w,h)) = bounds arr + run :: [Int] -> (Int,Int) -> BuilderM GLfloat [Int] + run rs (x,y) = do + let (seed:npart:t) = rs + nStdGen = mkStdGen seed + height = elevation (arr ! (x,y)) + when (tileType (arr ! (x,y)) == Tundra) $ + forM_ (take (npart`mod`50) $ chunkList3 $ randomRs (0::GLfloat,1) nStdGen ) $ \(a,b,c) -> do + let (x',y') = (int x + a, int y + b) + bVertex3 (x',c*100,y') + bColor4 (int $ height `div` 10,1, 0, 0) + + return t + in + + foldM_ run (randoms gen) [(x,y) | x <- [1..w], y <- [1..h]] + +buildSnowObject :: Array (Int,Int) Tile -> StdGen -> IO (ResourcesClosure -> IO ()) +buildSnowObject arr gen = do + snowProgram <- loadProgramSafe' "shaders/snow.vert" "shaders/snow.frag" (Just "shaders/snow.geom") + obj <- + liftM (setPrimitiveMode Ex.Points) $ + newDefaultGlyphObjectWithClosure (buildSnowVal arr gen) () $ \_ -> do + currentProgram $= Just snowProgram + + [globalAmbientU,pjMatrixU,mvMatrixU,timeU] <- + getUniformsSafe snowProgram ["globalAmbient","pjMatrix","mvMatrix","time"] + return $ \rc -> do + draw $ (prepare obj) $ \_ -> do + uniform mvMatrixU $= rcMVMatrix rc + uniform pjMatrixU $= rcPMatrix rc + uniform timeU $= (Index1 $ (rcTime rc/75)) + uniform globalAmbientU $= rcGlobalAmbient rc buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (ResourcesClosure -> IO ()) buildForestObject a_seq obj tex = @@ -532,7 +567,7 @@ buildWaterObject builder = do uniform (UniformLocation 5) $= rcMVMatrix rc uniform (UniformLocation 7) $= rcNormalMatrix rc uniform (UniformLocation 8) $= rcLightPos rc - uniform (UniformLocation 9) $= Index1 (rcTime rc / 20.0) + uniform (UniformLocation 9) $= Index1 (rcTime rc / 20.0); uniform (UniformLocation 10) $= rcGlobalAmbient rc bool <- (resourcesUnderWater $ rcResources rc) if bool then @@ -548,6 +583,7 @@ makeResources surf builder forestB jungleB water arr waterarr = do hSetBuffering stdout NoBuffering let pMatrix' = perspectiveMatrix 50 1.8 0.1 100 + stdgen <- newStdGen let l_routines = sequence [ skyboxObject, (return $ \_ -> do @@ -560,7 +596,8 @@ makeResources surf builder forestB jungleB water arr waterarr = do blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha)), buildWaterObject water, buildForestObject forestB "tree.obj" "textures/wood_low.png", - buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png" + buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png", + buildSnowObject arr stdgen -- cloudProgram ] Resources -- cgit