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

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-07 14:20:13 +01:00
parent cc5d431d4c
commit c8c299cfb5
8 changed files with 61 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -17,7 +17,7 @@ import Data.Maybe
{- | The AI equivalent for your control. -}
yourControl :: Creature -> World -> World
yourControl cr w
| hasTerminalFocus w = w
| inTermFocus w = w
| otherwise = w
& creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
src/Dodge/Event.hs
+3 -3
View File
@@ -96,7 +96,7 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of
(DisplayCarte,_) -> w & clickMousePos .~ _mousePos w
(_,ButtonMiddle) -> w & clickMousePos .~ _mousePos w
( DisplayInventory (DisplayTerminal tmid) , ButtonLeft)
| hasTerminalFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w
| inTermFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w
| otherwise -> w & terminals . ix tmid . tmInput . tiFocus %~ const True
( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w
@@ -144,9 +144,9 @@ wheelEvent y w = case _hudElement $ _hud w of
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tmid)
| rbDown && hasTerminalFocus w -> w
| rbDown && inTermFocus w -> w
& terminals . ix tmid %~ updatetermsubsel
| hasTerminalFocus w -> w
| inTermFocus w -> w
& terminals . ix tmid %~ updatetermsel
_ -> w
where
src/Dodge/Event/Keyboard.hs
+12 -12
View File
@@ -64,14 +64,14 @@ handlePressedKey True ScancodeBackspace u
| otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1
handlePressedKey True _ u = return $ Just u
handlePressedKey _ scode u = case scode of
ScancodeF5 -> return . Just $ doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u
ScancodeF5 -> return . Just $ doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u
_ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid)
| hasTerminalFocus (_uvWorld u) -> return $ uvWorld (handlePressedKeyTerminal tmid scode) u
_ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u
_ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u)
-> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
_ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u
_ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u
handlePressedKeyInGame :: Scancode -> World -> World
handlePressedKeyInGame scode w = case scode of
@@ -88,14 +88,14 @@ handlePressedKeyInGame scode w = case scode of
_ -> w
handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
handlePressedKeyTerminal tmid scode w = case scode of
ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid)
ScancodeBackspace -> Just $ w
ScancodeEscape -> w & terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid)
ScancodeBackspace -> w
& terminals . ix tmid . tmInput . tiText %~ doBackspace
& backspaceTimer .~ 5
_ -> Just w
_ -> w
where
doBackspace t = case T.unsnoc t of
Nothing -> t
src/Dodge/InputFocus.hs
+2 -2
View File
@@ -4,8 +4,8 @@ import LensHelp
import Data.Maybe
hasTerminalFocus :: World -> Bool
hasTerminalFocus w = fromMaybe False $ do
inTermFocus :: World -> Bool
inTermFocus w = fromMaybe False $ do
tmid <- w ^? hud . hudElement . subInventory . termID
w ^? terminals . ix tmid . tmInput . tiFocus
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -48,7 +48,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
where
tparams = basicTerminal & tmScrollCommands .:~ sensorCommand
linksensortotrigger tp _ mc
= (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
= triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
themachine = defaultMachine & mcColor .~ aquamarine
& mcUpdate .~ mcProximitySensorUpdate
& mcDraw .~ terminalSPic
src/Dodge/Placement/Instance/Terminal.hs
+1 -4
View File
@@ -33,7 +33,7 @@ putTerminal''
putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
$ \tmpl -> Just $ ps0PushPS (PutButton termButton)
$ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
(mc & mcUpdate %~ (\fmu mc' -> (mcf (fromJust $ _plMID btpl) mc' . fmu mc')) . machineAddSound fridgeHumS
(mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
& mcDeath %~ (\fd mc' -> mcKillTerm mc' . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
) )
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
@@ -48,9 +48,6 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
btid = fromJust (_plMID btpl)
mcid = fromJust (_plMID mcpl)
mcKillLinked :: Machine -> World -> World
mcKillLinked mc = mcKillTerm mc
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
tmid <- _mcTermMID mc
src/Dodge/Room/LasTurret.hs
+2 -2
View File
@@ -16,7 +16,7 @@ import Dodge.Placement.Instance
import Dodge.Placement.Instance.Analyser
import Dodge.Default.Room
import Dodge.Item.Consumable
import Dodge.Machine
--import Dodge.Machine
--import Dodge.Item.Weapon.Utility
--import Dodge.LevelGen.Data
--import Geometry.Data
@@ -26,7 +26,7 @@ import Color
import Shape
import LensHelp
import Dodge.RandomHelp
import Dodge.SoundLogic
--import Dodge.SoundLogic
import qualified Data.Set as S
import Data.Maybe
src/Dodge/Terminal.hs
+39 -42
View File
@@ -13,7 +13,7 @@ import Data.Maybe
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import Text.Read
--import Text.Read
import Data.List (find)
quitCommand :: TerminalCommand
@@ -52,11 +52,6 @@ getDamageCoding = decodedtmap . _sensorCoding . _genParams
decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape)
-> M.Map String [TerminalLine]
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
where
f args _ w = fromMaybe (Left "") $ do
dtype <- safeHead args >>= readMaybe
dinfo <- _sensorCoding (_genParams w) M.!? dtype
return $ Right [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
sensorCommand :: TerminalCommand
sensorCommand = TerminalCommand
@@ -106,18 +101,24 @@ helpCommand :: TerminalCommand
helpCommand = TerminalCommand
{ _tcString = "HELP"
, _tcAlias = ["H","MAN"]
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"."
, _tcEffect = \tm w -> OneArgument "AN AVAILABLE COMMAND" $ getCommandsHelp tm w
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
, _tcEffect = \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
}
getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
getCommandsHelp tm w = fromMaybe mempty $ do
tcs <- getCommands tm w
return $ foldr f mempty tcs
--getCommandsHelp tm w = fromMaybe mempty $ do
-- tcs <- getCommands tm w
-- return $ foldr f mempty tcs
getCommandsHelp tm w = maybe mempty (foldr f mempty) (getCommands tm w)
where
f tc = M.insert (_tcString tc)
( [makeTermLine ("COMMAND:" ++ _tcString tc)
,makeTermLine ("ALIASES:" ++ unwords (_tcAlias tc)) ]
++ (makeTermPara $ _tcHelp tc)
( [makeTermLine "COMMAND:"
, makeColorTermLine yellow (_tcString tc)
,makeTermLine "ALIASES:"
, makeColorTermLine yellow ( unwords (_tcAlias tc)) ]
++ case argumentHelp tc tm w of
(arghelp,Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
(arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp)
++ [makeColorTermLine yellow $ unwords args]
)
getCommands :: Terminal -> World -> Maybe [TerminalCommand]
getCommands tm w = do
@@ -132,10 +133,11 @@ infoClearInput tm tls = terminals . ix (_tmID tm) %~
)
)
argumentHelp :: Maybe String -> String
argumentHelp mstr = case mstr of
Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED."
Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT."
argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
argumentHelp tc tm w = case _tcEffect tc tm w of
NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
, Just (M.keys argm) )
makeTermPara :: String -> [TerminalLine]
makeTermPara = map makeTermLine . makeParagraph 60
@@ -144,7 +146,7 @@ makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine white
makeTermLine = makeColorTermLine (greyN 0.9)
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
@@ -183,39 +185,34 @@ singleCommand followingLines command aliases htext eff = TerminalCommand
doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
if null (words s) then Just $ defocusTerminalInput w else return $ doTerminalEffect tm w
if null (words s)
then Just $ defocusTerminalInput w
else return $ terminalReturnEffect tm w
doTerminalEffect :: Terminal -> World -> World
doTerminalEffect tm w = fromMaybe w $ do
terminalReturnEffect :: Terminal -> World -> World
terminalReturnEffect tm w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
return $ doTerminalEffect' s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines .~ [makeColorTermLine (greyN 0.9) ('>':s)]
return $ runTerminalString s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]
commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
commandFutureLines s tm w = fromMaybe [] $ do
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
commands <- getCommands tm w
(str,args) <- safeUncons $ words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
case _tcEffect command tm w of
NoArguments tls -> Just tls
OneArgument argtype m -> case args of
(arg:_) -> M.lookup arg m
[] -> Just [makeColorTermLine red $ "^ INVALID ARGUMENT: EXPECTS "++ argtype ]
doTerminalEffect' :: String -> Terminal -> World -> World
doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
if null (words s) then Just $ defocusTerminalInput w else do
let futlines = commandFutureLines s tm w
return $ w & terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ futlines)
. (tmCommandHistory %~ take 10 . (s:))
)
OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]
$ safeHead args >>= (m M.!?)
where
badinput = terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ])
)
errline = makeColorTermLine red
runTerminalString :: String -> Terminal -> World -> World
runTerminalString s tm w = w & terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ commandFutureLines s tm w)
. (tmCommandHistory %~ take 10 . (s:))
)
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do