From f0eff7d9c69de2e6c7257b8d94e7deb7b89becdf Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 27 Oct 2022 06:57:19 -0500 Subject: Add+Move: user and model files, moved code into files --- user.lisp | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 user.lisp (limited to 'user.lisp') diff --git a/user.lisp b/user.lisp new file mode 100644 index 0000000..4f1db96 --- /dev/null +++ b/user.lisp @@ -0,0 +1,72 @@ +;;;; user.lisp + +(in-package :vampire) + +;;; CLIENT STATE + +(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 + (div () + (section (:h2 :content "Create New Playlist")) + (label (:content "Playlist Title:")) + (form-element (:text :bind pl-title)) + (button (:content "Create" :bind btn))) + (set-on-click + btn + (alambda + (new-playlist (session-user parent) :title (value pl-title)) + (reload (location (connection-body parent))))))) + +(defun url-to-playlist (pl location) + (format nil "~a//~a/playlist/~a" + (protocol location) + (host location) + (key pl))) + +(defun create-playlist-listing (parent &rest args) + (declare (ignorable args)) + (dolist (pl (user-playlists (session-user parent))) + (let ((url + (url-to-playlist pl (location (connection-body parent))))) + (with-clog-create parent + (div () + (section (:h4) + (a (:link url :content (playlist-title pl) :bind pl-link)))) + (set-on-click + pl-link + (alambda + (setf (url (location (connection-body parent))) + url))))))) + +(defun user-home-page (body) + (if-let (user (session-user body)) + (with-clog-create body + (div () + (p (:content (format nil "Welcome ~a" (user-name user)))) + (new-playlist-form ()) + (playlist-listing ()))) + (setf (url (location body)) "/"))) + + -- cgit v1.2.3