Refactoring

2021-05-03 23:59:20 +02:00
parent b826299cbd
commit e21178b688
20 changed files with 830 additions and 731 deletions
@@ -0,0 +1,53 @@
+{- |
+Drawing of creatures. 
+Takes into account damage etc. -}
+module Dodge.Creature.Picture
+    ( basicCrPict
+    , circLine
+    ) where
+import Dodge.Data
+import Dodge.Picture.Layer
+import Picture
+import Geometry
+
+import Control.Lens
+import Data.List
+import qualified Data.IntMap.Strict as IM
+basicCrPict 
+    :: Color    -- ^ Creature color
+    -> Creature 
+    -> Picture
+basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked , drawEquipment cr]
+  where 
+    cdir = _crDir cr
+    naked 
+        | pdam > 200    = color red $ circleSolid $ _crRad cr
+        | pdam > 100    = color white $ circleSolid $ _crRad cr
+        | otherwise     = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
+    pastDams = _crPastDamage $ _crState cr
+    pdam = sum $ concatMap (map _dmAmount) $ pastDams
+    col' = light . light . light $ light col
+    bluntDam :: Maybe Point2
+    bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
+    bluntScale = case fmap argV bluntDam of
+        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
+        _   -> id
+    isBluntDam (Blunt {}) = True
+    isBluntDam _ = False
+    piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
+    isPiercingDam (Piercing {}) = True
+    isPiercingDam _ = False
+    piercingMod = case fmap argV piercingDam of
+        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
+        _   -> id
+
+drawEquipment 
+    :: Creature 
+    -> Picture
+drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
+  where 
+    f (i,it) = case it ^? itEquipPict of
+        Just g -> g cr i
+        _      -> blank
+
+circLine x = line [(0,0),(x,0)]