{-# LANGUAGE LambdaCase #-}

module Dodge.Terminal (
    makeTermLine,
    textInputBlurb,
    textTerminal,
    simpleTermMessage,
    damageCodeCommand,
    makeColorTermLine,
    makeTermPara,
    terminalReturnEffect,
    getCommands,
    tabComplete,
    tlSetStatus,
    tlDoEffect,
    termTextColor,
) where

import Color
import Data.Char
import qualified Data.List as List
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Data.Terminal.Status
import Dodge.Data.World
import Dodge.Default
import Dodge.SoundLogic
import Dodge.Terminal.Type
import Justify
import LensHelp
import Sound.Data

textTerminal :: Terminal
textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}

textInputBlurb :: [TerminalLine] -> [TerminalLine]
textInputBlurb tls =
    [termSoundLine computerBeepingS]
        ++ tls
        ++ tlSetStatus (TerminalTextInput "")

termSoundLine :: SoundID -> TerminalLine
termSoundLine = TLine 0 [] . TmWdWdTermSound

termTextColor :: Color
termTextColor = greyN 0.9

getCommands :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
getCommands w tm = foldMap (getCommand w tm) $ tm ^. tmCommands

getCommand :: World 
    -> Terminal -> TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
getCommand w tm = \case
    TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
    TCBase -> quitCommand <> toggleCommands tm
    TCDamageCommand -> damageCodeCommand w tm

damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
damageCodeCommand w _ 
    = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
  where
    f :: SensorType -> Maybe (String, [TerminalLine])
    f st = do
        s <- g st
        return (s, decodeSensorType st w)
    g =
        fmap (map toUpper . reverse) . List.stripPrefix (reverse "Sensor")
            . reverse
            . show

decodeSensorType :: SensorType -> World -> [TerminalLine]
decodeSensorType st w = fromMaybe [] $ do
    x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
    return [makeTermLine $ show x]

toggleCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
toggleCommands tm 
    | null ts = mempty
    | otherwise = PTE.singleton "TOGGLE" $ PTE.fromList $ f <$> M.toList ts
  where
    ts = tm ^. tmToggles
    f (s,x) = (s,
        [ TLine
            1
            [TerminalLineConst (s ++ " TOGGLE DONE!") termTextColor]
            (TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
        ])

helpPara :: [TerminalLine]
helpPara = makeTermPara "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE."

quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdPowerDownTerminal])

makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor

tlSetStatus :: TerminalStatus -> [TerminalLine]
tlSetStatus x = tlDoEffect $ TmTmSetStatus x

tlDoEffect :: TmWdWd -> [TerminalLine]
tlDoEffect x = [TLine 1 [] x]

makeTermPara :: String -> [TerminalLine]
makeTermPara = makeColorTermPara termTextColor

makeColorTermPara :: Color -> String -> [TerminalLine]
makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 55

makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TLine 1 [TerminalLineConst str col] TmWdId

commandColor :: Color
commandColor = yellow

tabComplete :: World -> Terminal -> Terminal
tabComplete w tm = fromMaybe tm $ do
    s <- tm ^? tmStatus . tiText
    return $ tabComplete' s w tm

-- ugly, can improve output to explain when showing available arguments
tabComplete' :: String -> World -> Terminal -> Terminal
tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
    Just m -> f (s ++ " ") $ PTE.toList $ PTE.lookupPrefix a m
    Nothing -> f "" $ PTE.toList $ PTE.lookupPrefix s $ getCommands w tm
  where
    ss = words s'
    s = fromMaybe "" $ ss ^? ix 0
    a = fromMaybe "" $ ss ^? ix 1
    f y m' = case fmap fst m' of
        [] -> tm
        [x] -> tm & tmStatus . tiText .~ (y ++ x)
        xs ->
            tm & tmStatus .~ TerminalLineRead
                & tmFutureLines
                .~ ( makeColorTermPara
                        commandColor
                        (unwords xs)
                        <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s']
                   )

--damageCodeCommand :: TerminalCommand
--damageCodeCommand =
--    TerminalCommand
--        { _tcString = "DAMAGECODE"
--        , _tcAlias = ["DCODE", "DC"]
--        , _tcHelp = "Displays the shape and color associated with a given damage type."
--        , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
--        }

--infoClearInput :: Terminal -> [TerminalLine] -> World -> World
--infoClearInput tm tls =
--    cWorld . lWorld . terminals . ix (_tmID tm)
--        %~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
--                . (tmFutureLines ++.~ tls)
--           )

--togglesToEffects :: Terminal -> M.Map String [TerminalLine]
--togglesToEffects = fmap f . _tmToggles
--  where
--    f tt = [TLine 0 [] $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]

simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs

-- list available arguments on function input?
terminalReturnEffect :: Int -> World -> World
terminalReturnEffect tmid w = fromMaybe w $ do
    tm' <- w ^? cWorld . lWorld . terminals . ix tmid
    let tm = tabComplete w tm'
    s <- tm ^? tmStatus . tiText
    let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
            let args = words s
            case args of
                [] -> return helpPara
                (x:_) -> do
                    teff <- PTE.lookup x (getCommands w tm)
                    let y = fromMaybe "" (args ^? ix 1)
                    PTE.lookup y teff
    return $ w 
        & totm . tmDisplayedLines .:~ (getPromptTM ++ s, termTextColor)
        & totm . tmFutureLines .~ ss <> tlSetStatus (TerminalTextInput "")
        & totm . tmCommandHistory %~ take 10 . (s :)
        & totm . tmStatus .~ TerminalLineRead
  where
    totm = cWorld . lWorld . terminals . ix tmid