moduularize objects

This commit is contained in:
nek0 2019-02-15 11:22:24 +01:00
parent 16a329ddac
commit 06845657f2
4 changed files with 259 additions and 201 deletions

View file

@ -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
View 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
View 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

View file

@ -48,6 +48,8 @@ executable tracer-game
, MindMap
, NPC
, Object
, Object.Computer
, Object.Copier
, Util
default-extensions: OverloadedStrings
, DeriveGeneric