diff --git a/temp-squares/app-with.sml b/temp-squares/app-with.sml index 66b52f1..6a91f58 100644 --- a/temp-squares/app-with.sml +++ b/temp-squares/app-with.sml @@ -110,7 +110,7 @@ struct } end - fun arrowX (app, arrowY) = + fun arrowY (app, arrowY) = let val { mode diff --git a/temp-squares/graph-lines.sml b/temp-squares/graph-lines.sml new file mode 100644 index 0000000..e69425f --- /dev/null +++ b/temp-squares/graph-lines.sml @@ -0,0 +1,142 @@ +signature GRAPH_LINES = +sig + val generate: AppType.app_type -> Real32.real vector +end + +structure GraphLines :> GRAPH_LINES = +struct + (* + * This function only produces the desired result + * when the window is a square and has the aspect ratio 1:1. + * This is because the function assumes it can use + * the same position coordinates both horizontally and vertically. + *) + fun helpGenGraphLinesSquare (pos: Real32.real, limit, acc) = + if pos >= limit then + Vector.concat acc + else + let + val vec = + #[ (* x = _.1 *) + pos - 0.001, ~1.0 + , pos + 0.001, ~1.0 + , pos + 0.001, 1.0 + + , pos + 0.001, 1.0 + , pos - 0.001, 1.0 + , pos - 0.001, ~1.0 + + (* y = _.1 *) + , ~1.0, pos - 0.001 + , ~1.0, pos + 0.001 + , 1.0, pos + 0.001 + + , 1.0, pos + 0.001 + , 1.0, pos - 0.001 + , ~1.0, pos - 0.001 + ] + val acc = vec :: acc + val nextPos = pos + 0.1 + in + helpGenGraphLinesSquare (nextPos, limit, acc) + end + + fun helpGenGraphLinesHorizontal + (pos, xClickPoints, acc, halfWidth, yMin, yMax) = + if pos = Vector.length xClickPoints then + acc + else + let + val curX = Vector.sub (xClickPoints, pos) + val ndc = (curX - halfWidth) / halfWidth + val acc = + #[ + ndc - 0.001, yMin + , ndc + 0.001, yMin + , ndc + 0.001, yMax + + , ndc + 0.001, yMax + , ndc - 0.001, yMax + , ndc - 0.001, yMin + ] :: acc + in + helpGenGraphLinesHorizontal + (pos + 1, xClickPoints, acc, halfWidth, yMin, yMax) + end + + fun helpGenGraphLinesVertical (pos, yClickPoints, acc, halfHeight, xMin, xMax) = + if pos = Vector.length yClickPoints then + acc + else + let + val curY = Vector.sub (yClickPoints, pos) + val ndc = (curY - halfHeight) / halfHeight + val acc = + #[ + xMin, ndc - 0.001 + , xMin, ndc + 0.001 + , xMax, ndc + 0.001 + + , xMax, ndc + 0.001 + , xMax, ndc - 0.001 + , xMin, ndc - 0.001 + ] :: acc + in + helpGenGraphLinesVertical + (pos + 1, yClickPoints, acc, halfHeight, xMin, xMax) + end + + fun helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints) = + if windowWidth = windowHeight then + helpGenGraphLinesSquare (~1.0, 1.0, []) + else if windowWidth > windowHeight then + let + val difference = windowWidth - windowHeight + val offset = difference div 2 + + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + + val start = offset - (windowWidth div 2) + val start = Real32.fromInt start / halfWidth + + val finish = (windowWidth - offset) - (windowWidth div 2) + val finish = Real32.fromInt finish / halfWidth + + val lines = helpGenGraphLinesHorizontal + (0, xClickPoints, [], halfWidth, ~1.0, 1.0) + val lines = helpGenGraphLinesVertical + (0, yClickPoints, lines, halfHeight, start, finish) + in + Vector.concat lines + end + else + (* windowWidth < windowHeight *) + let + val difference = windowHeight - windowWidth + val offset = difference div 2 + + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + + val start = offset - (windowHeight div 2) + val start = Real32.fromInt start / halfHeight + + val finish = (windowHeight - offset) - (windowHeight div 2) + val finish = Real32.fromInt finish / halfHeight + + val lines = helpGenGraphLinesHorizontal + (0, xClickPoints, [], halfWidth, start, finish) + val lines = helpGenGraphLinesVertical + (0, yClickPoints, lines, halfHeight, ~1.0, 1.0) + in + Vector.concat lines + end + + fun generate (app: AppType.app_type) = + let + val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = app + in + helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints) + end +end diff --git a/temp-squares/temp.mlb b/temp-squares/temp.mlb index 3621bf2..0e3346d 100644 --- a/temp-squares/temp.mlb +++ b/temp-squares/temp.mlb @@ -6,3 +6,8 @@ click-points.sml app-init.sml app-with.sml +ann + "allowVectorExps true" +in + graph-lines.sml +end