Permalink
Browse files

move by grid size

  • Loading branch information...
1 parent f4bcda7 commit 29a0389fda8df82b325397ff92a870bd9af60e13 @torii-y torii-y committed Oct 7, 2016
Showing with 62 additions and 26 deletions.
  1. +22 −0 src/elm/Model/Direction.elm
  2. +9 −7 src/elm/Model/Model.elm
  3. +2 −13 src/elm/Model/ObjectsOperation.elm
  4. +29 −6 src/elm/Update.elm
@@ -0,0 +1,22 @@
+module Model.Direction exposing (..)
+
+
+type Direction = Up | Left | Right | Down
+
+
+opposite : Direction -> Direction
+opposite direction =
+ case direction of
+ Left -> Right
+ Right -> Left
+ Up -> Down
+ Down -> Up
+
+
+shiftTowards : Direction -> number -> (number, number)
+shiftTowards direction amount =
+ case direction of
+ Up -> (0, -amount)
+ Down -> (0, amount)
+ Right -> (amount, 0)
+ Left -> (-amount, 0)
@@ -9,6 +9,7 @@ import Util.ShortCut as ShortCut
import Util.IdGenerator as IdGenerator exposing (Seed)
import Util.DictUtil as DictUtil
+import Model.Direction exposing (..)
import Model.User as User exposing (User)
import Model.Person as Person exposing (Person)
import Model.Object as Object exposing (..)
@@ -251,7 +252,7 @@ nextObjectToInput object allObjects =
[object]
(List.filter (\e -> (idOf e) /= (idOf object)) allObjects)
in
- case ObjectsOperation.nearest ObjectsOperation.Down object island' of
+ case ObjectsOperation.nearest Down object island' of
Just e ->
if idOf object == idOf e then
Nothing
@@ -266,10 +267,11 @@ candidatesOf model =
List.filterMap (\personId -> Dict.get personId model.personInfo) model.candidates
-shiftSelectionToward : ObjectsOperation.Direction -> Model -> Model
+shiftSelectionToward : Direction -> Model -> Model
shiftSelectionToward direction model =
let
- floor = (getEditingFloorOrDummy model)
+ floor = getEditingFloorOrDummy model
+
selected = selectedObjects model
in
case selected of
@@ -286,7 +288,9 @@ shiftSelectionToward direction model =
newObjects = [e]
in
List.map idOf newObjects
- _ -> model.selectedObjects
+
+ _ ->
+ model.selectedObjects
in
{ model |
selectedObjects = toBeSelected
@@ -297,9 +301,7 @@ shiftSelectionToward direction model =
-- TODO bad naming
isSelected : Model -> Object -> Bool
isSelected model object =
- case model.editMode of
- Viewing _ -> False
- _ -> List.member (idOf object) model.selectedObjects
+ EditMode.isEditMode model.editMode && List.member (idOf object) model.selectedObjects
primarySelectedObject : Model -> Maybe Object
@@ -2,6 +2,7 @@ module Model.ObjectsOperation exposing (..)
{- this module does not know Model or Floor -}
+import Model.Direction exposing (..)
import Model.Object as Object exposing (..)
import Util.ListUtil exposing (..)
@@ -46,18 +47,6 @@ island current rest =
island (current ++ newObjects) rest'
-type Direction = Up | Left | Right | Down
-
-
-opposite : Direction -> Direction
-opposite direction =
- case direction of
- Left -> Right
- Right -> Left
- Up -> Down
- Down -> Up
-
-
compareBy : Direction -> Object -> Object -> Order
compareBy direction from new =
let
@@ -253,7 +242,7 @@ maximumPartsOf direction list =
LT -> memo
EQ -> e :: memo
GT -> [e]
-
+
_ -> [e]
in
List.foldl f [] list
View
@@ -19,6 +19,7 @@ import Util.IdGenerator as IdGenerator exposing (Seed)
import Util.DictUtil as DictUtil
import Util.File exposing (..)
+import Model.Direction as Direction exposing (..)
import Model.Model as Model exposing (Model, ContextMenu(..), DraggingContext(..), Tab(..))
import Model.EditMode as EditMode exposing (EditMode(..))
import Model.User as User exposing (User)
@@ -1815,7 +1816,7 @@ nextObjectToInput object allObjects =
[object]
(List.filter (\e -> (idOf e) /= (idOf object)) allObjects)
in
- case ObjectsOperation.nearest ObjectsOperation.Down object island' of
+ case ObjectsOperation.nearest Down object island' of
Just e ->
if idOf object == idOf e then
Nothing
@@ -1890,16 +1891,16 @@ updateByKeyEvent event model =
} ! [ saveCmd ]
(Just floor, _, ShortCut.UpArrow) ->
- Model.shiftSelectionToward ObjectsOperation.Up model ! []
+ moveSelectionToward Up model
(Just floor, _, ShortCut.DownArrow) ->
- Model.shiftSelectionToward ObjectsOperation.Down model ! []
+ moveSelectionToward Down model
(Just floor, _, ShortCut.LeftArrow) ->
- Model.shiftSelectionToward ObjectsOperation.Left model ! []
+ moveSelectionToward Left model
(Just floor, _, ShortCut.RightArrow) ->
- Model.shiftSelectionToward ObjectsOperation.Right model ! []
+ moveSelectionToward Right model
(Just floor, _, ShortCut.Del) ->
let
@@ -1911,12 +1912,34 @@ updateByKeyEvent event model =
} ! [ saveCmd ]
(Just floor, _, ShortCut.Other 9) ->
- Model.shiftSelectionToward ObjectsOperation.Right model ! []
+ Model.shiftSelectionToward Right model ! []
_ ->
model ! []
+moveSelectionToward : Direction -> Model -> (Model, Cmd Msg)
+moveSelectionToward direction model =
+ case model.floor of
+ Just editingFloor ->
+ let
+ shift =
+ Direction.shiftTowards direction gridSize
+
+ (newFloor, saveCmd) =
+ EditingFloor.commit
+ (saveFloorCmd model.apiConfig)
+ (Floor.move model.selectedObjects model.gridSize shift)
+ editingFloor
+ in
+ { model |
+ floor = Just newFloor
+ } ! [ saveCmd ]
+
+ Nothing ->
+ model ! []
+
+
updateByMoveObjectEnd : Id -> (Int, Int) -> (Int, Int) -> Model -> (Model, Cmd Msg)
updateByMoveObjectEnd id (x0, y0) (x1, y1) model =
case model.floor of

0 comments on commit 29a0389

Please sign in to comment.