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

progress towards supporting arrow input

Browse Source
This commit is contained in:
Humza Shahid
2024-09-20 12:33:31 +01:00
parent 2d817cc998
commit 9ffc19ef24
4 changed files with 236 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
functional-core/app/app-with.sml
View File

@@ -7,6 +7,9 @@ sig
val mousePosition: AppType.app_type * Real32.real * Real32.real
-> AppType.app_type
val arrowX: AppType.app_type * int -> AppType.app_type
val arrowY: AppType.app_type * int -> AppType.app_type
val undo:
AppType.app_type
* AppType.triangle_stage
@@ -133,6 +136,74 @@ struct
}
end
fun arrowX (app: app_type, arrowX) =
let
val
{ xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX = _
, arrowY
} = app
in
{ xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
}
end
fun arrowY (app: app_type, arrowY) =
let
val
{ xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY = _
} = app
in
{ xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
}
end
fun helpWindowResize
(app: app_type, windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) :
app_type =