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

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