aboutsummaryrefslogtreecommitdiffstats
path: root/src/Vivant.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Vivant.hs')
-rw-r--r--src/Vivant.hs255
1 files changed, 170 insertions, 85 deletions
diff --git a/src/Vivant.hs b/src/Vivant.hs
index 001b463..21c397e 100644
--- a/src/Vivant.hs
+++ b/src/Vivant.hs
@@ -14,7 +14,7 @@
module Main where
-import Control.Lens ((.~), (^.), (%~))
+import Control.Lens ((%~), (.~), (^.))
import Control.Monad
import qualified Data.ByteString as BS
import Data.Fixed (mod')
@@ -29,11 +29,11 @@ import Foreign.Marshal.Alloc (free, malloc)
import Foreign.Ptr
import Foreign.Storable (poke, sizeOf)
import qualified Graphics.GL.Compatibility33 as GL
+import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as GL (UniformLocation (..))
import Linear
import Paths_vivant (getDataDir)
-import Graphics.Rendering.OpenGL (($=))
import qualified SDL
import SDL.Raw.Enum as SDL
import SDL.Raw.Video as SDL (glSetAttribute)
@@ -41,10 +41,10 @@ import SDL.Time (ticks)
import SDL.Vect
import System.Exit (exitFailure)
import System.IO
-import Vivant.Shader (createProgram)
+import Vivant.Noise
import Vivant.Renderer
+import Vivant.Shader (createProgram)
import Vivant.Terrain
-import Vivant.Noise
screenWidth, screenHeight :: CInt
(screenWidth, screenHeight) = (640, 480)
@@ -123,7 +123,7 @@ main = do
window <-
SDL.createWindow
- "SDL / OpenGL Example"
+ "Vivant"
SDL.defaultWindow
{ SDL.windowInitialSize = V2 screenWidth screenHeight,
SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
@@ -182,14 +182,14 @@ parseEvents keys mouse = do
. changeIfIn events' mouseWheel (\(k, m) -> (k, m {mouseWheel = 0}))
$ changeIfIn events' mouseMoving (\(k, m) -> (k, m {mouseRelative = V2 0 0})) (k, m)
where
- mouseMoving (SDL.MouseMotionEvent{}) = True
+ mouseMoving (SDL.MouseMotionEvent {}) = True
mouseMoving _ = False
- mouseWheel (SDL.MouseWheelEvent{}) = True
+ mouseWheel (SDL.MouseWheelEvent {}) = True
mouseWheel _ = False
changeIfIn events event modification initial =
if (> 0) . length $ filter event events
- then initial
- else modification initial
+ then initial
+ else modification initial
handleEvents ::
SDL.EventPayload ->
@@ -212,20 +212,23 @@ handleEvents event (k, m) =
) ->
(k, MouseInputs pos vel (mousePositionOld m) (mousePressed m) (mouseWheel m))
SDL.MouseButtonEvent
- (SDL.MouseButtonEventData
- { SDL.mouseButtonEventMotion = SDL.Pressed
- }) ->
- (k, m {mousePressed = True})
+ ( SDL.MouseButtonEventData
+ { SDL.mouseButtonEventMotion = SDL.Pressed
+ }
+ ) ->
+ (k, m {mousePressed = True})
SDL.MouseButtonEvent
- (SDL.MouseButtonEventData
- { SDL.mouseButtonEventMotion = SDL.Released
- }) ->
- (k, m {mousePressed = False})
+ ( SDL.MouseButtonEventData
+ { SDL.mouseButtonEventMotion = SDL.Released
+ }
+ ) ->
+ (k, m {mousePressed = False})
SDL.MouseWheelEvent
- (SDL.MouseWheelEventData
- { SDL.mouseWheelEventPos = V2 x y
- }) ->
- (k, m {mouseWheel = y})
+ ( SDL.MouseWheelEventData
+ { SDL.mouseWheelEventPos = V2 x y
+ }
+ ) ->
+ (k, m {mouseWheel = y})
SDL.QuitEvent {} ->
(Set.insert escapeKey k, m)
_ -> (k, m)
@@ -235,40 +238,43 @@ updateMouse mouse game =
game
{ gameCamera =
(gameCamera game)
- {
- cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront),
+ { cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront),
cameraFront = newFront,
cameraUp = newUp
}
}
where
rotation v
- | mousePressed mouse = rotate (axisAngle (V3 0 0 1)
- ((/ 2) . toRadians . fromIntegral
- $ - (mouseRelative mouse ^. _x))) v
+ | mousePressed mouse =
+ rotate
+ ( axisAngle
+ (V3 0 0 1)
+ ( (/ 2) . toRadians . fromIntegral $
+ - (mouseRelative mouse ^. _x)
+ )
+ )
+ v
| otherwise = v
newPos = rotation . cameraPos $ gameCamera game
newUp = rotation . cameraUp $ gameCamera game
newFront = normalize (V3 0 0 0 ^-^ newPos)
-pixelRenderer :: Double -> Int -> Int -> Word8
+pixelRenderer :: Double -> Int -> Int -> Float
pixelRenderer n x y =
- doubleToByte $
+ fromRational . toRational $
( ( perlin3
permutation
- ( (fromIntegral x - 32) / 4,
- (fromIntegral y - 32) / 4,
+ ( (fromIntegral x - 32) / 16,
+ (fromIntegral y - 32) / 16,
n
)
)
+ 1
)
- / 2
- * 128
createTerrain :: [[Float]]
createTerrain =
- fmap (\y -> fmap (\x -> fromIntegral (pixelRenderer 0 x y) / 20) [0..63]) [0..63]
+ fmap (\y -> fmap (\x -> pixelRenderer 3 x y * 5) [0 .. 256]) [0 .. 256]
initResources :: IO Game
initResources = do
@@ -327,7 +333,7 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t})
cameraPosition = cameraPos camera
targetPosition = cameraPosition ^+^ cameraFront camera
viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera)
- projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 200
+ projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 500
poke (gameViewP game) viewMatrix
poke (gameProjectionP game) projectionMatrix
@@ -336,9 +342,9 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t})
GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game))
ourColorLoc <- GL.uniformLocation p "light_pos"
- GL.uniform ourColorLoc $=
- (GL.Vector3 (0::Float) (32 * sin (fromIntegral tick / 2000)) (16 * (abs $ cos (fromIntegral tick / 2000))))
- --castV3 (cameraPos (gameCamera game))
+ GL.uniform ourColorLoc
+ $= (GL.Vector3 (0 :: Float) (128 * sin (fromIntegral tick / 2000)) (64 * (abs $ cos (fromIntegral tick / 2000))))
+ --castV3 (cameraPos (gameCamera game))
render $ terrainRenderer t
@@ -351,59 +357,138 @@ vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
vertices :: V.Vector Float
vertices =
V.fromList
- [ 0.5, -0.5, 0,
- -0.5, -0.5, 0,
- 0.5, 0.5, 0,
- -0.5, 0.5, 0,
- -0.5, -0.5, 0,
- 0.5, 0.5, 0
+ [ 0.5,
+ -0.5,
+ 0,
+ -0.5,
+ -0.5,
+ 0,
+ 0.5,
+ 0.5,
+ 0,
+ -0.5,
+ 0.5,
+ 0,
+ -0.5,
+ -0.5,
+ 0,
+ 0.5,
+ 0.5,
+ 0
]
square :: V.Vector Float
square =
V.fromList
- [ -0.5, -0.5, -0.5,
- 0.5, -0.5, -0.5,
- 0.5, 0.5, -0.5,
- 0.5, 0.5, -0.5,
- -0.5, 0.5, -0.5,
- -0.5, -0.5, -0.5,
-
- -0.5, -0.5, 0.5,
- 0.5, -0.5, 0.5,
- 0.5, 0.5, 0.5,
- 0.5, 0.5, 0.5,
- -0.5, 0.5, 0.5,
- -0.5, -0.5, 0.5,
-
- -0.5, 0.5, 0.5,
- -0.5, 0.5, -0.5,
- -0.5, -0.5, -0.5,
- -0.5, -0.5, -0.5,
- -0.5, -0.5, 0.5,
- -0.5, 0.5, 0.5,
-
- 0.5, 0.5, 0.5,
- 0.5, 0.5, -0.5,
- 0.5, -0.5, -0.5,
- 0.5, -0.5, -0.5,
- 0.5, -0.5, 0.5,
- 0.5, 0.5, 0.5,
-
- -0.5, -0.5, -0.5,
- 0.5, -0.5, -0.5,
- 0.5, -0.5, 0.5,
- 0.5, -0.5, 0.5,
- -0.5, -0.5, 0.5,
- -0.5, -0.5, -0.5,
-
- -0.5, 0.5, -0.5,
- 0.5, 0.5, -0.5,
- 0.5, 0.5, 0.5,
- 0.5, 0.5, 0.5,
- -0.5, 0.5, 0.5,
- -0.5, 0.5, -0.5
- ]
+ [ -0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ -0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ 0.5,
+ -0.5,
+ 0.5,
+ -0.5
+ ]
locs :: [V3 Float]
locs =
generated by cgit (git 2.34.1) at 2024-05-19 10:49:18 +0000