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