diff --git a/dotscape b/dotscape index 320a3a3..97e65d8 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app-init.sml b/functional-core/app-init.sml index c6046e1..ae84282 100644 --- a/functional-core/app-init.sml +++ b/functional-core/app-init.sml @@ -8,7 +8,7 @@ struct open AppType fun helpFromWidthAndHeight - (windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) = + (windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) : app_type = let val xClickPoints = ClickPoints.generate (wStart, wFinish) val yClickPoints = ClickPoints.generate (hStart, hFinish) @@ -24,6 +24,8 @@ struct , yClickPoints = yClickPoints , graphLines = graphLines , undo = [] + , mouseX = 0.0 + , mouseY = 0.0 } end diff --git a/functional-core/app-type.sml b/functional-core/app-type.sml index bfe5ef8..18d5c50 100644 --- a/functional-core/app-type.sml +++ b/functional-core/app-type.sml @@ -24,6 +24,8 @@ sig , yClickPoints: Real32.real vector , graphLines: Real32.real vector , undo: (Real32.real * Real32.real) list + , mouseX: Real32.real + , mouseY: Real32.real } end @@ -61,5 +63,7 @@ struct , yClickPoints: Real32.real vector , graphLines: Real32.real vector , undo: (Real32.real * Real32.real) list + , mouseX: Real32.real + , mouseY: Real32.real } end diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 1b06f29..f985547 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -1,7 +1,7 @@ signature APP_UPDATE = sig - val update: AppType.app_type * Real32.real * Real32.real * InputMessage.t - -> AppType.app_type * DrawMessage.t * Real32.real * Real32.real + val update: AppType.app_type * InputMessage.t + -> AppType.app_type * DrawMessage.t end structure AppUpdate :> APP_UPDATE = @@ -10,9 +10,18 @@ struct open DrawMessage open InputMessage - fun mouseMoveOrRelease (model: app_type, mouseX, mouseY) = + fun mouseMoveOrRelease (model: app_type) = let - val {xClickPoints, yClickPoints, windowWidth, windowHeight, ...} = model + val + { xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , mouseX + , mouseY + , ... + } = model + val (drawVec, _, _) = ClickPoints.getClickPosition ( mouseX , mouseY @@ -27,12 +36,21 @@ struct val drawVec = TriangleStage.toVector (model, drawVec) val drawMsg = DRAW_BUTTON drawVec in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end - fun mouseLeftClick (model: app_type, mouseX, mouseY) = + fun mouseLeftClick (model: app_type) = let - val {xClickPoints, yClickPoints, windowWidth, windowHeight, ...} = model + val + { xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , mouseX + , mouseY + , ... + } = model + val (buttonVec, hpos, vpos) = ClickPoints.getClickPosition ( mouseX , mouseY @@ -57,7 +75,7 @@ struct val model = AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple) in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end | FIRST {x1, y1} => let @@ -70,7 +88,7 @@ struct val model = AppWith.newTriangleStage (model, newTriangleStage, newUndoTuple) in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end | SECOND {x1, y1, x2, y2} => let @@ -80,13 +98,13 @@ struct val drawVec = Triangles.toVector model val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end else - (model, NO_DRAW, mouseX, mouseY) + (model, NO_DRAW) end - fun resizeWindow (model, mouseX, mouseY, width, height) = + fun resizeWindow (model, width, height) = let val model = AppWith.windowResize (model, width, height) val triangles = Triangles.toVector model @@ -95,15 +113,15 @@ struct RESIZE_TRIANGLES_BUTTONS_AND_GRAPH {triangles = triangles, graphLines = graphLines} in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end - fun undoAction (model, mouseX, mouseY) = + fun undoAction model = 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) + in (model, CLEAR_BUTTONS) end | SECOND {x1, y1, x2, y2} => (* Change FIRST to SECOND and redraw buttons. *) @@ -115,7 +133,7 @@ struct TriangleStage.firstToVector (x1, y1, Vector.fromList [], model) val drawMsg = DRAW_BUTTON drawVec in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end | NO_TRIANGLE => (case #triangles model of @@ -135,19 +153,21 @@ struct DRAW_TRIANGLES_AND_BUTTONS {triangles = newTriangleVec, buttons = drawVec} in - (model, drawMsg, mouseX, mouseY) + (model, drawMsg) end | [] => (* Can't undo, because there are no actions to undo. *) - (model, NO_DRAW, mouseX, mouseY)) + (model, NO_DRAW)) - fun update (model: app_type, mouseX, mouseY, inputMsg) = + fun update (model: app_type, inputMsg) = case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => - mouseMoveOrRelease (model, mouseX, mouseY) - | MOUSE_LEFT_RELEASE => mouseMoveOrRelease (model, mouseX, mouseY) - | MOUSE_LEFT_CLICK => mouseLeftClick (model, mouseX, mouseY) + let val model = AppWith.mousePosition (model, mouseX, mouseY) + in mouseMoveOrRelease model + end + | MOUSE_LEFT_RELEASE => mouseMoveOrRelease model + | MOUSE_LEFT_CLICK => mouseLeftClick model | RESIZE_WINDOW {width, height} => - resizeWindow (model, mouseX, mouseY, width, height) - | UNDO_ACTION => undoAction (model, mouseX, mouseY) + resizeWindow (model, width, height) + | UNDO_ACTION => undoAction model end diff --git a/functional-core/app-with.sml b/functional-core/app-with.sml index d95d720..e062ecd 100644 --- a/functional-core/app-with.sml +++ b/functional-core/app-with.sml @@ -22,6 +22,9 @@ 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 = @@ -40,7 +43,10 @@ struct , windowHeight , graphLines , undo + , mouseX + , mouseY } = app + val newUndo = xyTuple :: undo in { triangleStage = newTriangleStage @@ -51,6 +57,8 @@ struct , windowHeight = windowHeight , graphLines = graphLines , undo = newUndo + , mouseX = mouseX + , mouseY = mouseY } end @@ -65,6 +73,8 @@ struct , windowHeight , graphLines , undo + , mouseX + , mouseY } = app in { triangleStage = newTriangleStage @@ -75,6 +85,8 @@ struct , windowHeight = windowHeight , graphLines = graphLines , undo = undo + , mouseX = mouseX + , mouseY = mouseY } end @@ -90,6 +102,8 @@ struct , windowHeight , graphLines , undo + , mouseX + , mouseY } = app in { triangleStage = newTriangleStage @@ -100,6 +114,8 @@ struct , windowHeight = windowHeight , graphLines = graphLines , undo = undo + , mouseX = mouseX + , mouseY = mouseY } end @@ -115,6 +131,8 @@ struct , windowHeight , graphLines , undo + , mouseX + , mouseY } = app val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} @@ -123,12 +141,14 @@ struct in { triangleStage = NO_TRIANGLE , triangles = newTriangles + , undo = newUndo , xClickPoints = xClickPoints , yClickPoints = yClickPoints , windowWidth = windowWidth , windowHeight = windowHeight , graphLines = graphLines - , undo = newUndo + , mouseX = mouseX + , mouseY = mouseY } end @@ -145,6 +165,8 @@ struct , triangles , triangleStage , undo + , mouseX + , mouseY } = app val xClickPoints = ClickPoints.generate (wStart, wFinish) val yClickPoints = ClickPoints.generate (hStart, hFinish) @@ -160,6 +182,8 @@ struct , windowWidth = windowWidth , windowHeight = windowHeight , undo = undo + , mouseX = mouseX + , mouseY = mouseY } end @@ -185,4 +209,33 @@ struct helpWindowResize (app, windowWidth, windowHeight, 0, windowWidth, hStart, hFinish) end + + fun mousePosition (app: app_type, mouseX, mouseY) = + let + val + { mouseX = _ + , mouseY = _ + , triangles + , triangleStage + , xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , graphLines + , undo + } = app + + in + { mouseX = mouseX + , mouseY = mouseY + , triangles = triangles + , triangleStage = triangleStage + , xClickPoints = xClickPoints + , yClickPoints = yClickPoints + , windowWidth = windowWidth + , windowHeight = windowHeight + , graphLines = graphLines + , undo = undo + } + end end diff --git a/imperative-shell/event-loop.sml b/imperative-shell/event-loop.sml index 0b070e8..3736efc 100644 --- a/imperative-shell/event-loop.sml +++ b/imperative-shell/event-loop.sml @@ -4,18 +4,17 @@ struct open DrawMessage local - fun loop (inputMailbox, drawMailbox, mouseX, mouseY, model) = + fun loop (inputMailbox, drawMailbox, model) = let val inputMsg = Mailbox.recv inputMailbox - val (model, drawMsg, mouseX, mouseY) = - AppUpdate.update (model, mouseX, mouseY, inputMsg) + val (model, drawMsg) = AppUpdate.update (model, inputMsg) val _ = Mailbox.send (drawMailbox, drawMsg) in - loop (inputMailbox, drawMailbox, mouseX, mouseY, model) + loop (inputMailbox, drawMailbox, model) end in fun update (inputMailbox, drawMailbox, initial) = - loop (inputMailbox, drawMailbox, 0.0, 0.0, initial) + loop (inputMailbox, drawMailbox, initial) end fun draw