{-# 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]