mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-11 14:46:33 +03:00
Change appear
command to take an optional attribute (#1807)
Also, fix a bug---it didn't work before if an appearance string of length 5 was given. Closes #1230. I don't know how to write an automated test for this, but you can see it working by *e.g.*: - Start a creative game - Execute e.g. `appear "DNESW" (inr "rock")` - Observe that the base now looks like a rock-colored `N` - Now do some `turn` commands (including `turn down`) and observe the appearance changing to e.g. `S` when facing south
This commit is contained in:
parent
b39851d1ab
commit
bf73f2acd9
@ -206,7 +206,7 @@ def mkBeeName = \structureLoc.
|
||||
|
||||
def workerProgramInit = \beename. \hiveIdx. \structureLoc.
|
||||
setname beename;
|
||||
appear "B";
|
||||
appear "B" (inl ());
|
||||
workerProgram hiveIdx structureLoc;
|
||||
end;
|
||||
|
||||
|
@ -5,13 +5,13 @@ Swims back and forth forever.
|
||||
def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
|
||||
|
||||
def swim =
|
||||
appear "^";
|
||||
appear "^" (inl ());
|
||||
doN 3 (move; wait 3);
|
||||
turn back;
|
||||
wait 15;
|
||||
doN 3 (move; wait 3);
|
||||
turn back;
|
||||
appear " ";
|
||||
appear " " (inl ());
|
||||
end;
|
||||
|
||||
def go =
|
||||
|
@ -99,11 +99,11 @@ def go = \width. \height. \lastTauntIndex. \startingAmount. \dropping.
|
||||
say $ snd tauntStage;
|
||||
} {};
|
||||
|
||||
appear "o";
|
||||
appear "o" (inl ());
|
||||
arrive width height;
|
||||
|
||||
place dropping;
|
||||
appear "G";
|
||||
appear "G" (inl ());
|
||||
waitWhileHere dropping 150;
|
||||
go width height tauntIndex startingAmount dropping;
|
||||
} {
|
||||
@ -128,4 +128,4 @@ def go = \width. \height. \lastTauntIndex. \startingAmount. \dropping.
|
||||
|
||||
let dropping = "mound" in
|
||||
startingAmount <- count dropping;
|
||||
go 28 18 (-1) startingAmount dropping;
|
||||
go 28 18 (-1) startingAmount dropping;
|
||||
|
@ -33,7 +33,7 @@ robots:
|
||||
def createWorker =
|
||||
build {
|
||||
setname "childbot";
|
||||
appear "B";
|
||||
appear "B" (inl ());
|
||||
};
|
||||
end;
|
||||
|
||||
|
@ -1,3 +1,3 @@
|
||||
loops:
|
||||
test: stack test --fast
|
||||
test: stack test swarm:swarm-integration swarm:swarm-unit --fast
|
||||
unit: stack test swarm:swarm-unit --fast
|
||||
|
@ -829,21 +829,36 @@ execConst runChildProg c vs s k = do
|
||||
return $ mkReturn ()
|
||||
_ -> badConst
|
||||
Appear -> case vs of
|
||||
[VText app] -> do
|
||||
flagRedraw
|
||||
[VText app, VInj hasAttr mattr] -> do
|
||||
-- Set the robot's display character(s)
|
||||
case into @String app of
|
||||
[dc] -> do
|
||||
robotDisplay . defaultChar .= dc
|
||||
robotDisplay . orientationMap .= M.empty
|
||||
return $ mkReturn ()
|
||||
[dc, nc, ec, sc, wc] -> do
|
||||
robotDisplay . defaultChar .= dc
|
||||
robotDisplay . orientationMap . ix DNorth .= nc
|
||||
robotDisplay . orientationMap . ix DEast .= ec
|
||||
robotDisplay . orientationMap . ix DSouth .= sc
|
||||
robotDisplay . orientationMap . ix DWest .= wc
|
||||
return $ mkReturn ()
|
||||
_other -> raise Appear [quote app, "is not a valid appearance string. 'appear' must be given a string with exactly 1 or 5 characters."]
|
||||
robotDisplay . orientationMap
|
||||
.= M.fromList
|
||||
[ (DNorth, nc)
|
||||
, (DEast, ec)
|
||||
, (DSouth, sc)
|
||||
, (DWest, wc)
|
||||
]
|
||||
_other ->
|
||||
raise
|
||||
Appear
|
||||
[ quote app
|
||||
, "is not a valid appearance string."
|
||||
, "'appear' must be given a string with exactly 1 or 5 characters."
|
||||
]
|
||||
|
||||
-- Possibly set the display attribute
|
||||
case (hasAttr, mattr) of
|
||||
(True, VText attr) -> robotDisplay . displayAttr .= readAttribute attr
|
||||
_ -> return ()
|
||||
|
||||
flagRedraw
|
||||
return $ mkReturn ()
|
||||
_ -> badConst
|
||||
Create -> case vs of
|
||||
[VText name] -> do
|
||||
@ -1348,7 +1363,7 @@ execConst runChildProg c vs s k = do
|
||||
T.unlines
|
||||
[ "Bad application of execConst:"
|
||||
, T.pack (show c)
|
||||
, T.pack (show (reverse vs))
|
||||
, T.pack (show vs)
|
||||
, prettyText (Out (VCApp c (reverse vs)) s k)
|
||||
]
|
||||
|
||||
|
@ -501,7 +501,7 @@ seedProgram minTime randTime thing =
|
||||
try {
|
||||
r <- random (1 + $int:randTime);
|
||||
wait (r + $int:minTime);
|
||||
appear "|";
|
||||
appear "|" (inl ());
|
||||
r <- random (1 + $int:randTime);
|
||||
wait (r + $int:minTime);
|
||||
place $str:thing;
|
||||
|
@ -223,7 +223,7 @@ data Const
|
||||
Log
|
||||
| -- | View a certain robot.
|
||||
View
|
||||
| -- | Set what characters are used for display.
|
||||
| -- | Set color and what characters are used for display.
|
||||
Appear
|
||||
| -- | Create an entity out of thin air. Only
|
||||
-- available in creative mode.
|
||||
@ -739,9 +739,10 @@ constInfo c = case c of
|
||||
[ "This will recenter the map on the target robot and allow its inventory and logs to be inspected."
|
||||
]
|
||||
Appear ->
|
||||
command 1 short . doc (Set.singleton $ Mutation Cosmetic) "Set how the robot is displayed." $
|
||||
[ "You can either specify one character or five (for each direction)."
|
||||
command 2 short . doc (Set.singleton $ Mutation Cosmetic) "Set how the robot is displayed." $
|
||||
[ "You can either specify one character or five (one for each direction: down, north, east, south, west)."
|
||||
, "The default is \"X^>v<\"."
|
||||
, "The second argument is for optionally setting a display attribute (i.e. color)."
|
||||
]
|
||||
Create ->
|
||||
command 1 short . doc (Set.fromList [Mutation EntityChange, Mutation $ RobotChange InventoryChange]) "Create an item out of thin air." $
|
||||
|
@ -811,7 +811,7 @@ inferConst c = case c of
|
||||
Listen -> [tyQ| cmd text |]
|
||||
Log -> [tyQ| text -> cmd unit |]
|
||||
View -> [tyQ| actor -> cmd unit |]
|
||||
Appear -> [tyQ| text -> cmd unit |]
|
||||
Appear -> [tyQ| text -> (unit + text) -> cmd unit |]
|
||||
Create -> [tyQ| text -> cmd unit |]
|
||||
Halt -> [tyQ| actor -> cmd unit |]
|
||||
Time -> [tyQ| cmd int |]
|
||||
|
@ -13,6 +13,7 @@ module Swarm.Game.Display (
|
||||
-- * The display record
|
||||
Priority,
|
||||
Attribute (..),
|
||||
readAttribute,
|
||||
Display,
|
||||
|
||||
-- ** Fields
|
||||
@ -57,14 +58,15 @@ type Priority = Int
|
||||
data Attribute = ADefault | ARobot | AEntity | AWorld Text
|
||||
deriving (Eq, Ord, Show, Generic, Hashable)
|
||||
|
||||
readAttribute :: Text -> Attribute
|
||||
readAttribute = \case
|
||||
"robot" -> ARobot
|
||||
"entity" -> AEntity
|
||||
"default" -> ADefault
|
||||
w -> AWorld w
|
||||
|
||||
instance FromJSON Attribute where
|
||||
parseJSON =
|
||||
withText "attribute" $
|
||||
pure . \case
|
||||
"robot" -> ARobot
|
||||
"entity" -> AEntity
|
||||
"default" -> ADefault
|
||||
w -> AWorld w
|
||||
parseJSON = withText "attribute" $ pure . readAttribute
|
||||
|
||||
instance ToJSON Attribute where
|
||||
toJSON = \case
|
||||
|
@ -51,7 +51,7 @@ treeProgram =
|
||||
{
|
||||
r <- random 100;
|
||||
wait (r + 300);
|
||||
appear "|";
|
||||
appear "|" (inl ());
|
||||
r <- random 100;
|
||||
wait (r + 300);
|
||||
place "tree";
|
||||
|
Loading…
Reference in New Issue
Block a user