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