port arrow movement (involving functional core)

temp-squares/fcore/app-update.sml

@@ -27,16 +27,16 @@ struct
 
       val tl =
         ClickPoints.getDrawDotRgb
-          (xpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
+          (xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
       val tr =
         ClickPoints.getDrawDotRgb
-          (endXpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
+          (endXpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
       val bl =
         ClickPoints.getDrawDotRgb
-          (xpos, endYpos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
+          (xpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
       val br =
         ClickPoints.getDrawDotRgb
-          (endXpos, endYpos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
+          (endXpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
     in
       Vector.concat [tl, tr, bl, br]
     end
@@ -53,4 +53,90 @@ struct
     in
       (model, drawMsg)
     end
+
+  fun getDrawDotMsgWhenArrowIsAtBoundary model =
+    let
+      val {arrowX, arrowY, ...} = model
+      val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
+      val drawMsg = DRAW_DOT dotVec
+      val drawMsg = [DRAW drawMsg]
+    in
+      (model, drawMsg)
+    end
+
+  fun moveArrowUp (model: app_type) =
+    let
+      val {arrowX, arrowY, ...} = model
+    in
+      if arrowY > 0 then
+        let
+          val newArrowY = arrowY - 1
+          val model = AppWith.arrowY (model, newArrowY)
+
+          val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowLeft (model: app_type) =
+    let
+      val {arrowX, arrowY, ...} = model
+    in
+      if arrowX > 0 then
+        let
+          val newArrowX = arrowX - 1
+          val model = AppWith.arrowX (model, newArrowX)
+
+          val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowRight (model: app_type) =
+    let
+      val {arrowX, arrowY, xClickPoints, ...} = model
+    in
+      if arrowX < Vector.length xClickPoints - 2 then
+        let
+          val newArrowX = arrowX + 1
+          val model = AppWith.arrowX (model, newArrowX)
+
+          val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowDown (model: app_type) =
+    let
+      val {arrowX, arrowY, yClickPoints, ...} = model
+    in
+      if arrowY < Vector.length yClickPoints - 2 then
+        let
+          val newArrowY = arrowY + 1
+          val model = AppWith.arrowY (model, newArrowY)
+
+          val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
 end