sml-projects/fcore/quad-tree.sml

signature QUAD_TREE =
sig
  type t

  val empty: t

  datatype collision_side =
    QUERY_ON_LEFT_SIDE
  | QUERY_ON_TOP_SIDE
  | QUERY_ON_RIGHT_SIDE
  | QUERY_ON_BOTTOM_SIDE

  val insert: int * int * int * int * 
              int * int * int * int * 
              int * t -> t

  val fromItem: int * int * int * int * int -> t

  val getCollisions: int * int * int * int * 
                     int * int * int * int * 
                     int * t -> int list

  val helpGetCollisions: int * int * int * int * 
                         int * int * int * int * 
                         int * int list * t 
                         -> int list

  val getCollisionSides: int * int * int * int * int * int * int * int * int * t
                         -> (collision_side * int) list

  val getCollisionsBelow: int * int * int * int * int * int * int * int * int * t
                         -> int list

  val hasCollisionAt: int * int * int * int *
                      int * int * int * int *
                      int * t -> bool

  val getItemID: int * int * int * int *
                 int * int * int * int *
                 t -> int
end

structure QuadTree: QUAD_TREE =
struct
  open QuadTreeType

  type item = QuadTreeType.item

  fun visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
    let
      val midX = qW div 2 + qX
      val midY = qH div 2 + qY
    in
      iX <= midX andalso iY <= midY
    end

  fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) =
    let
      val midX = qW div 2 + qX
      val midY = qH div 2 + qY
    in
      iX >= midX andalso iY <= midY
    end

  fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
    let
      val midX = qW div 2 + qX
      val midY = qH div 2 + qY

      val iFinishY = iY + iH
    in
      iX <= midX andalso iFinishY >= midY
    end

  fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) =
    let
      val midX = qW div 2 + qX
      val midY = qH div 2 + qY

      val iFinishX = iX + iH
      val iFinishY = iY + iH
    in
      iFinishX >= midX andalso iFinishY >= midY
    end

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

  fun itemToString {itemID, startX, startY, width, height} =
    String.concat
      [ "{itemID = "
      , Int.toString itemID
      , ", startX = "
      , Int.toString startX
      , ", startY = "
      , Int.toString startY
      , ", width = "
      , Int.toString width
      , ", height = "
      , Int.toString height
      , "}"
      ]

  type t = QuadTreeType.t

  val empty = LEAF (Vector.fromList [])

  fun fromItem (itemID, startX, startY, width, height) =
    let
      val item = mkItem (itemID, startX, startY, width, height)
      val elements = Vector.fromList [item]
    in
      LEAF elements
    end

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

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

  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, 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
      in
        NODE
          { topLeft = LEAF tl
          , topRight = LEAF tr
          , bottomLeft = LEAF bl
          , bottomRight = LEAF br
          }
      end
    else
      let
        val item = Vector.sub (elements, pos)
        val {startX = iX, startY = iY, width = iW, height = iH, ...} = item

        val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
        val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
        val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
        val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

        val tl = if vtl then item :: tl else tl

        val tr = if vtr then item :: tr else tr

        val bl = if vbl then item :: bl else bl

        val br = if vbr then item :: br else br
      in
        splitLeaf (qX, qY, qW, qH, tl, tr, bl, br, 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} =>
        let
          val halfW = quadWidth div 2
          val halfH = quadHeight div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemWidth
          val iH = itemHeight

          val qX = quadX
          val qY = quadY
          val qW = quadWidth
          val qH = quadHeight

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val tl =
            if vtl then
              insert (iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, topLeft)
            else
              topLeft

          val tr =
            if vtr then
              insert (iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, topRight)
            else
              topRight

          val bl =
            if vbl then
              insert
                (iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, bottomLeft)
            else
              bottomLeft

          val br =
            if vbr then
              insert
                (iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, bottomRight)
            else
              bottomRight
        in
          NODE {topLeft = tl, topRight = tr, bottomLeft = bl, bottomRight = br}
        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)

            val halfW = quadWidth div 2
            val halfH = quadHeight div 2

            val midX = halfW + quadX
            val midY = halfH + quadY

            val iX = itemX
            val iY = itemY
            val iW = itemWidth
            val iH = itemHeight

            val qX = quadX
            val qY = quadY
            val qW = quadWidth
            val qH = quadHeight

            val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
            val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
            val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
            val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

            val pos = Vector.length elements - 1
            val item = mkItem (itemID, itemX, itemY, itemWidth, itemHeight)

            val tl = if vtl then [item] else []

            val tr = if vtr then [item] else []

            val bl = if vbl then [item] else []

            val br = if vbr then [item] else []

            val pe = []
          in
            splitLeaf
              ( quadX
              , quadY
              , quadWidth
              , quadHeight
              , tl
              , tr
              , bl
              , br
              , 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

  fun isBetween (start, checkStart, finish, checkFinish) =
    (* if check containhs start/finish *)
    (checkStart <= start andalso checkFinish >= finish)
    orelse
    (* if start/finish containhs check *)
    (start <= checkStart andalso finish >= checkFinish)
    orelse
    (* if checkStart between start and finish *)
    (start <= checkStart andalso finish >= checkStart)
    orelse
    (* if checkFinish is between start and finish *)
    (start <= checkFinish andalso finish >= checkFinish)

  fun isColliding (iX, iY, iW, iH, itemID, checkWith: item) =
    let
      val itemEndX = iX + iW
      val itemEndY = iY + iH
      val {itemID = checkID, startX, startY, width, height, ...} = checkWith
      val endX = startX + width
      val endY = startY + height
    in
      isBetween (iX, startX, itemEndX, endX)
      andalso isBetween (iY, startY, itemEndY, endY) andalso itemID <> checkID
    end

  fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
    if pos = Vector.length elements then
      acc
    else
      let
        val item = Vector.sub (elements, pos)
        val acc =
          if isColliding (iX, iY, iW, iH, itemID, item) then #itemID item :: acc
          else acc
      in
        getCollisionsVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
      end

  fun getCollisionsAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfWidth = qW div 2
          val halfHeight = qH div 2

          val acc = getCollisionsAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)

          val acc = getCollisionsAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)

          val acc = getCollisionsAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
        in
          getCollisionsAll
            (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
        end
    | LEAF elements =>
        getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)

  fun helpGetCollisions
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , acc
    , tree: t
    ) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfW = quadWidth div 2
          val halfH = quadHeight div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemWidth
          val iH = itemHeight

          val qX = quadX
          val qY = quadY
          val qW = quadWidth
          val qH = quadHeight

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val acc =
            if vtl then
              helpGetCollisions
                (iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
            else
              acc

          val acc =
            if vtr then
              helpGetCollisions
                (iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
            else
              acc

          val acc =
            if vbl then
              helpGetCollisions
                ( iX
                , iY
                , iW
                , iH
                , qX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomLeft
                )
            else
              acc

          val acc =
            if vbl then
              helpGetCollisions
                ( iX
                , iY
                , iW
                , iH
                , midX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomRight
                )
            else
              acc
        in
          acc
        end
    | LEAF elements =>
        getCollisionsVec
          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)

  fun getCollisions
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , tree
    ) =
    helpGetCollisions
      ( itemX
      , itemY
      , itemWidth
      , itemHeight
      , quadX
      , quadY
      , quadWidth
      , quadHeight
      , itemID
      , []
      , tree
      )

  (* no variant to represent 'no collision' case
   * because caller should only try getting collision side 
   * after checking that there is any collision. *)
  datatype collision_side =
    QUERY_ON_LEFT_SIDE
  | QUERY_ON_TOP_SIDE
  | QUERY_ON_RIGHT_SIDE
  | QUERY_ON_BOTTOM_SIDE

  (* getCollisionSide function ported from this answer:
   * https://stackoverflow.com/a/56607347
   * *)
  fun getCollisionSide (iX, iY, iW, iH, checkWith: item) =
    let
      val iFinishX = iX + iW
      val iFinishY = iY + iH
      val iHalfW = iW div 2
      val iHalfH = iH div 2
      val iCentreX = iX + iHalfW
      val iCentreY = iY + iHalfH

      val {startX = cX, startY = cY, width = cW, height = cH, ...} = checkWith

      val cFinishX = cX + cW
      val cFinishY = cY + cH
      val cHalfW = cW div 2
      val cHalfH = cH div 2
      val cCentreX = cX + cHalfW
      val cCentreY = cY + cHalfH

      val diffX = iCentreX - cCentreX
      val diffY = iCentreY - cCentreY

      val minXDist = iHalfW + cHalfW
      val minYDist = iHalfH + cHalfH

      val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX

      val depthY = if diffY > 0 then minYDist - diffY else (~minYDist) - diffY
    in
      if abs depthX < abs depthY then
        if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE
      else if depthY > 0 then
        QUERY_ON_TOP_SIDE
      else
        QUERY_ON_BOTTOM_SIDE
    end

  (* like getCollisionsVec, but instead of consing just the itemID, 
   * it also conses the "collision-side" information.
   * *)
  fun getCollisionSideVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
    if pos = Vector.length elements then
      acc
    else
      let
        val item = Vector.sub (elements, pos)
        val acc =
          if isColliding (iX, iY, iW, iH, itemID, item) then
            let val side = getCollisionSide (iX, iY, iW, iH, item)
            in (side, #itemID item) :: acc
            end
          else
            acc
      in
        getCollisionSideVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
      end

  fun getCollisionSidesAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfWidth = qW div 2
          val halfHeight = qH div 2

          val acc = getCollisionSidesAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)

          val acc = getCollisionSidesAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)

          val acc = getCollisionSidesAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
        in
          getCollisionSidesAll
            (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
        end
    | LEAF elements =>
        getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc)

  fun helpGetCollisionSides
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , acc
    , tree: t
    ) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfW = quadWidth div 2
          val halfH = quadHeight div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemWidth
          val iH = itemHeight

          val qX = quadX
          val qY = quadY
          val qW = quadWidth
          val qH = quadHeight

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val acc =
            if vtl then
              helpGetCollisionSides
                (iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
            else
              acc

          val acc =
            if vtr then
              helpGetCollisionSides
                (iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
            else
              acc

          val acc =
            if vbl then
              helpGetCollisionSides
                ( iX
                , iY
                , iW
                , iH
                , qX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomLeft
                )
            else
              acc

          val acc =
            if vbl then
              helpGetCollisionSides
                ( iX
                , iY
                , iW
                , iH
                , midX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomRight
                )
            else
              acc
        in
          acc
        end
    | LEAF elements =>
        getCollisionSideVec
          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)

  fun getCollisionSides
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , tree
    ) =
    helpGetCollisionSides
      ( itemX
      , itemY
      , itemWidth
      , itemHeight
      , quadX
      , quadY
      , quadWidth
      , quadHeight
      , itemID
      , []
      , tree
      )

  fun getCollisionsBelowVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
    if pos = Vector.length elements then
      acc
    else
      let
        val item = Vector.sub (elements, pos)
        val {itemID = curID, ...} = item
      in
        if isColliding (iX, iY, iW, iH, itemID, item) then
          case getCollisionSide (iX, iY, iW, iH, item) of
            QUERY_ON_BOTTOM_SIDE =>
              getCollisionsBelowVec
                (iX, iY, iW, iH, itemID, pos + 1, elements, curID :: acc)
          | _ =>
              getCollisionsBelowVec
                (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
        else
          getCollisionsBelowVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
      end

  fun getCollisionsBelowAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfWidth = qW div 2
          val halfHeight = qH div 2

          val acc = getCollisionsBelowAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)

          val acc = getCollisionsBelowAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)

          val acc = getCollisionsBelowAll
            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
        in
          getCollisionsBelowAll
            (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
        end
    | LEAF elements =>
        getCollisionsBelowVec (iX, iY, iW, iH, itemID, 0, elements, acc)

  fun helpGetCollisionsBelow
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , acc
    , tree: t
    ) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfW = quadWidth div 2
          val halfH = quadHeight div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemWidth
          val iH = itemHeight

          val qX = quadX
          val qY = quadY
          val qW = quadWidth
          val qH = quadHeight

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val acc =
            if vtl then
              helpGetCollisionsBelow
                (iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
            else
              acc

          val acc =
            if vtr then
              helpGetCollisionsBelow
                (iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
            else
              acc

          val acc =
            if vbl then
              helpGetCollisionsBelow
                ( iX
                , iY
                , iW
                , iH
                , qX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomLeft
                )
            else
              acc

          val acc =
            if vbl then
              helpGetCollisionsBelow
                ( iX
                , iY
                , iW
                , iH
                , midX
                , midY
                , halfW
                , halfH
                , itemID
                , acc
                , bottomRight
                )
            else
              acc
        in
          acc
        end
    | LEAF elements =>
        getCollisionsBelowVec
          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)

  fun getCollisionsBelow
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , tree
    ) =
    helpGetCollisionsBelow
      ( itemX
      , itemY
      , itemWidth
      , itemHeight
      , quadX
      , quadY
      , quadWidth
      , quadHeight
      , itemID
      , []
      , tree
      )

  fun hasCollisionAtVec (iX, iY, iW, iH, itemID, pos, elements) =
    if pos = Vector.length elements then
      false
    else
      let
        val item = Vector.sub (elements, pos)
      in
        if isColliding (iX, iY, iW, iH, itemID, item) then
          let
            val _ = print
              ("quad-tree.sml: has collision: \n" ^ itemToString item ^ "\n")
          in
            true
          end
        else
          hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
      end

  fun hasCollisionAt
    ( itemX
    , itemY
    , itemWidth
    , itemHeight
    , quadX
    , quadY
    , quadWidth
    , quadHeight
    , itemID
    , tree
    ) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfW = quadWidth div 2
          val halfH = quadHeight div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemWidth
          val iH = itemHeight

          val qX = quadX
          val qY = quadY
          val qW = quadWidth
          val qH = quadHeight

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val tl =
            if vtl then
              hasCollisionAt
                (iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, topLeft)
            else
              false

          val tr =
            if vtr then
              hasCollisionAt
                (iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, topRight)
            else
              false

          val bl =
            if vbl then
              hasCollisionAt
                (iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, bottomLeft)
            else
              false

          val br =
            if vbl then
              hasCollisionAt
                (iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, bottomRight)
            else
              false
        in
          tl orelse tr orelse bl orelse br
        end
    | LEAF elements =>
        hasCollisionAtVec
          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements)

  fun getItemIDVec (iX, iY, iW, iH, pos, elements) =
    if pos = Vector.length elements then
      ~1
    else
      let
        val item = Vector.sub (elements, pos)
      in
        if isColliding (iX, iY, iW, iH, ~1, item) then #itemID item
        else getItemIDVec (iX, iY, iW, iH, pos + 1, elements)
      end

  fun getItemID (itemX, itemY, itemW, itemH, quadX, quadY, quadW, quadH, tree) =
    case tree of
      NODE {topLeft, topRight, bottomLeft, bottomRight} =>
        let
          val halfW = quadW div 2
          val halfH = quadH div 2

          val midX = halfW + quadX
          val midY = halfH + quadY

          val iX = itemX
          val iY = itemY
          val iW = itemW
          val iH = itemH

          val qX = quadX
          val qY = quadY
          val qW = quadW
          val qH = quadH

          val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
          val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)

          val try1 =
            if vtl then
              getItemID (iX, iY, iW, iH, qX, qY, halfW, halfH, topLeft)
            else
              ~1

          val try2 =
            if vtr then
              getItemID (iX, iY, iW, iH, midX, qY, halfW, halfH, topRight)
            else
              ~1

          val try3 =
            if vbl then
              getItemID (iX, iY, iW, iH, qX, midY, halfW, halfH, bottomLeft)
            else
              ~1

          val try4 =
            if vbl then
              getItemID (iX, iY, iW, iH, midX, midY, halfW, halfH, bottomRight)
            else
              ~1

          (* get max: we assume query was narrow enough 
           * that only one ID is valid *)
          val a = Int.max (try1, try2)
          val a = Int.max (a, try3)
          val a = Int.max (a, try4)
        in
          a
        end
    | LEAF elements => getItemIDVec (itemX, itemY, itemW, itemH, 0, elements)
end