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

Cleanup, split CWorld into separate file

Browse Source
This commit is contained in:
justin
2022-07-26 21:19:12 +01:00
parent c2707719fb
commit 6554d219dc
27 changed files with 1049 additions and 911 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEffect.hs
+57 -46
View File
@@ -1,55 +1,67 @@
module Dodge.WorldEffect where
import Dodge.Terminal
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Dodge.Data
import Dodge.Inventory.Lock
import Dodge.Default
import LensHelp
import Data.Maybe
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Creature.Impulse.UseItem
import Dodge.Data
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
doWorldEffect :: WdWd -> World -> World
doWorldEffect we = case we of
doWdWd :: WdWd -> World -> World
doWdWd we = case we of
NoWorldEffect -> id
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
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 . triggers . ix trid %~ not
WdWdFromItixCrixWdWd itid crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . creatures . ix crid
it <- getItem itid w
return $ doItCrWdWd f it cr w
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . creatures . ix crid
return $ doItCrWdWd f it cr w
doItCrWdWd :: ItCrWdWd -> Item -> Creature -> World -> World
doItCrWdWd icww = case icww of
ItCrWdId -> \_ _ -> id
ItCrWdItemEffect -> flip itemEffect
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
& cWorld . terminals . ix tmid . tmInput . tiFocus .~ True
& cWorld . 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
TerminalBusy -> tm
TerminalOff -> tm
& tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w
& tmStatus .~ TerminalBusy
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 (cWorld . cameraRot) (+rot) w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w
where
(rot, g) = randomR (-x,x) $ _randGen 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
doCommandInstant :: String -> Terminal -> World -> World
doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w
@@ -62,25 +74,27 @@ doLineEffectsInstant tm = foldr f
TerminalLineEffect _ eff -> doTmWdWd eff tm w
_ -> w
lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = defaultTerminalInput
,_tmScrollCommands = [quitCommand]
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmBootProgram = TerminalBootLines $ connectionBlurbLines tls
, _tmDeathEffect = TmWdWdDoDeathTriggers
}
lineOutputTerminal tls =
defaultTerminal
{ _tmDisplayedLines = []
, _tmFutureLines = []
, _tmMaxLines = 14
, _tmTitle = "TERMINAL"
, _tmInput = defaultTerminalInput
, _tmScrollCommands = [quitCommand]
, _tmWriteCommands = [helpCommand, commandsCommand]
, _tmBootProgram = TerminalBootLines $ connectionBlurbLines tls
, _tmDeathEffect = TmWdWdDoDeathTriggers
}
doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm w = w
& cWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
doDeathTriggers tm w =
w
& cWorld . 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
@@ -90,20 +104,17 @@ doBlBl bb = case bb of
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 . buttons . ix (_tmButtonID tm) . btPos
in soundStart TerminalSound tpos sid Nothing w
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
TmWdWdfromWdWd f -> \_ -> doWdWd f