Add 'dotscape/' from commit 'f306501a68a51b634e895c5fdac70788ae899d75'

git-subtree-dir: dotscape git-subtree-mainline: 6b91d64fc3 git-subtree-split: f306501a68
2026-04-24 00:30:08 +01:00
parent 6b91d64fc3 f306501a68
commit f3a4e15ed5
53 changed files with 9187 additions and 0 deletions
--- a/dotscape/fcore/move-mode.sml
+++ b/dotscape/fcore/move-mode.sml
@@ -0,0 +1,126 @@
+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