loop/src/Dodge/WorldEffect.hs

{-# LANGUAGE LambdaCase #-}

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

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.Default
import Dodge.HeldUse
import Dodge.Inventory.Lock
import Dodge.Item.Grammar
--import Dodge.Item.Location
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.WorldEvent.Cloud
import qualified IntMapHelp as IM
import LensHelp
import System.Random

doWdWd :: WdWd -> World -> World
doWdWd we = case we of
    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
    --    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))
    UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
    WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
        cr <- w ^? cWorld . lWorld . creatures . ix cid
        --itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
        loc <- invIndents (cr ^. crInv) ^? ix invid . _2
        return $ heldEffectMuzzles loc cr w

accessTerminal :: Int -> World -> World
accessTerminal tid =
    (hud . hudElement . subInventory .~ DisplayTerminal tid)
        . (cWorld . lWorld . terminals . ix tid %~ tryToBoot)
  where
    tryToBoot tm = case _tmStatus tm of
        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

lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls =
    defaultTerminal
        { _tmDisplayedLines = []
        , _tmFutureLines = []
        , _tmBootLines = connectionBlurbLines tls
        , _tmDeathEffect = TmWdWdDoDeathTriggers
        }

doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm = cWorld . lWorld . 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 %~ doBlBl f

doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd tmwdwd = case tmwdwd of
    TmTmClearDisplayedLines -> \tm -> fromMaybe id $ do
        tid <- tm ^? tmID
        return $ cWorld . lWorld . terminals . ix tid . tmDisplayedLines .~ []
    TmGetDamageCoding st -> \tm w -> fromMaybe w $ do
        tid <- tm ^? tmID
        return $
            w & cWorld . lWorld . terminals . ix tid . tmFutureLines
                .~ decodeSensorType st w
    TmGetSensor s -> \tm w -> fromMaybe w $ do
        tid <- tm ^? tmID
        return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines .~ getSensorInfo w tm s
    TmTmSetStatus x -> \tm -> fromMaybe id $ do
        tid <- tm ^? tmID
        return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
    --    TmDisplayCommands -> \tm -> fromMaybe id $ do
    --        tid <- tm ^? tmID
    --        return $ cWorld . lWorld . terminals . ix tid %~ tabComplete ""
    --return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~
    --    makeColorTermPara commandColor
    --        (unwords (map fst (PTE.toList $ getCommands tm)))
    --    TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do
    --        tid <- tm ^? tmID
    --        return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
    TmWdId -> const id
    TmWdWdPowerDownTerminal -> powerDownTerminal
    TmWdWdDeactivateTerminal -> deactivateTerminal
    TmWdWdTermSound sid -> \tm w ->
        let tpos = fromMaybe 0 $ w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
         in soundStart TerminalSound tpos sid Nothing w
    TmWdWdDoDeathTriggers -> doDeathTriggers
    TmWdWdfromWdWd f -> \_ -> doWdWd f

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

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

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

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

-- ugly, when changing check sensorCommand
getSensorInfo :: World -> Terminal -> String -> [TerminalLine]
getSensorInfo w tm = \case
    "REQUIREMENT" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . proxRequirement
    "DISTANCE" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . proxDist
    "STATUS" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . sensToggle
    _ -> []
  where
    f s = [makeTermLine $ show s]