progress with move mode

fcore/move-mode.sml

@@ -2,10 +2,44 @@ structure MoveMode =
 struct
   open AppType
   open InputMessage
+  open DrawMessage
+  open UpdateMessage
+
+  (* todo: resize message, escape button to go back to normal mode *)
 
   fun makeBlankYAxis length =
     Vector.tabulate (length, fn _ => {r = 0, g = 0, b = 0, a = 0})
 
+  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
+
   fun moveImageUp (model: app_type) =
     let
       val {squares, ...} = model
@@ -20,16 +54,61 @@ struct
 
       val model = AppWith.squares (model, squares)
     in
-      (model, [])
+      getDrawMsg model
+    end
+
+  fun moveImageDown (model: app_type) =
+    let
+      val {squares, ...} = model
+
+      val squares =
+        Vector.mapi
+          (fn (idx, yAxis) =>
+             if idx = 0 then makeBlankYAxis (Vector.length yAxis)
+             else Vector.sub (squares, idx - 1)) 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 = 0 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 + 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 update (model, inputMsg) =
     case inputMsg of
       ARROW_UP => moveImageUp model
-    (*
+    | ARROW_DOWN => moveImageDown model
     | ARROW_LEFT => moveImageLeft model
     | ARROW_RIGHT => moveImageRight model
-    | ARROW_DOWN => moveImageDown model
-    *)
     | _ => (model, [])
 end