diff --git a/dotscape b/dotscape index cb8b756..79f1b7c 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/app-with.sml b/fcore/app-with.sml index 462e71b..4738112 100644 --- a/fcore/app-with.sml +++ b/fcore/app-with.sml @@ -3,12 +3,12 @@ struct open AppType fun updateSquares (squares, newX, newY, item) = - let - val yAxis = Vector.sub (squares, newX) - val yAxis = Vector.update (yAxis, newY, item) - in - Vector.update (squares, newX, yAxis) - end + let + val yAxis = Vector.sub (squares, newX) + val yAxis = Vector.update (yAxis, newY, item) + in + Vector.update (squares, newX, yAxis) + end fun changeSquaresSize (squares, newCanvasWidth, newCanvasHeight) = let diff --git a/fcore/common-update.sml b/fcore/common-update.sml index f19cccd..7ece0d5 100644 --- a/fcore/common-update.sml +++ b/fcore/common-update.sml @@ -1,8 +1,22 @@ structure CommonUpdate = struct - (* unimplemented *) - fun getSaveSquaresMsg model = (model, []) + open AppType + open DrawMessage + open FileMessage + open InputMessage + open UpdateMessage + + fun getSaveSquaresMsg (model: app_type) = + let + val {canvasWidth, canvasHeight, squares, ...} = model + val str = CollisionTree.toString (squares, canvasWidth, canvasHeight) + val msg = SAVE_SQUARES str + in + (model, [FILE msg]) + end + + (* unimplemented *) fun getLoadSquaresMsg model = (model, []) fun getExportSquaresMsg model = (model, []) diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index de0e144..7076764 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -520,19 +520,25 @@ struct , Int.toString b , " " , Int.toString a - , " }" + , " } " ] in item :: acc end - fun toString (squares, size) = + fun toString (squares, canvasWidth, canvasHeight) = let + val size = Int.max (canvasWidth, canvasHeight) val qtree = buildTree (0, 0, size, squares) val bintree = merge (qtree, squares) - val vec = BinTree.foldr (toStringFolder, bintree, []) + val initial = ["}"] + val acc = BinTree.foldr (toStringFolder, bintree, initial) + val acc = + String.concat + [Int.toString canvasWidth, " ", Int.toString canvasHeight, " { "] + :: acc in - Vector.concat vec + String.concat acc end end diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index f130f01..078d7f4 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -51,7 +51,13 @@ struct fun loadSquares (path, inputMailbox) = () - fun saveSquares squares = () + fun saveSquares squaresString = + let + val io = TextIO.openOut filename + val () = TextIO.output (io, squaresString) + in + TextIO.closeOut io + end fun getDirList (dir, acc, rootPath) = case OS.FileSys.readDir dir of @@ -87,7 +93,7 @@ struct let val _ = case Mailbox.recv fileMailbox of - SAVE_SQUARES triangles => saveSquares triangles + SAVE_SQUARES str => saveSquares str | LOAD_SQUARES => loadSquares (filename, inputMailbox) | EXPORT_SQUARES triangles => exportSquares triangles | LOAD_FILES path => loadFiles (path, inputMailbox) diff --git a/message-types/file-msg.sml b/message-types/file-msg.sml index 02156db..8a59384 100644 --- a/message-types/file-msg.sml +++ b/message-types/file-msg.sml @@ -1,7 +1,7 @@ structure FileMessage = struct datatype t = - SAVE_SQUARES of int vector vector + SAVE_SQUARES of string | LOAD_SQUARES | EXPORT_SQUARES of int vector vector | LOAD_FILES of string