{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Potato.Flow.Math (
  XY
  , LBox(..)
  , nilLBox

  , make_0area_lBox_from_XY
  , make_1area_lBox_from_XY
  , make_lBox_from_XYs
  , make_lBox_from_XYlist
  , does_lBox_contains_XY
  , lBox_tl
  , lBox_area
  , lBox_to_axis
  , translate_lBox
  , add_XY_to_lBox

  , make_lBox_from_axis
  , union_lBox
  , lBox_expand
  , intersect_lBox
  , intersect_lBox_include_zero_area
  , does_lBox_intersect
  , does_lBox_intersect_include_zero_area
  , substract_lBox

  -- these helpers maybe belong in a different file, they have very specific usages
  , CanonicalLBox(..)
  , canonicalLBox_from_lBox
  , canonicalLBox_from_lBox_
  , lBox_from_canonicalLBox
  , deltaLBox_via_canonicalLBox
  , lBox_isCanonicalLBox

  , Delta(..)
  , DeltaXY(..)
  , DeltaLBox(..)

  , module Linear.V2
) where

import           Relude

import           Data.Aeson
import           Data.Binary
import           Linear.V2
import qualified Text.Show

import Control.Exception (assert)

{-
 CORDINATE SYSTEM
 UPPER LEFT CORNER is 0 0
 (0,0)--- +x
  |
  |
  +y
-}

type XY = V2 Int
instance FromJSON XY
instance ToJSON XY
instance FromJSONKey XY
instance ToJSONKey XY

-- | a point in screen space
-- should only be used by VC, so does not belong here
--newtype VPoint = VPoint (Int, Int) deriving (Generic, Show, FromJSON, ToJSON)

-- | a box in logical space
-- note size is non inclusive
-- e.g. an LBox with size (1,1) is exactly 1 point at ul
-- e.g. an LBox with size (0,0) contains nothing
data LBox = LBox {
  LBox -> XY
_lBox_tl     :: XY
  , LBox -> XY
_lBox_size :: XY
} deriving (LBox -> LBox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LBox -> LBox -> Bool
$c/= :: LBox -> LBox -> Bool
== :: LBox -> LBox -> Bool
$c== :: LBox -> LBox -> Bool
Eq, forall x. Rep LBox x -> LBox
forall x. LBox -> Rep LBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LBox x -> LBox
$cfrom :: forall x. LBox -> Rep LBox x
Generic)

instance Show LBox where
  show :: LBox -> String
show (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = String
"LBox: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
x forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
y forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
w forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
h

instance FromJSON LBox
instance ToJSON LBox
instance Binary LBox
instance NFData LBox

nilLBox :: LBox
nilLBox :: LBox
nilLBox = XY -> XY -> LBox
LBox XY
0 XY
0

lBox_area :: LBox -> Int
lBox_area :: LBox -> Int
lBox_area (LBox XY
_ (V2 Int
w Int
h)) = Int
wforall a. Num a => a -> a -> a
*Int
h

lBox_tl :: LBox -> XY
lBox_tl :: LBox -> XY
lBox_tl (LBox XY
p XY
_) = XY
p

translate_lBox :: XY -> LBox -> LBox
translate_lBox :: XY -> LBox -> LBox
translate_lBox XY
pan (LBox XY
p XY
s) = XY -> XY -> LBox
LBox (XY
pforall a. Num a => a -> a -> a
+XY
pan) XY
s


-- | returns a 0 area LBox
make_0area_lBox_from_XY :: XY -> LBox
make_0area_lBox_from_XY :: XY -> LBox
make_0area_lBox_from_XY XY
p = XY -> XY -> LBox
LBox XY
p XY
0

-- | returns a 1 area LBox
make_1area_lBox_from_XY :: XY -> LBox
make_1area_lBox_from_XY :: XY -> LBox
make_1area_lBox_from_XY XY
p = XY -> XY -> LBox
LBox XY
p XY
1

-- TODO rename to make_lBox_from_XY_XY
-- | always returns a canonical LBox
make_lBox_from_XYs :: XY -> XY -> LBox
make_lBox_from_XYs :: XY -> XY -> LBox
make_lBox_from_XYs (V2 Int
x1 Int
y1) (V2 Int
x2 Int
y2) =
  LBox {
    _lBox_tl :: XY
_lBox_tl= forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
min Int
x1 Int
x2) (forall a. Ord a => a -> a -> a
min Int
y1 Int
y2)
    , _lBox_size :: XY
_lBox_size  = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
abs (Int
x1 forall a. Num a => a -> a -> a
- Int
x2)) (forall a. Num a => a -> a
abs (Int
y1 forall a. Num a => a -> a -> a
- Int
y2))
  }

-- TODO rename to make_lBox_from_XYs
-- | always returns a canonical LBox
make_lBox_from_XYlist :: [XY] -> LBox
make_lBox_from_XYlist :: [XY] -> LBox
make_lBox_from_XYlist [] = LBox
nilLBox
make_lBox_from_XYlist (XY
x:[XY]
xs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XY -> LBox -> LBox
add_XY_to_lBox (XY -> LBox
make_0area_lBox_from_XY XY
x) [XY]
xs


-- | always returns a canonical LBox
-- bottom/right XYs cells are not included in
add_XY_to_lBox :: XY -> LBox -> LBox
add_XY_to_lBox :: XY -> LBox -> LBox
add_XY_to_lBox (V2 Int
px Int
py) LBox
lbox = LBox
r where
  (LBox (V2 Int
bx Int
by) (V2 Int
bw Int
bh)) = LBox -> LBox
canonicalLBox_from_lBox_ LBox
lbox
  r :: LBox
r = LBox {
    _lBox_tl :: XY
_lBox_tl = forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
min Int
px Int
bx) (forall a. Ord a => a -> a -> a
min Int
py Int
by)
    , _lBox_size :: XY
_lBox_size  = forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
max Int
bw forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall a. Num a => a -> a
abs (Int
pxforall a. Num a => a -> a -> a
-Int
bx)) (forall a. Num a => a -> a
abs (Int
pxforall a. Num a => a -> a -> a
-(Int
bxforall a. Num a => a -> a -> a
+Int
bw)))) (forall a. Ord a => a -> a -> a
max Int
bh forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall a. Num a => a -> a
abs (Int
pyforall a. Num a => a -> a -> a
-Int
by)) (forall a. Num a => a -> a
abs (Int
pyforall a. Num a => a -> a -> a
-(Int
byforall a. Num a => a -> a -> a
+Int
bh))))
  }

-- specifically `make_1area_lBox_from_XY pos` must be contained in lbox
-- so XYs on the bottom/right border are not included
does_lBox_contains_XY :: LBox -> XY -> Bool
does_lBox_contains_XY :: LBox -> XY -> Bool
does_lBox_contains_XY (LBox (V2 Int
bx Int
by) (V2 Int
bw Int
bh)) (V2 Int
px Int
py) =
  Int
px forall a. Ord a => a -> a -> Bool
>= Int
bx Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
>= Int
by Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
< (Int
bx forall a. Num a => a -> a -> a
+ Int
bw) Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
< (Int
by forall a. Num a => a -> a -> a
+ Int
bh)

-- | right and bottom axis are non-inclusive
make_lBox_from_axis :: (Int, Int, Int, Int) -> LBox
make_lBox_from_axis :: (Int, Int, Int, Int) -> LBox
make_lBox_from_axis (Int
x1,Int
x2,Int
y1,Int
y2) = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
rx Int
ry) (forall a. a -> a -> V2 a
V2 Int
rw Int
rh) where
  rx :: Int
rx = forall a. Ord a => a -> a -> a
min Int
x1 Int
x2
  ry :: Int
ry = forall a. Ord a => a -> a -> a
min Int
y1 Int
y2
  rw :: Int
rw = forall a. Num a => a -> a
abs (Int
x1forall a. Num a => a -> a -> a
-Int
x2)
  rh :: Int
rh = forall a. Num a => a -> a
abs (Int
y1forall a. Num a => a -> a -> a
-Int
y2)

-- | (left, right, top, bottom)
-- right and bottom are non-inclusive
lBox_to_axis :: LBox -> (Int, Int, Int, Int)
lBox_to_axis :: LBox -> (Int, Int, Int, Int)
lBox_to_axis (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = (forall a. Ord a => a -> a -> a
min Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w), forall a. Ord a => a -> a -> a
max Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w), forall a. Ord a => a -> a -> a
min Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h), forall a. Ord a => a -> a -> a
max Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h))

min4 :: (Ord a) => a -> a -> a -> a -> a
min4 :: forall a. Ord a => a -> a -> a -> a -> a
min4 a
a1 a
a2 a
a3 a
a4 = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
min a
a1 a
a2) a
a3) a
a4

max4 :: (Ord a) => a -> a -> a -> a -> a
max4 :: forall a. Ord a => a -> a -> a -> a -> a
max4 a
a1 a
a2 a
a3 a
a4 = forall a. Ord a => a -> a -> a
max (forall a. Ord a => a -> a -> a
max (forall a. Ord a => a -> a -> a
max a
a1 a
a2) a
a3) a
a4

-- | inverted LBox are treated as if not inverted
union_lBox :: LBox -> LBox -> LBox
union_lBox :: LBox -> LBox -> LBox
union_lBox (LBox (V2 Int
x1 Int
y1) (V2 Int
w1 Int
h1)) (LBox (V2 Int
x2 Int
y2) (V2 Int
w2 Int
h2)) = LBox
combined where
  cx1 :: Int
cx1 = Int
x1 forall a. Num a => a -> a -> a
+ Int
w1
  cy1 :: Int
cy1 = Int
y1 forall a. Num a => a -> a -> a
+ Int
h1
  cx2 :: Int
cx2 = Int
x2 forall a. Num a => a -> a -> a
+ Int
w2
  cy2 :: Int
cy2 = Int
y2 forall a. Num a => a -> a -> a
+ Int
h2
  combined :: LBox
combined = (Int, Int, Int, Int) -> LBox
make_lBox_from_axis (forall a. Ord a => a -> a -> a -> a -> a
min4 Int
x1 Int
cx1 Int
x2 Int
cx2, forall a. Ord a => a -> a -> a -> a -> a
max4 Int
x1 Int
cx1 Int
x2 Int
cx2, forall a. Ord a => a -> a -> a -> a -> a
min4 Int
y1 Int
cy1 Int
y2 Int
cy2, forall a. Ord a => a -> a -> a -> a -> a
max4 Int
y1 Int
cy1 Int
y2 Int
cy2)

-- assumes lbox is canonical
lBox_expand :: LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand :: LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) (Int
l, Int
r, Int
u, Int
d) = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
-Int
l) (Int
yforall a. Num a => a -> a -> a
-Int
u)) (forall a. a -> a -> V2 a
V2 (Int
wforall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
+Int
r) (Int
hforall a. Num a => a -> a -> a
+Int
uforall a. Num a => a -> a -> a
+Int
d))

-- | inverted LBox are treated as if not inverted
intersect_lBox :: LBox -> LBox -> Maybe LBox
intersect_lBox :: LBox -> LBox -> Maybe LBox
intersect_lBox lb1 :: LBox
lb1@(LBox (V2 Int
x1 Int
y1) (V2 Int
w1 Int
h1)) lb2 :: LBox
lb2@(LBox (V2 Int
x2 Int
y2) (V2 Int
w2 Int
h2)) = Maybe LBox
r where
  cx1 :: Int
cx1 = Int
x1 forall a. Num a => a -> a -> a
+ Int
w1
  cy1 :: Int
cy1 = Int
y1 forall a. Num a => a -> a -> a
+ Int
h1
  cx2 :: Int
cx2 = Int
x2 forall a. Num a => a -> a -> a
+ Int
w2
  cy2 :: Int
cy2 = Int
y2 forall a. Num a => a -> a -> a
+ Int
h2
  l1 :: Int
l1 = forall a. Ord a => a -> a -> a
min Int
cx1 Int
x1
  l2 :: Int
l2 = forall a. Ord a => a -> a -> a
min Int
cx2 Int
x2
  r1 :: Int
r1 = forall a. Ord a => a -> a -> a
max Int
cx1 Int
x1
  r2 :: Int
r2 = forall a. Ord a => a -> a -> a
max Int
cx2 Int
x2
  t1 :: Int
t1 = forall a. Ord a => a -> a -> a
min Int
cy1 Int
y1
  t2 :: Int
t2 = forall a. Ord a => a -> a -> a
min Int
cy2 Int
y2
  b1 :: Int
b1 = forall a. Ord a => a -> a -> a
max Int
cy1 Int
y1
  b2 :: Int
b2 = forall a. Ord a => a -> a -> a
max Int
cy2 Int
y2
  r :: Maybe LBox
r = if LBox -> LBox -> Bool
does_lBox_intersect LBox
lb1 LBox
lb2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> LBox
make_lBox_from_axis (forall a. Ord a => a -> a -> a
max Int
l1 Int
l2, forall a. Ord a => a -> a -> a
min Int
r1 Int
r2, forall a. Ord a => a -> a -> a
max Int
t1 Int
t2, forall a. Ord a => a -> a -> a
min Int
b1 Int
b2)
    else forall a. Maybe a
Nothing

intersect_lBox_include_zero_area :: LBox -> LBox -> Maybe LBox
intersect_lBox_include_zero_area :: LBox -> LBox -> Maybe LBox
intersect_lBox_include_zero_area lb1 :: LBox
lb1@(LBox (V2 Int
x1 Int
y1) (V2 Int
w1 Int
h1)) lb2 :: LBox
lb2@(LBox (V2 Int
x2 Int
y2) (V2 Int
w2 Int
h2)) = Maybe LBox
r where
  cx1 :: Int
cx1 = Int
x1 forall a. Num a => a -> a -> a
+ Int
w1
  cy1 :: Int
cy1 = Int
y1 forall a. Num a => a -> a -> a
+ Int
h1
  cx2 :: Int
cx2 = Int
x2 forall a. Num a => a -> a -> a
+ Int
w2
  cy2 :: Int
cy2 = Int
y2 forall a. Num a => a -> a -> a
+ Int
h2
  l1 :: Int
l1 = forall a. Ord a => a -> a -> a
min Int
cx1 Int
x1
  l2 :: Int
l2 = forall a. Ord a => a -> a -> a
min Int
cx2 Int
x2
  r1 :: Int
r1 = forall a. Ord a => a -> a -> a
max Int
cx1 Int
x1
  r2 :: Int
r2 = forall a. Ord a => a -> a -> a
max Int
cx2 Int
x2
  t1 :: Int
t1 = forall a. Ord a => a -> a -> a
min Int
cy1 Int
y1
  t2 :: Int
t2 = forall a. Ord a => a -> a -> a
min Int
cy2 Int
y2
  b1 :: Int
b1 = forall a. Ord a => a -> a -> a
max Int
cy1 Int
y1
  b2 :: Int
b2 = forall a. Ord a => a -> a -> a
max Int
cy2 Int
y2
  r :: Maybe LBox
r = if LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lb1 LBox
lb2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> LBox
make_lBox_from_axis (forall a. Ord a => a -> a -> a
max Int
l1 Int
l2, forall a. Ord a => a -> a -> a
min Int
r1 Int
r2, forall a. Ord a => a -> a -> a
max Int
t1 Int
t2, forall a. Ord a => a -> a -> a
min Int
b1 Int
b2)
    else forall a. Maybe a
Nothing


does_lBox_intersect :: LBox -> LBox -> Bool
does_lBox_intersect :: LBox -> LBox -> Bool
does_lBox_intersect LBox
lb1 LBox
lb2 = Bool
r where
  (Int
l1,Int
r1,Int
t1,Int
b1) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb1
  (Int
l2,Int
r2,Int
t2,Int
b2) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb2
  r :: Bool
r | LBox -> Int
lBox_area LBox
lb1 forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
False
    | LBox -> Int
lBox_area LBox
lb2 forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
False
    | Int
l1 forall a. Ord a => a -> a -> Bool
>= Int
r2 = Bool
False
    | Int
l2 forall a. Ord a => a -> a -> Bool
>= Int
r1 = Bool
False
    | Int
t1 forall a. Ord a => a -> a -> Bool
>= Int
b2 = Bool
False
    | Int
t2 forall a. Ord a => a -> a -> Bool
>= Int
b1 = Bool
False
    | Bool
otherwise = Bool
True

does_lBox_intersect_include_zero_area :: LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area :: LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lb1 LBox
lb2 = Bool
r where
  (Int
l1,Int
r1,Int
t1,Int
b1) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb1
  (Int
l2,Int
r2,Int
t2,Int
b2) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb2
  r :: Bool
r | LBox
lb1 forall a. Eq a => a -> a -> Bool
== LBox
lb2 = Bool
True -- this covers the case of 2 0 area boxes over each other
    | Int
l1 forall a. Ord a => a -> a -> Bool
>= Int
r2 = Bool
False
    | Int
l2 forall a. Ord a => a -> a -> Bool
>= Int
r1 = Bool
False
    | Int
t1 forall a. Ord a => a -> a -> Bool
>= Int
b2 = Bool
False
    | Int
t2 forall a. Ord a => a -> a -> Bool
>= Int
b1 = Bool
False
    | Bool
otherwise = Bool
True


-- | substract lb2 from lb1 and return [LBox] representing the difference
substract_lBox :: LBox -> LBox -> [LBox]
substract_lBox :: LBox -> LBox -> [LBox]
substract_lBox lb1 :: LBox
lb1@(LBox XY
_ (V2 Int
w1 Int
h1)) LBox
lb2 = [LBox]
r where
  (Int
l1,Int
r1,Int
t1,Int
b1) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb1
  (Int
l2,Int
r2,Int
t2,Int
b2) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lb2
  mleft :: Maybe LBox
mleft = if Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
l1 Int
t1) (forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
min (Int
l2forall a. Num a => a -> a -> a
-Int
l1) Int
w1) Int
h1)
    else forall a. Maybe a
Nothing
  mright :: Maybe LBox
mright = if Int
r1 forall a. Ord a => a -> a -> Bool
> Int
r2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
max Int
r2 Int
l1) Int
t1) (forall a. a -> a -> V2 a
V2 (forall a. Ord a => a -> a -> a
min (Int
r1forall a. Num a => a -> a -> a
-Int
r2) Int
w1) Int
h1)
    else forall a. Maybe a
Nothing
  mtop' :: Maybe LBox
mtop' =  if Int
t1 forall a. Ord a => a -> a -> Bool
< Int
t2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
l1 Int
t1) (forall a. a -> a -> V2 a
V2 Int
w1 (forall a. Ord a => a -> a -> a
min (Int
t2forall a. Num a => a -> a -> a
-Int
t1) Int
h1))
    else forall a. Maybe a
Nothing
  mbot' :: Maybe LBox
mbot' = if Int
b1 forall a. Ord a => a -> a -> Bool
> Int
b2
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
l1 (forall a. Ord a => a -> a -> a
max Int
b2 Int
t1)) (forall a. a -> a -> V2 a
V2 Int
w1 (forall a. Ord a => a -> a -> a
min (Int
b1forall a. Num a => a -> a -> a
-Int
b2) Int
h1))
    else forall a. Maybe a
Nothing
  -- TODO crop away mleft/mright from mtop'/mbot'
  mtop :: Maybe LBox
mtop = Maybe LBox
mtop'
  mbot :: Maybe LBox
mbot = Maybe LBox
mbot'
  r :: [LBox]
r = forall a. [Maybe a] -> [a]
catMaybes [Maybe LBox
mleft,Maybe LBox
mright,Maybe LBox
mtop, Maybe LBox
mbot]


-- | CanonicalLBox is always has non-negative width/height
-- and tracks which axis are flipped to return back to original LBox
-- first Bool is if x values are flipped, second is for y
data CanonicalLBox = CanonicalLBox Bool Bool LBox

canonicalLBox_from_lBox :: LBox -> CanonicalLBox
canonicalLBox_from_lBox :: LBox -> CanonicalLBox
canonicalLBox_from_lBox (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = CanonicalLBox
r where
  fx :: Bool
fx = Int
w forall a. Ord a => a -> a -> Bool
< Int
0
  fy :: Bool
fy = Int
h forall a. Ord a => a -> a -> Bool
< Int
0
  r :: CanonicalLBox
r = Bool -> Bool -> LBox -> CanonicalLBox
CanonicalLBox Bool
fx Bool
fy forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> LBox
make_lBox_from_axis (Int
x, Int
xforall a. Num a => a -> a -> a
+Int
w, Int
y, Int
yforall a. Num a => a -> a -> a
+Int
h)

-- | same as canonicalLBox_from_lBox but returns just the canonical LBox
canonicalLBox_from_lBox_ :: LBox -> LBox
canonicalLBox_from_lBox_ :: LBox -> LBox
canonicalLBox_from_lBox_ LBox
lbox = LBox
r where
  (CanonicalLBox Bool
_ Bool
_ LBox
r) = LBox -> CanonicalLBox
canonicalLBox_from_lBox LBox
lbox

lBox_from_canonicalLBox :: CanonicalLBox -> LBox
lBox_from_canonicalLBox :: CanonicalLBox -> LBox
lBox_from_canonicalLBox (CanonicalLBox Bool
fx Bool
fy (LBox (V2 Int
x Int
y) (V2 Int
w Int
h))) = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
x' Int
y') (forall a. a -> a -> V2 a
V2 Int
w' Int
h') where
  x' :: Int
x' = if Bool
fx then Int
xforall a. Num a => a -> a -> a
+Int
w else Int
x
  y' :: Int
y' = if Bool
fy then Int
yforall a. Num a => a -> a -> a
+Int
h else Int
y
  w' :: Int
w' = if Bool
fx then -Int
w else Int
w
  h' :: Int
h' = if Bool
fy then -Int
h else Int
h

deltaLBox_via_canonicalLBox :: CanonicalLBox -> DeltaLBox -> DeltaLBox
deltaLBox_via_canonicalLBox :: CanonicalLBox -> DeltaLBox -> DeltaLBox
deltaLBox_via_canonicalLBox (CanonicalLBox Bool
fx Bool
fy LBox
_) DeltaLBox {XY
_deltaLBox_resizeBy :: DeltaLBox -> XY
_deltaLBox_translate :: DeltaLBox -> XY
_deltaLBox_resizeBy :: XY
_deltaLBox_translate :: XY
..} = DeltaLBox
r where
  V2 Int
tx Int
ty = XY
_deltaLBox_translate
  V2 Int
sx Int
sy = XY
_deltaLBox_resizeBy
  (Int
rtx, Int
rsx) = if Bool
fx then (Int
sx, Int
tx) else (Int
tx, Int
sx)
  (Int
rty, Int
rsy) = if Bool
fy then (Int
sy, Int
ty) else (Int
ty, Int
sy)
  r :: DeltaLBox
r = XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
rtx Int
rty) (forall a. a -> a -> V2 a
V2 Int
rsx Int
rsy)

lBox_isCanonicalLBox :: LBox -> Bool
lBox_isCanonicalLBox :: LBox -> Bool
lBox_isCanonicalLBox LBox
lbx = LBox -> LBox
canonicalLBox_from_lBox_ LBox
lbx forall a. Eq a => a -> a -> Bool
== LBox
lbx





-- TODO maybe DELETE?
class Delta x dx where
  plusDelta :: x -> dx -> x
  minusDelta :: x -> dx -> x

instance Delta XY XY where
  plusDelta :: XY -> XY -> XY
plusDelta = forall a. Num a => a -> a -> a
(+)
  minusDelta :: XY -> XY -> XY
minusDelta = (-)

instance (Show a, Eq a) => Delta a (a,a) where
  plusDelta :: a -> (a, a) -> a
plusDelta a
s (a
b, a
a) = if a
b forall a. Eq a => a -> a -> Bool
/= a
s
    then forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show a
s forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show a
b forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show a
a
    else a
a
  minusDelta :: a -> (a, a) -> a
minusDelta a
s (a
b, a
a) = forall a. HasCallStack => Bool -> a -> a
assert (a
a forall a. Eq a => a -> a -> Bool
== a
s) a
b

newtype DeltaXY = DeltaXY XY deriving (DeltaXY -> DeltaXY -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaXY -> DeltaXY -> Bool
$c/= :: DeltaXY -> DeltaXY -> Bool
== :: DeltaXY -> DeltaXY -> Bool
$c== :: DeltaXY -> DeltaXY -> Bool
Eq, forall x. Rep DeltaXY x -> DeltaXY
forall x. DeltaXY -> Rep DeltaXY x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeltaXY x -> DeltaXY
$cfrom :: forall x. DeltaXY -> Rep DeltaXY x
Generic, Int -> DeltaXY -> ShowS
[DeltaXY] -> ShowS
DeltaXY -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaXY] -> ShowS
$cshowList :: [DeltaXY] -> ShowS
show :: DeltaXY -> String
$cshow :: DeltaXY -> String
showsPrec :: Int -> DeltaXY -> ShowS
$cshowsPrec :: Int -> DeltaXY -> ShowS
Show)

instance NFData DeltaXY

instance Delta XY DeltaXY where
  plusDelta :: XY -> DeltaXY -> XY
plusDelta XY
xy (DeltaXY XY
dxy) = XY
xy forall a. Num a => a -> a -> a
+ XY
dxy
  minusDelta :: XY -> DeltaXY -> XY
minusDelta XY
xy (DeltaXY XY
dxy) = XY
xy forall a. Num a => a -> a -> a
- XY
dxy

instance (Delta a c, Delta b d) => Delta (a,b) (c,d) where
  plusDelta :: (a, b) -> (c, d) -> (a, b)
plusDelta (a
a,b
b) (c
c,d
d) = (forall x dx. Delta x dx => x -> dx -> x
plusDelta a
a c
c, forall x dx. Delta x dx => x -> dx -> x
plusDelta b
b d
d)
  minusDelta :: (a, b) -> (c, d) -> (a, b)
minusDelta (a
a,b
b) (c
c,d
d) = (forall x dx. Delta x dx => x -> dx -> x
minusDelta a
a c
c, forall x dx. Delta x dx => x -> dx -> x
minusDelta b
b d
d)

data DeltaLBox = DeltaLBox {
  DeltaLBox -> XY
_deltaLBox_translate  :: XY
  , DeltaLBox -> XY
_deltaLBox_resizeBy :: XY
}  deriving (DeltaLBox -> DeltaLBox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaLBox -> DeltaLBox -> Bool
$c/= :: DeltaLBox -> DeltaLBox -> Bool
== :: DeltaLBox -> DeltaLBox -> Bool
$c== :: DeltaLBox -> DeltaLBox -> Bool
Eq, forall x. Rep DeltaLBox x -> DeltaLBox
forall x. DeltaLBox -> Rep DeltaLBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeltaLBox x -> DeltaLBox
$cfrom :: forall x. DeltaLBox -> Rep DeltaLBox x
Generic, Int -> DeltaLBox -> ShowS
[DeltaLBox] -> ShowS
DeltaLBox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaLBox] -> ShowS
$cshowList :: [DeltaLBox] -> ShowS
show :: DeltaLBox -> String
$cshow :: DeltaLBox -> String
showsPrec :: Int -> DeltaLBox -> ShowS
$cshowsPrec :: Int -> DeltaLBox -> ShowS
Show)

instance NFData DeltaLBox

instance Delta LBox DeltaLBox where
  plusDelta :: LBox -> DeltaLBox -> LBox
plusDelta LBox {XY
_lBox_size :: XY
_lBox_tl :: XY
_lBox_size :: LBox -> XY
_lBox_tl :: LBox -> XY
..} DeltaLBox {XY
_deltaLBox_resizeBy :: XY
_deltaLBox_translate :: XY
_deltaLBox_resizeBy :: DeltaLBox -> XY
_deltaLBox_translate :: DeltaLBox -> XY
..} = LBox {
      _lBox_tl :: XY
_lBox_tl = forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_lBox_tl XY
_deltaLBox_translate
      , _lBox_size :: XY
_lBox_size = forall x dx. Delta x dx => x -> dx -> x
plusDelta XY
_lBox_size XY
_deltaLBox_resizeBy
    }
  minusDelta :: LBox -> DeltaLBox -> LBox
minusDelta LBox {XY
_lBox_size :: XY
_lBox_tl :: XY
_lBox_size :: LBox -> XY
_lBox_tl :: LBox -> XY
..} DeltaLBox {XY
_deltaLBox_resizeBy :: XY
_deltaLBox_translate :: XY
_deltaLBox_resizeBy :: DeltaLBox -> XY
_deltaLBox_translate :: DeltaLBox -> XY
..} =  LBox {
      _lBox_tl :: XY
_lBox_tl = forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_lBox_tl XY
_deltaLBox_translate
      , _lBox_size :: XY
_lBox_size = forall x dx. Delta x dx => x -> dx -> x
minusDelta XY
_lBox_size XY
_deltaLBox_resizeBy
    }