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

135 lines
3.3 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
, squares
, xClickPoints
, yClickPoints
, ...
} = model
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 = 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 moveImageUp (model: app_type) =
let
val {squares, ...} = model
val squares =
Vector.mapi
(fn (_, yAxis) =>
Vector.mapi
(fn (yIdx, pixel) =>
if yIdx = Vector.length yAxis - 1 then blankPixel
else Vector.sub (yAxis, yIdx + 1)) yAxis) squares
val model = AppWith.squares (model, squares)
in
getDrawMsg model
end
fun moveImageDown (model: app_type) =
let
val {squares, ...} = model
val squares =
Vector.mapi
(fn (_, yAxis) =>
Vector.mapi
(fn (yIdx, pixel) =>
if yIdx = 0 then blankPixel else Vector.sub (yAxis, yIdx - 1))
yAxis) squares
val model = AppWith.squares (model, squares)
in
getDrawMsg model
end
fun moveImageLeft (model: app_type) =
let
val {squares, ...} = model
val squares =
Vector.mapi
(fn (idx, yAxis) =>
if idx + 1 = Vector.length squares then
makeBlankYAxis (Vector.length squares)
else
Vector.sub (squares, idx + 1)) squares
val model = AppWith.squares (model, squares)
in
getDrawMsg model
end
fun moveImageRight (model: app_type) =
let
val {squares, ...} = model
val squares =
Vector.mapi
(fn (idx, yAxis) =>
if idx = 0 then makeBlankYAxis (Vector.length squares)
else Vector.sub (squares, idx - 1)) squares
val model = AppWith.squares (model, squares)
in
getDrawMsg model
end
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