add redo stack, and adjust functions to clear it when new triangle or triangle_stage is added; when an undo function is called, the undoHd becomes the redoHd, and undo becomes undoTl, which is expected behaviour. Still need to implement REDO_ACTION though.

2024-08-08 23:10:38 +01:00
parent 4243e4c679
commit 10b3617689
5 changed files with 126 additions and 84 deletions
--- a/BIN
+++ b/BIN
--- a/functional-core/app-init.sml
+++ b/functional-core/app-init.sml
@@ -24,6 +24,7 @@ struct
      , yClickPoints = yClickPoints
      , graphLines = graphLines
      , undo = []
+      , redo = []
      , mouseX = 0.0
      , mouseY = 0.0
      }
--- a/functional-core/app-type.sml
+++ b/functional-core/app-type.sml
@@ -24,6 +24,7 @@ sig
    , yClickPoints: Real32.real vector
    , graphLines: Real32.real vector
    , undo: (Real32.real * Real32.real) list
+    , redo: (Real32.real * Real32.real) list
    , mouseX: Real32.real
    , mouseY: Real32.real
    }
@@ -63,6 +64,7 @@ struct
    , yClickPoints: Real32.real vector
    , graphLines: Real32.real vector
    , undo: (Real32.real * Real32.real) list
+    , redo: (Real32.real * Real32.real) list
    , mouseX: Real32.real
    , mouseY: Real32.real
    }
--- a/functional-core/app-update.sml
+++ b/functional-core/app-update.sml
@@ -1,6 +1,6 @@
 signature APP_UPDATE =
 sig
-  val update: AppType.app_type *  InputMessage.t
+  val update: AppType.app_type * InputMessage.t
              -> AppType.app_type * DrawMessage.t
 end

@@ -73,7 +73,7 @@ struct

              val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
              val model =
-                AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple)
+                AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple)
            in
              (model, drawMsg)
            end
@@ -86,13 +86,13 @@ struct
              val newTriangleStage = SECOND
                {x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
              val model =
-                AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple)
+                AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple)
            in
              (model, drawMsg)
            end
        | SECOND {x1, y1, x2, y2} =>
            let
-              val model = AppWith.newTriangle
+              val model = AppWith.addTriangle
                (model, x1, y1, x2, y2, hpos, vpos, newUndoTuple)

              val drawVec = Triangles.toVector model
@@ -120,31 +120,33 @@ struct
    case #triangleStage model of
      FIRST {x1, y1} =>
        (* Change FIRST to NO_TRIANGLE and clear buttons. *)
-        let val model = AppWith.replaceTriangleStage (model, NO_TRIANGLE)
+        let val model = AppWith.undoTriangleStage (model, NO_TRIANGLE, (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.replaceTriangleStage (model, newTriangleStage)
+          val model =
+            AppWith.undoTriangleStage (model, newTriangleStage, (x2, y2))

-          val drawVec =
-            TriangleStage.firstToVector (x1, y1, Vector.fromList [], model)
+          val emptyVec: Real32.real vector = Vector.fromList []
+          val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model)
          val drawMsg = DRAW_BUTTON drawVec
        in
          (model, drawMsg)
        end
    | NO_TRIANGLE =>
        (case #triangles model of
-           {x1, y1, x2, y2, ...} :: trianglesTl =>
+           {x1, y1, x2, y2, x3, y3} :: trianglesTl =>
             (* Have to slice off (x3, y3) from triangle head,
              * turn (x1, y1, x2, y2) into a triangleStage,
              * and redraw both triangle and triangleStage. *)
             let
               val triangleStage = SECOND {x1 = x1, y1 = y1, x2 = x2, y2 = y2}
               val model =
-                 AppWith.undoTriangle (model, triangleStage, trianglesTl)
+                 AppWith.undoTriangle
+                   (model, triangleStage, trianglesTl, (x3, y3))

               val newTriangleVec = Triangles.toVector model
               val drawVec = TriangleStage.secondToVector
@@ -167,7 +169,6 @@ struct
        end
    | MOUSE_LEFT_RELEASE => mouseMoveOrRelease model
    | MOUSE_LEFT_CLICK => mouseLeftClick model
-    | RESIZE_WINDOW {width, height} =>
-        resizeWindow (model, width, height)
+    | RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
    | UNDO_ACTION => undoAction model
 end
--- a/functional-core/app-with.sml
+++ b/functional-core/app-with.sml
@@ -2,17 +2,30 @@ signature APP_WITH =
 sig
  val windowResize: AppType.app_type * int * int -> AppType.app_type

-  val newTriangleStage:
+  val mousePosition: AppType.app_type * Real32.real * Real32.real
+                     -> AppType.app_type
+
+  val undoTriangleStage:
    AppType.app_type * AppType.triangle_stage * (Real32.real * Real32.real)
    -> AppType.app_type
-  val replaceTriangleStage: AppType.app_type * AppType.triangle_stage
-                            -> AppType.app_type

  val undoTriangle:
-    AppType.app_type * AppType.triangle_stage * AppType.triangle list
+    AppType.app_type
+    * AppType.triangle_stage
+    * AppType.triangle list
+    * (Real32.real * Real32.real)
    -> AppType.app_type

-  val newTriangle:
+  (* 
+   * add functions clear the redo stack, 
+   * as they are meant to be called after a click action,
+   * and also add new click position to undo stack.
+   *)
+  val addTriangleStage:
+    AppType.app_type * AppType.triangle_stage * (Real32.real * Real32.real)
+    -> AppType.app_type
+
+  val addTriangle:
    AppType.app_type
    * Real32.real
    * Real32.real
@@ -22,17 +35,15 @@ sig
    * Real32.real
    * (Real32.real * Real32.real)
    -> AppType.app_type
-
-  val mousePosition: AppType.app_type * Real32.real * Real32.real
-                     -> AppType.app_type
 end

 structure AppWith :> APP_WITH =
 struct
  open AppType

-  fun newTriangleStage
-    (app: app_type, newTriangleStage: triangle_stage, xyTuple) : app_type =
+  (* add to undo, clear redo *)
+  fun addTriangleStage
+    (app: app_type, newTriangleStage: triangle_stage, newUndoHd) : app_type =
    let
      val
        { triangleStage = _
@@ -43,84 +54,28 @@ struct
        , windowHeight
        , graphLines
        , undo
+        , redo = _
        , mouseX
        , mouseY
        } = app

-      val newUndo = xyTuple :: undo
+      val newUndo = newUndoHd :: undo
    in
      { triangleStage = newTriangleStage
-      , triangles = triangles
-      , xClickPoints = xClickPoints
-      , yClickPoints = yClickPoints
-      , windowWidth = windowWidth
-      , windowHeight = windowHeight
-      , graphLines = graphLines
      , undo = newUndo
-      , mouseX = mouseX
-      , mouseY = mouseY
-      }
-    end
-
-  fun replaceTriangleStage (app: app_type, newTriangleStage) =
-    let
-      val
-        { triangleStage = _
-        , triangles
-        , xClickPoints
-        , yClickPoints
-        , windowWidth
-        , windowHeight
-        , graphLines
-        , undo
-        , mouseX
-        , mouseY
-        } = app
-    in
-      { triangleStage = newTriangleStage
+      , redo = []
      , triangles = triangles
      , xClickPoints = xClickPoints
      , yClickPoints = yClickPoints
      , windowWidth = windowWidth
      , windowHeight = windowHeight
      , graphLines = graphLines
-      , undo = undo
      , mouseX = mouseX
      , mouseY = mouseY
      }
    end

-  fun undoTriangle
-    (app: app_type, newTriangleStage: triangle_stage, trianglesTl) : app_type =
-    let
-      val
-        { triangleStage = _
-        , triangles = _
-        , xClickPoints
-        , yClickPoints
-        , windowWidth
-        , windowHeight
-        , graphLines
-        , undo
-        , mouseX
-        , mouseY
-        } = app
-    in
-      { triangleStage = newTriangleStage
-      , triangles = trianglesTl
-      , xClickPoints = xClickPoints
-      , yClickPoints = yClickPoints
-      , windowWidth = windowWidth
-      , windowHeight = windowHeight
-      , graphLines = graphLines
-      , undo = undo
-      , mouseX = mouseX
-      , mouseY = mouseY
-      }
-    end
-
-  fun newTriangle (app: app_type, x1, y1, x2, y2, x3, y3, newUndoTuple) :
-    app_type =
+  fun addTriangle (app: app_type, x1, y1, x2, y2, x3, y3, newUndoHd) : app_type =
    let
      val
        { triangles
@@ -131,17 +86,96 @@ struct
        , windowHeight
        , graphLines
        , undo
+        , redo = _
        , mouseX
        , mouseY
        } = app

      val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
      val newTriangles = newTriangle :: triangles
-      val newUndo = newUndoTuple :: undo
+      val newUndo = newUndoHd :: undo
    in
      { triangleStage = NO_TRIANGLE
      , triangles = newTriangles
      , undo = newUndo
+      , redo = []
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , graphLines = graphLines
+      , mouseX = mouseX
+      , mouseY = mouseY
+      }
+    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
@@ -165,9 +199,11 @@ struct
        , triangles
        , triangleStage
        , undo
+        , redo
        , mouseX
        , mouseY
        } = app
+
      val xClickPoints = ClickPoints.generate (wStart, wFinish)
      val yClickPoints = ClickPoints.generate (hStart, hFinish)
      val graphLines =
@@ -182,6 +218,7 @@ struct
      , windowWidth = windowWidth
      , windowHeight = windowHeight
      , undo = undo
+      , redo = redo
      , mouseX = mouseX
      , mouseY = mouseY
      }
@@ -223,8 +260,8 @@ struct
        , windowHeight
        , graphLines
        , undo
+        , redo
        } = app
-
    in
      { mouseX = mouseX
      , mouseY = mouseY
@@ -236,6 +273,7 @@ struct
      , windowHeight = windowHeight
      , graphLines = graphLines
      , undo = undo
+      , redo = redo
      }
    end
 end