structure BinTree = struct datatype 'a bintree = NODE of { x: int , y: int , ex: int , ey: int , data: 'a , left: 'a bintree , right: 'a bintree } | LEAF val empty = LEAF fun insert (newItem as {x, y, ex, ey, data}, tree) = case tree of LEAF => NODE { x = x , y = y , ex = ex , ey = ey , data = data , left = LEAF , right = LEAF } | NODE {x = ox, y = oy, ex = oex, ey = oey, data = oldData, left, right} => let val dir = if x < ox then LESS else if x > ox then GREATER else (if y < oy then LESS else if y > oy then GREATER else (if ex < oex then LESS else if ex > oex then GREATER else (if ey < oey then LESS else if ey > oey then GREATER else EQUAL))) in case dir of LESS => NODE { left = insert (newItem, left) , right = right , x = ox , y = oy , ex = oex , ey = oey , data = oldData } | GREATER => NODE { right = insert (newItem, right) , left = left , x = ox , y = oy , ex = oex , ey = oey , data = oldData } | EQUAL => NODE { left = left , right = right , x = x , y = y , ex = ex , ey = ey , data = data } end fun foldr (f, tree, acc) = case tree of NODE {x, y, ex, ey, data, left, right} => let val acc = foldr (f, right, acc) val item = {x = x, y = y, ex = ex, ey = ey, data = data} val acc = f (item, acc) in foldr (f, left, acc) end | LEAF => acc end structure CollisionTree = struct (* ignoreData = any data we find in grid but which doesn't concern us * so we omit from tree, to reduce number of items in tree, * and therefore decrease the constant in O(n) *) val ignoreData = 0 local fun loopYAxis (x, y, eX, eY, yAxis, col) = if y > eY orelse y >= Vector.length yAxis then true else let val newCol = Vector.sub (yAxis, y) in if col = newCol then loopYAxis (x, y + 1, eX, eY, yAxis, col) else false end fun loopColour (x, y, eX, eY, grid, col) = if x > eX orelse x >= Vector.length grid then true else let val yAxis = Vector.sub (grid, x) in if loopYAxis (x, y, eX, eY, yAxis, col) then loopColour (x + 1, y, eX, eY, grid, col) else false end in fun quadHasSameColour (startX, startY, endX, endY, grid) = let val yAxis = Vector.sub (grid, startX) val col = Vector.sub (yAxis, startY) in loopColour (startX, startY, endX, endY, grid, col) end end (* tree creation *) fun build (x, y, size, grid, bintree) = if x >= Vector.length grid orelse y >= Vector.length grid then bintree else if quadHasSameColour (x, y, x + size, y + size, grid) then let val yAxis = Vector.sub (grid, x) val data = Vector.sub (yAxis, y) in if data = ignoreData then bintree else let val ex = x + size val ey = y + size val item = {x = x, y = y, ex = ex, ey = ey, data = data} in BinTree.insert (item, bintree) end end else (if size mod 2 = 0 orelse size = 1 then let val halfSize = size div 2 val bintree = build (x, y, halfSize, grid, bintree) val bintree = build (x + halfSize, y, halfSize, grid, bintree) val bintree = build (x, y + halfSize, halfSize, grid, bintree) in build (x + halfSize, y + halfSize, halfSize, grid, bintree) end else (* handles odd-number divisions. * For example, `7 div 2` is 3 because of integer division. * We would not cover every pixel unless we handle odd numbers specially. *) let val halfSizeBefore = size div 2 val halfSizeAfter = (size + 1) div 2 val bintree = build (x, y, halfSizeAfter, grid, bintree) val bintree = build (x + halfSizeBefore, y, halfSizeAfter, grid, bintree) val bintree = build (x, y + halfSizeBefore, halfSizeAfter, grid, bintree) in build ( x + halfSizeBefore , y + halfSizeBefore , halfSizeAfter , grid , bintree ) 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 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 f = folder ( windowWidth , windowHeight , canvasWidth , canvasHeight , xClickPoints , yClickPoints ) val vec = BinTree.foldr (f, bintree, []) in Vector.concat vec end end end