done with functional-core logic for redo (now just need to send REDO_ACTION on key callback when shortcut is pressed)
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user