diff --git a/dotscape b/dotscape index 3b4870c..d42c2bf 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index bfd8c4f..66f668e 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -72,97 +72,21 @@ struct } end - 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 + 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 - (* functions to check individual collisions *) - fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) = - ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy - - fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) = - let - val ifx = ix + iw - val ify = iy + ih - val cfx = cx + cw - val cfy = cy + ch - in - isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) - end - - fun isCollidingItem (iX, iY, iW, iH, checkWith) = - let val {x = cX, y = cY, w = cW, h = cH} = checkWith - in isCollidingPlus (iX, iY, iW, iH, cX, cY, cW, cH) - end - - fun visitTopLeft (iX, iY, qX, qY, size) = - let - val half = size div 2 - - val qmx = qX + half - val qmy = qY + half - in - iX >= qX andalso iX <= qmx andalso iY >= qY andalso iY <= qmy - end - - fun visitTopRight (iX, iY, qX, qY, size) = - let - val half = size div 2 - - val qmx = qX + half - val qmy = qY + half - 1 - - val qfx = qX + size - in - iX >= qmx andalso iX <= qfx andalso iY >= qY andalso iY <= qmy - end - - fun visitBottomLeft (iX, iY, qX, qY, size) = - let - val half = size div 2 - - val qmx = qX + half - 1 - val qmy = qY + half - - val qfy = qY + size - in - iX >= qX andalso iX <= qmx andalso iY >= qmy andalso iY <= qfy - end - - fun visitBottomRight (iX, iY, qX, qY, size) = - let - val half = size div 2 - - val qmx = qX + half - val qmy = qY + half - - val qfx = qX + size - val qfy = qY + size - in - iX >= qmx andalso iX <= qfx andalso iY >= qmy andalso iY <= qfy - end - - (* types for tree *) - datatype 'a tree = - NODE of {tl: 'a tree, tr: 'a tree, bl: 'a tree, br: 'a tree} - | LEAF of {x: int, y: int, ex: int, ey: int, data: 'a} - - type 'a t = {tree: 'a tree, size: int} - local fun loopYAxis (x, y, eX, eY, yAxis, col) = if y > eY orelse y >= Vector.length yAxis then @@ -197,7 +121,7 @@ struct end end - (* tree creation/insertion/query functions *) + (* tree creation *) fun build (x, y, size, grid, bintree) = if x >= Vector.length grid orelse y >= Vector.length grid then bintree @@ -226,74 +150,39 @@ struct build (x + halfSize, y + halfSize, halfSize, grid, bintree) end - fun foldWithDuplicates (f, tree, acc) = - case tree of - LEAF item => f (item, acc) - | NODE {tl, tr, bl, br} => - let - val acc = foldWithDuplicates (f, tl, acc) - val acc = foldWithDuplicates (f, tr, acc) - val acc = foldWithDuplicates (f, bl, acc) - in - foldWithDuplicates (f, br, acc) - end - - fun insertItemIntoTree (item, acc) = BinTree.insert (item, acc) - - fun toList qtree = - foldWithDuplicates (fn (item, acc) => item :: acc, qtree, []) - local fun getClickPoint (clickPoints, pos) = let val idx = Int.min (pos, Vector.length clickPoints - 1) in Vector.sub (clickPoints, idx) end - fun loop + fun folder ( windowWidth , windowHeight - , squares - , acc , canvasWidth , canvasHeight , xClickPoints , yClickPoints - ) = - case squares of - {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 + ) ({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 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) - - 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 - ) - end - | [] => Vector.concat acc + 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 @@ -307,18 +196,18 @@ struct ) = let val bintree = build (0, 0, size, squares, BinTree.empty) - val squares = BinTree.toList bintree - in - loop + + val f = folder ( windowWidth , windowHeight - , squares - , [] , canvasWidth , canvasHeight , xClickPoints , yClickPoints ) + val vec = BinTree.foldr (f, bintree, []) + in + Vector.concat vec end end end