Skip to content

Commit

Permalink
Add achievement for losing
Browse files Browse the repository at this point in the history
  • Loading branch information
kostmo committed Jan 2, 2023
1 parent 758dd97 commit 392f717
Show file tree
Hide file tree
Showing 6 changed files with 29 additions and 5 deletions.
14 changes: 13 additions & 1 deletion src/Swarm/Game/Step.hs
Original file line number Diff line number Diff line change
Expand Up @@ -187,6 +187,17 @@ hypotheticalWinCheck g ws oc = do
_ -> ws

winCondition .= WinConditions newWinState (completions finalAccumulator)

case newWinState of
Unwinnable _ -> do
currentTime <- sendIO getZonedTime
gameAchievements
%= M.insertWith
(<>)
LoseScenario
(Attainment (GameplayAchievement LoseScenario) Nothing currentTime)
_ -> return ()

announcementQueue %= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))

mapM_ handleException $ exceptions finalAccumulator
Expand Down Expand Up @@ -723,11 +734,12 @@ stepCESK cesk = case cesk of
case exn of
CmdFailed _ _ (Just a) -> do
currentTime <- sendIO getZonedTime
scenarioPath <- use currentScenarioPath
gameAchievements
%= M.insertWith
(<>)
a
(Attainment (GameplayAchievement a) Nothing currentTime)
(Attainment (GameplayAchievement a) scenarioPath currentTime)
_ -> return ()

-- If an exception rises all the way to the top level without being
Expand Down
2 changes: 1 addition & 1 deletion src/Swarm/TUI/Controller.hs
Original file line number Diff line number Diff line change
Expand Up @@ -442,7 +442,7 @@ saveScenarioInfoOnQuit = do
case segments of
firstDir : _ -> do
when (won && firstDir == tutorialsDirname) $
attainAchievement' t (Just $ T.pack p) (GlobalAchievement CompletedSingleTutorial)
attainAchievement' t (Just p) (GlobalAchievement CompletedSingleTutorial)
_ -> return ()
liftIO $ saveScenarioInfo p si

Expand Down
3 changes: 1 addition & 2 deletions src/Swarm/TUI/Model/Achievement/Attainment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,15 +10,14 @@ import Data.Aeson (
genericToJSON,
)
import Data.Function (on)
import Data.Text (Text)
import Data.Time (ZonedTime, zonedTimeToUTC)
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.TUI.Model.Achievement.Definitions

data Attainment = Attainment
{ _achievement :: CategorizedAchievement
, _maybeScenarioPath :: Maybe Text
, _maybeScenarioPath :: Maybe FilePath
-- ^ from which scenario was it obtained?
, _obtainedAt :: ZonedTime
}
Expand Down
1 change: 1 addition & 0 deletions src/Swarm/TUI/Model/Achievement/Definitions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -79,6 +79,7 @@ data GameplayAchievement
| RobotIntoWater
| AttemptSelfDestructBase
| DestroyedBase
| LoseScenario
deriving (Eq, Ord, Show, Bounded, Enum, Generic)

instance FromJSON GameplayAchievement
Expand Down
7 changes: 7 additions & 0 deletions src/Swarm/TUI/Model/Achievement/Description.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,3 +61,10 @@ describe (GameplayAchievement DestroyedBase) =
"Actually destroy your base."
Moderate
True
describe (GameplayAchievement LoseScenario) =
AchievementInfo
"Silver Lining"
(Just $ Freeform "Here's your consolation prize.")
"Lose at a scenario."
Easy
True
7 changes: 6 additions & 1 deletion src/Swarm/TUI/Model/StateUpdate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,12 @@ attainAchievement a = do
currentTime <- liftIO getZonedTime
attainAchievement' currentTime Nothing a

attainAchievement' :: (MonadIO m, MonadState AppState m) => ZonedTime -> Maybe Text -> CategorizedAchievement -> m ()
attainAchievement' ::
(MonadIO m, MonadState AppState m) =>
ZonedTime ->
Maybe FilePath ->
CategorizedAchievement ->
m ()
attainAchievement' t p a = do
(uiState . uiAchievements)
%= M.insertWith
Expand Down

0 comments on commit 392f717

Please sign in to comment.