{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Yi.UI.SimpleLayout
    ( Rect (..)
    , Layout (..)
    , Point2D (..)
    , Size2D (..)
    , coordsOfCharacterB
    , layout
    , verticalOffsetsForWindows
    ) where

import           Prelude                        hiding (concatMap, mapM)

import           Lens.Micro.Platform                     (use, (.~), (&), (^.), to, _1)
import           Control.Monad.State            (evalState, get, put)
import           Data.Foldable                  (find, toList)
import qualified Data.List.PointedList.Circular as PL (PointedList, focus)
import qualified Data.Map.Strict                as M (Map, fromList)
import           Data.Maybe                     (fromMaybe)
import           Data.Monoid                    ((<>))
import qualified Data.Text                      as T (uncons)
import           Data.Traversable               (mapM)
import           Yi.Buffer
import           Yi.Editor
import qualified Yi.Rope                        as R (take, toString, toText)
import           Yi.UI.Utils                    (arrangeItems)
import           Yi.Window
import           Yi.Tab                         (tabLayout)
import           Yi.Layout                      (Rectangle(..), HasNeighborWest,
                                                 layoutToRectangles)

data Layout = Layout
    { Layout -> Rect
tabbarRect :: !Rect
    , Layout -> Map WindowRef (Rect, HasNeighborWest)
windowRects :: !(M.Map WindowRef (Rect, HasNeighborWest))
    , Layout -> Rect
promptRect :: !Rect
    }

data Rect = Rect
    { Rect -> Int
offsetX :: !Int
    , Rect -> Int
offsetY :: !Int
    , Rect -> Int
sizeX :: !Int
    , Rect -> Int
sizeY :: !Int
    }

data Point2D = Point2D
    { Point2D -> Int
pointCol :: !Int
    , Point2D -> Int
pointRow :: !Int
    }

data Size2D = Size2D
    { Size2D -> Int
sizeWidth :: !Int
    , Size2D -> Int
sizeHeight :: !Int
    }

layout :: Int -> Int -> Editor -> (Editor, Layout)
layout :: Int -> Int -> Editor -> (Editor, Layout)
layout Int
colCount Int
rowCount Editor
e =
    ( Editor
e Editor -> (Editor -> Editor) -> Editor
forall a b. a -> (a -> b) -> b
& (PointedList Window -> Identity (PointedList Window))
-> Editor -> Identity Editor
Lens' Editor (PointedList Window)
windowsA ((PointedList Window -> Identity (PointedList Window))
 -> Editor -> Identity Editor)
-> PointedList Window -> Editor -> Editor
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PointedList Window
newWs
    , Rect -> Map WindowRef (Rect, HasNeighborWest) -> Rect -> Layout
Layout Rect
tabRect Map WindowRef (Rect, HasNeighborWest)
winRects Rect
cmdRect
    )
    where
      lt :: Layout WindowRef
lt = Editor
e Editor
-> Getting (Layout WindowRef) Editor (Layout WindowRef)
-> Layout WindowRef
forall s a. s -> Getting a s a -> a
^. (PointedList Tab -> Const (Layout WindowRef) (PointedList Tab))
-> Editor -> Const (Layout WindowRef) Editor
Lens' Editor (PointedList Tab)
tabsA ((PointedList Tab -> Const (Layout WindowRef) (PointedList Tab))
 -> Editor -> Const (Layout WindowRef) Editor)
-> ((Layout WindowRef
     -> Const (Layout WindowRef) (Layout WindowRef))
    -> PointedList Tab -> Const (Layout WindowRef) (PointedList Tab))
-> Getting (Layout WindowRef) Editor (Layout WindowRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tab -> Const (Layout WindowRef) Tab)
-> PointedList Tab -> Const (Layout WindowRef) (PointedList Tab)
forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> PointedList a -> f (PointedList a)
PL.focus ((Tab -> Const (Layout WindowRef) Tab)
 -> PointedList Tab -> Const (Layout WindowRef) (PointedList Tab))
-> ((Layout WindowRef
     -> Const (Layout WindowRef) (Layout WindowRef))
    -> Tab -> Const (Layout WindowRef) Tab)
-> (Layout WindowRef
    -> Const (Layout WindowRef) (Layout WindowRef))
-> PointedList Tab
-> Const (Layout WindowRef) (PointedList Tab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tab -> Layout WindowRef) -> SimpleGetter Tab (Layout WindowRef)
forall s a. (s -> a) -> SimpleGetter s a
to Tab -> Layout WindowRef
tabLayout
      miniWs :: [Window]
miniWs = (Window -> HasNeighborWest) -> [Window] -> [Window]
forall a. (a -> HasNeighborWest) -> [a] -> [a]
filter Window -> HasNeighborWest
isMini ([Window] -> [Window])
-> (PointedList Window -> [Window])
-> PointedList Window
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PointedList Window -> [Window]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PointedList Window -> [Window]) -> PointedList Window -> [Window]
forall a b. (a -> b) -> a -> b
$ Editor -> PointedList Window
windows Editor
e
      tabHeight :: Int
tabHeight = Int
1
      tabRect :: Rect
tabRect = Int -> Int -> Int -> Int -> Rect
Rect Int
0 Int
0 Int
colCount Int
tabHeight
      cmdHeight :: Int
cmdHeight = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Int -> [Text]
arrangeItems (([Text], StyleName) -> [Text]
forall a b. (a, b) -> a
fst (([Text], StyleName) -> [Text]) -> ([Text], StyleName) -> [Text]
forall a b. (a -> b) -> a -> b
$ Editor -> ([Text], StyleName)
statusLineInfo Editor
e) Int
colCount (Editor -> Int
maxStatusHeight Editor
e)
      miniHeight :: Int
miniHeight = if [Window] -> HasNeighborWest
forall (t :: * -> *) a. Foldable t => t a -> HasNeighborWest
null [Window]
miniWs then Int
0 else Int
1
      cmdRect :: Rect
cmdRect = Int -> Int -> Int -> Int -> Rect
Rect Int
0 (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cmdHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
miniHeight) Int
colCount Int
cmdHeight
      bounds :: Rectangle
bounds = Rect -> Rectangle
rectToRectangle (Rect -> Rectangle) -> Rect -> Rectangle
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Rect
Rect Int
0 Int
tabHeight Int
colCount (Int -> Rect) -> Int -> Rect
forall a b. (a -> b) -> a -> b
$
                   Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
cmdHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
miniHeight) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tabHeight
      bigRects :: [(Window, Rect, HasNeighborWest)]
bigRects = HasNeighborWest
-> Rectangle
-> Layout WindowRef
-> [(WindowRef, Rectangle, HasNeighborWest)]
forall a.
HasNeighborWest
-> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)]
layoutToRectangles HasNeighborWest
False Rectangle
bounds Layout WindowRef
lt [(WindowRef, Rectangle, HasNeighborWest)]
-> ([(WindowRef, Rectangle, HasNeighborWest)]
    -> [(Window, Rect, HasNeighborWest)])
-> [(Window, Rect, HasNeighborWest)]
forall a b. a -> (a -> b) -> b
& ((WindowRef, Rectangle, HasNeighborWest)
 -> (Window, Rect, HasNeighborWest))
-> [(WindowRef, Rectangle, HasNeighborWest)]
-> [(Window, Rect, HasNeighborWest)]
forall a b. (a -> b) -> [a] -> [b]
map (\(WindowRef
wr, Rectangle
r, HasNeighborWest
nb) ->
                   let r' :: Rect
r' = Rectangle -> Rect
rectangleToRect Rectangle
r
                       sx :: Int
sx = Rect -> Int
sizeX Rect
r' Int -> Int -> Int
forall a. Num a => a -> a -> a
- if HasNeighborWest
nb then Int
1 else Int
0
                       w' :: Window
w' = Window -> Editor -> Int -> Int -> Window
layoutWindow (WindowRef -> Editor -> Window
findWindowWith WindowRef
wr Editor
e) Editor
e Int
sx (Rect -> Int
sizeY Rect
r')
                   in (Window
w', Rect
r', HasNeighborWest
nb))
      miniRects :: [(Window, Rect, HasNeighborWest)]
miniRects = [Window]
miniWs [Window]
-> ([Window] -> [(Window, Rect, HasNeighborWest)])
-> [(Window, Rect, HasNeighborWest)]
forall a b. a -> (a -> b) -> b
& (Window -> (Window, Rect, HasNeighborWest))
-> [Window] -> [(Window, Rect, HasNeighborWest)]
forall a b. (a -> b) -> [a] -> [b]
map (\Window
w ->
                    let r' :: Rect
r' = Int -> Int -> Int -> Int -> Rect
Rect Int
0 (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
colCount Int
1
                        w' :: Window
w' = Window -> Editor -> Int -> Int -> Window
layoutWindow Window
w Editor
e (Rect -> Int
sizeX Rect
r') (Rect -> Int
sizeY Rect
r')
                    in (Window
w', Rect
r', HasNeighborWest
False))
      rects :: [(Window, Rect, HasNeighborWest)]
rects = [(Window, Rect, HasNeighborWest)]
bigRects [(Window, Rect, HasNeighborWest)]
-> [(Window, Rect, HasNeighborWest)]
-> [(Window, Rect, HasNeighborWest)]
forall a. Semigroup a => a -> a -> a
<> [(Window, Rect, HasNeighborWest)]
miniRects
      winRects :: Map WindowRef (Rect, HasNeighborWest)
winRects = [(Window, Rect, HasNeighborWest)]
rects [(Window, Rect, HasNeighborWest)]
-> ([(Window, Rect, HasNeighborWest)]
    -> Map WindowRef (Rect, HasNeighborWest))
-> Map WindowRef (Rect, HasNeighborWest)
forall a b. a -> (a -> b) -> b
& [(WindowRef, (Rect, HasNeighborWest))]
-> Map WindowRef (Rect, HasNeighborWest)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WindowRef, (Rect, HasNeighborWest))]
 -> Map WindowRef (Rect, HasNeighborWest))
-> ([(Window, Rect, HasNeighborWest)]
    -> [(WindowRef, (Rect, HasNeighborWest))])
-> [(Window, Rect, HasNeighborWest)]
-> Map WindowRef (Rect, HasNeighborWest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Window, Rect, HasNeighborWest)
 -> (WindowRef, (Rect, HasNeighborWest)))
-> [(Window, Rect, HasNeighborWest)]
-> [(WindowRef, (Rect, HasNeighborWest))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Window
w, Rect
r, HasNeighborWest
nb) -> (Window -> WindowRef
wkey Window
w, (Rect
r, HasNeighborWest
nb)))
      updWs :: [Window]
updWs = [(Window, Rect, HasNeighborWest)]
rects [(Window, Rect, HasNeighborWest)]
-> ([(Window, Rect, HasNeighborWest)] -> [Window]) -> [Window]
forall a b. a -> (a -> b) -> b
& ((Window, Rect, HasNeighborWest) -> Window)
-> [(Window, Rect, HasNeighborWest)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map ((Window, Rect, HasNeighborWest)
-> Getting Window (Window, Rect, HasNeighborWest) Window -> Window
forall s a. s -> Getting a s a -> a
^. Getting Window (Window, Rect, HasNeighborWest) Window
forall s t a b. Field1 s t a b => Lens s t a b
_1)
      newWs :: PointedList Window
newWs = Editor -> PointedList Window
windows Editor
e PointedList Window
-> (PointedList Window -> PointedList Window) -> PointedList Window
forall a b. a -> (a -> b) -> b
& (Window -> Window) -> PointedList Window -> PointedList Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Window
w -> Window -> Maybe Window -> Window
forall a. a -> Maybe a -> a
fromMaybe Window
w (Maybe Window -> Window) -> Maybe Window -> Window
forall a b. (a -> b) -> a -> b
$ (Window -> HasNeighborWest) -> [Window] -> Maybe Window
forall (t :: * -> *) a.
Foldable t =>
(a -> HasNeighborWest) -> t a -> Maybe a
find ((WindowRef -> WindowRef -> HasNeighborWest
forall a. Eq a => a -> a -> HasNeighborWest
== Window -> WindowRef
wkey Window
w) (WindowRef -> HasNeighborWest)
-> (Window -> WindowRef) -> Window -> HasNeighborWest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowRef
wkey) [Window]
updWs)

rectToRectangle :: Rect -> Rectangle
rectToRectangle :: Rect -> Rectangle
rectToRectangle (Rect Int
x Int
y Int
sx Int
sy) = Double -> Double -> Double -> Double -> Rectangle
Rectangle (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)  (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
                                             (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sx) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sy)

rectangleToRect :: Rectangle -> Rect
rectangleToRect :: Rectangle -> Rect
rectangleToRect (Rectangle Double
x Double
y Double
sx Double
sy) = Int -> Int -> Int -> Int -> Rect
Rect (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
y)
                                             (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sx) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x)
                                             (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sy) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
y)

layoutWindow :: Window -> Editor -> Int -> Int -> Window
layoutWindow :: Window -> Editor -> Int -> Int -> Window
layoutWindow Window
win Editor
e Int
w Int
h = Window
win
    { height :: Int
height = Int
h
    , width :: Int
width = Int
w
    , winRegion :: Region
winRegion = Point -> Point -> Region
mkRegion Point
fromMarkPoint Point
toMarkPoint
    , actualLines :: Int
actualLines = Int
dispLnCount
    }
    where
        b :: FBuffer
b = BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e
        evalBuffer :: BufferM a -> a
evalBuffer BufferM a
action = (a, FBuffer) -> a
forall a b. (a, b) -> a
fst (Window -> FBuffer -> BufferM a -> (a, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM a
action)

        -- Mini windows don't have a mode line.
        h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- if Window -> HasNeighborWest
isMini Window
win then Int
0 else Int
1

        -- Work around a problem with the mini window never displaying it's contents due to a
        -- fromMark that is always equal to the end of the buffer contents.
        Just (MarkSet Mark
fromM Mark
_ Mark
_) = BufferM (Maybe (MarkSet Mark)) -> Maybe (MarkSet Mark)
forall a. BufferM a -> a
evalBuffer (Window -> BufferM (Maybe (MarkSet Mark))
getMarks Window
win)
        fromMarkPoint :: Point
fromMarkPoint = if Window -> HasNeighborWest
isMini Window
win
                        then Int -> Point
Point Int
0
                        else BufferM Point -> Point
forall a. BufferM a -> a
evalBuffer (BufferM Point -> Point) -> BufferM Point -> Point
forall a b. (a -> b) -> a -> b
$ Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> Getting Point FBuffer Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Mark -> Lens' FBuffer Point
markPointA Mark
fromM

        -- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size;
        -- In that case, since attributes are also useless there, it might help to replace the call by a dummy value.
        -- This is also approximately valid of the call to "indexedAnnotatedStreamB".
        (Point
toMarkPoint, Int
wrapCount) = BufferM (Point, Int) -> (Point, Int)
forall a. BufferM a -> a
evalBuffer
            (Size2D -> Point -> BufferM (Point, Int)
lastVisiblePointAndWrapCountB (Int -> Int -> Size2D
Size2D Int
w Int
h') Point
fromMarkPoint)

        dispLnCount :: Int
dispLnCount = Int
h' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wrapCount


coordsOfCharacterB :: Size2D -> Point -> Point -> BufferM (Maybe Point2D)
coordsOfCharacterB :: Size2D -> Point -> Point -> BufferM (Maybe Point2D)
coordsOfCharacterB Size2D
_ Point
topLeft Point
char | Point
topLeft Point -> Point -> HasNeighborWest
forall a. Ord a => a -> a -> HasNeighborWest
> Point
char = Maybe Point2D -> BufferM (Maybe Point2D)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point2D
forall a. Maybe a
Nothing
coordsOfCharacterB (Size2D Int
w Int
h) (Point Int
topLeft) (Point Int
char)
    | Int
char Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
topLeft Int -> Int -> HasNeighborWest
forall a. Ord a => a -> a -> HasNeighborWest
>= Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h = Maybe Point2D -> BufferM (Maybe Point2D)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point2D
forall a. Maybe a
Nothing
coordsOfCharacterB (Size2D Int
w Int
h) (Point Int
topLeft) (Point Int
char) = BufferM (Maybe Point2D) -> BufferM (Maybe Point2D)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Maybe Point2D) -> BufferM (Maybe Point2D))
-> BufferM (Maybe Point2D) -> BufferM (Maybe Point2D)
forall a b. (a -> b) -> a -> b
$ do
    Int
ts <- (IndentSettings -> Int) -> BufferM IndentSettings -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IndentSettings -> Int
tabSize BufferM IndentSettings
indentSettingsB
    String
text <- (YiString -> String) -> BufferM YiString -> BufferM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (YiString -> String
R.toString (YiString -> String)
-> (YiString -> YiString) -> YiString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.take (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h)) (Direction -> Point -> BufferM YiString
streamB Direction
Forward (Int -> Point
Point Int
topLeft))
    let go :: Int -> Int -> a -> String -> Maybe Point2D
go Int
_  !Int
y a
_ String
_ | Int
y Int -> Int -> HasNeighborWest
forall a. Ord a => a -> a -> HasNeighborWest
>= Int
h = Maybe Point2D
forall a. Maybe a
Nothing
        go !Int
x !Int
y a
0 String
_ = Point2D -> Maybe Point2D
forall a. a -> Maybe a
Just (Int -> Int -> Point2D
Point2D Int
x Int
y)
        go !Int
x !Int
y !a
n (Char
c : Char
d : String
t) =
            case (Char
c, Char
d, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
wOffset) of
                (Char
'\t',  Char
_ , Ordering
_) -> Int -> Int -> a -> String -> Maybe Point2D
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ts) Int
y (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
                (Char
'\n',  Char
_ , Ordering
_) -> Int -> Int -> a -> String -> Maybe Point2D
go Int
0 (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
                (  Char
_ ,Char
'\n',Ordering
EQ) -> Int -> Int -> a -> String -> Maybe Point2D
go Int
x Int
y (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
                (  Char
_ ,  Char
_ ,Ordering
EQ) -> Int -> Int -> a -> String -> Maybe Point2D
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wOffset) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
                (  Char
_ ,  Char
_ , Ordering
_) -> Int -> Int -> a -> String -> Maybe Point2D
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
t)
            where wOffset :: Int
wOffset = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        go !Int
x !Int
y !a
n [Char
c] =
            case (Char
c, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
wOffset) of
                (Char
'\n', Ordering
_) -> Int -> Int -> a -> String -> Maybe Point2D
go Int
0 (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [Char
c]
                (  Char
_ , Ordering
_) -> Int -> Int -> a -> String -> Maybe Point2D
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [Char
c]
            where wOffset :: Int
wOffset = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        go !Int
x !Int
y a
_ String
_ = Point2D -> Maybe Point2D
forall a. a -> Maybe a
Just (Int -> Int -> Point2D
Point2D Int
x Int
y)
    Maybe Point2D -> BufferM (Maybe Point2D)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> String -> Maybe Point2D
forall a.
(Eq a, Num a) =>
Int -> Int -> a -> String -> Maybe Point2D
go Int
0 Int
0 (Int
char Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
topLeft) String
text)

lastVisiblePointAndWrapCountB :: Size2D -> Point -> BufferM (Point, Int)
lastVisiblePointAndWrapCountB :: Size2D -> Point -> BufferM (Point, Int)
lastVisiblePointAndWrapCountB (Size2D Int
w Int
h) (Point Int
topLeft) = BufferM (Point, Int) -> BufferM (Point, Int)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Point, Int) -> BufferM (Point, Int))
-> BufferM (Point, Int) -> BufferM (Point, Int)
forall a b. (a -> b) -> a -> b
$ do
    Int
ts <- (IndentSettings -> Int) -> BufferM IndentSettings -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IndentSettings -> Int
tabSize BufferM IndentSettings
indentSettingsB
    Text
text <- (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (YiString -> Text
R.toText (YiString -> Text) -> (YiString -> YiString) -> YiString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.take (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h))
                 (Direction -> Point -> BufferM YiString
streamB Direction
Forward (Int -> Point
Point Int
topLeft))
    let go :: Int -> Int -> b -> Int -> Text -> (Point, b)
go !Int
x !Int
y !b
wc !Int
n Text
t | Int
x Int -> Int -> HasNeighborWest
forall a. Ord a => a -> a -> HasNeighborWest
> Int
w = Int -> Int -> b -> Int -> Text -> (Point, b)
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (b
wc b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) Int
n Text
t
        go Int
_  !Int
y !b
wc !Int
n Text
_ | Int
y Int -> Int -> HasNeighborWest
forall a. Ord a => a -> a -> HasNeighborWest
>= Int
h = (Int -> Point
Point (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), b
wc)
        go !Int
x !Int
y !b
wc !Int
n (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c, Text
t)) =
            case Char
c of
                Char
'\t' -> Int -> Int -> b -> Int -> Text -> (Point, b)
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ts) Int
y b
wc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t
                Char
'\n' -> Int -> Int -> b -> Int -> Text -> (Point, b)
go Int
0 (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b
wc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t
                Char
_ -> Int -> Int -> b -> Int -> Text -> (Point, b)
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y b
wc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t
        go Int
_ Int
_ !b
wc !Int
n Text
_ = (Int -> Point
Point Int
n, b
wc)
    (Point, Int) -> BufferM (Point, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Text -> (Point, Int)
forall b. Num b => Int -> Int -> b -> Int -> Text -> (Point, b)
go Int
0 Int
0 Int
0 Int
topLeft Text
text)

verticalOffsetsForWindows :: Int -> PL.PointedList Window -> PL.PointedList Int
verticalOffsetsForWindows :: Int -> PointedList Window -> PointedList Int
verticalOffsetsForWindows Int
startY PointedList Window
ws =
    (Int -> Int -> Int) -> Int -> PointedList Int -> PointedList Int
scanrT Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
startY ((Window -> Int) -> PointedList Window -> PointedList Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Window
w -> if Window -> HasNeighborWest
isMini Window
w then Int
0 else Window -> Int
height Window
w) PointedList Window
ws)

-- As scanr, but generalized to a traversable (TODO)
scanrT :: (Int -> Int -> Int) -> Int -> PL.PointedList Int -> PL.PointedList Int
scanrT :: (Int -> Int -> Int) -> Int -> PointedList Int -> PointedList Int
scanrT Int -> Int -> Int
(+*+) Int
k PointedList Int
t = State Int (PointedList Int) -> Int -> PointedList Int
forall s a. State s a -> s -> a
evalState ((Int -> StateT Int Identity Int)
-> PointedList Int -> State Int (PointedList Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> StateT Int Identity Int
forall (m :: * -> *). MonadState Int m => Int -> m Int
f PointedList Int
t) Int
k
    where f :: Int -> m Int
f Int
x = do Int
s <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
                   let s' :: Int
s' = Int
s Int -> Int -> Int
+*+ Int
x
                   Int -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
s'
                   Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s