structure QuadTree =
struct
  type item = {itemID: int, startX: int, startY: int, width: int, height: int}

  fun mkItem (id, startX, startY, width, height) : item =
    { itemID = id
    , startX = startX
    , startY = startY
    , width = width
    , height = height
    }

  datatype t =
    NODE of
      { topLeft: t
      , topRight: t
      , bottomLeft: t
      , bottomRight: t
      , elements: item vector
      }
  | LEAF of item vector

  (* max size of vector before we split it further *)
  val maxSize = 9

  fun isItemInQuad (iX, iY, iWidth, iHeight, qX, qY, qWidth, qHeight) =
    iX >= qX andalso iY >= qY andalso iWidth <= qWidth
    andalso iHeight <= qHeight

  datatype quadrant =
    TOP_LEFT
  | TOP_RIGHT
  | BOTTOM_LEFT
  | BOTTOM_RIGHT
  | PARENT_QUADRANT

  fun whichQuadrant
    (itemX, itemY, itemWidth, itemHeight, quadX, quadY, quadWidth, quadHeight) =
    let
      (* calculate quadrants *)
      val halfWidth = quadWidth div 2
      val halfHeight = quadHeight div 2

      val middleX = quadX + halfWidth
      val middleY = quadY + halfHeight

      val isInTopLeft = isItemInQuad
        ( itemX, itemY, itemWidth, itemHeight
        , quadX, quadY, halfWidth, halfHeight
        )

      val isInTopRight = isItemInQuad
        ( itemX, itemY, itemWidth, itemHeight
        , middleX, quadY, halfWidth, halfHeight
        )

      val isInBottomLeft = isItemInQuad
        ( itemX, itemY, itemWidth, itemHeight
        , quadX, middleY, halfWidth, halfHeight
        )

      val isInBottomRight = isItemInQuad
        ( itemX, itemY, itemWidth, itemHeight
        , middleX, middleY, halfWidth, halfHeight
        )
    in
      if isInTopLeft then TOP_LEFT
      else if isInTopRight then TOP_RIGHT
      else if isInBottomLeft then BOTTOM_LEFT
      else if isInBottomRight then BOTTOM_RIGHT
      else PARENT_QUADRANT
    end

  fun splitLeaf (qX, qY, qW, qH, tl, tr, bl, br, pe, elements, pos) =
    if pos < 0 then
      let
        val tl = Vector.fromList tl
        val tr = Vector.fromList tr
        val bl = Vector.fromList bl
        val br = Vector.fromList br
        val pe = Vector.fromList pe
      in
        NODE
          { topLeft = LEAF tl
          , topRight = LEAF tr
          , bottomLeft = LEAF bl
          , bottomRight = LEAF br
          , elements = pe
          }
      end
    else
      let
        val item = Vector.sub (elements, pos)
        val {startX = iX, startY = iY, width = iW, height = iH, ...} = item
      in
        case whichQuadrant (iX, iY, iW, iH, qX, qY, qW, qH) of
          TOP_LEFT =>
            splitLeaf
              (qX, qY, qW, qH, item :: tl, tr, bl, br, pe, elements, pos - 1)
        | TOP_RIGHT =>
            splitLeaf
              (qX, qY, qW, qH, tl, item :: tr, bl, br, pe, elements, pos - 1)
        | BOTTOM_LEFT =>
            splitLeaf
              (qX, qY, qW, qH, tl, tr, item :: bl, br, pe, elements, pos - 1)
        | BOTTOM_RIGHT =>
            splitLeaf
              (qX, qY, qW, qH, tl, tr, bl, item :: br, pe, elements, pos - 1)
        | PARENT_QUADRANT =>
            splitLeaf
              (qX, qY, qW, qH, tl, tr, bl, br, item :: pe, elements, pos - 1)
      end

  fun insert
    ( itemX, itemY, itemWidth, itemHeight
    , quadX, quadY, quadWidth, quadHeight
    , itemID, tree: t
    ) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
        (* check which quadrant item is in, if any.
         * If in any child quadrants, recurse insertion into there.
         * Else, add to elements vector in current node. *)
        (case
           whichQuadrant
             ( itemX, itemY, itemWidth, itemHeight
             , quadX, quadY, quadWidth, quadHeight
             )
         of
           TOP_LEFT =>
             let
               (* I know I am repeating myself by recalculating 
                * halfWidth/halfHeight in case branches but I prefer this 
                * over increating the indentation level further
                * *)
               val halfWidth = quadWidth div 2
               val halfHeight = quadHeight div 2

               val newTopLeft = insert
                 ( itemX, itemY, itemWidth, itemHeight
                 , quadX, quadY, halfWidth, halfHeight
                 , itemID, topLeft
                 )
             in
               NODE
                 { topLeft = newTopLeft
                 , topRight = topRight
                 , bottomLeft = bottomLeft
                 , bottomRight = bottomRight
                 , elements = elements
                 }
             end
         | TOP_RIGHT =>
             let
               val halfWidth = quadWidth div 2
               val halfHeight = quadHeight div 2
               val middleX = quadX + halfWidth

               val newTopRight = insert
                 ( itemX, itemY, itemWidth, itemHeight
                 , middleX, quadY, halfWidth, halfHeight
                 , itemID, topRight
                 )
             in
               NODE
                 { topLeft = topLeft
                 , topRight = newTopRight
                 , bottomLeft = bottomLeft
                 , bottomRight = bottomRight
                 , elements = elements
                 }
             end
         | BOTTOM_LEFT =>
             let
               val halfWidth = quadWidth div 2
               val halfHeight = quadHeight div 2
               val middleY = quadY + halfHeight

               val newBottomLeft = insert
                 ( itemX, itemY, itemWidth, itemHeight
                 , quadX, middleY, halfWidth, halfHeight
                 , itemID, bottomLeft
                 )
             in
               NODE
                 { topLeft = topLeft
                 , topRight = topRight
                 , bottomLeft = newBottomLeft
                 , bottomRight = bottomRight
                 , elements = elements
                 }
             end
         | BOTTOM_RIGHT =>
             let
               val halfWidth = quadWidth div 2
               val halfHeight = quadHeight div 2
               val middleX = quadX + halfWidth
               val middleY = quadY + halfHeight

               val newBottomRight = insert
                 ( itemX, itemY, itemWidth, itemHeight
                 , middleX, middleY, halfWidth, halfHeight
                 , itemID, bottomRight
                 )
             in
               NODE
                 { topLeft = topLeft
                 , topRight = topRight
                 , bottomLeft = bottomLeft
                 , bottomRight = newBottomRight
                 , elements = elements
                 }
             end
         | PARENT_QUADRANT =>
             (* Does not fit in any of the child quadrants
              * so we must add to the current parent quadrant. *)
             let
               val item = mkItem (itemID, itemX, itemY, itemWidth, itemHeight)
               val elements = Vector.concat [elements, Vector.fromList [item]]
             in
               NODE
                 { topLeft = topLeft
                 , topRight = topRight
                 , bottomLeft = bottomLeft
                 , bottomRight = bottomRight
                 , elements = elements
                 }
             end)
    | LEAF elements =>
        if Vector.length elements + 1 > maxSize then
          (* have to calculate quadrants and split *)
          let
            val pos = Vector.length elements - 1
            val item = mkItem (itemID, itemX, itemY, itemWidth, itemHeight)
          in
            (case
               whichQuadrant
                 ( itemX, itemY, itemWidth, itemHeight
                 , quadX, quadY, quadWidth, quadHeight
                 )
             of
               TOP_LEFT =>
                 splitLeaf
                   ( quadX, quadY, quadWidth, quadHeight
                   , [item], [], [], [], []
                   , elements, pos
                   )
             | TOP_RIGHT =>
                 splitLeaf
                   ( quadX, quadY, quadWidth, quadHeight
                   , [], [item], [], [], []
                   , elements, pos
                   )
             | BOTTOM_LEFT =>
                 splitLeaf
                   ( quadX, quadY, quadWidth, quadHeight
                   , [], [], [item], [], []
                   , elements, pos
                   )
             | BOTTOM_RIGHT =>
                 splitLeaf
                   ( quadX, quadY, quadWidth, quadHeight
                   , [], [], [], [item], []
                   , elements, pos
                   )
             | PARENT_QUADRANT =>
                 splitLeaf
                   ( quadX, quadY, quadWidth, quadHeight
                   , [], [], [], [], [item]
                   , elements, pos
                   ))
          end
        else
          (* can insert itemID in elements vector *)
          let
            val item = mkItem (itemID, itemX, itemY, itemWidth, itemHeight)
            val elements = Vector.concat [elements, Vector.fromList [item]]
          in
            LEAF elements
          end
end