diff --git a/app/Main.hs b/app/Main.hs
index 4da724f..4bad497 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -16,20 +16,20 @@ world0 = World {
     [('1', Box {
       boxColor = withForeColor defAttr green,
       boxLocation = Location '1' (-1) 0,
-      boxWalls = makeWalls [
+      boxType = Original $ makeWalls [
         "▓▓   ▓▓",
         "▓     ▓",
         "▓     ▓",
         "▓     ▓",
         "▓  ▓  ▓",
         "▓     ▓",
-        "▓  ▓  ▓"
+        "▓ ▓▓▓ ▓"
         ]
     }),
     ('2', Box {
       boxColor = withForeColor defAttr cyan,
       boxLocation = Location '1' 1 1,
-      boxWalls = makeWalls [
+      boxType = Original $ makeWalls [
         "▓ ▓ ▓ ▓",
         "       ",
         "▓     ▓",
@@ -39,23 +39,28 @@ world0 = World {
         "▓ ▓ ▓ ▓"
       ]
     }),
+    ('₂', Box {
+      boxColor = withForeColor defAttr cyan,
+      boxLocation = Location '1' 2 (-1),
+      boxType = Link '2'
+    }),
     ('3', Box {
       boxColor = withForeColor defAttr blue,
       boxLocation = Location '2' 1 1,
-      boxWalls = makeWalls [
-        "▓▓   ▓▓",
-        "▓  ▓  ▓",
-        "▓     ▓",
-        "▓     ▓",
-        "▓     ▓",
-        "▓     ▓",
+      boxType = Original $ makeWalls [
+        "▓▓▓▓▓▓▓",
+        "▓   ▓▓▓",
+        "▓   ▓▓▓",
+        "▓▓▓ ▓▓▓",
+        "▓   ▓▓▓",
+        "▓   ▓▓▓",
         "▓▓▓ ▓▓▓"
       ]
     }),
         ('4', Box {
       boxColor = withForeColor defAttr black,
       boxLocation = Location '3' (-3) 0,
-      boxWalls = makeWalls [
+      boxType = Original $ makeWalls [
         "▓▓   ▓▓",
         "▓  ▓  ▓",
         "▓     ▓",
@@ -68,10 +73,10 @@ world0 = World {
     ('b', Box {
         boxColor = withForeColor defAttr red,
         boxLocation = Location '1' 0 1,
-        boxWalls = makeWalls [
+        boxType = Original $ makeWalls [
         "▓▓▓▓▓▓▓",
         "▓     ▓",
-        "▓ ▓ ▓ ▓",
+        "▓     ▓",
         "       ",
         "▓    ▓▓",
         "▓     ▓",
@@ -81,32 +86,37 @@ world0 = World {
     ('x', Box {
         boxColor = withForeColor defAttr yellow,
         boxLocation = Location '1' 0 (-1),
-        boxWalls = solid 7
+        boxType = Original $ solid 7
     }),
     ('y', Box {
         boxColor = withForeColor defAttr magenta,
         boxLocation = Location '1' 0 (-2),
-        boxWalls = solid 7
+        boxType = Original $ solid 7
     }),
     ('i', Box {
         boxColor = withForeColor defAttr black,
         boxLocation = Location 'b' 0 (-2),
-        boxWalls = solid 7
+        boxType = Original $ solid 7
     }),
     ('j', Box {
         boxColor = withForeColor defAttr black,
         boxLocation = Location 'b' 0 (-1),
-        boxWalls = solid 7
+        boxType = Original $ solid 7
     }),
         ('k', Box {
         boxColor = withForeColor defAttr black,
         boxLocation = Location 'b' 0 0,
-        boxWalls = solid 7
+        boxType = Original $ solid 7
     }),
         ('l', Box {
         boxColor = withForeColor defAttr black,
         boxLocation = Location 'b' 0 1,
-        boxWalls = solid 7
+        boxType = Original $ solid 7
+    }),
+    ('₁', Box {
+      boxColor = withForeColor defAttr green,
+      boxLocation = Location '1' 2 1,
+      boxType = Link '1'
     })
     ]
   }
diff --git a/app/Model.hs b/app/Model.hs
index 495d201..6baadaf 100644
--- a/app/Model.hs
+++ b/app/Model.hs
@@ -12,11 +12,22 @@ type Coord = (Int, Int)
 
 data Box = Box {
   boxLocation :: Location,
-  boxWalls    :: Array Coord Bool,
+  boxType     :: BoxType,
   boxColor    :: Attr
 }
    deriving (Show, Read, Eq)
 
+boxWalls :: World -> Box -> Array Coord Bool
+boxWalls world box =
+    case boxType box of
+        Original walls -> walls
+        Link c -> boxWalls world (worldBoxes world Map.! c)
+
+data BoxType
+    = Original (Array Coord Bool)
+    | Link Char
+   deriving (Show, Read, Eq)
+
 data Location = Location Char Int Int
   deriving (Read, Show, Ord, Eq)
 
@@ -37,10 +48,10 @@ makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
 mkRange :: Int -> (Int,Int)
 mkRange n = (- (n-1)`div`2, n`div`2)
 
-boxSize :: Box -> Int
-boxSize box = yhi-ylo+1
+boxSize :: World -> Box -> Int
+boxSize world box = yhi-ylo+1
   where
-    ((ylo,_),(yhi,_)) = bounds (boxWalls box)
+    ((ylo,_),(yhi,_)) = bounds (boxWalls world box)
 
 
 solid :: Int -> Array Coord Bool
@@ -65,11 +76,11 @@ myLocation :: World -> Location
 myLocation world =
   boxLocation (worldBoxes world Map.! worldMe world)
 
-isWall :: Location -> World -> Bool
-isWall (Location n y x) world =
+isWall :: World -> Location -> Bool
+isWall world (Location n y x) =
   case Map.lookup n (worldBoxes world) of
     Nothing -> True
-    Just box -> boxWalls box ! (y,x)
+    Just box -> boxWalls world box ! (y,x)
 
 type Movement = (Int, Int)
 
@@ -82,7 +93,7 @@ moveBlock ::
 
 -- moving into a wall, not possible
 moveBlock world _ loc _
-  | isWall loc world = Nothing
+  | isWall world loc = Nothing
 
 -- move introduced a loop, trim off the tail and report success
 moveBlock _ visited loc _
@@ -97,7 +108,7 @@ moveBlock world visited loc dir =
     -- moving a box
     (name,box):_ ->
      do loc' <- nextLoc world loc dir
-        guard (not (isWall loc' world))
+        guard (not (isWall world loc'))
         moveBlock' world visited loc loc' dir name box
 
 moveBlock' ::
@@ -117,25 +128,28 @@ moveBlock' world visited loc loc' dir name box =
 
         moveInto =
          do (n,b) <- boxAt world loc'
-            let locI = enterLoc n b dir
+            let locI = enterLoc world n b dir
             moveBlock' world visited loc locI dir name box -- beware epsilon!
         
         moveToEat =
          do let dir' = invert dir
-            let locE = enterLoc name box dir'
+            let locE = enterLoc world name box dir'
             (name', box') <- boxAt world loc' 
             moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' 
 
-enterLoc :: Char -> Box -> Movement -> Location
-enterLoc name box dir =
+enterLoc :: World -> Char -> Box -> Movement -> Location
+enterLoc world name box dir =
   case dir of
-    (-1, 0) -> Location name yhi (midpoint xlo xhi)
-    ( 1, 0) -> Location name ylo (midpoint xlo xhi)
-    ( 0,-1) -> Location name (midpoint ylo yhi) xhi
-    ( 0, 1) -> Location name (midpoint ylo yhi) xlo
+    (-1, 0) -> Location name' yhi (midpoint xlo xhi)
+    ( 1, 0) -> Location name' ylo (midpoint xlo xhi)
+    ( 0,-1) -> Location name' (midpoint ylo yhi) xhi
+    ( 0, 1) -> Location name' (midpoint ylo yhi) xlo
     _ -> error "enterLoc: bad direction"
   where
-    ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box)
+    name' = case boxType box of
+              Link c -> c
+              Original{} -> name
+    ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
 
 boxAt :: World -> Location -> Maybe (Char, Box)
 boxAt world loc =
@@ -160,7 +174,7 @@ nextLoc world loc (dy, dx) = go Set.empty loc
     
   go _ (Location b y x)
     | Just box <- Map.lookup b (worldBoxes world)
-    , inRange (bounds (boxWalls box)) (y+dy, x+dx)
+    , inRange (bounds (boxWalls world box)) (y+dy, x+dx)
     = Just (Location b (y+dy) (x+dx))
   
   go visited (Location b _ _)
diff --git a/app/Rendering.hs b/app/Rendering.hs
index e156419..73b7b4b 100644
--- a/app/Rendering.hs
+++ b/app/Rendering.hs
@@ -14,14 +14,23 @@ unit a scale x =
 
 renderCell :: World -> Map Location Char -> Char -> Box -> Int -> Int -> Int -> Image
 renderCell world locMap name box y x scale =
-    if boxWalls box ! (y,x) then unit (boxColor box) scale '▓'
-      else case Map.lookup (Location name y x) locMap of
+    if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar
+      else case Map.lookup (Location name' y x) locMap of
         Nothing -> unit (boxColor box) scale '░'
         Just n ->
             if scale == 1
                 then unit (boxColor (worldBoxes world Map.! n)) scale n 
                 else renderBox world locMap (worldBoxes world Map.! n) n
-                        (scale `div` boxSize box)
+                        (scale `div` boxSize world box)
+    where
+        name' =
+            case boxType box of
+                Original{} -> name
+                Link c -> c
+        wallChar =
+            case boxType box of
+                Original{} -> '▓'
+                Link{} -> '▒'
 
 renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image
 renderBox world locMap box name scale =
@@ -32,7 +41,7 @@ renderBox world locMap box name scale =
         renderCell world locMap name box y x scale
         | x <- [xlo .. xhi]
     ]
-    | let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box)
+    | let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
     , y <- [ylo .. yhi]
   ]
         
@@ -72,7 +81,7 @@ stackedLoc world = go Set.empty
 
   go visited loc@(Location b y x) =
    do box <- Map.lookup b (worldBoxes world)
-      let bnds@((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box)
+      let bnds@((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
       if inRange bnds (y, x)
         then Just loc
         else