diff --git a/dotscape b/dotscape index ef0bc3d..22f50f8 100755 Binary files a/dotscape and b/dotscape differ diff --git a/dotscape.mlb b/dotscape.mlb index 43b2e0a..85cd649 100644 --- a/dotscape.mlb +++ b/dotscape.mlb @@ -18,7 +18,9 @@ functional-core/app-init.sml functional-core/app-with.sml message-types/input-msg.sml +message-types/file-msg.sml message-types/draw-msg.sml +message-types/update-msg.sml functional-core/app-update.sml diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index c594538..edb03b7 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -1,14 +1,16 @@ signature APP_UPDATE = sig val update: AppType.app_type * InputMessage.t - -> AppType.app_type * DrawMessage.t + -> AppType.app_type * UpdateMessage.t end structure AppUpdate :> APP_UPDATE = struct open AppType + open DrawMessage open InputMessage + open UpdateMessage fun mouseMoveOrRelease (model: app_type) = let @@ -16,7 +18,7 @@ struct val drawVec = TriangleStage.toVector (model, drawVec) val drawMsg = DRAW_DOT drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end fun mouseLeftClick (model: app_type) = @@ -36,7 +38,7 @@ struct val model = AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple) in - (model, drawMsg) + (model, DRAW drawMsg) end | FIRST {x1, y1} => let @@ -48,7 +50,7 @@ struct val model = AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple) in - (model, drawMsg) + (model, DRAW drawMsg) end | SECOND {x1, y1, x2, y2} => let @@ -58,10 +60,10 @@ struct val drawVec = Triangles.toVector model val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end else - (model, NO_DRAW) + (model, NO_MAILBOX) end fun resizeWindow (model, width, height) = @@ -79,7 +81,7 @@ struct RESIZE_TRIANGLES_DOTS_AND_GRAPH {triangles = triangles, graphLines = graphLines, dots = dots} in - (model, drawMsg) + (model, DRAW drawMsg) end fun undoAction model = @@ -90,7 +92,7 @@ struct val model = AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1)) in - (model, CLEAR_DOTS) + (model, DRAW CLEAR_DOTS) end | SECOND {x1, y1, x2, y2} => (* Change FIRST to SECOND and redraw dots. *) @@ -103,7 +105,7 @@ struct val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model) val drawMsg = DRAW_DOT drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end | NO_TRIANGLE => (case #triangles model of @@ -124,11 +126,11 @@ struct DRAW_TRIANGLES_AND_DOTS {triangles = newTriangleVec, dots = drawVec} in - (model, drawMsg) + (model, DRAW drawMsg) end | [] => (* Can't undo, because there are no actions to undo. *) - (model, NO_DRAW)) + (model, NO_MAILBOX)) fun redoAction model = case #redo model of @@ -147,7 +149,7 @@ struct val drawVec = TriangleStage.firstToVector (x, y, emptyVec, model) val drawMsg = DRAW_DOT drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end | FIRST {x1, y1} => (* add to triangle stage, redraw dots *) @@ -162,7 +164,7 @@ struct (x1, y1, x, y, emptyVec, model) val drawMsg = DRAW_DOT drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end | SECOND {x1, y1, x2, y2} => (* clear triangle stage, add to trinagle list and redraw triangles *) @@ -177,11 +179,9 @@ struct val drawVec = Triangles.toVector model val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec in - (model, drawMsg) + (model, DRAW drawMsg) end) - | [] => - (* Nothing to redo. *) - (model, NO_DRAW) + | [] => (* Nothing to redo. *) (model, NO_MAILBOX) fun toggleGraph (model: app_type) = if #showGraph model then @@ -189,7 +189,7 @@ struct val model = AppWith.graphVisibility (model, false) val drawMsg = DRAW_GRAPH (Vector.fromList []) in - (model, drawMsg) + (model, DRAW drawMsg) end else let @@ -197,7 +197,7 @@ struct val graphLines = GraphLines.generate model val drawMsg = DRAW_GRAPH graphLines in - (model, drawMsg) + (model, DRAW drawMsg) end fun update (model: app_type, inputMsg) = diff --git a/imperative-shell/draw-thread.sml b/imperative-shell/draw-thread.sml index 7a04a2f..caebf41 100644 --- a/imperative-shell/draw-thread.sml +++ b/imperative-shell/draw-thread.sml @@ -150,18 +150,7 @@ struct , triangleDrawObject , triangleDrawLength ) - end - | NO_DRAW => - run - ( drawMailbox - , window - , graphDrawObject - , drawGraphLength - , dotDrawObject - , dotDrawLength - , triangleDrawObject - , triangleDrawLength - )) + end) else Glfw.terminate () end diff --git a/imperative-shell/update-thread.sml b/imperative-shell/update-thread.sml index e86fd22..9a2a3d7 100644 --- a/imperative-shell/update-thread.sml +++ b/imperative-shell/update-thread.sml @@ -1,18 +1,32 @@ -structure UpdateThread = +signature UPDATE_THREAD = +sig + val run: + InputMessage.t Mailbox.mbox + * DrawMessage.t Mailbox.mbox + * AppType.app_type + -> unit +end + +structure UpdateThread :> UPDATE_THREAD = struct open CML + open UpdateMessage - local - fun loop (inputMailbox, drawMailbox, model) = - let - val inputMsg = Mailbox.recv inputMailbox - val (model, drawMsg) = AppUpdate.update (model, inputMsg) - val _ = Mailbox.send (drawMailbox, drawMsg) - in - loop (inputMailbox, drawMailbox, model) - end - in - fun run (inputMailbox, drawMailbox, initial) = - loop (inputMailbox, drawMailbox, initial) - end + fun handleMsg (drawMailbox, updateMsg) = + case updateMsg of + DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg) + | FILE fileMsg => () + | NO_MAILBOX => () + + fun loop (inputMailbox, drawMailbox, model) = + let + val inputMsg = Mailbox.recv inputMailbox + val (model, updateMsg) = AppUpdate.update (model, inputMsg) + val _ = handleMsg (drawMailbox, updateMsg) + in + loop (inputMailbox, drawMailbox, model) + end + + fun run (inputMailbox, drawMailbox, initial) = + loop (inputMailbox, drawMailbox, initial) end diff --git a/message-types/draw-msg.sml b/message-types/draw-msg.sml index 8a6495d..a7e9b96 100644 --- a/message-types/draw-msg.sml +++ b/message-types/draw-msg.sml @@ -12,7 +12,6 @@ sig , dots: Real32.real vector } | CLEAR_DOTS - | NO_DRAW end structure DrawMessage :> DRAW_MESSAGE = @@ -29,5 +28,4 @@ struct , dots: Real32.real vector } | CLEAR_DOTS - | NO_DRAW end diff --git a/message-types/io-msg.sml b/message-types/file-msg.sml similarity index 79% rename from message-types/io-msg.sml rename to message-types/file-msg.sml index 5d27022..6b1e462 100644 --- a/message-types/io-msg.sml +++ b/message-types/file-msg.sml @@ -1,4 +1,4 @@ -signature IO_MESSAGE = +signature FILE_MESSAGE = sig datatype t = SAVE_TRIANGLES of AppType.triangle list @@ -6,7 +6,7 @@ sig | IMPORT_FILE end -structure IoMessage :> IO_MESSAGE = +structure FileMessage :> FILE_MESSAGE = struct datatype t = SAVE_TRIANGLES of AppType.triangle list diff --git a/message-types/update-msg.sml b/message-types/update-msg.sml new file mode 100644 index 0000000..870cfa8 --- /dev/null +++ b/message-types/update-msg.sml @@ -0,0 +1,7 @@ +signature UPDATE_MESSAGE = +sig + datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t | NO_MAILBOX +end + +structure UpdateMessage :> UPDATE_MESSAGE = +struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t | NO_MAILBOX end