module Dodge.SelectionSections (
    scrollSelectionSections,
    nextInSectionSS,
    ssLookupDown,
    ssSetCursor,
    selSecYint,
    selSecSelSize,
    inverseSelSecYint,
    posSelSecYint,
    inverseSelNumPos,
) where

import Control.Applicative
import qualified Control.Foldl as L
import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.HUD
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Geometry.Data

scrollSelectionSections :: Int -> IMSS a -> Maybe Selection -> Maybe Selection
scrollSelectionSections yi sss msel
    | yi == 0 = msel
    | yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
    | otherwise = foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)

nextInSectionSS :: IMSS a -> Maybe Selection -> Maybe Selection
nextInSectionSS = ssScrollUsing ssLookupNextMax

ssScrollUsing ::
    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
    IMSS a ->
    Maybe Selection ->
    Maybe Selection
ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)

-- 
ssScrollMinOnFail ::
    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
    IMSS a ->
    Maybe Selection ->
    Maybe Selection
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j q) $ l <|> ssLookupMin sss
  where
    q = fold (msel ^? _Just . slSet)
    l = do
        Sel i j _ <- msel
        f i j sss

---- this version removes the selected set when scrolling outside it
--ssScrollMinOnFail' ::
--    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
--    IMSS a ->
--    Maybe Selection ->
--    Maybe Selection
--ssScrollMinOnFail' f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
--  where
--    q i j = fromMaybe mempty $ do
--        Sel k _ xs <- msel ^? _Just
--        guard $ j `IS.member` xs && i == k
--        return xs
--    l = do
--        Sel i j _ <- msel
--        f i j sss

ssSetCursor ::
    (IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
    IMSS a ->
    Maybe Selection ->
    Maybe Selection
ssSetCursor f sss msel = fromMaybe msel $ do
    (i, j, _) <- f sss
    let newxs = fromMaybe mempty $ do
            Sel k _ xs <- msel
            guard $ k == i && j `IS.member` xs
            return xs
    return $ Just (Sel i j newxs)

ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
    (i, _) <- IM.lookupMax sss
    ssLookupLE' i sss

ssLookupUp :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupUp i j sss = case ssLookupLT i j sss of
    Nothing -> ssLookupMax sss
    x -> x

ssLookupDown :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupDown i j sss = case ssLookupGT i j sss of
    Nothing -> ssLookupMin sss
    x -> x

ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupNextMax i j sss = case ssLookupGT i j sss of
    Just x@(i', j', _) | i' == i && j' > j -> Just x
    _ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss

ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection i sss = do
    ss <- sss ^? ix i . ssItems
    (j, s) <- IM.lookupMax ss
    return (i, j, s)

ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
    ss <- sss ^? ix i
    (j', si) <- IM.lookupLT j (ss ^. ssItems)
    return $ Just (i, j', si)

ssLookupLT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT' i sss = do
    (i', ss) <- IM.lookupLT i sss
    case IM.lookupMax (ss ^. ssItems) of
        Just (j', si) -> return (i', j', si)
        Nothing -> ssLookupLT' i' sss

ssLookupLE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' i sss = do
    (i', ss) <- IM.lookupLE i sss
    case IM.lookupMax (ss ^. ssItems) of
        Just (j', si) -> return (i', j', si)
        Nothing -> ssLookupLT' i' sss

ssLookupMin :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
    (i, _) <- IM.lookupMin sss
    ssLookupGE' i sss

ssLookupGT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
    ss <- sss ^? ix i
    (j', si) <- IM.lookupGT j (ss ^. ssItems)
    return $ Just (i, j', si)

ssLookupGT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' i sss = do
    (i', ss) <- IM.lookupGT i sss
    case IM.lookupMin (ss ^. ssItems) of
        Just (j', si) -> return (i', j', si)
        Nothing -> ssLookupGT' i' sss

ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' i sss = do
    (i', ss) <- IM.lookupGE i sss
    case IM.lookupMin (ss ^. ssItems) of
        Just (j', si) -> return (i', j', si)
        Nothing -> ssLookupGT' i' sss

selSecSelSize :: Int -> Int -> IMSS a -> Maybe Int
selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)

-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Config -> LDParams -> Float -> Int
posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
  where
    V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)

selSecYint :: Int -> Int -> IMSS a -> Maybe Int
selSecYint i j sss = do
    ss <- sss ^? ix i
    return
        . (secpos +)
        . subtract (ss ^. ssOffset)
        . sum
        . fmap _siHeight
        . fst
        $ IM.split j (ss ^. ssItems)
  where
    secpos = sum . fmap _ssShownLength . fst $ IM.split i sss

inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
inverseSelSecYint yint sss
    | yint < 0 = NegInf
    | otherwise = fromMaybe PosInf $ do
        ((i, ss), othersss) <- IM.minViewWithKey sss
        let l = _ssShownLength ss
        if l <= yint
            then return $ inverseSelSecYint (yint - l) othersss
            else do
                let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
                (j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls
                return $ NonInf (i, j)

inverseSelSecYintXPosCheck ::
    Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (XInfinity (Int, Int))
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
    let sel = inverseSelSecYint yint sss
    (i,j) <- case sel of
        NonInf v -> Just v
        NegInf -> do 
            (i',j',_) <- ssLookupMin sss
            return (i',j')
        PosInf -> do
            (i',j',_) <- ssLookupMax sss
            return (i',j')
    let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
    sindent <- sss ^? ix i . ssIndent
    itindent <- sss ^? ix i . ssItems . ix j . siOffX
    let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
    guard $ x - x1 < 160 && x > x1
    return sel

inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (XInfinity (Int, Int))
inverseSelNumPos cfig ldp (V2 x y) =
    inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)