From f6db4f5e5c7ed2ef49651ba25c03bacb05d9d54b Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 30 May 2018 17:32:00 +0200 Subject: [PATCH] hunting warnings in Test --- src/Test.hs | 147 ++++++++++++++++++++-------------------------------- 1 file changed, 55 insertions(+), 92 deletions(-) diff --git a/src/Test.hs b/src/Test.hs index 3382471..0e1a1c6 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -1,13 +1,11 @@ module Test where -import Affection as A hiding (get) +import Affection as A -import SDL (get, ($=)) import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL hiding (get) import NanoVG hiding (V2(..)) -import Control.Monad (when, unless, void) +import Control.Monad (when, void) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.MVar import Control.Concurrent (forkOS) @@ -26,8 +24,6 @@ import Linear hiding (E) import Foreign.C.Types (CFloat(..)) -import Debug.Trace - -- internal imports import Interior @@ -59,7 +55,7 @@ loadMap = do npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex) liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do - createEntity $ newEntity + void $ createEntity $ newEntity { pos = Just (V2 10.5 10.5) , vel = Just (V2 0 0) , player = Just () @@ -68,9 +64,9 @@ loadMap = do } void $ mapM_ (\npcpos@(V2 nr nc) -> do fact <- liftIO $ randomRIO (0.5, 1.5) - future <- liftIO $ newEmptyMVar + future <- liftIO newEmptyMVar _ <- liftIO $ forkOS $ getPath (fmap floor npcpos) future nnex inter - createEntity $ newEntity + void $ createEntity $ newEntity { pos = Just (V2 (nr + 0.5) (nc + 0.5)) , vel = Just (V2 0 0) , velFact = Just fact @@ -100,7 +96,7 @@ mouseToPlayer mv2 = do (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 let dr = (ry / sin (atan (1/2)) / 2) + rx dc = rx - (ry / sin (atan (1/2)) / 2) - (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do + (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ emap allEnts $ do with player pure $ unchanged @@ -116,7 +112,7 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = mouseToPlayer m movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do ud <- getAffection - (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do + (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ emap allEnts $ do with player pure $ unchanged @@ -131,21 +127,19 @@ drawMap :: Affection UserData () drawMap = do ud <- getAffection dt <- getDelta - (_, (playerPos, playerRot, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do - (pc, dir) <- fmap head $ efor allEnts $ do + (_, (playerPos, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do + pc <- fmap head $ efor allEnts $ do with player with pos - with rot pos' <- query pos - rot' <- query rot - pure (pos', rot') + pure pos' posanims <- efor allEnts $ do with anim with pos - state <- query anim + stat <- query anim pos' <- query pos - return (pos', state) - return (pc, dir, posanims) + return (pos', stat) + return (pc, posanims) let V2 pr pc = playerPos mat = imgMat (stateData ud) ctx = nano ud @@ -171,16 +165,14 @@ drawMap = do fillColor ctx (rgb 255 255 255) fill ctx mapM_ (\(i, ls) -> mapM_ - (\(j, t) -> do - drawTile ud ctx posanims pr pc i j t - ) + (uncurry (drawTile ud ctx posanims pr pc i)) (reverse $ zip [1..] ls)) (zip [1..] (toLists mat)) fontSize ctx 20 fontFace ctx (assetFonts ud Map.! FontBedstead) textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgb 255 128 0) - textBox ctx 0 0 200 ("FPS: " `T.append` (T.pack $ Prelude.take 5 $ show (1/dt))) + textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) drawTile :: UserData @@ -194,15 +186,16 @@ drawTile -> IO () drawTile ud ctx posanims pr pc row col img = when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && - (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) $ + ((realToFrac x :: Double) < 1280 && + (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $ do let lt = Prelude.filter (\(V2 nr nc, _) -> - (any (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs && - any (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs) + (any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs && + any (\m -> nc > fromIntegral (floor nc :: Int) + m) maxcs) ) sorted ge = Prelude.filter (\(V2 nr nc, _) -> not - (any (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs && - any (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs) + (any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs && + any (\m -> nc > fromIntegral (floor nc :: Int) + m) maxcs) ) sorted save ctx mapM_ drawAnim lt @@ -215,10 +208,9 @@ drawTile ud ctx posanims pr pc row col img = tileWidth = 64 :: Double tileHeight = 32 :: Double filtered = Prelude.filter - (\((V2 ar ac), _) -> floor ar == row && floor ac == col) posanims + (\(V2 ar ac, _) -> floor ar == row && floor ac == col) posanims sorted = sortOn (\(V2 sr sc, _) -> sc + sr * maxCol) filtered maxCol = maximum (Prelude.map (\(V2 _ mc, _) -> mc) filtered) - minrs = Prelude.map (fst . matmin) mb maxrs = Prelude.map (fst . matmax) mb mincs = Prelude.map (snd . matmin) mb maxcs = Prelude.map (snd . matmax) mb @@ -257,42 +249,13 @@ drawTile ud ctx posanims pr pc row col img = fillPaint ctx paint fill ctx -drawAnims - :: Context - -> Map AnimId Animation - -> SystemState Entity IO - -> [(V2 Double, AnimState)] - -> Double - -> Double - -> Int - -> Int - -> Maybe ImgId - -> IO () -drawAnims ctx anims ws posanims pr pc r c tile = - mapM_ (\(V2 nr nc, as) -> do - let x = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32 - y = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16 - anim = anims Map.! asId as - beginPath ctx - paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0 - (animSprites anim !! asCurrentFrame as) 1 - rect ctx (x - 32) (y - 58) 64 74 - fillPaint ctx paint - fill ctx - ) filtered - where - filtered = Prelude.filter - (\((V2 ar ac), _) -> floor ar == r && floor ac == c) posanims - sorted = sortOn (\(V2 sr sc, _) -> sc + sr * maxCol) filtered - maxCol = maximum (Prelude.map (\(V2 _ mc, _) -> mc) filtered) - updateMap :: Double -> Affection UserData () updateMap dt = do let direction :: V2 Double -> Direction -> Direction direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0 then let xuu = - (acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel'))) / pi * 180 + acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel')) / pi * 180 xu = if vr < 0 then 360 - xuu else xuu d | xu < 22.5 = NE @@ -304,39 +267,40 @@ updateMap dt = do | xu > 247.5 && xu < 292.5 = NW | xu > 292.5 && xu < 337.5 = N | xu > 337.5 = NE + | otherwise = NE in d else rot' ud <- getAffection (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do emap allEnts $ do with anim - state <- query anim - let anim = assetAnimations ud Map.! asId state - ntime = asElapsedTime state + dt - nstate = if ntime > (fromIntegral $ asCurrentFrame state) * - (animDuration anim / (fromIntegral $ length $ animSprites anim)) + stat <- query anim + let an = assetAnimations ud Map.! asId stat + ntime = asElapsedTime stat + dt + nstate = if ntime > fromIntegral (asCurrentFrame stat) * + (animDuration an / fromIntegral (length $ animSprites an)) then - let nframe = asCurrentFrame state + 1 - in case animPlay anim of + let nframe = asCurrentFrame stat + 1 + in case animPlay an of APLoop -> let (nnframe, nntime) = - if nframe >= (length $ animSprites anim) + if nframe >= length (animSprites an) then (0, 0) else (nframe, ntime) - in state + in stat { asCurrentFrame = nnframe , asElapsedTime = nntime } APOnce -> - let nnframe = if nframe >= (length $ animSprites anim) + let nnframe = if nframe >= length (animSprites an) then nframe - 1 else nframe - in state + in stat { asCurrentFrame = nnframe , asElapsedTime = ntime } else - state + stat { asElapsedTime = ntime } return $ unchanged @@ -349,18 +313,17 @@ updateMap dt = do with pos with rot with anim - pos'@(V2 pr pc) <- query pos + pos' <- query pos vel' <- query vel rot' <- query rot fact' <- query velFact - state <- query anim - let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel' - dpos = npos - pos' - aId = asId state + stat <- query anim + let npos = pos' + fmap (* (dt * fact')) vel' + aId = asId stat ent = unchanged - { pos = Set $ npos + { pos = Set npos , rot = Set $ direction vel' rot' - , anim = Set state + , anim = Set stat { asId = aId { aiDirection = direction vel' rot' } @@ -374,12 +337,12 @@ updateMap dt = do with rot with anim pos'@(V2 pr pc) <- query pos - vel'@(V2 vr vc) <- query vel + vel' <- query vel rot' <- query rot - state <- query anim - let npos@(V2 nr nc) = pos' + fmap (* dt) vel' + stat <- query anim + let npos = pos' + fmap (* dt) vel' dpos@(V2 dpr dpc) = npos - pos' - aId = asId state + aId = asId stat len = sqrt (dpos `dot` dpos) lll = (,) <$> ( @@ -411,7 +374,7 @@ updateMap dt = do (A.log A.Verbose (show lll ++ " " ++ show len) lll) ) , rot = Set (direction vel' rot') - , anim = Set state + , anim = Set stat { asId = aId { aiDirection = direction vel' rot' } @@ -437,26 +400,26 @@ checkBoundsCollision2 -> Boundaries Double -> V2 Double checkBoundsCollision2 - pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc)) + pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc)) | colltr < dt && colltc < dt = V2 0 0 | colltr < dt && incol = V2 0 1 * acc | colltc < dt && inrow = V2 1 0 * acc | otherwise = acc where - vel@(V2 vr vc) = fmap (/ dt) (next - pre) + V2 vr vc = fmap (/ dt) (nex - pre) colltr | vr > 0 && prr <= maxr = - (((fromIntegral (floor pr :: Int)) + minr - 0.15) - pr) / vr + ((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr | vr < 0 && prr >= minr = - (((fromIntegral (floor pr :: Int)) + maxr + 0.15) - pr) / vr + ((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr | otherwise = dt colltc | vc > 0 && prc <= maxc = - (((fromIntegral (floor pc :: Int)) + minc - 0.15) - pc) / vc + ((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc | vc < 0 && prc >= minc = - (((fromIntegral (floor pc :: Int)) + maxc + 0.15) - pc) / vc + ((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc | otherwise = dt inrow = pr > minr && pr < maxr incol = pc > minc && pc < maxc - prr = pr - (fromIntegral $ floor pr) - prc = pc - (fromIntegral $ floor pc) + prr = pr - fromIntegral (floor pr :: Int) + prc = pc - fromIntegral (floor pc :: Int)