moduularize objects

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
+  objectAction dt t@ObjCopier s ent = copierObjectAction dt t s ent
-    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@ObjComputer s@"on" ent = do
+  objectAction dt t@ObjComputer s ent = computerObjectAction dt t s ent
-    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 _ _ _ _ = return ()
 
-  objectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
+  objectTransition t@ObjCopier s pa ent aent =
-    e <- efor (anEnt ent) $ do
+    copierObjectTransition t s pa ent aent
-        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 ObjCopier "copying" _ ent _ = do
+  objectTransition t@ObjComputer s pa ent aent =
-    e <- efor (anEnt ent) $ do
+    computerObjectTransition t s pa ent aent
-      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 _ _ _ _ _ = return unchanged
 

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

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

tracer-game.cabal

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