{-# LANGUAGE LambdaCase #-}

module Dodge.WorldEffect (
    doWdWd,
    accessTerminal,
    doTmWdWd,
) where

import Dodge.Item.MaxAmmo
import ShortShow
import Data.Traversable (mapAccumR)
import Dodge.Item.MagAmmoType
import qualified Data.IntSet as IS
import Dodge.Data.AmmoType
import Color
import Dodge.Terminal
import NewInt
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.BlBl
import Dodge.Creature.Impulse.UseItem
import Dodge.Data.Terminal.Status
import Dodge.Data.World
import Dodge.HeldUse
import Dodge.Inventory.Lock
import Dodge.Item.Grammar
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import qualified IntMapHelp as IM
import LensHelp
import System.Random

doWdWd :: WdWd -> World -> World
doWdWd = \case
    NoWorldEffect -> id
    SetTrigger bool tid -> cWorld . lWorld . triggers . ix tid .~ bool
    SetLSCol col lsid -> cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col
    SetTriggerAndSetLSCol bool tid col lsid -> (cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col)
             . (cWorld . lWorld . triggers . ix tid .~ bool)
    AccessTerminal mtmid -> accessTerminal mtmid
    UnlockInv -> unlockInv
    MakeStartCloudAt p -> makeCloudAt CryoReleaseCloud 400 p
    TorqueCr x cid -> torqueCr x cid
    SoundStart so p sid mi -> soundStart so p sid mi
    WdWdNegateTrig trid -> cWorld . lWorld . triggers . ix trid %~ not
    WdWdSetSoundFilter x -> wSoundFilter .~ x
    MakeTempLight _ 0 -> id
    MakeTempLight x t ->
        (cWorld . lWorld . lights .:~ x)
            . (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t -1))
    MakeTempLightFade _ _ 0 -> id
    MakeTempLightFade y x t ->
        (cWorld . lWorld . lights .:~ x)
            . (cWorld . lWorld . worldEvents 
                .:~ MakeTempLightFade y (x&lsCol . each -~ y) (t -1))
    UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
    WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
        cr <- w ^? cWorld . lWorld . creatures . ix cid
        loc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ cr ^. crInv) ^? ix (_unNInt invid) . _2
        return $ heldEffectMuzzles loc cr w

accessTerminal :: Int -> World -> World
accessTerminal tid w = fromMaybe w $ do
    tm <- w ^? cWorld . lWorld . terminals . ix tid
    guard (tm ^. tmStatus /= TerminalDeactivated)
    return $
        w & hud . subInventory .~ DisplayTerminal tid
            & cWorld . lWorld . terminals . ix tid %~ tryToBoot
  where
    tryToBoot tm = case _tmStatus tm of
        _ | tm ^. tmRebootOnAccess -> tm
                & tmFutureLines .~ _tmBootLines tm
                & tmStatus .~ TerminalLineRead
        TerminalTextInput{} -> tm
        TerminalLineRead -> tm
        TerminalPressTo{} -> tm
        TerminalOff ->
            tm
                & tmFutureLines .~ _tmBootLines tm
                & tmStatus .~ TerminalLineRead
        TerminalDeactivated -> error "managed to boot a deactivated terminal"

torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
    | cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w
    | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
  where
    (rot, g) = randomR (- x, x) $ _randGen w

doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm =
    (cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs)
        . (cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ TerminalDeactivated)
  where
    xs = M.elems $ _tmToggles tm

doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f

doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd = \case
    TmTmClearDisplayedLines -> \tm -> 
        cWorld . lWorld . terminals . ix (tm ^. tmID) . tmDisplayedLines .~ []
    TmTmSetStatus x -> \tm -> cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ x
    TmWdId -> const id
    TmWdWdPowerDownTerminal -> resetTerminal TerminalOff
    TmWdWdDeactivateTerminal -> resetTerminal TerminalDeactivated
    TmWdWdLeaveTerminal s -> leaveResetQuitTerminal s
    TmWdWdTermSound sid -> \tm w -> fromMaybe w $ do
        tpos <- w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
        return $ soundStart TerminalSound tpos sid Nothing w
    TmWdWdDoDeathTriggers -> doDeathTriggers
    TmWdWdfromWdWd f -> \_ -> doWdWd f
    TmDistributeAmmo -> tmDistributeAmmo

tmDistributeAmmo :: Terminal -> World -> World
tmDistributeAmmo tm w = fromMaybe w $ do
    let mid = tm ^. tmMachineID
    sid <- w ^? cWorld . lWorld . machines . ix mid 
        . mcType . mcdStorageMachine . _Just
    McStorage atype aamount <- w ^? cWorld . lWorld . machines . ix sid . mcType
    let (newaamount,w') = distributeAmmoToYou atype aamount w
    return $ w'
        & cWorld . lWorld . machines . ix sid . mcType . mcsAmount .~ newaamount
        & cWorld . lWorld . terminals . ix (tm ^. tmID) . tmFutureLines .~ 
            [TLine 1 [TerminalLineConst (g (aamount - newaamount)) white] TmWdId
            ,TLine 1 [TerminalLineConst (shortShow newaamount <>" "<>show atype<>" AVAILABLE") white] TmWdId
            ,TLine 1 [] (TmWdWdTermSound (getsid (aamount - newaamount)))
            ]
  where
    getsid x | x > 0 = reloadS
        | otherwise = reloadFailS
    g 0 = "NO SUITABLE RECIPIENTS"
    g _ = "SUCCESFUL"

distributeAmmoToYou :: AmmoType -> Int -> World -> (Int,World)
distributeAmmoToYou atype x w = fromMaybe (0,w) $ do
    is <- fmap IM.elems $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . unNIntMap
    let itms = IM.filter (\itm -> magAmmoType itm == Just atype) $
            IM.restrictKeys (w ^. cWorld . lWorld . items) (IS.fromList is)
        (x',itmams) = mapAccumR distributeAmmoToItem x itms
    return (x', IM.foldlWithKey' f w itmams)
  where
    f w' _ 0 = w'
    f w' i y = w' & cWorld . highlightItems . at i ?~ 20
        & cWorld . lWorld . items . ix i . itConsumables . _Just +~ y

distributeAmmoToItem :: Int -> Item -> (Int,Int)
distributeAmmoToItem x itm = fromMaybe (x,0) $ do
    m <- maxAmmo itm
    cur <- itm ^. itConsumables
    let d = m - cur
        t = max 0 $ min x d
    return (x-t,t)

resetTerminal :: TerminalStatus -> Terminal -> World -> World
resetTerminal x tm = 
    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ x)
        . (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
        . exitTerminalSubInv

leaveResetQuitTerminal :: String -> Terminal -> World -> World
leaveResetQuitTerminal s tm = 
    (cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines 
        .~ tlSetStatus (TerminalPressTo s) <> tlDoEffect (TmWdWdLeaveTerminal s))
        . exitTerminalSubInv

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