--{-# LANGUAGE TupleSections #-}
module Dodge.Terminal where
import Dodge.Data
import Dodge.Default
--import Dodge.Base
import Dodge.SoundLogic
import Color
import Justify
import LensHelp
import Sound.Data
import ListHelp (safeUncons,safeHead)

import Data.Char
import Data.Maybe
import Data.Foldable
import qualified Data.Map.Strict as M
import qualified IntMapHelp as IM
import qualified Data.Text as T
--import Text.Read

quitCommand :: TerminalCommand
quitCommand = TerminalCommand
    { _tcString = "QUIT"
    , _tcAlias  = ["Q","EXIT","X","SHUTDOWN",""]
    , _tcHelp   = "DISCONNECTS THE TERMINAL."
    , _tcEffect = \_ _ -> NoArguments [TerminalLineEffect 0 disconnectTerminal]
    }
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w 
    & terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
    & exitTerminalSubInv
    & terminals . ix (_tmID tm) . tmFutureLines .~ 
        [ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ []) ]

exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
    Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
    _ -> w

damageCodeCommand :: TerminalCommand
damageCodeCommand = TerminalCommand
    { _tcString = "DAMAGECODE"
    , _tcAlias  = ["DCODE","DC"]
    , _tcHelp   = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
    , _tcEffect = \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
    }
getDamageCoding :: World -> M.Map String [TerminalLine]
getDamageCoding = decodedtmap . _sensorCoding . _genParams

decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine]
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)

sensorCommand :: TerminalCommand
sensorCommand = TerminalCommand
    { _tcString = "SENSOR"
    , _tcAlias  = ["SEN"]
    , _tcHelp   = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
    , _tcEffect = \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
    }
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
sensorInfoMap tm w = M.fromList
    [("REQUIREMENT",    getSensor _proxRequirement  tm w)
    ,("DISTANCE",       getSensor _proxDist         tm w)
    ,("CURRENTSTATUS",  getSensor _proxStatus       tm w)
    ,("PASTSTATUS",     getSensor _sensToggle       tm w)
    ]
getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f) 
    (w ^? machines . ix (_tmMachineID tm) . mcSensor)

toggleCommand :: TerminalCommand
toggleCommand = TerminalCommand
    { _tcString = "TOGGLE"
    , _tcAlias  = ["TOG"]
    , _tcHelp   = "PERFORMS A REVERSABLE EFFECT."
    , _tcEffect = \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
    }
togglesToEffects :: Terminal -> M.Map String [TerminalLine]
togglesToEffects = fmap f . _tmToggles
  where
    f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ not]

helpCommand :: TerminalCommand
helpCommand = TerminalCommand
    { _tcString = "HELP"
    , _tcAlias  = ["H","MAN"]
    , _tcHelp   = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
    , _tcEffect = \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
    }
getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
getCommandsHelp tm w = foldr f mempty $ getCommands tm
  where
    f tc = M.insert (_tcString tc) 
        ( [makeTermLine "COMMAND:"
            , makeColorTermLine commandColor (_tcString tc)
            ,makeTermLine "ALIASES:" 
            , makeColorTermLine commandColor ( unwords (_tcAlias tc)) ] 
            ++ case argumentHelp tc tm w of
                (arghelp,Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
                (arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp)
                    ++ [makeColorTermLine commandColor $ unwords args]
        )
getCommands :: Terminal -> [TerminalCommand]
getCommands tm = _tmScrollCommands tm ++ _tmWriteCommands tm

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

argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
argumentHelp tc tm w = case _tcEffect tc tm w of
    NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
    OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
        , Just (M.keys argm) )

makeTermPara :: String -> [TerminalLine]
makeTermPara = map makeTermLine . makeParagraph 60

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

makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)

makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor

termTextColor :: Color
termTextColor = greyN 0.9

termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
  where
    termsound tm w = soundStart TerminalSound tpos sid Nothing w
      where
        tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos

infoCommand :: String -> TerminalCommand
infoCommand str = TerminalCommand
    { _tcString = "INFORMATION"
    , _tcAlias  = ["INFO","I"]
    , _tcHelp   = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
    , _tcEffect = \_ _ -> NoArguments (makeTermPara str)
    }

commandsCommand :: TerminalCommand
commandsCommand = TerminalCommand
    { _tcString = "COMMANDS"
    , _tcAlias  = ["COMMAND","COM"]
    , _tcHelp   = "DISPLAYS AVAILABLE COMMANDS."
    , _tcEffect = \tm _ -> NoArguments
        ( makeTermLine "AVAILABLE COMMANDS:"
        : makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
        )
    }

commandColor :: Color
commandColor = yellow

singleCommand :: [String] -> String -> [String] -> String -> (World -> World) -> TerminalCommand
singleCommand followingLines command aliases htext eff = TerminalCommand
    {_tcString = command
    ,_tcAlias = aliases
    ,_tcHelp = htext
    ,_tcEffect = \_ _ -> NoArguments $ TerminalLineEffect 0 (const eff) : map makeTermLine followingLines
    }

guardDisconnected :: Terminal -> World -> World -> World
guardDisconnected tm w w' = case _tmStatus tm of
    TerminalOff -> w
    TerminalBusy -> w
    TerminalReady -> w'

doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do
    s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
    if null (words s) 
        then Just $ defocusTerminalInput w 
        else return $ terminalReturnEffect tm w

terminalReturnEffect :: Terminal -> World -> World
terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do
    s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
    return $ runTerminalString s tm $ w
        & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]

commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
    (str,args)  <- safeUncons $ words s
    command     <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
    case _tcEffect command tm w of
        NoArguments tls -> Just tls
        OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]
            $ safeHead args >>= (m M.!?)
  where
    errline = makeColorTermLine red

runTerminalString :: String -> Terminal -> World -> World
runTerminalString s tm w = w & terminals . ix (_tmID tm) %~
    ( (tmInput .~ TerminalInput T.empty True (0,0))
    . (tmFutureLines ++.~ commandFutureLines s tm w)
    . (tmCommandHistory %~ take 10 . (s:))
    )

defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
    tmid <- w ^? hud . hudElement . subInventory . termID
    return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False

doCommandInstant :: String -> Terminal -> World -> World
doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w

-- doesn't do internal terminal effects
doLineEffectsInstant :: Terminal -> World -> [TerminalLine] -> World
doLineEffectsInstant tm = foldr f
  where
    f tl w = case tl of
        TerminalLineEffect _ eff -> eff tm w
        _ -> w

basicTerminal :: Terminal
basicTerminal = defaultTerminal
    {_tmDisplayedLines = []
    ,_tmFutureLines = []
    ,_tmMaxLines = 14
    ,_tmTitle = "TERMINAL"
    ,_tmInput   = defaultTerminalInput
    ,_tmScrollCommands = [quitCommand]
    ,_tmWriteCommands = [helpCommand,commandsCommand]
    ,_tmBootProgram = \_ _ -> connectionBlurb
    , _tmDeathEffect = doDeathTriggers
    }

lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal
    {_tmDisplayedLines = []
    ,_tmFutureLines = []
    ,_tmMaxLines = 14
    ,_tmTitle = "TERMINAL"
    ,_tmInput   = defaultTerminalInput
    ,_tmScrollCommands = [quitCommand]
    ,_tmWriteCommands = [helpCommand,commandsCommand]
    ,_tmBootProgram = \_ _ -> connectionBlurbLines tls
    , _tmDeathEffect = doDeathTriggers
    }

doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm w = w
    & triggers %~ flip (foldl' $ flip doDeathToggle) xs
  where
    xs = M.elems $ _tmToggles tm
doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ f

connectionBlurb :: [TerminalLine]
connectionBlurb = 
    [termSoundLine computerBeepingS
    ,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
    ,TerminalLineDisplay 10 (const ("...",termTextColor))
    ,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
    ,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]

connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
connectionBlurbLines tls = 
    [termSoundLine computerBeepingS
    ,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
    ,TerminalLineDisplay 10 (const ("...",termTextColor))
    ,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
    ] ++ tls ++
    [TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]