Files
sml-projects/fcore/normal-mode.sml

375 lines
10 KiB
Standard ML
Raw Normal View History

structure NormalMode =
struct
open AppType
open DrawMessage
open FileMessage
open InputMessage
open UpdateMessage
fun getDotVecFromIndices (model: app_type, hIdx, vIdx) =
let
val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = model
val xpos = Vector.sub (xClickPoints, hIdx)
val ypos = Vector.sub (yClickPoints, vIdx)
val endXpos =
if hIdx + 1 = Vector.length xClickPoints then xpos
else Vector.sub (xClickPoints, hIdx + 1)
val endYpos =
if vIdx + 1 = Vector.length yClickPoints then ypos
else Vector.sub (yClickPoints, vIdx + 1)
val tl = ClickPoints.getDrawDotRgb
(xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
val tr = ClickPoints.getDrawDotRgb
(endXpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
val bl = ClickPoints.getDrawDotRgb
(xpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
val br = ClickPoints.getDrawDotRgb
(endXpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
in
Vector.concat [tl, tr, bl, br]
end
fun mouseMoveOrRelease (model: app_type) =
let
val drawVec =
case ClickPoints.getClickPositionFromMouse model of
SOME (hIdx, vIdx) => getDotVecFromIndices (model, hIdx, vIdx)
| NONE => Vector.fromList []
val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun getDrawDotMsgWhenArrowIsAtBoundary model =
let
val {arrowX, arrowY, ...} = model
val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun moveArrowUp (model: app_type) =
let
val {arrowX, arrowY, ...} = model
in
if arrowY > 0 then
let
val newArrowY = arrowY - 1
val model = AppWith.arrowY (model, newArrowY)
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowLeft (model: app_type) =
let
val {arrowX, arrowY, ...} = model
in
if arrowX > 0 then
let
val newArrowX = arrowX - 1
val model = AppWith.arrowX (model, newArrowX)
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowRight (model: app_type) =
let
val {arrowX, arrowY, xClickPoints, ...} = model
in
if arrowX < Vector.length xClickPoints - 2 then
let
val newArrowX = arrowX + 1
val model = AppWith.arrowX (model, newArrowX)
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowDown (model: app_type) =
let
val {arrowX, arrowY, yClickPoints, ...} = model
in
if arrowY < Vector.length yClickPoints - 2 then
let
val newArrowY = arrowY + 1
val model = AppWith.arrowY (model, newArrowY)
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun realToInt x = Real32.toInt IEEEReal.TO_NEAREST x
2025-07-11 23:55:12 +01:00
fun changeSquare (model: app_type, hIdx, vIdx, fModel) =
let
val
{ windowWidth
, windowHeight
, xClickPoints
, yClickPoints
, canvasWidth
, canvasHeight
, ...
} = model
val xpos = Vector.sub (xClickPoints, hIdx)
val ypos = Vector.sub (yClickPoints, vIdx)
2025-07-11 23:55:12 +01:00
val model = fModel (model, hIdx, vIdx, hIdx, vIdx)
val squares = #squares model
val dotVec = getDotVecFromIndices (model, hIdx, vIdx)
val maxSide = Int.max (canvasWidth, canvasHeight)
2025-07-11 00:57:55 +01:00
val squares = CollisionTree.toTriangles
( windowWidth
, windowHeight
, squares
, maxSide
, canvasWidth
, canvasHeight
, xClickPoints
, yClickPoints
)
val drawMsg = DRAW_SQUARES_AND_DOTS {squares = squares, dots = dotVec}
in
(model, [DRAW drawMsg])
end
2025-07-11 23:55:12 +01:00
fun addCoordinates (model, hIdx, vIdx) =
changeSquare (model, hIdx, vIdx, AppWith.addSquare)
fun mouseLeftClick model =
case ClickPoints.getClickPositionFromMouse model of
SOME (hIdx, vIdx) => addCoordinates (model, hIdx, vIdx)
| NONE => (model, [])
fun enterOrSpaceCoordinates model =
let val {arrowX, arrowY, ...} = model
in addCoordinates (model, arrowX, arrowY)
end
2025-07-11 23:47:28 +01:00
fun deletePixel (model, hIdx, vIdx) =
2025-07-11 23:55:12 +01:00
changeSquare (model, hIdx, vIdx, AppWith.deleteSquare)
2025-07-11 23:47:28 +01:00
fun backspace model =
let val {arrowX, arrowY, ...} = model
in deletePixel (model, arrowX, arrowY)
end
fun resizeWindow (model, width, height) =
let
val model = AppWith.windowResize (model, width, height)
2025-07-11 00:57:55 +01:00
val
{ squares
, canvasWidth
, canvasHeight
, showGraph
, arrowX
, arrowY
, xClickPoints
, yClickPoints
, ...
} = model
val maxSide = Int.max (canvasWidth, canvasHeight)
2025-07-11 00:57:55 +01:00
val squares = CollisionTree.toTriangles
( width
, height
, squares
, maxSide
, canvasWidth
, canvasHeight
, xClickPoints
, yClickPoints
)
val graphLines =
if showGraph then GraphLines.generate model else Vector.fromList []
val dots = getDotVecFromIndices (model, arrowX, arrowY)
val drawMsg =
RESIZE_SQUARES_DOTS_AND_GRAPH
{squares = squares, graphLines = graphLines, dots = dots}
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun undoAction model = (model, [])
fun redoAction model = (model, [])
fun toggleGraph (model: app_type) =
if #showGraph model then
let
val model = AppWith.graphVisibility (model, false)
val drawMsg = DRAW_GRAPH (Vector.fromList [])
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
let
val model = AppWith.graphVisibility (model, true)
val graphLines = GraphLines.generate model
val drawMsg = DRAW_GRAPH graphLines
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun updateNum (model: app_type, newNum) =
(AppWith.modalNum (model, newNum), [])
fun updateRed model = (AppWith.r model, [])
fun updateGreen model = (AppWith.g model, [])
fun updateBlue model = (AppWith.b model, [])
fun updateAlpha model = (AppWith.a model, [])
fun updateCanvas (model, canvasWidth, canvasHeight) =
let
val newCanvaidth = #modalNum model
val model = AppWith.canvasWidth (model, canvasWidth)
val
{ arrowX
, arrowY
, windowWidth
, windowHeight
, squares
, xClickPoints
, yClickPoints
, showGraph
, ...
} = model
val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
val graphLines =
if showGraph then GraphLines.generate model else Vector.fromList []
val maxSide = Int.max (canvasWidth, canvasHeight)
val squares = CollisionTree.toTriangles
( windowWidth
, windowHeight
, squares
, maxSide
, canvasWidth
, canvasHeight
, xClickPoints
, yClickPoints
)
val msg =
RESIZE_SQUARES_DOTS_AND_GRAPH
{squares = squares, dots = dotVec, graphLines = graphLines}
in
(model, [DRAW msg])
end
fun updateCanvasWidth model =
let
val newCanvasWidth = #modalNum model
val (model as {canvasWidth, canvasHeight, ...}) =
AppWith.canvasWidth (model, newCanvasWidth)
in
updateCanvas (model, canvasWidth, canvasHeight)
end
fun updateCanvasHeight model =
let
val newCanvasHeight = #modalNum model
val (model as {canvasWidth, canvasHeight, ...}) =
AppWith.canvasHeight (model, newCanvasHeight)
in
updateCanvas (model, canvasWidth, canvasHeight)
end
fun enterBrowseMode model =
let
val model = AppWith.mode (model, AppType.BROWSE_MODE)
(* todo: should draw modal window as well *)
val fileMsg = LOAD_FILES (#openFilePath model)
val fileMsg = [FILE fileMsg]
in
(model, fileMsg)
end
fun handleFileBrowserAndPathInNormalMode (model, fileBrowser, path) =
let val model = AppWith.fileBrowserAndPath (model, fileBrowser, path)
in (model, [])
end
fun update (model: app_type, inputMsg) =
case inputMsg of
MOUSE_MOVE {x = mouseX, y = mouseY} =>
let val model = AppWith.mousePosition (model, mouseX, mouseY)
in mouseMoveOrRelease model
end
| MOUSE_LEFT_RELEASE => mouseMoveOrRelease model
| MOUSE_LEFT_CLICK => mouseLeftClick model
| NUM num => updateNum (model, num)
| KEY_R => updateRed model
| KEY_G => updateGreen model
| KEY_B => updateBlue model
| KEY_A => updateAlpha model
| KEY_W => updateCanvasWidth model
| KEY_H => updateCanvasHeight model
| RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
| UNDO_ACTION => undoAction model
| REDO_ACTION => redoAction model
| KEY_T => toggleGraph model
| KEY_CTRL_S => CommonUpdate.getSaveSquaresMsg model
| KEY_CTRL_L => CommonUpdate.getLoadSquaresMsg model
| KEY_CTRL_E => CommonUpdate.getExportSquaresMsg model
| USE_SQUARES squares =>
CommonUpdate.useSquaresInNormalMode (model, squares)
| SQUARES_LOAD_ERROR => CommonUpdate.squaresLoadError model
| KEY_CTRL_O => enterBrowseMode model
| ARROW_UP => moveArrowUp model
| ARROW_LEFT => moveArrowLeft model
| ARROW_RIGHT => moveArrowRight model
| ARROW_DOWN => moveArrowDown model
2025-07-11 23:47:28 +01:00
| KEY_BACKSPACE => backspace model
| KEY_ENTER => enterOrSpaceCoordinates model
| KEY_SPACE => enterOrSpaceCoordinates model
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
end