justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEffect.hs
+10 -10
View File
@@ -17,22 +17,22 @@ import System.Random
doWorldEffect :: WdWd -> World -> World
doWorldEffect we = case we of
NoWorldEffect -> id
SetTrigger bool tid -> triggers . ix tid .~ bool
SetLSCol col lsid -> lightSources . ix lsid . lsParam . lsCol .~ col
SetTrigger bool tid -> cWorld . triggers . ix tid .~ bool
SetLSCol col lsid -> cWorld . lightSources . ix lsid . lsParam . lsCol .~ col
AccessTerminal mtmid -> accessTerminal mtmid
WorldEffects wes -> \w -> foldr doWorldEffect 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 -> triggers . ix trid %~ not
WdWdNegateTrig trid -> cWorld . triggers . ix trid %~ not
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
& terminals . ix tmid . tmInput . tiFocus .~ True
& terminals . ix tmid %~ tryToBoot
Just tmid -> w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
& cWorld . terminals . ix tmid . tmInput . tiFocus .~ True
& cWorld . terminals . ix tmid %~ tryToBoot
where
tryToBoot tm = case _tmStatus tm of
TerminalReady -> tm
@@ -43,8 +43,8 @@ accessTerminal mtmid w = case mtmid of
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
| cid == 0 = set randGen g $ over cameraRot (+rot) w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w
where
(rot, g) = randomR (-x,x) $ _randGen w
@@ -78,7 +78,7 @@ lineOutputTerminal tls = defaultTerminal
doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm w = w
& triggers %~ flip (foldl' $ flip doDeathToggle) xs
& cWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
where
xs = M.elems $ _tmToggles tm
doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
@@ -102,7 +102,7 @@ doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd tmwdwd = case tmwdwd of
TmWdId -> const id
TmWdWdDisconnectTerminal -> disconnectTerminal
TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? cWorld . buttons . ix (_tmButtonID tm) . btPos
in soundStart TerminalSound tpos sid Nothing w
TmWdWdDoDeathTriggers -> doDeathTriggers
TmWdWdfromWdWd f -> \_ -> doWorldEffect f