aboutsummaryrefslogtreecommitdiffhomepage
path: root/playlist.lisp
blob: 0d6e5892128c1e5854ba515113eeda8db8f424fd (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
;;;; playlist.lisp

(in-package :vampire)

;;; CLIENT STATE 

(defclass/std playlist-ctl ()
  ((playlist :std nil :doc "The playlist instance.")
   
   (tracks :std nil :doc "A list of instances of track/client")
   (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 

(defun install-new-playlist-ctl (playlist body)
  (setf (cur-playlist-ctl body)
        (make-instance 'playlist-ctl :playlist playlist)))


;;; PLAYBACK CONTROL

(defun start-playback (ctl)
  (when-let (tr (now-playing-track ctl))
    (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))
    (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-title tr)
          (text (np-artist ctl)) (if (track-artist tr)
                                     (format nil "~a |" (track-artist tr))
                                     "")
          (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))
              (next
               (find-next-track ctl (now-playing-track ctl))))
    (stop-playback ctl)
    (setf (now-playing-track ctl) next)
    (load-now-playing-display ctl next)
    (start-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)))
      (unless (and np (eq audio (audio np)))
        (let ((tr
                (track-ctl-with-audio ctl audio)))
          (stop-playback ctl)
          (setf (now-playing-track ctl) tr)
          (start-playback ctl)
          (load-now-playing-display ctl tr))))))


(defun remove-track (track-ctl)
  (when-let ((ctl (cur-playlist-ctl (container track-ctl))))
    (when (delete-track-at (playlist ctl) (position track-ctl (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* ((ctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks ctl))))
    (when (swap-tracks (playlist ctl) pos (1+ pos))
      (let* ((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 track-ctl) (container next))))))

(defun move-track-up (track-ctl)
  (when-let* ((ctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks ctl))))
    (when (swap-tracks (playlist ctl) pos (1- pos))
      (let* ((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 track-ctl) (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-display")
           (section (:h3 :content "Now Playing"))
           (img (:bind thumb))
           (section (:h4)
              (span (:content " | "))
              (span (:bind title))
              (span (:content " | "))              
              (span (:bind artist)))
           (p ()
              (span (:bind time))
              (span (:content " / "))
              (span (:bind dur)))
           (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) "100px")
    (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)
  (with-slots (artist title) track
    (with-output-to-string (out)
      (when artist
        (princ artist out)
        (princ " - " out))
      (princ title out))))

(defun create-track-list-item (list track ctl)
  (with-clog-create list
      (list-item (:bind container)
                 (div ()
                      (button (:content "delete " :hidden t :bind delbtn))
                      (button (:content "↓" :bind downbtn))
                      (button (:content "↑" :bind upbtn)))
                 (div (:bind item)
                      (span (:content (track-listing-line track)))
                      (span (:content " -- "))
                      (span (:content (secs-to-hms (or (track-duration track) 0)))))
                 
                 (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)) 
      (setf (visiblep delbtn) t)
      (set-on-click delbtn (alambda (remove-track track-ctl)))
      (set-on-click downbtn (alambda (move-track-down track-ctl)))
      (set-on-click upbtn (alambda (move-track-up track-ctl))))
    (set-on-time-update audio 'update-now-playing-time)
    (set-on-ended audio 'advance-now-playing)
    (set-on-click item (alambda (play-this-audio audio)))))

(defun create-track-listing (parent pl)
  (when-let (ctl (cur-playlist-ctl parent))
    (let ((ol (create-ordered-list parent)))
      (setf (pl-tracks ctl) ol)
      (dolist (track (playlist-tracks pl))
        (create-track-list-item ol track ctl)))))

(defun append-track-list-item (obj track)
  (when-let (ctl (cur-playlist-ctl obj))
    (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)
  (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))
           (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
     (alambda
         (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 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)))
      (with-clog-create body
          (div ()
               (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)))))
               
               (now-playing-display (ctl))
               (track-listing (pl))
               (new-track-form (pl)))
        (setf (pl-title ctl) title-elem
              (pl-dur ctl) dur-elem
              (display input) "none"
              (display title-elem) "inline")

        (set-on-blur
         input
         (alambda
             (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
         (alambda
             (setf (value input) (text title-elem)
                   (display title-elem) "none"
                   (display input) "inline")
           (focus input)))

        (initialize-now-playing body)))))