131 lines
4.7 KiB
Haskell
131 lines
4.7 KiB
Haskell
{- | Laser effects -}
|
|
module Dodge.Item.Weapon.Laser
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Picture
|
|
import Dodge.Picture.Layer
|
|
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 Dodge.Creature.State.Data
|
|
import Geometry
|
|
import Picture
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
import Data.Tuple
|
|
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
|
|
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 :: Fractional p => Char -> p
|
|
charToPhaseV 'V' = 0.2
|
|
charToPhaseV '/' = 1
|
|
charToPhaseV 'Z' = 5
|
|
charToPhaseV _ = error "Trying to set an undefined phaseV"
|
|
|
|
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 _ 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 (uncurry (-.-) (_wlLine wall)) (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 $ uncurry (-.-) $ swap (_wlLine wl)
|
|
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 = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
|
|
wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
|
|
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
|