{-# LANGUAGE OverloadedStrings #-}

module TextViewport
  ( Item(..)
  , Buffer(..)
  , WrapMode(..)
  , Viewport(..)
  , RenderedLine(..)
  , renderBuffer
  , defaultViewport
  , scrollUp
  , scrollDown
  , visibleLines
  , lookupPosition
  ) where

import Data.Text (Text)
import qualified Data.Text as T

--------------------------------------------------------------------------------
-- Logical model
--------------------------------------------------------------------------------

newtype Item = Item { unItem :: Text }
newtype Buffer = Buffer { unBuffer :: [Item] }

--------------------------------------------------------------------------------
-- Rendering
--------------------------------------------------------------------------------

-- | Rendering mode: either truncate long lines or wrap them.
data WrapMode
  = NoWrap   -- ^ Hard truncation at viewport width.
  | Wrap     -- ^ Soft line breaks inserted at viewport width.
  deriving (Eq, Show)

-- | A physical line with provenance.
data RenderedLine = RenderedLine
  { rlText      :: !Text
  , rlItemIx    :: !Int      -- ^ index of the item in the Buffer
  , rlLineIx    :: !Int      -- ^ index of the logical line within the item
  , rlCharStart :: !Int      -- ^ starting character offset within the logical line
  } deriving (Eq, Show)

-- | Render the buffer into a flat list of physical lines.
--   Wrapping expands logical lines; truncation keeps one line per logical line.
renderBuffer :: WrapMode -> Int -> Buffer -> [RenderedLine]
renderBuffer mode w (Buffer items) =
    concat $ zipWith renderItem [0..] items
  where
    renderItem :: Int -> Item -> [RenderedLine]
    renderItem itemIx (Item t) =
      concat $ zipWith (renderLogicalLine itemIx) [0..] (T.splitOn "\n" t)

    renderLogicalLine :: Int -> Int -> Text -> [RenderedLine]
    renderLogicalLine itemIx lineIx txt =
      case mode of
        NoWrap ->
          [ RenderedLine
              { rlText      = T.take w txt
              , rlItemIx    = itemIx
              , rlLineIx    = lineIx
              , rlCharStart = 0
              }
          ]

        Wrap ->
          let chunks = chunk w txt
          in zipWith mkChunk [0, w ..] chunks
          where
            mkChunk off chunkTxt =
              RenderedLine
                { rlText      = chunkTxt
                , rlItemIx    = itemIx
                , rlLineIx    = lineIx
                , rlCharStart = off
                }

    chunk :: Int -> Text -> [Text]
    chunk width s
      | T.null s  = [""]
      | otherwise = go s
      where
        go t
          | T.null t  = []
          | otherwise =
              let (c, r) = T.splitAt width t
              in c : go r

-- | Split a line into chunks of at most width characters.
--   This is soft wrapping: no hyphenation, no word-boundary logic.
wrapText :: Int -> Text -> [Text]
wrapText w t
  | T.null t  = [""]
  | otherwise = go t
  where
    go s
      | T.null s  = []
      | otherwise =
          let (chunk, rest) = T.splitAt w s
          in chunk : go rest

--------------------------------------------------------------------------------
-- Viewport
--------------------------------------------------------------------------------

data Viewport = Viewport
  { vpWidth  :: !Int
  , vpHeight :: !Int
  , vpOffset :: !Int
  } deriving (Eq, Show)

defaultViewport :: Int -> Int -> [RenderedLine] -> Viewport
defaultViewport w h rendered =
    let total = length rendered
        off   = max 0 (total - h)
    in Viewport w h off

scrollUp :: Int -> Viewport -> Viewport
scrollUp k vp =
    vp { vpOffset = max 0 (vpOffset vp - k) }

scrollDown :: Int -> [RenderedLine] -> Viewport -> Viewport
scrollDown k rendered vp =
    let total  = length rendered
        maxOff = max 0 (total - vpHeight vp)
        newOff = min maxOff (vpOffset vp + k)
    in vp { vpOffset = newOff }

visibleLines :: [RenderedLine] -> Viewport -> [RenderedLine]
visibleLines rendered vp =
    take (vpHeight vp) . drop (vpOffset vp) $ rendered


--------------------------------------------------------------------------------
-- Lookup
--------------------------------------------------------------------------------

-- | Given viewport coordinates (x,y), return:
--   (item index, character offset within that item), if visible.
lookupPosition
  :: Int              -- ^ x coordinate in viewport
  -> Int              -- ^ y coordinate in viewport
  -> Viewport
  -> [RenderedLine]
  -> Maybe (Int, Int) -- ^ (itemIx, charOffsetInItem)
lookupPosition x y vp rendered = do
    let lineIx = vpOffset vp + y
    rl <- renderedAt lineIx rendered
    let charInLogical = rlCharStart rl + x
    pure (rlItemIx rl, charInLogical)
  where
    renderedAt ix rs
      | ix < 0 || ix >= length rs = Nothing
      | otherwise                 = Just (rs !! ix)

-- | Convert (lineIx, charOffset) into a single absolute offset inside the item.
absoluteCharOffset :: Item -> Int -> Int -> Int
absoluteCharOffset (Item t) lineIx charOff =
    let ls = T.splitOn "\n" t
        prefix = sum (map T.length (take lineIx ls)) + lineIx  -- +lineIx for '\n'
    in prefix + charOff