mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-27 01:49:15 +03:00
Extract drilling logic (#1288)
Just a simple code relocation with no functional changes. Towards #1007.
This commit is contained in:
parent
b2747a6fce
commit
c1a1a67480
@ -1462,63 +1462,7 @@ execConst c vs s k = do
|
||||
t <- use ticks
|
||||
return $ Out (VInt t) s k
|
||||
Drill -> case vs of
|
||||
[VDir d] -> do
|
||||
rname <- use robotName
|
||||
inv <- use robotInventory
|
||||
ins <- use equippedDevices
|
||||
|
||||
let equippedDrills = extantElemsWithCapability CDrill ins
|
||||
-- Heuristic: choose the drill with the more elaborate name.
|
||||
-- E.g. "metal drill" vs. "drill"
|
||||
preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills
|
||||
|
||||
drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!"
|
||||
|
||||
let directionText = case d of
|
||||
DRelative DDown -> "under"
|
||||
DRelative DForward -> "ahead of"
|
||||
DRelative DBack -> "behind"
|
||||
_ -> directionSyntax d <> " of"
|
||||
|
||||
(nextLoc, nextME) <- lookInDirection d
|
||||
nextE <-
|
||||
nextME
|
||||
`isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."]
|
||||
|
||||
inRs <- use recipesIn
|
||||
|
||||
let recipes = filter drilling (recipesFor inRs nextE)
|
||||
drilling = any ((== drill) . snd) . view recipeRequirements
|
||||
|
||||
not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."]
|
||||
|
||||
-- add the drilled entity so it can be consumed by the recipe
|
||||
let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r
|
||||
chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes))
|
||||
((invTaken, outs), recipe) <-
|
||||
chosenRecipe
|
||||
`isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."]
|
||||
|
||||
let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs
|
||||
let learn = map (LearnEntity . snd) down
|
||||
let gain = map (uncurry AddEntity) out
|
||||
|
||||
newEntity <- case down of
|
||||
[] -> pure Nothing
|
||||
[(1, de)] -> pure $ Just de
|
||||
_ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced."
|
||||
let changeWorld =
|
||||
ReplaceEntity
|
||||
{ updatedLoc = nextLoc
|
||||
, originalEntity = nextE
|
||||
, newEntity = newEntity
|
||||
}
|
||||
|
||||
-- take recipe inputs from inventory and add outputs after recipeTime
|
||||
robotInventory .= invTaken
|
||||
|
||||
let cmdOutput = asValue $ snd <$> listToMaybe out
|
||||
finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain)
|
||||
[VDir d] -> doDrill d
|
||||
_ -> badConst
|
||||
Blocked -> do
|
||||
loc <- use robotLocation
|
||||
@ -2103,6 +2047,68 @@ execConst c vs s k = do
|
||||
let msg = "The operator '$' should only be a syntactic sugar and removed in elaboration:\n"
|
||||
in throwError . Fatal $ msg <> badConstMsg
|
||||
where
|
||||
doDrill d = do
|
||||
inv <- use robotInventory
|
||||
ins <- use equippedDevices
|
||||
|
||||
let equippedDrills = extantElemsWithCapability CDrill ins
|
||||
-- Heuristic: choose the drill with the more elaborate name.
|
||||
-- E.g. "metal drill" vs. "drill"
|
||||
preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills
|
||||
|
||||
drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!"
|
||||
|
||||
(nextLoc, nextE) <- getDrillTarget "drill" d
|
||||
inRs <- use recipesIn
|
||||
|
||||
let recipes = filter drilling (recipesFor inRs nextE)
|
||||
drilling = any ((== drill) . snd) . view recipeRequirements
|
||||
|
||||
not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."]
|
||||
|
||||
-- add the drilled entity so it can be consumed by the recipe
|
||||
let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r
|
||||
chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes))
|
||||
((invTaken, outs), recipe) <-
|
||||
chosenRecipe
|
||||
`isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."]
|
||||
|
||||
let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs
|
||||
let learn = map (LearnEntity . snd) down
|
||||
let gain = map (uncurry AddEntity) out
|
||||
|
||||
newEntity <- case down of
|
||||
[] -> pure Nothing
|
||||
[(1, de)] -> pure $ Just de
|
||||
_ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced."
|
||||
let changeWorld =
|
||||
ReplaceEntity
|
||||
{ updatedLoc = nextLoc
|
||||
, originalEntity = nextE
|
||||
, newEntity = newEntity
|
||||
}
|
||||
|
||||
-- take recipe inputs from inventory and add outputs after recipeTime
|
||||
robotInventory .= invTaken
|
||||
|
||||
let cmdOutput = asValue $ snd <$> listToMaybe out
|
||||
finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain)
|
||||
|
||||
getDrillTarget verb d = do
|
||||
rname <- use robotName
|
||||
|
||||
(nextLoc, nextME) <- lookInDirection d
|
||||
nextE <-
|
||||
nextME
|
||||
`isJustOrFail` ["There is nothing to", verb, directionText, "robot", rname <> "."]
|
||||
return (nextLoc, nextE)
|
||||
where
|
||||
directionText = case d of
|
||||
DRelative DDown -> "under"
|
||||
DRelative DForward -> "ahead of"
|
||||
DRelative DBack -> "behind"
|
||||
_ -> directionSyntax d <> " of"
|
||||
|
||||
goAtomic :: HasRobotStepState sig m => m CESK
|
||||
goAtomic = case vs of
|
||||
-- To execute an atomic block, set the runningAtomic flag,
|
||||
|
Loading…
Reference in New Issue
Block a user