first interactable object ever: a copier

This commit is contained in:
nek0 2018-07-22 22:30:17 +02:00
parent f64aae86f0
commit 08dbb9326c
9 changed files with 106 additions and 13 deletions

BIN
assets/misc/copier.kra Normal file

Binary file not shown.

BIN
assets/misc/copier.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

View file

@ -227,7 +227,7 @@ loadFork ws win glc nvg future progress = do
)))
copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg $
[ ( AnimId "copier" "copy" N
, AnimationConfig (64, 0) (64, 74) (64, 0) 4 0.5 APOnce
, AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop
)
]
modifyMVar_ progress (return . (\(p, _) ->

View file

@ -37,6 +37,7 @@ import Types
import Floorplan
import MindMap
import NPC
import Object
loadMap :: Affection UserData ()
loadMap = do
@ -44,12 +45,13 @@ loadMap = do
let (Subsystems _ m k) = subsystems ud
uu1 <- partSubscribe m movePlayer
uu2 <- partSubscribe k changeMaps
uu3 <- partSubscribe m playerInteract
future <- liftIO newEmptyMVar
progress <- liftIO $ newMVar (0, "Ohai!")
_ <- liftIO $ forkIO $ loadMapFork ud future progress
putAffection ud
{ stateData = None
, uuid = [uu1, uu2]
, uuid = [uu1, uu2, uu3]
, stateMVar = future
, stateProgress = progress
}
@ -133,8 +135,9 @@ loadMapFork ud future progress = do
void $ createEntity $ newEntity
{ pos = Just $ reachCoord - V2 1 0
, obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
, anim = Just $ AnimState (AnimId "copier" "closed" N) 0 0
, objAccess = Just $ V2 1 0
, anim = Just $ AnimState (AnimId "copier" "open" N) 0 0
, objAccess = Just $ (V2 1 0, NW)
, objType = Just ObjCopier
}
) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState")
@ -204,6 +207,48 @@ movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do
}
movePlayer _ = return ()
playerInteract :: MouseMessage -> Affection UserData ()
playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
ud <- getAffection
(nws, relEnts) <- liftIO $ yieldSystemT (worldState ud) $ do
emap allEnts $ do
with player
with rot
rot' <- query rot
(V2 rx ry) <- liftIO $ relativizeMouseCoords m
let dr = (ry / sin (atan 0.5) / 2) + rx
dc = rx - (ry / sin (atan 0.5) / 2)
ndir = direction (V2 dr dc)
return $ unchanged
{ rot = Set $ fromMaybe rot' ndir
}
[(ppos, pdir)] <- efor allEnts $ do
with player
with pos
with rot
pos' <- query pos
rot' <- query rot
return (pos', rot')
mrelEnts <- efor allEnts $ do
with pos
with objAccess
(rel, dir) <- query objAccess
pos' <- query pos
otype <- query objType
ent <- queryEnt
if (fmap floor ppos == fmap floor pos' ||
fmap floor ppos == fmap floor pos' + rel) &&
pdir == dir
then return $ Just (otype, ent)
else return Nothing
return (catMaybes mrelEnts)
liftIO $ A.logIO A.Debug ("relEnts: " ++ show relEnts)
putAffection ud
{ worldState = nws
}
mapM_ (uncurry objectAction) relEnts
playerInteract _ = return ()
drawMap :: Affection UserData ()
drawMap = do
ud <- getAffection
@ -337,9 +382,9 @@ drawTile ud ctx posanims pr pc row col img =
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)
_ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 +
(1 - (sc - (fromIntegral ((floor sc) :: Int))))
Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr + (1 - maxc) * 10
_ -> (sr - (fromIntegral ((floor sr) :: Int))) +
(1 - (sc - (fromIntegral ((floor sc) :: Int)))) * 10
) posanims
-- sorted = posanims
minrs = Prelude.map (fst . matmin) mb
@ -380,7 +425,6 @@ updateMap dt = do
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
emap allEnts $ do
with anim
with pos
stat <- query anim
let an = assetAnimations ud Map.! asId stat
ntime = asElapsedTime stat + dt

26
src/Object.hs Normal file
View file

@ -0,0 +1,26 @@
{-# LANGUAGE MultiParamTypeClasses #-}
module Object where
import Affection
import Data.Ecstasy
import Types
instance ObjectAction UserData ObjType where
objectAction ObjCopier ent = do
ud <- getAffection
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
emap (anEnt ent) $ do
with anim
liftIO $ logIO Debug "copying!"
let nstat = AnimState
(AnimId "copier" "copy" N)
0
0
return unchanged
{ anim = Set nstat
}
putAffection ud
{ worldState = nws
}

View file

@ -14,3 +14,4 @@ import Types.Animation as T
import Types.MindMap as T
import Types.Drawable as T
import Types.Collidible as T
import Types.ObjType as T

13
src/Types/ObjType.hs Normal file
View file

@ -0,0 +1,13 @@
{-# LANGUAGE MultiParamTypeClasses #-}
module Types.ObjType where
import Affection
import Data.Ecstasy (Ent)
data ObjType
= ObjCopier
deriving (Show, Eq, Ord, Enum)
class ObjectAction us t where
objectAction :: t -> Ent -> Affection us ()

View file

@ -23,6 +23,7 @@ import Types.ImgId
import Types.FontId
import Types.Direction
import Types.Animation
import Types.ObjType
data UserData = UserData
{ state :: State
@ -60,7 +61,8 @@ data Entity f = Entity
, player :: Component f 'Unique ()
, npcMoveState :: Component f 'Field NPCMoveState
, anim :: Component f 'Field AnimState
, objAccess :: Component f 'Field (V2 Int)
, objAccess :: Component f 'Field ((V2 Int), Direction)
, objType :: Component f 'Field ObjType
}
deriving (Generic)

View file

@ -174,12 +174,19 @@ naviGraph imgmat animBounds (V2 r c) =
list2 =
foldl
(\acc (rr, cc) ->
if null (maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat))
if null
((maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++
(map snd $ filter
(\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc)
animBounds))
&& all null
(map
(\(oor, ooc) -> maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat))
(\(oor, ooc) -> (maybe [] collisionObstacle
(fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) ++
(map snd $ filter
(\(V2 br bc, _) -> floor br == r + oor && floor bc == c + ooc)
animBounds))
[(0, cc), (rr, 0)])
then V2 (r + rr) (c + cc): acc
else acc