Files
sml-projects/fcore/click-points.sml

102 lines
3.3 KiB
Standard ML
Raw Normal View History

structure ClickPoints =
struct
2025-07-06 17:50:46 +01:00
fun helpMakeOne (start, finish, numPoints, point) =
let
val difference = finish - start
val increment = Real32.fromInt difference / Real32.fromInt numPoints
val start = Real32.fromInt start
in
(Real32.fromInt point * increment) + start
end
fun makeOne (windowWidth, windowHeight, numPoints, point) =
if windowWidth > windowHeight then
let
val difference = windowWidth - windowHeight
val half = difference div 2
val widthStart = half
val widthFinish = windowWidth - half
in
helpMakeOne (widthStart, widthFinish, numPoints, point)
end
else if windowHeight > windowWidth then
let
val difference = windowHeight - windowWidth
val half = difference div 2
val heightStart = half
val heightFinish = windowHeight - half
in
helpMakeOne (heightStart, heightFinish, numPoints, point)
end
else
helpMakeOne (0, windowWidth, numPoints, point)
fun generate (start, finish, numPoints) =
let
val difference = finish - start
val increment = Real32.fromInt difference / Real32.fromInt numPoints
val start = Real32.fromInt start
in
Vector.tabulate (numPoints + 1, fn idx =>
(Real32.fromInt idx * increment) + start)
end
2025-07-06 02:49:38 +01:00
2025-07-06 03:53:26 +01:00
fun getClickPos (clickPoints, mousePos, idx) =
let
val nextIdx = idx + 1
in
if nextIdx >= Vector.length clickPoints then
NONE
else
let
val curPos = Vector.sub (clickPoints, idx)
val nextPos = Vector.sub (clickPoints, nextIdx)
in
if mousePos >= curPos andalso mousePos <= nextPos then SOME idx
else getClickPos (clickPoints, mousePos, idx + 1)
end
end
2025-07-06 03:53:26 +01:00
fun getClickPositionFromMouse (app: AppType.app_type) =
case getClickPos (#xClickPoints app, #mouseX app, 0) of
SOME hIdx =>
(case getClickPos (#yClickPoints app, #mouseY app, 0) of
SOME vIdx => SOME (hIdx, vIdx)
| NONE => NONE)
| NONE => NONE
2025-07-06 02:49:38 +01:00
fun getDrawDot (xpos, ypos, windowWidth, windowHeight) =
let
(* calculate normalised device coordinates *)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val hpos = xpos - halfWidth
val vpos = ~(ypos - 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
in
Ndc.ltrbToVertex (left, top, right, bottom)
end
fun getDrawDotRgb (xpos, ypos, r, g, b, windowWidth, windowHeight) =
let
(* calculate normalised device coordinates *)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val hpos = xpos - halfWidth
val vpos = ~(ypos - 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
in
Ndc.ltrbToVertexRgb (left, top, right, bottom, r, g, b)
end
end