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