175 lines
6.9 KiB
Haskell
175 lines
6.9 KiB
Haskell
{-# 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
|
|
--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 = \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)))
|
|
,TLine 1 [TerminalLineConst "" yellow] (TmTmSetStatus (TerminalPressTo ""))
|
|
,TLine 1 [TerminalLineConst "" white] TmWdWdPowerDownTerminal
|
|
]
|
|
where
|
|
getsid x | x > 0 = reloadS
|
|
| otherwise = dedumS
|
|
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
|