diff options
author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-12-02 12:29:17 +0100 |
---|---|---|
committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-12-02 12:29:17 +0100 |
commit | 7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c (patch) | |
tree | d390caf6c166d9beecf1a9ad0532930c667bd53d | |
parent | 917f9c29063961c6825c4253422db946e1f2350f (diff) | |
download | 2017-01-16_17:13:37-7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c.tar 2017-01-16_17:13:37-7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c.tar.gz 2017-01-16_17:13:37-7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c.tar.bz2 2017-01-16_17:13:37-7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c.tar.xz 2017-01-16_17:13:37-7ecbf4f5c7bd0c3c2f92559a2313274b6d075e6c.zip |
Entity replacement
-rw-r--r-- | src/Main.hs | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/src/Main.hs b/src/Main.hs index db49e14..9a51332 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -95,6 +95,7 @@ main = do | |||
95 | , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary" | 95 | , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary" |
96 | , cmd "name" nameEntity "Name the current entity overriding previous name assignments" | 96 | , cmd "name" nameEntity "Name the current entity overriding previous name assignments" |
97 | , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it" | 97 | , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it" |
98 | , cmd "replace" replaceEntity "Replace the focused entity with a different one carrying over some values" | ||
98 | , cmd "spawn'" spawnFaction "Create a new faction and spawn multiple copies of an archetype in it" | 99 | , cmd "spawn'" spawnFaction "Create a new faction and spawn multiple copies of an archetype in it" |
99 | , cmd "test" rollTest "Roll a test using the stats of the currently focused entity" | 100 | , cmd "test" rollTest "Roll a test using the stats of the currently focused entity" |
100 | , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" | 101 | , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" |
@@ -326,11 +327,25 @@ remove = withFocus $ \ident -> do | |||
326 | blur | 327 | blur |
327 | 328 | ||
328 | -- Manage Entity | 329 | -- Manage Entity |
329 | spawnEntity :: Completable Entity -> Sh GameState () | 330 | spawnEntity, replaceEntity :: Completable Entity -> Sh GameState () |
330 | spawnEntity = withArg $ \entity -> do | 331 | spawnEntity = withArg $ \entity -> do |
331 | identifier <- use gNextId' | 332 | identifier <- use gNextId' |
332 | modify $ insertEntity entity | 333 | modify $ insertEntity entity |
333 | gFocus ?= identifier | 334 | gFocus ?= identifier |
335 | replaceEntity = withArg $ \entity -> void . withFocus' $ \old -> do | ||
336 | let oldStats = old ^. eStats | ||
337 | modifying (gFocus' . eStats) . execState $ do | ||
338 | put $ entity ^. eStats | ||
339 | let | ||
340 | copy :: st -> Traversal' st a -> State st () | ||
341 | copy from lens = do | ||
342 | case preview lens from of | ||
343 | Just a -> lens .= a | ||
344 | Nothing -> return () | ||
345 | copy oldStats sSeqVal | ||
346 | copy oldStats sTimer | ||
347 | copy oldStats sModifiers | ||
348 | copy oldStats sEquipment | ||
334 | 349 | ||
335 | nameEntity :: String -> Sh GameState () | 350 | nameEntity :: String -> Sh GameState () |
336 | nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" | 351 | nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" |