118 lines
4.1 KiB
Haskell
118 lines
4.1 KiB
Haskell
module Dodge.WorldEffect (
|
|
doWdWd,
|
|
accessTerminal,
|
|
doTmWdWd,
|
|
lineOutputTerminal,
|
|
) where
|
|
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Data.Foldable
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.Data.World
|
|
import Dodge.Default
|
|
import Dodge.Inventory.Lock
|
|
--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 cid -> unlockInv cid
|
|
MakeStartCloudAt p -> makeStartCloudAt 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
|
|
--WdWdFromItixCrixWdWd itid crid f -> \w -> fromMaybe w $ do
|
|
WdWdFromItixCrixWdWd _ crid f -> \w -> fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix crid
|
|
--it <- getItem itid w
|
|
itRef <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
|
|
it <- invTrees (_crInv cr) ^? ix itRef
|
|
return $ doItCrWdWd f it cr w
|
|
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix crid
|
|
return $ doItCrWdWd f it cr w
|
|
|
|
doItCrWdWd :: ItCrWdWd -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
doItCrWdWd icww = case icww of
|
|
ItCrWdId -> \_ _ -> id
|
|
ItCrWdItemEffect -> flip itemEffect
|
|
|
|
accessTerminal :: Maybe Int -> World -> World
|
|
accessTerminal mtmid w = fromMaybe w $ do
|
|
tmid <- mtmid
|
|
return $
|
|
w & hud . hudElement . subInventory .~ DisplayTerminal tmid
|
|
& cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True
|
|
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
|
|
where
|
|
tryToBoot tm = case _tmStatus tm of
|
|
TerminalReady -> tm
|
|
TerminalBusy -> tm
|
|
TerminalOff ->
|
|
tm
|
|
& tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w
|
|
& tmStatus .~ TerminalBusy
|
|
|
|
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 = []
|
|
, _tmMaxLines = 14
|
|
, _tmTitle = "TERMINAL"
|
|
, _tmScrollCommands = [quitCommand]
|
|
, _tmWriteCommands = [helpCommand, commandsCommand]
|
|
, _tmBootProgram = TerminalBootLines $ 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
|
|
|
|
doBlBl :: BlBl -> Bool -> Bool
|
|
doBlBl bb = case bb of
|
|
BlNegate -> not
|
|
BlConst bl -> const bl
|
|
BlId -> id
|
|
|
|
doTerminalBootProgram :: TerminalBootProgram -> Terminal -> World -> [TerminalLine]
|
|
doTerminalBootProgram tbp = case tbp of
|
|
TerminalBootMempty -> \_ _ -> []
|
|
TerminalBootLines ls -> \_ _ -> ls
|
|
|
|
doTmWdWd :: TmWdWd -> Terminal -> World -> World
|
|
doTmWdWd tmwdwd = case tmwdwd of
|
|
TmWdId -> const id
|
|
TmWdWdDisconnectTerminal -> disconnectTerminal
|
|
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
|