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

change AppUpdate.update function to return a list, so we can return multiple messages from a single event

Browse Source
This commit is contained in:
Humza Shahid
2024-09-27 08:27:53 +01:00
parent 57fbf5f1aa
commit e3ff121a35
4 changed files with 67 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
dotscape
View File

Binary file not shown.

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

@@ -1,7 +1,7 @@
signature APP_UPDATE = signature APP_UPDATE =
sig sig
val update: AppType.app_type * InputMessage.t val update: AppType.app_type * InputMessage.t
-> AppType.app_type * UpdateMessage.t -> AppType.app_type * UpdateMessage.t list
end end
structure AppUpdate :> APP_UPDATE = structure AppUpdate :> APP_UPDATE =
@@ -32,8 +32,9 @@ struct
val drawVec = TriangleStage.toVector (model, drawVec) val drawVec = TriangleStage.toVector (model, drawVec)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
fun getDrawDotMsgWhenArrowIsAtBoundary model = fun getDrawDotMsgWhenArrowIsAtBoundary model =
@@ -42,8 +43,9 @@ struct
val dotVec = getDotVecFromIndices (model, arrowX, arrowY) val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec) val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
fun moveArrowUp (model: app_type) = fun moveArrowUp (model: app_type) =
@@ -58,8 +60,9 @@ struct
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY) val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val dotVec = TriangleStage.toVector (model, dotVec) val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
else else
getDrawDotMsgWhenArrowIsAtBoundary model getDrawDotMsgWhenArrowIsAtBoundary model
@@ -77,8 +80,9 @@ struct
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY) val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec) val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
else else
getDrawDotMsgWhenArrowIsAtBoundary model getDrawDotMsgWhenArrowIsAtBoundary model
@@ -96,8 +100,9 @@ struct
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY) val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec) val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
else else
getDrawDotMsgWhenArrowIsAtBoundary model getDrawDotMsgWhenArrowIsAtBoundary model
@@ -115,8 +120,9 @@ struct
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY) val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val dotVec = TriangleStage.toVector (model, dotVec) val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
else else
getDrawDotMsgWhenArrowIsAtBoundary model getDrawDotMsgWhenArrowIsAtBoundary model
@@ -152,24 +158,26 @@ struct
let let
val drawVec = TriangleStage.toVector (model, dotVec) val drawVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
val newTriangleStage = FIRST {x1 = hpos, y1 = vpos} val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
val model = AppWith.addTriangleStage val model = AppWith.addTriangleStage
(model, newTriangleStage, newUndoTuple, hIdx, vIdx) (model, newTriangleStage, newUndoTuple, hIdx, vIdx)
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| FIRST {x1, y1} => | FIRST {x1, y1} =>
let let
val drawVec = TriangleStage.firstToVector (x1, y1, dotVec, model) val drawVec = TriangleStage.firstToVector (x1, y1, dotVec, model)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
val newTriangleStage = SECOND val newTriangleStage = SECOND
{x1 = x1, y1 = y1, x2 = hpos, y2 = vpos} {x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
val model = AppWith.addTriangleStage val model = AppWith.addTriangleStage
(model, newTriangleStage, newUndoTuple, hIdx, vIdx) (model, newTriangleStage, newUndoTuple, hIdx, vIdx)
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| SECOND {x1, y1, x2, y2} => | SECOND {x1, y1, x2, y2} =>
let let
@@ -177,15 +185,16 @@ struct
(model, x1, y1, x2, y2, hpos, vpos, newUndoTuple, hIdx, vIdx) (model, x1, y1, x2, y2, hpos, vpos, newUndoTuple, hIdx, vIdx)
val drawVec = Triangles.toVector model val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
end end
fun mouseLeftClick model = fun mouseLeftClick model =
case ClickPoints.getClickPositionFromMouse model of case ClickPoints.getClickPositionFromMouse model of
SOME (hIdx, vIdx) => addCoordinates (model, hIdx, vIdx) SOME (hIdx, vIdx) => addCoordinates (model, hIdx, vIdx)
| NONE => (model, NO_MAILBOX) | NONE => (model, [])
fun enterOrSpaceCoordinates model = fun enterOrSpaceCoordinates model =
let val {arrowX, arrowY, ...} = model let val {arrowX, arrowY, ...} = model
@@ -206,8 +215,9 @@ struct
val drawMsg = val drawMsg =
RESIZE_TRIANGLES_DOTS_AND_GRAPH RESIZE_TRIANGLES_DOTS_AND_GRAPH
{triangles = triangles, graphLines = graphLines, dots = dots} {triangles = triangles, graphLines = graphLines, dots = dots}
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
fun undoAction model = fun undoAction model =
@@ -218,7 +228,7 @@ struct
val model = val model =
AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1)) AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1))
in in
(model, DRAW CLEAR_DOTS) (model, [DRAW CLEAR_DOTS])
end end
| SECOND {x1, y1, x2, y2} => | SECOND {x1, y1, x2, y2} =>
(* Change FIRST to SECOND and redraw dots. *) (* Change FIRST to SECOND and redraw dots. *)
@@ -230,8 +240,9 @@ struct
val emptyVec: Real32.real vector = Vector.fromList [] val emptyVec: Real32.real vector = Vector.fromList []
val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model) val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| NO_TRIANGLE => | NO_TRIANGLE =>
(case #triangles model of (case #triangles model of
@@ -251,12 +262,13 @@ struct
val drawMsg = val drawMsg =
DRAW_TRIANGLES_AND_DOTS DRAW_TRIANGLES_AND_DOTS
{triangles = newTriangleVec, dots = drawVec} {triangles = newTriangleVec, dots = drawVec}
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| [] => | [] =>
(* Can't undo, because there are no actions to undo. *) (* Can't undo, because there are no actions to undo. *)
(model, NO_MAILBOX)) (model, []))
fun redoAction model = fun redoAction model =
case #redo model of case #redo model of
@@ -274,8 +286,9 @@ struct
val emptyVec: Real32.real vector = Vector.fromList [] val emptyVec: Real32.real vector = Vector.fromList []
val drawVec = TriangleStage.firstToVector (x, y, emptyVec, model) val drawVec = TriangleStage.firstToVector (x, y, emptyVec, model)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| FIRST {x1, y1} => | FIRST {x1, y1} =>
(* add to triangle stage, redraw dots *) (* add to triangle stage, redraw dots *)
@@ -289,8 +302,9 @@ struct
val drawVec = TriangleStage.secondToVector val drawVec = TriangleStage.secondToVector
(x1, y1, x, y, emptyVec, model) (x1, y1, x, y, emptyVec, model)
val drawMsg = DRAW_DOT drawVec val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
| SECOND {x1, y1, x2, y2} => | SECOND {x1, y1, x2, y2} =>
(* clear triangle stage, add to trinagle list and redraw triangles *) (* clear triangle stage, add to trinagle list and redraw triangles *)
@@ -304,44 +318,50 @@ struct
val drawVec = Triangles.toVector model val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end) end)
| [] => (* Nothing to redo. *) (model, NO_MAILBOX) | [] => (* Nothing to redo. *) (model, [])
fun toggleGraph (model: app_type) = fun toggleGraph (model: app_type) =
if #showGraph model then if #showGraph model then
let let
val model = AppWith.graphVisibility (model, false) val model = AppWith.graphVisibility (model, false)
val drawMsg = DRAW_GRAPH (Vector.fromList []) val drawMsg = DRAW_GRAPH (Vector.fromList [])
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
else else
let let
val model = AppWith.graphVisibility (model, true) val model = AppWith.graphVisibility (model, true)
val graphLines = GraphLines.generate model val graphLines = GraphLines.generate model
val drawMsg = DRAW_GRAPH graphLines val drawMsg = DRAW_GRAPH graphLines
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
fun getSaveTrianglesMsg model = fun getSaveTrianglesMsg model =
let let
val {triangles, ...} = model val {triangles, ...} = model
val fileMsg = SAVE_TRIANGLES triangles val fileMsg = SAVE_TRIANGLES triangles
val fileMsg = [FILE fileMsg]
in in
(model, FILE fileMsg) (model, fileMsg)
end end
fun getLoadTrianglesMsg model = (model, FILE LOAD_TRIANGLES) fun getLoadTrianglesMsg model =
(model, [FILE LOAD_TRIANGLES])
fun getExportTrianglesMsg model = fun getExportTrianglesMsg model =
let let
val {triangles, ...} = model val {triangles, ...} = model
val fileMsg = EXPORT_TRIANGLES (#triangles model) val fileMsg = EXPORT_TRIANGLES (#triangles model)
val fileMsg = [FILE fileMsg]
in in
(model, FILE fileMsg) (model, fileMsg)
end end
fun useTriangles (model, triangles) = fun useTriangles (model, triangles) =
@@ -349,28 +369,28 @@ struct
val model = AppWith.useTriangles (model, triangles) val model = AppWith.useTriangles (model, triangles)
val drawVec = Triangles.toVector model val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
val drawMsg = [DRAW drawMsg]
in in
(model, DRAW drawMsg) (model, drawMsg)
end end
fun trianglesLoadError model = (model, NO_MAILBOX) fun trianglesLoadError model = (model, [])
fun enterBrowseMode model = fun enterBrowseMode model =
let let
val model = AppWith.mode (model, AppType.BROWSE_MODE) val model = AppWith.mode (model, AppType.BROWSE_MODE)
(* todo: should draw modal window as well *) (* todo: should draw modal window as well *)
val fileMsg = LOAD_FILES (#openFilePath model) val fileMsg = LOAD_FILES (#openFilePath model)
val fileMsg = [FILE fileMsg]
in in
(model, FILE fileMsg) (model, fileMsg)
end end
fun handleFileBrowserAndPath (model, fileBrowser, path) = fun handleFileBrowserAndPath (model, fileBrowser, path) =
let let val model = AppWith.fileBrowserAndPath (model, fileBrowser, path)
val model = AppWith.fileBrowserAndPath (model, fileBrowser, path) (* todo: update and recreate vector indicating text to redraw,
(* todo: update and recreate vector indicating text to redraw, * if not in normal mode *)
* if not in normal mode *) in (model, [])
in
(model, NO_MAILBOX)
end end
fun updateNormalMode (model: app_type, inputMsg) = fun updateNormalMode (model: app_type, inputMsg) =

15
imperative-shell/update-thread.sml
View File

@@ -1,7 +1,7 @@
signature UPDATE_THREAD = signature UPDATE_THREAD =
sig sig
val run: val run:
InputMessage.t Mailbox.mbox InputMessage.t Mailbox.mbox
* DrawMessage.t Mailbox.mbox * DrawMessage.t Mailbox.mbox
* FileMessage.t Mailbox.mbox * FileMessage.t Mailbox.mbox
* AppType.app_type * AppType.app_type
@@ -17,13 +17,20 @@ struct
case updateMsg of case updateMsg of
DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg) DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg)
| FILE fileMsg => Mailbox.send (fileMailbox, fileMsg) | FILE fileMsg => Mailbox.send (fileMailbox, fileMsg)
| NO_MAILBOX => ()
fun handleMsgs (drawMailbox, fileMailbox, lst) =
case lst of
hd :: tl =>
let val _ = handleMsg (drawMailbox, fileMailbox, hd)
in handleMsgs (drawMailbox, fileMailbox, tl)
end
| [] => ()
fun loop (inputMailbox, drawMailbox, fileMailbox, model) = fun loop (inputMailbox, drawMailbox, fileMailbox, model) =
let let
val inputMsg = Mailbox.recv inputMailbox val inputMsg = Mailbox.recv inputMailbox
val (model, updateMsg) = AppUpdate.update (model, inputMsg) val (model, updateMsgs) = AppUpdate.update (model, inputMsg)
val _ = handleMsg (drawMailbox, fileMailbox, updateMsg) val _ = handleMsgs (drawMailbox, fileMailbox, updateMsgs)
in in
loop (inputMailbox, drawMailbox, fileMailbox, model) loop (inputMailbox, drawMailbox, fileMailbox, model)
end end

4
message-types/update-msg.sml
View File

@@ -1,7 +1,7 @@
signature UPDATE_MESSAGE = signature UPDATE_MESSAGE =
sig sig
datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t | NO_MAILBOX datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t
end end
structure UpdateMessage :> UPDATE_MESSAGE = structure UpdateMessage :> UPDATE_MESSAGE =
struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t | NO_MAILBOX end struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t end