Achievement for disorientation (#1173)

Inspired by #1105

![image](https://user-images.githubusercontent.com/261693/227453439-b08afe02-07f1-40dd-9688-9d77dcef7989.png)

src/Swarm/Game/Achievement/Definitions.hs

@@ -82,6 +82,7 @@ data GameplayAchievement
   | AttemptSelfDestructBase
   | DestroyedBase
   | LoseScenario
+  | GetDisoriented
   deriving (Eq, Ord, Show, Bounded, Enum, Generic)
 
 instance FromJSON GameplayAchievement

src/Swarm/Game/Achievement/Description.hs

@@ -72,3 +72,15 @@ describe (GameplayAchievement LoseScenario) =
     "Lose at a scenario."
     Easy
     True
+describe (GameplayAchievement GetDisoriented) =
+  AchievementInfo
+    "Playing Ostrich"
+    ( Just $
+        FTQuotation $
+          Quotation
+            "Lil Jon"
+            "Fire up that loud / Another round of shots / Turn down for what?"
+    )
+    "'turn down' without a compass. Congratulations, you are 'disoriented'. How are you supposed to move now?"
+    Easy
+    True

src/Swarm/Game/Step.hs

@@ -293,12 +293,7 @@ hypotheticalWinCheck em g ws oc = do
 
   case newWinState of
     Unwinnable _ -> do
-      currentTime <- sendIO getZonedTime
-      gameAchievements
-        %= M.insertWith
-          (<>)
-          LoseScenario
-          (Attainment (GameplayAchievement LoseScenario) Nothing currentTime)
+      grantAchievement LoseScenario
     _ -> return ()
 
   announcementQueue %= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))
@@ -842,13 +837,7 @@ stepCESK cesk = case cesk of
     -- handled.
     case exn of
       CmdFailed _ _ (Just a) -> do
-        currentTime <- sendIO getZonedTime
-        scenarioPath <- use currentScenarioPath
-        gameAchievements
-          %= M.insertWith
-            (<>)
-            a
-            (Attainment (GameplayAchievement a) scenarioPath currentTime)
+        grantAchievement a
       _ -> return ()
 
     -- If an exception rises all the way to the top level without being
@@ -1045,6 +1034,11 @@ execConst c vs s k = do
         when (isCardinal d) $ hasCapabilityFor COrient (TDir d)
         robotOrientation . _Just %= applyTurn d
         flagRedraw
+
+        inst <- use equippedDevices
+        when (d == DRelative DDown && countByName "compass" inst == 0) $ do
+          grantAchievement GetDisoriented
+
         return $ Out VUnit s k
       _ -> badConst
     Place -> case vs of
@@ -2148,6 +2142,19 @@ execConst c vs s k = do
 -- Some utility functions
 ------------------------------------------------------------
 
+grantAchievement ::
+  (Has (State GameState) sig m, Has (Lift IO) sig m) =>
+  GameplayAchievement ->
+  m ()
+grantAchievement a = do
+  currentTime <- sendIO getZonedTime
+  scenarioPath <- use currentScenarioPath
+  gameAchievements
+    %= M.insertWith
+      (<>)
+      a
+      (Attainment (GameplayAchievement a) scenarioPath currentTime)
+
 -- | How to handle failure, for example when moving to blocked location
 data RobotFailure = ThrowExn | Destroy | IgnoreFail