diff --git a/dotscape b/dotscape index a7fc07a..5feee0d 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index d4d30a0..fc5d429 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -1,104 +1,104 @@ -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 - - fun toList tree = - foldr (fn (item, acc) => item :: acc, tree, []) -end - structure CollisionTree = struct + 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 + + fun toList tree = + foldr (fn (item, acc) => item :: acc, tree, []) + end + fun shouldIgnoreData {a, r = _, g = _, b = _} = a = 0 local @@ -457,33 +457,6 @@ struct toBintree tree end - fun toTrianglesMerged - ( windowWidth - , windowHeight - , squares - , size - , canvasWidth - , canvasHeight - , xClickPoints - , yClickPoints - ) = - let - val qtree = buildTree (0, 0, size, squares) - val bintree = merge (qtree, squares) - - val f = folder - ( windowWidth - , windowHeight - , canvasWidth - , canvasHeight - , xClickPoints - , yClickPoints - ) - val vec = BinTree.foldr (f, bintree, []) - in - Vector.concat vec - end - fun toStringFolder ({x, ex, y, ey, data = {r, g, b, a}}, acc) = let val item = String.concat @@ -524,4 +497,77 @@ struct in String.concat acc end + + fun intToRealString num = + let + val result = Real32.fromInt num + val result = Real32.toString result + in + if String.isSubstring "." result then result else result ^ ".0" + end + + fun colToRealString col = + let + val result = Real32.fromInt col / 255.0 + val result = Real32.toString result + in + if String.isSubstring "." result then result else result ^ ".0" + end + + fun toExportStringFolder ({x, ex, y, ey, data = {r, g, b, a}}, acc) = + let + val x = intToRealString x + val y = intToRealString y + val ex = intToRealString ex + val ey = intToRealString ey + val r = colToRealString r + val g = colToRealString g + val b = colToRealString b + + val x = String.concat ["((", x, " - halfWidth) / halfWidth)"] + val y = String.concat ["(~(", y, " - halfHeight) / halfHeight)"] + + val ex = String.concat + [ "(((((" + , ex + , " - " + , x + , ") " + , "* scale) + " + , x + , ") - halfWidth) / halfWidth)" + ] + + val ey = String.concat + [ "(" + , "(" + , "(" + , "(" + , "(" + , ey + , " - " + , y + , ")" + , "* scale) + " + , y + , ") - halfHeight) / halfHeight)" + ] + in + x :: y :: ex :: ex :: y :: ey :: r :: g :: b :: acc + end + + fun toExportString (squares, canvasWidth, canvasHeight) = + let + val size = Int.max (canvasWidth, canvasHeight) + val qtree = buildTree (0, 0, size, squares) + val bintree = merge (qtree, squares) + + val coords = BinTree.foldr (toExportStringFolder, bintree, []) + val coords = String.concatWith "," coords + + val header = "" + val footer = "" + in + String.concat [header, coords, footer] + end end