diff options
| -rw-r--r-- | Final.hs | 2 | ||||
| -rw-r--r-- | Graphics/Glyph/GLMath.hs | 11 | ||||
| -rw-r--r-- | Resources.hs | 40 | ||||
| -rw-r--r-- | maps/kingofhill_height.png | bin | 0 -> 13921 bytes | |||
| -rw-r--r-- | maps/kingofhill_terrain.png | bin | 0 -> 1101 bytes | |||
| -rw-r--r-- | maps/svalbard_height.png | bin | 10361 -> 19903 bytes | |||
| -rw-r--r-- | maps/svalbard_terrain.png | bin | 1862 -> 1946 bytes |
7 files changed, 39 insertions, 14 deletions
@@ -346,7 +346,7 @@ main = do (mapping,water) <- getWaterQuads arr coloredArr coloredArr2 <- mapArray (\idx -> if idx == 0 then -1 else Map.findWithDefault (-1) idx mapping) coloredArr - printShowArray coloredArr2 + -- printShowArray coloredArr2 {- Kick off SDL with the callbacks defined in Resources -} makeResources surface (createBuilder arr) forestLocations jungleLocations water arr coloredArr2 diff --git a/Graphics/Glyph/GLMath.hs b/Graphics/Glyph/GLMath.hs index 361ca16..ac3e93a 100644 --- a/Graphics/Glyph/GLMath.hs +++ b/Graphics/Glyph/GLMath.hs @@ -191,6 +191,17 @@ rotationMatrix ang (Vec3 (u,v,w)) = zRotationMatrix :: GLfloat -> Mat3 GLfloat zRotationMatrix ang = rotationMatrix ang (Vec3 (0,0,1)) +maybeNormalize :: (Vector f a, Eq f) => a f -> a f +maybeNormalize x = if norm x == 0 then x else normalize x + +coordinateConvert :: Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat +coordinateConvert forward up' vector = + if vector == Vec3 (0,0,0) then vector else + let right = forward × up' + up = right × forward in + case (normalize forward, normalize up, normalize right, vector) of + (za,ya,xa,Vec3 (x,y,z)) -> (x `vScale` xa) <+> (y `vScale` ya) <+> (z `vScale` za) + rotateFrom :: Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat rotateFrom vector relative newRelative = if vector == Vec3 (0,0,0) then vector else 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 diff --git a/maps/kingofhill_height.png b/maps/kingofhill_height.png Binary files differnew file mode 100644 index 0000000..b548cf2 --- /dev/null +++ b/maps/kingofhill_height.png diff --git a/maps/kingofhill_terrain.png b/maps/kingofhill_terrain.png Binary files differnew file mode 100644 index 0000000..39b6d0e --- /dev/null +++ b/maps/kingofhill_terrain.png diff --git a/maps/svalbard_height.png b/maps/svalbard_height.png Binary files differindex 6892b3a..656226a 100644 --- a/maps/svalbard_height.png +++ b/maps/svalbard_height.png diff --git a/maps/svalbard_terrain.png b/maps/svalbard_terrain.png Binary files differindex 5afd0b4..edc7f65 100644 --- a/maps/svalbard_terrain.png +++ b/maps/svalbard_terrain.png |
