-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.Topography.Navigation.Util where

import Control.Lens (view)
import Data.Function (on)
import Data.Int (Int32)
import Linear (V2)
import Swarm.Game.Location
import Swarm.Game.Robot
import Swarm.Game.Universe (Cosmic, planar)
import Swarm.Language.Syntax.Direction

-- |
-- Computes the relative offset vector between a 'Robot' and a 'Location'
-- (presumed to be in the same subworld, though the contrary will
-- not result in failure), then re-interpret that vector based on the
-- 'Robot'\'s current orientation.
--
-- If the robot is not oriented in a cardinal direction, returns 'Nothing'.
--
-- = Re-orientation semantics
--
-- Given a displacement vector @(x, y)@ where:
--
-- * positive @x@-coordinate represents @east@
-- * negative @x@-coordinate represents @west@
-- * positive @y@-coordinate represents @north@
-- * negative @y@-coordinate represents @south@
--
-- the re-interpreted vector @(x', y')@ becomes:
--
-- * positive @x'@-coordinate represents @right@
-- * negative @x'@-coordinate represents @left@
-- * positive @y'@-coordinate represents @forward@
-- * negative @y'@-coordinate represents @back@
orientationBasedRelativePosition :: Robot -> Cosmic Location -> Maybe (V2 Int32)
orientationBasedRelativePosition :: Robot -> Cosmic Location -> Maybe (V2 Int32)
orientationBasedRelativePosition Robot
selfRobot Cosmic Location
otherLocation =
  (Direction -> V2 Int32 -> V2 Int32
`applyTurn` V2 Int32
relativeCoords) (Direction -> V2 Int32) -> Maybe Direction -> Maybe (V2 Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Direction
maybeSelfDirRelativeToNorth
 where
  maybeSelfDirection :: Maybe AbsoluteDir
maybeSelfDirection = Getting (Maybe (V2 Int32)) Robot (Maybe (V2 Int32))
-> Robot -> Maybe (V2 Int32)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe (V2 Int32)) Robot (Maybe (V2 Int32))
Lens' Robot (Maybe (V2 Int32))
robotOrientation Robot
selfRobot Maybe (V2 Int32)
-> (V2 Int32 -> Maybe AbsoluteDir) -> Maybe AbsoluteDir
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= V2 Int32 -> Maybe AbsoluteDir
toAbsDirection
  maybeSelfDirRelativeToNorth :: Maybe Direction
maybeSelfDirRelativeToNorth = RelativeDir -> Direction
DRelative (RelativeDir -> Direction)
-> (AbsoluteDir -> RelativeDir) -> AbsoluteDir -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarRelativeDir -> RelativeDir
DPlanar (PlanarRelativeDir -> RelativeDir)
-> (AbsoluteDir -> PlanarRelativeDir) -> AbsoluteDir -> RelativeDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsoluteDir -> AbsoluteDir -> PlanarRelativeDir
relativeTo AbsoluteDir
DNorth (AbsoluteDir -> Direction) -> Maybe AbsoluteDir -> Maybe Direction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AbsoluteDir
maybeSelfDirection

  relativeCoords :: Diff (Point V2) Int32
relativeCoords = (Location -> Location -> Diff (Point V2) Int32
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
(.-.) (Location -> Location -> Diff (Point V2) Int32)
-> (Cosmic Location -> Location)
-> Cosmic Location
-> Cosmic Location
-> Diff (Point V2) Int32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Location (Cosmic Location) Location
-> Cosmic Location -> Location
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) Cosmic Location
otherLocation (Getting (Cosmic Location) Robot (Cosmic Location)
-> Robot -> Cosmic Location
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation Robot
selfRobot)