From b14d9a6d765728b89e8b7bb85fd841ecb8488b93 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Sat, 11 Aug 2018 11:51:20 +0200
Subject: [PATCH] prepare hackable computers

---
 src/Load.hs              | 12 ++++-
 src/MainGame/WorldMap.hs |  1 +
 src/Object.hs            | 98 ++++++++++++++++++++++++++++++++++------
 src/Types/Entity.hs      |  1 +
 4 files changed, 97 insertions(+), 15 deletions(-)

diff --git a/src/Load.hs b/src/Load.hs
index 478a0d8..322ec81 100644
--- a/src/Load.hs
+++ b/src/Load.hs
@@ -62,7 +62,7 @@ loadFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadFork ws win glc nvg future progress = do
-  let stateSteps = 35
+  let stateSteps = 36
       increment = 1 / stateSteps
   SDL.glMakeCurrent win glc
   modifyMVar_ progress (return . (\(p, _) ->
@@ -272,6 +272,15 @@ loadFork ws win glc nvg future progress = do
       , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
       )
     ]
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Loading Animation \"computer: hack\""
+    )))
+  computerHack <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
+    [ ( AnimId "computer" "hack" N
+      , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
+      )
+    ]
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"toilet: free\""
@@ -307,6 +316,7 @@ loadFork ws win glc nvg future progress = do
           copierStand ++
           copierCopy ++
           computerOff ++
+          computerHack ++
           toiletFree ++
           toiletOccupied
         )
diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs
index 5a7155e..22c14db 100644
--- a/src/MainGame/WorldMap.hs
+++ b/src/MainGame/WorldMap.hs
@@ -157,6 +157,7 @@ loadMapFork ud ad future progress = do
         , anim      = Just $ AnimState (AnimId "computer" "off" N) 0 0
         , objAccess = Just $ (V2 1 (-1), dir)
         , objType   = Just ObjComputer
+        , objState  = Just "off"
         }
       ) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers)
     void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering toilets into WorldState")
diff --git a/src/Object.hs b/src/Object.hs
index 606f4ba..eb88699 100644
--- a/src/Object.hs
+++ b/src/Object.hs
@@ -8,6 +8,9 @@ import Affection as A
 import Control.Monad (when)
 
 import Data.Ecstasy
+import Data.Maybe
+
+import Linear
 
 import Types
 
@@ -33,6 +36,38 @@ instance ObjectAction ObjType ObjState where
         Just ttl -> return (ttl < 0)
     when trans (setEntity ent =<< objectTransition t s False ent)
 
+  objectAction dt t@ObjComputer s@"hack" ent = do
+    [vel] <- efor allEnts $ do
+      with player
+      with vel
+      query vel
+    emap (anEnt ent) $ do
+      mtime <- queryMaybe objStateTime
+      case mtime of
+        Nothing -> do
+          liftIO $ logIO Debug ("Computer " ++ show ent ++ ": hacking!")
+          return unchanged
+            { objStateTime = Set (actionTime t s)
+            }
+        Just ttl -> do
+          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) || vel `dot` vel > 0
+          then do
+            tpa <- query objPlayerActivated
+            return (Just tpa)
+          else return Nothing
+    maybe
+      (return ())
+      (\tpa -> setEntity ent =<< objectTransition t s tpa ent)
+      trans
+
   objectAction _ _ _ _ = return ()
 
   objectTransition ObjCopier "idle" playerActivated ent = do
@@ -50,25 +85,60 @@ instance ObjectAction ObjType ObjState where
 
   objectTransition ObjCopier "copying" _ ent = do
     [e] <- efor (anEnt ent) $ do
-        ttl <- query objStateTime
-        if ttl < 0
-        then do
-          let nstat = AnimState
-                (AnimId "copier" "open" N)
-                0
-                0
-          return unchanged
-            { anim               = Set nstat
-            , objState           = Set "idle"
-            , objStateTime       = Unset
-            , objPlayerActivated = Unset
-            }
-        else return unchanged
+      ttl <- query objStateTime
+      if ttl < 0
+      then do
+        let nstat = AnimState
+              (AnimId "copier" "open" N)
+              0
+              0
+        return unchanged
+          { anim               = Set nstat
+          , objState           = Set "idle"
+          , objStateTime       = Unset
+          , objPlayerActivated = Unset
+          }
+      else return unchanged
+    return e
+
+  objectTransition ObjComputer "off" pa ent = do
+    [e] <- efor (anEnt ent) $ do
+      solved <- queryMaybe objSolved
+      if pa && not (fromMaybe False solved)
+      then do
+        let nstat = AnimState
+              (AnimId "computer" "hack" N)
+              0
+              0
+        return unchanged
+          { anim               = Set nstat
+          , objState           = Set "hack"
+          , objPlayerActivated = Set True
+          }
+      else return unchanged
+    return e
+
+  objectTransition ObjComputer "hack" _ ent = do
+    [e] <- efor (anEnt ent) $ do
+      let nstat = AnimState
+            (AnimId "computer" "off" N)
+            0
+            0
+      ost <- query objStateTime
+      return unchanged
+        { anim               = Set nstat
+        , objState           = Set "off"
+        , objPlayerActivated = Unset
+        , objStateTime       = Unset
+        , objSolved          = Set (ost < 0)
+        }
     return e
 
   objectTransition _ _ _ _ = return unchanged
 
 instance ActionTime ObjType ObjState where
   actionTime ObjCopier "copying" = 5
+  actionTime ObjComputer "off" = 0
+  actionTime ObjComputer "hack" = 20
 
   actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not time") 0
diff --git a/src/Types/Entity.hs b/src/Types/Entity.hs
index d83131d..1284dbb 100644
--- a/src/Types/Entity.hs
+++ b/src/Types/Entity.hs
@@ -27,5 +27,6 @@ data Entity f = Entity
   , objState           :: Component f 'Field ObjState
   , objStateTime       :: Component f 'Field Double
   , objPlayerActivated :: Component f 'Field Bool
+  , objSolved          :: Component f 'Field Bool
   }
   deriving (Generic)