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 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) 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 else let (* handles odd-number divisions. * For example, `7 div 2` is 3 because of integer division. *) val halfSize = if size = 1 orelse size mod 2 = 0 then size div 2 else (size + 1) 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 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) = if data = 0 then acc else 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