module Dodge.SelectionSections (
    scrollSelectionSections,
    nextInSectionSS,
    ssLookupDown,
    ssLookupGT,
    ssTryLookup,
    ssSetCursor,
    --    setFirstPosSelectionSections,
    selSecYint,
    selSecSelSize,
    inverseSelSecYint,
    posSelSecYint,
    inverseSelNumPos,
    inverseSelBoundaryUp,
    inverseSelBoundaryDown,
) 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 Data.Maybe
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Geometry.Data

scrollSelectionSections ::
    Int ->
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int) ->
    Maybe (Int, Int)
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 :: 
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int) ->
    Maybe (Int, Int)
nextInSectionSS = ssScrollUsing ssLookupNextMax

--setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
--setFirstPosSelectionSections sss = fromMaybe sss $ do
--    (i, j, _) <- ssLookupMin sss
--    return $ sss & sssExtra . sssSelPos ?~ (i, j)

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

ssScrollMinOnFail ::
    (Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int) ->
    Maybe (Int, Int)
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
  where
    l = do
        (i, j) <- msel
        f i j sss

ssSetCursor ::
    (IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int) ->
    Maybe (Int, Int)
ssSetCursor f sss msel = fromMaybe msel $ do
    (i, j, _) <- f sss
    return $ Just (i, j)

ssTryLookup :: Maybe (Int,Int) -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssTryLookup msel sss = fromMaybe (ssLookupMin sss) $ do
    (i,j) <- msel
    itm <- sss ^? ix i . ssItems . ix j
    return $ Just (i,j,itm)

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

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

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

ssLookupNextMax ::
    Int ->
    Int ->
    IM.IntMap (SelectionSection 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 -> IM.IntMap (SelectionSection 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 ->
    IM.IntMap (SelectionSection 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 ->
    IM.IntMap (SelectionSection 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 -> IM.IntMap (SelectionSection 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 :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
    (i, _) <- IM.lookupMin sss
    ssLookupGE' i sss

ssLookupGT ::
    Int ->
    Int ->
    IM.IntMap (SelectionSection 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 -> IM.IntMap (SelectionSection 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 -> IM.IntMap (SelectionSection 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 -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecSelSize i j = fmap length . (^? ix i . ssItems . ix j . siPictures)

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

selSecYint :: Int -> Int -> IM.IntMap (SelectionSection 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 (length . _ssShownItems) . fst $ IM.split i sss

inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int)
inverseSelSecYint yint sss = do
    ((i, ss), othersss) <- IM.minViewWithKey sss
    let l = length $ _ssShownItems ss
    if l <= yint
        then 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 (i, j)

inverseSelSecYintXPosCheck ::
    Configuration ->
    ListDisplayParams ->
    Float ->
    Int ->
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
    ((i, ss), othersss) <- IM.minViewWithKey sss
    let l = length $ _ssShownItems ss
        V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
    guard (x - x0 < 150) -- HACK, should determine selection item width and offset below
    guard (x > x0)
    if l <= yint
        then inverseSelSecYint (yint - l) othersss
        else do
            let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
            j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls
            return (i, j)

inverseSelNumPos ::
    Configuration ->
    ListDisplayParams ->
    IM.IntMap (SelectionSection a) ->
    Point2 ->
    Maybe (Int, Int)
inverseSelNumPos cfig ldp sss (V2 x y) =
    inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss

inverseSelBoundaryUp ::
    Configuration ->
    ListDisplayParams ->
    IM.IntMap (SelectionSection a) ->
    Point2 ->
    Maybe (Int, Int)
inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
    sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss
    let mselup = inverseSelSecYint (posSelSecYint cfig ldp y - 1) sss
    if Just sel == mselup
        then return $ sel & _2 +~ 1
        else return sel

inverseSelBoundaryDown ::
    Configuration ->
    ListDisplayParams ->
    IM.IntMap (SelectionSection a) ->
    Point2 ->
    Maybe (Int, Int)
inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do
    sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss
    let mseldown = inverseSelSecYint (posSelSecYint cfig ldp y + 1) sss
    if Just sel == mseldown
        then return $ sel & _2 -~ 1
        else return sel

--getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
--getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm