{-# language RecordWildCards #-}

module CodeWorld.Test.Relative (
  Components(..),
  RelativePicSpec(..),
  SpatialQuery,
  (===),
  toRelative,
  isSouthOf,
  isNorthOf,
  isWestOf,
  isEastOf,
  isSouthEastOf,
  isSouthWestOf,
  isNorthEastOf,
  isNorthWestOf,
  isBelow,
  isAbove,
  isLeftOf,
  isRightOf,
  atSamePosition,
  )where


import Data.List                        (sort)

import CodeWorld.Tasks.API              (Drawable(..))
import CodeWorld.Test.AbsTypes          (Position(..), fromPosition)
import CodeWorld.Test.Abstract (
  AbstractPicture(..),
  getSubPictures,
  stripTranslation,
  getTranslation,
  couldHaveTranslation,
  contains,
  )


{- |
Alias for queries on spatial relationships.
-}
type SpatialQuery = [RelativePicSpec] -> Bool

data DirectionV = South deriving (DirectionV -> DirectionV -> Bool
(DirectionV -> DirectionV -> Bool)
-> (DirectionV -> DirectionV -> Bool) -> Eq DirectionV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectionV -> DirectionV -> Bool
== :: DirectionV -> DirectionV -> Bool
$c/= :: DirectionV -> DirectionV -> Bool
/= :: DirectionV -> DirectionV -> Bool
Eq,Eq DirectionV
Eq DirectionV =>
(DirectionV -> DirectionV -> Ordering)
-> (DirectionV -> DirectionV -> Bool)
-> (DirectionV -> DirectionV -> Bool)
-> (DirectionV -> DirectionV -> Bool)
-> (DirectionV -> DirectionV -> Bool)
-> (DirectionV -> DirectionV -> DirectionV)
-> (DirectionV -> DirectionV -> DirectionV)
-> Ord DirectionV
DirectionV -> DirectionV -> Bool
DirectionV -> DirectionV -> Ordering
DirectionV -> DirectionV -> DirectionV
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DirectionV -> DirectionV -> Ordering
compare :: DirectionV -> DirectionV -> Ordering
$c< :: DirectionV -> DirectionV -> Bool
< :: DirectionV -> DirectionV -> Bool
$c<= :: DirectionV -> DirectionV -> Bool
<= :: DirectionV -> DirectionV -> Bool
$c> :: DirectionV -> DirectionV -> Bool
> :: DirectionV -> DirectionV -> Bool
$c>= :: DirectionV -> DirectionV -> Bool
>= :: DirectionV -> DirectionV -> Bool
$cmax :: DirectionV -> DirectionV -> DirectionV
max :: DirectionV -> DirectionV -> DirectionV
$cmin :: DirectionV -> DirectionV -> DirectionV
min :: DirectionV -> DirectionV -> DirectionV
Ord,Int -> DirectionV -> ShowS
[DirectionV] -> ShowS
DirectionV -> String
(Int -> DirectionV -> ShowS)
-> (DirectionV -> String)
-> ([DirectionV] -> ShowS)
-> Show DirectionV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectionV -> ShowS
showsPrec :: Int -> DirectionV -> ShowS
$cshow :: DirectionV -> String
show :: DirectionV -> String
$cshowList :: [DirectionV] -> ShowS
showList :: [DirectionV] -> ShowS
Show)
data DirectionH = West | East deriving (DirectionH -> DirectionH -> Bool
(DirectionH -> DirectionH -> Bool)
-> (DirectionH -> DirectionH -> Bool) -> Eq DirectionH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectionH -> DirectionH -> Bool
== :: DirectionH -> DirectionH -> Bool
$c/= :: DirectionH -> DirectionH -> Bool
/= :: DirectionH -> DirectionH -> Bool
Eq,Eq DirectionH
Eq DirectionH =>
(DirectionH -> DirectionH -> Ordering)
-> (DirectionH -> DirectionH -> Bool)
-> (DirectionH -> DirectionH -> Bool)
-> (DirectionH -> DirectionH -> Bool)
-> (DirectionH -> DirectionH -> Bool)
-> (DirectionH -> DirectionH -> DirectionH)
-> (DirectionH -> DirectionH -> DirectionH)
-> Ord DirectionH
DirectionH -> DirectionH -> Bool
DirectionH -> DirectionH -> Ordering
DirectionH -> DirectionH -> DirectionH
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DirectionH -> DirectionH -> Ordering
compare :: DirectionH -> DirectionH -> Ordering
$c< :: DirectionH -> DirectionH -> Bool
< :: DirectionH -> DirectionH -> Bool
$c<= :: DirectionH -> DirectionH -> Bool
<= :: DirectionH -> DirectionH -> Bool
$c> :: DirectionH -> DirectionH -> Bool
> :: DirectionH -> DirectionH -> Bool
$c>= :: DirectionH -> DirectionH -> Bool
>= :: DirectionH -> DirectionH -> Bool
$cmax :: DirectionH -> DirectionH -> DirectionH
max :: DirectionH -> DirectionH -> DirectionH
$cmin :: DirectionH -> DirectionH -> DirectionH
min :: DirectionH -> DirectionH -> DirectionH
Ord,Int -> DirectionH -> ShowS
[DirectionH] -> ShowS
DirectionH -> String
(Int -> DirectionH -> ShowS)
-> (DirectionH -> String)
-> ([DirectionH] -> ShowS)
-> Show DirectionH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectionH -> ShowS
showsPrec :: Int -> DirectionH -> ShowS
$cshow :: DirectionH -> String
show :: DirectionH -> String
$cshowList :: [DirectionH] -> ShowS
showList :: [DirectionH] -> ShowS
Show)

data Direction = Direction {
  Direction -> Maybe DirectionV
vertical :: Maybe DirectionV,
  Direction -> Maybe DirectionH
horizontal :: Maybe DirectionH
} deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq,Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)


{- |
Abstract representation of spatial positioning between two picture components.
-}
data RelativePicSpec
  = Is AbstractPicture Direction AbstractPicture
  | Alone AbstractPicture
  deriving(RelativePicSpec -> RelativePicSpec -> Bool
(RelativePicSpec -> RelativePicSpec -> Bool)
-> (RelativePicSpec -> RelativePicSpec -> Bool)
-> Eq RelativePicSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelativePicSpec -> RelativePicSpec -> Bool
== :: RelativePicSpec -> RelativePicSpec -> Bool
$c/= :: RelativePicSpec -> RelativePicSpec -> Bool
/= :: RelativePicSpec -> RelativePicSpec -> Bool
Eq,Eq RelativePicSpec
Eq RelativePicSpec =>
(RelativePicSpec -> RelativePicSpec -> Ordering)
-> (RelativePicSpec -> RelativePicSpec -> Bool)
-> (RelativePicSpec -> RelativePicSpec -> Bool)
-> (RelativePicSpec -> RelativePicSpec -> Bool)
-> (RelativePicSpec -> RelativePicSpec -> Bool)
-> (RelativePicSpec -> RelativePicSpec -> RelativePicSpec)
-> (RelativePicSpec -> RelativePicSpec -> RelativePicSpec)
-> Ord RelativePicSpec
RelativePicSpec -> RelativePicSpec -> Bool
RelativePicSpec -> RelativePicSpec -> Ordering
RelativePicSpec -> RelativePicSpec -> RelativePicSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelativePicSpec -> RelativePicSpec -> Ordering
compare :: RelativePicSpec -> RelativePicSpec -> Ordering
$c< :: RelativePicSpec -> RelativePicSpec -> Bool
< :: RelativePicSpec -> RelativePicSpec -> Bool
$c<= :: RelativePicSpec -> RelativePicSpec -> Bool
<= :: RelativePicSpec -> RelativePicSpec -> Bool
$c> :: RelativePicSpec -> RelativePicSpec -> Bool
> :: RelativePicSpec -> RelativePicSpec -> Bool
$c>= :: RelativePicSpec -> RelativePicSpec -> Bool
>= :: RelativePicSpec -> RelativePicSpec -> Bool
$cmax :: RelativePicSpec -> RelativePicSpec -> RelativePicSpec
max :: RelativePicSpec -> RelativePicSpec -> RelativePicSpec
$cmin :: RelativePicSpec -> RelativePicSpec -> RelativePicSpec
min :: RelativePicSpec -> RelativePicSpec -> RelativePicSpec
Ord)


{- |
Abstract representation of a picture in terms of its components
and the pairwise spatial positioning between them.
-}
newtype Components = Components (AbstractPicture,[RelativePicSpec]) deriving (Components -> Components -> Bool
(Components -> Components -> Bool)
-> (Components -> Components -> Bool) -> Eq Components
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Components -> Components -> Bool
== :: Components -> Components -> Bool
$c/= :: Components -> Components -> Bool
/= :: Components -> Components -> Bool
Eq,Eq Components
Eq Components =>
(Components -> Components -> Ordering)
-> (Components -> Components -> Bool)
-> (Components -> Components -> Bool)
-> (Components -> Components -> Bool)
-> (Components -> Components -> Bool)
-> (Components -> Components -> Components)
-> (Components -> Components -> Components)
-> Ord Components
Components -> Components -> Bool
Components -> Components -> Ordering
Components -> Components -> Components
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Components -> Components -> Ordering
compare :: Components -> Components -> Ordering
$c< :: Components -> Components -> Bool
< :: Components -> Components -> Bool
$c<= :: Components -> Components -> Bool
<= :: Components -> Components -> Bool
$c> :: Components -> Components -> Bool
> :: Components -> Components -> Bool
$c>= :: Components -> Components -> Bool
>= :: Components -> Components -> Bool
$cmax :: Components -> Components -> Components
max :: Components -> Components -> Components
$cmin :: Components -> Components -> Components
min :: Components -> Components -> Components
Ord,Int -> Components -> ShowS
[Components] -> ShowS
Components -> String
(Int -> Components -> ShowS)
-> (Components -> String)
-> ([Components] -> ShowS)
-> Show Components
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Components -> ShowS
showsPrec :: Int -> Components -> ShowS
$cshow :: Components -> String
show :: Components -> String
$cshowList :: [Components] -> ShowS
showList :: [Components] -> ShowS
Show)


instance Show Direction where
  show :: Direction -> String
show Direction{Maybe DirectionH
Maybe DirectionV
vertical :: Direction -> Maybe DirectionV
horizontal :: Direction -> Maybe DirectionH
vertical :: Maybe DirectionV
horizontal :: Maybe DirectionH
..} = case (Maybe DirectionV
vertical, Maybe DirectionH
horizontal) of
    (Maybe DirectionV
Nothing, Maybe DirectionH
Nothing) -> String
"OnTop"
    (Maybe DirectionV
Nothing, Just DirectionH
a)  -> DirectionH -> String
forall a. Show a => a -> String
show DirectionH
a
    (Just DirectionV
a, Maybe DirectionH
Nothing)  -> DirectionV -> String
forall a. Show a => a -> String
show DirectionV
a
    (Just DirectionV
a, Just DirectionH
b)   -> DirectionV -> String
forall a. Show a => a -> String
show DirectionV
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ DirectionH -> String
forall a. Show a => a -> String
show DirectionH
b


instance Show RelativePicSpec where
  show :: RelativePicSpec -> String
show (Is AbstractPicture
p1 Direction
dir AbstractPicture
p2) = AbstractPicture -> String
forall a. Show a => a -> String
show AbstractPicture
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> String
forall a. Show a => a -> String
show Direction
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AbstractPicture -> String
forall a. Show a => a -> String
show AbstractPicture
p2
  show (Alone AbstractPicture
p) = AbstractPicture -> String
forall a. Show a => a -> String
show AbstractPicture
p



(===) :: AbstractPicture -> AbstractPicture -> Bool
AbstractPicture
p1 === :: AbstractPicture -> AbstractPicture -> Bool
=== AbstractPicture
p2 = AbstractPicture -> Components
toRelative AbstractPicture
p1 Components -> Components -> Bool
forall a. Eq a => a -> a -> Bool
== AbstractPicture -> Components
toRelative AbstractPicture
p2


southOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southOf AbstractPicture
p1 = AbstractPicture -> Direction -> AbstractPicture -> RelativePicSpec
Is AbstractPicture
p1 (Maybe DirectionV -> Maybe DirectionH -> Direction
Direction (DirectionV -> Maybe DirectionV
forall a. a -> Maybe a
Just DirectionV
South) Maybe DirectionH
forall a. Maybe a
Nothing)


northOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbstractPicture -> AbstractPicture -> RelativePicSpec
southOf


westOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
westOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
westOf AbstractPicture
p1 = AbstractPicture -> Direction -> AbstractPicture -> RelativePicSpec
Is AbstractPicture
p1 (Maybe DirectionV -> Maybe DirectionH -> Direction
Direction  Maybe DirectionV
forall a. Maybe a
Nothing (DirectionH -> Maybe DirectionH
forall a. a -> Maybe a
Just DirectionH
West))


eastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
eastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
eastOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbstractPicture -> AbstractPicture -> RelativePicSpec
westOf


onTopOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
onTopOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
onTopOf AbstractPicture
p1 = AbstractPicture -> Direction -> AbstractPicture -> RelativePicSpec
Is AbstractPicture
p1 (Maybe DirectionV -> Maybe DirectionH -> Direction
Direction Maybe DirectionV
forall a. Maybe a
Nothing Maybe DirectionH
forall a. Maybe a
Nothing)


southwestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southwestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southwestOf AbstractPicture
p1 = AbstractPicture -> Direction -> AbstractPicture -> RelativePicSpec
Is AbstractPicture
p1 (Maybe DirectionV -> Maybe DirectionH -> Direction
Direction (DirectionV -> Maybe DirectionV
forall a. a -> Maybe a
Just DirectionV
South) (DirectionH -> Maybe DirectionH
forall a. a -> Maybe a
Just DirectionH
West))


southeastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southeastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
southeastOf AbstractPicture
p1 = AbstractPicture -> Direction -> AbstractPicture -> RelativePicSpec
Is AbstractPicture
p1 (Maybe DirectionV -> Maybe DirectionH -> Direction
Direction (DirectionV -> Maybe DirectionV
forall a. a -> Maybe a
Just DirectionV
South) (DirectionH -> Maybe DirectionH
forall a. a -> Maybe a
Just DirectionH
East))


northwestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northwestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northwestOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbstractPicture -> AbstractPicture -> RelativePicSpec
southeastOf


northeastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northeastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec
northeastOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbstractPicture -> AbstractPicture -> RelativePicSpec
southwestOf


alone :: AbstractPicture -> RelativePicSpec
alone :: AbstractPicture -> RelativePicSpec
alone = AbstractPicture -> RelativePicSpec
Alone


containedSouthOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) Maybe DirectionH
Nothing) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedSouthOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedNorthOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) Maybe DirectionH
Nothing) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedNorthOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedWestOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
Nothing (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedWestOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
Nothing (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedWestOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedEastOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
Nothing (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedEastOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
Nothing (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedEastOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedSouthWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthWestOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedSouthWestOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedSouthEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthEastOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedSouthEastOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedNorthWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthWestOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthWestOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedNorthWestOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedNorthEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthEastOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthEastOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedNorthEastOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedAbove :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedAbove :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedAbove AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) Maybe DirectionH
_) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedAbove AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedBelow :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedBelow :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedBelow AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction (Just DirectionV
South) Maybe DirectionH
_) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedBelow AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedLeftOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedLeftOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedLeftOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
_ (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedLeftOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
_ (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedLeftOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedRightOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedRightOf :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedRightOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
_ (Just DirectionH
East)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q
containedRightOf AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
_ (Just DirectionH
West)) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedRightOf AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


containedSameSpot :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSameSpot :: AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSameSpot AbstractPicture
p AbstractPicture
q (Is AbstractPicture
p1 (Direction Maybe DirectionV
Nothing Maybe DirectionH
Nothing) AbstractPicture
p2) =
  AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
|| AbstractPicture
p1 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
q Bool -> Bool -> Bool
&& AbstractPicture
p2 AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p
containedSameSpot AbstractPicture
_ AbstractPicture
_ RelativePicSpec
_ = Bool
False


{- |
True if the first argument is below the second and aligned on the X-axis.
-}
isSouthOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthOf


{- |
True if the first argument is above the second and aligned on the X-axis.
-}
isNorthOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthOf


{- |
True if the first argument is left of the second and aligned on the Y-axis.
-}
isWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isWestOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedWestOf


{- |
True if the first argument is right of the second and aligned on the Y-axis.
-}
isEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isEastOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedEastOf


{- |
True if the first argument is below and to the left of the second.
-}
isSouthWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthWestOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthWestOf


{- |
True if the first argument is below and to the right of the second.
-}
isSouthEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isSouthEastOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSouthEastOf


{- |
True if the first argument is above and to the left of the second.
-}
isNorthWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthWestOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthWestOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthWestOf


{- |
True if the first argument is above and to the right of the second.
-}
isNorthEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthEastOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isNorthEastOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedNorthEastOf


{- |
True if the first argument is above the second, ignoring horizontal positioning.
-}
isAbove :: AbstractPicture -> AbstractPicture -> SpatialQuery
isAbove :: AbstractPicture -> AbstractPicture -> SpatialQuery
isAbove = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedAbove


{- |
True if the first argument is below the second, ignoring horizontal positioning.
-}
isBelow :: AbstractPicture -> AbstractPicture -> SpatialQuery
isBelow :: AbstractPicture -> AbstractPicture -> SpatialQuery
isBelow = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedBelow


{- |
True if the first argument is left of the second, ignoring vertical positioning.
-}
isLeftOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isLeftOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isLeftOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedLeftOf


{- |
True if the first argument is right of the second, ignoring vertical positioning.
-}
isRightOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isRightOf :: AbstractPicture -> AbstractPicture -> SpatialQuery
isRightOf = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedRightOf


{- |
True if the first argument is at the same position as the second.
-}
atSamePosition :: AbstractPicture -> AbstractPicture -> SpatialQuery
atSamePosition :: AbstractPicture -> AbstractPicture -> SpatialQuery
atSamePosition = (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
containedSameSpot


compositeRelation
  :: (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
  -> AbstractPicture
  -> AbstractPicture
  -> SpatialQuery
compositeRelation :: (AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool)
-> AbstractPicture -> AbstractPicture -> SpatialQuery
compositeRelation AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
g AbstractPicture
p AbstractPicture
q [RelativePicSpec]
rs = ((RelativePicSpec -> Bool) -> Bool)
-> [RelativePicSpec -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((RelativePicSpec -> Bool) -> SpatialQuery
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [RelativePicSpec]
rs) [RelativePicSpec -> Bool]
allRelations
  where
    allRelations :: [RelativePicSpec -> Bool]
allRelations = [AbstractPicture -> AbstractPicture -> RelativePicSpec -> Bool
g AbstractPicture
x AbstractPicture
y | AbstractPicture
x <- AbstractPicture -> [AbstractPicture]
getSubPictures AbstractPicture
p, AbstractPicture
y <- AbstractPicture -> [AbstractPicture]
getSubPictures AbstractPicture
q]


toRelative :: AbstractPicture -> Components
toRelative :: AbstractPicture -> Components
toRelative AbstractPicture
p = case AbstractPicture
p of
  Pictures [AbstractPicture]
ps -> (AbstractPicture, [RelativePicSpec]) -> Components
Components ([AbstractPicture] -> AbstractPicture
Pictures [AbstractPicture]
ps, [RelativePicSpec] -> [RelativePicSpec]
forall a. Ord a => [a] -> [a]
sort ([RelativePicSpec] -> [RelativePicSpec])
-> [RelativePicSpec] -> [RelativePicSpec]
forall a b. (a -> b) -> a -> b
$ [AbstractPicture] -> [RelativePicSpec]
relativePosition [AbstractPicture]
ps)
  AbstractPicture
a           -> let noTranslation :: AbstractPicture
noTranslation = AbstractPicture -> AbstractPicture
stripTranslation AbstractPicture
a in
    (AbstractPicture, [RelativePicSpec]) -> Components
Components (AbstractPicture
a,[AbstractPicture -> RelativePicSpec
alone AbstractPicture
noTranslation])


relativePosition :: [AbstractPicture] -> [RelativePicSpec]
relativePosition :: [AbstractPicture] -> [RelativePicSpec]
relativePosition [] = []
relativePosition (AbstractPicture
p:[AbstractPicture]
ps)
  | AbstractPicture -> Bool
couldHaveTranslation AbstractPicture
p = [RelativePicSpec]
othersTrans [RelativePicSpec] -> [RelativePicSpec] -> [RelativePicSpec]
forall a. [a] -> [a] -> [a]
++ [AbstractPicture] -> [RelativePicSpec]
relativePosition [AbstractPicture]
ps
  | Bool
otherwise = [RelativePicSpec]
others [RelativePicSpec] -> [RelativePicSpec] -> [RelativePicSpec]
forall a. [a] -> [a] -> [a]
++ [AbstractPicture] -> [RelativePicSpec]
relativePosition [AbstractPicture]
ps
  where
    (Position
pX,Position
pY) = AbstractPicture -> (Position, Position)
getTranslation AbstractPicture
p

    asCenter :: AbstractPicture -> AbstractPicture
asCenter AbstractPicture
pic = let (Position
bX,Position
bY) = AbstractPicture -> (Position, Position)
getTranslation AbstractPicture
pic in
      Double -> Double -> AbstractPicture -> AbstractPicture
forall a. Drawable a => Double -> Double -> a -> a
translated (Position -> Double
fromPosition (Position -> Double) -> Position -> Double
forall a b. (a -> b) -> a -> b
$ Position
bXPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Position
pX) (Position -> Double
fromPosition (Position -> Double) -> Position -> Double
forall a b. (a -> b) -> a -> b
$ Position
bYPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Position
pY) (AbstractPicture -> AbstractPicture)
-> AbstractPicture -> AbstractPicture
forall a b. (a -> b) -> a -> b
$ AbstractPicture -> AbstractPicture
stripTranslation AbstractPicture
pic

    othersTrans :: [RelativePicSpec]
othersTrans = (AbstractPicture -> RelativePicSpec)
-> [AbstractPicture] -> [RelativePicSpec]
forall a b. (a -> b) -> [a] -> [b]
map (\AbstractPicture
pic ->
        AbstractPicture
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
orientation (AbstractPicture -> AbstractPicture
asCenter AbstractPicture
pic) (AbstractPicture -> AbstractPicture
stripTranslation AbstractPicture
p) (AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> RelativePicSpec
forall a b. (a -> b) -> a -> b
$ AbstractPicture -> AbstractPicture
stripTranslation AbstractPicture
pic
        )
      [AbstractPicture]
ps

    others :: [RelativePicSpec]
others = (AbstractPicture -> RelativePicSpec)
-> [AbstractPicture] -> [RelativePicSpec]
forall a b. (a -> b) -> [a] -> [b]
map (\AbstractPicture
pic -> AbstractPicture
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
orientation AbstractPicture
pic AbstractPicture
p (AbstractPicture -> RelativePicSpec)
-> AbstractPicture -> RelativePicSpec
forall a b. (a -> b) -> a -> b
$ AbstractPicture -> AbstractPicture
stripTranslation AbstractPicture
pic) [AbstractPicture]
ps


orientation
  :: AbstractPicture
  -> AbstractPicture
  -> AbstractPicture
  -> RelativePicSpec
orientation :: AbstractPicture
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
orientation = (Position, Position)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
toDirection ((Position, Position)
 -> AbstractPicture -> AbstractPicture -> RelativePicSpec)
-> (AbstractPicture -> (Position, Position))
-> AbstractPicture
-> AbstractPicture
-> AbstractPicture
-> RelativePicSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractPicture -> (Position, Position)
getTranslation
  where
    toDirection :: (Position, Position)
-> AbstractPicture -> AbstractPicture -> RelativePicSpec
toDirection (Position
a,Position
b) = case (Position
a,Position
b) of
      (Position
Zero , Neg Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
northOf
      (Position
Zero , Pos Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
southOf
      (Neg Double
_, Position
Zero ) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
eastOf
      (Pos Double
_, Position
Zero ) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
westOf
      (Pos Double
_, Pos Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
southwestOf
      (Pos Double
_, Neg Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
northwestOf
      (Neg Double
_, Pos Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
southeastOf
      (Neg Double
_, Neg Double
_) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
northeastOf
      (Position
Zero , Position
Zero ) -> AbstractPicture -> AbstractPicture -> RelativePicSpec
onTopOf