{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
module Imj.GameItem.Weapon.Laser
(
LaserRay(..)
, Ray(..)
, Theoretical
, Actual
, LaserReach(..)
, shootLaser
, shootLaserWithOffset
, LaserPolicy(..)
, computeActualLaserShot
, afterEnd
) where
import Imj.Prelude
import Data.List( minimumBy, partition )
import Data.Maybe( isJust, isNothing )
import Imj.GameItem.Weapon.Laser.Types
import Imj.Geo.Discrete
import Imj.Physics.Discrete.Collision
shootLaserWithOffset :: Coords Pos
-> Direction
-> LaserReach
-> (Coords Pos -> Location)
-> Maybe (Ray Theoretical)
shootLaserWithOffset shipCoords dir =
shootLaser (translateInDir dir shipCoords) dir
shootLaser :: Coords Pos
-> Direction
-> LaserReach
-> (Coords Pos -> Location)
-> Maybe (Ray Theoretical)
shootLaser laserStart dir laserType getLocation =
case getLocation laserStart of
OutsideWorld -> Nothing
InsideWorld ->
case laserType of
Infinite ->
let continueExtension c = getLocation c == InsideWorld
seg = mkSegmentByExtendingWhile laserStart dir continueExtension
in Just $ Ray seg
stopRayAtFirstCollision :: [Coords Pos] -> Ray Theoretical -> (Ray Actual, Maybe (Coords Pos))
stopRayAtFirstCollision coords (Ray s) =
let collisions =
map (\(c, Just i) -> (c,i))
$ filter (\(_, i) -> isJust i)
$ zip coords
$ map (`segmentContains` s) coords
limitAtFirstCollision :: [(Coords Pos, Int)] -> Segment -> (Ray Actual, Maybe (Coords Pos))
limitAtFirstCollision collis seg = case collis of
[] -> (Ray seg, Nothing)
l -> (Ray (changeSegmentLength (snd minElt) seg), Just $ fst minElt)
where
minElt = minimumBy (\(_, i) (_, j) -> compare (abs i) (abs j)) l
in limitAtFirstCollision collisions s
afterEnd :: LaserRay Actual -> Coords Pos
afterEnd (LaserRay dir (Ray seg)) =
translateInDir dir $ snd $ extremities seg
computeActualLaserShot :: [a]
-> (a -> Coords Pos)
-> LaserRay Theoretical
-> LaserPolicy
-> (([a],[a]), Maybe (LaserRay Actual))
computeActualLaserShot obstacles coords (LaserRay dir theoreticalRay@(Ray seg)) = \case
DestroyAllObstacles ->
( partition (\e -> isNothing $ segmentContains (coords e) seg) obstacles
, Just $ LaserRay dir $ Ray seg)
DestroyFirstObstacle ->
let (rayActual, mayCoord) =
stopRayAtFirstCollision (map coords obstacles) theoreticalRay
remainingObstacles = case mayCoord of
Nothing -> (obstacles,[])
(Just pos') -> partition (\e -> coords e /= pos') obstacles
in ( remainingObstacles
, Just $ LaserRay dir rayActual)