module Dodge.SelectionSections (
    scrollSelectionSections,
    nextInSectionSS,
    ssLookupDown,
    ssSetCursor,
    selSecYint,
    selSecSelSize,
    inverseSelSecYint,
    posSelSecYint,
    inverseSelNumPos,
    inverseSelNumPosFixedWidth,
    mouseInvPosFixWidth,
    ssLookupGE,
    ssLookupLE,
    sssSelectionSlice,
    ssScrollUsing,
    ssLookupSecGTLoop,
    ssLookupSecLTLoop,
) where

import Dodge.ListDisplayParams
import Dodge.Data.Universe
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 Data.Maybe
import Dodge.Data.CardinalPoint
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) $ l <|> ssLookupMin sss
  where
    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
    return $ Just (Sel i j)

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 (ssLookupSecLT i sss) $ do
    ss <- sss ^? ix i
    (j', si) <- IM.lookupLT j (ss ^. ssItems)
    return $ Just (i, j', si)

ssLookupSecLTLoop :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupSecLTLoop i sss = ssLookupSecLT i sss <|> ssLookupMax sss

ssLookupSecLT :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupSecLT i sss = do
    (i', ss) <- IM.lookupLT i sss
    case IM.lookupMax (ss ^. ssItems) of
        Just (j', si) -> return (i', j', si)
        Nothing -> ssLookupSecLT 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 -> ssLookupSecLT 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 (ssLookupSecGT i sss) $ do
    ss <- sss ^? ix i
    (j', si) <- IM.lookupGT j (ss ^. ssItems)
    return $ Just (i, j', si)

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

ssLookupSecGTLoop :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupSecGTLoop i sss = ssLookupSecGT i sss <|> ssLookupMin sss

ssLookupGE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
ssLookupGE x sss = case x of
    NegInf -> ssLookupMin sss
    PosInf -> Nothing
    NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
        Nothing -> ssLookupGT i j sss
        Just s -> Just (i,j,s)

ssLookupLE :: XInfinity (Int,Int) -> IMSS a -> Maybe (Int,Int,SelectionItem a)
ssLookupLE x sss = case x of
    NegInf -> Nothing
    PosInf -> ssLookupMax sss
    NonInf (i,j) -> case sss ^? ix i . ssItems . ix j of
        Nothing -> ssLookupLT i j sss
        Just s -> Just (i,j,s)

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 -> ssLookupSecGT 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 ^. ssYOffset)
        . 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 - _ssYOffset 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

inverseSelSecYintXPosCheckFixedWidth ::
    Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (XInfinity (Int, Int))
inverseSelSecYintXPosCheckFixedWidth cfig ldp x yint sss = do
    let sel = inverseSelSecYint yint sss
    (i,_) <- 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)
    let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent) - 0.5)
    guard $ x - x1 < 170 && x > x1
    return sel

mouseInvPosFixWidth :: Universe -> Maybe (XInfinity (Int,Int))
mouseInvPosFixWidth u = inverseSelNumPosFixedWidth
    (u^.uvConfig) 
    invDP 
    (u^.uvWorld. input . mousePos) 
    (u ^.uvWorld. hud . diSections)


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

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

sssSelectionSlice :: IMSS a -> XInfinity (Int,Int) -> XInfinity (Int,Int) -> IMSS a
sssSelectionSlice sss x1 x2 = fromMaybe mempty $ do
    let (xmin,xmax) | x1 < x2 = (x1,x2)
            | otherwise = (x2,x1)
    (mini,minj,_) <- ssLookupGE xmin sss
    (maxi,maxj,_) <- ssLookupLE xmax sss
    return $ fst (IM.split (maxi+1) . snd $ IM.split (mini-1) sss)
            & ix mini . ssItems %~ snd . IM.split (minj-1)
            & ix maxi . ssItems %~ fst . IM.split (maxj+1)