58 lines
1.3 KiB
Haskell
58 lines
1.3 KiB
Haskell
|
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
|