diff --git a/dotscape b/dotscape index ef87736..3ce5387 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app-type.sml b/functional-core/app-type.sml index a3dc87e..c55211b 100644 --- a/functional-core/app-type.sml +++ b/functional-core/app-type.sml @@ -15,21 +15,27 @@ sig , y3: Real32.real } - type app_type = {triangleStage: triangle_stage, triangles: triangle list} + type app_type = + { triangles: triangle list + , triangleStage: triangle_stage + , clickPoints: Real32.real vector + } - val initial: app_type + val getInitial: int * int -> app_type + + val genClickPoints: int * int -> Real32.real vector val withTriangleStage: app_type * triangle_stage -> app_type - val addTriangleAndResetStage : - app_type * - Real32.real * - Real32.real * - Real32.real * - Real32.real * - Real32.real * - Real32.real -> + val addTriangleAndResetStage: app_type + * Real32.real + * Real32.real + * Real32.real + * Real32.real + * Real32.real + * Real32.real + -> app_type end structure AppType :> APP_TYPE = @@ -57,24 +63,48 @@ struct | SECOND of {x1: Real32.real, y1: Real32.real, x2: Real32.real, y2: Real32.real} - type app_type = {triangles: triangle list, triangleStage: triangle_stage} + type app_type = + { triangles: triangle list + , triangleStage: triangle_stage + , clickPoints: Real32.real vector + } - val initial = {triangles = [], triangleStage = NO_TRIANGLE} + fun genClickPoints (windowWidth, windowHeight) = + let + val w = Real32.fromInt windowWidth / 40.0 + val h = Real32.fromInt windowHeight / 40.0 + in + Vector.tabulate (41, fn idx => Real32.fromInt idx * w) + end + + fun getInitial (windowWidth, windowHeight) = + { triangles = [] + , triangleStage = NO_TRIANGLE + , clickPoints = genClickPoints (windowWidth, windowHeight) + } fun withTriangleStage (app: app_type, newTriangleStage: triangle_stage) : app_type = - let val {triangles, triangleStage = _} = app - in {triangles = triangles, triangleStage = newTriangleStage} + let + val {triangles, triangleStage = _, clickPoints = clickPoints} = app + in + { triangles = triangles + , triangleStage = newTriangleStage + , clickPoints = clickPoints + } end fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) : app_type = let - val {triangles, triangleStage = _} = app + val {triangles, triangleStage = _, clickPoints = clickPoints} = app val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} val newTriangles = newTriangle :: triangles in - {triangles = newTriangles, triangleStage = NO_TRIANGLE} + { triangles = newTriangles + , triangleStage = NO_TRIANGLE + , clickPoints = clickPoints + } end end diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 66d3b19..f423464 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -28,18 +28,8 @@ struct ] local - fun genClickPoints (windowWidth, windowHeight) = - let - val w = Real32.fromInt windowWidth / 40.0 - val h = Real32.fromInt windowHeight / 40.0 - in - Vector.tabulate (41, fn idx => Real32.fromInt idx * w) - end - - val clickPoints = - genClickPoints (Constants.windowWidth, Constants.windowHeight) - - fun getVerticalClickPos (idx, horizontalPos, mouseX, mouseY, r, g, b) = + fun getVerticalClickPos + (clickPoints, idx, horizontalPos, mouseX, mouseY, r, g, b) = if idx = Vector.length clickPoints then (#[], 0.0, 0.0) else @@ -48,7 +38,7 @@ struct in if mouseY < curVerticalPos - 7.0 orelse mouseY > curVerticalPos + 7.0 then getVerticalClickPos - (idx + 1, horizontalPos, mouseX, mouseY, r, g, b) + (clickPoints, idx + 1, horizontalPos, mouseX, mouseY, r, g, b) else let val halfWidth = Real32.fromInt (Constants.windowWidth div 2) @@ -69,7 +59,7 @@ struct end end - fun getHorizontalClickPos (idx, mouseX, mouseY, r, g, b) = + fun getHorizontalClickPos (clickPoints, idx, mouseX, mouseY, r, g, b) = if idx = Vector.length clickPoints then (#[], 0.0, 0.0) else @@ -77,9 +67,11 @@ struct val curPos = Vector.sub (clickPoints, idx) in if mouseX < curPos - 7.0 orelse mouseX > curPos + 7.0 then - getHorizontalClickPos (idx + 1, mouseX, mouseY, r, g, b) + getHorizontalClickPos + (clickPoints, idx + 1, mouseX, mouseY, r, g, b) else - getVerticalClickPos (0, curPos, mouseX, mouseY, r, g, b) + getVerticalClickPos + (clickPoints, 0, curPos, mouseX, mouseY, r, g, b) end in (* @@ -88,9 +80,8 @@ struct * If a square wasn't found at the clicked position, * an empty vector is returned. *) - fun getClickPos (mouseX, mouseY, r, g, b) = - getHorizontalClickPos - (0, mouseX, mouseY, r, g, b) + fun getClickPos (clickPoints, mouseX, mouseY, r, g, b) = + getHorizontalClickPos (clickPoints, 0, mouseX, mouseY, r, g, b) end fun getFirstTriangleStageVector (x1, y1, drawVec) = @@ -154,7 +145,8 @@ struct case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => let - val (drawVec, _, _) = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0) + val (drawVec, _, _) = getClickPos + (#clickPoints model, mouseX, mouseY, 1.0, 0.0, 0.0) val drawVec = getTriangleStageVector (model, drawVec) val drawMsg = DRAW_BUTTON drawVec in @@ -162,7 +154,8 @@ struct end | MOUSE_LEFT_RELEASE => let - val (drawVec, _, _) = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0) + val (drawVec, _, _) = getClickPos + (#clickPoints model, mouseX, mouseY, 1.0, 0.0, 0.0) val drawVec = getTriangleStageVector (model, drawVec) val drawMsg = DRAW_BUTTON drawVec in @@ -171,7 +164,7 @@ struct | MUSE_LEFT_CLICK => let val (buttonVec, hpos, vpos) = getClickPos - (mouseX, mouseY, 0.0, 0.0, 1.0) + (#clickPoints model, mouseX, mouseY, 0.0, 0.0, 1.0) in if Vector.length buttonVec > 0 then (case #triangleStage model of diff --git a/imperative-shell/event-loop.sml b/imperative-shell/event-loop.sml index 9da3932..fc346bf 100644 --- a/imperative-shell/event-loop.sml +++ b/imperative-shell/event-loop.sml @@ -15,7 +15,13 @@ struct end in fun update (inputMailbox, drawMailbox) = - loop (inputMailbox, drawMailbox, 0.0, 0.0, AppType.initial) + loop + ( inputMailbox + , drawMailbox + , 0.0 + , 0.0 + , AppType.getInitial (Constants.windowWidth, Constants.windowHeight) + ) end fun draw @@ -35,7 +41,8 @@ struct val _ = Gles3.clear () val _ = AppDraw.drawGraphLines graphDrawObject - val _ = AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength) + val _ = + AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength) val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength) val _ = Glfw.pollEvents () @@ -70,9 +77,11 @@ struct end | DRAW_TRIANGLES_AND_RESET_BUTTONS triangleVec => let - val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec) + val _ = + AppDraw.uploadTrianglesVector + (triangleDrawObject, triangleVec) val triangleDrawLength = Vector.length triangleVec div 2 - (* buttons are reset by setting buttonDrawLength to 0 *) + (* buttons are reset by setting buttonDrawLength to 0 *) in draw ( drawMailbox