Files
loop/src/Dodge/Beam.hs
T
2022-07-23 23:26:39 +01:00

60 lines
2.0 KiB
Haskell

module Dodge.Beam where
import Dodge.Data
import Dodge.Flame
import Dodge.Tesla.Arc
import Dodge.Item.Location
import Geometry
import LensHelp
import Picture
import Data.Maybe
import qualified IntMapHelp as IM
doBeamCombine :: BeamCombineType
-> (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World
-> World
doBeamCombine bct = case bct of
FlameBeamCombine -> flameBeamCombine
LasBeamCombine -> lasBeamCombine
TeslaBeamCombine -> teslaBeamCombine
SplitBeamCombine -> splitBeamCombine
NoBeamCombine -> const id
flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
flameBeamCombine (p,(a,b,_),(x,y,_))
= makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
lasBeamCombine (p,(a,b,_),(x,y,_))
= lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
splitBeamCombine (p,(a,b,_),(x,y,_))
= (lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
. (lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
where
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
= w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip
where
itid = fromJust $ _bmOrigin bm
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
(w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w
it = case getItem itid w of
Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
Just itm -> itm
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
lasRayAt col dam phasev pos dir = LaserStart
{ _lpDamage = dam
, _lpPhaseV = phasev
, _lpPos = pos
, _lpDir = dir
, _lpColor = col
}