diff --git a/dotscape b/dotscape index f332a5a..3b4870c 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/app-init.sml b/fcore/app-init.sml index 8c43e04..056a7b2 100644 --- a/fcore/app-init.sml +++ b/fcore/app-init.sml @@ -21,7 +21,7 @@ struct val xClickPoints = ClickPoints.generate (wStart, wFinish, canvasWidth) val yClickPoints = ClickPoints.generate (hStart, hFinish, canvasHeight) - val maxPoints = Int.max (canvasWidth, canvasHeight) + 1 + val maxPoints = Int.max (canvasWidth, canvasHeight) val squares = Vector.tabulate (maxPoints, fn _ => Vector.tabulate (maxPoints, fn _ => 0)) in diff --git a/fcore/app-with.sml b/fcore/app-with.sml index 6a91f58..505e211 100644 --- a/fcore/app-with.sml +++ b/fcore/app-with.sml @@ -188,7 +188,7 @@ struct , modalNum } = app - val maxPoints = Int.max (canvasWidth, canvasHeight) + 1 + val maxPoints = Int.max (canvasWidth, canvasHeight) val xClickPoints = ClickPoints.generate (wStart, wFinish, maxPoints) val yClickPoints = ClickPoints.generate (hStart, hFinish, maxPoints) in diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index 0e4abc2..bfd8c4f 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -72,16 +72,20 @@ struct } end - fun toList (tree, acc) = - case tree of - NODE {x, y, ex, ey, data, left, right} => - let - val acc = toList (right, acc) - val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc - in - toList (left, acc) - end - | LEAF => acc + local + fun loop (tree, acc) = + case tree of + NODE {x, y, ex, ey, data, left, right} => + let + val acc = loop (right, acc) + val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc + in + loop (left, acc) + end + | LEAF => acc + in + fun toList tree = loop (tree, []) + end end structure CollisionTree = @@ -161,7 +165,7 @@ struct local fun loopYAxis (x, y, eX, eY, yAxis, col) = - if y > eY then + if y > eY orelse y >= Vector.length yAxis then true else let @@ -172,7 +176,7 @@ struct end fun loopColour (x, y, eX, eY, grid, col) = - if x > eX then + if x > eX orelse x >= Vector.length grid then true else let @@ -194,23 +198,32 @@ struct end (* tree creation/insertion/query functions *) - fun build (x, y, size, grid) = - if quadHasSameColour (x, y, x + size, y + size, grid) then + 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 - LEAF {x = x, y = y, ex = x + size, ey = y + size, data = data} + BinTree.insert (item, bintree) end else let - val halfSize = size div 2 - val tl = build (x, y, halfSize, grid) - val tr = build (x + halfSize, y, halfSize, grid) - val bl = build (x, y + halfSize, halfSize, grid) - val br = build (x + halfSize, y + halfSize, halfSize, grid) + (* 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 - NODE {tl = tl, bl = bl, tr = tr, br = br} + build (x + halfSize, y + halfSize, halfSize, grid, bintree) end fun foldWithDuplicates (f, tree, acc) = @@ -225,54 +238,87 @@ struct foldWithDuplicates (f, br, acc) end - fun insertItemIntoTree (item, acc) = - if #data item <> 0 then - BinTree.insert (item, acc) - else acc + fun insertItemIntoTree (item, acc) = BinTree.insert (item, acc) fun toList qtree = - let val tree = foldWithDuplicates (insertItemIntoTree, qtree, BinTree.empty) - in BinTree.toList (tree, []) - end + foldWithDuplicates (fn (item, acc) => item :: acc, qtree, []) local - fun loop (windowWidth, windowHeight, squares, acc, canvasWidth, - canvasHeight, xClickPoints, yClickPoints) = + fun getClickPoint (clickPoints, pos) = + let val idx = Int.min (pos, Vector.length clickPoints - 1) + in Vector.sub (clickPoints, idx) + end + + fun loop + ( windowWidth + , windowHeight + , squares + , acc + , canvasWidth + , canvasHeight + , xClickPoints + , yClickPoints + ) = case squares of - {x, y, ex, ey, data = _} :: tl => + {x, y, ex, ey, data} :: tl => let val ex = if ex = x then x + 1 else ex val ey = if ey = y then y + 1 else ey - val x = Vector.sub (xClickPoints, x) - val ex = Vector.sub (xClickPoints, ex) - val y = Vector.sub (yClickPoints, y) - val ey = Vector.sub (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 endX = Ndc.fromPixelX (ex, windowWidth, windowHeight) val startY = Ndc.fromPixelY (y, windowWidth, windowHeight) - val endY = Ndc.fromPixelY (ey , windowWidth, windowHeight) + val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight) - val vec = - Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) - val acc = vec :: acc + val acc = + if data <> 0 then + Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) + :: acc + else + acc in - loop (windowWidth, windowHeight, tl, acc, canvasWidth, canvasHeight, - xClickPoints, yClickPoints) + loop + ( windowWidth + , windowHeight + , tl + , acc + , canvasWidth + , canvasHeight + , xClickPoints + , yClickPoints + ) end | [] => Vector.concat acc in - fun toTriangles (windowWidth, windowHeight, squares, size, canvasWidth, - canvasHeight, xClickPoints, yClickPoints) = + fun toTriangles + ( windowWidth + , windowHeight + , squares + , size + , canvasWidth + , canvasHeight + , xClickPoints + , yClickPoints + ) = let - val qtree = build (0, 0, size, squares) - val squares = toList qtree - val msg = List.length squares - val () = print (Int.toString msg ^ "\n") + val bintree = build (0, 0, size, squares, BinTree.empty) + val squares = BinTree.toList bintree in - loop (windowWidth, windowHeight, squares, [], canvasWidth, canvasHeight, - xClickPoints, yClickPoints) + loop + ( windowWidth + , windowHeight + , squares + , [] + , canvasWidth + , canvasHeight + , xClickPoints + , yClickPoints + ) end end end