diff --git a/src/Test.hs b/src/Test.hs index ed7eef8..3382471 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -53,14 +53,9 @@ loadMap = do ) [] ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) - -- liftIO $ A.logIO A.Debug (show exits) (inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps)) let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps - -- playerAnim = Animations - -- { animStand = Map.fromList - -- (zip [NE .. N] [ImgIntrNE .. ImgIntrN]) - -- } 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 @@ -72,7 +67,6 @@ loadMap = do , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 } void $ mapM_ (\npcpos@(V2 nr nc) -> do - -- ttl <- liftIO $ randomRIO (5, 30) fact <- liftIO $ randomRIO (0.5, 1.5) future <- liftIO $ newEmptyMVar _ <- liftIO $ forkOS $ getPath (fmap floor npcpos) future nnex inter @@ -145,12 +139,6 @@ drawMap = do pos' <- query pos rot' <- query rot pure (pos', rot') - -- npcsrots <- efor allEnts $ do - -- with npcState - -- with pos - -- pos' <- query pos - -- rot' <- query rot - -- pure (pos', rot') posanims <- efor allEnts $ do with anim with pos @@ -185,12 +173,9 @@ drawMap = do mapM_ (\(i, ls) -> mapM_ (\(j, t) -> do drawTile ud ctx posanims pr pc i j t - -- drawNPCs (assetImages ud) ctx ud npcposrots pr pc i j t - -- drawAnims ctx (assetAnimations ud) (worldState ud) posanims pr pc i j t ) (reverse $ zip [1..] ls)) (zip [1..] (toLists mat)) - -- liftIO $ do -- draw FPS fontSize ctx 20 fontFace ctx (assetFonts ud Map.! FontBedstead) textAlign ctx (S.fromList [AlignCenter,AlignTop]) @@ -214,43 +199,15 @@ drawTile ud ctx posanims pr pc row col img = 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) - -- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) minrs && - -- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) mincs) || - -- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs && - -- all (\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) - -- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) minrs && - -- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) mincs) || - -- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs && - -- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs) ) sorted save ctx mapM_ drawAnim lt when (isJust img) drawImage mapM_ drawAnim ge - -- mapM (\posanim@(V2 nr nc, as) -> do - -- if (isNothing img) - -- then drawAnim posanim - -- else do - -- if (Prelude.null mb) - -- then do - -- drawImage - -- drawAnim posanim - -- else do - -- if (all (\m -> nr > (fromIntegral (floor nr :: Int)) + m) minrs && - -- all (\m -> nc < (fromIntegral (floor nc :: Int)) + m) mincs) || - -- (all (\m -> nr > (fromIntegral (floor nr :: Int)) + m) minrs && - -- all (\m -> nc < (fromIntegral (floor nc :: Int)) + m) maxcs) - -- then do - -- drawImage - -- drawAnim posanim - -- else do - -- drawAnim posanim - -- drawImage - -- ) sorted restore ctx where ai = assetImages ud @@ -299,17 +256,6 @@ drawTile ud ctx posanims pr pc row col img = rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74 fillPaint ctx paint fill ctx - -- drawPlayer = do - -- when (floor pr == row && floor pc == col) $ do - -- beginPath ctx - -- paint <- imagePattern - -- ctx 608 302 64 74 0 (ai Map.! playerImg) 1 - -- rect ctx 608 302 64 74 - -- fillPaint ctx paint - -- -- circle ctx 640 360 5 - -- -- closePath ctx - -- -- fillColor ctx (rgba 0 255 255 255) - -- fill ctx drawAnims :: Context @@ -444,20 +390,6 @@ updateMap dt = do if dpc < 0 then [(floor dpc :: Int) .. 0] else [0 .. (ceiling dpc :: Int)]) - -- lll = Prelude.map (\i -> - -- let lrow = - -- [ (nr - (fromIntegral $ floor nr)) - -- , (nr - (fromIntegral $ floor nr)) + (dpr / len) - -- .. - -- ] - -- lcol = - -- [ (nc - (fromIntegral $ floor nc)) - -- , (nc - (fromIntegral $ floor nc)) + (dpc / len) - -- .. - -- ] - -- in (fromIntegral (floor (lrow !! i)), fromIntegral (floor (lcol !! i))) - -- ) - -- [ 0 .. floor len] ent = unchanged { pos = Set $ pos' + dpos * Prelude.foldl (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a @@ -497,43 +429,6 @@ updateMap dt = do { worldState = nws } -checkBoundsCollision - :: V2 Double - -> V2 Double - -> V2 Double - -> Boundaries Double - -> V2 Double -checkBoundsCollision - (V2 pr pc) (V2 fr fc) (V2 mr mc) (Boundaries (minr, minc) (maxr, maxc)) - | ntestc && ntestr && not testr && not testc = V2 (1 * mr) (1 * mc) - | ntestc && ntestr && not testc = V2 (1 * mr) (0 * mc) - | ntestr && ntestc && not testr = V2 (0 * mr) (1 * mc) - | not ntestr && not ntestc = V2 (1 * mr) (1 * mc) - | not ntestr && ntestc = V2 (1 * mr) (1 * mc) - | not ntestc && ntestr = V2 (1 * mr) (1 * mc) - | otherwise = V2 (0 * mr) (0 * mc) - where - ntestr - = ndistr <= hheight + 0.15 - -- | ncdistsq <= 0.005 = True - ntestc - = ndistc <= hwidth + 0.15 - -- | ncdistsq <= 0.005 = True - testr - = distr <= hheight + 0.15 - -- | cdistsq <= 0.005 = True - testc - = distc <= hwidth + 0.15 - -- | cdistsq <= 0.005 = True - ndistr = abs (fr - (fromIntegral (floor fr :: Int) + (minr + hheight))) - ndistc = abs (fc - (fromIntegral (floor fc :: Int) + (minc + hwidth))) - distr = abs (pr - (fromIntegral (floor fr :: Int) + (minr + hheight))) - distc = abs (pc - (fromIntegral (floor fc :: Int) + (minc + hwidth))) - hheight = (maxr - minr) / 2 - hwidth = (maxc - minc) / 2 - ncdistsq = (ndistr - hheight) ^ (2 :: Int) + (ndistc - hwidth) ^ (2 :: Int) - cdistsq = (distr - hheight) ^ (2 :: Int) + (distc - hwidth) ^ (2 :: Int) - checkBoundsCollision2 :: V2 Double -> V2 Double