Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 56786e7a07 |
File diff suppressed because one or more lines are too long
@@ -29,7 +29,6 @@ data MouseContext
|
||||
| OverCombFilter
|
||||
| OverCombEscape
|
||||
| OverTerminalReturn {_mcoTermID :: Int}
|
||||
| OverTerminalContinue {_mcoTermID :: Int}
|
||||
| OverTerminalEscape
|
||||
| MouseGameRotate
|
||||
deriving (Show)
|
||||
|
||||
@@ -36,6 +36,7 @@ data Terminal = Terminal
|
||||
, _tmStatus :: TerminalStatus
|
||||
, _tmCommandHistory :: [String]
|
||||
, _tmToggles :: M.Map String TerminalToggle
|
||||
-- , _tmPartialCommand :: Maybe TerminalCommand
|
||||
}
|
||||
|
||||
data TerminalLineString = TerminalLineConst String Color
|
||||
@@ -76,7 +77,7 @@ data TerminalCommandEffect
|
||||
-- , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
|
||||
-- }
|
||||
|
||||
data TCom = TCInfo String String -- this may not be necessary, to revisit
|
||||
data TCom = TCInfo String String
|
||||
| TCBase
|
||||
| TCDamageCommand
|
||||
| TCSensorInfo
|
||||
|
||||
@@ -9,7 +9,7 @@ import Data.Aeson.TH
|
||||
|
||||
data TerminalStatus
|
||||
= TerminalOff
|
||||
| TerminalLineRead
|
||||
| TerminalBusy
|
||||
| TerminalTextInput {_tiText :: String}
|
||||
| TerminalPressTo {_tptString :: String}
|
||||
deriving (Eq)
|
||||
|
||||
@@ -20,7 +20,7 @@ data ItCrWdWd = ItCrWdItemHeldEffect
|
||||
data WdWd
|
||||
= NoWorldEffect
|
||||
| SetTrigger Bool Int
|
||||
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
|
||||
| WorldEffects [WdWd]
|
||||
| SetLSCol Point3 Int
|
||||
| AccessTerminal (Maybe Int)
|
||||
| UnlockInv
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Dodge.Debug.Terminal where
|
||||
module Dodge.Debug.Console where
|
||||
|
||||
import Data.Foldable
|
||||
import Dodge.Item.Location.Initialize
|
||||
@@ -19,14 +19,14 @@ import LensHelp
|
||||
import MaybeHelp
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
applyTerminalString :: [String] -> Universe -> Universe
|
||||
applyTerminalString ss = case ss of
|
||||
applyConsoleString :: [String] -> Universe -> Universe
|
||||
applyConsoleString ss = case ss of
|
||||
[] -> id
|
||||
[s] -> applyTerminalCommand s
|
||||
(s : ss') -> applyTerminalCommandArguments s ss'
|
||||
[s] -> applyConsoleCommand s
|
||||
(s : ss') -> applyConsoleCommandArguments s ss'
|
||||
|
||||
applyTerminalCommand :: String -> Universe -> Universe
|
||||
applyTerminalCommand s = case s of
|
||||
applyConsoleCommand :: String -> Universe -> Universe
|
||||
applyConsoleCommand s = case s of
|
||||
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
|
||||
['L', x] ->
|
||||
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
|
||||
@@ -39,8 +39,8 @@ applyTerminalCommand s = case s of
|
||||
(ibt, n) <- parseItem [x]
|
||||
return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
||||
|
||||
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
|
||||
applyTerminalCommandArguments command args u = case command of
|
||||
applyConsoleCommandArguments :: String -> [String] -> Universe -> Universe
|
||||
applyConsoleCommandArguments command args u = case command of
|
||||
"IT" -> fromMaybe u $ do
|
||||
(ibt, n) <- parseItem args
|
||||
return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
||||
@@ -75,33 +75,33 @@ parseItem [] = Nothing
|
||||
parseNum :: [String] -> Int
|
||||
parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
|
||||
|
||||
showTerminalError :: String -> String -> Universe -> Universe
|
||||
showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s
|
||||
showConsoleError :: String -> String -> Universe -> Universe
|
||||
showConsoleError cmd s = uvScreenLayers .:~ InputScreen cmd s
|
||||
|
||||
applySetTerminalString :: String -> Universe -> Universe
|
||||
applySetTerminalString [] = id
|
||||
applySetTerminalString var = case key' of
|
||||
"" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
||||
applySetConsoleString :: String -> Universe -> Universe
|
||||
applySetConsoleString [] = id
|
||||
applySetConsoleString var = case key' of
|
||||
"" -> showConsoleError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
||||
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
||||
-- "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
||||
-- "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
|
||||
-- "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
|
||||
"mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
|
||||
_ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
||||
_ -> showConsoleError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
||||
where
|
||||
(key, val) = getSplitString var
|
||||
val' = readMaybe val :: Maybe Float
|
||||
key' = if isNothing val' then "" else key
|
||||
|
||||
--autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
|
||||
--autoCompleteTerminal s _ =
|
||||
--autoCompleteConsole :: String -> String -> Universe -> IO (Maybe Universe)
|
||||
--autoCompleteConsole s _ =
|
||||
-- return
|
||||
-- . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
|
||||
-- where
|
||||
-- (key, val) = getSplitString $ tail s
|
||||
-- command_options = case val of
|
||||
-- "" -> filter (isInfixOf key) (validTerminalCommands "")
|
||||
-- _ -> filter (isInfixOf val) (validTerminalCommands key)
|
||||
-- "" -> filter (isInfixOf key) (validConsoleCommands "")
|
||||
-- _ -> filter (isInfixOf val) (validConsoleCommands key)
|
||||
-- -- basic autocomplete if single option available (or as far as possible)
|
||||
-- input_str = case (key, val) of
|
||||
-- (_, "") ->
|
||||
@@ -117,7 +117,7 @@ applySetTerminalString var = case key' of
|
||||
-- else ">" ++ key ++ " " ++ longestCommonPrefix command_options
|
||||
-- command_options' =
|
||||
-- if not (null command_options) && head command_options == key
|
||||
-- then validTerminalCommands key
|
||||
-- then validConsoleCommands key
|
||||
-- else command_options
|
||||
--
|
||||
-- --val' = Debug.Trace.trace key tail val
|
||||
@@ -129,12 +129,12 @@ getSplitString str = case break (== ' ') str of
|
||||
(a, _) -> (a, "")
|
||||
|
||||
isValidCommand :: String -> String -> Bool
|
||||
isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
|
||||
|
||||
validTerminalCommands :: String -> [String]
|
||||
validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
|
||||
validTerminalCommands "god" = ["on", "off"]
|
||||
validTerminalCommands _ = ["set", "spawn", "god"]
|
||||
isValidCommand arg1 arg2 = arg2 `elem` validConsoleCommands arg1
|
||||
validConsoleCommands :: String -> [String]
|
||||
validConsoleCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
|
||||
validConsoleCommands "god" = ["on", "off"]
|
||||
validConsoleCommands _ = ["set", "spawn", "god"]
|
||||
validConsoleCommands _ = ["set", "spawn", "god"]
|
||||
|
||||
loadme :: a
|
||||
loadme = undefined
|
||||
@@ -16,7 +16,7 @@ defaultTerminal =
|
||||
, _tmMachineID = 0
|
||||
, _tmDisplayedLines = []
|
||||
, _tmFutureLines = []
|
||||
, _tmCommands = [TCBase]
|
||||
, _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
|
||||
, _tmDeathEffect = TmWdWdDoDeathTriggers
|
||||
, _tmStatus = TerminalOff
|
||||
, _tmCommandHistory = []
|
||||
|
||||
@@ -383,11 +383,17 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
|
||||
$ _tmDisplayedLines tm
|
||||
displayTermInput tm = case _tmStatus tm of
|
||||
TerminalOff -> id
|
||||
TerminalLineRead -> id
|
||||
TerminalBusy -> (++ [([cFilledRect], white)])
|
||||
TerminalTextInput s ->
|
||||
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
|
||||
TerminalPressTo s ->
|
||||
(++ [(getPromptTM ++ "PRESS TO "++s, white)])
|
||||
(++ [("PRESS TO "++s, white)])
|
||||
-- partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
|
||||
-- displayInputText tm s
|
||||
-- | TerminalTextInput <- _tmStatus tm = getPromptTM ++ s
|
||||
---- | _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM ++ s
|
||||
-- | otherwise = ""
|
||||
|
||||
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
|
||||
|
||||
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
|
||||
|
||||
@@ -109,7 +109,6 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
|
||||
OverCombFilter{} -> drawJumpDown 5
|
||||
OverCombCombine{} -> drawGapPlus 5
|
||||
OverCombEscape -> rotate (pi / 4) $ drawPlus 5
|
||||
OverTerminalContinue{} -> drawReturn 5
|
||||
OverTerminalReturn{} -> drawReturn 5
|
||||
OverTerminalEscape -> rotate (pi / 4) $ drawPlus 5
|
||||
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Dodge.Room.RezBox where
|
||||
|
||||
import Dodge.Default.Terminal
|
||||
import Dodge.Terminal
|
||||
import Control.Monad
|
||||
import qualified Data.Set as S
|
||||
@@ -26,14 +25,12 @@ rezBox :: LightSource -> Room
|
||||
rezBox ls =
|
||||
roomRect 40 60 1 1
|
||||
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
|
||||
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
|
||||
, putMessageTerminal terminalColor (simpleTermMessage ["HELLOW","THIS"])
|
||||
& plSpot .~ PS (V2 20 0) 0
|
||||
]
|
||||
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
||||
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
||||
& rmName .~ "rezBox"
|
||||
where
|
||||
s = "RESPAWN POINT SET AT THIS LOCATION."
|
||||
|
||||
rezBox' :: RandomGen g => State g (MetaTree Room String)
|
||||
rezBox' = do
|
||||
|
||||
+18
-13
@@ -1,7 +1,12 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Dodge.Terminal (
|
||||
-- doTerminalCommandEffect,
|
||||
makeTermLine,
|
||||
-- commandFutureLines,
|
||||
-- quitCommand,
|
||||
-- helpCommand,
|
||||
-- commandsCommand,
|
||||
connectionBlurbLines,
|
||||
disconnectTerminal,
|
||||
textTerminal,
|
||||
@@ -16,7 +21,6 @@ module Dodge.Terminal (
|
||||
makeColorTermPara,
|
||||
commandColor,
|
||||
tabComplete,
|
||||
tlSetStatus,
|
||||
) where
|
||||
|
||||
--import Dodge.Data.WorldEffect
|
||||
@@ -154,7 +158,9 @@ helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
|
||||
helpStrings :: PTE.TrieMap Char String
|
||||
helpStrings =
|
||||
PTE.fromList
|
||||
[ ("", "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE.")
|
||||
[ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE [TAB] FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
|
||||
, ("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
|
||||
, ("QUIT", "SHUTDOWN TERMINAL.")
|
||||
]
|
||||
|
||||
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
@@ -163,9 +169,6 @@ quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnec
|
||||
makeTermLine :: String -> TerminalLine
|
||||
makeTermLine = makeColorTermLine termTextColor
|
||||
|
||||
tlSetStatus :: TerminalStatus -> [TerminalLine]
|
||||
tlSetStatus x = [TLine 1 [] $ TmTmSetStatus x]
|
||||
|
||||
makeTermPara :: String -> [TerminalLine]
|
||||
makeTermPara = makeColorTermPara termTextColor
|
||||
|
||||
@@ -189,13 +192,12 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
|
||||
a = fromMaybe "" $ ss ^? ix 1
|
||||
f y m' = case fmap fst m' of
|
||||
[] -> tm
|
||||
[x] -> tm & tmStatus . tiText .~ (y ++ x)
|
||||
[x] -> tm & tmStatus .~ TerminalTextInput (y ++ x)
|
||||
xs ->
|
||||
tm & tmStatus .~ TerminalLineRead
|
||||
& tmFutureLines
|
||||
.~ (makeColorTermPara
|
||||
tm & tmFutureLines
|
||||
.~ makeColorTermPara
|
||||
commandColor
|
||||
(unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
|
||||
(unwords xs)
|
||||
|
||||
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
|
||||
--doTerminalCommandEffect tce = case tce of
|
||||
@@ -272,7 +274,8 @@ disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm =
|
||||
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
|
||||
. exitTerminalSubInv
|
||||
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
|
||||
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
|
||||
.~ [TLine 0 [] TmTmClearDisplayedLines]
|
||||
)
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
@@ -339,9 +342,11 @@ terminalReturnEffect tmid w = fromMaybe w $ do
|
||||
runTerminalInput :: String -> Terminal -> World -> World
|
||||
runTerminalInput s tm w =
|
||||
w & cWorld . lWorld . terminals . ix (_tmID tm)
|
||||
%~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
|
||||
%~ ( --(tmInput .~ TerminalInput{ _tiSel = (0, 0)})
|
||||
|
||||
(tmFutureLines ++.~ ss)
|
||||
. (tmCommandHistory %~ take 10 . (s :))
|
||||
. (tmStatus .~ TerminalLineRead)
|
||||
. (tmStatus .~ TerminalTextInput "")
|
||||
)
|
||||
where
|
||||
ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
|
||||
|
||||
@@ -12,4 +12,4 @@ termScreenColor tm = case tm ^. tmStatus of
|
||||
TerminalOff -> Nothing
|
||||
TerminalTextInput _ -> Just green
|
||||
TerminalPressTo{} -> Just green
|
||||
TerminalLineRead -> Just white
|
||||
TerminalBusy -> Just white
|
||||
|
||||
+34
-41
@@ -7,6 +7,10 @@ Description : Simulation update
|
||||
-}
|
||||
module Dodge.Update (updateUniverse) where
|
||||
|
||||
import Dodge.SpawnAt
|
||||
import Dodge.Prop.Moving
|
||||
import Dodge.WorldEvent.Explosion
|
||||
import Dodge.Data.Object
|
||||
import Color
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
@@ -23,7 +27,6 @@ import Dodge.Creature.Radius
|
||||
import Dodge.Creature.Update
|
||||
import Dodge.Damage
|
||||
import Dodge.Data.CrWlID
|
||||
import Dodge.Data.Object
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Debug
|
||||
import Dodge.DisplayInventory
|
||||
@@ -41,7 +44,6 @@ import Dodge.Machine.Update
|
||||
import Dodge.ModificationEffect
|
||||
import Dodge.PressPlate
|
||||
import Dodge.Projectile.Update
|
||||
import Dodge.Prop.Moving
|
||||
import Dodge.Prop.Update
|
||||
import Dodge.RadarBlip
|
||||
import Dodge.RadarSweep
|
||||
@@ -52,7 +54,6 @@ import Dodge.Shockwave.Update
|
||||
import Dodge.SmoothScroll
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Spark
|
||||
import Dodge.SpawnAt
|
||||
import Dodge.Terminal.Type
|
||||
import Dodge.TractorBeam.Update
|
||||
import Dodge.Update.Camera
|
||||
@@ -63,7 +64,6 @@ import Dodge.Update.Scroll
|
||||
import Dodge.Update.WallDamage
|
||||
import Dodge.WallCreatureCollisions
|
||||
import Dodge.WorldEffect
|
||||
import Dodge.WorldEvent.Explosion
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
import Dodge.Zoning.Cloud
|
||||
import Dodge.Zoning.Creature
|
||||
@@ -467,27 +467,27 @@ updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
|
||||
updatePulseBall :: PulseBall -> World -> World
|
||||
updatePulseBall pb w
|
||||
| Just (_, ecrwl) <- thit =
|
||||
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
|
||||
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
|
||||
& cWorld . lWorld %~ dodam ecrwl
|
||||
| pb ^. pbTimer <= 0 =
|
||||
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
|
||||
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
|
||||
| otherwise =
|
||||
w & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
|
||||
w & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
|
||||
& cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbPos .~ ep
|
||||
& pbFlicker pb
|
||||
where
|
||||
dodam = \case
|
||||
Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
|
||||
Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
|
||||
thedam = Lasering 100 ep (pb ^. pbVel)
|
||||
thedam = Lasering 100 ep (pb ^. pbVel)
|
||||
sp = pb ^. pbPos
|
||||
ep = sp + pb ^. pbVel
|
||||
thit = thingHit sp ep w
|
||||
|
||||
pbFlicker :: PulseBall -> World -> World
|
||||
pbFlicker pt =
|
||||
cWorld . lWorld . lights
|
||||
.:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
|
||||
cWorld . lWorld . lights
|
||||
.:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
|
||||
where
|
||||
d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
|
||||
|
||||
@@ -501,23 +501,20 @@ displayTerminalLineString :: TerminalLineString -> (String, Color)
|
||||
displayTerminalLineString (TerminalLineConst str col) = (str, col)
|
||||
|
||||
tmUpdate :: Terminal -> World -> World
|
||||
tmUpdate tm w = fromMaybe w $ do
|
||||
guard $ tm ^. tmStatus == TerminalLineRead
|
||||
tl <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0
|
||||
return $ case tl of
|
||||
_ | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
|
||||
(TLine _ tls g) ->
|
||||
w & pointTermParams
|
||||
%~ ( (tmFutureLines %~ tail)
|
||||
. (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
|
||||
)
|
||||
& doTmWdWd g tm
|
||||
tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
|
||||
Nothing -> w
|
||||
Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
|
||||
Just (TLine _ tls g) ->
|
||||
w & pointTermParams
|
||||
%~ ( (tmFutureLines %~ tail)
|
||||
. (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
|
||||
)
|
||||
& doTmWdWd g tm
|
||||
-- Just (TerminalLineEffect _ eff) ->
|
||||
-- w
|
||||
-- & pointTermParams . tmFutureLines %~ tail
|
||||
-- & doTmWdWd eff tm
|
||||
where
|
||||
-- Just (TerminalLineEffect _ eff) ->
|
||||
-- w
|
||||
-- & pointTermParams . tmFutureLines %~ tail
|
||||
-- & doTmWdWd eff tm
|
||||
|
||||
pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm)
|
||||
|
||||
setOldPos :: Creature -> Creature
|
||||
@@ -644,24 +641,22 @@ updatePulseLaser pz = case pz ^. pzTimer of
|
||||
5 -> (Endo f, [pz & pzTimer -~ 1])
|
||||
_ -> (Endo g, [pz & pzTimer -~ 1])
|
||||
where
|
||||
f w =
|
||||
dodam
|
||||
thHit
|
||||
f w = dodam thHit
|
||||
w
|
||||
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
|
||||
where
|
||||
(thHit, ps) = reflectPulseLaserAlong phasev sp xp w
|
||||
dodam thit = case thit of
|
||||
((p, OCreature cr) : _) ->
|
||||
cWorld . lWorld . creatures . ix (_crID cr) . crDamage
|
||||
((p, OCreature cr):_) ->
|
||||
cWorld . lWorld . creatures . ix (_crID cr) . crDamage
|
||||
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
|
||||
((p, OWall wl) : _) ->
|
||||
((p, OWall wl):_) ->
|
||||
cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
|
||||
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
|
||||
((_, OPulseBall pb) : xs) ->
|
||||
dodam xs
|
||||
. (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
|
||||
. makeExplosionAt (_pbPos pb `v2z` 20) 0
|
||||
((_, OPulseBall pb):xs) -> dodam xs
|
||||
.
|
||||
(cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
|
||||
. makeExplosionAt (_pbPos pb `v2z` 20) 0
|
||||
_ -> id
|
||||
phasev = _pzPhaseV pz
|
||||
sp = _pzPos pz
|
||||
@@ -801,11 +796,9 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w
|
||||
|
||||
checkEndGame :: Universe -> Universe
|
||||
checkEndGame uv = case w ^? timeFlow . respawnDelay of
|
||||
Just x
|
||||
| x < 0 ->
|
||||
uv -- & uvScreenLayers .~ [gameOverMenu uv]
|
||||
& uvWorld . timeFlow .~ NormalTimeFlow
|
||||
& uvWorld %~ respawn
|
||||
Just x | x < 0 -> uv -- & uvScreenLayers .~ [gameOverMenu uv]
|
||||
& uvWorld . timeFlow .~ NormalTimeFlow
|
||||
& uvWorld %~ respawn
|
||||
Just _ -> uv & uvWorld . timeFlow . respawnDelay -~ 1
|
||||
_ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ RespawnDelay 50
|
||||
_ -> uv
|
||||
|
||||
@@ -219,7 +219,6 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
|
||||
OverInvSelect x -> startDrag x cfig w
|
||||
OverTerminalReturn tmid -> terminalReturnEffect tmid w
|
||||
OverTerminalContinue tmid -> undefined
|
||||
OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
OverCombSelect x ->
|
||||
w & hud . hudElement . subInventory . ciSelection ?~ f x
|
||||
@@ -382,19 +381,7 @@ updateFunctionKey uv ScancodeF4 _ = doDebugTest2 uv
|
||||
updateFunctionKey uv _ _ = uv
|
||||
|
||||
updateKeysInTerminal :: Int -> Universe -> Universe
|
||||
updateKeysInTerminal tmid u = fromMaybe u $ do
|
||||
tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
|
||||
return $ case tm ^. tmStatus of
|
||||
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
|
||||
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
|
||||
_ -> u
|
||||
updateKeyContinueTerminal :: Int -> Universe -> Universe
|
||||
updateKeyContinueTerminal tmid u
|
||||
| any (==0) $ u ^. uvWorld . input . pressedKeys =
|
||||
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
|
||||
| otherwise = u
|
||||
updateKeysTextInputTerminal :: Int -> Universe -> Universe
|
||||
updateKeysTextInputTerminal tmid u =
|
||||
updateKeysInTerminal tmid u =
|
||||
u
|
||||
& doTextInputOverUniverse
|
||||
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)
|
||||
|
||||
@@ -11,7 +11,7 @@ import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Dodge.Data.ScreenPos
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Debug.Terminal
|
||||
import Dodge.Debug.Console
|
||||
import Dodge.Menu.Option
|
||||
import Dodge.SelectionList
|
||||
import Dodge.Update.Input.Text
|
||||
@@ -34,7 +34,7 @@ doInputScreenInput s u =
|
||||
checkEndStatus
|
||||
| ispressed ScancodeReturn =
|
||||
(uvScreenLayers %~ tail)
|
||||
. applyTerminalString (words $ map toUpper s)
|
||||
. applyConsoleString (words $ map toUpper s)
|
||||
. (uvWorld . worldEventFlags . at InventoryChange ?~ ())
|
||||
| ispressed ScancodeEscape = uvScreenLayers %~ tail
|
||||
| otherwise = id
|
||||
|
||||
@@ -60,12 +60,12 @@ accessTerminal mtmid w = fromMaybe w $ do
|
||||
where
|
||||
tryToBoot tm = case _tmStatus tm of
|
||||
TerminalTextInput{} -> tm
|
||||
TerminalLineRead -> tm
|
||||
TerminalBusy -> tm
|
||||
TerminalPressTo{} -> tm
|
||||
TerminalOff ->
|
||||
tm
|
||||
& tmFutureLines .~ _tmBootLines tm
|
||||
& tmStatus .~ TerminalLineRead
|
||||
& tmStatus .~ TerminalBusy
|
||||
|
||||
torqueCr :: Float -> Int -> World -> World
|
||||
torqueCr x cid w
|
||||
|
||||
Reference in New Issue
Block a user