Humza Shahid
f3a4e15ed5
git-subtree-dir: dotscape git-subtree-mainline:6b91d64fc3git-subtree-split:f306501a68
127 lines
3.4 KiB
Standard ML
127 lines
3.4 KiB
Standard ML
structure MoveMode =
|
|
struct
|
|
open AppType
|
|
open InputMessage
|
|
open DrawMessage
|
|
open UpdateMessage
|
|
|
|
fun resizeWindow (model, width, height) =
|
|
let
|
|
val model = AppWith.windowResize (model, width, height)
|
|
val dots = Vector.fromList []
|
|
in
|
|
CommonUpdate.resizeWindow (model, width, height, dots)
|
|
end
|
|
|
|
fun getDrawMsg (model: app_type) =
|
|
let
|
|
val
|
|
{ canvasWidth
|
|
, canvasHeight
|
|
, windowWidth
|
|
, windowHeight
|
|
, layerTree
|
|
, xClickPoints
|
|
, yClickPoints
|
|
, ...
|
|
} = model
|
|
|
|
val maxSide = Int.max (canvasWidth, canvasHeight)
|
|
val grid = LayerTree.flatten (maxSide, layerTree)
|
|
|
|
val squares = CollisionTree.toTriangles
|
|
( windowWidth
|
|
, windowHeight
|
|
, grid
|
|
, maxSide
|
|
, canvasWidth
|
|
, canvasHeight
|
|
, xClickPoints
|
|
, yClickPoints
|
|
)
|
|
val drawMsg =
|
|
DRAW_SQUARES_AND_DOTS {squares = squares, dots = Vector.fromList []}
|
|
in
|
|
(model, [DRAW drawMsg])
|
|
end
|
|
|
|
val blankPixel = {r = 0, g = 0, b = 0, a = 0}
|
|
|
|
fun makeBlankYAxis length =
|
|
Vector.tabulate (length, fn _ => blankPixel)
|
|
|
|
fun makeBlankXAxis length =
|
|
Vector.tabulate (length, fn _ => makeBlankYAxis length)
|
|
|
|
fun finishMove (model: app_type, newGrid) =
|
|
let
|
|
val {layer, layerTree, arrowX, arrowY, ...} = model
|
|
val layerTree = LayerTree.insert (layer, newGrid, layerTree)
|
|
val model = AppWith.layerTree (model, layerTree, arrowX, arrowY)
|
|
in
|
|
getDrawMsg model
|
|
end
|
|
|
|
fun moveImage (model: app_type, fMove) =
|
|
let
|
|
val {layer, layerTree, ...} = model
|
|
in
|
|
case LayerTree.get (layer, layerTree) of
|
|
SOME grid => finishMove (model, fMove grid)
|
|
| NONE => (model, [])
|
|
end
|
|
|
|
fun helpMoveImageUp grid =
|
|
Vector.mapi
|
|
(fn (_, yAxis) =>
|
|
Vector.mapi
|
|
(fn (yIdx, pixel) =>
|
|
if yIdx = Vector.length yAxis - 1 then blankPixel
|
|
else Vector.sub (yAxis, yIdx + 1)) yAxis) grid
|
|
|
|
fun moveImageUp (model: app_type) = moveImage (model, helpMoveImageUp)
|
|
|
|
fun helpMoveImageDown grid =
|
|
Vector.mapi
|
|
(fn (_, yAxis) =>
|
|
Vector.mapi
|
|
(fn (yIdx, pixel) =>
|
|
if yIdx = 0 then blankPixel else Vector.sub (yAxis, yIdx - 1))
|
|
yAxis) grid
|
|
|
|
fun moveImageDown (model: app_type) = moveImage (model, helpMoveImageDown)
|
|
|
|
fun helpMoveImageLeft grid =
|
|
Vector.mapi
|
|
(fn (idx, yAxis) =>
|
|
if idx + 1 = Vector.length grid then
|
|
makeBlankYAxis (Vector.length grid)
|
|
else
|
|
Vector.sub (grid, idx + 1)) grid
|
|
|
|
fun moveImageLeft (model: app_type) = moveImage (model, helpMoveImageLeft)
|
|
|
|
fun helpMoveImageRight grid =
|
|
Vector.mapi
|
|
(fn (idx, yAxis) =>
|
|
if idx = 0 then makeBlankYAxis (Vector.length grid)
|
|
else Vector.sub (grid, idx - 1)) grid
|
|
|
|
fun moveImageRight (model: app_type) = moveImage (model, helpMoveImageRight)
|
|
|
|
fun enterNormalMode model =
|
|
let val model = AppWith.mode (model, AppType.NORMAL_MODE)
|
|
in (model, [])
|
|
end
|
|
|
|
fun update (model, inputMsg) =
|
|
case inputMsg of
|
|
ARROW_UP => moveImageUp model
|
|
| ARROW_DOWN => moveImageDown model
|
|
| ARROW_LEFT => moveImageLeft model
|
|
| ARROW_RIGHT => moveImageRight model
|
|
| KEY_ESC => enterNormalMode model
|
|
| RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
|
|
| _ => (model, [])
|
|
end
|