infinite improbability drive device enabling teleport command (#1724)

* `tea plant` (which now spawns rarely in a certain biome of the classic world) can be harvested to yield...
* `tea leaves`, which can be combined with `water` to produce...
* `cup of tea`, which, along with `atomic vector plotter` (= `rubber band` + `typewriter` + `compass` + `counter`), are ingredients for...
* `infinite improbability drive`, which enables `teleport`.

When used by a privileged robot (system robot or in creative mode), the `teleport` command continues to function as before.  When used by an unprivileged robot, that is, via the `infinite improbability drive` device, a random entity spawns somewhere near the target location.

Closes #1041.

data/entities.yaml

@@ -295,6 +295,29 @@
     - A beautiful flower that grows wild in local meadows.  It is not clear what it might be useful for, but it looks nice.
   properties: [pickable, growable]
   growth: [30, 50]
+- name: tea plant
+  display:
+    attr: plant
+    char: 't'
+  description:
+    - Camellia sinensis.
+  properties: [pickable, growable]
+  growth: [5000, 6000]
+  yields: tea leaves
+- name: cup of tea
+  display:
+    attr: sand
+    char: 'u'
+  description:
+    - A nice hot cup of tea.
+  properties: [pickable]
+- name: tea leaves
+  display:
+    attr: plant
+    char: 'l'
+  description:
+    - Leaves picked from a tea plant.  They give off a nice smell when crushed.
+  properties: [pickable]
 - name: cotton
   display:
     attr: silver
@@ -1229,3 +1252,22 @@
       there is no distance limitation.
   properties: [pickable]
   capabilities: [halt]
+- name: atomic vector plotter
+  display:
+    attr: device
+    char: 'A'
+  description:
+    - A plot device for plotting interstellar and intermolecular atomic vector gradients.
+  properties: [pickable]
+- name: infinite improbability drive
+  display:
+    attr: device
+    char: 'I'
+  description:
+    - |
+      Enables the `teleport` command, which takes as arguments an
+      `actor`{=type} and a location in the form of a pair of
+      coordinates, and teleports the given actor to the specified
+      coordinates (and may also have some improbable side effects).
+  properties: [pickable]
+  capabilities: [teleport]

data/recipes.yaml

@@ -727,3 +727,24 @@
     - [1, toolkit]
   out:
     - [1, halting oracle]
+- in:
+    - [1, tea leaves]
+    - [1, water]
+  required:
+    - [1, furnace]
+  out:
+    - [1, cup of tea]
+- in:
+    - [1, rubber band]
+    - [1, typewriter]
+    - [1, compass]
+    - [1, counter]
+  out:
+    - [1, atomic vector plotter]
+- in:
+    - [1, cup of tea]
+    - [5, bitcoin]
+    - [3, PhD thesis]
+    - [1, atomic vector plotter]
+  out:
+    - [1, infinite improbability drive]

data/worlds/classic.world

@@ -89,6 +89,7 @@ overlay
     [ {grass}
     , mask (hash % 20 == 10) {grass, cotton}
     , mask (hash % 20 == 0)  {grass, flower}
+    , mask (hash % 1000 == 1) {grass, tea plant}
     ]
   )
 , mask (small && soft && artificial)

src/swarm-engine/Swarm/Game/Entity.hs

@@ -49,6 +49,7 @@ module Swarm.Game.Entity (
   buildEntityMap,
   validateAttrRefs,
   loadEntities,
+  allEntities,
   lookupEntityName,
   deviceForCap,
 
@@ -369,6 +370,10 @@ instance Monoid EntityMap where
   mempty = EntityMap M.empty M.empty
   mappend = (<>)
 
+-- | Get a list of all the entities in the entity map.
+allEntities :: EntityMap -> [Entity]
+allEntities (EntityMap nm _) = M.elems nm
+
 -- | Find an entity with the given name.
 lookupEntityName :: Text -> EntityMap -> Maybe Entity
 lookupEntityName nm = M.lookup nm . entitiesByName

src/swarm-engine/Swarm/Game/Location.hs

@@ -30,6 +30,7 @@ module Swarm.Game.Location (
   -- ** Utility functions
   manhattan,
   euclidean,
+  getLocsInArea,
   getElemsInArea,
 
   -- ** Re-exports for convenience
@@ -43,6 +44,7 @@ import Control.Arrow ((&&&))
 import Data.Aeson (FromJSONKey, ToJSONKey)
 import Data.Function (on, (&))
 import Data.Int (Int32)
+import Data.List (nub)
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Yaml (FromJSON (parseJSON), ToJSON (toJSON))
@@ -63,7 +65,7 @@ import Swarm.Util qualified as Util
 --   See also the 'Swarm.Game.World.Coords' type defined in "Swarm.Game.World", which
 --   use a (row, column) format instead, which is more convenient for
 --   internal use.  The "Swarm.Game.World" module also defines
---   conversions between t'Location' and 'Swarm.Game.World.Coords'.
+--   conversions between 'Location' and 'Swarm.Game.World.Coords'.
 type Location = Point V2 Int32
 
 -- | A convenient way to pattern-match on t'Location' values.
@@ -205,6 +207,19 @@ manhattan (Location x1 y1) (Location x2 y2) = abs (x1 - x2) + abs (y1 - y2)
 euclidean :: Location -> Location -> Double
 euclidean p1 p2 = norm (fromIntegral <$> (p2 .-. p1))
 
+-- | Get all the locations that are within a certain manhattan
+--   distance from a given location.
+--
+-- >>> getLocsInArea (P (V2 0 0)) 1
+-- [P (V2 0 0),P (V2 0 1),P (V2 0 (-1)),P (V2 1 0),P (V2 (-1) 0)]
+-- >>> map (\i -> length (getLocsInArea origin i)) [0..8]
+-- [1,5,13,25,41,61,85,113,145]
+--
+--   See also @Swarm.Game.Step.Const.genDiamondSides@.
+getLocsInArea :: Location -> Int32 -> [Location]
+getLocsInArea loc r =
+  [loc .+^ V2 dx dy | x <- [0 .. r], y <- [0 .. r - x], dx <- nub [x, -x], dy <- nub [y, -y]]
+
 -- | Get elements that are within a certain manhattan distance from location.
 --
 -- >>> v2s i = [(p, manhattan origin p) | x <- [-i..i], y <- [-i..i], let p = Location x y]

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -78,6 +78,7 @@ import Swarm.Game.Step.Util.Command
 import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
 import Swarm.Game.Value
+import Swarm.Game.World (locToCoords)
 import Swarm.Language.Capability
 import Swarm.Language.Context hiding (delete)
 import Swarm.Language.Key (parseKeyComboFull)
@@ -90,6 +91,7 @@ import Swarm.Language.Text.Markdown qualified as Markdown
 import Swarm.Language.Value
 import Swarm.Log
 import Swarm.Util hiding (both)
+import Swarm.Util.Content (getContentAt)
 import Swarm.Util.Effect (throwToMaybe)
 import Swarm.Util.Lens (inherit)
 import Witch (From (from), into)
@@ -254,6 +256,22 @@ execConst runChildProg c vs s k = do
             PathLiquid -> Destroy
           updateRobotLocation oldLoc nextLoc
 
+        -- Privileged robots can teleport without causing any
+        -- improbable effects.  Unprivileged robots must be using an
+        -- infinite improbability drive, which can cause a random entity
+        -- to spawn near the target location.
+        omni <- isPrivilegedBot
+        unless omni $ do
+          w <- use (landscape . multiWorld)
+          let area = map (<$ nextLoc) $ getLocsInArea (nextLoc ^. planar) 5
+              emptyLocs = filter (\cl -> isNothing . snd $ getContentAt w (locToCoords <$> cl)) area
+          randomLoc <- weightedChoice (const 1) emptyLocs
+          es <- uses (landscape . entityMap) allEntities
+          randomEntity <- weightedChoice (const 1) es
+          case (randomLoc, randomEntity) of
+            (Just loc, Just e) -> updateEntityAt loc (const (Just e))
+            _ -> return ()
+
         return $ mkReturn ()
       _ -> badConst
     Grab -> mkReturn <$> doGrab Grab'