前回 はBrowsert
やSvg
などの標準的なパッケージを利用してドラッグ機能を実現した。今回はelm-draggable というパッケージを使ってドラッグ機能を実現してみる。
Elmのプロジェクトを作成して、src/Main.elm
とsrc/Circle.elm
を作成。
Circle.elm# 前回と同じなのでコードだけ載せる。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
module Circle exposing (..)
type alias Id =
Int
type alias Circle =
{ id : Id
, x : Float
, y : Float
, r : Float
}
type alias Circles =
{ all : List Circle
, nextId : Id
}
empty : Circles
empty =
{ all = []
, nextId = 0
}
type alias CircleNoId =
{ x : Float
, y : Float
, r : Float
}
add : CircleNoId -> Circles -> Circles
add c circles =
let
circle =
{ id = circles . nextId
, x = c . x
, y = c . y
, r = c . r
}
in
{ circles
| all = circle :: circles . all
, nextId = circles . nextId + 1
}
fromList : List CircleNoId -> Circles
fromList list =
{ all = List . indexedMap ( \ i c -> { id = i , x = c . x , y = c . y , r = c . r }) list
, nextId = List . length list
}
toList : Circles -> List Circle
toList circles =
circles . all
update : Id -> ( Circle -> Circle ) -> Circles -> Circles
update id f circles =
let
new =
List . foldr
( \ c acc ->
if c . id == id then
f c :: acc
else
c :: acc
)
[]
circles . all
in
{ circles | all = new }
copy
Main.elm# Circles
を描画するところまで書く。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
module Main exposing (..)
import Browser
import Circle as C exposing ( Circle , CircleNoId , Circles , Id )
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode as JD
import Svg as S exposing ( Svg )
import Svg.Attributes as SA
import Svg.Events as SE
main =
Browser . element
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}
type alias Model =
{ circles : Circles
}
init : () -> ( Model , Cmd Msg )
init _ =
( { circles =
C . fromList
[ CircleNoId 10 10 10
, CircleNoId 20 100 20
, CircleNoId 250 250 30
]
}
, Cmd . none
)
type Msg
= Dummy
update : Msg -> Model -> ( Model , Cmd Msg )
update msg model =
( model , Cmd . none )
view : Model -> Html Msg
view model =
div []
[ viewSvg model
]
viewSvg : Model -> Svg Msg
viewSvg model =
S . svg
[ style "width" "500px"
, style "height" "500px"
, style "border" "1px solid #000"
]
[ viewCircles model
]
viewCircles : Model -> Svg Msg
viewCircles model =
S . g []
( List . map ( viewCircle model ) ( C . toList model . circles ))
viewCircle : Model -> Circle -> Svg Msg
viewCircle model circle =
S . g [ SA . transform ( translate circle . x circle . y ) ]
[ S . circle
[ SA . r ( String . fromFloat circle . r )
, SA . fill "#fff"
, SA . stroke "#000"
]
[]
]
translate : Float -> Float -> String
translate x y =
"translate(" ++ String . fromFloat x ++ "," ++ String . fromFloat y ++ ")"
subscriptions : Model -> Sub Msg
subscriptions model =
Sub . none
copy
elm-draggableのインストール# $ elm install zaboco/elm-draggable
src/Main.elm
にて、Draggable
とDraggable.Events
をimportする。
1
2
import Draggable as D
import Draggable.Events as DE
copy
elm-draggableの仕組み# Usage を読むと、次のような仕組みでドラッグを管理しているとわかる。
ドラッグの状態は、Model
内にdrag: Draggable.DragState a
として管理する。a
に入るのは、ドラッグ中の要素の識別子の型。 ドラッグはDraggable.mouseTrigger
をドラッグしたい要素に指定することで可能になる。 ドラッグ状態の変化はsubscription
でDraggable.subscriptions
を指定することで待ち受ける。 Draggable.update
で、Model
内のdrag
を更新する。ドラッグ量、ドラッグ開始、ドラック終了などの細かい情報をどんなMsg
として受けとるのかについては、Draggable.customConfig
で指定する。Draggable.update
の引数に乗せることによって、Msg
を発生させているっぽい。 Modelの追加# drag
を追加する。ついでにドラッグ中のCircle
のid
をhold
として持たせておく。drag
はDraggable.init
で初期化しなければいけないようなのでその通りにする。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
type alias Model =
{ ...
, hold : Maybe Id
, drag : D . State Id
}
init : () -> ( Model , Cmd Msg )
init _ =
( { ...
, hold = Nothing
, drag = D . init
}
, Cmd . none
)
copy
ドラッグイベントの指定# Draggable.mouseTrigger
をcircle
要素に指定する。第1引数には、ドラッグの対象となる要素の識別子を指定する。今回はCircle
のId
を指定する。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
type Msg
= DragMsg ( D . Msg Id )
...
viewCircle : Model -> Circle -> Svg Msg
viewCircle model circle =
S . g [ ... ]
[ S . circle
[ ...
, D . mouseTrigger circle . id DragMsg
]
[]
]
copy
ドキュメントに明言はされていないが、おそらくmouseTrigger
はマウスが押下されたときに起こるイベント。ドラッグ中はDraggable.subscriptions
で監視する。
1
2
3
subscriptions : Model -> Sub Msg
subscriptions model =
D . subscriptions DragMsg model . drag
copy
ドラッグイベントを受け取る# Model
が持つdrag
はドラッグ状態(ドラッグ開始/中/終了など)を持っている。ただし、この状態を直接のぞくことはできない。ドラッグ状態はMsg
として取得する。具体的には、以下のようにする。
まず、どんな状態が欲しいのかをMsg
として定義する。D.Delta
とはマウスの移動量を表す型で、(Float, Float)
のエイリアス。
1
2
3
4
5
type Msg
= DragMsg ( D . Msg Id )
| OnDragStart Id
| OnDragBy D . Delta
| OnDragEnd
copy
どのMsg
にどの状態を対応させるのかを、D.customConfig
に定義する。Draggable.Event.onDragStart
はドラッグ開始を意味する。Draggable.Event.onDragBy
はドラッグ中を意味する。Draggable.Event.onDragStart
はドラッグ終了を意味する。それぞれの状態がどんな情報を持っているのかについてはドキュメント を読むと分かる。
1
2
3
4
5
6
7
dragConfig : D . Config Id Msg
dragConfig =
D . customConfig
[ DE . onDragStart OnDragStart
, DE . onDragBy OnDragBy
, DE . onDragEnd OnDragEnd
]
copy
DragMsg
を受け取ったとき、Draggable.upate
を用いてdrag
を更新する。この際に、上で定義したdragConfig
を利用する。恐らくこのときに、OnDragStart Id
、OnDragBy D.Delta
、OnDragEnd
のいずれかを発生させるようなコマンドが作られる。
1
2
3
4
5
update : Msg -> Model -> ( Model , Cmd Msg )
update msg model =
case msg of
DragMsg dragMsg ->
D . update dragConfig dragMsg model
copy
そこで、各ドラッグ状態に対応したMsg
について、Model
の更新処理を書く。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
update : Msg -> Model -> ( Model , Cmd Msg )
update msg model =
case msg of
...
OnDragStart id ->
( { model | hold = Just id }
, Cmd . none
)
OnDragBy ( dx , dy ) ->
( { model
| circles = updateCircles model dx dy
}
, Cmd . none
)
OnDragEnd ->
( { model | hold = Nothing }
, Cmd . none
)
updateCircles : Model -> Float -> Float -> Circles
updateCircles model dx dy =
case model . hold of
Nothing ->
model . circles
Just id ->
C . update id
( \ c -> { c | x = c . x + dx , y = c . y + dy })
model . circles
copy
これで円をドラッグして移動できるようになった。「ドラッグ中は円の色を変える」処理については、前回とまったく同じなので省略。
補足: Msgを発行するコマンド# OnDragStart
やOnDragBy
はどこから発行されているのか、についてはUsage の最初の段落で述べられている。
どうやら、任意のMsg
を作るコマンドは、Task
を用いて作ることができるようだ。例えば以下のようにすると、Foo
を発行するコマンドを作成することができる。
1
Task . perform identity ( Task . succeed Foo )
copy
Task.succeed Foo
で、常にFoo
という値を返すTask
を作成する。Task.perform
は、第2引数のTask
を実行して、その結果を第1引数に適用してMsg
を発行する。identity
は恒等関数なので、結局Foo
そのものをMsg
として発行する。
この手法についてはElm-CommunityのFAQ にも載っている。しかしそこにも書かれているが、わざわざコマンドを作成して非同期処理にするよりも、単にupdate
を再帰呼び出しすれば十分なことが多い。
つまり、
1
2
3
4
5
6
7
8
9
update : Msg -> Model -> Cmd Msg
update msg model =
Foo ->
...
Bar ->
( model
, Task . perform identity ( Task . succeed Foo )
)
copy
とするより、
1
2
3
4
5
6
7
update : Msg -> Model -> Cmd Msg
update msg model =
Foo ->
...
Bar ->
update Foo model
copy
とすれば十分なことが多い。
ただ前者を用いた良いケースもあるようで、FAQでは、
The former option may be attractive when recursive calls to update could cause an infinite loop, or for authors of reusable components interested in creating a clean encapsulation of their library’s internal behavior.意訳: 前者の選択肢は、updateを再帰呼び出しすると無限ループを引き起こしたり、また再利用可能なコンポーネントの作者が、ライブラリの内部状態をきれいにカプセル化することに関心がある場合に魅力的かもしれない。
とある。