From 06845657f27dc4c35ce9ffc1a113e8c6e7145114 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 15 Feb 2019 11:22:24 +0100 Subject: [PATCH] moduularize objects --- src/Object.hs | 212 +++-------------------------------------- src/Object/Computer.hs | 172 +++++++++++++++++++++++++++++++++ src/Object/Copier.hs | 74 ++++++++++++++ tracer-game.cabal | 2 + 4 files changed, 259 insertions(+), 201 deletions(-) create mode 100644 src/Object/Computer.hs create mode 100644 src/Object/Copier.hs diff --git a/src/Object.hs b/src/Object.hs index ef0be88..cb440c8 100644 --- a/src/Object.hs +++ b/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 diff --git a/src/Object/Computer.hs b/src/Object/Computer.hs new file mode 100644 index 0000000..6fe764a --- /dev/null +++ b/src/Object/Computer.hs @@ -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 diff --git a/src/Object/Copier.hs b/src/Object/Copier.hs new file mode 100644 index 0000000..7364722 --- /dev/null +++ b/src/Object/Copier.hs @@ -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 diff --git a/tracer-game.cabal b/tracer-game.cabal index 6ed2a0a..b2fd9fc 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -48,6 +48,8 @@ executable tracer-game , MindMap , NPC , Object + , Object.Computer + , Object.Copier , Util default-extensions: OverloadedStrings , DeriveGeneric