module Wumpus.Basic.Kernel.Objects.Displacement
(
PointDisplace
, ThetaDisplace
, ThetaPointDisplace
, moveStart
, moveStartTheta
, moveStartThetaPoint
, moveStartThetaAngle
, displace
, displaceVec
, displaceH
, displaceV
, northwards
, southwards
, eastwards
, westwards
, northeastwards
, northwestwards
, southeastwards
, southwestwards
, displaceParallel
, displacePerpendicular
, displaceOrtho
, thetaNorthwards
, thetaSouthwards
, thetaEastwards
, thetaWestwards
, thetaNortheastwards
, thetaNorthwestwards
, thetaSoutheastwards
, thetaSouthwestwards
) where
import Wumpus.Basic.Kernel.Base.ContextFun
import Wumpus.Core
import Data.AffineSpace
type PointDisplace u = Point2 u -> Point2 u
type ThetaDisplace = Radian -> Radian
type ThetaPointDisplace u = Radian -> PointDisplace u
moveStart :: PointDisplace u -> LocCF u a -> LocCF u a
moveStart f ma = promoteR1 $ \pt -> apply1R1 ma (f pt)
moveStartTheta :: ThetaPointDisplace u -> LocThetaCF u a -> LocThetaCF u a
moveStartTheta f ma = promoteR2 $ \pt theta -> let p2 = f theta pt
in apply2R2 ma p2 theta
moveStartThetaPoint :: PointDisplace u -> LocThetaCF u a -> LocThetaCF u a
moveStartThetaPoint f ma = promoteR2 $ \pt theta -> apply2R2 ma (f pt) theta
moveStartThetaAngle :: ThetaDisplace -> LocThetaCF u a -> LocThetaCF u a
moveStartThetaAngle f ma = promoteR2 $ \pt theta -> apply2R2 ma pt (f theta)
displace :: Num u => u -> u -> PointDisplace u
displace dx dy (P2 x y) = P2 (x+dx) (y+dy)
displaceVec :: Num u => Vec2 u -> PointDisplace u
displaceVec (V2 dx dy) (P2 x y) = P2 (x+dx) (y+dy)
displaceH :: Num u => u -> PointDisplace u
displaceH dx (P2 x y) = P2 (x+dx) y
displaceV :: Num u => u -> PointDisplace u
displaceV dy (P2 x y) = P2 x (y+dy)
northwards :: Num u => u -> PointDisplace u
northwards = displaceV
southwards :: Num u => u -> PointDisplace u
southwards = displaceV . negate
eastwards :: Num u => u -> PointDisplace u
eastwards = displaceH
westwards :: Num u => u -> PointDisplace u
westwards = displaceH . negate
northeastwards :: Floating u => u -> PointDisplace u
northeastwards = displaceVec . avec (0.25 * pi)
northwestwards :: Floating u => u -> PointDisplace u
northwestwards = displaceVec . avec (0.75 * pi)
southeastwards :: Floating u => u -> PointDisplace u
southeastwards = displaceVec . avec (1.75 * pi)
southwestwards :: Floating u => u -> PointDisplace u
southwestwards = displaceVec . avec (1.25 * pi)
displaceParallel :: Floating u => u -> ThetaPointDisplace u
displaceParallel d = \theta pt -> pt .+^ avec (circularModulo theta) d
displacePerpendicular :: Floating u => u -> ThetaPointDisplace u
displacePerpendicular d =
\theta pt -> pt .+^ avec (circularModulo $ theta + (0.5*pi)) d
displaceOrtho :: Floating u => Vec2 u -> ThetaPointDisplace u
displaceOrtho (V2 x y) = \theta ->
displaceParallel x theta . displacePerpendicular y theta
thetaNorthwards :: Floating u => u -> ThetaPointDisplace u
thetaNorthwards = displacePerpendicular
thetaSouthwards :: Floating u => u -> ThetaPointDisplace u
thetaSouthwards = displacePerpendicular . negate
thetaEastwards :: Floating u => u -> ThetaPointDisplace u
thetaEastwards = displaceParallel
thetaWestwards :: Floating u => u -> ThetaPointDisplace u
thetaWestwards = displaceParallel . negate
thetaNortheastwards :: Floating u => u -> ThetaPointDisplace u
thetaNortheastwards d =
\theta pt -> pt .+^ avec (circularModulo $ theta + (0.25*pi)) d
thetaNorthwestwards :: Floating u => u -> ThetaPointDisplace u
thetaNorthwestwards d =
\theta pt -> pt .+^ avec (circularModulo $ theta + (0.75*pi)) d
thetaSoutheastwards :: Floating u => u -> ThetaPointDisplace u
thetaSoutheastwards d =
\theta pt -> pt .+^ avec (circularModulo $ theta + (1.75*pi)) d
thetaSouthwestwards :: Floating u => u -> ThetaPointDisplace u
thetaSouthwestwards d =
\theta pt -> pt .+^ avec (circularModulo $ theta + (1.25*pi)) d