moduularize objects
This commit is contained in:
parent
16a329ddac
commit
06845657f2
4 changed files with 259 additions and 201 deletions
212
src/Object.hs
212
src/Object.hs
|
|
@ -12,215 +12,25 @@ import Data.Maybe
|
|||
|
||||
import Linear
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Types
|
||||
|
||||
import Object.Computer
|
||||
import Object.Copier
|
||||
|
||||
instance ObjectAction ObjType ObjState where
|
||||
objectAction dt t@ObjCopier s@"copying" ent = do
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Copier " ++ show ent ++ ": copying!")
|
||||
return unchanged
|
||||
{ objStateTime = Set (actionTime t s)
|
||||
, objState = Set "copying"
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return False
|
||||
Just ttl -> return (ttl < 0)
|
||||
when (head trans) (setEntity ent =<< objectTransition t s False ent Nothing)
|
||||
objectAction dt t@ObjCopier s ent = copierObjectAction dt t s ent
|
||||
|
||||
objectAction dt t@ObjComputer s@"on" ent = do
|
||||
pent <- efor (anEnt ent) $ do
|
||||
with objUsedBy
|
||||
query objUsedBy
|
||||
vls <- efor (anEnt $ head pent) $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": on!")
|
||||
let dur = actionTime t s
|
||||
return unchanged
|
||||
{ objStateTime = Set dur
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return Nothing
|
||||
Just ttl -> do
|
||||
pa <- query objPlayerActivated
|
||||
if ttl < 0
|
||||
then
|
||||
return (Just pa)
|
||||
else if not (null vls) && head vls `dot` head vls > 0
|
||||
then return (Just pa)
|
||||
else return Nothing
|
||||
maybe
|
||||
(return ())
|
||||
(\tpa -> setEntity ent =<< objectTransition t s tpa ent Nothing)
|
||||
(head trans)
|
||||
|
||||
objectAction dt t@ObjComputer s@"hack" ent = do
|
||||
aent <- efor (anEnt ent) $ do
|
||||
with objUsedBy
|
||||
query objUsedBy
|
||||
vls <- efor (anEnt $ head aent) $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": hacking!")
|
||||
return unchanged
|
||||
{ objStateTime = Set (actionTime t s)
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return Nothing
|
||||
Just ttl -> do
|
||||
if (ttl < 0) || (not (null vls) && head vls `dot` head vls > 0)
|
||||
then do
|
||||
tpa <- query objPlayerActivated
|
||||
return (Just tpa)
|
||||
else return Nothing
|
||||
maybe
|
||||
(return ())
|
||||
(\tpa -> setEntity ent =<< objectTransition t s tpa ent Nothing)
|
||||
(head trans)
|
||||
objectAction dt t@ObjComputer s ent = computerObjectAction dt t s ent
|
||||
|
||||
objectAction _ _ _ _ = return ()
|
||||
|
||||
objectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimCopier "copy" N)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ objState = Set "copying"
|
||||
, objUsedBy = Set aent
|
||||
, objPlayerActivated = Set playerActivated
|
||||
, anim = Set nstat
|
||||
}
|
||||
return (head e)
|
||||
objectTransition t@ObjCopier s pa ent aent =
|
||||
copierObjectTransition t s pa ent aent
|
||||
|
||||
objectTransition ObjCopier "copying" _ ent _ = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
ttl <- query objStateTime
|
||||
if ttl < 0
|
||||
then do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimCopier "open" N)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "idle"
|
||||
, objStateTime = Unset
|
||||
, objPlayerActivated = Unset
|
||||
, objUsedBy = Unset
|
||||
}
|
||||
else return unchanged
|
||||
return (head e)
|
||||
|
||||
objectTransition ObjComputer "off" pa ent (Just aent) = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
solved <- queryMaybe objSolved
|
||||
(_, dir) <- query objAccess
|
||||
if pa
|
||||
then if not (fromMaybe False solved)
|
||||
then do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "hack" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "hack"
|
||||
, objPlayerActivated = Set True
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
else do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "on" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "on"
|
||||
, objPlayerActivated = Set True
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
else do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "on" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "on"
|
||||
, objPlayerActivated = Set False
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
return (head e)
|
||||
|
||||
objectTransition ObjComputer "on" _ ent _ = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
(_, dir) <- query objAccess
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "off" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "off"
|
||||
, objPlayerActivated = Unset
|
||||
, objStateTime = Unset
|
||||
, objUsedBy = Unset
|
||||
}
|
||||
return (head e)
|
||||
|
||||
objectTransition ObjComputer "hack" pa ent _ =
|
||||
if pa
|
||||
then do
|
||||
e <- efor (anEnt ent) $ do
|
||||
(_, dir) <- query objAccess
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "off" dir)
|
||||
0
|
||||
0
|
||||
ost <- query objStateTime
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "off"
|
||||
, objPlayerActivated = Unset
|
||||
, objStateTime = Unset
|
||||
, objUsedBy = Unset
|
||||
, objSolved = if pa then Set (ost < 0) else Keep
|
||||
}
|
||||
return (head e)
|
||||
else return unchanged
|
||||
objectTransition t@ObjComputer s pa ent aent =
|
||||
computerObjectTransition t s pa ent aent
|
||||
|
||||
objectTransition _ _ _ _ _ = return unchanged
|
||||
|
||||
|
|
|
|||
172
src/Object/Computer.hs
Normal file
172
src/Object/Computer.hs
Normal file
|
|
@ -0,0 +1,172 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module Object.Computer where
|
||||
|
||||
import Affection as A
|
||||
|
||||
import Control.Monad (when)
|
||||
|
||||
import Data.Ecstasy
|
||||
import Data.Maybe
|
||||
|
||||
import Linear
|
||||
|
||||
import Types
|
||||
|
||||
|
||||
computerObjectAction dt t@ObjComputer s@"on" ent = do
|
||||
pent <- efor (anEnt ent) $ do
|
||||
with objUsedBy
|
||||
query objUsedBy
|
||||
vls <- efor (anEnt $ head pent) $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": on!")
|
||||
let dur = actionTime t s
|
||||
return unchanged
|
||||
{ objStateTime = Set dur
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return Nothing
|
||||
Just ttl -> do
|
||||
pa <- query objPlayerActivated
|
||||
if ttl < 0
|
||||
then
|
||||
return (Just pa)
|
||||
else if not (null vls) && head vls `dot` head vls > 0
|
||||
then return (Just pa)
|
||||
else return Nothing
|
||||
maybe
|
||||
(return ())
|
||||
(\tpa -> setEntity ent =<< computerObjectTransition t s tpa ent Nothing)
|
||||
(head trans)
|
||||
|
||||
computerObjectAction dt t@ObjComputer s@"hack" ent = do
|
||||
aent <- efor (anEnt ent) $ do
|
||||
with objUsedBy
|
||||
query objUsedBy
|
||||
vls <- efor (anEnt $ head aent) $ do
|
||||
with player
|
||||
with vel
|
||||
query vel
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": hacking!")
|
||||
return unchanged
|
||||
{ objStateTime = Set (actionTime t s)
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return Nothing
|
||||
Just ttl -> do
|
||||
if (ttl < 0) || (not (null vls) && head vls `dot` head vls > 0)
|
||||
then do
|
||||
tpa <- query objPlayerActivated
|
||||
return (Just tpa)
|
||||
else return Nothing
|
||||
maybe
|
||||
(return ())
|
||||
(\tpa -> setEntity ent =<< computerObjectTransition t s tpa ent Nothing)
|
||||
(head trans)
|
||||
|
||||
computerObjectAction _ _ _ _ = return ()
|
||||
|
||||
computerObjectTransition ObjComputer "off" pa ent (Just aent) = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
solved <- queryMaybe objSolved
|
||||
(_, dir) <- query objAccess
|
||||
if pa
|
||||
then if not (fromMaybe False solved)
|
||||
then do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "hack" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "hack"
|
||||
, objPlayerActivated = Set True
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
else do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "on" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "on"
|
||||
, objPlayerActivated = Set True
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
else do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "on" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "on"
|
||||
, objPlayerActivated = Set False
|
||||
, objUsedBy = Set aent
|
||||
}
|
||||
return (head e)
|
||||
|
||||
computerObjectTransition ObjComputer "on" _ ent _ = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
(_, dir) <- query objAccess
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "off" dir)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "off"
|
||||
, objPlayerActivated = Unset
|
||||
, objStateTime = Unset
|
||||
, objUsedBy = Unset
|
||||
}
|
||||
return (head e)
|
||||
|
||||
computerObjectTransition ObjComputer "hack" pa ent _ =
|
||||
if pa
|
||||
then do
|
||||
e <- efor (anEnt ent) $ do
|
||||
(_, dir) <- query objAccess
|
||||
let nstat = AnimState
|
||||
(AnimId AnimComputer "off" dir)
|
||||
0
|
||||
0
|
||||
ost <- query objStateTime
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "off"
|
||||
, objPlayerActivated = Unset
|
||||
, objStateTime = Unset
|
||||
, objUsedBy = Unset
|
||||
, objSolved = if pa then Set (ost < 0) else Keep
|
||||
}
|
||||
return (head e)
|
||||
else return unchanged
|
||||
|
||||
computerObjectTransition _ _ _ _ _ = return unchanged
|
||||
74
src/Object/Copier.hs
Normal file
74
src/Object/Copier.hs
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module Object.Copier where
|
||||
|
||||
import Affection as A
|
||||
|
||||
import Control.Monad (when)
|
||||
|
||||
import Data.Ecstasy
|
||||
import Data.Maybe
|
||||
|
||||
import Linear
|
||||
|
||||
import Types
|
||||
|
||||
copierObjectAction dt t@ObjCopier s@"copying" ent = do
|
||||
emap (anEnt ent) $ do
|
||||
mtime <- queryMaybe objStateTime
|
||||
case mtime of
|
||||
Nothing -> do
|
||||
liftIO $ logIO Verbose ("Copier " ++ show ent ++ ": copying!")
|
||||
return unchanged
|
||||
{ objStateTime = Set (actionTime t s)
|
||||
, objState = Set "copying"
|
||||
}
|
||||
Just ttl ->
|
||||
return unchanged
|
||||
{ objStateTime = Set (ttl - dt)
|
||||
}
|
||||
trans <- efor (anEnt ent) $ do
|
||||
mttl <- queryMaybe objStateTime
|
||||
case mttl of
|
||||
Nothing -> return False
|
||||
Just ttl -> return (ttl < 0)
|
||||
when (head trans) (setEntity ent =<< copierObjectTransition t s False ent Nothing)
|
||||
|
||||
copierObjectAction _ _ _ _ = return ()
|
||||
|
||||
copierObjectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimCopier "copy" N)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ objState = Set "copying"
|
||||
, objUsedBy = Set aent
|
||||
, objPlayerActivated = Set playerActivated
|
||||
, anim = Set nstat
|
||||
}
|
||||
return (head e)
|
||||
|
||||
copierObjectTransition ObjCopier "copying" _ ent _ = do
|
||||
e <- efor (anEnt ent) $ do
|
||||
ttl <- query objStateTime
|
||||
if ttl < 0
|
||||
then do
|
||||
let nstat = AnimState
|
||||
(AnimId AnimCopier "open" N)
|
||||
0
|
||||
0
|
||||
return unchanged
|
||||
{ anim = Set nstat
|
||||
, objState = Set "idle"
|
||||
, objStateTime = Unset
|
||||
, objPlayerActivated = Unset
|
||||
, objUsedBy = Unset
|
||||
}
|
||||
else return unchanged
|
||||
return (head e)
|
||||
|
||||
copierObjectTransition _ _ _ _ _ = return unchanged
|
||||
|
|
@ -48,6 +48,8 @@ executable tracer-game
|
|||
, MindMap
|
||||
, NPC
|
||||
, Object
|
||||
, Object.Computer
|
||||
, Object.Copier
|
||||
, Util
|
||||
default-extensions: OverloadedStrings
|
||||
, DeriveGeneric
|
||||
|
|
|
|||
Loading…
Reference in a new issue