diff --git a/dotscape b/dotscape
index 22c0ee3..a40e2fc 100755
Binary files a/dotscape and b/dotscape differ
diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml
index df17a27..7f0fa41 100644
--- a/fcore/quad-tree.sml
+++ b/fcore/quad-tree.sml
@@ -92,6 +92,8 @@ struct
           foldr (f, left, acc)
         end
     | LEAF => acc
+
+  fun toList tree = foldr (fn (item, acc) => item ::acc, tree, [])
 end
 
 structure CollisionTree =
@@ -187,63 +189,61 @@ struct
              )
          end)
 
-  local
     fun getClickPoint (clickPoints, pos) =
       let val idx = Int.min (pos, Vector.length clickPoints - 1)
       in Vector.sub (clickPoints, idx)
       end
 
-    fun folder
-      ( windowWidth
-      , windowHeight
-      , canvasWidth
-      , canvasHeight
-      , xClickPoints
-      , yClickPoints
-      ) ({x, ex, y, ey, data}, acc) =
-      let
-        val ex = if ex = x then x + 1 else ex
-        val ey = if ey = y then y + 1 else ey
+  fun folder
+    ( windowWidth
+    , windowHeight
+    , canvasWidth
+    , canvasHeight
+    , xClickPoints
+    , yClickPoints
+    ) ({x, ex, y, ey, data}, acc) =
+    let
+      val ex = if ex = x then x + 1 else ex
+      val ey = if ey = y then y + 1 else ey
 
-        val x = getClickPoint (xClickPoints, x)
-        val y = getClickPoint (yClickPoints, y)
-        val ex = getClickPoint (xClickPoints, ex)
-        val ey = getClickPoint (yClickPoints, ey)
+      val x = getClickPoint (xClickPoints, x)
+      val y = getClickPoint (yClickPoints, y)
+      val ex = getClickPoint (xClickPoints, ex)
+      val ey = getClickPoint (yClickPoints, ey)
 
-        val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
-        val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
-        val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
-        val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
-      in
-        Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) :: acc
-      end
-  in
-    fun toTriangles
-      ( windowWidth
-      , windowHeight
-      , squares
-      , size
-      , canvasWidth
-      , canvasHeight
-      , xClickPoints
-      , yClickPoints
-      ) =
-      let
-        val bintree = build (0, 0, size, squares, BinTree.empty)
+      val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
+      val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
+      val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
+      val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
+    in
+      Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) :: acc
+    end
 
-        val f = folder
-          ( windowWidth
-          , windowHeight
-          , canvasWidth
-          , canvasHeight
-          , xClickPoints
-          , yClickPoints
-          )
-        val vec = BinTree.foldr (f, bintree, [])
-      in
-        Vector.concat vec
-      end
-  end
+  fun toTriangles
+    ( windowWidth
+    , windowHeight
+    , squares
+    , size
+    , canvasWidth
+    , canvasHeight
+    , xClickPoints
+    , yClickPoints
+    ) =
+    let
+      val bintree = build (0, 0, size, squares, BinTree.empty)
+
+      val f = folder
+        ( windowWidth
+        , windowHeight
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+      val vec = BinTree.foldr (f, bintree, [])
+    in
+      Vector.concat vec
+    end
 
   (* building and querying quad tree, plus compression *)
   datatype quad_tree =
@@ -251,6 +251,22 @@ struct
   | NODE of {tl: quad_tree, tr: quad_tree, bl: quad_tree, br: quad_tree}
   | EMPTY
 
+  fun foldWithDuplicates (f, tree, acc) =
+    case tree of
+      EMPTY => acc
+    | LEAF item => f (item, acc)
+    | NODE {tl, tr, bl, br} =>
+        let
+          val acc = foldWithDuplicates (f, tl, acc)
+          val acc = foldWithDuplicates (f, tr, acc)
+          val acc = foldWithDuplicates (f, bl, acc)
+        in
+          foldWithDuplicates (f, br, acc)
+        end
+
+  fun toBintree qtree =
+    foldWithDuplicates (BinTree.insert, qtree, BinTree.empty)
+
   fun buildTree (x, y, size, grid) =
     if x >= Vector.length grid orelse y >= Vector.length grid then
       EMPTY
@@ -297,255 +313,58 @@ struct
            NODE {tl = tl, tr = tr, bl = bl, br = br}
          end)
 
-  fun getItemWithDataAt (x, y, qx, qy, size, tree, data) =
-    case tree of
-      EMPTY => NONE
-    | LEAF (item as {x = ix, y = iy, ex = iex, ey = iey, data = oldData}) =>
-        if (x >= ix andalso x <= iex) andalso (y >= iy andalso y <= iey) then
-          (* search coordinates are in item *)
-          if data = oldData then (* data matches *) SOME item else NONE
+    local
+      fun loop (x, y, ex, ey, grid) =
+        if x > 0 then
+          if quadHasSameColour (x, y, ex, ey, grid) then
+            loop (x - 1, y, x, ey, grid)
+          else
+            ex
         else
-          NONE
-    | NODE {tl, tr, bl, br} =>
-        if size mod 2 = 0 orelse size = 1 then
-          let
-            val halfSize = size div 2
-            val qmx = x + halfSize
-            val qfx = x + size
-            val qmy = y + halfSize
-            val qfy = y + size
-          in
-            if y >= qy andalso y <= qmy then
-              (* top *)
-              if x >= qx andalso x <= qmx then
-                (* top left *)
-                getItemWithDataAt (x, y, qx, qy, halfSize, tl, data)
-              else
-                (* top right *)
-                getItemWithDataAt (x, y, qx + halfSize, qy, halfSize, tr, data)
-            else (* bottom *) if x >= qx andalso x <= qmx then
-              (* bottom left *)
-              getItemWithDataAt (x, y, qx, qy + halfSize, halfSize, bl, data)
-            else
-              (* bottom right *)
-              getItemWithDataAt
-                (x, y, qx + halfSize, qy + halfSize, halfSize, br, data)
-          end
+          0
+    in
+      fun getLeftmostX ({x, y, ex, ey, data}, grid) =
+        loop (x - 1, y, x, ey, grid)
+    end
+
+    local
+      fun loop (x, y, ex, ey, grid) =
+        if x < Vector.length grid andalso ex < Vector.length grid then
+          if quadHasSameColour (x, y, ex, ey, grid) then
+            loop (ex, y, ex + 1, ey, grid)
+          else
+            x
         else
-          let
-            val halfSizeBefore = size div 2
-            val halfSizeAfter = (size + 1) div 2
-            val qmx = x + halfSizeBefore
-            val qmy = y + halfSizeBefore
-          in
-            if y >= qy andalso y <= qmy then
-              (* top *)
-              if x >= qx andalso x <= qmx then
-                (* top left *)
-                getItemWithDataAt (x, y, qx, qy, halfSizeAfter, tl, data)
-              else
-                (* top right *)
-                getItemWithDataAt (x, y, qmx, qy, halfSizeAfter, tr, data)
-            else (* bottom *) if x >= qx andalso x <= qmx then
-              (* bottom left *)
-              getItemWithDataAt (x, y, qx, qmy, halfSizeAfter, bl, data)
-            else
-              (* bottom right *)
-              getItemWithDataAt (x, y, qmx, qmy, halfSizeAfter, br, data)
-          end
-
-  fun getLeftmostX (rootSize, rootTree, prevItem) =
-    let
-      val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
-        prevItem
+          Vector.length grid - 1
     in
-      case
-        getItemWithDataAt (prevX - 1, prevY, 0, 0, rootSize, rootTree, prevData)
-      of
-        SOME (newItem as {y = newY, ey = newEy, data = newData, ...}) =>
-          if prevY = newY andalso newEy = prevEy andalso prevData = newData then
-            (* Y side has same edge, so is mergeable, and data is also same *)
-            getLeftmostX (rootSize, rootTree, newItem)
+      fun getRightmostX ({x, y, ex, ey, data}, grid) =
+        loop (ex, y, ex + 1, ey, grid)
+    end
+
+    local
+      fun loop (x, y, ex, ey, grid) =
+        if y < 0 then 0
+        else
+          if quadHasSameColour (x, y, ex, ey, grid) then
+            loop (x, y - 1, ex, y, grid)
           else
-            prevX
-      | NONE => prevX
+            ey
+    in
+      fun getTopmostY ({x, y, ex, ey, data}, grid) =
+        loop (x, y - 1, ex, y, grid)
     end
 
-  fun getRightmostX (rootSize, rootTree, prevItem) =
-    let
-      val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
-        prevItem
-    in
-      case
-        getItemWithDataAt
-          (prevEx + 1, prevY, 0, 0, rootSize, rootTree, prevData)
-      of
-        SOME (newItem as {y = newY, ey = newEy, data = newData, ...}) =>
-          if prevY = newY andalso newEy = prevEy andalso prevData = newData then
-            getRightmostX (rootSize, rootTree, newItem)
+    local
+      fun loop (x, y, ex, ey, grid) =
+        if y < Vector.length grid andalso ey < Vector.length grid then
+          if quadHasSameColour (x, y, ex, ey, grid) then
+            loop (x, ey, ex, ey + 1, grid)
           else
-            prevEx
-      | NONE => prevEx
-    end
-
-  fun getTopmostY (rootSize, rootTree, prevItem) =
-    let
-      val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
-        prevItem
+            y
+        else
+          Vector.length grid - 1
     in
-      case
-        getItemWithDataAt (prevX, prevY - 1, 0, 0, rootSize, rootTree, prevData)
-      of
-        SOME (newItem as {x = newX, ex = newEx, data = newData, ...}) =>
-          if prevX = newX andalso prevEx = newEx andalso prevData = newData then
-            (* X side has same edge and data is also same, so mergeable *)
-            getTopmostY (rootSize, rootTree, newItem)
-          else
-            prevY
-      | NONE => prevY
+      fun getBottomY ({x, y, ex, ey, data}, grid) =
+        loop (x, ey, ex, ey + 1, grid)
     end
-
-  fun getBottomY (rootSize, rootTree, prevItem) =
-    let
-      val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
-        prevItem
-    in
-      case
-        getItemWithDataAt
-          (prevX, prevEy + 1, 0, 0, rootSize, rootTree, prevData)
-      of
-        SOME (newItem as {x = newX, ex = newEx, data = newData, ...}) =>
-          if prevX = newX andalso prevEx = newEx andalso prevData = newData then
-            (* X side has same edge and data is also same, so mergeable *)
-            getBottomY (rootSize, rootTree, newItem)
-          else
-            prevEy
-      | NONE => prevEy
-    end
-
-  datatype merge_dir =
-    HORIZONTAL of {left: int, right: int}
-  | VERTICAL of {up: int, down: int}
-  | NO_MERGE
-
-  fun getHorizontal (ox, oex, leftX, rightX) =
-    let
-      val left = if leftX < ox then ox - 1 else ox
-      val right = if rightX > oex then oex + 1 else oex
-    in
-      HORIZONTAL {left = left, right = right}
-    end
-
-  fun getVertical (oy, oey, upY, bottomY) =
-    let
-      val up = if upY < oy then oy - 1 else oy
-      val down = if bottomY > oey then oey + 1 else oey
-    in
-      VERTICAL {up = up, down = down}
-    end
-
-  fun getMergeDir (rootSize, rootTree, item) =
-    let
-      val {x = ox, y = oy, ex = oex, ey = oey, data} = item
-
-      val leftX = getLeftmostX (rootSize, rootTree, item)
-      val rightX = getRightmostX (rootSize, rootTree, item)
-      val upY = getTopmostY (rootSize, rootTree, item)
-      val bottomY = getBottomY (rootSize, rootTree, item)
-
-      val xChanged = leftX <> ox orelse rightX <> oex
-      val yChanged = upY <> oy orelse bottomY <> oey
-    in
-      if xChanged andalso yChanged then
-        let
-          val diffX = abs (rightX - leftX)
-          val diffY = abs (bottomY - upY)
-        in
-          if diffX > diffY then getHorizontal (ox, oex, leftX, rightX)
-          else getVertical (oy, oey, upY, bottomY)
-        end
-      else if xChanged then
-        getHorizontal (ox, oex, leftX, rightX)
-      else if yChanged then
-        getVertical (oy, oey, upY, bottomY)
-      else
-        NO_MERGE
-    end
-
-  fun mergeHorizontal (item, newX, newEx) =
-    let val {y, ey, data, x = _, ex = _} = item
-    in {x = newX, ex = newEx, y = y, ey = ey, data = data}
-    end
-
-  fun mergeVertical (item, newY, newEy) =
-    let val {x, ex, data, y = _, ey = _} = item
-    in {y = newY, ey = newEy, x = x, ex = ex, data = data}
-    end
-
-  local
-    fun mergePass (qx, qy, size, tree, rootSize, rootTree) =
-      case tree of
-        EMPTY => (EMPTY, false)
-      | LEAF item =>
-          let
-            val mergeDir = getMergeDir (rootSize, rootTree, item)
-          in
-            case mergeDir of
-              NO_MERGE => (LEAF item, false)
-            | VERTICAL {up, down} =>
-                (LEAF (mergeVertical (item, up, down)), true)
-            | HORIZONTAL {left, right} =>
-                (LEAF (mergeHorizontal (item, left, right)), true)
-          end
-      | NODE {tl, tr, bl, br} =>
-          if size = 1 orelse size mod 2 = 0 then
-            let
-              val halfSize = size div 2
-
-              val (tl, didMergeTl) = mergePass
-                (qx, qy, halfSize, tl, rootSize, rootTree)
-              val (tr, didMergeTr) = mergePass
-                (qx + halfSize, qy, halfSize, tr, rootSize, rootTree)
-              val (bl, didMergeBl) = mergePass
-                (qx, qy + halfSize, halfSize, bl, rootSize, rootTree)
-              val (br, didMergeBr) = mergePass
-                (qx + halfSize, qy + halfSize, halfSize, br, rootSize, rootTree)
-
-              val didMergeAny =
-                didMergeTl orelse didMergeTr orelse didMergeBl orelse didMergeBr
-              val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
-            in
-              (node, didMergeAny)
-            end
-          else
-            let
-              val halfSizeBefore = size div 2
-              val halfSizeAfter = (size + 1) div 2
-              val qmx = qx + halfSizeBefore
-              val qmy = qy + halfSizeAfter
-
-              val (tl, didMergeTl) = mergePass
-                (qx, qy, halfSizeAfter, tl, rootSize, rootTree)
-              val (tr, didMergeTr) = mergePass
-                (qmx, qy, halfSizeAfter, tr, rootSize, rootTree)
-              val (bl, didMergeBl) = mergePass
-                (qx, qmy, halfSizeAfter, bl, rootSize, rootTree)
-              val (br, didMergeBr) = mergePass
-                (qmx, qmy, halfSizeAfter, br, rootSize, rootTree)
-
-              val didMergeAny =
-                didMergeTl orelse didMergeTr orelse didMergeBl orelse didMergeBr
-              val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
-            in
-              (node, didMergeAny)
-            end
-  in
-    fun merge (rootSize, rootTree) =
-      let
-        val (newTree, didMerge) = mergePass
-          (0, 0, rootSize, rootTree, rootSize, rootTree)
-      in
-        if didMerge then merge (rootSize, newTree) else newTree
-      end
-  end
 end