Move flame into its own datatype

2022-07-18 22:41:40 +01:00
parent c14b3ff787
commit 54ba0fbedc
29 changed files with 444 additions and 318 deletions
@@ -0,0 +1,35 @@
+module Dodge.Tesla.Arc.Default where
+import Dodge.Data
+import RandomHelp
+import Geometry
+import Dodge.Base.Collide
+import LensHelp
+import Shape
+
+import Data.Maybe
+import Data.List (sortOn)
+import qualified Data.IntMap.Strict as IM
+
+defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
+    -> State g (Maybe ArcStep)
+defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
+defaultArcStep itparams w (ArcStep p dir _) = do
+    let csize = _arcSize itparams
+    --rot <- takeOne [pi/4,negate pi/4]
+    rot <- takeOne [0]
+    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
+    newp <- (center +.+) <$> randInCirc csize
+    let mcr = listToMaybe 
+            . sortOn (dist center . _crPos) 
+            . filter (\cr -> dist center (_crPos cr) < csize)
+            . IM.elems
+            $ _creatures w
+        mwl = listToMaybe
+            . sortOn (dist p . fst)
+            . mapMaybe (\ q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w)
+                -- collidePointWallsWall and wlsnearpoint
+            $ polyCirc 6 csize
+        f (q,wl) = ArcStep q dir (Just $ Right wl)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos))
+        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]