mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-27 18:15:15 +03:00
parent
1500fd127c
commit
e8d387d739
@ -405,6 +405,20 @@
|
||||
properties: [portable]
|
||||
capabilities: [scan, sensefront]
|
||||
|
||||
- name: flash memory
|
||||
display:
|
||||
attr: device
|
||||
char: '§'
|
||||
description:
|
||||
- "Using a flash memory device, a robot can reprogram other robots using the
|
||||
'reprogram' command."
|
||||
- "Only robots that have completed executing their previous command
|
||||
can be reprogrammed."
|
||||
- "The robot must possess enough capabilities to run the new command
|
||||
otherwise it will fail."
|
||||
properties: [portable]
|
||||
capabilities: [reprogram]
|
||||
|
||||
- name: mirror
|
||||
display:
|
||||
attr: device
|
||||
|
@ -809,6 +809,72 @@ execConst c vs k = do
|
||||
Raise -> case vs of
|
||||
[VString s] -> return $ Up (User s) k
|
||||
_ -> badConst
|
||||
Reprogram -> case vs of
|
||||
[VString childRobotName, VDelay _ cmd e] -> do
|
||||
em <- lift . lift $ use entityMap
|
||||
mode <- lift . lift $ use gameMode
|
||||
rctx@(_, capCtx) <- use robotCtx
|
||||
renv <- use robotEnv
|
||||
|
||||
-- check if robot exists
|
||||
childRobot <-
|
||||
robotNamed childRobotName
|
||||
>>= (`isJustOr` cmdExn Reprogram ["There is no robot named", childRobotName, "."])
|
||||
|
||||
-- check that current robot is not trying to reprogram self
|
||||
myName <- use robotName
|
||||
(childRobotName /= myName)
|
||||
`holdsOr` cmdExn
|
||||
Reprogram
|
||||
["You cannot make a robot reprogram itself"]
|
||||
|
||||
-- check if robot has completed executing it's current command
|
||||
_ <-
|
||||
finalValue (childRobot ^. machine)
|
||||
`isJustOr` cmdExn
|
||||
Reprogram
|
||||
["You cannot reprogram a robot that has not completed its current command"]
|
||||
|
||||
-- check if childRobot is at the correct distance
|
||||
-- a robot can program adjacent robots
|
||||
-- creative mode ignores distance checks
|
||||
loc <- use robotLocation
|
||||
( mode == Creative
|
||||
|| (childRobot ^. robotLocation) `manhattan` loc <= 1
|
||||
)
|
||||
`holdsOr` cmdExn
|
||||
Reprogram
|
||||
["You can only program adjacent robot"]
|
||||
|
||||
let -- Find out what capabilities are required by the program that will
|
||||
-- be run on the other robot, and what devices would provide those
|
||||
-- capabilities.
|
||||
(caps, _capCtx) = requiredCaps capCtx cmd
|
||||
capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps
|
||||
|
||||
-- device is ok if it is installed on the childRobot
|
||||
deviceOK d = (childRobot ^. installedDevices) `E.contains` d
|
||||
|
||||
missingDevices = S.filter (not . deviceOK) capDevices
|
||||
|
||||
-- check if robot has all devices to execute new command
|
||||
(mode == Creative || S.null missingDevices)
|
||||
`holdsOr` cmdExn
|
||||
Reprogram
|
||||
[ "the target robot does not have required devices:\n"
|
||||
, commaList (map (^. entityName) (S.toList missingDevices))
|
||||
]
|
||||
|
||||
-- update other robot's CEK machine, environment and context
|
||||
-- the childRobot inherits the parent robot's environment
|
||||
-- and context which collectively mean all the variables
|
||||
-- declared in the parent robot
|
||||
lift . lift $ robotMap . at childRobotName . _Just . machine .= In cmd e [FExec]
|
||||
lift . lift $ robotMap . at childRobotName . _Just . robotEnv .= renv
|
||||
lift . lift $ robotMap . at childRobotName . _Just . robotCtx .= rctx
|
||||
|
||||
return $ Out VUnit k
|
||||
_ -> badConst
|
||||
Build -> case vs of
|
||||
[VString name, VDelay _ cmd e] -> do
|
||||
r <- get
|
||||
|
@ -87,6 +87,8 @@ data Capability
|
||||
CLambda
|
||||
| -- | Enable recursive definitions
|
||||
CRecursion
|
||||
| -- | Execute the 'Reprogram' command
|
||||
CReprogram
|
||||
| -- | Capability to introspect and see it's own name
|
||||
CWhoami
|
||||
deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, Hashable, Data)
|
||||
@ -249,6 +251,8 @@ constCaps Upload = S.singleton CScan
|
||||
-- interpreter. However, I suspect things currently start to go
|
||||
-- haywire if you try to build a robot that builds other robots.
|
||||
constCaps Build = S.singleton CBuild
|
||||
-- Reprogram reqiures a CReprogram capability.
|
||||
constCaps Reprogram = S.singleton CReprogram
|
||||
-- Some additional straightforward ones, which however currently
|
||||
-- cannot be used in classic mode since there is no craftable item
|
||||
-- which conveys their capability.
|
||||
|
@ -56,5 +56,10 @@ elaborate =
|
||||
-- doing the constructing.
|
||||
rewrite (TApp (TApp (TConst Build) nm) prog) =
|
||||
TApp (TApp (TConst Build) nm) (TDelay prog)
|
||||
-- Delay evaluation of the program argument to a 'Reprogram' command,
|
||||
-- so it will be evaluated by the reprogrammed robot instead of the one
|
||||
-- doing the reprogramming.
|
||||
rewrite (TApp (TApp (TConst Reprogram) nm) prog) =
|
||||
TApp (TApp (TConst Reprogram) nm) (TDelay prog)
|
||||
-- Leave any other subterms alone.
|
||||
rewrite t = t
|
||||
|
@ -178,6 +178,9 @@ data Const
|
||||
Make
|
||||
| -- | Construct a new robot.
|
||||
Build
|
||||
| -- | Reprogram a robot that has executed it's command
|
||||
-- with a new command
|
||||
Reprogram
|
||||
| -- | Emit a message.
|
||||
Say
|
||||
| -- | View a certain robot.
|
||||
@ -335,6 +338,7 @@ constInfo c = case c of
|
||||
Give -> commandLow 2
|
||||
Install -> commandLow 2
|
||||
Make -> commandLow 1
|
||||
Reprogram -> commandLow 2
|
||||
Build -> commandLow 2
|
||||
Say -> commandLow 1
|
||||
View -> commandLow 1
|
||||
|
@ -422,6 +422,7 @@ inferConst c = toU $ case c of
|
||||
Give -> [tyQ| string -> string -> cmd () |]
|
||||
Install -> [tyQ| string -> string -> cmd () |]
|
||||
Make -> [tyQ| string -> cmd () |]
|
||||
Reprogram -> [tyQ| forall a. string -> cmd a -> cmd () |]
|
||||
Build -> [tyQ| forall a. string -> cmd a -> cmd string |]
|
||||
Say -> [tyQ| string -> cmd () |]
|
||||
View -> [tyQ| string -> cmd () |]
|
||||
|
Loading…
Reference in New Issue
Block a user