diff --git a/src/NPC.hs b/src/NPC.hs new file mode 100644 index 0000000..520593c --- /dev/null +++ b/src/NPC.hs @@ -0,0 +1,57 @@ +module NPC where + +import Affection as A + +import qualified Data.Matrix as M +import Data.Ecstasy as E + +import Linear + +import System.Random + +import NanoVG hiding (V2(..)) + +-- internal imports + +import Types.UserData + +drawNPCs + :: Context + -> [V2 Double] + -> Double + -> Double + -> Int + -> Int + -> Affection UserData () +drawNPCs ctx npcposs prow pcol row col = do + ud <- getAffection + let fnpcposs = filter + (\(V2 nr nc) -> floor nr == row && floor nc == col) + npcposs + liftIO $ mapM_ + (\(V2 nr nc) -> do + let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 + y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 + beginPath ctx + circle ctx x y 5 + closePath ctx + fillColor ctx (rgba 255 0 0 255) + fill ctx + ) + fnpcposs + +placeNPCs :: M.Matrix (Maybe ImgId) -> Int -> Affection UserData [V2 Double] +placeNPCs imgmat count = + doPlace 1 [] + where + doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double] + doPlace nr acc = do + if nr <= count + then do + r <- liftIO $ randomRIO (1, M.nrows imgmat) + c <- liftIO $ randomRIO (1, M.ncols imgmat) + if null (imgObstacle $ imgmat M.! (r, c)) + then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc) + else doPlace nr acc + else + return acc diff --git a/src/Test.hs b/src/Test.hs index ed92022..734d411 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -29,6 +29,7 @@ import Interior import Util import Types import Floorplan +import NPC loadMap :: Affection UserData () loadMap = do @@ -49,12 +50,20 @@ loadMap = do ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) -- liftIO $ A.logIO A.Debug (show exits) (inter, _) <- liftIO $ placeInteriorIO mat imgmat exits gr + npcposs <- placeNPCs inter 10 (nws, _) <- yieldSystemT (worldState ud) $ do void $ newEntity $ defEntity { pos = Just (V2 20.5 20.5) , vel = Just (V2 0 0) - , player = Just True + , player = Just () } + void $ mapM_ (\(V2 nr nc) -> do + newEntity $ defEntity + { pos = Just (V2 (nr + 0.5) (nc + 0.5)) + , vel = Just (V2 0 0) + , npc = Just () + } + ) npcposs uu <- partSubscribe m movePlayer putAffection ud { worldState = nws @@ -107,10 +116,15 @@ drawMap = do ud <- getAffection dt <- getDelta (_, playerPos) <- yieldSystemT (worldState ud) $ do - efor $ \_ -> do - with player - pos' <- E.get pos - pure pos' + efor $ \_ -> do + with player + pos' <- E.get pos + pure pos' + (_, npcposs) <- yieldSystemT (worldState ud) $ do + efor $ \_ -> do + with npc + pos' <- E.get pos + pure pos' let V2 pr pc = head playerPos mat = imgMat (stateData ud) ctx = nano ud @@ -135,11 +149,15 @@ drawMap = do closePath ctx fillColor ctx (rgb 255 255 255) fill ctx - mapM_ (\(i, ls) -> mapM_ - (\(j, t) -> drawTile - (assetImages ud) ctx pr pc i j t) - (reverse $ zip [1..] ls)) - (zip [1..] (toLists mat)) + mapM_ (\(i, ls) -> mapM_ + (\(j, t) -> do + liftIO $ drawTile + (assetImages ud) ctx pr pc i j t + drawNPCs ctx npcposs pr pc i j + ) + (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]) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index d51eaa9..fde9074 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -147,7 +147,8 @@ data Entity f = Entity , vel :: Component f 'Field (V2 Double) , rot :: Component f 'Field Direction , obstacle :: Component f 'Field (Boundaries Double) - , player :: Component f 'Unique Bool + , player :: Component f 'Unique () + , npc :: Component f 'Field () } deriving (Generic) diff --git a/tracer-game.cabal b/tracer-game.cabal index dc09cff..585e46b 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -27,6 +27,7 @@ executable tracer-game , Init , Test , Navigation + , NPC , Util default-extensions: OverloadedStrings , DeriveGeneric