done refactoring functional core (mostly); next, need to move folders in temp-squares directory into main
This commit is contained in:
@@ -2,293 +2,8 @@ structure AppUpdate =
|
||||
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, realToInt xpos, realToInt ypos, 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)
|
||||
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, ...} =
|
||||
model
|
||||
val maxSide = Int.max (canvasWidth, canvasHeight)
|
||||
|
||||
val squares = CollisionTree.toTriangles (width, height, squares, maxSide)
|
||||
|
||||
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, [])
|
||||
|
||||
(* unimplemented *)
|
||||
fun getSaveSquaresMsg model = (model, [])
|
||||
|
||||
fun getLoadSquaresMsg model = (model, [])
|
||||
|
||||
fun getExportSquaresMsg model = (model, [])
|
||||
|
||||
fun useSquaresInNormalMode (model, squares) = (model, [])
|
||||
|
||||
fun squaresLoadError 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
|
||||
| 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 => getSaveSquaresMsg model
|
||||
| KEY_CTRL_L => getLoadSquaresMsg model
|
||||
| KEY_CTRL_E => getExportSquaresMsg 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_SQUARES squares => useSquaresInNormalMode (model, squares)
|
||||
| SQUARES_LOAD_ERROR => squaresLoadError model
|
||||
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
|
||||
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
|
||||
fun update (model: app_type, inputMsg) =
|
||||
case #mode model of
|
||||
NORMAL_MODE => NormalMode.update (model, inputMsg)
|
||||
| BROWSE_MODE => BrowseMode.update (model, inputMsg)
|
||||
end
|
||||
|
||||
172
temp-squares/fcore/browse-mode.sml
Normal file
172
temp-squares/fcore/browse-mode.sml
Normal file
@@ -0,0 +1,172 @@
|
||||
structure BrowseMode =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
open DrawMessage
|
||||
open FileMessage
|
||||
open InputMessage
|
||||
open UpdateMessage
|
||||
|
||||
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 chrVec = Vector.fromList []
|
||||
|
||||
(*
|
||||
*
|
||||
|
||||
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 selectCurrentFileItem model =
|
||||
let
|
||||
val {fileBrowser, fileBrowserIdx, openFilePath, ...} = model
|
||||
in
|
||||
if Vector.length fileBrowser > 0 then
|
||||
let
|
||||
val path =
|
||||
case Vector.sub (fileBrowser, fileBrowserIdx) of
|
||||
IS_FILE str => str
|
||||
| IS_FOLDER str => str
|
||||
val path = String.concat [openFilePath, "/", path]
|
||||
val fileMsg = SELECT_PATH path
|
||||
in
|
||||
(model, [FILE fileMsg])
|
||||
end
|
||||
else
|
||||
(model, [])
|
||||
end
|
||||
|
||||
fun update (model: app_type, inputMsg) =
|
||||
case inputMsg of
|
||||
ARROW_UP => browseModeArrowUp model
|
||||
| ARROW_DOWN => browseModeArrowDown model
|
||||
(* todo:
|
||||
| ARROW_LEFT =>
|
||||
*)
|
||||
| ARROW_RIGHT => selectCurrentFileItem model
|
||||
| KEY_ENTER => selectCurrentFileItem model
|
||||
| KEY_SPACE => selectCurrentFileItem model
|
||||
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
|
||||
handleFileBrowserAndPathInBrowseMode (model, fileBrowser, path)
|
||||
| SQUARES_LOAD_ERROR => CommonUpdate.squaresLoadError model
|
||||
| USE_SQUARES squares =>
|
||||
CommonUpdate.useSquaresInNormalMode (model, squares)
|
||||
| _ => (model, [])
|
||||
end
|
||||
@@ -21,10 +21,8 @@ struct
|
||||
val curPos = Vector.sub (clickPoints, idx)
|
||||
val nextPos = Vector.sub (clickPoints, nextIdx)
|
||||
in
|
||||
if mousePos >= curPos andalso mousePos <= nextPos then
|
||||
SOME idx
|
||||
else
|
||||
getClickPos (clickPoints, mousePos, idx + 1)
|
||||
if mousePos >= curPos andalso mousePos <= nextPos then SOME idx
|
||||
else getClickPos (clickPoints, mousePos, idx + 1)
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
13
temp-squares/fcore/common-update.sml
Normal file
13
temp-squares/fcore/common-update.sml
Normal file
@@ -0,0 +1,13 @@
|
||||
structure CommonUpdate =
|
||||
struct
|
||||
(* unimplemented *)
|
||||
fun getSaveSquaresMsg model = (model, [])
|
||||
|
||||
fun getLoadSquaresMsg model = (model, [])
|
||||
|
||||
fun getExportSquaresMsg model = (model, [])
|
||||
|
||||
fun useSquaresInNormalMode (model, squares) = (model, [])
|
||||
|
||||
fun squaresLoadError model = (model, [])
|
||||
end
|
||||
284
temp-squares/fcore/normal-mode.sml
Normal file
284
temp-squares/fcore/normal-mode.sml
Normal file
@@ -0,0 +1,284 @@
|
||||
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, realToInt xpos, realToInt ypos, 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)
|
||||
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, ...} =
|
||||
model
|
||||
val maxSide = Int.max (canvasWidth, canvasHeight)
|
||||
|
||||
val squares = CollisionTree.toTriangles (width, height, squares, maxSide)
|
||||
|
||||
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
|
||||
@@ -262,11 +262,11 @@ struct
|
||||
| [] => Vector.concat acc
|
||||
in
|
||||
fun toTriangles (windowWidth, windowHeight, squares, size) =
|
||||
let
|
||||
val qtree = build (0, 0, size, squares)
|
||||
val squares = toList qtree
|
||||
in
|
||||
loop (windowWidth, windowHeight, squares, [])
|
||||
end
|
||||
let
|
||||
val qtree = build (0, 0, size, squares)
|
||||
val squares = toList qtree
|
||||
in
|
||||
loop (windowWidth, windowHeight, squares, [])
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@@ -20,5 +20,9 @@ message-types/input-msg.sml
|
||||
message-types/update-msg.sml
|
||||
|
||||
fcore/quad-tree.sml
|
||||
|
||||
fcore/common-update.sml
|
||||
fcore/normal-mode.sml
|
||||
fcore/browse-mode.sml
|
||||
fcore/app-update.sml
|
||||
|
||||
|
||||
Reference in New Issue
Block a user