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

Compare commits

base: Drezil:tessallation
Branches Tags
Drezil:master
Drezil:tessallation
Drezil:gh-pages
..
compare: Drezil:master
Branches Tags
Drezil:tessallation
Drezil:master
Drezil:gh-pages

No commits in common. "tessallation" and "master" have entirely different histories.
tessallati ... master

11 changed files with 92 additions and 187 deletions
Show Stats Expand all files Collapse all files

4
shaders/map/fragment.shader
View File

@ -96,8 +96,8 @@ float snoise(vec3 v)
float fog(float dist) { float fog(float dist) {
dist = max(0,dist - 50); dist = max(0,dist - 50);
dist = dist * 0.005; dist = dist * 0.05;
dist = dist*dist; // dist = dist*dist;
return 1-exp(-dist); return 1-exp(-dist);
} }

6
shaders/mapobjects/vertex.shader
View File

@ -6,8 +6,7 @@ layout(location=2) in vec2 TexCoord;
uniform mat4 ProjectionMatrix; uniform mat4 ProjectionMatrix;
uniform mat4 ViewMatrix; uniform mat4 ViewMatrix;
uniform mat3 NormalMatrix; uniform mat3 NormalMatrix;
uniform vec3 PositionOffset = vec3(5.0,2.0,5.0); uniform vec3 PositionOffset = vec3(5,2,5);
uniform vec3 Scale = vec3(1.0,1.0,1.0);
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons
@ -17,7 +16,6 @@ out vec3 vNormal;
void main () { void main () {
vPosition = Position; vPosition = Position;
//gl_Position = vec4(Position,1); //gl_Position = vec4(Position,1);
// component-wise gl_Position = ProjectionMatrix * ViewMatrix * vec4(PositionOffset + Position, 1);
gl_Position = ProjectionMatrix * ViewMatrix * vec4(PositionOffset + (Scale * Position), 1);
vNormal = Normal; vNormal = Normal;
} }

40
src/Icons/GUIQuad.hs
View File

@ -1,40 +0,0 @@
module Icons.GUIQuad (GUIQuad(..), Icon(..), marshalIcon) where
import Data.Word (Word8)
type Coord = (Float, Float)
type ZIndex = Float
data GUIQuad = GUIQuad Coord Coord ZIndex Icon
data Icon =
Woodcutter
| Stonemason
--
| CloseButton
| NextButton
| PreviousButton
numIcons :: Int
numIcons = 32
sizeIcon :: Float
sizeIcon = 1.0/(fromIntegral numIcons)
iconToTex :: Icon -> Coord
iconToTex i =
(x,y)
where
x = (fromIntegral (num `mod` numIcons)) * sizeIcon
y = (fromIntegral (num `div` numIcons)) * sizeIcon
num = fromIntegral.marshalIcon $ i
marshalIcon :: Icon -> Word8
marshalIcon a = case a of
Woodcutter -> 0
Stonemason -> 1
--
CloseButton -> 32
NextButton -> 33
PreviousButton -> 34

15
src/Main.hs
View File

@ -117,7 +117,7 @@ main = do
let camStack' = Map.empty let camStack' = Map.empty
glHud' <- initHud glHud' <- initHud
let zDistClosest' = 2 let zDistClosest' = 2
zDistFarthest' = zDistClosest' + 100 zDistFarthest' = zDistClosest' + 10
--TODO: Move near/far/fov to state for runtime-changability & central storage --TODO: Move near/far/fov to state for runtime-changability & central storage
aks = ArrowKeyState { aks = ArrowKeyState {
_up = False _up = False
@ -190,13 +190,12 @@ run = do
cam <- readTVar (state ^. camera) cam <- readTVar (state ^. camera)
game' <- readTVar (state ^. game) game' <- readTVar (state ^. game)
let let
scrollFactor = 1
multc = cos $ cam ^. yAngle multc = cos $ cam ^. yAngle
mults = sin $ cam ^. yAngle mults = sin $ cam ^. yAngle
modx x' = x' - kxrot * multc * scrollFactor modx x' = x' - 0.2 * kxrot * multc
- kyrot * mults * scrollFactor - 0.2 * kyrot * mults
mody y' = y' + kxrot * mults * scrollFactor mody y' = y' + 0.2 * kxrot * mults
- kyrot * multc * scrollFactor - 0.2 * kyrot * multc
cam' <- return $ camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (game' ^. currentMap)) $ cam cam' <- return $ camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (game' ^. currentMap)) $ cam
writeTVar (state ^. camera) cam' writeTVar (state ^. camera) cam'
@ -233,7 +232,7 @@ run = do
now' <- getCurrentTime now' <- getCurrentTime
return (now',tessChange,sleepAmount,ddiff,hasChanged) return (now',tessChange,sleepAmount,ddiff,hasChanged)
-- set state with new clock-time -- set state with new clock-time
--liftIO $ putStrLn $ unwords ["clockFactor:",show (state ^. io.tessClockFactor),"\ttc:", show (tc (state ^. gl.glMap.stateTessellationFactor)),"\tframe took ",show frameTime,"ms"] --liftIO $ putStrLn $ unwords ["clockFactor:",show (state ^. io.tessClockFactor),"\ttc:", show (tc (state ^. gl.glMap.stateTessellationFactor)),"\tsleep ",show frameTime,"ms"]
if hC then if hC then
do do
liftIO $ putStrLn $ unwords ["modifying TessFactor to",show $ tc $ state ^. gl.glMap.stateTessellationFactor] liftIO $ putStrLn $ unwords ["modifying TessFactor to",show $ tc $ state ^. gl.glMap.stateTessellationFactor]
@ -274,7 +273,7 @@ adjustWindow = do
fbHeight = state ^. window.height fbHeight = state ^. window.height
fov = 90 --field of view fov = 90 --field of view
near = 1 --near plane near = 1 --near plane
far = 500 --far plane far = 100 --far plane
ratio = fromIntegral fbWidth / fromIntegral fbHeight ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio frust = createFrustum fov near far ratio
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight) liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)

13
src/Map/Graphics.hs
View File

@ -7,8 +7,7 @@ fgColorIndex,
fgNormalIndex, fgNormalIndex,
fgVertexIndex, fgVertexIndex,
mapStride, mapStride,
getMapBufferObject, getMapBufferObject
unitLength
) )
where where
@ -40,10 +39,6 @@ type MapEntry = (
) )
type GraphicsMap = Array (Int, Int) MapEntry type GraphicsMap = Array (Int, Int) MapEntry
-- | length of 1 Unit in World-Coordinates
unitLength :: Double
unitLength = 10.0
-- converts from classical x/z to striped version of a map -- converts from classical x/z to striped version of a map
convertToStripeMap :: PlayMap -> PlayMap convertToStripeMap :: PlayMap -> PlayMap
convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp)) convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp))
@ -210,8 +205,6 @@ colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0)
coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat
coordLookup (x,z) y = coordLookup (x,z) y =
if even x then if even x then
(f unitLength) *^ V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight) V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight)
else else
(f unitLength) *^ V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight) V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight)
where
f = fromRational.toRational

17
src/Map/Map.hs
View File

@ -1,7 +1,6 @@
module Map.Map where module Map.Map where
import Map.Types import Map.Types
import Map.Graphics (unitLength)
import Data.Array (bounds, (!)) import Data.Array (bounds, (!))
import Data.List (sort, group) import Data.List (sort, group)
@ -45,23 +44,21 @@ giveMapHeight :: PlayMap
-> (Double, Double) -> (Double, Double)
-> Double -> Double
giveMapHeight mop (x, z) giveMapHeight mop (x, z)
| outsideMap (x/unitLength,z'/unitLength) = 0.0 | outsideMap (x,z') = 0.0
| otherwise = height' --sum $ map (\(p,d) -> hlu p * (d / totald)) tups | otherwise = height --sum $ map (\(p,d) -> hlu p * (d / totald)) tups
where where
z' = z * 2/ sqrt 3 z' = z * 2/ sqrt 3
rx = (x/unitLength) - (fromIntegral $ floor (x/unitLength )) rx = x - (fromIntegral $ floor (x +0.5))
rz = (z'/unitLength) - (fromIntegral $ floor (z'/unitLength)) rz = z' - (fromIntegral $ floor (z'+0.5))
hoi = map (hlu . clmp . tadd (floor (x/unitLength), floor (z'/unitLength))) mods hoi = map (hlu . clmp . tadd (floor x, floor z')) mods
where where
mods = [(0,0),(0,1),(1,0),(1,1)] mods = [(0,0),(0,1),(1,0),(1,1)]
tadd (a,b) (c,d) = (a+c,b+d) tadd (a,b) (c,d) = (a+c,b+d)
height' = height*unitLength
height = --trace (show [rx,rz] ++ show hoi) height = --trace (show [rx,rz] ++ show hoi)
(1-rz) * ((1-rx) * (hoi !! 0) + rx * (hoi !! 2)) rz * (rx * (hoi !! 0) + (1-rx) * (hoi !! 2))
+ rz * ((1-rx) * (hoi !! 1) + rx * (hoi !! 3)) + (1-rz) * (rx * (hoi !! 1) + (1-rx) * (hoi !! 3))
outsideMap :: (Double, Double) -> Bool outsideMap :: (Double, Double) -> Bool
outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mop outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mop

11
src/Render/Misc.hs
View File

@ -68,14 +68,13 @@ createProgramUsing shaders = do
createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat
createFrustum fov n' f' rat = createFrustum fov n' f' rat =
let let
ff = fromRational.toRational f = realToFrac f'
f = ff f' n = realToFrac n'
n = ff n' s = realToFrac $ recip (tan $ fov*0.5 * pi / 180)
s = ff $ recip (tan $ fov*0.5 * pi / 180)
(ratw,rath) = if rat > 1 then (ratw,rath) = if rat > 1 then
(1,1/ff rat) (1,1/realToFrac rat)
else else
(ff rat,1) (realToFrac rat,1)
in in
V4 (V4 (s/ratw) 0 0 0) V4 (V4 (s/ratw) 0 0 0)
(V4 0 (s/rath) 0 0) (V4 0 (s/rath) 0 0)

111
src/Render/Render.hs
View File

@ -9,9 +9,9 @@ import Graphics.Rendering.OpenGL.Raw.Core31
import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
import Graphics.GLUtil.BufferObjects import Graphics.GLUtil.BufferObjects
import qualified Linear as L import qualified Linear as L
import Control.Lens ((^.),(%~)) import Control.Lens ((^.))
import Control.Monad.RWS.Strict (liftIO) import Control.Monad.RWS.Strict (liftIO)
import qualified Control.Monad.RWS.Strict as RWS (get,modify) import qualified Control.Monad.RWS.Strict as RWS (get)
import Control.Concurrent.STM (readTVarIO) import Control.Concurrent.STM (readTVarIO)
import Data.Distributive (distribute, collect) import Data.Distributive (distribute, collect)
-- FFI -- FFI
@ -166,12 +166,6 @@ initMapShader tessFac (buf, vertDes) = do
normalMatrixIndex' <- get (uniformLocation objProgram "NormalMatrix") normalMatrixIndex' <- get (uniformLocation objProgram "NormalMatrix")
checkError "normalMat" checkError "normalMat"
positionOffsetIndex' <- get (uniformLocation objProgram "PositionOffset")
checkError "PositionOffset"
scaleIndex' <- get (uniformLocation objProgram "Scale")
checkError "Scale"
--tessLevelInner' <- get (uniformLocation objProgram "TessLevelInner") --tessLevelInner' <- get (uniformLocation objProgram "TessLevelInner")
--checkError "TessLevelInner" --checkError "TessLevelInner"
@ -188,10 +182,7 @@ initMapShader tessFac (buf, vertDes) = do
putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')] putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')]
testobj <- parseIQM "models/holzfaellerHaus1.iqm" testobj <- parseIQM "models/holzfaellerHaus1.iqm"
cube <- parseIQM "models/box.iqm" let objs = [MapObject testobj (L.V3 0 10 0) (MapObjectState ())]
let objs = [ MapObject testobj (L.V3 20 10 20) (MapObjectState ())
, MapObject cube (L.V3 25 5 25) (MapObjectState ())
]
currentProgram $= Nothing currentProgram $= Nothing
@ -209,33 +200,31 @@ initMapShader tessFac (buf, vertDes) = do
} }
let smodata = MapObjectShaderData let smodata = MapObjectShaderData
{ shdrMOVertexIndex = vertexIndex' { shdrMOVertexIndex = vertexIndex'
, shdrMOVertexOffsetIndex = vertexOffsetIndex' , shdrMOVertexOffsetIndex = vertexOffsetIndex'
, shdrMONormalIndex = normalIndex' , shdrMONormalIndex = normalIndex'
, shdrMOTexIndex = texIndex' , shdrMOTexIndex = texIndex'
, shdrMOProjMatIndex = projectionMatrixIndex' , shdrMOProjMatIndex = projectionMatrixIndex'
, shdrMOViewMatIndex = viewMatrixIndex' , shdrMOViewMatIndex = viewMatrixIndex'
, shdrMOModelMatIndex = modelMatrixIndex' , shdrMOModelMatIndex = modelMatrixIndex'
, shdrMONormalMatIndex = normalMatrixIndex' , shdrMONormalMatIndex = normalMatrixIndex'
, shdrMOPositionOffsetIndex = positionOffsetIndex' , shdrMOTessInnerIndex = UniformLocation 0 --tessLevelInner'
, shdrMOScaleIndex = scaleIndex' , shdrMOTessOuterIndex = UniformLocation 0 --tessLevelOuter'
, shdrMOTessInnerIndex = UniformLocation 0 --tessLevelInner'
, shdrMOTessOuterIndex = UniformLocation 0 --tessLevelOuter'
} }
return (GLMapState return (GLMapState
{ _mapProgram = program { _mapProgram = program
, _mapShaderData = sdata , _mapShaderData = sdata
, _mapObjectShaderData = smodata , _mapObjectShaderData = smodata
, _stateTessellationFactor = tessFac , _stateTessellationFactor = tessFac
, _stateMap = buf , _stateMap = buf
, _mapVert = vertDes , _mapVert = vertDes
, _overviewTexture = overTex , _overviewTexture = overTex
, _mapTextures = textures , _mapTextures = textures
, _shadowMapTexture = smap , _shadowMapTexture = smap
, _mapObjects = objs , _mapObjects = objs
, _objectProgram = objProgram , _objectProgram = objProgram
, _shadowMapProgram = shadowProgram , _shadowMapProgram = shadowProgram
}, tex, dtex) }, tex, dtex)
initHud :: IO GLHud initHud :: IO GLHud
@ -296,31 +285,23 @@ initRendering = do
-- | renders an IQM-Model at Position with scaling -- | renders an IQM-Model at Position with scaling
renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> Pioneers () renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
renderIQM m (L.V3 x y z) (L.V3 sx sy sz) = do renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
state <- RWS.get withVAO (vertexArrayObject m) $ do
let withVAA [(AttribLocation 0),(AttribLocation 1)] $ do
dmo = state ^. gl.glMap.mapObjectShaderData checkError "setting array to enabled"
po = shdrMOPositionOffsetIndex dmo bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
so = shdrMOScaleIndex dmo checkError "bindBuffer"
liftIO $ do let n = fromIntegral.(*3).num_triangles.header $ m
withVAO (vertexArrayObject m) $ do --print $ concat ["drawing ", show n," triangles"]
withVAA [(AttribLocation 0),(AttribLocation 1)] $ do drawElements Triangles n UnsignedInt nullPtr
uniform po $= Vertex3 x y z checkError "drawing model"
uniform so $= Vertex3 sx sy sz bindBuffer ElementArrayBuffer $= Nothing
checkError "setting array to enabled" checkError "unbind buffer"
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m) return ()
checkError "bindBuffer"
let n = fromIntegral.(*3).num_triangles.header $ m
--print $ concat ["drawing ", show n," triangles"]
drawElements Triangles n UnsignedInt nullPtr
checkError "drawing model"
bindBuffer ElementArrayBuffer $= Nothing
checkError "unbind buffer"
return ()
renderObject :: MapObject -> Pioneers () renderObject :: MapObject -> IO ()
renderObject (MapObject model pos _{-state-}) = renderObject (MapObject model pos@(L.V3 x y z) _{-state-}) =
renderIQM model pos (L.V3 1 1 1) renderIQM model pos (L.V3 1 1 1)
drawMap :: Pioneers () drawMap :: Pioneers ()
@ -362,7 +343,6 @@ drawMap = do
(ColorAttachment 1) --sample 1 (ColorAttachment 1) --sample 1
Renderbuffer --const Renderbuffer --const
rb --buffer-} rb --buffer-}
mat44ToGPU :: L.M44 CFloat -> UniformLocation -> String -> IO () mat44ToGPU :: L.M44 CFloat -> UniformLocation -> String -> IO ()
mat44ToGPU mat (UniformLocation dest) name = do mat44ToGPU mat (UniformLocation dest) name = do
with (distribute mat) $ \ptr -> with (distribute mat) $ \ptr ->
@ -406,14 +386,6 @@ render = do
(Just a) -> a (Just a) -> a
Nothing -> L.eye3) :: L.M33 CFloat Nothing -> L.eye3) :: L.M33 CFloat
nmap = collect id normal' :: L.M33 CFloat --transpose... nmap = collect id normal' :: L.M33 CFloat --transpose...
camTarget = getCamTarget camPos
moveTo :: L.V3 CFloat -> MapObject -> MapObject
moveTo p (MapObject o _ s) = MapObject o p s
-- TODO: remove hack for Target
RWS.modify $ gl.glMap.mapObjects %~ (\objs ->
head objs : [moveTo camTarget $ objs !! 1])
liftIO $ do liftIO $ do
@ -527,8 +499,7 @@ render = do
--set up normal --set up normal
mat33ToGPU nmap nmatmo "mapObjects-nmat" mat33ToGPU nmap nmatmo "mapObjects-nmat"
mapM_ renderObject (state ^. gl.glMap.mapObjects) mapM_ renderObject (state ^. gl.glMap.mapObjects)
liftIO $ do
checkError "draw mapobjects" checkError "draw mapobjects"
---- COMPOSE RENDERING -------------------------------------------- ---- COMPOSE RENDERING --------------------------------------------

10
src/Render/Types.hs
View File

@ -24,8 +24,6 @@ class GLCamera a where
moveBy :: a -> (Position -> Position) -> PlayMap -> a moveBy :: a -> (Position -> Position) -> PlayMap -> a
-- | Moves the Camera-Target to an absoloute position -- | Moves the Camera-Target to an absoloute position
move :: a -> Position -> PlayMap -> a move :: a -> Position -> PlayMap -> a
-- | Gets the target point of a camera
getCamTarget :: a -> V3 CFloat
-- | Alias for a camera-position onto the 2d-plane it moves on -- | Alias for a camera-position onto the 2d-plane it moves on
type Position = (Double, Double) type Position = (Double, Double)
@ -90,14 +88,6 @@ instance GLCamera Camera where
(x,z) = f (x', z') (x,z) = f (x', z')
y = giveMapHeight map (x,z) y = giveMapHeight map (x,z)
move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
getCamTarget (Flat (x',z') y') =
V3 x y z
where
x = realToFrac x'
y = realToFrac y'
z = realToFrac z'
getCamTarget (Sphere (inc', az') r') =
undefined
-- | converting spherical to cartesian coordinates -- | converting spherical to cartesian coordinates
sphereToCart :: (Floating a) => a -> a -> a -> V3 a sphereToCart :: (Floating a) => a -> a -> a -> V3 a

46
src/Types.hs
View File

@ -9,7 +9,7 @@ import qualified Data.HashMap.Strict as Map
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Linear.Matrix (M44) import Linear.Matrix (M44)
import Linear (V3) import Linear (V3)
import Control.Monad.RWS.Strict (RWST, get) import Control.Monad.RWS.Strict (RWST, liftIO, get)
import Control.Monad.Writer.Strict import Control.Monad.Writer.Strict
--import Control.Monad (when) --import Control.Monad (when)
import Control.Lens import Control.Lens
@ -96,18 +96,18 @@ data KeyboardState = KeyboardState
data GLMapState = GLMapState data GLMapState = GLMapState
{ _mapShaderData :: !MapShaderData { _mapShaderData :: !MapShaderData
, _mapObjectShaderData :: !MapObjectShaderData , _mapObjectShaderData :: !MapObjectShaderData
, _stateTessellationFactor :: !Int , _stateTessellationFactor :: !Int
, _stateMap :: !GL.BufferObject , _stateMap :: !GL.BufferObject
, _mapVert :: !GL.NumArrayIndices , _mapVert :: !GL.NumArrayIndices
, _mapProgram :: !GL.Program , _mapProgram :: !GL.Program
, _overviewTexture :: !TextureObject , _overviewTexture :: !TextureObject
, _shadowMapTexture :: !TextureObject , _shadowMapTexture :: !TextureObject
, _mapTextures :: ![TextureObject] --TODO: Fix size on list? , _mapTextures :: ![TextureObject] --TODO: Fix size on list?
, _objectProgram :: !GL.Program , _objectProgram :: !GL.Program
, _mapObjects :: ![MapObject] , _mapObjects :: ![MapObject]
, _shadowMapProgram :: !GL.Program , _shadowMapProgram :: !GL.Program
} }
data MapShaderData = MapShaderData data MapShaderData = MapShaderData
@ -123,18 +123,16 @@ data MapShaderData = MapShaderData
} }
data MapObjectShaderData = MapObjectShaderData data MapObjectShaderData = MapObjectShaderData
{ shdrMOVertexIndex :: !GL.AttribLocation { shdrMOVertexIndex :: !GL.AttribLocation
, shdrMOVertexOffsetIndex :: !GL.UniformLocation , shdrMOVertexOffsetIndex :: !GL.UniformLocation
, shdrMONormalIndex :: !GL.AttribLocation , shdrMONormalIndex :: !GL.AttribLocation
, shdrMOTexIndex :: !GL.AttribLocation , shdrMOTexIndex :: !GL.AttribLocation
, shdrMOProjMatIndex :: !GL.UniformLocation , shdrMOProjMatIndex :: !GL.UniformLocation
, shdrMOViewMatIndex :: !GL.UniformLocation , shdrMOViewMatIndex :: !GL.UniformLocation
, shdrMOModelMatIndex :: !GL.UniformLocation , shdrMOModelMatIndex :: !GL.UniformLocation
, shdrMONormalMatIndex :: !GL.UniformLocation , shdrMONormalMatIndex :: !GL.UniformLocation
, shdrMOPositionOffsetIndex :: !GL.UniformLocation , shdrMOTessInnerIndex :: !GL.UniformLocation
, shdrMOScaleIndex :: !GL.UniformLocation , shdrMOTessOuterIndex :: !GL.UniformLocation
, shdrMOTessInnerIndex :: !GL.UniformLocation
, shdrMOTessOuterIndex :: !GL.UniformLocation
} }

2
src/UI/Callbacks.hs
View File

@ -123,7 +123,7 @@ eventCallback e = do
state <- get state <- get
liftIO $ atomically $ do liftIO $ atomically $ do
cam <- readTVar (state ^. camera) cam <- readTVar (state ^. camera)
let zDist' = (cam ^. zDist) + 4*realToFrac (negate vscroll) let zDist' = (cam ^. zDist) + realToFrac (negate vscroll)
zDist'' = curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist' zDist'' = curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist'
cam' <- return $ zDist .~ zDist'' $ cam cam' <- return $ zDist .~ zDist'' $ cam
writeTVar (state ^. camera) cam' writeTVar (state ^. camera) cam'