Refactoring and linting

2021-04-30 17:50:28 +02:00
parent 83c2220813
commit 9c0e4425da
18 changed files with 531 additions and 523 deletions
@@ -5,6 +5,7 @@ module Dodge.Item.Weapon.Decoration
    where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture
 import Geometry.Data
 import Picture

@@ -0,0 +1,123 @@
+module Dodge.Item.Weapon.Laser
+    where
+import Dodge.Data
+import Dodge.Picture
+import Dodge.Item.Attachment.Data
+import Dodge.Base
+import Dodge.SoundLogic
+import Dodge.WorldEvent.SpawnParticle
+import Dodge.WorldEvent.ThingsHit
+import Dodge.WorldEvent.HelperParticle
+import Dodge.WorldEvent.Flash
+import Geometry
+import Picture
+
+import Control.Lens
+import System.Random
+import Data.List (find)
+import Data.Maybe (fromMaybe)
+import qualified Data.Sequence as Seq
+import qualified Data.IntMap.Strict as IM
+
+aLaser :: Int -> World -> World
+aLaser cid w = over particles (makeLaserAt phaseV pos dir (Just cid) : )
+    $ soundFrom LasSound 24 1 0 
+    $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
+    w
+  where 
+    cr  = _creatures w IM.! cid
+    i = newProjectileKey w
+    pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
+    dir = _crDir cr
+    phaseV = charToPhaseV 
+        $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . _Just . itCharMode
+    j = _crInvSel cr
+
+charToPhaseV 'V'    = 0.2
+charToPhaseV '/'   = 1
+charToPhaseV 'Z'    = 5
+
+
+makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
+makeLaserAt phaseV pos dir mcid = Particle
+    { _ptDraw = const blank
+    , _ptUpdate' = moveLaser phaseV pos dir mcid
+    }
+
+moveLaser 
+    :: Float    -- ^ Phase velocity, controls deflection in windows
+    -> Point2 
+    -> Float 
+    -> Maybe Int 
+    -> World 
+    -> Particle 
+    -> (World, Maybe Particle)
+moveLaser phaseV pos dir mcid w pt
+    = ( set randGen g $ hitEffect w
+      , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 }
+      )
+  where 
+    xp = pos +.+ 800 *.* unitVectorAtAngle dir
+    (a,g)  = randomR (-0.7,0.7) $ _randGen w
+    reflectDir wall = a + 
+        (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (xp -.- pos) )
+    (colID,_) = randomR (0,11) $ _randGen w
+    f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
+    f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
+        Just (p,E3x2 wl) 
+            | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) 
+                                             p 
+                                             (h x y wl p)
+            | otherwise -> (Just (p,E3x2 wl), [p])
+        Just (p,obj) -> (Just (p,obj), [p])
+        Nothing -> (Nothing, [y])
+    f' p (x,ps') = (x,p:ps')
+    h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
+               | otherwise = p +.+ rotateV angleRef' normalDist'
+      where 
+        wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0)
+        normalDist = magV (p -.- y) *.* normalizeV wlNormal
+        angleInc = piRange $ argV wlNormal - argV (x -.- y)
+        angleRef | reflectExternal = angleInc
+                 | otherwise = asin $ sin angleInc / phaseV
+        piRange a | a > pi = a - 2 * pi
+                  | a > negate pi = a
+                  | otherwise  = a + 2 * pi
+        isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0))
+        wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1)
+        normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
+        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
+        angleRef' | reflectInternal = angleInc'
+                  | otherwise = asin $ phaseV * sin angleInc'
+        reflectInternal = 1 < abs (phaseV * sin angleInc')
+        reflectExternal = 1 < abs (sin angleInc / phaseV)
+            
+    h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws
+    h' _ _ = True
+    (thHit, ps) = f [] pos xp
+    hitEffect
+      = case thHit of
+          Just (p,E3x1 cr) 
+              -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp)
+--                  . over worldEvents ((.) $ flareAt yellow (flarePos p))
+          Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p))
+                                                      (reflectDir wl) Nothing
+          _   -> id
+    pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow
+                   , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
+                   , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
+                   ]
+
+fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
+fadeLine sp ep alph width col = setLayer 1 $ polygonCol 
+    [(sp       , ca)
+    ,(sp +.+ n , cb)
+    ,(ep +.+ n , cb)
+    ,(ep       , ca)
+    ,(ep -.- n , cb)
+    ,(sp -.- n , cb)
+    ]
+  where 
+    n = width *.* normalizeV (vNormal $ ep -.- sp)
+    ca = withAlpha alph col
+    cb = withAlpha 0 col
@@ -42,6 +42,44 @@ withThickSmoke eff cid w = eff cid $ foldr (makeThickSmokeAt . (+.+ pos)) w ps
    pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
    ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w
 {- |
+Fires at an increasing rate.
+Has different effect after first fire.
+Applies ammo check and use cooldown check.  -}
+rateIncAB 
+    :: Int  -- ^ Start rate
+    -> Int  -- ^ End rate
+    -> (Int -> World -> World)  -- ^ Effect on first fire
+    -> (Int -> World -> World)  -- ^ Effect on continued fire
+    -> Int  -- ^ Creature id
+    -> World 
+    -> World
+rateIncAB startRate fastRate shooteff1 shooteff2 cid w
+    | repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1))
+                    $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+                    $ set (pointItem . itUseTime) currentRate
+                    $ shooteff2 cid
+                    w
+    | firstFire = set (pointItem . itUseRate) (startRate - 1)
+                    $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+                    $ set (pointItem . itUseTime) startRate
+                    $ shooteff1 cid
+                    w
+    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | otherwise = w
+  where 
+    cr = _creatures w IM.! cid
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointItem = creatures . ix cid . crInv . ix itRef
+    currentRate = _itUseRate item
+    repeatFire = _wpReloadState item == 0 
+        && _itUseTime item == 1 
+        && _wpLoadedAmmo item > 0
+    firstFire = _wpReloadState item == 0 
+        && _itUseTime item == 0 
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+{- |
 Shoot a weapon rapidly after a warm up.
 Applies ammo check as well.  -}
 withWarmUp 
@@ -55,18 +93,18 @@ withWarmUp t f cid w
    | reloadCondition = fromMaybe w $ reloadWeapon cid w
    | _wpReloadState item /= 0 = w
    | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) 
-                                    $ set (pointerToItem . wpFireState) 2 
+                                    $ set (pointerToItem . itUseTime) 2 
                                        w
    | t > 2  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
-                                    $ set (pointerToItem . wpFireState) 2
+                                    $ set (pointerToItem . itUseTime) 2
                                    $ soundFrom (CrWeaponSound cid) 26 2 0
                                        w 
    | t > 0  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
-                                    $ set (pointerToItem . wpFireState) 2
+                                    $ set (pointerToItem . itUseTime) 2
                                        w
    | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
                                    $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                                    $ set (pointerToItem . wpFireState) 2
+                                    $ set (pointerToItem . itUseTime) 2
                                    $ f cid
                                    $ soundFrom (CrWeaponSound cid) 28 2 0
                                        w
@@ -75,8 +113,8 @@ withWarmUp t f cid w
    itRef = _crInvSel cr
    item = _crInv cr IM.! itRef
    pointerToItem = creatures . ix cid . crInv . ix itRef
-    fState = _wpFireState item
-    fRate = _wpFireRate item
+    fState = _itUseTime item
+    fRate = _itUseRate item
    reloadCondition = _wpLoadedAmmo item == 0
 {- |
 Adds a sound to a creature based world effect. 
@@ -136,7 +174,7 @@ shootWithSound
 shootWithSound soundid f cid w
    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
        $ soundOncePos soundid (_crPos cr)
-        $ set (pointerToItem . wpFireState) (_wpFireRate item)
+        $ set (pointerToItem . itUseTime) (_itUseRate item)
        $ f cid w
    | reloadCondition = fromMaybe w $ reloadWeapon cid w
    | otherwise = w
@@ -146,10 +184,25 @@ shootWithSound soundid f cid w
    item = _crInv cr IM.! itRef
    pointerToItem = creatures . ix cid . crInv . ix itRef
    fireCondition = _wpReloadState item == 0
-                      && _wpFireState item == 0
+                      && _itUseTime item == 0
                      && _wpLoadedAmmo item > 0
    reloadCondition = _wpLoadedAmmo item == 0
 {- | 
+Applies a world effect after an item use cooldown check. -}
+useTimeCheck
+    :: (Int -> World -> World)  -- ^ Underlying effect
+    -> Int                      -- ^ Creature id
+    -> World
+    -> World
+useTimeCheck f cid w = case theItem ^? itUseTime of
+    Just 0 -> f cid $ setUseTime w
+    _             -> w
+  where 
+    cr = _creatures w IM.! cid
+    setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate
+    theItem = _crInv cr IM.! _crInvSel cr
+    useRate = fromMaybe 0 $ theItem ^? itUseRate
+{- | 
 Applies a world effect after a hammer position check. -}
 hammerCheck
    :: (Int -> World -> World)  -- ^ Underlying effect
@@ -172,7 +225,7 @@ shoot
    -> World
 shoot f cid w 
    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                          $ set (pointerToItem . wpFireState) (_wpFireRate item)
+                          $ set (pointerToItem . itUseTime) (_itUseRate item)
                          $ f cid w
    | reloadCondition = fromMaybe w $ reloadWeapon cid w
    | otherwise = w
@@ -182,7 +235,7 @@ shoot f cid w
    item = _crInv cr IM.! itRef
    pointerToItem = creatures . ix cid . crInv . ix itRef
    fireCondition = _wpReloadState item == 0
-        && _wpFireState item == 0
+        && _itUseTime item == 0
        && _wpLoadedAmmo item > 0
    reloadCondition = _wpLoadedAmmo item == 0