{-# LANGUAGE CPP #-}
module Geometry where
-- This module should be moved to ../types/

import Data.Ix

class Move a where move :: Point -> a -> a

fmove :: Point -> f b -> f b
fmove Point
0 = f b -> f b
forall a. a -> a
id
fmove Point
p = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point -> b -> b
forall a. Move a => Point -> a -> a
move Point
p)

instance Move a => Move [a]       where move :: Point -> [a] -> [a]
move = Point -> [a] -> [a]
forall (f :: * -> *) b. (Functor f, Move b) => Point -> f b -> f b
fmove
instance Move a => Move (Maybe a) where move :: Point -> Maybe a -> Maybe a
move = Point -> Maybe a -> Maybe a
forall (f :: * -> *) b. (Functor f, Move b) => Point -> f b -> f b
fmove

data Point = Point { Point -> Int
xcoord, Point -> Int
ycoord :: Int }
   deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Eq Point
Eq Point
-> (Point -> Point -> Ordering)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Point)
-> (Point -> Point -> Point)
-> Ord Point
Point -> Point -> Bool
Point -> Point -> Ordering
Point -> Point -> Point
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
min :: Point -> Point -> Point
$cmin :: Point -> Point -> Point
max :: Point -> Point -> Point
$cmax :: Point -> Point -> Point
>= :: Point -> Point -> Bool
$c>= :: Point -> Point -> Bool
> :: Point -> Point -> Bool
$c> :: Point -> Point -> Bool
<= :: Point -> Point -> Bool
$c<= :: Point -> Point -> Bool
< :: Point -> Point -> Bool
$c< :: Point -> Point -> Bool
compare :: Point -> Point -> Ordering
$ccompare :: Point -> Point -> Ordering
$cp1Ord :: Eq Point
Ord, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show, ReadPrec [Point]
ReadPrec Point
Int -> ReadS Point
ReadS [Point]
(Int -> ReadS Point)
-> ReadS [Point]
-> ReadPrec Point
-> ReadPrec [Point]
-> Read Point
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Point]
$creadListPrec :: ReadPrec [Point]
readPrec :: ReadPrec Point
$creadPrec :: ReadPrec Point
readList :: ReadS [Point]
$creadList :: ReadS [Point]
readsPrec :: Int -> ReadS Point
$creadsPrec :: Int -> ReadS Point
Read, Ord Point
Ord Point
-> ((Point, Point) -> [Point])
-> ((Point, Point) -> Point -> Int)
-> ((Point, Point) -> Point -> Int)
-> ((Point, Point) -> Point -> Bool)
-> ((Point, Point) -> Int)
-> ((Point, Point) -> Int)
-> Ix Point
(Point, Point) -> Int
(Point, Point) -> [Point]
(Point, Point) -> Point -> Bool
(Point, Point) -> Point -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Point, Point) -> Int
$cunsafeRangeSize :: (Point, Point) -> Int
rangeSize :: (Point, Point) -> Int
$crangeSize :: (Point, Point) -> Int
inRange :: (Point, Point) -> Point -> Bool
$cinRange :: (Point, Point) -> Point -> Bool
unsafeIndex :: (Point, Point) -> Point -> Int
$cunsafeIndex :: (Point, Point) -> Point -> Int
index :: (Point, Point) -> Point -> Int
$cindex :: (Point, Point) -> Point -> Int
range :: (Point, Point) -> [Point]
$crange :: (Point, Point) -> [Point]
$cp1Ix :: Ord Point
Ix)
type Size = Point
data Line = Line Point Point  deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Eq Line
Eq Line
-> (Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
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
min :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show, ReadPrec [Line]
ReadPrec Line
Int -> ReadS Line
ReadS [Line]
(Int -> ReadS Line)
-> ReadS [Line] -> ReadPrec Line -> ReadPrec [Line] -> Read Line
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Line]
$creadListPrec :: ReadPrec [Line]
readPrec :: ReadPrec Line
$creadPrec :: ReadPrec Line
readList :: ReadS [Line]
$creadList :: ReadS [Line]
readsPrec :: Int -> ReadS Line
$creadsPrec :: Int -> ReadS Line
Read)
data Rect = Rect {Rect -> Point
rectpos::Point, Rect -> Point
rectsize::Size}
 deriving (Rect -> Rect -> Bool
(Rect -> Rect -> Bool) -> (Rect -> Rect -> Bool) -> Eq Rect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c== :: Rect -> Rect -> Bool
Eq, Eq Rect
Eq Rect
-> (Rect -> Rect -> Ordering)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Rect)
-> (Rect -> Rect -> Rect)
-> Ord Rect
Rect -> Rect -> Bool
Rect -> Rect -> Ordering
Rect -> Rect -> Rect
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
min :: Rect -> Rect -> Rect
$cmin :: Rect -> Rect -> Rect
max :: Rect -> Rect -> Rect
$cmax :: Rect -> Rect -> Rect
>= :: Rect -> Rect -> Bool
$c>= :: Rect -> Rect -> Bool
> :: Rect -> Rect -> Bool
$c> :: Rect -> Rect -> Bool
<= :: Rect -> Rect -> Bool
$c<= :: Rect -> Rect -> Bool
< :: Rect -> Rect -> Bool
$c< :: Rect -> Rect -> Bool
compare :: Rect -> Rect -> Ordering
$ccompare :: Rect -> Rect -> Ordering
$cp1Ord :: Eq Rect
Ord, Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: Int -> Rect -> ShowS
$cshowsPrec :: Int -> Rect -> ShowS
Show, ReadPrec [Rect]
ReadPrec Rect
Int -> ReadS Rect
ReadS [Rect]
(Int -> ReadS Rect)
-> ReadS [Rect] -> ReadPrec Rect -> ReadPrec [Rect] -> Read Rect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rect]
$creadListPrec :: ReadPrec [Rect]
readPrec :: ReadPrec Rect
$creadPrec :: ReadPrec Rect
readList :: ReadS [Rect]
$creadList :: ReadS [Rect]
readsPrec :: Int -> ReadS Rect
$creadsPrec :: Int -> ReadS Rect
Read)
{-
instance Show Point where showsPrec d (Point x y) = showsPrec d (x,y)
instance Read Point where readsPrec d s = [(pP x y,r)|((x,y),r)<-readsPrec d s]

instance Show Rect where
  showsPrec d (Rect p s) =
    showParen (d>=10) $
    showString "R " . showsPrec 10 p . showChar ' ' . showsPrec 10 s
-}
-- convenient abbreviations:
origin :: Point
origin = Int -> Int -> Point
Point Int
0 Int
0
pP :: Int -> Int -> Point
pP Int
x Int
y = Int -> Int -> Point
Point Int
x Int
y
lL :: Int -> Int -> Int -> Int -> Line
lL Int
x1 Int
y1 Int
x2 Int
y2 = Point -> Point -> Line
Line (Int -> Int -> Point
Point Int
x1 Int
y1) (Int -> Int -> Point
Point Int
x2 Int
y2)
rR :: Int -> Int -> Int -> Int -> Rect
rR Int
x Int
y Int
w Int
h = Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x Int
y) (Int -> Int -> Point
Point Int
w Int
h)
diag :: Int -> Point
diag Int
x = Int -> Int -> Point
Point Int
x Int
x

-- selectors:
--xcoord (Point x _) = x
--ycoord (Point _ y) = y

--rectsize (Rect _ size) = size
--rectpos (Rect pos _) = pos

-- basic operations:
padd :: Point -> Point -> Point
padd (Point Int
x1 Int
y1) (Point Int
x2 Int
y2) = Int -> Int -> Point
Point (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2) (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2)
psub :: Point -> Point -> Point
psub (Point Int
x1 Int
y1) (Point Int
x2 Int
y2) = Int -> Int -> Point
Point (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2) (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y2)

instance Num Point where
	 + :: Point -> Point -> Point
(+) = Point -> Point -> Point
padd
	 (-) = Point -> Point -> Point
psub
	 Point Int
x1 Int
y1 * :: Point -> Point -> Point
* Point Int
x2 Int
y2 = Int -> Int -> Point
Point (Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x2) (Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y2) -- hmm
	 negate :: Point -> Point
negate = Point -> Point -> Point
psub Point
origin
	 abs :: Point -> Point
abs (Point Int
x Int
y) = Int -> Int -> Point
Point (Int -> Int
forall a. Num a => a -> a
abs Int
x) (Int -> Int
forall a. Num a => a -> a
abs Int
y) -- hmm
	 signum :: Point -> Point
signum (Point Int
x Int
y) = Int -> Int -> Point
Point (Int -> Int
forall a. Num a => a -> a
signum Int
x) (Int -> Int
forall a. Num a => a -> a
signum Int
y) -- hmm
	 fromInteger :: Integer -> Point
fromInteger Integer
i = let i' :: Int
i' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i in Int -> Int -> Point
Point Int
i' Int
i'
#ifdef __HBC__
	 fromInt i = Point i i
#endif

rsub :: Rect -> Rect -> Point
rsub (Rect Point
p1 Point
_) (Rect Point
p2 Point
_) = Point -> Point -> Point
psub Point
p1 Point
p2

posrect :: Rect -> Point -> Rect
posrect (Rect Point
pos Point
size) Point
newpos = Point -> Point -> Rect
Rect Point
newpos Point
size
moverect :: Rect -> Point -> Rect
moverect (Rect Point
pos Point
size) Point
delta = Point -> Point -> Rect
Rect (Point -> Point -> Point
padd Point
pos Point
delta) Point
size
sizerect :: Rect -> Point -> Rect
sizerect (Rect Point
pos Point
size) Point
newsize = Point -> Point -> Rect
Rect Point
pos Point
newsize
growrect :: Rect -> Point -> Rect
growrect (Rect Point
pos Point
size) Point
delta = Point -> Point -> Rect
Rect Point
pos (Point -> Point -> Point
padd Point
size Point
delta)

moveline :: Line -> Point -> Line
moveline (Line Point
p1 Point
p2) Point
delta = Point -> Point -> Line
Line (Point -> Point -> Point
padd Point
p1 Point
delta) (Point -> Point -> Point
padd Point
p2 Point
delta)

rect2line :: Rect -> Line
rect2line (Rect Point
p Point
s) = Point -> Point -> Line
Line Point
p (Point
p Point -> Point -> Point
`padd` Point
s)
line2rect :: Line -> Rect
line2rect (Line Point
p1 Point
p2) = Point -> Point -> Rect
Rect Point
p1 (Point
p2 Point -> Point -> Point
`psub` Point
p1)

instance Move Point where move :: Point -> Point -> Point
move = Point -> Point -> Point
padd
instance Move Rect where move :: Point -> Rect -> Rect
move = (Rect -> Point -> Rect) -> Point -> Rect -> Rect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rect -> Point -> Rect
moverect
instance Move Line where move :: Point -> Line -> Line
move = (Line -> Point -> Line) -> Point -> Line -> Line
forall a b c. (a -> b -> c) -> b -> a -> c
flip Line -> Point -> Line
moveline

-- misc:
Point Int
x1 Int
y1 =.> :: Point -> Point -> Bool
=.> Point Int
x2 Int
y2 = Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x2 Bool -> Bool -> Bool
&& Int
y1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y2
inRect :: Point -> Rect -> Bool
inRect Point
pt (Rect Point
p1 Point
p2) = Point
pt Point -> Point -> Bool
=.> Point
p1 Bool -> Bool -> Bool
&& Point
p2 Point -> Point -> Bool
=.> Point -> Point -> Point
psub Point
pt Point
p1
scale :: a -> a -> b
scale a
k a
i = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
scalePoint :: a -> Point -> Point
scalePoint a
k (Point Int
x Int
y) = Int -> Int -> Point
Point (a -> Int -> Int
forall a b a. (RealFrac a, Integral b, Integral a) => a -> a -> b
scale a
k Int
x) (a -> Int -> Int
forall a b a. (RealFrac a, Integral b, Integral a) => a -> a -> b
scale a
k Int
y)
rectMiddle :: Rect -> Point
rectMiddle (Rect (Point Int
x Int
y) (Point Int
w Int
h)) =
    Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)

freedom :: Rect -> Rect -> Point
freedom (Rect Point
_ Point
outer) (Rect Point
_ Point
inner) = Point -> Point -> Point
psub Point
outer Point
inner

pmin :: Point -> Point -> Point
pmin (Point Int
x1 Int
y1) (Point Int
x2 Int
y2) = Int -> Int -> Point
Point (Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
x2) (Int
y1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
y2)
pmax :: Point -> Point -> Point
pmax (Point Int
x1 Int
y1) (Point Int
x2 Int
y2) = Int -> Int -> Point
Point (Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
x2) (Int
y1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
y2)

pMin :: [Point] -> Point
pMin (Point
p : [Point]
pl) = (Point -> Point -> Point) -> Point -> [Point] -> Point
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> Point -> Point
pmin Point
p [Point]
pl
pMin [] = String -> Point
forall a. HasCallStack => String -> a
error String
"pMin on []"

pMax :: [Point] -> Point
pMax (Point
p : [Point]
pl) = (Point -> Point -> Point) -> Point -> [Point] -> Point
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> Point -> Point
pmax Point
p [Point]
pl
pMax [] = String -> Point
forall a. HasCallStack => String -> a
error String
"pMax on []"

plim :: Point -> Point -> Point -> Point
plim Point
p0 Point
p1 Point
p = Point -> Point -> Point
pmax Point
p0 (Point -> Point -> Point
pmin Point
p1 Point
p)

-- | confine outer inner: moves an shrinks inner to fit within outer
confine :: Rect -> Rect -> Rect
confine (Rect Point
outerpos Point
outersize) (Rect Point
innerpos Point
innersize) =
    let newsize :: Point
newsize = Point -> Point -> Point
pmin Point
outersize Point
innersize
        maxpos :: Point
maxpos = Point -> Point -> Point
padd Point
outerpos (Point -> Point -> Point
psub Point
outersize Point
newsize)
    in  Point -> Point -> Rect
Rect (Point -> Point -> Point -> Point
plim Point
outerpos Point
maxpos Point
innerpos) Point
newsize

-- | rmax gives an enclosing rect
rmax :: Rect -> Rect -> Rect
rmax Rect
r1 Rect
r2 = Line -> Rect
line2rect (Point -> Point -> Line
Line (Point -> Point -> Point
pmin Point
lp1 Point
lp2) (Point -> Point -> Point
pmax Point
lp1' Point
lp2'))
   where Line Point
lp1 Point
lp1' = Rect -> Line
rect2line Rect
r1
	 Line Point
lp2 Point
lp2' = Rect -> Line
rect2line Rect
r2