Rename WorldActions to WorldEvent

2021-03-23 03:26:27 +01:00
parent afb3d8a712
commit 63a50f0e05
5 changed files with 767 additions and 0 deletions
@@ -0,0 +1,137 @@
+module Dodge.WorldEvent.Flash
+    where
+import Dodge.Data
+import Dodge.Base
+
+import Dodge.WorldEvent.ThingsHit
+import Dodge.WorldEvent.HelperParticle
+
+import Picture
+import Geometry
+
+import Control.Lens
+
+flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
+flareAt' col alphax alphay p 
+    = -- over particles' ((:) (flashColAt col alphax p))
+      -- . 
+      lowLightColAt col alphay p
+
+lowLightColAt :: Color -> Float ->  Point2 -> World -> World
+lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps
+    where ps = map ((+.+) p) $ nRaysRad 20 30
+
+lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
+lowLightWidthHit len wdth col alphay a b w 
+    = case thingsHitLongLine a b w of
+        ((p, E3x2 wall):_) 
+            -> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w
+        ((p, E3x1 cr):_) 
+            -> over particles' ((:) (crGlareWidth wdth col alphay p cr)) w
+        _  -> w
+
+flashColAt :: Color -> Float -> Point2 -> Particle'
+flashColAt col alphax (x,y) =
+    Particle' 
+        { _ptPict' = pictures $
+                         map (\i -> onLayerL [levLayer PtLayer] 
+                                    $ color (withAlpha alphax col) $ translate x y $ circleSolid i
+                         )
+                         [20,25,30,35,40,45,50]
+        , _ptUpdate' = ptTimer' 1
+        }
+
+wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
+wallGlareWidth len wdth col alphay p wl = 
+    Particle'
+        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
+        , _ptUpdate' = ptTimer' 1
+        }
+    where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
+          x = len *.* ( normalizeV $ a -.- b)
+          (a:b:_) = _wlLine wl
+
+crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle'
+crGlareWidth wdth col alphay p cr =
+    Particle'
+        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
+        , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
+                                              ,_ptUpdate' = ptTimer' 0
+                                              }
+                                )
+        }
+    where l x = uncurry translate x
+                $ rotate (-0.25*pi + argV (p -.- x))
+                $ color (withAlpha alphay col) 
+                $ thickArc 0 (pi/2) (_crRad cr) wdth
+          cp = _crPos cr
+          cid = _crID cr
+          upp cid' w' = case w' ^? creatures . ix cid . crPos of
+                            Just y -> l y 
+                            _      -> blank
+
+flareWidth :: Float -> Float -> Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
+flareWidth len wdth rad rays col ax ay p
+    = over particles' ((:) (flashRadAt rad col ax p))
+      . lowLightWidthAt len wdth col ay rays rad p
+
+flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
+flareRad rad rays col ax ay p
+    = over particles' ((:) (flashRadAt rad col ax p))
+      . lowLightWidthAt 10 5 col ay rays rad p
+
+flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
+flashRadAt rad col alphax (x,y) =
+    Particle' 
+        { _ptPict' = pictures $
+                         map (\i -> onLayerL [levLayer PtLayer]
+                                        $ color (withAlpha alphax col) $ translate x y $ circleSolid i
+                         )
+                         [rad/5,2*rad/5,3*rad/5,4*rad/5,rad]
+        , _ptUpdate' = ptTimer' 1
+        }
+
+lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
+lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
+    where ps = map ((+.+) p) $ nRaysRad rays rad
+
+explosionFlashAt = lowLightWidthAt 10 5 white 0.3 75 150
+
+flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50
+
+lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
+lowLightDirected col alpha a b angles w
+    = foldr (\angle w' -> lowLightWidthHit 10 5 col alpha a (a +.+ rotateV angle b) w') w angles
+
+
+muzFlareAt :: Point2 -> World -> World
+muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
+                . lowLightAt p
+
+muzzleFlareAt :: Point2 -> Particle'
+muzzleFlareAt (x,y) =
+    Particle' 
+        { _ptPict' = setDepth 0 
+                        . setLayer 1
+                        . translate x y 
+                        $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
+        , _ptUpdate' = ptTimer' 1
+        }
+
+
+lowLightAt :: Point2 -> World -> World
+lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w
+
+lowLightAt' :: Point2 -> World -> World
+lowLightAt' p w = foldr (lowLightHit' p) w ps
+    where ps = map ((+.+) p) $ nRaysRad 20 30
+
+lowLightHit' :: Point2 -> Point2 -> World -> World
+lowLightHit' a b w 
+    = case thingsHitLongLine a b w of
+        ((p, E3x2 wall):_) 
+            -> over particles' ((:) (wallGlare' p wall)) w
+        _  -> w
+
+wallGlare' :: Point2 -> Wall -> Particle'
+wallGlare' p wl = wallGlareWidth 5 5 white 0.1 p wl