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