{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Brick.BorderMap
    ( BorderMap
    , Edges(..)
    , eTopL, eBottomL, eRightL, eLeftL
    , empty, emptyCoordinates, singleton
    , insertH, insertV, insert
    , unsafeUnion
    , coordinates, bounds
    , values
    , lookupRow, lookupCol, lookupH, lookupV, lookup
    , setCoordinates, crop, expand
    , translate
    ) where

import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)
import Control.Applicative (liftA2)
import Data.IMap (IMap, Run(Run))
import GHC.Generics
import Control.DeepSeq
import Prelude hiding (lookup)
import qualified Data.IMap as IM

-- | Internal use only.
neighbors :: Edges a -> Edges (a, a)
neighbors :: Edges a -> Edges (a, a)
neighbors (Edges a
vt a
vb a
vl a
vr) = (a, a) -> (a, a) -> (a, a) -> (a, a) -> Edges (a, a)
forall a. a -> a -> a -> a -> Edges a
Edges (a, a)
horiz (a, a)
horiz (a, a)
vert (a, a)
vert where
    horiz :: (a, a)
horiz = (a
vl, a
vr)
    vert :: (a, a)
vert  = (a
vt, a
vb)

-- Invariant: corner values are present on all the edges incident on that
-- corner. Widthless or heightless rectangles replicate the IMaps exactly on
-- the two coincident edges.
--
-- Practically speaking, this means for lookup you can look on any edge that
-- could contain the key you care about, while for insertion you must insert on
-- every edge that could contain the keys being inserted.

-- | A @BorderMap a@ is like a @Map Location a@, except that there is a
-- rectangle, and only 'Location's on the border of this rectangle are
-- retained. The 'BorderMap' can be queried for the position and size of the
-- rectangle. There are also efficient bulk query and bulk update operations
-- for adjacent positions on the border.
data BorderMap a = BorderMap
    { BorderMap a -> Edges Int
_coordinates :: Edges Int
    , BorderMap a -> Edges (IMap a)
_values :: Edges (IMap a)
    } deriving (BorderMap a -> BorderMap a -> Bool
(BorderMap a -> BorderMap a -> Bool)
-> (BorderMap a -> BorderMap a -> Bool) -> Eq (BorderMap a)
forall a. Eq a => BorderMap a -> BorderMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BorderMap a -> BorderMap a -> Bool
$c/= :: forall a. Eq a => BorderMap a -> BorderMap a -> Bool
== :: BorderMap a -> BorderMap a -> Bool
$c== :: forall a. Eq a => BorderMap a -> BorderMap a -> Bool
Eq, Eq (BorderMap a)
Eq (BorderMap a)
-> (BorderMap a -> BorderMap a -> Ordering)
-> (BorderMap a -> BorderMap a -> Bool)
-> (BorderMap a -> BorderMap a -> Bool)
-> (BorderMap a -> BorderMap a -> Bool)
-> (BorderMap a -> BorderMap a -> Bool)
-> (BorderMap a -> BorderMap a -> BorderMap a)
-> (BorderMap a -> BorderMap a -> BorderMap a)
-> Ord (BorderMap a)
BorderMap a -> BorderMap a -> Bool
BorderMap a -> BorderMap a -> Ordering
BorderMap a -> BorderMap a -> BorderMap a
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
forall a. Ord a => Eq (BorderMap a)
forall a. Ord a => BorderMap a -> BorderMap a -> Bool
forall a. Ord a => BorderMap a -> BorderMap a -> Ordering
forall a. Ord a => BorderMap a -> BorderMap a -> BorderMap a
min :: BorderMap a -> BorderMap a -> BorderMap a
$cmin :: forall a. Ord a => BorderMap a -> BorderMap a -> BorderMap a
max :: BorderMap a -> BorderMap a -> BorderMap a
$cmax :: forall a. Ord a => BorderMap a -> BorderMap a -> BorderMap a
>= :: BorderMap a -> BorderMap a -> Bool
$c>= :: forall a. Ord a => BorderMap a -> BorderMap a -> Bool
> :: BorderMap a -> BorderMap a -> Bool
$c> :: forall a. Ord a => BorderMap a -> BorderMap a -> Bool
<= :: BorderMap a -> BorderMap a -> Bool
$c<= :: forall a. Ord a => BorderMap a -> BorderMap a -> Bool
< :: BorderMap a -> BorderMap a -> Bool
$c< :: forall a. Ord a => BorderMap a -> BorderMap a -> Bool
compare :: BorderMap a -> BorderMap a -> Ordering
$ccompare :: forall a. Ord a => BorderMap a -> BorderMap a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BorderMap a)
Ord, Int -> BorderMap a -> ShowS
[BorderMap a] -> ShowS
BorderMap a -> String
(Int -> BorderMap a -> ShowS)
-> (BorderMap a -> String)
-> ([BorderMap a] -> ShowS)
-> Show (BorderMap a)
forall a. Show a => Int -> BorderMap a -> ShowS
forall a. Show a => [BorderMap a] -> ShowS
forall a. Show a => BorderMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BorderMap a] -> ShowS
$cshowList :: forall a. Show a => [BorderMap a] -> ShowS
show :: BorderMap a -> String
$cshow :: forall a. Show a => BorderMap a -> String
showsPrec :: Int -> BorderMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BorderMap a -> ShowS
Show, a -> BorderMap b -> BorderMap a
(a -> b) -> BorderMap a -> BorderMap b
(forall a b. (a -> b) -> BorderMap a -> BorderMap b)
-> (forall a b. a -> BorderMap b -> BorderMap a)
-> Functor BorderMap
forall a b. a -> BorderMap b -> BorderMap a
forall a b. (a -> b) -> BorderMap a -> BorderMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BorderMap b -> BorderMap a
$c<$ :: forall a b. a -> BorderMap b -> BorderMap a
fmap :: (a -> b) -> BorderMap a -> BorderMap b
$cfmap :: forall a b. (a -> b) -> BorderMap a -> BorderMap b
Functor, ReadPrec [BorderMap a]
ReadPrec (BorderMap a)
Int -> ReadS (BorderMap a)
ReadS [BorderMap a]
(Int -> ReadS (BorderMap a))
-> ReadS [BorderMap a]
-> ReadPrec (BorderMap a)
-> ReadPrec [BorderMap a]
-> Read (BorderMap a)
forall a. Read a => ReadPrec [BorderMap a]
forall a. Read a => ReadPrec (BorderMap a)
forall a. Read a => Int -> ReadS (BorderMap a)
forall a. Read a => ReadS [BorderMap a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BorderMap a]
$creadListPrec :: forall a. Read a => ReadPrec [BorderMap a]
readPrec :: ReadPrec (BorderMap a)
$creadPrec :: forall a. Read a => ReadPrec (BorderMap a)
readList :: ReadS [BorderMap a]
$creadList :: forall a. Read a => ReadS [BorderMap a]
readsPrec :: Int -> ReadS (BorderMap a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BorderMap a)
Read, (forall x. BorderMap a -> Rep (BorderMap a) x)
-> (forall x. Rep (BorderMap a) x -> BorderMap a)
-> Generic (BorderMap a)
forall x. Rep (BorderMap a) x -> BorderMap a
forall x. BorderMap a -> Rep (BorderMap a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BorderMap a) x -> BorderMap a
forall a x. BorderMap a -> Rep (BorderMap a) x
$cto :: forall a x. Rep (BorderMap a) x -> BorderMap a
$cfrom :: forall a x. BorderMap a -> Rep (BorderMap a) x
Generic, BorderMap a -> ()
(BorderMap a -> ()) -> NFData (BorderMap a)
forall a. NFData a => BorderMap a -> ()
forall a. (a -> ()) -> NFData a
rnf :: BorderMap a -> ()
$crnf :: forall a. NFData a => BorderMap a -> ()
NFData)

-- | Given a rectangle (specified as the coordinates of the top, left, bottom,
-- and right sides), initialize an empty 'BorderMap'.
emptyCoordinates :: Edges Int -> BorderMap a
emptyCoordinates :: Edges Int -> BorderMap a
emptyCoordinates Edges Int
cs = BorderMap :: forall a. Edges Int -> Edges (IMap a) -> BorderMap a
BorderMap { _coordinates :: Edges Int
_coordinates = Edges Int
cs, _values :: Edges (IMap a)
_values = IMap a -> Edges (IMap a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IMap a
forall a. IMap a
IM.empty }

-- | An empty 'BorderMap' that only tracks the point (0,0).
empty :: BorderMap a
empty :: BorderMap a
empty = Edges Int -> BorderMap a
forall a. Edges Int -> BorderMap a
emptyCoordinates (Int -> Edges Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0)

-- | A 'BorderMap' that tracks only the given the point (and initially maps it
-- to the given value).
singleton :: Location -> a -> BorderMap a
singleton :: Location -> a -> BorderMap a
singleton Location
l a
v = Location -> BorderMap a -> BorderMap a
forall a. Location -> BorderMap a -> BorderMap a
translate Location
l (BorderMap a -> BorderMap a)
-> (BorderMap a -> BorderMap a) -> BorderMap a -> BorderMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> a -> BorderMap a -> BorderMap a
forall a. Location -> a -> BorderMap a -> BorderMap a
insert Location
origin a
v (BorderMap a -> BorderMap a) -> BorderMap a -> BorderMap a
forall a b. (a -> b) -> a -> b
$ BorderMap a
forall a. BorderMap a
empty

{-# INLINE coordinates #-}
-- | The positions of the edges of the rectangle whose border is retained in a
-- 'BorderMap'. For example, if @coordinates m = e@, then the top border
-- contains the 'Location's on row @eTop e@ and between columns @eLeft e@ to
-- @eRight e@ inclusive.
coordinates :: BorderMap a -> Edges Int
coordinates :: BorderMap a -> Edges Int
coordinates = BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
_coordinates

-- | A complementary way to query the edges of the rectangle whose border is
-- retained in a 'BorderMap'. For example, if @bounds m = b@, then a
-- 'Location'\'s column must be between @fst (eTop b)@ and @snd (eTop b)@ to be
-- retained. See also 'coordinates', which is in most cases a more natural
-- border query.
bounds :: BorderMap a -> Edges (Int, Int)
bounds :: BorderMap a -> Edges (Int, Int)
bounds = Edges Int -> Edges (Int, Int)
forall a. Edges a -> Edges (a, a)
neighbors (Edges Int -> Edges (Int, Int))
-> (BorderMap a -> Edges Int) -> BorderMap a -> Edges (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates

{-# INLINE values #-}
-- | Maps giving the values along each edge. Corner values are replicated in
-- all relevant edges.
values :: BorderMap a -> Edges (IMap a)
values :: BorderMap a -> Edges (IMap a)
values = BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values

-- | Bulk insertion of horizontally-adjacent values. The 'Location' gives the
-- start point, and the 'Run' extends in the "larger columns" direction.
insertH :: Location -> Run a -> BorderMap a -> BorderMap a
insertH :: Location -> Run a -> BorderMap a -> BorderMap a
insertH = Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Location -> Run a -> BorderMap a -> BorderMap a
forall a.
Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Location -> Run a -> BorderMap a -> BorderMap a
insertDirAgnostic ((Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Edges
     (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
forall a. a -> a -> a -> a -> Edges a
Edges Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPerp Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPerp) (Location -> Run a -> BorderMap a -> BorderMap a)
-> (Location -> Location)
-> Location
-> Run a
-> BorderMap a
-> BorderMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> Location
swapLoc
    where
    swapLoc :: Location -> Location
swapLoc (Location (Int
col, Int
row)) = (Int, Int) -> Location
Location (Int
row, Int
col)

-- | Bulk insertion of vertically-adjacent values. The 'Location' gives the
-- start point, and the 'Run' extends in the "larger rows" direction.
insertV :: Location -> Run a -> BorderMap a -> BorderMap a
insertV :: Location -> Run a -> BorderMap a -> BorderMap a
insertV = Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Location -> Run a -> BorderMap a -> BorderMap a
forall a.
Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Location -> Run a -> BorderMap a -> BorderMap a
insertDirAgnostic ((Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Edges
     (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
forall a. a -> a -> a -> a -> Edges a
Edges Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPerp Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPerp Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
forall a.
Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar)

insertDirAgnostic
    :: Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
    -> Location -> Run a -> BorderMap a -> BorderMap a
insertDirAgnostic :: Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Location -> Run a -> BorderMap a -> BorderMap a
insertDirAgnostic Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
insertions Location
l Run a
r BorderMap a
m =
    BorderMap a
m { _values :: Edges (IMap a)
_values = Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
insertions Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Edges Location
-> Edges (Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Location -> Edges Location
forall (f :: * -> *) a. Applicative f => a -> f a
pure Location
l Edges (Run a -> Int -> (Int, Int) -> IMap a -> IMap a)
-> Edges (Run a) -> Edges (Int -> (Int, Int) -> IMap a -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Run a -> Edges (Run a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Run a
r Edges (Int -> (Int, Int) -> IMap a -> IMap a)
-> Edges Int -> Edges ((Int, Int) -> IMap a -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m Edges ((Int, Int) -> IMap a -> IMap a)
-> Edges (Int, Int) -> Edges (IMap a -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges (Int, Int)
forall a. BorderMap a -> Edges (Int, Int)
bounds BorderMap a
m Edges (IMap a -> IMap a) -> Edges (IMap a) -> Edges (IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m }

insertPar, insertPerp :: Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar :: Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPar (Location (Int
kPar, Int
kPerp)) Run a
r Int
herePar (Int
loPerp, Int
hiPerp)
    | Int
kPar Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
herePar Bool -> Bool -> Bool
&& Int
loPerp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kPerp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Run a -> Int
forall a. Run a -> Int
IM.len Run a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Int
kPerp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hiPerp
        = Int -> Run a -> IMap a -> IMap a
forall a. Int -> Run a -> IMap a -> IMap a
IM.insert Int
beg Run a
r { len :: Int
IM.len = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
beg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
    | Bool
otherwise = IMap a -> IMap a
forall a. a -> a
id
    where
    beg :: Int
beg = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
kPerp Int
loPerp
    end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
kPerp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Run a -> Int
forall a. Run a -> Int
IM.len Run a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
hiPerp
insertPerp :: Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a
insertPerp (Location (Int
kPar, Int
kPerp)) Run a
r Int
herePerp (Int
loPar, Int
hiPar)
    | Int
loPar Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kPar Bool -> Bool -> Bool
&& Int
kPar Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hiPar Bool -> Bool -> Bool
&& Int
kPerp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
herePerp Bool -> Bool -> Bool
&& Int
herePerp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kPerp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Run a -> Int
forall a. Run a -> Int
IM.len Run a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        = Int -> Run a -> IMap a -> IMap a
forall a. Int -> Run a -> IMap a -> IMap a
IM.insert Int
kPar Run a
r { len :: Int
IM.len = Int
1 }
    | Bool
otherwise = IMap a -> IMap a
forall a. a -> a
id

-- | Insert a single value at the given location.
insert :: Location -> a -> BorderMap a -> BorderMap a
insert :: Location -> a -> BorderMap a -> BorderMap a
insert Location
l = Location -> Run a -> BorderMap a -> BorderMap a
forall a. Location -> Run a -> BorderMap a -> BorderMap a
insertV Location
l (Run a -> BorderMap a -> BorderMap a)
-> (a -> Run a) -> a -> BorderMap a -> BorderMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Run a
forall a. Int -> a -> Run a
Run Int
1

-- | Look up all values on a given row. The 'IMap' returned maps columns to
-- values.
lookupRow :: Int -> BorderMap a -> IMap a
lookupRow :: Int -> BorderMap a -> IMap a
lookupRow Int
row BorderMap a
m
    | Int
row Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Edges Int -> Int
forall a. Edges a -> a
eTop    (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) = Edges (IMap a) -> IMap a
forall a. Edges a -> a
eTop    (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m)
    | Int
row Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Edges Int -> Int
forall a. Edges a -> a
eBottom (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) = Edges (IMap a) -> IMap a
forall a. Edges a -> a
eBottom (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m)
    | Bool
otherwise = [(Int, Run a)] -> IMap a
forall a. [(Int, Run a)] -> IMap a
IM.fromList
        ([(Int, Run a)] -> IMap a) -> [(Int, Run a)] -> IMap a
forall a b. (a -> b) -> a -> b
$  [(Edges Int -> Int
forall a. Edges a -> a
eLeft   (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m), Int -> a -> Run a
forall a. Int -> a -> Run a
Run Int
1 a
a) | Just a
a <- [Int -> IMap a -> Maybe a
forall a. Int -> IMap a -> Maybe a
IM.lookup Int
row (Edges (IMap a) -> IMap a
forall a. Edges a -> a
eLeft   (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m))]]
        [(Int, Run a)] -> [(Int, Run a)] -> [(Int, Run a)]
forall a. [a] -> [a] -> [a]
++ [(Edges Int -> Int
forall a. Edges a -> a
eRight  (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m), Int -> a -> Run a
forall a. Int -> a -> Run a
Run Int
1 a
a) | Just a
a <- [Int -> IMap a -> Maybe a
forall a. Int -> IMap a -> Maybe a
IM.lookup Int
row (Edges (IMap a) -> IMap a
forall a. Edges a -> a
eRight  (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m))]]

-- | Look up all values on a given column. The 'IMap' returned maps rows to
-- values.
lookupCol :: Int -> BorderMap a -> IMap a
lookupCol :: Int -> BorderMap a -> IMap a
lookupCol Int
col BorderMap a
m
    | Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Edges Int -> Int
forall a. Edges a -> a
eLeft   (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) = Edges (IMap a) -> IMap a
forall a. Edges a -> a
eLeft   (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m)
    | Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Edges Int -> Int
forall a. Edges a -> a
eRight  (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) = Edges (IMap a) -> IMap a
forall a. Edges a -> a
eRight  (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m)
    | Bool
otherwise = [(Int, Run a)] -> IMap a
forall a. [(Int, Run a)] -> IMap a
IM.fromList
        ([(Int, Run a)] -> IMap a) -> [(Int, Run a)] -> IMap a
forall a b. (a -> b) -> a -> b
$  [(Edges Int -> Int
forall a. Edges a -> a
eTop    (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m), Int -> a -> Run a
forall a. Int -> a -> Run a
Run Int
1 a
a) | Just a
a <- [Int -> IMap a -> Maybe a
forall a. Int -> IMap a -> Maybe a
IM.lookup Int
col (Edges (IMap a) -> IMap a
forall a. Edges a -> a
eTop    (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m))]]
        [(Int, Run a)] -> [(Int, Run a)] -> [(Int, Run a)]
forall a. [a] -> [a] -> [a]
++ [(Edges Int -> Int
forall a. Edges a -> a
eBottom (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m), Int -> a -> Run a
forall a. Int -> a -> Run a
Run Int
1 a
a) | Just a
a <- [Int -> IMap a -> Maybe a
forall a. Int -> IMap a -> Maybe a
IM.lookup Int
col (Edges (IMap a) -> IMap a
forall a. Edges a -> a
eBottom (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m))]]

-- | Bulk lookup of horizontally-adjacent values. The 'Location' gives the
-- starting point, and the 'Run' extends in the "larger columns" direction. The
-- 'IMap' returned maps columns to values.
lookupH :: Location -> Run ignored -> BorderMap a -> IMap a
lookupH :: Location -> Run ignored -> BorderMap a -> IMap a
lookupH (Location (Int
col, Int
row)) Run ignored
r = Int -> Run ignored -> IMap a -> IMap a
forall ignored a. Int -> Run ignored -> IMap a -> IMap a
IM.restrict Int
col Run ignored
r (IMap a -> IMap a)
-> (BorderMap a -> IMap a) -> BorderMap a -> IMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupRow Int
row

-- | Bulk lookup of vertically-adjacent values. The 'Location' gives the
-- starting point, and the 'Run' extends in the "larger rows" direction. The
-- 'IMap' returned maps rows to values.
lookupV :: Location -> Run ignored -> BorderMap a -> IMap a
lookupV :: Location -> Run ignored -> BorderMap a -> IMap a
lookupV (Location (Int
col, Int
row)) Run ignored
r = Int -> Run ignored -> IMap a -> IMap a
forall ignored a. Int -> Run ignored -> IMap a -> IMap a
IM.restrict Int
row Run ignored
r (IMap a -> IMap a)
-> (BorderMap a -> IMap a) -> BorderMap a -> IMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupCol Int
col

-- | Look up a single position.
lookup :: Location -> BorderMap a -> Maybe a
lookup :: Location -> BorderMap a -> Maybe a
lookup (Location (Int
col, Int
row)) = Int -> IMap a -> Maybe a
forall a. Int -> IMap a -> Maybe a
IM.lookup Int
row (IMap a -> Maybe a)
-> (BorderMap a -> IMap a) -> BorderMap a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupCol Int
col

-- | Set the rectangle being tracked by this 'BorderMap', throwing away any
-- values that do not lie on this new rectangle.
setCoordinates :: Edges Int -> BorderMap a -> BorderMap a
setCoordinates :: Edges Int -> BorderMap a -> BorderMap a
setCoordinates Edges Int
coordinates' BorderMap a
m = BorderMap :: forall a. Edges Int -> Edges (IMap a) -> BorderMap a
BorderMap
    { _values :: Edges (IMap a)
_values = Edges (IMap a)
values'
    , _coordinates :: Edges Int
_coordinates = Edges Int
coordinates'
    }
    where
    bounds' :: Edges (Int, Int)
bounds' = Edges Int -> Edges (Int, Int)
forall a. Edges a -> Edges (a, a)
neighbors Edges Int
coordinates'
    values' :: Edges (IMap a)
values' = Int
-> Int
-> (Int, Int)
-> IMap a
-> (Int -> BorderMap a -> IMap a)
-> IMap a
forall t a.
Eq t =>
t
-> t
-> (Int, Int)
-> IMap a
-> (t -> BorderMap a -> IMap a)
-> IMap a
gc
        (Int
 -> Int
 -> (Int, Int)
 -> IMap a
 -> (Int -> BorderMap a -> IMap a)
 -> IMap a)
-> Edges Int
-> Edges
     (Int
      -> (Int, Int)
      -> IMap a
      -> (Int -> BorderMap a -> IMap a)
      -> IMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
_coordinates BorderMap a
m
        Edges
  (Int
   -> (Int, Int)
   -> IMap a
   -> (Int -> BorderMap a -> IMap a)
   -> IMap a)
-> Edges Int
-> Edges
     ((Int, Int) -> IMap a -> (Int -> BorderMap a -> IMap a) -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Edges Int
coordinates'
        Edges
  ((Int, Int) -> IMap a -> (Int -> BorderMap a -> IMap a) -> IMap a)
-> Edges (Int, Int)
-> Edges (IMap a -> (Int -> BorderMap a -> IMap a) -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Edges (Int, Int)
bounds'
        Edges (IMap a -> (Int -> BorderMap a -> IMap a) -> IMap a)
-> Edges (IMap a)
-> Edges ((Int -> BorderMap a -> IMap a) -> IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m
        Edges ((Int -> BorderMap a -> IMap a) -> IMap a)
-> Edges (Int -> BorderMap a -> IMap a) -> Edges (IMap a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Edges :: forall a. a -> a -> a -> a -> Edges a
Edges { eTop :: Int -> BorderMap a -> IMap a
eTop = Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupRow, eBottom :: Int -> BorderMap a -> IMap a
eBottom = Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupRow, eLeft :: Int -> BorderMap a -> IMap a
eLeft = Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupCol, eRight :: Int -> BorderMap a -> IMap a
eRight = Int -> BorderMap a -> IMap a
forall a. Int -> BorderMap a -> IMap a
lookupCol }
    gc :: t
-> t
-> (Int, Int)
-> IMap a
-> (t -> BorderMap a -> IMap a)
-> IMap a
gc t
oldPar t
newPar (Int
loPerp, Int
hiPerp) IMap a
imPar t -> BorderMap a -> IMap a
lookupPerp
        | t
oldPar t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
newPar = Int -> Run () -> IMap a -> IMap a
forall ignored a. Int -> Run ignored -> IMap a -> IMap a
IM.restrict Int
loPerp (Int -> () -> Run ()
forall a. Int -> a -> Run a
Run (Int
hiPerpInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
loPerpInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ()) IMap a
imPar
        | Bool
otherwise = t -> BorderMap a -> IMap a
lookupPerp t
newPar BorderMap a
m

-- | Ensure that the rectangle being tracked by this 'BorderMap' extends no
-- farther than the given one.
crop :: Edges Int -> BorderMap a -> BorderMap a
crop :: Edges Int -> BorderMap a -> BorderMap a
crop Edges Int
cs BorderMap a
m = Edges Int -> BorderMap a -> BorderMap a
forall a. Edges Int -> BorderMap a -> BorderMap a
setCoordinates (Edges (Int -> Int -> Int)
shrink Edges (Int -> Int -> Int) -> Edges Int -> Edges (Int -> Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Edges Int
cs Edges (Int -> Int) -> Edges Int -> Edges Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) BorderMap a
m where
    shrink :: Edges (Int -> Int -> Int)
shrink = Edges :: forall a. a -> a -> a -> a -> Edges a
Edges
        { eTop :: Int -> Int -> Int
eTop    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
        , eBottom :: Int -> Int -> Int
eBottom = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
        , eLeft :: Int -> Int -> Int
eLeft   = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
        , eRight :: Int -> Int -> Int
eRight  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
        }

-- | Ensure that the rectangle being tracked by this 'BorderMap' extends at
-- least as far as the given one.
expand :: Edges Int -> BorderMap a -> BorderMap a
expand :: Edges Int -> BorderMap a -> BorderMap a
expand Edges Int
cs BorderMap a
m = Edges Int -> BorderMap a -> BorderMap a
forall a. Edges Int -> BorderMap a -> BorderMap a
setCoordinates (Edges (Int -> Int -> Int)
grow Edges (Int -> Int -> Int) -> Edges Int -> Edges (Int -> Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Edges Int
cs Edges (Int -> Int) -> Edges Int -> Edges Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
coordinates BorderMap a
m) BorderMap a
m where
    grow :: Edges (Int -> Int -> Int)
grow = Edges :: forall a. a -> a -> a -> a -> Edges a
Edges
        { eTop :: Int -> Int -> Int
eTop    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
        , eBottom :: Int -> Int -> Int
eBottom = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
        , eLeft :: Int -> Int -> Int
eLeft   = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
        , eRight :: Int -> Int -> Int
eRight  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
        }

-- | Move a 'BorderMap' by adding the given 'Location' to all keys in the map.
translate :: Location -> BorderMap a -> BorderMap a
-- fast path: do nothing for (0,0)
translate :: Location -> BorderMap a -> BorderMap a
translate (Location (Int
0, Int
0)) BorderMap a
m = BorderMap a
m
translate (Location (Int
c, Int
r)) BorderMap a
m = BorderMap :: forall a. Edges Int -> Edges (IMap a) -> BorderMap a
BorderMap
    { _coordinates :: Edges Int
_coordinates = (Int -> Int -> Int) -> Edges Int -> Edges Int -> Edges Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)          Edges Int
cOffsets (BorderMap a -> Edges Int
forall a. BorderMap a -> Edges Int
_coordinates BorderMap a
m)
    , _values :: Edges (IMap a)
_values      = (Int -> IMap a -> IMap a)
-> Edges Int -> Edges (IMap a) -> Edges (IMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> IMap a -> IMap a
forall a. Int -> IMap a -> IMap a
IM.addToKeys Edges Int
vOffsets (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values      BorderMap a
m)
    }
    where
    cOffsets :: Edges Int
cOffsets = Edges :: forall a. a -> a -> a -> a -> Edges a
Edges { eTop :: Int
eTop = Int
r, eBottom :: Int
eBottom = Int
r, eLeft :: Int
eLeft = Int
c, eRight :: Int
eRight = Int
c }
    vOffsets :: Edges Int
vOffsets = Edges :: forall a. a -> a -> a -> a -> Edges a
Edges { eTop :: Int
eTop = Int
c, eBottom :: Int
eBottom = Int
c, eLeft :: Int
eLeft = Int
r, eRight :: Int
eRight = Int
r }

-- | Assumes the two 'BorderMap's are tracking the same rectangles, but have
-- disjoint keys. This property is not checked.
unsafeUnion :: BorderMap a -> BorderMap a -> BorderMap a
unsafeUnion :: BorderMap a -> BorderMap a -> BorderMap a
unsafeUnion BorderMap a
m BorderMap a
m' = BorderMap a
m { _values :: Edges (IMap a)
_values = (IMap a -> IMap a -> IMap a)
-> Edges (IMap a) -> Edges (IMap a) -> Edges (IMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 IMap a -> IMap a -> IMap a
forall a. IMap a -> IMap a -> IMap a
IM.unsafeUnion (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m) (BorderMap a -> Edges (IMap a)
forall a. BorderMap a -> Edges (IMap a)
_values BorderMap a
m') }