humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

undo implemented and working fine

Browse Source
This commit is contained in:
Humza Shahid
2024-08-08 21:35:48 +01:00
parent 5c7c61586a
commit 89f4ae3b13
6 changed files with 164 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
dotscape
View File

Binary file not shown.

4
functional-core/app-type.sml
View File

@@ -23,7 +23,7 @@ sig
, xClickPoints: Real32.real vector
, yClickPoints: Real32.real vector
, graphLines: Real32.real vector
, undo: (int * int) list
, undo: (Real32.real * Real32.real) list
}
end
@@ -60,6 +60,6 @@ struct
, xClickPoints: Real32.real vector
, yClickPoints: Real32.real vector
, graphLines: Real32.real vector
, undo: (int * int) list
, undo: (Real32.real * Real32.real) list
}
end

59
functional-core/app-update.sml
View File

@@ -44,6 +44,7 @@ struct
, windowWidth
, windowHeight
)
val newUndoTuple = (hpos, vpos)
in
if Vector.length buttonVec > 0 then
case #triangleStage model of
@@ -53,7 +54,8 @@ struct
val drawMsg = DRAW_BUTTON drawVec
val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
val model = AppWith.triangleStage (model, newTriangleStage)
val model =
AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple)
in
(model, drawMsg, mouseX, mouseY)
end
@@ -65,14 +67,15 @@ struct
val newTriangleStage = SECOND
{x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
val model = AppWith.triangleStage (model, newTriangleStage)
val model =
AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple)
in
(model, drawMsg, mouseX, mouseY)
end
| SECOND {x1, y1, x2, y2} =>
let
val model = AppWith.newTriangle
(model, x1, y1, x2, y2, hpos, vpos)
(model, x1, y1, x2, y2, hpos, vpos, newUndoTuple)
val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec
@@ -95,6 +98,49 @@ struct
(model, drawMsg, mouseX, mouseY)
end
fun undoAction (model, mouseX, mouseY) =
case #triangleStage model of
FIRST {x1, y1} =>
(* Change FIRST to NO_TRIANGLE and clear buttons. *)
let val model = AppWith.replaceTriangleStage (model, NO_TRIANGLE)
in (model, CLEAR_BUTTONS, mouseX, mouseY)
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 drawVec =
TriangleStage.firstToVector (x1, y1, Vector.fromList [], model)
val drawMsg = DRAW_BUTTON drawVec
in
(model, drawMsg, mouseX, mouseY)
end
| NO_TRIANGLE =>
(case #triangles model of
{x1, y1, x2, y2, ...} :: 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)
val newTriangleVec = Triangles.toVector model
val drawVec = TriangleStage.secondToVector
(x1, y1, x2, y2, newTriangleVec, model)
val drawMsg =
DRAW_TRIANGLES_AND_BUTTONS
{triangles = newTriangleVec, buttons = drawVec}
in
(model, drawMsg, mouseX, mouseY)
end
| [] =>
(* Can't undo, because there are no actions to undo. *)
(model, NO_DRAW, mouseX, mouseY))
fun update (model: app_type, mouseX, mouseY, inputMsg) =
case inputMsg of
MOUSE_MOVE {x = mouseX, y = mouseY} =>
@@ -103,10 +149,5 @@ struct
| MOUSE_LEFT_CLICK => mouseLeftClick (model, mouseX, mouseY)
| RESIZE_WINDOW {width, height} =>
resizeWindow (model, mouseX, mouseY, width, height)
| UNDO_ACTION =>
let
val _ = print "undo action\n"
in
(model, NO_DRAW, mouseX, mouseY)
end
| UNDO_ACTION => undoAction (model, mouseX, mouseY)
end

73
functional-core/app-with.sml
View File

@@ -1,8 +1,17 @@
signature APP_WITH =
sig
val windowResize: AppType.app_type * int * int -> AppType.app_type
val triangleStage: AppType.app_type * AppType.triangle_stage
-> AppType.app_type
val newTriangleStage:
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
val newTriangle:
AppType.app_type
* Real32.real
@@ -11,6 +20,7 @@ sig
* Real32.real
* Real32.real
* Real32.real
* (Real32.real * Real32.real)
-> AppType.app_type
end
@@ -18,7 +28,33 @@ structure AppWith :> APP_WITH =
struct
open AppType
fun triangleStage (app: app_type, newTriangleStage: triangle_stage) : app_type =
fun newTriangleStage
(app: app_type, newTriangleStage: triangle_stage, xyTuple) : app_type =
let
val
{ triangleStage = _
, triangles
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, graphLines
, undo
} = app
val newUndo = xyTuple :: undo
in
{ triangleStage = newTriangleStage
, triangles = triangles
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, graphLines = graphLines
, undo = newUndo
}
end
fun replaceTriangleStage (app: app_type, newTriangleStage) =
let
val
{ triangleStage = _
@@ -42,7 +78,33 @@ struct
}
end
fun newTriangle (app: app_type, x1, y1, x2, y2, x3, y3) : app_type =
fun undoTriangle
(app: app_type, newTriangleStage: triangle_stage, trianglesTl) : app_type =
let
val
{ triangleStage = _
, triangles = _
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, graphLines
, undo
} = app
in
{ triangleStage = newTriangleStage
, triangles = trianglesTl
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, graphLines = graphLines
, undo = undo
}
end
fun newTriangle (app: app_type, x1, y1, x2, y2, x3, y3, newUndoTuple) :
app_type =
let
val
{ triangles
@@ -57,6 +119,7 @@ struct
val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
val newTriangles = newTriangle :: triangles
val newUndo = newUndoTuple :: undo
in
{ triangleStage = NO_TRIANGLE
, triangles = newTriangles
@@ -65,7 +128,7 @@ struct
, windowWidth = windowWidth
, windowHeight = windowHeight
, graphLines = graphLines
, undo = undo
, undo = newUndo
}
end

38
imperative-shell/event-loop.sml
View File

@@ -91,6 +91,44 @@ struct
, triangleDrawLength
)
end
| DRAW_TRIANGLES_AND_BUTTONS
{triangles = triangleVec, buttons = buttonsVec} =>
let
val _ =
AppDraw.uploadTrianglesVector
(triangleDrawObject, triangleVec)
val triangleDrawLength = Vector.length triangleVec div 2
val _ =
AppDraw.uploadButtonVector (buttonDrawObject, buttonsVec)
val buttonDrawLength = Vector.length buttonsVec div 5
in
draw
( drawMailbox
, window
, graphDrawObject
, drawGraphLength
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
)
end
| CLEAR_BUTTONS =>
let
val buttonDrawLength = 0
in
draw
( drawMailbox
, window
, graphDrawObject
, drawGraphLength
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
)
end
| RESIZE_TRIANGLES_BUTTONS_AND_GRAPH {triangles, graphLines} =>
let
val _ =

6
message-types/draw-msg.sml
View File

@@ -2,9 +2,12 @@ signature DRAW_MESSAGE =
sig
datatype t =
DRAW_BUTTON of Real32.real vector
| DRAW_TRIANGLES_AND_BUTTONS of
{triangles: Real32.real vector, buttons: Real32.real vector}
| DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
| RESIZE_TRIANGLES_BUTTONS_AND_GRAPH of
{triangles: Real32.real vector, graphLines: Real32.real vector}
| CLEAR_BUTTONS
| NO_DRAW
end
@@ -12,8 +15,11 @@ structure DrawMessage :> DRAW_MESSAGE =
struct
datatype t =
DRAW_BUTTON of Real32.real vector
| DRAW_TRIANGLES_AND_BUTTONS of
{triangles: Real32.real vector, buttons: Real32.real vector}
| DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
| RESIZE_TRIANGLES_BUTTONS_AND_GRAPH of
{triangles: Real32.real vector, graphLines: Real32.real vector}
| CLEAR_BUTTONS
| NO_DRAW
end