aboutsummaryrefslogtreecommitdiffhomepage
path: root/playlist.lisp
blob: 7c5a9b609ed35bb9afc906b8add927ff6cb2e727 (plain)
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
;;;; playlist.lisp

(in-package :vampire)


;;; CLIENT STATE 

(defclass/std playlist-ctl ()
  ((playlist :std nil :doc "The playlist instance.")
   (editorp :std nil)
   (tracks :std nil :doc "A list of instances of track-ctl")
   (now-playing-track :std nil :doc "An instance of track-ctl")
   (np-title np-artist np-thumb np-dur np-time np-play
             :std nil :doc "Now Playing Elements")
   (pl-title pl-tracks pl-dur
             :std nil :doc "Playlist Elements"))
  (:documentation "Holds the complete state for this session's viewing of a particular playlist."))

(defclass/std track-ctl ()
  ((track audio container :std nil))
  (:documentation "The state of a particular track in this session's viewing of a playlist."))


(defun audio-for-track (ctl track)
  "Return the audio element associated with the track"
  (when-let (trctl (find track (tracks ctl) :test #'eq :key #'track))
    (audio trctl)))

(defun track-for-audio (ctl audio)
  "Return the track instance associated with the AUDIO element."
  (when-let (trctl (find audio (tracks ctl) :test #'eq :key #'audio))
    (track trctl)))

(defun track-ctl-with-audio (ctl audio)
  (find audio (tracks ctl) :key #'audio))

(defun find-next-track (ctl &optional track)
  "Return the TRACK-CTL instance that appeqars after TRACK in the
  TRACKS list, or NIL.  If TRACK is NIL, return the first TRACK in the
  list."
  (if (null track)
      (first (tracks ctl))
      (when-let (pos (position track (tracks ctl)))
        (nth (1+ pos) (tracks ctl)))))

(defun find-previous-track (ctl &optional track)
  (when-let (pos (position track (tracks ctl)))
    (when (plusp pos)
      (nth (1- pos) (tracks ctl)))))

;;; SESSION UTIL 

(defparameter +playlist-connection-key+ "playlist-connection-key"
  "Stored in the clog connection object")

(defun cur-playlist-ctl (obj)
  (when (connection-data obj)
    (connection-data-item obj +playlist-connection-key+)))

(defun (setf cur-playlist-ctl) (newval obj)
  (setf (connection-data-item obj +playlist-connection-key+) newval))

(defun install-new-playlist-ctl (playlist body)
  (setf (cur-playlist-ctl body)
        (make-instance 'playlist-ctl
                       :playlist playlist
                       :editorp (can-edit-p (session-user body) playlist))))

;;; SYNCHRONIZATION

(defvar *playlist-viewers* (make-hash-table :synchronized t)
  "Holds lists of active viewers of each playlist, keyed by playlist.")

(defun playlist-viewers (ctl)
  (gethash (playlist ctl) *playlist-viewers* nil))

(defun add-playlist-viewer (ctl)
  "Add a new playlist-ctl instance for this connection and, while
   doing so, remove any dead controllers"
  (let ((viewers
          (playlist-viewers ctl)))
    (setf (gethash (playlist ctl) *playlist-viewers*)
          (cons ctl (remove-if-not 'controller-alive-p viewers)))))

(defun controller-alive-p (ctl)
  "A controller is a live if the CLOG elements it manages are
   associated with a live connection."
  (when (pl-title ctl) (connection-data (pl-title ctl))))

(defmacro for-playlist-viewers (clog-elem ctlvar &body body)
  `(dolist (,ctlvar (playlist-viewers (cur-playlist-ctl ,clog-elem)))
     (if (controller-alive-p ctl)
         (progn ,@body))))

;;; PLAYBACK CONTROL

(defun start-playback (ctl)
  (when-let (tr (now-playing-track ctl))
    (add-class (first-child (container tr)) "now-playing-track")
    (play-media (audio tr))
    (setf (text (np-play ctl)) "⏸")))

(defun pause-playback (ctl)
  (when-let (tr (now-playing-track ctl))
    (pause-media (audio tr))
    (setf (text (np-play ctl)) "⏵")))

(defun stop-playback (ctl)
  (when-let (tr (now-playing-track ctl))
    (pause-media (audio tr))
    (remove-class (first-child (container tr)) "now-playing-track")
    (setf (media-position (audio tr)) 0
          (now-playing-track ctl) nil
          (text (np-play ctl)) "⏵")))


;;; CLIENT CONTROL

(defun initialize-now-playing (elem)
  (when-let (ctl (cur-playlist-ctl elem))
    (when (tracks ctl)
      (setf (now-playing-track ctl) (first (tracks ctl)))
      (load-now-playing-display ctl (now-playing-track ctl)))))

(defun load-now-playing-display (ctl track-ctl)
  (let ((tr (track track-ctl)))
    (setf (text (np-title ctl)) (track-listing-line tr nil)
          (url-src (np-thumb ctl)) (or (track-thumb-url tr) "")
          (text (np-dur ctl)) (secs-to-hms (or (track-duration tr) 0))
          (text (np-time ctl)) (secs-to-hms 0))))

(defun toggle-now-playing (e)
  (when-let (ctl (cur-playlist-ctl e))
    (if-let (np (now-playing-track ctl))
      (if (pausedp (audio np))
          (start-playback ctl)
          (pause-playback ctl))
      (advance-now-playing e))))

(defun advance-now-playing (e)
  (when-let ((ctl
              (cur-playlist-ctl e)))

    (if-let (next (find-next-track ctl (now-playing-track ctl)))
      (progn 
        (stop-playback ctl)
        (setf (now-playing-track ctl) next)
        (load-now-playing-display ctl next)
        (start-playback ctl))
      (stop-playback ctl))))

(defun previous-now-playing (e)
  (when-let* ((ctl
               (cur-playlist-ctl e))
              (prev
               (find-previous-track ctl (now-playing-track ctl))))
    (stop-playback ctl)
    (setf (now-playing-track ctl) prev)
    (load-now-playing-display ctl prev)
    (start-playback ctl)))

(defun update-now-playing-time (e)
  (when-let* ((ctl (cur-playlist-ctl e))
              (tr (now-playing-track ctl)))
    (setf (text (np-time ctl))
          (secs-to-hms
           (media-position (audio tr))))))


(defun play-this-audio (audio)
  (when-let (ctl (cur-playlist-ctl audio))
    (let ((np (now-playing-track ctl))
          (tr (track-ctl-with-audio ctl audio)))
      (cond
        ((and np (eq audio (audio np)) (pausedp audio))
         (start-playback ctl))

        (t
         (stop-playback ctl)
         (setf (now-playing-track ctl) tr)
         (start-playback ctl)
         (load-now-playing-display ctl tr))))))

;;; SYNCHRONZIED CLIENT CONTROL

(defun remove-track (track-ctl)
  (when-let* ((container (container track-ctl))
              (curctl (cur-playlist-ctl container))
              (pos (position track-ctl (tracks curctl))))

    (when (delete-track-at (playlist curctl) pos) 
      (for-playlist-viewers container ctl
        (let ((track-ctl (nth pos (tracks ctl))))
          (destroy (container track-ctl)) 
          (setf (tracks ctl) (delete track-ctl (tracks ctl))
                (text (pl-dur ctl)) (secs-to-hms (playlist-duration (playlist ctl)))))))))

(defun move-track-down (track-ctl)
  (when-let* ((curctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks curctl))))
    (when (swap-tracks (playlist curctl) pos (1+ pos))
      (for-playlist-viewers (container track-ctl) ctl
        (let* ((cur
                 (nth pos (tracks ctl)))
               (next
                 (nth (1+ pos) (tracks ctl))))
          ;; swap track-ctls
          (setf (tracks ctl)
                (nswap (tracks ctl) pos (1+ pos)))
          ;; swap list items in the dom
          (place-before (container cur) (container next)))))))

(defun move-track-up (track-ctl)
  (when-let* ((curctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks curctl))))
    (when (swap-tracks (playlist curctl) pos (1- pos))
      (for-playlist-viewers (container track-ctl) ctl
        (let* ((cur
                 (nth pos (tracks ctl)))
               (next
                 (nth (1- pos) (tracks ctl))))
          ;; swap track-ctls
          (setf (tracks ctl)
                (nswap (tracks ctl) pos (1- pos)))
          ;; swap list items in the dom
          (place-after (container cur) (container next)))))))


;;; CLIENT UI

(defun playlist-title-content (playlist)
  (format nil "~a -- ~a"
          (playlist-title playlist)
          (secs-to-hms (playlist-duration playlist))))

(defun create-now-playing-display (parent ctl)
  (with-clog-create parent
      (div (:class "now-playing")
           (section (:h3 :content "Now Playing"))
           (img (:bind thumb))
           (section (:h4)
              (span (:bind title))
              (span (:bind artist)))
           (p ()
              (span (:bind time))
              (span (:content " / "))
              (span (:bind dur)))
           (div (:class "controls")
		(button (:content "⏮" :bind back ))
		(button (:content "⏵" :bind play ))
		(button (:content "⏭" :bind forward ))))
    (setf (np-title ctl) title
          (np-artist ctl) artist
          (np-thumb ctl) thumb
          (np-dur ctl) dur
          (np-time ctl) time
          (np-play ctl) play) 
    (setf (height thumb) "300px")
    (set-on-click back 'previous-now-playing)
    (set-on-click forward 'advance-now-playing)
    (set-on-click play 'toggle-now-playing)))

(defun media-url-path (track)
  (format nil "/media/~a.~a"
          (pathname-name (track-file track))
          (pathname-type (track-file track))))

(defun track-listing-line (track &optional (timep t))
  (with-slots (artist title duration) track
    (if timep
        (format nil "~50<~a~;~a~>~%~a"
                (subseq* title 0 40)
                (secs-to-hms (or duration 0))
                (if artist (concatenate 'string " by "
                                        (subseq* artist 0 40)) ""))
        (format nil "~a~%~a"
                (subseq* title 0 40)
                (if artist (concatenate 'string " by "
                                        (subseq* artist 0 40)) "")))))

(defun create-track-list-item (list track ctl)
  (with-clog-create list
      (list-item (:bind container)
                 
                 (div (:bind item :class "track-list-item")
                      (section (:pre :content (track-listing-line track))))
                 (div (:bind edit-controls)
                      (button (:content "delete " :bind delbtn))
                      (button (:content "↓" :bind downbtn))
                      (button (:content "↑" :bind upbtn)))
                 (audio (:source (media-url-path track) :controls nil :bind audio)))
    (let ((track-ctl
            (make-instance 'track-ctl
                           :container container
                           :audio audio
                           :track track)))
      (setf (tracks ctl)
            (insert-nth track-ctl -1 (tracks ctl) t)) 
      (cond
        ((editorp ctl)
         (setf (attribute downbtn "title") "move track down"
               (attribute upbtn "title") "move track up")
         (set-on-click delbtn (thunk* (remove-track track-ctl)))
         (set-on-click downbtn (thunk* (move-track-down track-ctl)))
         (set-on-click upbtn (thunk* (move-track-up track-ctl))))
        (t
         (setf (display edit-controls) "none"))))

    (set-on-time-update audio 'update-now-playing-time)
    (set-on-ended audio 'advance-now-playing)
    (set-on-click item (thunk* (play-this-audio audio)))))

(defun create-track-listing (parent pl)
  (when-let (ctl (cur-playlist-ctl parent))
    (create-section parent :h3 :content "TRACKS")
    (let ((ol (create-ordered-list parent :class "playlist-tracks")))
      (setf (pl-tracks ctl) ol)
      (dolist (track (playlist-tracks pl))
        (create-track-list-item ol track ctl)))))

(defun append-track-list-item (obj track)
  (for-playlist-viewers obj ctl
    (create-track-list-item (pl-tracks ctl) track ctl)
    (setf (text (pl-dur ctl))
          (secs-to-hms (playlist-duration (playlist ctl))))))

(defun create-new-track-form (parent pl)
  (when (editorp (cur-playlist-ctl parent))
   (with-clog-create parent
       (div ()
            (section (:h3 :content "Add A Track"))
            (label (:content "Paste a URL: " :bind url-label))
            (form-element (:text :bind url-input))
            (button (:content "Fetch Track" :bind button))
            (p (:content "Paste from youtube, bandcamp, vimeo... anything really. Chances are it'll work."))
            (div (:bind notice-area)))
     (label-for url-label url-input)
     (setf (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ"))
     (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ")
     (set-on-click
      button
      (thunk*
        (let* ((url
                 (value url-input))
               (notice
                 (create-p notice-area :content (format nil "... Fetching ~a" url)))
               (on-ok
                 (lambda (track)
                   (destroy notice)
                   (append-track pl track)
                   (append-track-list-item parent track))))
          (setf (value url-input) "")
          (if-let (track (track-with-source url))
            (funcall on-ok track)
            (add-fetch-track-job
             url on-ok              
             (lambda (err)
               (destroy notice)
               (format t "~a" err)
               (alert (window (connection-body parent))
                      (format nil "Error while fetching track at: ~a~%"
                              url)))))))))))

(defun create-editor-managment (parent playlist)
  (when (eq (session-user parent) (playlist-user playlist))
    (with-clog-create parent
        (div ()
             (section (:h3 :content "Collaborators"))
             (unordered-list (:bind editor-list))
             (button (:content "Add Contributor" :bind addbtn))
             (form-element (:text :bind userinput))
             (span (:bind username-status)))
      (setf (place-holder userinput) "who?"
            (width userinput ) 140)
      (flet ((create-editor-item (editor)
               (with-clog-create editor-list
                   (p (:content (user-name editor) :bind editor-elem)
                      (button (:content "remove" :bind delbtn)))
                 (set-on-click
                  delbtn
                  (thunk*
                    (remove-editor playlist editor)
                    (destroy editor-elem)))))) 
        (set-on-blur
         userinput
         (thunk*
           (setf (text username-status)
                 (if (user-with-name (value userinput))
                     "✔" "No user with that name"))))
        (set-on-click
         addbtn
         (thunk*
           (let ((user (user-with-name (value userinput))))
             (cond
               (user 
                (add-editor playlist user)
                (setf (value userinput) ""
                      (text username-status) "")
                (create-editor-item user))
               (t
                (setf (text username-status)
                      "No user with that name"))))))
        (dolist (editor (playlist-editors playlist))
          (create-editor-item editor))))))

(defun url-to-user (user)
  (format nil "/user/~a" (key user)))

(defun playlist-key-from-url (url)
  (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))

(defun playlist-page (body)
  (when-let* ((list-id
               (playlist-key-from-url (url (location body))))
              (pl
               (object-with-key list-id)))
    (let ((ctl
            (install-new-playlist-ctl pl body)))
      (add-playlist-viewer ctl)
      (include-style body)
      (with-clog-create body
          (div ()
               (navigation-header ())
               (div (:class "player")
		    (now-playing-display (ctl))
		    (div (:class "playlist-display")
			 (:span (:bind edit-indicator))
			 (section (:h2)
				  (:span (:bind title-elem :content (playlist-title pl)))
				  (form-element (:text :bind input))
				  (:span (:content " -- "))
				  (:span (:bind dur-elem :content (secs-to-hms (playlist-duration pl)))))
			 (span (:content "by ")
			       (a (:link (url-to-user (playlist-user pl))
				   :content (format nil "~a" (user-name (playlist-user pl))))))
			 (p (:bind collaborators-elem))
			 (track-listing (pl))))

	       (div (:class "row")
                    (div ()
                         (new-track-form (pl))
                         (editor-managment (pl)))))
        (setf (pl-title ctl) title-elem
              (pl-dur ctl) dur-elem
              (display input) "none"
              (display title-elem) "inline")

        (when (playlist-editors pl)
          (setf (inner-html collaborators-elem)
                (with-output-to-string (out)
                  (princ "with help from " out)
                  (loop for (u . more) on (playlist-editors pl)
                        do  (format out "<a href='/user/~a'>~a</a>"
                                    (key u) (user-name u))
                        when more do (princ ", " out)))))
        
        (when (editorp ctl)
          (setf (attribute title-elem "title") "Click to edit the title."
                (text edit-indicator) "(click the title to edit it)")
          (set-on-blur
           input
           (thunk*
             (when (plusp (length (value input)))
               (update-playlist-title pl (value input))
               (setf (text title-elem) (value input)))
             (setf (display input) "none"
                   (display title-elem) "inline")))

          (set-on-click
           title-elem
           (thunk*
             (setf (value input) (text title-elem)
                   (display title-elem) "none"
                   (display input) "inline")
             (focus input))))
        (initialize-now-playing body)))))