112 lines
4.3 KiB
Haskell
112 lines
4.3 KiB
Haskell
--{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.WorldEffect (
|
|
doWdWd,
|
|
accessTerminal,
|
|
doTmWdWd,
|
|
) where
|
|
|
|
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 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 (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
|
|
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 tmwdwd = case tmwdwd of
|
|
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
|
|
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
|
|
|
|
resetTerminal :: TerminalStatus -> Terminal -> World -> World
|
|
resetTerminal x tm =
|
|
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ x)
|
|
. (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
|
|
. exitTerminalSubInv
|
|
|
|
exitTerminalSubInv :: World -> World
|
|
exitTerminalSubInv w = case w ^? hud . subInventory . termID of
|
|
Just _ -> w & hud . subInventory .~ NoSubInventory
|
|
_ -> w
|