561 lines
17 KiB
Standard ML
561 lines
17 KiB
Standard ML
signature APP_UPDATE =
|
|
sig
|
|
val update: AppType.app_type * InputMessage.t
|
|
-> AppType.app_type * UpdateMessage.t list
|
|
end
|
|
|
|
structure AppUpdate :> APP_UPDATE =
|
|
struct
|
|
open AppType
|
|
|
|
open DrawMessage
|
|
open FileMessage
|
|
open InputMessage
|
|
open UpdateMessage
|
|
|
|
fun getDotVecFromIndices (model, hIdx, vIdx) =
|
|
let
|
|
val {windowWidth, windowHeight, ...} = model
|
|
val xpos = Vector.sub (#xClickPoints model, hIdx)
|
|
val ypos = Vector.sub (#yClickPoints model, vIdx)
|
|
in
|
|
ClickPoints.getDrawDotRgb
|
|
(xpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
|
|
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 drawVec = TriangleStage.toVector (model, drawVec)
|
|
|
|
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 dotVec = TriangleStage.toVector (model, dotVec)
|
|
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 dotVec = TriangleStage.toVector (model, dotVec)
|
|
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 dotVec = TriangleStage.toVector (model, dotVec)
|
|
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 - 1 then
|
|
let
|
|
val newArrowX = arrowX + 1
|
|
val model = AppWith.arrowX (model, newArrowX)
|
|
|
|
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
|
|
val dotVec = TriangleStage.toVector (model, dotVec)
|
|
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 - 1 then
|
|
let
|
|
val newArrowY = arrowY + 1
|
|
val model = AppWith.arrowY (model, newArrowY)
|
|
|
|
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
|
|
val dotVec = TriangleStage.toVector (model, dotVec)
|
|
val drawMsg = DRAW_DOT dotVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
else
|
|
getDrawDotMsgWhenArrowIsAtBoundary model
|
|
end
|
|
|
|
fun addCoordinates (model: app_type, hIdx, vIdx) =
|
|
let
|
|
val
|
|
{ windowWidth
|
|
, windowHeight
|
|
, xClickPoints
|
|
, yClickPoints
|
|
, triangleStage
|
|
, ...
|
|
} = model
|
|
|
|
val xpos = Vector.sub (xClickPoints, hIdx)
|
|
val ypos = Vector.sub (yClickPoints, vIdx)
|
|
val dotVec = ClickPoints.getDrawDotRgb
|
|
(xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
|
|
|
|
val halfWidth = Real32.fromInt (windowWidth div 2)
|
|
val halfHeight = Real32.fromInt (windowHeight div 2)
|
|
val hpos =
|
|
ClickPoints.xposToNdc (xpos, windowWidth, windowHeight, halfWidth)
|
|
val vpos =
|
|
ClickPoints.yposToNdc (ypos, windowWidth, windowHeight, halfHeight)
|
|
|
|
val newUndoTuple = (hpos, vpos)
|
|
in
|
|
case triangleStage of
|
|
NO_TRIANGLE =>
|
|
let
|
|
val drawVec = TriangleStage.toVector (model, dotVec)
|
|
val drawMsg = DRAW_DOT drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
|
|
val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
|
|
val model = AppWith.addTriangleStage
|
|
(model, newTriangleStage, newUndoTuple, hIdx, vIdx)
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| FIRST {x1, y1} =>
|
|
let
|
|
val drawVec = TriangleStage.firstToVector (x1, y1, dotVec, model)
|
|
val drawMsg = DRAW_DOT drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
|
|
val newTriangleStage = SECOND
|
|
{x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
|
|
val model = AppWith.addTriangleStage
|
|
(model, newTriangleStage, newUndoTuple, hIdx, vIdx)
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| SECOND {x1, y1, x2, y2} =>
|
|
let
|
|
val model = AppWith.addTriangle
|
|
(model, x1, y1, x2, y2, hpos, vpos, newUndoTuple, hIdx, vIdx)
|
|
val drawVec = Triangles.toVector model
|
|
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
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 triangles = Triangles.toVector model
|
|
|
|
val graphLines =
|
|
if #showGraph model then GraphLines.generate model
|
|
else Vector.fromList []
|
|
|
|
val dots = TriangleStage.toVector (model, Vector.fromList [])
|
|
|
|
val drawMsg =
|
|
RESIZE_TRIANGLES_DOTS_AND_GRAPH
|
|
{triangles = triangles, graphLines = graphLines, dots = dots}
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
|
|
fun undoAction model =
|
|
case #triangleStage model of
|
|
FIRST {x1, y1} =>
|
|
(* Change FIRST to NO_TRIANGLE and clear dots. *)
|
|
let
|
|
val model =
|
|
AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1))
|
|
in
|
|
(model, [DRAW CLEAR_DOTS])
|
|
end
|
|
| SECOND {x1, y1, x2, y2} =>
|
|
(* Change FIRST to SECOND and redraw dots. *)
|
|
let
|
|
val newTriangleStage = FIRST {x1 = x1, y1 = y1}
|
|
val model =
|
|
AppWith.undo (model, newTriangleStage, #triangles model, (x2, y2))
|
|
|
|
val emptyVec: Real32.real vector = Vector.fromList []
|
|
val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model)
|
|
val drawMsg = DRAW_DOT drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| NO_TRIANGLE =>
|
|
(case #triangles model of
|
|
{x1, y1, x2, y2, x3, y3} :: trianglesTl =>
|
|
(* Have to slice off (x3, y3) from triangle head,
|
|
* turn (x1, y1, x2, y2) into a triangleStage,
|
|
* and redraw both triangle and triangleStage. *)
|
|
let
|
|
val triangleStage = SECOND {x1 = x1, y1 = y1, x2 = x2, y2 = y2}
|
|
val model =
|
|
AppWith.undo (model, triangleStage, trianglesTl, (x3, y3))
|
|
|
|
val newTriangleVec = Triangles.toVector model
|
|
val emptyVec: Real32.real vector = Vector.fromList []
|
|
val drawVec = TriangleStage.secondToVector
|
|
(x1, y1, x2, y2, emptyVec, model)
|
|
val drawMsg =
|
|
DRAW_TRIANGLES_AND_DOTS
|
|
{triangles = newTriangleVec, dots = drawVec}
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| [] =>
|
|
(* Can't undo, because there are no actions to undo. *)
|
|
(model, []))
|
|
|
|
fun redoAction model =
|
|
case #redo model of
|
|
(redoHd as (x, y)) :: tl =>
|
|
(* There is a click point to redo. *)
|
|
(case #triangleStage model of
|
|
NO_TRIANGLE =>
|
|
(* add to triangle stage, and redraw dots *)
|
|
let
|
|
val newTriangleStage = FIRST {x1 = x, y1 = y}
|
|
val model =
|
|
AppWith.redo
|
|
(model, newTriangleStage, #triangles model, redoHd)
|
|
|
|
val emptyVec: Real32.real vector = Vector.fromList []
|
|
val drawVec = TriangleStage.firstToVector (x, y, emptyVec, model)
|
|
val drawMsg = DRAW_DOT drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| FIRST {x1, y1} =>
|
|
(* add to triangle stage, redraw dots *)
|
|
let
|
|
val newTriangleStage = SECOND {x1 = x1, y1 = y1, x2 = x, y2 = y}
|
|
val model =
|
|
AppWith.redo
|
|
(model, newTriangleStage, #triangles model, redoHd)
|
|
|
|
val emptyVec: Real32.real vector = Vector.fromList []
|
|
val drawVec = TriangleStage.secondToVector
|
|
(x1, y1, x, y, emptyVec, model)
|
|
val drawMsg = DRAW_DOT drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
| SECOND {x1, y1, x2, y2} =>
|
|
(* clear triangle stage, add to trinagle list and redraw triangles *)
|
|
let
|
|
val newTriangleStage = NO_TRIANGLE
|
|
val newTriangle =
|
|
{x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x, y3 = y}
|
|
val newTriangles = newTriangle :: (#triangles model)
|
|
val model =
|
|
AppWith.redo (model, newTriangleStage, newTriangles, redoHd)
|
|
|
|
val drawVec = Triangles.toVector model
|
|
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end)
|
|
| [] => (* Nothing to redo. *) (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 getSaveTrianglesMsg model =
|
|
let
|
|
val {triangles, ...} = model
|
|
val fileMsg = SAVE_TRIANGLES triangles
|
|
val fileMsg = [FILE fileMsg]
|
|
in
|
|
(model, fileMsg)
|
|
end
|
|
|
|
fun getLoadTrianglesMsg model =
|
|
(model, [FILE LOAD_TRIANGLES])
|
|
|
|
fun getExportTrianglesMsg model =
|
|
let
|
|
val {triangles, ...} = model
|
|
val fileMsg = EXPORT_TRIANGLES (#triangles model)
|
|
val fileMsg = [FILE fileMsg]
|
|
in
|
|
(model, fileMsg)
|
|
end
|
|
|
|
fun useTriangles (model, triangles) =
|
|
let
|
|
val model = AppWith.useTriangles (model, triangles)
|
|
val drawVec = Triangles.toVector model
|
|
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
|
val drawMsg = [DRAW drawMsg]
|
|
in
|
|
(model, drawMsg)
|
|
end
|
|
|
|
fun trianglesLoadError model = (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 updateNormalMode (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
|
|
| RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
|
|
| UNDO_ACTION => undoAction model
|
|
| REDO_ACTION => redoAction model
|
|
| KEY_G => toggleGraph model
|
|
| KEY_CTRL_S => getSaveTrianglesMsg model
|
|
| KEY_CTRL_L => getLoadTrianglesMsg model
|
|
| KEY_CTRL_E => getExportTrianglesMsg 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
|
|
| USE_TRIANGLES triangles => useTriangles (model, triangles)
|
|
| TRIANGLES_LOAD_ERROR => trianglesLoadError model
|
|
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
|
|
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
|
|
|
|
fun stringToVec
|
|
(pos, str, acc, startX, startY, windowWidth, windowHeight, r, g, b) =
|
|
if pos = String.size str then
|
|
acc
|
|
else
|
|
let
|
|
val chr = String.sub (str, pos)
|
|
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
|
|
val chrVec = chrFun
|
|
(startX, startY, 25.0, 25.0, windowWidth, windowHeight, r, g, b)
|
|
val acc = chrVec :: acc
|
|
in
|
|
stringToVec
|
|
( pos + 1
|
|
, str
|
|
, acc
|
|
, startX + 12
|
|
, startY
|
|
, windowWidth
|
|
, windowHeight
|
|
, r
|
|
, g
|
|
, b
|
|
)
|
|
end
|
|
|
|
fun buildFileBrowserText
|
|
(pos, fileBrowser, acc, startY, windowWidth, windowHeight, selectedIdx) =
|
|
if pos = Vector.length fileBrowser then
|
|
Vector.concat acc
|
|
else
|
|
let
|
|
val item = Vector.sub (fileBrowser, pos)
|
|
val itemText =
|
|
case item of
|
|
IS_FILE str => str
|
|
| IS_FOLDER str => str
|
|
val acc =
|
|
if pos <> selectedIdx then
|
|
stringToVec
|
|
( 0
|
|
, itemText
|
|
, acc
|
|
, 10
|
|
, startY
|
|
, windowWidth
|
|
, windowHeight
|
|
, 0.0
|
|
, 0.0
|
|
, 0.0
|
|
)
|
|
else
|
|
stringToVec
|
|
( 0
|
|
, itemText
|
|
, acc
|
|
, 10
|
|
, startY
|
|
, windowWidth
|
|
, windowHeight
|
|
, 0.35
|
|
, 0.35
|
|
, 0.75
|
|
)
|
|
in
|
|
buildFileBrowserText
|
|
( pos + 1
|
|
, fileBrowser
|
|
, acc
|
|
, startY + 23
|
|
, windowWidth
|
|
, windowHeight
|
|
, selectedIdx
|
|
)
|
|
end
|
|
|
|
fun redrawFileBrowser (model: app_type) =
|
|
let
|
|
val {windowWidth, windowHeight, fileBrowser, fileBrowserIdx, ...} = model
|
|
val ww = Real32.fromInt windowWidth
|
|
val wh = Real32.fromInt windowHeight
|
|
val textVec = buildFileBrowserText
|
|
(0, fileBrowser, [], 10, ww, wh, fileBrowserIdx)
|
|
|
|
val drawMsg = DRAW_MODAL_TEXT textVec
|
|
in
|
|
(model, [DRAW drawMsg])
|
|
end
|
|
|
|
fun handleFileBrowserAndPathInBrowseMode (model, fileBrowser, path) =
|
|
let val model = AppWith.fileBrowserAndPath (model, fileBrowser, path)
|
|
in redrawFileBrowser model
|
|
end
|
|
|
|
fun browseModeArrowUp (model: app_type) =
|
|
let
|
|
val {fileBrowser, fileBrowserIdx, ...} = model
|
|
|
|
val fileBrowserIdx =
|
|
if fileBrowserIdx > 0 then fileBrowserIdx - 1
|
|
else Int.max (0, Vector.length fileBrowser - 1)
|
|
|
|
val model = AppWith.fileBrowserIdx (model, fileBrowserIdx)
|
|
in
|
|
redrawFileBrowser model
|
|
end
|
|
|
|
fun browseModeArrowDown (model: app_type) =
|
|
let
|
|
val {fileBrowser, fileBrowserIdx, ...} = model
|
|
|
|
val fileBrowserIdx =
|
|
if fileBrowserIdx = Vector.length fileBrowser - 1 then 0
|
|
else fileBrowserIdx + 1
|
|
|
|
val model = AppWith.fileBrowserIdx (model, fileBrowserIdx)
|
|
in
|
|
redrawFileBrowser model
|
|
end
|
|
|
|
fun updateBrowseMode (model: app_type, inputMsg) =
|
|
case inputMsg of
|
|
ARROW_UP => browseModeArrowUp model
|
|
| ARROW_DOWN => browseModeArrowDown model
|
|
| TRIANGLES_LOAD_ERROR => trianglesLoadError model
|
|
(* todo:
|
|
| ARROW_LEFT =>
|
|
| ARROW_RIGHT =>
|
|
| KEY_ENTER =>
|
|
| KEY_SPACE =>
|
|
*)
|
|
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
|
|
handleFileBrowserAndPathInBrowseMode (model, fileBrowser, path)
|
|
| _ => (model, [])
|
|
|
|
fun update (model: app_type, inputMsg) =
|
|
case #mode model of
|
|
NORMAL_MODE => updateNormalMode (model, inputMsg)
|
|
| BROWSE_MODE => updateBrowseMode (model, inputMsg)
|
|
end
|