humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refinements to 'getClickPos' function (and helper functions) in app-update.sml

Browse Source
This commit is contained in:
Humza Shahid
2024-07-31 13:32:22 +01:00
parent 6a2fe3ed18
commit 95345131ab
3 changed files with 58 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
dot-to-dot
View File

Binary file not shown.

43
functional-core/app-update.sml
View File

@@ -17,14 +17,16 @@ struct
end
end
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
local
val clickPoints =
#[ 25, 50, 75, 100
, 125, 150, 175, 200
, 225, 250, 275, 300
, 325, 350, 375, 400
, 425, 450, 475
]
val clickPoints = genClickPoints (500, 500)
fun getVerticalClickPos (idx, horizontalPos, mouseX, mouseY, r, g, b) =
if idx = Vector.length clickPoints then
@@ -33,15 +35,17 @@ struct
let
val curVerticalPos = Vector.sub (clickPoints, idx)
in
if mouseY < curVerticalPos - 10 orelse mouseY > curVerticalPos + 10 then
if mouseY < curVerticalPos - 7.0 orelse mouseY > curVerticalPos + 7.0 then
getVerticalClickPos
(idx + 1, horizontalPos, mouseX, mouseY, r, g, b)
else
let
val left = Real32.fromInt (horizontalPos - 10) / 500.0
val right = Real32.fromInt (horizontalPos + 10) / 500.0
val bottom = Real32.fromInt (curVerticalPos - 10) / 500.0
val top = Real32.fromInt (curVerticalPos + 10) / 500.0
val hpos = horizontalPos - 250.0
val vpos = ~(curVerticalPos - 250.0)
val left = (hpos - 5.0) / 250.0
val right = (hpos + 5.0) / 250.0
val bottom = (vpos - 5.0) / 250.0
val top = (vpos + 5.0) / 250.0
in
#[ left, bottom, r, g, b
, right, bottom, r, g, b
@@ -61,7 +65,7 @@ struct
let
val curPos = Vector.sub (clickPoints, idx)
in
if mouseX < curPos - 10 orelse mouseX > curPos + 10 then
if mouseX < curPos - 7.0 orelse mouseX > curPos + 7.0 then
getHorizontalClickPos (idx + 1, mouseX, mouseY, r, g, b)
else
getVerticalClickPos (0, curPos, mouseX, mouseY, r, g, b)
@@ -74,7 +78,8 @@ struct
* an empty vector is returned.
*)
fun getClickPos (mouseX, mouseY, r, g, b) =
getHorizontalClickPos (0, mouseX, mouseY, r, g, b)
getHorizontalClickPos
(0, Real32.fromInt mouseX, Real32.fromInt mouseY, r, g, b)
end
fun update (model, mouseX, mouseY, inputMsg) =
@@ -86,23 +91,23 @@ struct
MOUSE_MOVE {x = mouseX, y = mouseY} =>
let
val _ = print "mouse moved\n"
val drawMsg =
DRAW_BUTTON (getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0))
val drawMsg = DRAW_BUTTON (getClickPos
(mouseX, mouseY, 1.0, 0.0, 0.0))
in
(model, drawMsg, mouseX, mouseY)
end
| MOUSE_LEFT_RELEASE =>
let
val _ = print "mouse released\n"
val drawMsg =
DRAW_BUTTON (getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0))
val drawMsg = DRAW_BUTTON (getClickPos
(mouseX, mouseY, 1.0, 0.0, 0.0))
in
(model, drawMsg, mouseX, mouseY)
end
| MUSE_LEFT_CLICK =>
let
val _ = print "mouse clicked\n"
val buttonVec = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0)
val buttonVec = getClickPos (mouseX, mouseY, 0.0, 0.0, 1.0)
val drawMsg = DRAW_BUTTON buttonVec
in
(model, drawMsg, mouseX, mouseY)

51
imperative-shell/event-loop.sml
View File

@@ -1,7 +1,7 @@
structure EventLoop =
struct
open CML
open InputMessage
open DrawMessage
local
fun loop (inputMailbox, drawMailbox, mouseX, mouseY, model) =
@@ -21,24 +21,41 @@ struct
fun draw
(drawMailbox, window, graphDrawObject, buttonDrawObject, buttonDrawLength) =
if not (Glfw.windowShouldClose window) then
let
val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0)
val _ = Gles3.clear ()
case Mailbox.recvPoll drawMailbox of
NONE =>
let
val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0)
val _ = Gles3.clear ()
val _ = AppDraw.drawGraphLines graphDrawObject
val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength)
val _ = AppDraw.drawGraphLines graphDrawObject
val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength)
val _ = Glfw.pollEvents ()
val _ = Glfw.swapBuffers window
in
draw
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
)
end
val _ = Glfw.pollEvents ()
val _ = Glfw.swapBuffers window
in
draw
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
)
end
| SOME drawMsg =>
(case drawMsg of
DRAW_BUTTON vec =>
let
val _ = AppDraw.uploadButtonVector (buttonDrawObject, vec)
val buttonDrawLength = Vector.length vec div 5
in
draw
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
)
end)
else
Glfw.terminate ()
end