nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

hunted down warnings

Browse source
This commit is contained in:
nek0 2018-03-06 21:58:55 +01:00
parent d91f4bf9c1
commit 8023f93ce7
1 changed files with 21 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
src/Test.hs
View file

@ -41,8 +41,8 @@ loadMap = do
[] -- [(5,5), (35, 35)] [] -- [(5,5), (35, 35)]
(50,75) (50,75)
(Subsystems _ m) = subsystems ud (Subsystems _ m) = subsystems ud
(matrix, gr) <- liftIO $ buildHallFloorIO fc (mat, gr) <- liftIO $ buildHallFloorIO fc
inter <- liftIO $ placeInteriorIO matrix (convertTileToImg matrix) gr inter <- liftIO $ placeInteriorIO mat (convertTileToImg mat) gr
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
void $ newEntity $ defEntity void $ newEntity $ defEntity
{ pos = Just (V2 20.5 20.5) { pos = Just (V2 20.5 20.5)
@ -53,7 +53,7 @@ loadMap = do
putAffection ud putAffection ud
{ worldState = nws { worldState = nws
, stateData = MenuData , stateData = MenuData
{ mapMat = matrix { mapMat = mat
, imgMat = inter , imgMat = inter
, initCoords = (0, 500) , initCoords = (0, 500)
} }
@ -63,13 +63,12 @@ loadMap = do
mouseToPlayer :: V2 Int32 -> Affection UserData () mouseToPlayer :: V2 Int32 -> Affection UserData ()
mouseToPlayer mv2 = do mouseToPlayer mv2 = do
ud <- getAffection ud <- getAffection
rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
let dr = (ry / sin (atan (1/2)) / 2) + rx let dr = (ry / sin (atan (1/2)) / 2) + rx
dc = rx - (ry / sin (atan (1/2)) / 2) dc = rx - (ry / sin (atan (1/2)) / 2)
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
emap $ do emap $ do
with player with player
pos' <- E.get pos
pure $ defEntity' pure $ defEntity'
{ vel = Set $ V2 dr dc { vel = Set $ V2 dr dc
} }
@ -81,7 +80,7 @@ movePlayer :: MouseMessage -> Affection UserData ()
movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m
movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) =
mouseToPlayer m mouseToPlayer m
movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ m) = do movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do
ud <- getAffection ud <- getAffection
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
emap $ do emap $ do
@ -104,10 +103,10 @@ drawMap = do
pos' <- E.get pos pos' <- E.get pos
pure pos' pure pos'
let V2 pr pc = head playerPos let V2 pr pc = head playerPos
matrix = imgMat (stateData ud) mat = imgMat (stateData ud)
ctx = nano ud ctx = nano ud
cols = fromIntegral (ncols matrix) cols = fromIntegral (ncols mat)
rows = fromIntegral (nrows matrix) rows = fromIntegral (nrows mat)
tileWidth = 64 :: Double tileWidth = 64 :: Double
tileHeight = 32 :: Double tileHeight = 32 :: Double
x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2) x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2)
@ -131,7 +130,7 @@ drawMap = do
(\(j, t) -> drawTile (\(j, t) -> drawTile
(assetImages ud) ctx pr pc i j t) (assetImages ud) ctx pr pc i j t)
(reverse $ zip [1..] ls)) (reverse $ zip [1..] ls))
(zip [1..] (toLists matrix)) (zip [1..] (toLists mat))
fontSize ctx 20 fontSize ctx 20
fontFace ctx (assetFonts ud Map.! FontBedstead) fontFace ctx (assetFonts ud Map.! FontBedstead)
textAlign ctx (S.fromList [AlignCenter,AlignTop]) textAlign ctx (S.fromList [AlignCenter,AlignTop])
@ -141,12 +140,11 @@ drawMap = do
updateMap :: Double -> Affection UserData () updateMap :: Double -> Affection UserData ()
updateMap dt = do updateMap dt = do
ud <- getAffection ud <- getAffection
let matrix = mapMat $ stateData ud
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
emap $ do emap $ do
with vel with vel
with pos with pos
pos'@(V2 or oc) <- E.get pos pos'@(V2 pr pc) <- E.get pos
vel' <- E.get vel vel' <- E.get vel
let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel' let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
dpos = npos - pos' dpos = npos - pos'
@ -155,7 +153,7 @@ updateMap dt = do
(checkBoundsCollision pos' npos) (checkBoundsCollision pos' npos)
(V2 1 1) (V2 1 1)
((imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc))) ++ ((imgObstacle (imgMat (stateData ud) M.! (floor nr, floor nc))) ++
(imgObstacle (imgMat (stateData ud) M.! (floor or, floor oc)))) (imgObstacle (imgMat (stateData ud) M.! (floor pr, floor pc))))
} }
return ent return ent
putAffection ud putAffection ud
@ -182,8 +180,8 @@ drawTile ai ctx pr pc row col img =
drawImage drawImage
drawPlayer drawPlayer
else do else do
if any (\minr -> pr <= fromIntegral (floor pr) + minr) minrs && if any (\minr -> pr <= (fromIntegral (floor pr :: Int)) + minr) minrs &&
any (\minc -> pc >= fromIntegral (floor pc) + minc) mincs any (\minc -> pc >= (fromIntegral (floor pc :: Int)) + minc) mincs
then do then do
drawPlayer drawPlayer
drawImage drawImage
@ -197,7 +195,6 @@ drawTile ai ctx pr pc row col img =
minrs = Prelude.map (fst . matmin) mb minrs = Prelude.map (fst . matmin) mb
maxrs = Prelude.map (fst . matmax) mb maxrs = Prelude.map (fst . matmax) mb
mincs = Prelude.map (snd . matmin) mb mincs = Prelude.map (snd . matmin) mb
maxcs = Prelude.map (snd . matmax) mb
x = realToFrac $ 640 + ((fromIntegral col - pc) + x = realToFrac $ 640 + ((fromIntegral col - pc) +
(fromIntegral row - pr)) * (tileWidth / 2) (fromIntegral row - pr)) * (tileWidth / 2)
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) - y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
@ -205,7 +202,7 @@ drawTile ai ctx pr pc row col img =
dist = distance (V2 (fromIntegral row) (fromIntegral col)) dist = distance (V2 (fromIntegral row) (fromIntegral col))
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4 (V2 (realToFrac pr - 1) (realToFrac pc)) / 4
fact = fact =
if (pr <= fromIntegral row + minimum maxrs && if (pr <= fromIntegral row + maximum maxrs &&
pc >= fromIntegral col + minimum mincs) && pc >= fromIntegral col + minimum mincs) &&
isWall (fromJust img) isWall (fromJust img)
then min 1 dist then min 1 dist
@ -248,8 +245,7 @@ checkBoundsCollision
-> Boundaries Double -> Boundaries Double
-> V2 Double -> V2 Double
checkBoundsCollision checkBoundsCollision
pos@(V2 or oc) npos@(V2 fr fc) acc@(V2 mr mc) (V2 pr pc) (V2 fr fc) (V2 mr mc) (Boundaries (minr, minc) (maxr, maxc))
(Boundaries (minr, minc) (maxr, maxc))
| ntestr && ntestc && not testr = V2 (0 * mr) (1 * mc) | ntestr && ntestc && not testr = V2 (0 * mr) (1 * mc)
| ntestc && ntestr && not testc = V2 (1 * mr) (0 * mc) | ntestc && ntestr && not testc = V2 (1 * mr) (0 * mc)
| not ntestr && not ntestc = V2 (1 * mr) (1 * mc) | not ntestr && not ntestc = V2 (1 * mr) (1 * mc)
@ -273,11 +269,11 @@ checkBoundsCollision
| distc <= hwidth + 0.07 = True | distc <= hwidth + 0.07 = True
| cdistsq <= 0.005 = True | cdistsq <= 0.005 = True
| otherwise = False | otherwise = False
ndistr = abs ((fr - fromIntegral (floor fr)) - (minr + hheight)) ndistr = abs ((fr - fromIntegral (floor fr :: Int)) - (minr + hheight))
ndistc = abs ((fc - fromIntegral (floor fc)) - (minc + hwidth)) ndistc = abs ((fc - fromIntegral (floor fc :: Int)) - (minc + hwidth))
distr = abs ((or - fromIntegral (floor or)) - (minr + hheight)) distr = abs ((pr - fromIntegral (floor pr :: Int)) - (minr + hheight))
distc = abs ((oc - fromIntegral (floor oc)) - (minc + hwidth)) distc = abs ((pc - fromIntegral (floor pc :: Int)) - (minc + hwidth))
hheight = (maxr - minr) / 2 hheight = (maxr - minr) / 2
hwidth = (maxc - minc) / 2 hwidth = (maxc - minc) / 2
ncdistsq = (ndistr - hheight) ^ 2 + (ndistc - hwidth) ^ 2 ncdistsq = (ndistr - hheight) ^ (2 :: Int) + (ndistc - hwidth) ^ (2 :: Int)
cdistsq = (distr - hheight) ^ 2 + (distc - hwidth) ^ 2 cdistsq = (distr - hheight) ^ (2 :: Int) + (distc - hwidth) ^ (2 :: Int)