cripple & shock – human

author: Gregor Kleen <gkleen@yggdrasil.li> 2016-06-12 15:46:19 +0200
committer: Gregor Kleen <gkleen@yggdrasil.li> 2016-06-12 15:46:19 +0200
commit: 532600423afbfe83185c6de28f951ebc3bcf5c3f (patch)
tree: 683517b9ad7b6fbcc2f059cf4ad4af542897277d /src
parent: 0802edda630246a0ff9f82196e55f09780ffa965 (diff)
download: 2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar
2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.gz
2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.bz2
2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.xz
2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.zip
1 files changed, 84 insertions, 20 deletions
diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs
index 1ad26bb..5f431de 100644
--- a/src/Sequence/Contact/Archetypes.hs
+++ b/src/Sequence/Contact/Archetypes.hs
@@ -47,6 +47,30 @@ archetypes = [ ("Mensch", human)
 cTable :: Ord v => [(Integer, Integer, v)] -> Table v
 cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100))
+death :: Hitzone -> FormulaM Stats (Maybe Stats)
+death zone = runMaybeT $ do
+  maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift
+  currentDmg <- MaybeT . preview $ ctx . sDamage' zone
+  allDmg <- MaybeT . preview $ ctx . sTotalDamage
+  let dmg = currentDmg + (maxVitality - allDmg)
+      dmg' = if dmg >= 0 then dmg else 0
+  MaybeT . previews ctx $ set (sDamage' zone) dmg'
+unconsciousR :: Formula Stats -> FormulaM Stats (Maybe Stats)
+unconsciousR roundsF = do
+  rounds <- roundsF
+  previews ctx $ over (sSequence . _Just . seqRound . _Wrapped) (+ rounds)
+unconscious :: FormulaM Stats (Maybe Stats)
+unconscious = previews ctx $ set sSequence Nothing
+amputate :: Hitzone -> Effect
+amputate zone = Effect (CI.mk $ review hitzone zone ++ " ist verloren") . runMaybeT $ do
+  hitzones <- MaybeT . preview $ ctx . sHitzones
+  (fromRational -> zoneProp) <- MaybeT . return $ Map.lookup zone hitzones
+  MaybeT . previews ctx . execState $ do
+    sHitzones %= Map.delete zone
+    sMaxVitality %= view (mapping . scaled $ 1 - zoneProp)
 human = Humanoid
        { _sAStrength = vStrength
@@ -111,20 +135,39 @@ human = Humanoid
                                                            & set seVal (sDamage' "Kopf" . to return)
                                                            & set seBar (sMaxVitality . mapping (scaled 0.5))
                                                            & set seReBar (sMaxVitality . mapping (scaled 0.2))
-                                                            & set seEffect (cTable [ (1, 10, Effect "Tod" headshot)
+                                                            & set seEffect (cTable [ (1, 10, Effect "Tod" $ death "Kopf")
                                                                                   , (11, 25, effect "Blind")
                                                                                   , (26, 35, effect "Blind, Rechts")
                                                                                   , (36, 45, effect "Blind, Links")
                                                                                   , (46, 75, effect "Taub")
-                                                                                   , (76, 100, Effect "Bewusstlos" . unconscious $ d 10)
+                                                                                   , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
                                                                                   ])
                                                   )
-                                                 , ("Torso", def)
+                                                 , ("Torso", def
-                                                 , ("Rechter Arm", def)
+                                                             & set seVal (sDamage' "Torso" . to return)
-                                                 , ("Linker Arm", def)
+                                                             & set seBar (sMaxVitality . mapping (scaled 0.75))
-                                                 , ("Unterleib", def)
+                                                             & set seReBar (sMaxVitality . mapping (scaled 0.2))
-                                                 , ("Rechtes Bein", def)
+                                                             & set seEffect (cTable [ (1, 5, Effect "Tod" $ death "Torso")
-                                                 , ("Linkes Bein", def)
+                                                                                    , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10))
+                                                                                    , (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)")
+                                                                                    , (46, 75, Effect "Bewusstlos" unconscious)
+                                                                                    , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
+                                                                                    ])
+                                                   )
+                                                 , ("Rechter Arm", arm "Rechter Arm")
+                                                 , ("Linker Arm", arm "Linker Arm")
+                                                 , ("Unterleib", def
+                                                                 & set seVal (sDamage' "Unterleib" . to return)
+                                                                 & set seBar (sMaxVitality . mapping (scaled 0.2))
+                                                                 & set seReBar (sMaxVitality . mapping (scaled 0.2))
+                                                                 & set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt")
+                                                                                         , (6, 25, Effect "Impotenz" . previews ctx $ over sFatigue (+ 15))
+                                                                                         , (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)")
+                                                                                         , (51, 100, Effect "Bewusstlos" unconscious)
+                                                                                         ])
+                                                   )
+                                                 , ("Rechtes Bein", bein "Rechtes Bein")
+                                                 , ("Linkes Bein", bein "Linkes Bein")
                                                 ]
        , _sDamage = const 0
@@ -133,24 +176,45 @@ human = Humanoid
        , _sSequence = Nothing
        , _sPainShock = def
+                        & set seReBar (sMaxVitality . mapping (scaled 0.75))
+                        & set seEffect ( cTable [ (1, 5, Effect "Organversagen" $ death "Torso")
+                                                , (6, 25, Effect "Koma" unconscious)
+                                                , (26, 45, Effect "Bewusstlos" . unconsciousR $ d 10)
+                                                , (46, 75, Effect "Bewusstlos" unconscious)
+                                                , (76, 100, Effect "Verlangsamt" $ d 10 >>= (\loss -> previews ctx $ over (sSequence . _Just . seqVal . _Just) (+ (-loss))))
+                                                ])
        , _sFatigueShock = def
+                           & set seReBar (sMaxVitality . mapping (scaled 0.75))
+                           & set seEffect ( cTable [ (1, 25, Effect "Bewusstlos" . unconsciousR $ 2 * d 10)
+                                                   , (26, 50, Effect "Bewusstlos" . unconsciousR $ d 10)
+                                                   , (51, 75, Effect "Bewusstlos" unconscious)
+                                                   , (76, 100, Effect "Verlangsamt" $ 2 * d 10 >>= (\loss -> previews ctx $ over (sSequence . _Just . seqVal . _Just) (+ (-loss))))
+                                                   ])
        , _sExtraSkills = []
        , _sModifiers = []
        }
  where
-    headshot = runMaybeT $ do
+    arm zone = def
-      maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift
+               & set seVal (sDamage' zone . to return)
-      currentDmg <- MaybeT . preview $ ctx . sDamage' "Kopf"
+               & set seBar (sMaxVitality . mapping (scaled 0.3))
-      allDmg <- MaybeT . preview $ ctx . sTotalDamage
+               & set seReBar (sMaxVitality . mapping (scaled 0.2))
-      let dmg = currentDmg + (maxVitality - allDmg)
+               & set seEffect (cTable [ (1, 10, amputate zone)
-          dmg' = if dmg >= 0 then dmg else 0
+                                      , (11, 25, effect $ review hitzone zone ++ " ist gelähmt und unbrauchbar")
-      MaybeT . previews ctx $ set (sDamage' "Kopf") dmg'
+                                      , (26, 45, effect $ review hitzone zone ++ " hat eingeschränkte Funktion (-50%)")
+                                      , (46, 75, Effect "Schwerste Schmerzen" . previews ctx $ over sFatigue (+ 10))
-    unconscious :: Formula Stats -> FormulaM Stats (Maybe Stats)
+                                      , (76, 100, effect "Fleischwunde")
-    unconscious roundsF = do
+                                      ])
-      rounds <- roundsF
+    bein zone = def
-      previews ctx $ over (sSequence . _Just . seqRound . _Wrapped) (+ rounds)
+               & set seVal (sDamage' zone . to return)
+               & set seBar (sMaxVitality . mapping (scaled 0.4))
+               & set seReBar (sMaxVitality . mapping (scaled 0.2))
+               & set seEffect (cTable [ (1, 10, amputate zone)
+                                      , (11, 45, effect $ review hitzone zone ++ " ist gelähmt und unbrauchbar (halbierte Bewegung)")
+                                      , (46, 75, Effect "Schwerste Schmerzen" . previews ctx $ over sFatigue (+ 10))
+                                      , (76, 100, effect "Fleischwunde")
+                                      ])
 dog = Quadruped
      { _sAStrength = vStrength
author	Gregor Kleen <gkleen@yggdrasil.li>	2016-06-12 15:46:19 +0200
committer	Gregor Kleen <gkleen@yggdrasil.li>	2016-06-12 15:46:19 +0200
commit	532600423afbfe83185c6de28f951ebc3bcf5c3f (patch)
tree	683517b9ad7b6fbcc2f059cf4ad4af542897277d /src
parent	0802edda630246a0ff9f82196e55f09780ffa965 (diff)
download	2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar 2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.gz 2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.bz2 2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.tar.xz 2017-01-16_17:13:37-532600423afbfe83185c6de28f951ebc3bcf5c3f.zip

diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index 1ad26bb..5f431de 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs
@@ -47,6 +47,30 @@ archetypes = [ ("Mensch", human)
47	cTable :: Ord v => [(Integer, Integer, v)] -> Table v	47	cTable :: Ord v => [(Integer, Integer, v)] -> Table v
48	cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100))	48	cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100))
49		49
		50	death :: Hitzone -> FormulaM Stats (Maybe Stats)
		51	death zone = runMaybeT $ do
		52	maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift
		53	currentDmg <- MaybeT . preview $ ctx . sDamage' zone
		54	allDmg <- MaybeT . preview $ ctx . sTotalDamage
		55	let dmg = currentDmg + (maxVitality - allDmg)
		56	dmg' = if dmg >= 0 then dmg else 0
		57	MaybeT . previews ctx $ set (sDamage' zone) dmg'
		58
		59	unconsciousR :: Formula Stats -> FormulaM Stats (Maybe Stats)
		60	unconsciousR roundsF = do
		61	rounds <- roundsF
		62	previews ctx $ over (sSequence . _Just . seqRound . _Wrapped) (+ rounds)
		63
		64	unconscious :: FormulaM Stats (Maybe Stats)
		65	unconscious = previews ctx $ set sSequence Nothing
		66
		67	amputate :: Hitzone -> Effect
		68	amputate zone = Effect (CI.mk $ review hitzone zone ++ " ist verloren") . runMaybeT $ do
		69	hitzones <- MaybeT . preview $ ctx . sHitzones
		70	(fromRational -> zoneProp) <- MaybeT . return $ Map.lookup zone hitzones
		71	MaybeT . previews ctx . execState $ do
		72	sHitzones %= Map.delete zone
		73	sMaxVitality %= view (mapping . scaled $ 1 - zoneProp)
50		74
51	human = Humanoid	75	human = Humanoid
52	{ _sAStrength = vStrength	76	{ _sAStrength = vStrength
@@ -111,20 +135,39 @@ human = Humanoid
111	& set seVal (sDamage' "Kopf" . to return)	135	& set seVal (sDamage' "Kopf" . to return)
112	& set seBar (sMaxVitality . mapping (scaled 0.5))	136	& set seBar (sMaxVitality . mapping (scaled 0.5))
113	& set seReBar (sMaxVitality . mapping (scaled 0.2))	137	& set seReBar (sMaxVitality . mapping (scaled 0.2))
114	& set seEffect (cTable [ (1, 10, Effect "Tod" headshot)	138	& set seEffect (cTable [ (1, 10, Effect "Tod" $ death "Kopf")
115	, (11, 25, effect "Blind")	139	, (11, 25, effect "Blind")
116	, (26, 35, effect "Blind, Rechts")	140	, (26, 35, effect "Blind, Rechts")
117	, (36, 45, effect "Blind, Links")	141	, (36, 45, effect "Blind, Links")
118	, (46, 75, effect "Taub")	142	, (46, 75, effect "Taub")
119	, (76, 100, Effect "Bewusstlos" . unconscious $ d 10)	143	, (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
120	])	144	])
121	)	145	)
122	, ("Torso", def)	146	, ("Torso", def
123	, ("Rechter Arm", def)	147	& set seVal (sDamage' "Torso" . to return)
124	, ("Linker Arm", def)	148	& set seBar (sMaxVitality . mapping (scaled 0.75))
125	, ("Unterleib", def)	149	& set seReBar (sMaxVitality . mapping (scaled 0.2))
126	, ("Rechtes Bein", def)	150	& set seEffect (cTable [ (1, 5, Effect "Tod" $ death "Torso")
127	, ("Linkes Bein", def)	151	, (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10))
		152	, (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)")
		153	, (46, 75, Effect "Bewusstlos" unconscious)
		154	, (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
		155	])
		156	)
		157	, ("Rechter Arm", arm "Rechter Arm")
		158	, ("Linker Arm", arm "Linker Arm")
		159	, ("Unterleib", def
		160	& set seVal (sDamage' "Unterleib" . to return)
		161	& set seBar (sMaxVitality . mapping (scaled 0.2))
		162	& set seReBar (sMaxVitality . mapping (scaled 0.2))
		163	& set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt")
		164	, (6, 25, Effect "Impotenz" . previews ctx $ over sFatigue (+ 15))
		165	, (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)")
		166	, (51, 100, Effect "Bewusstlos" unconscious)
		167	])
		168	)
		169	, ("Rechtes Bein", bein "Rechtes Bein")
		170	, ("Linkes Bein", bein "Linkes Bein")
128	]	171	]
129		172
130	, _sDamage = const 0	173	, _sDamage = const 0
@@ -133,24 +176,45 @@ human = Humanoid
133	, _sSequence = Nothing	176	, _sSequence = Nothing
134		177
135	, _sPainShock = def	178	, _sPainShock = def
		179	& set seReBar (sMaxVitality . mapping (scaled 0.75))
		180	& set seEffect ( cTable [ (1, 5, Effect "Organversagen" $ death "Torso")
		181	, (6, 25, Effect "Koma" unconscious)
		182	, (26, 45, Effect "Bewusstlos" . unconsciousR $ d 10)
		183	, (46, 75, Effect "Bewusstlos" unconscious)
		184	, (76, 100, Effect "Verlangsamt" $ d 10 >>= (\loss -> previews ctx $ over (sSequence . _Just . seqVal . _Just) (+ (-loss))))
		185	])
136	, _sFatigueShock = def	186	, _sFatigueShock = def
		187	& set seReBar (sMaxVitality . mapping (scaled 0.75))
		188	& set seEffect ( cTable [ (1, 25, Effect "Bewusstlos" . unconsciousR $ 2 * d 10)
		189	, (26, 50, Effect "Bewusstlos" . unconsciousR $ d 10)
		190	, (51, 75, Effect "Bewusstlos" unconscious)
		191	, (76, 100, Effect "Verlangsamt" $ 2 * d 10 >>= (\loss -> previews ctx $ over (sSequence . _Just . seqVal . _Just) (+ (-loss))))
		192	])
137		193
138	, _sExtraSkills = []	194	, _sExtraSkills = []
139	, _sModifiers = []	195	, _sModifiers = []
140	}	196	}
141	where	197	where
142	headshot = runMaybeT $ do	198	arm zone = def
143	maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift	199	& set seVal (sDamage' zone . to return)
144	currentDmg <- MaybeT . preview $ ctx . sDamage' "Kopf"	200	& set seBar (sMaxVitality . mapping (scaled 0.3))
145	allDmg <- MaybeT . preview $ ctx . sTotalDamage	201	& set seReBar (sMaxVitality . mapping (scaled 0.2))
146	let dmg = currentDmg + (maxVitality - allDmg)	202	& set seEffect (cTable [ (1, 10, amputate zone)
147	dmg' = if dmg >= 0 then dmg else 0	203	, (11, 25, effect $ review hitzone zone ++ " ist gelähmt und unbrauchbar")
148	MaybeT . previews ctx $ set (sDamage' "Kopf") dmg'	204	, (26, 45, effect $ review hitzone zone ++ " hat eingeschränkte Funktion (-50%)")
149		205	, (46, 75, Effect "Schwerste Schmerzen" . previews ctx $ over sFatigue (+ 10))
150	unconscious :: Formula Stats -> FormulaM Stats (Maybe Stats)	206	, (76, 100, effect "Fleischwunde")
151	unconscious roundsF = do	207	])
152	rounds <- roundsF	208	bein zone = def
153	previews ctx $ over (sSequence . _Just . seqRound . _Wrapped) (+ rounds)	209	& set seVal (sDamage' zone . to return)
		210	& set seBar (sMaxVitality . mapping (scaled 0.4))
		211	& set seReBar (sMaxVitality . mapping (scaled 0.2))
		212	& set seEffect (cTable [ (1, 10, amputate zone)
		213	, (11, 45, effect $ review hitzone zone ++ " ist gelähmt und unbrauchbar (halbierte Bewegung)")
		214	, (46, 75, Effect "Schwerste Schmerzen" . previews ctx $ over sFatigue (+ 10))
		215	, (76, 100, effect "Fleischwunde")
		216	])
		217
154		218
155	dog = Quadruped	219	dog = Quadruped
156	{ _sAStrength = vStrength	220	{ _sAStrength = vStrength