removing some warnings
This commit is contained in:
parent
d2b1baea6b
commit
b276219e07
10 changed files with 21 additions and 43 deletions
|
@ -14,7 +14,6 @@ import Control.Concurrent.STM
|
|||
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Ecstasy
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
|
||||
import System.Exit (exitFailure)
|
||||
|
|
|
@ -38,7 +38,7 @@ import Types
|
|||
import Floorplan
|
||||
import MindMap
|
||||
import NPC
|
||||
import Object
|
||||
-- import Object
|
||||
import Animation
|
||||
|
||||
loadMap :: Affection UserData ()
|
||||
|
@ -243,11 +243,10 @@ movePlayer _ = return ()
|
|||
playerInteract :: MouseMessage -> Affection UserData ()
|
||||
playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
|
||||
ud <- getAffection
|
||||
ad <- get
|
||||
(V2 rx ry) <- liftIO $ (* V2 640 360) <$> relativizeMouseCoords m
|
||||
let dr = ((ry / 32) / sin (atan 0.5) / 2) + (rx / 64)
|
||||
dc = (rx / 64) - ((ry / 32) / sin (atan 0.5) / 2)
|
||||
(nws, relEnts) <- yieldSystemT (worldState ud) $ do
|
||||
(nws, _) <- yieldSystemT (worldState ud) $ do
|
||||
emap allEnts $ do
|
||||
with player
|
||||
with rot
|
||||
|
@ -274,8 +273,8 @@ playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
|
|||
ostate <- query objState
|
||||
ent <- queryEnt
|
||||
if (fmap floor ppos == fmap floor pos' ||
|
||||
fmap floor ppos == fmap floor pos' + rel) &&
|
||||
fmap floor (ppos + V2 dr dc) == fmap floor pos' &&
|
||||
(fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) + rel) &&
|
||||
(fmap floor (ppos + V2 dr dc) :: V2 Int) == (fmap floor pos' ::V2 Int) &&
|
||||
pdir == dir
|
||||
then return $ Just (otype, ostate, ent)
|
||||
else return Nothing
|
||||
|
@ -446,17 +445,17 @@ drawTile ud ctx posanims pr pc row col img =
|
|||
| otherwise =
|
||||
False
|
||||
nnr = case mbnds of
|
||||
Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr
|
||||
Just (Boundaries (_, _) (maxr, _)) -> maxr
|
||||
Nothing -> nr - fromIntegral ((floor nr) :: Int) :: Double
|
||||
nnc = case mbnds of
|
||||
Just (Boundaries (minr, minc) (maxr, maxc)) -> minc
|
||||
Just (Boundaries (_, minc) (_, _)) -> minc
|
||||
Nothing -> nc - fromIntegral ((floor nc) :: Int) :: Double
|
||||
-- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
|
||||
-- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of
|
||||
Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr * 10 + (1 - minc)
|
||||
Just (Boundaries (_, minc) (maxr, _)) -> maxr * 10 + (1 - minc)
|
||||
_ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 +
|
||||
(1 - (sc - (fromIntegral ((floor sc) :: Int))))
|
||||
) posanims
|
||||
|
@ -693,7 +692,6 @@ updateMap dt = do
|
|||
(reachPoints $ stateData ud)
|
||||
)
|
||||
dt
|
||||
nws
|
||||
putAffection ud
|
||||
{ worldState = nws2
|
||||
}
|
||||
|
|
|
@ -33,8 +33,8 @@ buildMindMap num difficulty = do
|
|||
[1 .. (1 + fromIntegral difficulty)]
|
||||
aux <- randomRIO (0, floor (fromIntegral num * 5 / 8 :: Double)) :: IO Int
|
||||
auxPaths <- mapM (\_ -> do
|
||||
len <- randomRIO (0, num `div` 10)
|
||||
(path . (MMNode (V2 0 0) 0 :)) <$> foldM makeVert [] [1 .. len]
|
||||
ln <- randomRIO (0, num `div` 10)
|
||||
(path . (MMNode (V2 0 0) 0 :)) <$> foldM makeVert [] [1 .. ln]
|
||||
)
|
||||
[0 .. aux]
|
||||
return $ overlays (mainPath : auxPaths)
|
||||
|
|
18
src/NPC.hs
18
src/NPC.hs
|
@ -9,7 +9,6 @@ import Data.Ecstasy as E
|
|||
import Data.Maybe
|
||||
import Data.List (find)
|
||||
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Concurrent (forkIO)
|
||||
|
@ -24,7 +23,7 @@ import Util
|
|||
|
||||
import Types
|
||||
|
||||
import Object
|
||||
import Object ()
|
||||
|
||||
placeNPCs
|
||||
:: M.Matrix (Maybe ImgId)
|
||||
|
@ -62,9 +61,8 @@ updateNPCs
|
|||
:: M.Matrix (Maybe ImgId)
|
||||
-> [ReachPoint]
|
||||
-> Double
|
||||
-> SystemState Entity (AffectionState (AffectionData UserData) IO)
|
||||
-> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
|
||||
updateNPCs imgmat rp dt ws = do
|
||||
updateNPCs imgmat rp dt = do
|
||||
posbounds <- efor allEnts $ do
|
||||
with pos
|
||||
with obstacle
|
||||
|
@ -89,9 +87,6 @@ updateNPCs imgmat rp dt ws = do
|
|||
with anim
|
||||
pos' <- query pos
|
||||
rot' <- query rot
|
||||
let mdir =
|
||||
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
|
||||
e <- queryEnt
|
||||
npcState' <- query npcMoveState
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
|
@ -114,7 +109,6 @@ updateNPCs imgmat rp dt ws = do
|
|||
{ npcMoveState = Set $ NPCStanding 1 future
|
||||
})
|
||||
NPCWalking path -> do
|
||||
pos' <- query pos
|
||||
if not (null path)
|
||||
then do
|
||||
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
|
||||
|
@ -184,6 +178,10 @@ updateNPCs imgmat rp dt ws = do
|
|||
}
|
||||
) moent
|
||||
|
||||
getObjects
|
||||
:: (Monad m, Traversable t, RealFrac a1)
|
||||
=> t (a2, V2 a1)
|
||||
-> SystemT Entity m (t (a2, [(Ent, V2 Double, (V2 Int, Direction))]))
|
||||
getObjects npcposs = do
|
||||
candidates <- efor allEnts $ do
|
||||
with pos
|
||||
|
@ -194,11 +192,11 @@ getObjects npcposs = do
|
|||
oacc <- query objAccess
|
||||
ent <- queryEnt
|
||||
return (ent, pos', oacc)
|
||||
mapM (\(e, pos) ->
|
||||
mapM (\(e, npos) ->
|
||||
return
|
||||
( e
|
||||
, filter (\(_, p, (delta, _)) ->
|
||||
fmap floor p + delta == fmap floor pos
|
||||
fmap floor p + delta == fmap floor npos
|
||||
) candidates
|
||||
)
|
||||
) npcposs
|
||||
|
|
|
@ -37,7 +37,7 @@ instance ObjectAction ObjType ObjState where
|
|||
when trans (setEntity ent =<< objectTransition t s False ent)
|
||||
|
||||
objectAction dt t@ObjComputer s@"on" ent = do
|
||||
[vel] <- efor allEnts $ do
|
||||
[vl] <- efor allEnts $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
|
@ -63,7 +63,7 @@ instance ObjectAction ObjType ObjState where
|
|||
if (ttl < 0)
|
||||
then do
|
||||
return (Just pa)
|
||||
else if (pa && vel `dot` vel > 0)
|
||||
else if (pa && vl `dot` vl > 0)
|
||||
then return (Just pa)
|
||||
else return Nothing
|
||||
maybe
|
||||
|
@ -72,7 +72,7 @@ instance ObjectAction ObjType ObjState where
|
|||
(head trans)
|
||||
|
||||
objectAction dt t@ObjComputer s@"hack" ent = do
|
||||
[vel] <- efor allEnts $ do
|
||||
[vl] <- efor allEnts $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
|
@ -93,7 +93,7 @@ instance ObjectAction ObjType ObjState where
|
|||
case mttl of
|
||||
Nothing -> return Nothing
|
||||
Just ttl -> do
|
||||
if (ttl < 0) || vel `dot` vel > 0
|
||||
if (ttl < 0) || vl `dot` vl > 0
|
||||
then do
|
||||
tpa <- query objPlayerActivated
|
||||
return (Just tpa)
|
||||
|
@ -179,7 +179,6 @@ instance ObjectAction ObjType ObjState where
|
|||
(AnimId "computer" "off" N)
|
||||
0
|
||||
0
|
||||
ost <- query objStateTime
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "off"
|
||||
|
|
|
@ -1,8 +1,6 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Types.Collidible where
|
||||
|
||||
import Affection as A
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Types.Map (Boundaries(..))
|
||||
|
@ -12,8 +10,6 @@ import Types.Animation (AnimState(..))
|
|||
class Collidible c where
|
||||
collisionObstacle :: c -> [(Boundaries Double)]
|
||||
|
||||
instance Collidible AnimState where
|
||||
|
||||
instance Collidible ImgId where
|
||||
collisionObstacle ImgMiscBox1 =
|
||||
[ Boundaries (0.2, 0.34) (0.8, 1)
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
module Types.ImgId where
|
||||
|
||||
import Types.Map
|
||||
|
||||
data ImgId
|
||||
= ImgEmpty -- TODO: Find better solution than empty image.
|
||||
| ImgEmptyNoWalk
|
||||
|
|
|
@ -1,10 +1,6 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Types.ObjType where
|
||||
|
||||
import Affection
|
||||
|
||||
import Data.Ecstasy (Ent)
|
||||
|
||||
data ObjType
|
||||
= ObjCopier
|
||||
| ObjComputer
|
||||
|
|
|
@ -2,14 +2,12 @@ module Types.StateData where
|
|||
|
||||
import Data.Matrix
|
||||
import Data.Map
|
||||
import Data.Text
|
||||
|
||||
import NanoVG
|
||||
|
||||
import Types.ReachPoint
|
||||
import Types.Map
|
||||
import Types.ImgId
|
||||
import Types.FontId
|
||||
import Types.Animation
|
||||
|
||||
data StateData
|
||||
|
|
|
@ -17,15 +17,11 @@ import Data.Ecstasy
|
|||
|
||||
import Control.Concurrent.MVar
|
||||
|
||||
import Types.Map
|
||||
import Types.StateData
|
||||
import Types.ImgId
|
||||
import Types.FontId
|
||||
import Types.Direction
|
||||
import Types.Animation
|
||||
import Types.ObjType
|
||||
import Types.Entity
|
||||
import Types.NPCState
|
||||
|
||||
data UserData = UserData
|
||||
{ state :: State
|
||||
|
|
Loading…
Reference in a new issue