A music player that connects to your cloud/distributed storage.
Queue drag & drop
+415
-34
+28
-3
src/Applications/UI.elm
+28
-3
src/Applications/UI.elm
···
22
22
import File.Select
23
23
import Html.Events.Extra.Pointer as Pointer
24
24
import Html.Styled as Html exposing (Html, section, toUnstyled)
25
-
import Html.Styled.Attributes exposing (css, id)
25
+
import Html.Styled.Attributes as Attributes exposing (css, id)
26
26
import Html.Styled.Events exposing (onClick)
27
27
import Html.Styled.Lazy as Lazy
28
28
import Json.Decode
···
47
47
import UI.Console
48
48
import UI.ContextMenu
49
49
import UI.Core as Core exposing (Flags, Model, Msg(..))
50
+
import UI.DnD as DnD
50
51
import UI.Equalizer as Equalizer
51
52
import UI.Kit
52
53
import UI.Navigation as Navigation
···
102
103
in
103
104
{ contextMenu = Nothing
104
105
, currentTime = Time.millisToPosix flags.initialTime
106
+
, isDragging = False
105
107
, isLoading = True
106
108
, navKey = key
107
109
, notifications = []
···
194
196
}
195
197
, Cmd.none
196
198
)
199
+
200
+
StoppedDragging ->
201
+
let
202
+
notDragging =
203
+
{ model | isDragging = False }
204
+
in
205
+
case model.page of
206
+
Page.Queue _ ->
207
+
update (QueueMsg <| Queue.DragMsg DnD.stoppedDragging) notDragging
208
+
209
+
_ ->
210
+
return notDragging
197
211
198
212
Core.ToggleLoadingScreen On ->
199
213
return { model | isLoading = True }
···
525
539
|> ChangeUrlUsingPage
526
540
|> updateWithModel model
527
541
542
+
StartedDragging ->
543
+
return { model | isDragging = True }
544
+
528
545
Reply.ToggleLoadingScreen state ->
529
546
update (Core.ToggleLoadingScreen state) model
530
547
···
844
861
else if Maybe.isJust model.equalizer.activeKnob then
845
862
[ (EqualizerMsg << Equalizer.AdjustKnob)
846
863
|> Pointer.onMove
847
-
|> Html.Styled.Attributes.fromUnstyled
864
+
|> Attributes.fromUnstyled
848
865
, (EqualizerMsg << Equalizer.DeactivateKnob)
849
866
|> Pointer.onUp
850
-
|> Html.Styled.Attributes.fromUnstyled
867
+
|> Attributes.fromUnstyled
868
+
]
869
+
870
+
else if model.isDragging then
871
+
[ Attributes.class "dragging-something"
872
+
, Attributes.fromUnstyled (Pointer.onUp <| always StoppedDragging)
851
873
]
852
874
853
875
else
···
1022
1044
-----------------------------------------
1023
1045
-- Bits & Pieces
1024
1046
-----------------------------------------
1047
+
, Css.Global.selector ".dragging-something" [ Css.cursor Css.grabbing ]
1048
+
, Css.Global.selector ".dragging-something *" [ Css.cursor Css.grabbing ]
1049
+
, Css.Global.selector ".grab-cursor" [ Css.cursor Css.grab ]
1025
1050
, Css.Global.selector ".lh-0" [ Css.lineHeight Css.zero ]
1026
1051
, Css.Global.selector ".pointer-events-none" [ Css.pointerEvents Css.none ]
1027
1052
]
+2
src/Applications/UI/Core.elm
+2
src/Applications/UI/Core.elm
···
41
41
{ contextMenu : Maybe (ContextMenu Msg)
42
42
, currentTime : Time.Posix
43
43
, debounce : Debouncer Msg Msg
44
+
, isDragging : Bool
44
45
, isLoading : Bool
45
46
, navKey : Nav.Key
46
47
, notifications : List (Notification Msg)
···
85
86
| LoadHypaethralUserData Json.Value
86
87
| ResizedWindow ( Int, Int )
87
88
| SetCurrentTime Time.Posix
89
+
| StoppedDragging
88
90
| ToggleLoadingScreen Switch
89
91
-----------------------------------------
90
92
-- Audio
+214
src/Applications/UI/DnD.elm
+214
src/Applications/UI/DnD.elm
···
1
+
module UI.DnD exposing (Environment, Model, Msg, environmentSubject, environmentTarget, hasDropped, initialModel, isBeingDraggedOver, listenToDrop, listenToEnterLeave, listenToStart, modelSubject, modelTarget, stoppedDragging, update)
2
+
3
+
import Html.Events.Extra.Pointer as Pointer
4
+
import Html.Styled exposing (Attribute)
5
+
import Html.Styled.Attributes as Attributes
6
+
import UI.Reply as Reply exposing (Reply)
7
+
8
+
9
+
10
+
-- 🌳
11
+
12
+
13
+
type Model context
14
+
= NotDragging
15
+
| Dragging { subject : context }
16
+
| DraggingOver { subject : context, target : context }
17
+
| Dropped { subject : context, target : context }
18
+
19
+
20
+
type Msg context
21
+
= Start context
22
+
| Enter context
23
+
| Leave context
24
+
| Drop context
25
+
| Stop
26
+
27
+
28
+
type alias Environment context msg =
29
+
{ model : Model context
30
+
, toMsg : Msg context -> msg
31
+
}
32
+
33
+
34
+
initialModel : Model context
35
+
initialModel =
36
+
NotDragging
37
+
38
+
39
+
40
+
-- 📣
41
+
42
+
43
+
update : Msg context -> Model context -> ( Model context, List Reply )
44
+
update msg model =
45
+
( ------------------------------------
46
+
-- Model
47
+
------------------------------------
48
+
case msg of
49
+
Start context ->
50
+
Dragging { subject = context }
51
+
52
+
Enter context ->
53
+
case model of
54
+
Dragging { subject } ->
55
+
DraggingOver { subject = subject, target = context }
56
+
57
+
_ ->
58
+
model
59
+
60
+
Leave _ ->
61
+
case model of
62
+
DraggingOver { subject } ->
63
+
Dragging { subject = subject }
64
+
65
+
_ ->
66
+
model
67
+
68
+
Drop context ->
69
+
case model of
70
+
DraggingOver { subject } ->
71
+
Dropped { subject = subject, target = context }
72
+
73
+
_ ->
74
+
NotDragging
75
+
76
+
Stop ->
77
+
NotDragging
78
+
------------------------------------
79
+
-- Reply
80
+
------------------------------------
81
+
, case msg of
82
+
Start context ->
83
+
[ Reply.StartedDragging ]
84
+
85
+
_ ->
86
+
[]
87
+
)
88
+
89
+
90
+
91
+
-- 🔱 ░░ EVENTS & MESSAGES
92
+
93
+
94
+
listenToStart : Environment context msg -> context -> Attribute msg
95
+
listenToStart { toMsg } context =
96
+
context
97
+
|> Start
98
+
|> toMsg
99
+
|> always
100
+
|> Pointer.onDown
101
+
|> Attributes.fromUnstyled
102
+
103
+
104
+
listenToEnterLeave : Environment context msg -> context -> List (Attribute msg)
105
+
listenToEnterLeave { model, toMsg } context =
106
+
case model of
107
+
NotDragging ->
108
+
[]
109
+
110
+
_ ->
111
+
[ context
112
+
|> Enter
113
+
|> toMsg
114
+
|> always
115
+
|> Pointer.onEnter
116
+
|> Attributes.fromUnstyled
117
+
, context
118
+
|> Leave
119
+
|> toMsg
120
+
|> always
121
+
|> Pointer.onLeave
122
+
|> Attributes.fromUnstyled
123
+
]
124
+
125
+
126
+
listenToDrop : Environment context msg -> context -> List (Attribute msg)
127
+
listenToDrop { model, toMsg } context =
128
+
case model of
129
+
NotDragging ->
130
+
[]
131
+
132
+
_ ->
133
+
[ context
134
+
|> Drop
135
+
|> toMsg
136
+
|> always
137
+
|> Pointer.onUp
138
+
|> Attributes.fromUnstyled
139
+
]
140
+
141
+
142
+
stoppedDragging : Msg context
143
+
stoppedDragging =
144
+
Stop
145
+
146
+
147
+
148
+
-- 🔱 ░░ MODEL
149
+
150
+
151
+
isBeingDraggedOver : context -> Model context -> Bool
152
+
isBeingDraggedOver context model =
153
+
case model of
154
+
DraggingOver { target } ->
155
+
context == target
156
+
157
+
_ ->
158
+
False
159
+
160
+
161
+
hasDropped : Model context -> Bool
162
+
hasDropped model =
163
+
case model of
164
+
Dropped _ ->
165
+
True
166
+
167
+
_ ->
168
+
False
169
+
170
+
171
+
modelSubject : Model context -> Maybe context
172
+
modelSubject model =
173
+
case model of
174
+
NotDragging ->
175
+
Nothing
176
+
177
+
Dragging { subject } ->
178
+
Just subject
179
+
180
+
DraggingOver { subject } ->
181
+
Just subject
182
+
183
+
Dropped { subject } ->
184
+
Just subject
185
+
186
+
187
+
modelTarget : Model context -> Maybe context
188
+
modelTarget model =
189
+
case model of
190
+
NotDragging ->
191
+
Nothing
192
+
193
+
Dragging _ ->
194
+
Nothing
195
+
196
+
DraggingOver { target } ->
197
+
Just target
198
+
199
+
Dropped { target } ->
200
+
Just target
201
+
202
+
203
+
204
+
-- 🔱 ░░ ENVIRONMENT
205
+
206
+
207
+
environmentSubject : Environment context msg -> Maybe context
208
+
environmentSubject =
209
+
.model >> modelSubject
210
+
211
+
212
+
environmentTarget : Environment context msg -> Maybe context
213
+
environmentTarget =
214
+
.model >> modelTarget
+92
-28
src/Applications/UI/List.elm
+92
-28
src/Applications/UI/List.elm
···
1
-
module UI.List exposing (Action, Item, view)
1
+
module UI.List exposing (Action, Item, Variant(..), view)
2
2
3
3
import Chunky exposing (..)
4
4
import Classes as C
···
10
10
import Html.Styled as Html exposing (Html, fromUnstyled)
11
11
import Html.Styled.Attributes as Attributes exposing (css, style, title)
12
12
import Material.Icons exposing (Coloring(..))
13
+
import Material.Icons.Action as Icons
13
14
import Maybe.Extra as Maybe
14
15
import Tachyons.Classes as T
16
+
import UI.DnD as DnD
15
17
import UI.Kit
16
18
import VirtualDom
17
19
···
33
35
, actions : List (Action msg)
34
36
}
35
37
38
+
39
+
type Variant context msg
40
+
= Normal
41
+
| Draggable (DnD.Environment context msg)
36
42
37
43
44
+
38
45
-- ⛩
39
46
40
47
41
-
view : List (Item msg) -> Html msg
42
-
view =
43
-
List.map item >> brick [ css listStyles ] [ T.lh_title ]
48
+
view : Variant Int msg -> List (Item msg) -> Html msg
49
+
view variant =
50
+
List.indexedMap (item variant) >> brick [ css listStyles ] [ T.lh_title ]
44
51
45
52
46
53
···
49
56
-----------------------------------------
50
57
51
58
52
-
item : Item msg -> Html msg
53
-
item { label, actions } =
59
+
item : Variant Int msg -> Int -> Item msg -> Html msg
60
+
item variant idx { label, actions } =
61
+
let
62
+
dragHandleColoring =
63
+
actions
64
+
|> List.head
65
+
|> Maybe.map .color
66
+
|> Maybe.withDefault Inherit
67
+
in
54
68
brick
55
-
[ css itemStyles ]
56
-
[ T.flex, T.fw6, T.items_center, T.pv3 ]
69
+
(case variant of
70
+
Normal ->
71
+
[ css (itemStyles { dragTarget = False }) ]
72
+
73
+
Draggable env ->
74
+
List.concat
75
+
[ [ css (itemStyles { dragTarget = DnD.environmentTarget env == Just idx }) ]
76
+
, DnD.listenToEnterLeave env idx
77
+
, DnD.listenToDrop env idx
78
+
]
79
+
)
80
+
[ T.flex
81
+
, T.fw6
82
+
, T.items_center
83
+
, T.pv3
84
+
]
57
85
[ -- Label
58
86
--------
59
87
chunk
···
64
92
----------
65
93
, chunk
66
94
[ T.flex, T.items_center ]
67
-
(List.map
68
-
(\action ->
69
-
brick
70
-
(case action.msg of
71
-
Just msg ->
72
-
[ Attributes.fromUnstyled (onClick msg)
73
-
, title action.title
74
-
]
95
+
(List.append
96
+
(List.map actionView actions)
97
+
(case variant of
98
+
Normal ->
99
+
[]
75
100
76
-
Nothing ->
77
-
[ title action.title ]
78
-
)
79
-
[ C.lh_0
80
-
, T.ml2
81
-
, ifThenElse (Maybe.isJust action.msg) T.pointer ""
82
-
]
83
-
[ fromUnstyled (action.icon 16 action.color) ]
101
+
Draggable env ->
102
+
[ dragActionView dragHandleColoring env idx ]
84
103
)
85
-
actions
86
104
)
87
105
]
88
106
89
107
108
+
actionView : Action msg -> Html msg
109
+
actionView action =
110
+
brick
111
+
(case action.msg of
112
+
Just msg ->
113
+
[ Attributes.fromUnstyled (onClick msg)
114
+
, title action.title
115
+
]
116
+
117
+
Nothing ->
118
+
[ title action.title ]
119
+
)
120
+
[ C.lh_0
121
+
, T.ml2
122
+
, ifThenElse (Maybe.isJust action.msg) T.pointer ""
123
+
]
124
+
[ fromUnstyled (action.icon 16 action.color) ]
125
+
126
+
127
+
dragActionView : Coloring -> DnD.Environment Int msg -> Int -> Html msg
128
+
dragActionView coloring env context =
129
+
brick
130
+
[ title "Drag me"
131
+
, DnD.listenToStart env context
132
+
]
133
+
[ C.lh_0
134
+
, C.grab_cursor
135
+
, T.ml2
136
+
]
137
+
[ fromUnstyled (Icons.drag_indicator 16 coloring) ]
138
+
139
+
90
140
91
141
-- 🖼
92
142
···
96
146
[ Css.fontSize (px 13) ]
97
147
98
148
99
-
itemStyles : List Css.Style
100
-
itemStyles =
101
-
[ Css.borderBottom3 (px 1) solid (Color.toElmCssColor UI.Kit.colors.verySubtleBorder) ]
149
+
itemStyles : { dragTarget : Bool } -> List Css.Style
150
+
itemStyles { dragTarget } =
151
+
if dragTarget then
152
+
List.append
153
+
itemBaseStyles
154
+
[ Css.borderTop3 (px 1) solid (Color.toElmCssColor UI.Kit.colorKit.accent) ]
155
+
156
+
else
157
+
itemBaseStyles
158
+
159
+
160
+
itemBaseStyles : List Css.Style
161
+
itemBaseStyles =
162
+
[ Css.borderBottom3 (px 1) solid (Color.toElmCssColor UI.Kit.colors.verySubtleBorder)
163
+
, Css.borderTop3 (px 1) solid Css.transparent
164
+
, Css.marginTop (px -1)
165
+
]
+63
-1
src/Applications/UI/Queue.elm
+63
-1
src/Applications/UI/Queue.elm
···
18
18
import Tachyons.Classes as T
19
19
import Time
20
20
import Tracks exposing (IdentifiedTrack)
21
+
import UI.DnD as DnD
21
22
import UI.Kit
22
23
import UI.List
23
24
import UI.Navigation exposing (..)
···
44
45
--
45
46
, repeat = False
46
47
, shuffle = False
48
+
49
+
--
50
+
, dnd = DnD.initialModel
47
51
}
48
52
49
53
···
232
236
[ FillQueue ]
233
237
234
238
------------------------------------
239
+
-- Drag & Drop
240
+
------------------------------------
241
+
DragMsg dragMsg ->
242
+
let
243
+
( dnd, replies ) =
244
+
DnD.update dragMsg model.dnd
245
+
in
246
+
if DnD.hasDropped dnd then
247
+
let
248
+
( subject, target ) =
249
+
( Maybe.withDefault 0 <| DnD.modelSubject dnd
250
+
, Maybe.withDefault 0 <| DnD.modelTarget dnd
251
+
)
252
+
253
+
subjectItem =
254
+
model.future
255
+
|> List.getAt subject
256
+
|> Maybe.map (\s -> { s | manualEntry = True })
257
+
258
+
fixedTarget =
259
+
if target > subject then
260
+
target - 1
261
+
262
+
else
263
+
target
264
+
265
+
newFuture =
266
+
model.future
267
+
|> List.removeAt subject
268
+
|> List.indexedFoldr
269
+
(\idx existingItem acc ->
270
+
if idx == fixedTarget then
271
+
case subjectItem of
272
+
Just itemToInsert ->
273
+
List.append [ itemToInsert, existingItem ] acc
274
+
275
+
Nothing ->
276
+
existingItem :: acc
277
+
278
+
else if idx < fixedTarget then
279
+
{ existingItem | manualEntry = True } :: acc
280
+
281
+
else
282
+
existingItem :: acc
283
+
)
284
+
[]
285
+
in
286
+
returnRepliesWithModel { model | dnd = dnd, future = newFuture } replies
287
+
288
+
else
289
+
returnRepliesWithModel { model | dnd = dnd } replies
290
+
291
+
------------------------------------
235
292
-- Settings
236
293
------------------------------------
237
294
ToggleRepeat ->
···
344
401
, model.future
345
402
|> List.indexedMap futureItem
346
403
|> UI.List.view
404
+
(UI.List.Draggable
405
+
{ model = model.dnd
406
+
, toMsg = DragMsg
407
+
}
408
+
)
347
409
|> chunky [ T.mt3 ]
348
410
]
349
411
]
···
436
498
, model.past
437
499
|> List.reverse
438
500
|> List.indexedMap historyItem
439
-
|> UI.List.view
501
+
|> UI.List.view UI.List.Normal
440
502
|> chunky [ T.mt3 ]
441
503
]
442
504
+8
src/Applications/UI/Queue/Core.elm
+8
src/Applications/UI/Queue/Core.elm
···
1
1
module UI.Queue.Core exposing (Model, Msg(..))
2
2
3
+
import UI.DnD as DnD
3
4
import Html.Events.Extra.Mouse as Mouse
4
5
import Queue exposing (..)
5
6
import Time
···
19
20
--
20
21
, repeat : Bool
21
22
, shuffle : Bool
23
+
24
+
--
25
+
, dnd : DnD.Model Int
22
26
}
23
27
24
28
···
48
52
| Clear
49
53
| Reset
50
54
| Fill Time.Posix (List IdentifiedTrack)
55
+
------------------------------------
56
+
-- Drag & Drop
57
+
------------------------------------
58
+
| DragMsg (DnD.Msg Int)
51
59
------------------------------------
52
60
-- Settings
53
61
------------------------------------
+1
src/Applications/UI/Reply.elm
+1
src/Applications/UI/Reply.elm
+1
-1
src/Applications/UI/Sources.elm
+1
-1
src/Applications/UI/Sources.elm
+6
-1
src/Library/Classes.elm
+6
-1
src/Library/Classes.elm
···
1
-
module Classes exposing (lh_0, pointer_events_none)
1
+
module Classes exposing (grab_cursor, lh_0, pointer_events_none)
2
2
3
3
{-| Some class names used for global css.
4
4
5
5
This is an extension of Tachyons.
6
6
7
7
-}
8
+
9
+
10
+
grab_cursor : String
11
+
grab_cursor =
12
+
"grab-cursor"
8
13
9
14
10
15
lh_0 : String