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

310 lines
8.8 KiB
Standard ML

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
fun addCoordinates (model: app_type, hIdx, vIdx) =
let
val
{ windowWidth
, windowHeight
, xClickPoints
, yClickPoints
, canvasWidth
, canvasHeight
, ...
} = model
val xpos = Vector.sub (xClickPoints, hIdx)
val ypos = Vector.sub (yClickPoints, vIdx)
val model = AppWith.addSquare (model, hIdx, vIdx, hIdx, vIdx)
val squares = #squares model
val dotVec = getDotVecFromIndices (model, hIdx, vIdx)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val maxSide = Int.max (canvasWidth, canvasHeight)
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
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
fun resizeWindow (model, width, height) =
let
val model = AppWith.windowResize (model, width, height)
val
{ squares
, canvasWidth
, canvasHeight
, showGraph
, arrowX
, arrowY
, xClickPoints
, yClickPoints
, ...
} = model
val maxSide = Int.max (canvasWidth, canvasHeight)
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, inputNum) =
let
val oldNum = #modalNum model
val newNum = oldNum * 10 + inputNum
val newNum = if newNum > 255 then 0 else newNum
in
(AppWith.modalNum (model, newNum), [])
end
fun updateRed model = (AppWith.r model, [])
fun updateGreen model = (AppWith.g model, [])
fun updateBlue model = (AppWith.b model, [])
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
| 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
| KEY_ENTER => enterOrSpaceCoordinates model
| KEY_SPACE => enterOrSpaceCoordinates model
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
end