diff --git a/dotscape b/dotscape index ff83e01..1306019 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 902975a..9e9a7dc 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -2,18 +2,72 @@ structure AppUpdate = struct open AppType + (* 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) = + fun helpGetTrianglesVector + (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) = case lst of {x1, y1, x2, y2, x3, y3} :: tl => - let val vec = #[x1, y1, x2, y2, x3, y3] - in helpGetTrianglesVector (tl, vec :: acc) + 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 lst = helpGetTrianglesVector (#triangles app, []) - in Vector.concat lst + 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 @@ -29,8 +83,17 @@ struct local fun getVerticalClickPos - (yClickPoints, idx, horizontalPos, mouseX, mouseY, r, g, b, windowWidth, - windowHeight) = + ( yClickPoints + , idx + , horizontalPos + , mouseX + , mouseY + , r + , g + , b + , windowWidth + , windowHeight + ) = if idx = Vector.length yClickPoints then (#[], 0.0, 0.0) else @@ -39,9 +102,18 @@ struct in if mouseY < curVerticalPos - 7.0 orelse mouseY > curVerticalPos + 7.0 then getVerticalClickPos - (yClickPoints, idx + 1, horizontalPos, mouseX, mouseY, r, g, b, - windowWidth, windowHeight) - else + ( yClickPoints + , idx + 1 + , horizontalPos + , mouseX + , mouseY + , r + , g + , b + , windowWidth + , windowHeight + ) + else let (* calculate normalised device coordinates *) val halfWidth = Real32.fromInt (windowWidth div 2) @@ -115,8 +187,18 @@ struct end end - fun getHorizontalClickPos (xClickPoints, yClickPoints, idx, mouseX, mouseY, - r, g, b, windowWidth, windowHeight) = + fun getHorizontalClickPos + ( xClickPoints + , yClickPoints + , idx + , mouseX + , mouseY + , r + , g + , b + , windowWidth + , windowHeight + ) = if idx = Vector.length xClickPoints then (#[], 0.0, 0.0) else @@ -125,12 +207,30 @@ struct in if mouseX < curPos - 7.0 orelse mouseX > curPos + 7.0 then getHorizontalClickPos - (xClickPoints, yClickPoints, idx + 1, mouseX, mouseY, r, g, b, - windowWidth, windowHeight) + ( xClickPoints + , yClickPoints + , idx + 1 + , mouseX + , mouseY + , r + , g + , b + , windowWidth + , windowHeight + ) else getVerticalClickPos - (yClickPoints, 0, curPos, mouseX, mouseY, r, g, b, windowWidth, - windowHeight) + ( yClickPoints + , 0 + , curPos + , mouseX + , mouseY + , r + , g + , b + , windowWidth + , windowHeight + ) end in (* @@ -140,8 +240,18 @@ struct * an empty vector is returned. *) fun getClickPos (mouseX, mouseY, r, g, b, model: app_type) = - getHorizontalClickPos (#xClickPoints model, #yClickPoints model, 0, - mouseX, mouseY, r, g, b, #windowWidth model, #windowHeight model) + getHorizontalClickPos + ( #xClickPoints model + , #yClickPoints model + , 0 + , mouseX + , mouseY + , r + , g + , b + , #windowWidth model + , #windowHeight model + ) end fun getFirstTriangleStageVector (x1, y1, drawVec, model) = @@ -152,29 +262,11 @@ struct val halfWidth = Real32.fromInt (windowWidth div 2) val halfHeight = Real32.fromInt (windowHeight div 2) - val x1px = - if windowWidth > windowHeight then - let - val difference = windowWidth - windowHeight - val offset = Real32.fromInt (difference div 2) - in - x1 * (halfWidth - offset) - end - else - x1 * halfWidth + val x1px = calcRelativeX (x1, windowWidth, windowHeight, halfWidth) val left = (x1px - 5.0) / halfWidth val right = (x1px + 5.0) / halfWidth - val y1px = - if windowHeight > windowWidth then - let - val difference = windowHeight - windowWidth - val offset = Real32.fromInt (difference div 2) - in - y1 * (halfHeight - offset) - end - else - y1 * halfHeight + val y1px = calcRelativeY (y1, windowWidth, windowHeight, halfHeight) val top = (y1px + 5.0) / halfHeight val bottom = (y1px - 5.0) / halfHeight @@ -191,21 +283,22 @@ struct val halfWidth = Real32.fromInt (windowWidth div 2) val halfHeight = Real32.fromInt (windowHeight div 2) - val x1px = x1 * halfWidth + + val x1px = calcRelativeX (x1, windowWidth, windowHeight, halfWidth) val left = (x1px - 5.0) / halfWidth val right = (x1px + 5.0) / halfWidth - val y1px = y1 * halfHeight + 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 = x2 * halfWidth + val x2px = calcRelativeX (x2, windowWidth, windowHeight, halfWidth) val left = (x2px - 5.0) / halfWidth val right = (x2px + 5.0) / halfWidth - val y2px = y2 * halfHeight + val y2px = calcRelativeY (y2, windowWidth, windowHeight, halfHeight) val top = (y2px + 5.0) / halfHeight val bottom = (y2px - 5.0) / halfHeight @@ -227,9 +320,8 @@ struct 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 {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 @@ -238,7 +330,7 @@ struct fun mouseLeftClick (model: app_type, mouseX, mouseY) = let - val {xClickPoints, yClickPoints, ...} = model + val {xClickPoints, yClickPoints, ...} = model val (buttonVec, hpos, vpos) = getClickPos (mouseX, mouseY, 0.0, 0.0, 1.0, model) in @@ -256,8 +348,8 @@ struct end | FIRST {x1, y1} => let - val drawVec = getFirstTriangleStageVector (x1, y1, buttonVec, - model) + val drawVec = + getFirstTriangleStageVector (x1, y1, buttonVec, model) val drawMsg = DRAW_BUTTON drawVec val newTriangleStage = SECOND @@ -282,28 +374,29 @@ struct fun resizeWindow (model, mouseX, mouseY, width, height) = let - val msg = String.concat [ - "resized window. ", - "width = ", - Int.toString width, - " height = ", - Int.toString height, - "\n" - ] + val msg = String.concat + [ "resized window. " + , "width = " + , Int.toString width + , " height = " + , Int.toString height + , "\n" + ] val _ = print msg val model = AppType.withWindowResize (model, width, height) + + val drawVec = getTrianglesVector model + val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec in - (model, NO_DRAW, mouseX, mouseY) + (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) + | 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