loop/src/Dodge/WorldEffect.hs

{-# LANGUAGE LambdaCase #-}

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

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
    AccessTerminal mtmid -> accessTerminal mtmid
    WorldEffects wes -> \w -> foldr doWdWd w wes
    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
    --    WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
    --        cr <- w ^? cWorld . lWorld . creatures . ix crid
    --        return $ doItCrWdWd f it cr w
    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 <- magMax 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