diff --git a/dotscape b/dotscape index d86b965..6f58cd0 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index d8cd667..0877e53 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -120,15 +120,18 @@ struct case #triangleStage model of FIRST {x1, y1} => (* Change FIRST to NO_TRIANGLE and clear buttons. *) - let val model = AppWith.undoTriangleStage (model, NO_TRIANGLE, (x1, y1)) - in (model, CLEAR_BUTTONS) + let + val model = + AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1)) + in + (model, CLEAR_BUTTONS) end | SECOND {x1, y1, x2, y2} => (* Change FIRST to SECOND and redraw buttons. *) let val newTriangleStage = FIRST {x1 = x1, y1 = y1} val model = - AppWith.undoTriangleStage (model, newTriangleStage, (x2, y2)) + AppWith.undo (model, newTriangleStage, #triangles model, (x2, y2)) val emptyVec: Real32.real vector = Vector.fromList [] val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model) @@ -145,8 +148,7 @@ struct let val triangleStage = SECOND {x1 = x1, y1 = y1, x2 = x2, y2 = y2} val model = - AppWith.undoTriangle - (model, triangleStage, trianglesTl, (x3, y3)) + AppWith.undo (model, triangleStage, trianglesTl, (x3, y3)) val newTriangleVec = Triangles.toVector model val drawVec = TriangleStage.secondToVector @@ -161,6 +163,60 @@ struct (* Can't undo, because there are no actions to undo. *) (model, NO_DRAW)) + fun redoAction model = + case #redo model of + (redoHd as (x, y)) :: tl => + (* There is a click point to redo. *) + (case #triangleStage model of + NO_TRIANGLE => + (* add to triangle stage, and redraw buttons *) + let + val newTriangleStage = FIRST {x1 = x, y1 = y} + val model = + AppWith.redo + (model, newTriangleStage, #triangles model, redoHd) + + val emptyVec: Real32.real vector = Vector.fromList [] + val drawVec = + TriangleStage.firstToVector (x1, y1, emptyVec, model) + val drawMsg = DRAW_BUTTON drawVec + in + (model, drawMsg) + end + | FIRST {x1, y1} => + (* add to triangle stage, redraw buttons *) + let + val newTriangleStage = SECOND {x1 = x1, y1 = y1, x2 = x, y2 = y} + val model = + AppWith.redo + (model, newTriangleStage, #triangles model, redoHd) + + val emptyVec: Real32.real vector = Vector.fromList [] + val drawVec = TriangleStage.secondToVector + (x1, y1, x, y, emptyVec, model) + val drawMsg = DRAW_BUTTON drawVec + in + (model, drawMsg) + end + | SECOND {x1, y1, x2, y2} => + (* clear triangle stage, add to trinagle list and redraw triangles *) + let + val newTriangleStage = NO_TRIANGLE + val newTriangle = + {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x, y3 = y} + val newTriangles = newUndoTuple :: (#triangles model) + val model = + AppWith.redo (model, newTriangleStage, newTriangles, redoHd) + + val drawVec = Triangles.toVector model + val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec + in + (model, drawMsg) + end) + | [] => + (* Nothing to redo. *) + (model, NO_DRAW) + fun update (model: app_type, inputMsg) = case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => @@ -171,4 +227,5 @@ struct | MOUSE_LEFT_CLICK => mouseLeftClick model | RESIZE_WINDOW {width, height} => resizeWindow (model, width, height) | UNDO_ACTION => undoAction model + | REDO_ACTION => redoAction model end diff --git a/functional-core/app-with.sml b/functional-core/app-with.sml index e9051ab..65c5c77 100644 --- a/functional-core/app-with.sml +++ b/functional-core/app-with.sml @@ -5,11 +5,14 @@ sig val mousePosition: AppType.app_type * Real32.real * Real32.real -> AppType.app_type - val undoTriangleStage: - AppType.app_type * AppType.triangle_stage * (Real32.real * Real32.real) + val undo: + AppType.app_type + * AppType.triangle_stage + * AppType.triangle list + * (Real32.real * Real32.real) -> AppType.app_type - val undoTriangle: + val redo: AppType.app_type * AppType.triangle_stage * AppType.triangle list @@ -109,83 +112,6 @@ struct } end - (* add to redo, pop one from undo *) - fun undoTriangleStage (app: app_type, newTriangleStage, newRedoHd) = - let - val - { triangleStage = _ - , triangles - , xClickPoints - , yClickPoints - , windowWidth - , windowHeight - , graphLines - , undo - , redo - , mouseX - , mouseY - } = app - - val newUndo = - case undo of - hd :: tl => tl - | empty => empty - - val newRedo = newRedoHd :: redo - in - { triangleStage = newTriangleStage - , triangles = triangles - , undo = newUndo - , redo = newRedo - , xClickPoints = xClickPoints - , yClickPoints = yClickPoints - , windowWidth = windowWidth - , windowHeight = windowHeight - , graphLines = graphLines - , mouseX = mouseX - , mouseY = mouseY - } - end - - fun undoTriangle - (app: app_type, newTriangleStage: triangle_stage, trianglesTl, newRedoHd) : - app_type = - let - val - { triangleStage = _ - , triangles = _ - , xClickPoints - , yClickPoints - , windowWidth - , windowHeight - , graphLines - , undo - , redo - , mouseX - , mouseY - } = app - - val newUndo = - case undo of - hd :: tl => tl - | empty => empty - - val newRedo = newRedoHd :: redo - in - { triangleStage = newTriangleStage - , triangles = trianglesTl - , undo = newUndo - , redo = newRedo - , xClickPoints = xClickPoints - , yClickPoints = yClickPoints - , windowWidth = windowWidth - , windowHeight = windowHeight - , graphLines = graphLines - , mouseX = mouseX - , mouseY = mouseY - } - end - fun helpWindowResize (app: app_type, windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) : app_type = @@ -276,4 +202,79 @@ struct , redo = redo } end + + (* add to redo, pop one from undo *) + fun undo (app: app_type, newTriangleStage, newTriangles, newRedoHd) = + let + val + { triangleStage = _ + , triangles = _ + , xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , graphLines + , undo + , redo + , mouseX + , mouseY + } = app + + val newUndo = + case undo of + hd :: tl => tl + | empty => empty + + val newRedo = newRedoHd :: redo + in + { triangleStage = newTriangleStage + , triangles = newTriangles + , undo = newUndo + , redo = newRedo + , xClickPoints = xClickPoints + , yClickPoints = yClickPoints + , windowWidth = windowWidth + , windowHeight = windowHeight + , graphLines = graphLines + , mouseX = mouseX + , mouseY = mouseY + } + end + + (* add to undo, pop one from redo *) + fun redo (app: app_type, newTriangleStage, newTriangles, newUndoHd) = + let + val + { triangleStage = _ + , triangles = _ + , xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , graphLines + , undo + , redo + , mouseX + , mouseY + } = app + + val newUndo = newUndoHd :: undo + val newRedo = + case redo of + hd :: tl => tl + | empty => empty + in + { triangleStage = newTriangleStage + , triangles = newTriangles + , undo = newUndo + , redo = newRedo + , xClickPoints = xClickPoints + , yClickPoints = yClickPoints + , windowWidth = windowWidth + , windowHeight = windowHeight + , graphLines = graphLines + , mouseX = mouseX + , mouseY = mouseY + } + end end diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index 3f2ce1a..4f8b6f2 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -6,6 +6,7 @@ sig | MOUSE_LEFT_RELEASE | RESIZE_WINDOW of {width: int, height: int} | UNDO_ACTION + | REDO_ACTION end structure InputMessage :> INPUT_MESSAGE = @@ -16,4 +17,5 @@ struct | MOUSE_LEFT_RELEASE | RESIZE_WINDOW of {width: int, height: int} | UNDO_ACTION + | REDO_ACTION end