From 52c0408569a0b1de932d52e71fee5fb0163782e2 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 27 Oct 2022 07:17:04 -0500 Subject: Add: session file --- .gitignore | 1 + playlist.lisp | 28 +++++++++++++--------------- session.lisp | 29 +++++++++++++++++++++++++++++ user.lisp | 14 -------------- vampire.asd | 1 + vampire.lisp | 2 +- 6 files changed, 45 insertions(+), 30 deletions(-) create mode 100644 .gitignore create mode 100644 session.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/playlist.lisp b/playlist.lisp index 82b796f..0d6e589 100644 --- a/playlist.lisp +++ b/playlist.lisp @@ -46,14 +46,12 @@ (when (plusp pos) (nth (1- pos) (tracks ctl))))) -;;; CLIENT SESSION +;;; SESSION UTIL (defun install-new-playlist-ctl (playlist body) - (setf (connection-data-item body "playlist-ctl") + (setf (cur-playlist-ctl body) (make-instance 'playlist-ctl :playlist playlist))) -(defun get-playlist-ctl (obj) - (connection-data-item obj "playlist-ctl")) ;;; PLAYBACK CONTROL @@ -78,7 +76,7 @@ ;;; CLIENT CONTROL (defun initialize-now-playing (elem) - (when-let (ctl (get-playlist-ctl 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))))) @@ -94,7 +92,7 @@ (text (np-time ctl)) (secs-to-hms 0)))) (defun toggle-now-playing (e) - (when-let (ctl (get-playlist-ctl e)) + (when-let (ctl (cur-playlist-ctl e)) (if-let (np (now-playing-track ctl)) (if (pausedp (audio np)) (start-playback ctl) @@ -103,7 +101,7 @@ (defun advance-now-playing (e) (when-let* ((ctl - (get-playlist-ctl e)) + (cur-playlist-ctl e)) (next (find-next-track ctl (now-playing-track ctl)))) (stop-playback ctl) @@ -113,7 +111,7 @@ (defun previous-now-playing (e) (when-let* ((ctl - (get-playlist-ctl e)) + (cur-playlist-ctl e)) (prev (find-previous-track ctl (now-playing-track ctl)))) (stop-playback ctl) @@ -122,7 +120,7 @@ (start-playback ctl))) (defun update-now-playing-time (e) - (when-let* ((ctl (get-playlist-ctl e)) + (when-let* ((ctl (cur-playlist-ctl e)) (tr (now-playing-track ctl))) (setf (text (np-time ctl)) (secs-to-hms @@ -130,7 +128,7 @@ (defun play-this-audio (audio) - (when-let (ctl (get-playlist-ctl audio)) + (when-let (ctl (cur-playlist-ctl audio)) (let ((np (now-playing-track ctl))) (unless (and np (eq audio (audio np))) (let ((tr @@ -142,14 +140,14 @@ (defun remove-track (track-ctl) - (when-let ((ctl (get-playlist-ctl (container 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 (get-playlist-ctl (container 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 @@ -161,7 +159,7 @@ (place-before (container track-ctl) (container next)))))) (defun move-track-up (track-ctl) - (when-let* ((ctl (get-playlist-ctl (container 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 @@ -249,14 +247,14 @@ (set-on-click item (alambda (play-this-audio audio))))) (defun create-track-listing (parent pl) - (when-let (ctl (get-playlist-ctl parent)) + (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 (get-playlist-ctl obj)) + (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)))))) diff --git a/session.lisp b/session.lisp new file mode 100644 index 0000000..770bc8d --- /dev/null +++ b/session.lisp @@ -0,0 +1,29 @@ +;;;; session.lisp + +(in-package :vampire) + +;;; session parameter keys + +(defparameter +session-key+ "vampire-session-key" + "Stored in the browser's local storage") + +(defparameter +playlist-connection-key+ "playlist-connection-key" + "Stored in the clog connection object") + +;;; SESSION ACCESSORS + +(defun session-key (window) + (jonathan:parse (storage-element window :local +session-key+))) + +(defun (setf session-key) (val window) + (setf (storage-element window :local +session-key+) (jonathan:to-json val))) + +(defun session-user (clog-obj) + (user-with-key (session-key (window (connection-body clog-obj))))) + +(defun cur-playlist-ctl (obj) + (connection-data-item obj +playlist-connection-key+)) + +(defun (setf cur-playlist-ctl) (newval obj) + (setf (connection-data-item obj +playlist-connection-key+) newval)) + diff --git a/user.lisp b/user.lisp index 4f1db96..65163b2 100644 --- a/user.lisp +++ b/user.lisp @@ -7,24 +7,10 @@ (defclass/std user-ctl () ()) -;;; CLIENT SESSION - -(defparameter +user-key+ "vampire.userkey") - -(defun user-key (window) - (jonathan:parse (storage-element window :local +user-key+))) - -(defun (setf user-key) (val window) - (setf (storage-element window :local +user-key+) (jonathan:to-json val))) - -(defun session-user (clog-obj) - (user-with-key (user-key (window (connection-body clog-obj))))) - ;;; CLIENT CONTROL ;;; CLIENT UI - (defun create-new-playlist-form (parent &rest args) (declare (ignorable args)) (with-clog-create parent diff --git a/vampire.asd b/vampire.asd index 5c7b936..932c7d0 100644 --- a/vampire.asd +++ b/vampire.asd @@ -18,6 +18,7 @@ (:file "utilities") (:file "downloader") (:file "model") + (:file "session") (:file "user") (:file "playlist") (:file "vampire"))) diff --git a/vampire.lisp b/vampire.lisp index 85eed95..e089b0d 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -81,7 +81,7 @@ (lambda (obj) (declare (ignore obj)) (let ((u (new-user :name (value name)))) - (setf (user-key (window body)) (key u)) + (setf (session-key (window body)) (key u)) (setf (url (location body)) "/")))))) (defun main (body) -- cgit v1.2.3