begin coding functionality to move squares

This commit is contained in:
2025-08-08 23:39:29 +01:00
parent 1fe07149c7
commit f1cd3fbf85
7 changed files with 95 additions and 1 deletions

View File

@@ -1,6 +1,6 @@
structure AppType =
struct
datatype app_mode = NORMAL_MODE | BROWSE_MODE
datatype app_mode = NORMAL_MODE | BROWSE_MODE | MOVE_MODE
datatype file_browser_item = IS_FILE of string | IS_FOLDER of string

View File

@@ -6,4 +6,5 @@ struct
case #mode model of
NORMAL_MODE => NormalMode.update (model, inputMsg)
| BROWSE_MODE => BrowseMode.update (model, inputMsg)
| MOVE_MODE => MoveMode.update (model, inputMsg)
end

View File

@@ -145,6 +145,62 @@ struct
}
end
fun squares (app, newSquares) =
let
val
{ mode
, squares
, arrowX
, arrowY
, canvasWidth
, canvasHeight
, windowWidth
, windowHeight
, xClickPoints
, yClickPoints
, showGraph
, mouseX
, mouseY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, a
, modalNum
, undo
, redo
} = app
in
{ mode = mode
, squares = newSquares
, arrowX = arrowX
, arrowY = arrowY
, canvasWidth = canvasWidth
, canvasHeight = canvasHeight
, windowWidth = windowWidth
, windowHeight = windowHeight
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, a = a
, modalNum = modalNum
, undo = undo
, redo = redo
}
end
fun arrowX (app, arrowX) =
let
val

35
fcore/move-mode.sml Normal file
View File

@@ -0,0 +1,35 @@
structure MoveMode =
struct
open AppType
open InputMessage
fun makeBlankYAxis length =
Vector.tabulate (length, fn _ => {r = 0, g = 0, b = 0, a = 0})
fun moveImageUp (model: app_type) =
let
val {squares, ...} = model
val squares =
Vector.mapi
(fn (idx, yAxis) =>
if idx + 1 < Vector.length squares then
Vector.sub (squares, idx + 1)
else
makeBlankYAxis (Vector.length yAxis)) squares
val model = AppWith.squares (model, squares)
in
(model, [])
end
fun update (model, inputMsg) =
case inputMsg of
ARROW_UP => moveImageUp model
(*
| ARROW_LEFT => moveImageLeft model
| ARROW_RIGHT => moveImageRight model
| ARROW_DOWN => moveImageDown model
*)
| _ => (model, [])
end