From 2dd0ec5c66143617517fbc64bc4412eaac1c26ce Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Thu, 8 Aug 2024 00:50:36 +0100 Subject: [PATCH] additional refactoring (almost 100/home/humza/Downloads/sml/dotscape/dotscape.mlb done refactoring functional core) --- dotscape.mlb | 13 +- functional-core/app-update.sml | 278 ++++++++--------------------- functional-core/ndc.sml | 27 +++ functional-core/triangle-stage.sml | 62 +++++++ functional-core/triangle.sml | 46 +++++ 5 files changed, 222 insertions(+), 204 deletions(-) create mode 100644 functional-core/triangle-stage.sml create mode 100644 functional-core/triangle.sml diff --git a/dotscape.mlb b/dotscape.mlb index c7c4108..431bea6 100644 --- a/dotscape.mlb +++ b/dotscape.mlb @@ -7,7 +7,18 @@ in functional-core/click-points.sml functional-core/graph-lines.sml end + functional-core/app-type.sml +functional-core/triangle-stage.sml + +ann + "allowVectorExps true" +in + functional-core/triangle.sml +end + +functional-core/app-init.sml functional-core/app-with.sml - +message-types/input-msg.sml +message-types/draw-msg.sml diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 32e35fa..f52ca7a 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -1,216 +1,88 @@ -structure AppUpdate = +signature APP_UPDATE = +sig + val update: AppType.app_type * int * int * InputMessage.t + -> AppType.app_type * int * int * DrawMessage.t +end + +structure AppUpdate :> APP_UPDATE = struct open AppType + open DrawMessage + open InputMessage - (* This function adjusts the x position to be centre-aligned to the grid - * if windowWidth is greater than height - * (where screen size does not have 1:1 aspect ratio). *) - fun calcRelativeX (x, windowWidth, windowHeight, halfWidth) = - if windowWidth > windowHeight then - let - val difference = windowWidth - windowHeight - val offset = Real32.fromInt (difference div 2) - in - x * (halfWidth - offset) - end - else - x * halfWidth - - (* Similar to calcRelativeX, except it centre-aligns the y-point - * when windowHeight is greater than windowWidth. *) - fun calcRelativeY (y, windowWidth, windowHeight, halfHeight) = - if windowHeight > windowWidth then - let - val difference = windowHeight - windowWidth - val offset = Real32.fromInt (difference div 2) - in - y * (halfHeight - offset) - end - else - y * halfHeight - - local - fun helpGetTrianglesVector - (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) = - case lst of - {x1, y1, x2, y2, x3, y3} :: tl => - let - val x1 = calcRelativeX (x1, windowWidth, windowHeight, halfWidth) - val x2 = calcRelativeX (x2, windowWidth, windowHeight, halfWidth) - val x3 = calcRelativeX (x3, windowWidth, windowHeight, halfWidth) - - val y1 = calcRelativeY (y1, windowWidth, windowHeight, halfHeight) - val y2 = calcRelativeY (y2, windowWidth, windowHeight, halfHeight) - val y3 = calcRelativeY (y3, windowWidth, windowHeight, halfHeight) - - val vec = - #[ x1 / halfWidth - , y1 / halfHeight - , x2 / halfWidth - , y2 / halfHeight - , x3 / halfWidth - , y3 / halfHeight - ] - val acc = vec :: acc - in - helpGetTrianglesVector - (tl, acc, windowWidth, windowHeight, halfWidth, halfHeight) - end - | [] => acc - in - fun getTrianglesVector (app: app_type) = - let - val windowWidth = #windowWidth app - val windowHeight = #windowHeight app - val halfWidth = Real32.fromInt (windowWidth div 2) - val halfHeight = Real32.fromInt (windowHeight div 2) - val lst = helpGetTrianglesVector - (#triangles app, [], windowWidth, windowHeight, halfWidth, halfHeight) - in - Vector.concat lst - end - end - - - fun getFirstTriangleStageVector (x1, y1, drawVec, model) = + fun mouseMoveOrRelease (model: app_type, mouseX, mouseY) = let - val windowWidth = #windowWidth model - val windowHeight = #windowHeight model - - val halfWidth = Real32.fromInt (windowWidth div 2) - val halfHeight = Real32.fromInt (windowHeight div 2) - - val x1px = calcRelativeX (x1, windowWidth, windowHeight, halfWidth) - val left = (x1px - 5.0) / halfWidth - val right = (x1px + 5.0) / halfWidth - - val y1px = calcRelativeY (y1, windowWidth, windowHeight, halfHeight) - val top = (y1px + 5.0) / halfHeight - val bottom = (y1px - 5.0) / halfHeight - - val firstVec = ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) + val {xClickPoints, yClickPoints, ...} = model + val (drawVec, _, _) = ClickPoints.getClickPosition + (mouseX, mouseY, 1.0, 0.0, 0.0, model) + val drawVec = TriangleStage.toVector (model, drawVec) + val drawMsg = DRAW_BUTTON drawVec in - Vector.concat [firstVec, drawVec] + (model, drawMsg, mouseX, mouseY) end - fun getSecondTriangleStageVector (x1, y1, x2, y2, drawVec, model) = + fun mouseLeftClick (model: app_type, mouseX, mouseY) = let - val windowWidth = #windowWidth model - val windowHeight = #windowHeight model - - val halfWidth = Real32.fromInt (windowWidth div 2) - val halfHeight = Real32.fromInt (windowHeight div 2) - - - val x1px = calcRelativeX (x1, windowWidth, windowHeight, halfWidth) - val left = (x1px - 5.0) / halfWidth - val right = (x1px + 5.0) / halfWidth - - val y1px = calcRelativeY (y1, windowWidth, windowHeight, halfHeight) - val top = (y1px + 5.0) / halfHeight - val bottom = (y1px - 5.0) / halfHeight - - val firstVec = ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) - - val x2px = calcRelativeX (x2, windowWidth, windowHeight, halfWidth) - val left = (x2px - 5.0) / halfWidth - val right = (x2px + 5.0) / halfWidth - - val y2px = calcRelativeY (y2, windowWidth, windowHeight, halfHeight) - val top = (y2px + 5.0) / halfHeight - val bottom = (y2px - 5.0) / halfHeight - - val secVec = ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) + val {xClickPoints, yClickPoints, ...} = model + val (buttonVec, hpos, vpos) = ClickPoints.getClickPosition + (mouseX, mouseY, 0.0, 0.0, 1.0, model) in - Vector.concat [firstVec, secVec, drawVec] + if Vector.length buttonVec > 0 then + case #triangleStage model of + NO_TRIANGLE => + let + val drawVec = TriangleStage.toVector (model, buttonVec) + val drawMsg = DRAW_BUTTON drawVec + + val newTriangleStage = FIRST {x1 = hpos, y1 = vpos} + val model = AppType.withTriangleStage (model, newTriangleStage) + in + (model, drawMsg, mouseX, mouseY) + end + | FIRST {x1, y1} => + let + val drawVec = + TriangleStage.firstToVector (x1, y1, buttonVec, model) + val drawMsg = DRAW_BUTTON drawVec + + val newTriangleStage = SECOND + {x1 = x1, y1 = y1, x2 = hpos, y2 = vpos} + val model = AppType.withTriangleStage (model, newTriangleStage) + in + (model, drawMsg, mouseX, mouseY) + end + | SECOND {x1, y1, x2, y2} => + let + val model = AppType.addTriangleAndResetStage + (model, x1, y1, x2, y2, hpos, vpos) + + val drawVec = getTrianglesVector model + val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec + in + (model, drawMsg, mouseX, mouseY) + end + else + (model, NO_DRAW, mouseX, mouseY) end - fun getTriangleStageVector (model: app_type, drawVec) = - case #triangleStage model of - NO_TRIANGLE => drawVec - | FIRST {x1, y1} => getFirstTriangleStageVector (x1, y1, drawVec, model) - | SECOND {x1, y1, x2, y2} => - getSecondTriangleStageVector (x1, y1, x2, y2, drawVec, model) + fun resizeWindow (model, mouseX, mouseY, width, height) = + let + val model = AppType.withWindowResize (model, width, height) + val triangles = getTrianglesVector model + val graphLines = #graphLines model + val drawMsg = + RESIZE_TRIANGLES_BUTTONS_AND_GRAPH + {triangles = triangles, graphLines = graphLines} + in + (model, drawMsg, mouseX, mouseY) + end - local - open DrawMessage - open InputMessage - - fun mouseMoveOrRelease (model: app_type, mouseX, mouseY) = - let - val {xClickPoints, yClickPoints, ...} = model - val (drawVec, _, _) = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0, model) - val drawVec = getTriangleStageVector (model, drawVec) - val drawMsg = DRAW_BUTTON drawVec - in - (model, drawMsg, mouseX, mouseY) - end - - fun mouseLeftClick (model: app_type, mouseX, mouseY) = - let - val {xClickPoints, yClickPoints, ...} = model - val (buttonVec, hpos, vpos) = getClickPos - (mouseX, mouseY, 0.0, 0.0, 1.0, model) - in - if Vector.length buttonVec > 0 then - case #triangleStage model of - NO_TRIANGLE => - let - val drawVec = getTriangleStageVector (model, buttonVec) - val drawMsg = DRAW_BUTTON drawVec - - val newTriangleStage = FIRST {x1 = hpos, y1 = vpos} - val model = AppType.withTriangleStage (model, newTriangleStage) - in - (model, drawMsg, mouseX, mouseY) - end - | FIRST {x1, y1} => - let - val drawVec = - getFirstTriangleStageVector (x1, y1, buttonVec, model) - val drawMsg = DRAW_BUTTON drawVec - - val newTriangleStage = SECOND - {x1 = x1, y1 = y1, x2 = hpos, y2 = vpos} - val model = AppType.withTriangleStage (model, newTriangleStage) - in - (model, drawMsg, mouseX, mouseY) - end - | SECOND {x1, y1, x2, y2} => - let - val model = AppType.addTriangleAndResetStage - (model, x1, y1, x2, y2, hpos, vpos) - - val drawVec = getTrianglesVector model - val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec - in - (model, drawMsg, mouseX, mouseY) - end - else - (model, NO_DRAW, mouseX, mouseY) - end - - fun resizeWindow (model, mouseX, mouseY, width, height) = - let - val model = AppType.withWindowResize (model, width, height) - - val triangles = getTrianglesVector model - val graphLines = #graphLines model - val drawMsg = - RESIZE_TRIANGLES_BUTTONS_AND_GRAPH - {triangles = triangles, - graphLines = graphLines} - in - (model, drawMsg, mouseX, mouseY) - end - in - fun update (model: app_type, mouseX, mouseY, 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) - | RESIZE_WINDOW {width, height} => - resizeWindow (model, mouseX, mouseY, width, height) - end + fun update (model: app_type, mouseX, mouseY, 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) + | RESIZE_WINDOW {width, height} => + resizeWindow (model, mouseX, mouseY, width, height) end diff --git a/functional-core/ndc.sml b/functional-core/ndc.sml index 8f35b0a..16eecef 100644 --- a/functional-core/ndc.sml +++ b/functional-core/ndc.sml @@ -11,4 +11,31 @@ struct , right, bottom, r, g, b , right, top, r, g, b ] + + (* This function adjusts the x position to be centre-aligned to the grid + * if windowWidth is greater than height + * (where screen size does not have 1:1 aspect ratio). *) + fun centreAlignX (x, windowWidth, windowHeight, halfWidth) = + if windowWidth > windowHeight then + let + val difference = windowWidth - windowHeight + val offset = Real32.fromInt (difference div 2) + in + x * (halfWidth - offset) + end + else + x * halfWidth + + (* Similar to centreAlignX, except it centre-aligns the y-point + * when windowHeight is greater than windowWidth. *) + fun centreAlignY (y, windowWidth, windowHeight, halfHeight) = + if windowHeight > windowWidth then + let + val difference = windowHeight - windowWidth + val offset = Real32.fromInt (difference div 2) + in + y * (halfHeight - offset) + end + else + y * halfHeight end diff --git a/functional-core/triangle-stage.sml b/functional-core/triangle-stage.sml new file mode 100644 index 0000000..cb64b3b --- /dev/null +++ b/functional-core/triangle-stage.sml @@ -0,0 +1,62 @@ +structure TriangleStage = +struct + open AppType + + fun firstToVector (x1, y1, drawVec, model) = + let + val windowWidth = #windowWidth model + val windowHeight = #windowHeight model + + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + + val x1px = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth) + val left = (x1px - 5.0) / halfWidth + val right = (x1px + 5.0) / halfWidth + + val y1px = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight) + val top = (y1px + 5.0) / halfHeight + val bottom = (y1px - 5.0) / halfHeight + + val firstVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) + in + Vector.concat [firstVec, drawVec] + end + + fun secondToVector (x1, y1, x2, y2, drawVec, model) = + let + val windowWidth = #windowWidth model + val windowHeight = #windowHeight model + + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + + val x1px = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth) + val left = (x1px - 5.0) / halfWidth + val right = (x1px + 5.0) / halfWidth + + val y1px = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight) + val top = (y1px + 5.0) / halfHeight + val bottom = (y1px - 5.0) / halfHeight + + val firstVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) + + val x2px = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth) + val left = (x2px - 5.0) / halfWidth + val right = (x2px + 5.0) / halfWidth + + val y2px = Ndc.centreAlignY (y2, windowWidth, windowHeight, halfHeight) + val top = (y2px + 5.0) / halfHeight + val bottom = (y2px - 5.0) / halfHeight + + val secVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0) + in + Vector.concat [firstVec, secVec, drawVec] + end + + fun toVector (model: app_type, drawVec) = + case #triangleStage model of + NO_TRIANGLE => drawVec + | FIRST {x1, y1} => firstToVector (x1, y1, drawVec, model) + | SECOND {x1, y1, x2, y2} => secondToVector (x1, y1, x2, y2, drawVec, model) +end diff --git a/functional-core/triangle.sml b/functional-core/triangle.sml new file mode 100644 index 0000000..2faa70a --- /dev/null +++ b/functional-core/triangle.sml @@ -0,0 +1,46 @@ +structure Triangle = +struct + open AppType + + local + fun helpToVector + (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) = + case lst of + {x1, y1, x2, y2, x3, y3} :: tl => + let + val x1 = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth) + val x2 = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth) + val x3 = Ndc.centreAlignX (x3, windowWidth, windowHeight, halfWidth) + + val y1 = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight) + val y2 = Ndc.centreAlignY (y2, windowWidth, windowHeight, halfHeight) + val y3 = Ndc.centreAlignY (y3, windowWidth, windowHeight, halfHeight) + + val vec = + #[ x1 / halfWidth + , y1 / halfHeight + , x2 / halfWidth + , y2 / halfHeight + , x3 / halfWidth + , y3 / halfHeight + ] + val acc = vec :: acc + in + helpToVector + (tl, acc, windowWidth, windowHeight, halfWidth, halfHeight) + end + | [] => acc + in + fun toVector (app: app_type) = + let + val windowWidth = #windowWidth app + val windowHeight = #windowHeight app + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + val lst = helpToVector + (#triangles app, [], windowWidth, windowHeight, halfWidth, halfHeight) + in + Vector.concat lst + end + end +end