begin refactoring
This commit is contained in:
26
dotscape.mlb
26
dotscape.mlb
@@ -1,27 +1,13 @@
|
||||
$(SML_LIB)/basis/mlton.mlb
|
||||
$(SML_LIB)/basis/basis.mlb
|
||||
$(SML_LIB)/cml/cml.mlb
|
||||
|
||||
ann
|
||||
"allowFFI true"
|
||||
in
|
||||
ffi/gles3-import.sml
|
||||
ffi/glfw-import.sml
|
||||
ffi/glfw-input.sml
|
||||
end
|
||||
|
||||
message-types/input-msg.sml
|
||||
message-types/draw-msg.sml
|
||||
functional-core/app-type.sml
|
||||
|
||||
ann
|
||||
"allowVectorExps true"
|
||||
in
|
||||
imperative-shell/constants.sml
|
||||
functional-core/app-update.sml
|
||||
imperative-shell/app-draw.sml
|
||||
functional-core/ndc.sml
|
||||
functional-core/click-points.sml
|
||||
functional-core/graph-lines.sml
|
||||
end
|
||||
functional-core/app-type.sml
|
||||
functional-core/app-with.sml
|
||||
|
||||
|
||||
imperative-shell/input-callbacks.sml
|
||||
imperative-shell/event-loop.sml
|
||||
imperative-shell/shell.sml
|
||||
|
||||
@@ -157,9 +157,6 @@ typedef Pointer Objptr;
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
MLLIB_PUBLIC(void mltonMouseMoveCallback (Real32 x0, Real32 x1);)
|
||||
MLLIB_PUBLIC(void mltonMouseClickCallback (Int32 x0, Int32 x1);)
|
||||
MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Int32 x0, Int32 x1);)
|
||||
|
||||
#undef MLLIB_PRIVATE
|
||||
#undef MLLIB_PUBLIC
|
||||
|
||||
44
functional-core/app-init.sml
Normal file
44
functional-core/app-init.sml
Normal file
@@ -0,0 +1,44 @@
|
||||
structure AppInit =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
local
|
||||
fun init (windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) =
|
||||
let
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish)
|
||||
val graphLines =
|
||||
GraphLines.generate
|
||||
(windowWidth, windowHeight, xClickPoints, yClickPoints)
|
||||
in
|
||||
{ triangles = []
|
||||
, triangleStage = NO_TRIANGLE
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, graphLines = graphLines
|
||||
}
|
||||
end
|
||||
in
|
||||
fun fromWidthAndHeight (windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
init (windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
init (windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
init (windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
end
|
||||
end
|
||||
@@ -24,26 +24,6 @@ sig
|
||||
, yClickPoints: Real32.real vector
|
||||
, graphLines: Real32.real vector
|
||||
}
|
||||
|
||||
val getInitial: int * int -> app_type
|
||||
|
||||
val genGraphLines: int * int * Real32.real vector * Real32.real vector -> Real32.real vector
|
||||
|
||||
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
|
||||
-> app_type
|
||||
|
||||
val withWindowResize: app_type * int * int -> app_type
|
||||
end
|
||||
|
||||
structure AppType :> APP_TYPE =
|
||||
@@ -80,332 +60,4 @@ struct
|
||||
, yClickPoints: Real32.real vector
|
||||
, graphLines: Real32.real vector
|
||||
}
|
||||
|
||||
fun genClickPoints (start, finish) =
|
||||
let
|
||||
val difference = finish - start
|
||||
val increment = Real32.fromInt difference / 40.0
|
||||
val start = Real32.fromInt start
|
||||
in
|
||||
Vector.tabulate (41, fn idx => (Real32.fromInt idx * increment) + start)
|
||||
end
|
||||
|
||||
local
|
||||
(* 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 pos2 = pos + 0.05
|
||||
val vec = Vector.fromList
|
||||
[ (* x = _.1 *)
|
||||
pos - 0.002, ~1.0
|
||||
, pos + 0.002, ~1.0
|
||||
, pos + 0.002, 1.0
|
||||
|
||||
, pos + 0.002, 1.0
|
||||
, pos - 0.002, 1.0
|
||||
, pos - 0.002, ~1.0
|
||||
(* y = _.1 *)
|
||||
, ~1.0, pos - 0.002
|
||||
, ~1.0, pos + 0.002
|
||||
, 1.0, pos + 0.002
|
||||
|
||||
, 1.0, pos + 0.002
|
||||
, 1.0, pos - 0.002
|
||||
, ~1.0, pos - 0.002
|
||||
|
||||
(* x = _.05 *)
|
||||
, pos2 - 0.001, ~1.0
|
||||
, pos2 + 0.001, ~1.0
|
||||
, pos2 + 0.001, 1.0
|
||||
|
||||
, pos2 + 0.001, 1.0
|
||||
, pos2 - 0.001, 1.0
|
||||
, pos2 - 0.001, ~1.0
|
||||
|
||||
(* y = _.05 *)
|
||||
, ~1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 + 0.001
|
||||
, 1.0, pos2 + 0.001
|
||||
|
||||
, 1.0, pos2 + 0.001
|
||||
, 1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 - 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 vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
Vector.fromList
|
||||
[
|
||||
ndc - 0.001, yMin
|
||||
, ndc + 0.001, yMin
|
||||
, ndc + 0.001, yMax
|
||||
|
||||
, ndc + 0.001, yMax
|
||||
, ndc - 0.001, yMax
|
||||
, ndc - 0.001, yMin
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
Vector.fromList
|
||||
[
|
||||
ndc - 0.002, yMin
|
||||
, ndc + 0.002, yMin
|
||||
, ndc + 0.002, yMax
|
||||
|
||||
, ndc + 0.002, yMax
|
||||
, ndc - 0.002, yMax
|
||||
, ndc - 0.002, yMin
|
||||
]
|
||||
val acc = vec:: 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 vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
Vector.fromList
|
||||
[
|
||||
xMin, ndc - 0.001
|
||||
, xMin, ndc + 0.001
|
||||
, xMax, ndc + 0.001
|
||||
|
||||
, xMax, ndc + 0.001
|
||||
, xMax, ndc - 0.001
|
||||
, xMin, ndc - 0.001
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
Vector.fromList
|
||||
[
|
||||
xMin, ndc - 0.002
|
||||
, xMin, ndc + 0.002
|
||||
, xMax, ndc + 0.002
|
||||
|
||||
, xMax, ndc + 0.002
|
||||
, xMax, ndc - 0.002
|
||||
, xMin, ndc - 0.002
|
||||
]
|
||||
val acc = vec:: acc
|
||||
in
|
||||
helpGenGraphLinesVertical
|
||||
(pos + 1, yClickPoints, acc, halfHeight, xMin, xMax)
|
||||
end
|
||||
in
|
||||
fun genGraphLines (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
|
||||
end
|
||||
|
||||
local
|
||||
fun make (windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) =
|
||||
let
|
||||
val xClickPoints = genClickPoints (wStart, wFinish)
|
||||
val yClickPoints = genClickPoints (hStart, hFinish)
|
||||
in
|
||||
{ triangles = []
|
||||
, triangleStage = NO_TRIANGLE
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, graphLines = genGraphLines (windowWidth, windowHeight, xClickPoints, yClickPoints)
|
||||
}
|
||||
end
|
||||
in
|
||||
fun getInitial (windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
make (windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
make (windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
make (windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
|
||||
fun withTriangleStage (app: app_type, newTriangleStage: triangle_stage) :
|
||||
app_type =
|
||||
let
|
||||
val
|
||||
{ triangleStage = _
|
||||
, triangles
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, graphLines
|
||||
} = app
|
||||
in
|
||||
{ triangleStage = newTriangleStage
|
||||
, triangles = triangles
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, graphLines = graphLines
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) :
|
||||
app_type =
|
||||
let
|
||||
val
|
||||
{ triangles
|
||||
, triangleStage = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, graphLines
|
||||
} = app
|
||||
|
||||
val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
|
||||
val newTriangles = newTriangle :: triangles
|
||||
in
|
||||
{ triangleStage = NO_TRIANGLE
|
||||
, triangles = newTriangles
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, graphLines = graphLines
|
||||
}
|
||||
end
|
||||
|
||||
local
|
||||
fun make
|
||||
( app: app_type
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, wStart
|
||||
, wFinish
|
||||
, hStart
|
||||
, hFinish
|
||||
) : app_type =
|
||||
let
|
||||
val
|
||||
{ xClickPoints = _
|
||||
, yClickPoints = _
|
||||
, windowWidth = _
|
||||
, windowHeight = _
|
||||
, graphLines = _
|
||||
, triangles
|
||||
, triangleStage
|
||||
} = app
|
||||
val xClickPoints = genClickPoints (wStart, wFinish)
|
||||
val yClickPoints = genClickPoints (hStart, hFinish)
|
||||
in
|
||||
{ xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, graphLines = genGraphLines (windowWidth, windowHeight, xClickPoints, yClickPoints)
|
||||
, triangles = triangles
|
||||
, triangleStage = triangleStage
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
}
|
||||
end
|
||||
in
|
||||
fun withWindowResize (app: app_type, windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
make (app, windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
make
|
||||
(app, windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
make (app, windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@@ -71,196 +71,6 @@ struct
|
||||
end
|
||||
end
|
||||
|
||||
fun ltrbToVertex (left, top, right, bottom, r, g, b) =
|
||||
#[ left, bottom, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, left, top, r, g, b
|
||||
|
||||
, left, top, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, right, top, r, g, b
|
||||
]
|
||||
|
||||
local
|
||||
(*
|
||||
* Range to detect from clickable position.
|
||||
* For example, if we have a clickable position at (x, y) = (500, 500),
|
||||
* with a range of 15, we can detect clicks targeting this position
|
||||
* from top left at (485, 485) to bottom right at (515, 515).
|
||||
* *)
|
||||
val range = 15.0
|
||||
|
||||
fun getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length yClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curVerticalPos = Vector.sub (yClickPoints, idx)
|
||||
in
|
||||
if mouseY < curVerticalPos - range orelse mouseY > curVerticalPos + range then
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx + 1
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
let
|
||||
(* calculate normalised device coordinates *)
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
val hpos = horizontalPos - halfWidth
|
||||
val vpos = ~(curVerticalPos - halfHeight)
|
||||
|
||||
(* coordinates to form small box around clicked area *)
|
||||
val left = (hpos - 5.0) / halfWidth
|
||||
val right = (hpos + 5.0) / halfWidth
|
||||
val bottom = (vpos - 5.0) / halfHeight
|
||||
val top = (vpos + 5.0) / halfHeight
|
||||
|
||||
(* normalised device coordinates of drawVec should be relative
|
||||
* to actual windowWidth and windowHeight,
|
||||
* even if not a square, to display cursor position... *)
|
||||
val drawVec = ltrbToVertex (left, top, right, bottom, r, g, b)
|
||||
in
|
||||
(*
|
||||
* ...however, normalised device coordinate of hpos and vpos
|
||||
* should be relative to the vertical centre
|
||||
* (if height is greater than width)
|
||||
* or horizontal centre
|
||||
* (if width is greater than height).
|
||||
*
|
||||
* So, for example, a 900x1000 resolution
|
||||
* will have clickable points from 50...950,
|
||||
* in increments of 50.
|
||||
* Because we always want to show canvas as a square
|
||||
* with an aspect ratio of 1:1.
|
||||
* For displaying the click position on the screen, drawVec
|
||||
* which uses actual windowWidth and windowHeight, is fine.
|
||||
* However, we want to attach the meaning "start" to 50
|
||||
* and "end" to 950,
|
||||
* so the hpos and vpos stored in the app's triangle list
|
||||
* subtracts the offset 50 if needed,
|
||||
* allowing us to treat the coordinates as a 900x900 square.
|
||||
*
|
||||
* We may not actually want to render a square to the screen
|
||||
* if the screen's aspect ratio is not 1:1,
|
||||
* but it's the responsibility of the rendering code
|
||||
* which turns triangles into OpenGL vectors
|
||||
* to do that.
|
||||
* *)
|
||||
if windowWidth = windowHeight then
|
||||
let
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / (halfWidth - offset)
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else
|
||||
(* windowHeight > windowWidth *)
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / (halfHeight - offset)
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
fun getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length xClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curPos = Vector.sub (xClickPoints, idx)
|
||||
in
|
||||
if mouseX < curPos - range orelse mouseX > curPos + range then
|
||||
getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx + 1
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, 0
|
||||
, curPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
end
|
||||
in
|
||||
(*
|
||||
* This function returns a vector containing the position data of the
|
||||
* clicked square.
|
||||
* If a square wasn't found at the clicked position,
|
||||
* 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
|
||||
)
|
||||
end
|
||||
|
||||
fun getFirstTriangleStageVector (x1, y1, drawVec, model) =
|
||||
let
|
||||
|
||||
109
functional-core/app-with.sml
Normal file
109
functional-core/app-with.sml
Normal file
@@ -0,0 +1,109 @@
|
||||
structure AppWith =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun triangleStage (app: app_type, newTriangleStage: triangle_stage) : app_type =
|
||||
let
|
||||
val
|
||||
{ triangleStage = _
|
||||
, triangles
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, graphLines
|
||||
} = app
|
||||
in
|
||||
{ triangleStage = newTriangleStage
|
||||
, triangles = triangles
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, graphLines = graphLines
|
||||
}
|
||||
end
|
||||
|
||||
fun newTriangle (app: app_type, x1, y1, x2, y2, x3, y3) : app_type =
|
||||
let
|
||||
val
|
||||
{ triangles
|
||||
, triangleStage = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, graphLines
|
||||
} = app
|
||||
|
||||
val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
|
||||
val newTriangles = newTriangle :: triangles
|
||||
in
|
||||
{ triangleStage = NO_TRIANGLE
|
||||
, triangles = newTriangles
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, graphLines = graphLines
|
||||
}
|
||||
end
|
||||
|
||||
local
|
||||
fun make
|
||||
( app: app_type
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, wStart
|
||||
, wFinish
|
||||
, hStart
|
||||
, hFinish
|
||||
) : app_type =
|
||||
let
|
||||
val
|
||||
{ xClickPoints = _
|
||||
, yClickPoints = _
|
||||
, windowWidth = _
|
||||
, windowHeight = _
|
||||
, graphLines = _
|
||||
, triangles
|
||||
, triangleStage
|
||||
} = app
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish)
|
||||
val graphLines =
|
||||
GraphLines.generate
|
||||
(windowWidth, windowHeight, xClickPoints, yClickPoints)
|
||||
in
|
||||
{ xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, graphLines = graphLines
|
||||
, triangles = triangles
|
||||
, triangleStage = triangleStage
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
}
|
||||
end
|
||||
in
|
||||
fun windowResize (app: app_type, windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
make (app, windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
make
|
||||
(app, windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
make (app, windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
end
|
||||
end
|
||||
205
functional-core/click-points.sml
Normal file
205
functional-core/click-points.sml
Normal file
@@ -0,0 +1,205 @@
|
||||
structure ClickPoints =
|
||||
struct
|
||||
fun generate (start, finish) =
|
||||
let
|
||||
val difference = finish - start
|
||||
val increment = Real32.fromInt difference / 40.0
|
||||
val start = Real32.fromInt start
|
||||
in
|
||||
Vector.tabulate (41, fn idx => (Real32.fromInt idx * increment) + start)
|
||||
end
|
||||
|
||||
local
|
||||
(*
|
||||
* Range to detect from clickable position.
|
||||
* For example, if we have a clickable position at (x, y) = (500, 500),
|
||||
* with a range of 15, we can detect clicks targeting this position
|
||||
* from top left at (485, 485) to bottom right at (515, 515).
|
||||
* *)
|
||||
val range = 15.0
|
||||
|
||||
fun getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length yClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curVerticalPos = Vector.sub (yClickPoints, idx)
|
||||
in
|
||||
if
|
||||
mouseY < curVerticalPos - range
|
||||
orelse mouseY > curVerticalPos + range
|
||||
then
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx + 1
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
let
|
||||
(* calculate normalised device coordinates *)
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
val hpos = horizontalPos - halfWidth
|
||||
val vpos = ~(curVerticalPos - halfHeight)
|
||||
|
||||
(* coordinates to form small box around clicked area *)
|
||||
val left = (hpos - 5.0) / halfWidth
|
||||
val right = (hpos + 5.0) / halfWidth
|
||||
val bottom = (vpos - 5.0) / halfHeight
|
||||
val top = (vpos + 5.0) / halfHeight
|
||||
|
||||
(* normalised device coordinates of drawVec should be relative
|
||||
* to actual windowWidth and windowHeight,
|
||||
* even if not a square, to display cursor position... *)
|
||||
val drawVec = Ndc.ltrbToVertex (left, top, right, bottom, r, g, b)
|
||||
in
|
||||
(*
|
||||
* ...however, normalised device coordinate of hpos and vpos
|
||||
* should be relative to the vertical centre
|
||||
* (if height is greater than width)
|
||||
* or horizontal centre
|
||||
* (if width is greater than height).
|
||||
*
|
||||
* So, for example, a 900x1000 resolution
|
||||
* will have clickable points from 50...950,
|
||||
* in increments of 50.
|
||||
* Because we always want to show canvas as a square
|
||||
* with an aspect ratio of 1:1.
|
||||
* For displaying the click position on the screen, drawVec
|
||||
* which uses actual windowWidth and windowHeight, is fine.
|
||||
* However, we want to attach the meaning "start" to 50
|
||||
* and "end" to 950,
|
||||
* so the hpos and vpos stored in the app's triangle list
|
||||
* subtracts the offset 50 if needed,
|
||||
* allowing us to treat the coordinates as a 900x900 square.
|
||||
*
|
||||
* We may not actually want to render a square to the screen
|
||||
* if the screen's aspect ratio is not 1:1,
|
||||
* but it's the responsibility of the rendering code
|
||||
* which turns triangles into OpenGL vectors
|
||||
* to do that.
|
||||
* *)
|
||||
if windowWidth = windowHeight then
|
||||
let
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / (halfWidth - offset)
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else
|
||||
(* windowHeight > windowWidth *)
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / (halfHeight - offset)
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
fun getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length xClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curPos = Vector.sub (xClickPoints, idx)
|
||||
in
|
||||
if mouseX < curPos - range orelse mouseX > curPos + range then
|
||||
getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx + 1
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, 0
|
||||
, curPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
end
|
||||
in
|
||||
(*
|
||||
* This function returns a vector containing the position data of the
|
||||
* clicked square.
|
||||
* If a square wasn't found at the clicked position,
|
||||
* an empty vector is returned.
|
||||
*)
|
||||
fun getClickPosition
|
||||
( mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, 0
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
end
|
||||
end
|
||||
176
functional-core/graph-lines.sml
Normal file
176
functional-core/graph-lines.sml
Normal file
@@ -0,0 +1,176 @@
|
||||
structure GraphLines =
|
||||
struct
|
||||
local
|
||||
(* 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 pos2 = pos + 0.05
|
||||
val vec =
|
||||
#[ (* x = _.1 *)
|
||||
pos - 0.002, ~1.0
|
||||
, pos + 0.002, ~1.0
|
||||
, pos + 0.002, 1.0
|
||||
|
||||
, pos + 0.002, 1.0
|
||||
, pos - 0.002, 1.0
|
||||
, pos - 0.002, ~1.0
|
||||
(* y = _.1 *)
|
||||
, ~1.0, pos - 0.002
|
||||
, ~1.0, pos + 0.002
|
||||
, 1.0, pos + 0.002
|
||||
|
||||
, 1.0, pos + 0.002
|
||||
, 1.0, pos - 0.002
|
||||
, ~1.0, pos - 0.002
|
||||
|
||||
(* x = _.05 *)
|
||||
, pos2 - 0.001, ~1.0
|
||||
, pos2 + 0.001, ~1.0
|
||||
, pos2 + 0.001, 1.0
|
||||
|
||||
, pos2 + 0.001, 1.0
|
||||
, pos2 - 0.001, 1.0
|
||||
, pos2 - 0.001, ~1.0
|
||||
|
||||
(* y = _.05 *)
|
||||
, ~1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 + 0.001
|
||||
, 1.0, pos2 + 0.001
|
||||
|
||||
, 1.0, pos2 + 0.001
|
||||
, 1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 - 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 vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
#[
|
||||
ndc - 0.001, yMin
|
||||
, ndc + 0.001, yMin
|
||||
, ndc + 0.001, yMax
|
||||
|
||||
, ndc + 0.001, yMax
|
||||
, ndc - 0.001, yMax
|
||||
, ndc - 0.001, yMin
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
#[
|
||||
ndc - 0.002, yMin
|
||||
, ndc + 0.002, yMin
|
||||
, ndc + 0.002, yMax
|
||||
|
||||
, ndc + 0.002, yMax
|
||||
, ndc - 0.002, yMax
|
||||
, ndc - 0.002, yMin
|
||||
]
|
||||
val acc = vec:: 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 vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
#[
|
||||
xMin, ndc - 0.001
|
||||
, xMin, ndc + 0.001
|
||||
, xMax, ndc + 0.001
|
||||
|
||||
, xMax, ndc + 0.001
|
||||
, xMax, ndc - 0.001
|
||||
, xMin, ndc - 0.001
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
#[
|
||||
xMin, ndc - 0.002
|
||||
, xMin, ndc + 0.002
|
||||
, xMax, ndc + 0.002
|
||||
|
||||
, xMax, ndc + 0.002
|
||||
, xMax, ndc - 0.002
|
||||
, xMin, ndc - 0.002
|
||||
]
|
||||
val acc = vec:: acc
|
||||
in
|
||||
helpGenGraphLinesVertical
|
||||
(pos + 1, yClickPoints, acc, halfHeight, xMin, xMax)
|
||||
end
|
||||
in
|
||||
fun generate (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
|
||||
end
|
||||
end
|
||||
14
functional-core/ndc.sml
Normal file
14
functional-core/ndc.sml
Normal file
@@ -0,0 +1,14 @@
|
||||
structure Ndc =
|
||||
struct
|
||||
(* ndc = normalised device coordinates *)
|
||||
|
||||
fun ltrbToVertex (left, top, right, bottom, r, g, b) =
|
||||
#[ left, bottom, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, left, top, r, g, b
|
||||
|
||||
, left, top, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, right, top, r, g, b
|
||||
]
|
||||
end
|
||||
Reference in New Issue
Block a user