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-02 09:29:44 +01:00
parent b6e2b6ef21
commit 98cb8f2264
8 changed files with 57 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+10 -2
View File
@@ -95,6 +95,7 @@ data World = World
, _walls :: IM.IntMap Wall
, _doors :: IM.IntMap Door
, _machines :: IM.IntMap Machine
, _terminals :: IM.IntMap Terminal
, _magnets :: IM.IntMap Magnet
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
@@ -390,7 +391,8 @@ data TerminalParams = NoTerminalParams | TerminalParams
, _termSel :: Maybe (Int,Int)
-- , _termOptions :: [(String, World -> World)]
, _termInput :: Maybe T.Text
, _termCommands :: [TerminalCommand]
, _termScrollCommands :: [TerminalCommand]
, _termWriteCommands :: [TerminalCommand]
}
data TerminalLine
= TerminalLineDisplay
@@ -403,7 +405,8 @@ data TerminalLine
-- }
| TerminalLineInput
{_tlPause :: Int
,_tlCommands :: [TerminalCommand]
,_tlScrollCommands :: [TerminalCommand]
,_tlWriteCommands :: [TerminalCommand]
}
| TerminalLineEffect
{_tlPause :: Int
@@ -908,6 +911,10 @@ data Block = Block
, _blMaterial :: BlockMaterial
}
data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
data Terminal = Terminal
{ _tmID :: Int
, _tmParams :: TerminalParams
}
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
@@ -1358,6 +1365,7 @@ makeLenses ''CrMvType
makeLenses ''Intention
makeLenses ''Door
makeLenses ''Block
makeLenses ''Terminal
makeLenses ''Machine
makeLenses ''MachineType
makeLenses ''Zone
src/Dodge/Default/World.hs
+9 -8
View File
@@ -43,6 +43,7 @@ defaultWorld = World
, _walls = IM.empty
, _blocks = IM.empty
, _machines = IM.empty
, _terminals = IM.empty
, _doors = IM.empty
, _coordinates = IM.empty
, _triggers = IM.empty
@@ -99,14 +100,14 @@ defaultWorld = World
, _backspaceTimer = 0
}
youLight :: TempLightSource
youLight =
TLS { _tlsParam = LSParam
{_lsPos = V3 0 0 0
,_lsRad = 300
,_lsCol = 0.1
}
,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
,_tlsTime = 0
youLight = TLS
{ _tlsParam = LSParam
{_lsPos = V3 0 0 0
,_lsRad = 300
,_lsCol = 0.1
}
,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
,_tlsTime = 0
}
where
f (V2 x y) = V3 x y 100
src/Dodge/Event.hs
+7 -7
View File
@@ -150,7 +150,7 @@ wheelEvent y w = case _hudElement $ _hud w of
| otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tp _)
DisplayInventory DisplayTerminal{}
| rbDown -> w
& hud . hudElement . subInventory . termParams %~ updatetermsubsel
| otherwise -> w
@@ -160,20 +160,20 @@ wheelEvent y w = case _hudElement $ _hud w of
updatetermsel tp = case _termSel tp of
Nothing -> tp & termSel ?~ (0,0)
& termInput . _Just %~ replacewith tp 0
Just (i,_) -> let newi = ((`mod` length (_termCommands tp)) . subtract yi) i
Just (i,_) -> let newi = ((`mod` length (_termScrollCommands tp)) . subtract yi) i
in tp & termSel . _Just .~ (newi,0)
& termInput . _Just %~ replacewith tp newi
updatetermsubsel tp = case _termSel tp of
Nothing -> tp
Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termCommands tp !! i) w))
Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termScrollCommands tp !! i) w))
in tp & termSel . _Just .~ (i,newj)
& termInput . _Just %~ replacewith' tp i newj w
replacewith tp newi _ = T.pack (_tcString (_termCommands tp !! newi))
replacewith' tp i j w _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
replacewith tp newi _ = T.pack (_tcString (_termScrollCommands tp !! newi))
replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
where
arg :: String
arg = (("":(_tcArguments tc w) )!! j)
tc = _termCommands tp !! i
arg = ("": _tcArguments tc w' )!! j
tc = _termScrollCommands tp !! i
numcombs = length $ combineItemListYou w
yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
src/Dodge/Inventory.hs
+16 -23
View File
@@ -50,7 +50,8 @@ import qualified Data.Text as T
-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World -> World
-> World
-> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . itAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f
@@ -141,7 +142,7 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
where
invsel = yourInvSel w
splitgap
| yourInvSel w < length (yourInv w) = 0
| invsel < length (yourInv w) = 0
| otherwise = 1
updateTerminal :: World -> World
@@ -157,22 +158,21 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
updateTerminalLine :: World -> World
updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of
Nothing -> w
Just tl | _tlPause tl > 0 -> w
& hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1
Just (TerminalLineDisplay _ f) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& hud . hudElement . subInventory . termParams . termDisplayedLines .:~ f
Just tl | _tlPause tl > 0 -> w & pointTermParams . termFutureLines . ix 0 . tlPause -~ 1
Just (TerminalLineDisplay _ f) -> w & pointTermParams %~
( ( termFutureLines %~ tail )
. ( termDisplayedLines .:~ f )
)
Just (TerminalLineEffect _ eff) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& pointTermParams . termFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w)
-- Just (TerminalLineChoice _ ops) -> w
-- & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
-- & hud . hudElement . subInventory . termParams . termOptions .~ ops
-- & hud . hudElement . subInventory . termParams . termSel ?~ 0
Just (TerminalLineInput _ commands) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& hud . hudElement . subInventory . termParams . termInput ?~ T.empty
& hud . hudElement . subInventory . termParams . termCommands .~ commands
Just (TerminalLineInput _ scrollc writec) -> w & pointTermParams %~
( ( termFutureLines %~ tail )
. ( termInput ?~ T.empty )
. ( termScrollCommands .~ scrollc )
. ( termWriteCommands .~ writec ) )
where
pointTermParams = hud . hudElement . subInventory . termParams
-- this looks ugly...
updateCloseObjects :: World -> World
@@ -321,13 +321,6 @@ changeSwapInvSel k w
n = length $ _crInv cr
numCO = length $ _closeObjects w
--swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
--swapIntSetKeys i j is
-- | i `IS.member` is && j `IS.member` is = is
-- | i `IS.member` is = j `IS.insert` (i `IS.delete` is)
-- | j `IS.member` is = i `IS.insert` (j `IS.delete` is)
-- | otherwise = is
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
src/Dodge/Placement/Instance/Analyser.hs
+2 -1
View File
@@ -74,7 +74,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
, _termSel = Nothing
-- , _termOptions = []
, _termInput = Nothing
, _termCommands = []
, _termScrollCommands = []
, _termWriteCommands = []
})
)
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
src/Dodge/Placement/Instance/Terminal.hs
+3 -2
View File
@@ -58,7 +58,7 @@ termButton = Button
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing []
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
}
@@ -117,7 +117,8 @@ genTermMessage f = \gp _ -> TerminalParams
,_termSel = Nothing
-- ,_termOptions = []
,_termInput = Nothing
,_termCommands = []
,_termScrollCommands = []
,_termWriteCommands = []
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))
src/Dodge/Room/Warning.hs
+1 -1
View File
@@ -71,7 +71,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"])
-- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
ops trid f gw w = f gw w & termFutureLines %~
(++ [ TerminalLineInput 0 [quitCommand,helpCommand,infoCommand theinfo,commandsCommand,unlockCommand trid]])
(++ [ TerminalLineInput 0 [unlockCommand trid] [quitCommand,helpCommand,infoCommand theinfo,commandsCommand]])
unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid)
-- (++ [ TerminalLineChoice 0 [ ("TOGGLE", toggledoor trid)
-- , ("EXIT", id)
src/Dodge/Terminal.hs
+9 -4
View File
@@ -29,20 +29,25 @@ helpCommand = TerminalCommand
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"."
, _tcArgumentType = Just "AN AVAILABLE COMMAND"
, _tcArguments = \w -> fromMaybe [] $ do
commands <- w ^? hud . hudElement . subInventory . termParams . termCommands
commands <- getCommands w
return $ map _tcString commands
, _tcEffect = helpf
}
helpf :: [String] -> World -> Either String World
helpf [] w = helpf ["HELP"] w
helpf (str:_) w = maybe (Left "") Right $ do
commands <- w ^? hud . hudElement . subInventory . termParams . termCommands
commands <- getCommands w
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
return $ w & infoClearInput
([TerminalLineDisplay 0 $ const ("COMMAND:" ++ _tcString command,white)
,TerminalLineDisplay 0 $ const ("ALIASES:" ++ unwords (_tcAlias command),white) ]
++ stringToTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
)
getCommands :: World -> Maybe [TerminalCommand]
getCommands w = do
commands1 <- w ^? hud . hudElement . subInventory . termParams . termScrollCommands
commands2 <- w ^? hud . hudElement . subInventory . termParams . termWriteCommands
return $ commands1 ++ commands2
infoClearInput :: [TerminalLine] -> World -> World
infoClearInput tls = hud . hudElement . subInventory . termParams %~
@@ -81,7 +86,7 @@ commandsCommand = TerminalCommand
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & infoClearInput
(TerminalLineDisplay 0 (const ("AVAILABLE COMMANDS:",white))
: stringToTermPara (unwords (maybe [""] (map _tcString) $ w ^? hud . hudElement . subInventory . termParams . termCommands))
: stringToTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
)
}
@@ -103,7 +108,7 @@ doTerminalEffect w = fromMaybe w $ do
doTerminalEffect' :: String -> World -> World
doTerminalEffect' s w = fromMaybe (w & badinput) $ do
commands <- w ^? hud . hudElement . subInventory . termParams . termCommands
commands <- getCommands w
if null (words s) then Just $ disconnectTerminal w else do
let (str:args) = words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands