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