diff options
| -rw-r--r-- | about.lisp | 23 | ||||
| -rw-r--r-- | explore.lisp | 46 | ||||
| -rw-r--r-- | home.lisp | 166 | ||||
| -rw-r--r-- | login.lisp | 32 | ||||
| -rw-r--r-- | navigation.lisp | 11 | ||||
| -rw-r--r-- | new-account.lisp | 75 | ||||
| -rw-r--r-- | package.lisp | 8 | ||||
| -rw-r--r-- | playlist.lisp | 544 | ||||
| -rw-r--r-- | session.lisp | 14 | ||||
| -rw-r--r-- | style.lisp | 8 | ||||
| -rw-r--r-- | vampire.asd | 23 | ||||
| -rw-r--r-- | vampire.lisp | 21 |
12 files changed, 21 insertions, 950 deletions
diff --git a/about.lisp b/about.lisp deleted file mode 100644 index 1eb42aa..0000000 --- a/about.lisp +++ /dev/null @@ -1,23 +0,0 @@ -;;;; about.lisp -- an about page. - -(in-package :vampire) - -(defun about-page (body) - (include-style body) - (with-clog-create body - (div () - (navigation-header ()) - (div (:class "centered-column") - (div ()) - (div () - (p ( :content "Vampire is a small private app shared - between friends. Its purpose is to create and share audio playlists, - and to collaborate on playlists with your friends in real time.")) - (p ( :content "The app is called vampire because it sucks - content from other sources, backed by the popular - youtube-dl tool.")) - - (p ( :content "Vampire is written in Common Lisp using the - CLOG system.")) - (p ( :content "I hope you enjoy using Vampire."))) - (div ()))))) diff --git a/explore.lisp b/explore.lisp deleted file mode 100644 index 5c99fb8..0000000 --- a/explore.lisp +++ /dev/null @@ -1,46 +0,0 @@ -;;; explore.lisp - -(in-package :vampire) - -(defun create-media-search-area (parent) - (with-clog-create parent - (p (:content "media search area")))) - -(defun create-playlist-explore-card (parent pl) - (with-clog-create parent - (div (:bind card :class "card") - (a (:link (url-to-playlist pl) ) - (img (:bind thumb :class "thumb")) - (br ()) - (span (:content (playlist-title pl))) - (span (:content " -- ")) - (span (:content (secs-to-hms (playlist-duration pl)))))) - (when-let (track (first (playlist-tracks pl))) - (setf (url-src thumb) (or (track-thumb-url track) ""))))) - -(defun create-recent-playlists-area (parent) - (let* ((container (create-div parent :class "row"))) - (dolist (pl (recent-playlists 100)) - (create-playlist-explore-card container pl)))) - -(defun create-user-list (parent) - (with-clog-create parent - (unordered-list (:bind user-container)) - (dolist (user (store-objects-with-class 'user)) - (with-clog-create user-container - (list-item () - (a (:link (url-to-user user) - :content (format nil " ~a " (user-name user))))))))) - -(defun explore-page (body) - (include-style body) - (with-clog-create body - (div () - (navigation-header ()) - (div (:class "row") - (div (:bind playlist-area) - (section (:h2 :content "Recent Playlists" :class "center")) - (recent-playlists-area ())) - (div () - (section (:h3 :content "Who uses this?" :class "center")) - (user-list ())))))) diff --git a/home.lisp b/home.lisp deleted file mode 100644 index cac1c3b..0000000 --- a/home.lisp +++ /dev/null @@ -1,166 +0,0 @@ -;;;; user.lisp - -(in-package :vampire) - -;;; CLIENT UI - -(defun create-new-playlist-form (parent) - (with-clog-create parent - (form () - (section (:h3 :content "Create New Playlist")) - (label (:content "Playlist Title:")) - (form-element (:text :bind pl-title)) - (button (:content "Create" :bind btn))) - (set-on-click - btn - (thunk* - (new-playlist (session-user parent) :title (value pl-title)) - (reload (location (connection-body parent))))))) - -(defun url-to-playlist (pl) - (format nil "/playlist/~a" - (key pl))) - -(defun create-playlist-listing (parent &optional user) - (dolist (pl (user-playlists (or user (session-user parent)))) - (with-clog-create parent - (div (:bind pl-item) - (div () - (playlist-explore-card (pl)) - (button (:content "delete" :bind btn)))) - (cond - ((eq user (session-user parent)) - (set-on-click - btn - (thunk* - (destroy-playlist pl) - (destroy pl-item)))) - (t - (destroy btn)))))) - -(defun create-invite-list-item (invite-list invite) - (with-clog-create invite-list - (list-item (:bind item) - (button (:bind delbtn :content "delete")) - (p () - (span (:content "Code: ")) - (span (:content (key invite)))) - (p () - (span (:content "Uses Remaining: ")) - (span (:content - (format nil "~a" - (or (uses-remaining invite) "unlimited")))))) - (set-on-click delbtn (thunk* - (destroy-invite invite) - (destroy item))))) - -(defun create-invite-control (parent) - (let* ((user (session-user parent)) - (container (create-div parent)) - (invite-list (create-unordered-list parent))) - (place-after (create-section container :h3 :content "Your Invites") - invite-list) - ;; list invites - (dolist (invite (invites-by-maker user)) - (create-invite-list-item invite-list invite)) - - (with-clog-create container - (form () - (button (:bind createbtn :content "Create Invite")) - (form-element (:number :bind count)) - (p (:bind invite-explainer - :content "Share invite codes with friends to invite - them to this server. Optinally say how many times an - invite code can be used by setting the Uses count before - clicking the Create Invite button."))) - (setf - (maximum-width invite-explainer) "500px" - (minimum count) 0 - (place-holder count) "Uses" - (width count) 70) - (set-on-click - createbtn - (thunk* - (let ((invite (make-invite user (parse-integer (value count) :junk-allowed t)))) - (create-invite-list-item invite-list invite))))))) - -(defun create-password-reset (parent) - (with-clog-create parent - (div () - (button (:content "Password Reset" :bind pw-reset-toggle)) - (form (:hidden t :bind pw-reset-form) - (form-element (:password :bind pw-input)) - (br ()) - (form-element (:password :bind pw-repeated)) - (br ()) - (button (:content "Change password" :bind pw-update))) - (p (:bind notice-area))) - - (setf (place-holder pw-input) "New Password" - (place-holder pw-repeated) "Repeat New Password" - (disabledp pw-update) t) - - (set-on-key-down - pw-repeated - (thunk* (when (equal (value pw-input) (value pw-repeated)) - (setf (disabledp pw-update) nil)))) - - (flet ((toggle-form () - (cond ((visiblep pw-reset-form) - (setf (visiblep pw-reset-form) nil - (text pw-reset-toggle) "Password Reset" - (text notice-area) "" - (disabledp pw-update) t - (value pw-input) "" - (value pw-repeated) "")) - (t - (setf (visiblep pw-reset-form) t - (text notice-area) "" - (text pw-reset-toggle) "Nevermind"))))) - - (set-on-click pw-update - (thunk* - ;; assumes pw-input and pw-repeat are equal - (set-new-password (session-user parent) (value pw-input)) - (toggle-form) - (setf (text notice-area) - "Password updated!"))) - - (set-on-click pw-reset-toggle - (thunk* (toggle-form)))))) - - -(defun user-home-page (body) - (include-style body) - (with-clog-create body - (div () - (navigation-header ()) - (div (:class "row") - (div () - (section (:pre :content (format nil "Welcome ~a" (user-name (session-user body))))) - (section (:h3 :content "Your Playlists")) - (div (:class "row") (playlist-listing ())) - (new-playlist-form ()) - (invite-control ()) - (password-reset ())))))) - -(defun user-key-from-url (url) - (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url))))))) - -(defun user-listing-page (body) - (when-let* ((user-id - (user-key-from-url (url (location body)))) - (user - (object-with-key user-id))) - (include-style body) - (with-clog-create body - (div () - (navigation-header ()) - (div (:class "row") - (div () - (section (:h3 :content (format nil "Playlists by ~a" - (user-name user)))) - (div (:class "row") - (playlist-listing (user))))))))) - - diff --git a/login.lisp b/login.lisp deleted file mode 100644 index 0cf08b5..0000000 --- a/login.lisp +++ /dev/null @@ -1,32 +0,0 @@ -;;;; login.lisp - -(in-package :vampire) - -(defun login-page (body) - (include-style body) - (with-clog-create body - (div (:class "login") - (div () - (section (:h3 :content "LOGIN")) - (form () - (form-element (:text :bind name-input)) - (br ()) - (form-element (:password :bind pw-input)) - (br ()) - (button (:bind btn :content "Click here to log in")))) - (div () - (:p () - (:a (:link "/new-account" :content "Create an account"))))) - (setf (place-holder name-input) "Name" - (place-holder pw-input) "Password") - (set-on-click - btn - (thunk* - (let ((user - (login-user (value name-input) (value pw-input)))) - (if user - (let ((session (make-session user))) - (setf (session-key (window body)) (key session) - (url (location body)) "/home")) - (alert (window body) "Error logging in."))))))) - diff --git a/navigation.lisp b/navigation.lisp deleted file mode 100644 index 2e6b650..0000000 --- a/navigation.lisp +++ /dev/null @@ -1,11 +0,0 @@ -;;;; navigation - -(in-package :vampire) - -(defun create-navigation-header (parent) - (with-clog-create parent - (section (:header :class "row header") - (div () (a (:link "/home") - (img ( :url-src "/favicon.ico")))) - (div () (a (:link "/explore" :content "Explore"))) - (div () (a (:link "/about" :content "About")))))) diff --git a/new-account.lisp b/new-account.lisp deleted file mode 100644 index 653818a..0000000 --- a/new-account.lisp +++ /dev/null @@ -1,75 +0,0 @@ -;;;; new-account.lisp - -(in-package :vampire) - -(defparameter +username-regex+ - (ppcre:create-scanner "^[a-zA-Z0-9\_\\-!@#$^&*]{3,25}$")) - - - -(defun new-accout-page (body) - (include-style body) - (with-clog-create body - (div (:class "row") - (div () (section (:h2 :content "Create a new account")) - (form (:bind new-user-form) - (form-element (:text :bind invite)) - (span (:bind invite-status)) - (br ()) - (form-element (:text :bind name)) - (span (:bind name-status)) - (br ()) - (form-element (:password :bind pw)) - (br ()) - (form-element (:password :bind pw-confirm)) - (span (:bind pw-confirm-status)) - (br ()) - (button (:content "Make Account" :bind submit)))) - (div (:bind name-help :hidden t) - (p (:content "3-25 characters, no spaces, numbers, letters, or !@#$^&*()_-")))) - - (setf (place-holder invite) "Invite Code" - (place-holder name) "Name" - (place-holder pw) "Password" - (place-holder pw-confirm) "Repeat Password") - - (set-on-blur - invite - (thunk* - (setf (inner-html invite-status) - (if (invite-by-code (value invite)) - "✔" - "Bad Invite Code")))) - (set-on-blur - name - (thunk* - (let ((name (value name))) - (setf (text name-status) - (cond - ((not (ppcre:all-matches +username-regex+ name)) - (setf (visiblep name-help) t) - "Invalid Name.") - ((user-with-name name) - (setf (visiblep name-help) nil) - "Name Already Taken") - (t - (setf (visiblep name-help) nil) - "✔")))))) - - (set-on-key-press - pw-confirm - (thunk* - (setf (text pw-confirm-status) - (if (string-equal (value pw) (value pw-confirm)) - "✔" - "Passwords Do Not Match")))) - - (set-on-click - submit - (thunk* - (if (loop for status in (list pw-confirm-status name-status invite-status) - always (string-equal "✔" (text status))) - (if (use-invite-with-code (value invite) (value name) (value pw)) - (setf (url (location body)) "/login") - (alert (window body) "An error occurred while making your account.")) - (alert (window body) "Plase double check your inputs.")))))) diff --git a/package.lisp b/package.lisp index c24492c..0335b3d 100644 --- a/package.lisp +++ b/package.lisp @@ -1,8 +1,12 @@ ;;;; package.lisp (defpackage #:vampire - (:use #:cl #:clog) - (:local-nicknames (#:zippy #:org.shirakumo.zippy )) + (:use #:cl) + (:local-nicknames + (#:db #:bknr.datastore) + (#:wknd #:weekend) + (#:a #:alexandria-2) + (#:zippy #:org.shirakumo.zippy )) (:import-from #:bknr.datastore #:with-transaction #:store-object diff --git a/playlist.lisp b/playlist.lisp deleted file mode 100644 index d5c3690..0000000 --- a/playlist.lisp +++ /dev/null @@ -1,544 +0,0 @@ -;;;; 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 pl-zip pl-download - :std nil :doc "Playlist Elements")) - (:documentation "Holds the complete state for this session's viewing of a particular playlist.")) - -(defclass/std track-ctl () - ((track listing-line audio container info-edit-ctl edit-save-btn editing? - artist-input album-input title-input :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) - (delete-zipped-playlist curctl) - (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)) - (delete-zipped-playlist curctl) - (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)) - (delete-zipped-playlist curctl) - (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))))))) - -(defun open-track-editor (track-ctl) - (setf (display (info-edit-ctl track-ctl)) "inline" - (text (edit-save-btn track-ctl)) "save " - (editing? track-ctl) t) - (with-slots (artist-input album-input title-input) track-ctl - (with-slots (artist album title) (track track-ctl) - (setf (place-holder artist-input) (or artist "Artist") - (place-holder album-input) (or album "Album") - (place-holder title-input) (or title "Title")) - (set-on-click - (edit-save-btn track-ctl) - (thunk* (update-track-info - (track track-ctl) (value artist-input) (value album-input) (value title-input)) - (close-track-editor track-ctl)) - :one-time t)))) - -(defun close-track-editor (track-ctl) - (setf (display (info-edit-ctl track-ctl)) "none" - (text (listing-line track-ctl)) (track-listing-line (track track-ctl)) - (text (edit-save-btn track-ctl)) "edit " - (editing? track-ctl) nil) - (set-on-click - (edit-save-btn track-ctl) - (thunk* (open-track-editor track-ctl)) - :one-time t)) - -(defun add-zipped-playlist-link (pl-ctl playlist) - "Adds the link to a zipped playlist to the DOM." - (for-playlist-viewers (pl-download pl-ctl) ctl - (setf (pl-zip ctl) (make-zipped-playlist-link playlist (pl-download ctl))) - (place-inside-bottom-of (pl-download ctl) (pl-zip ctl)))) - -;;; 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 :bind listing-line))) - (div (:bind info-edit-ctl :class "track-list-edit") - (div (:class "track-edit-inputs column") - ;; (label (:content "Artist" :bind artist-label)) - (form-element (:text :bind artist-input :value (track-artist track))) - ;; (label (:content "Album" :bind album-label)) - (form-element (:text :bind album-input :value (track-album track))) - ;; (label (:content "Title" :bind title-label)) - (form-element (:text :bind title-input :value (track-title track))))) - (div (:bind edit-controls) - (button (:content "edit " :bind edit-save-btn)) - (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 - :listing-line listing-line - :audio audio - :track track - :info-edit-ctl info-edit-ctl - :edit-save-btn edit-save-btn - :artist-input artist-input - :album-input album-input - :title-input title-input - :editing? nil))) - (setf (tracks ctl) - (insert-nth track-ctl -1 (tracks ctl) t) - (text listing-line) (track-listing-line track) - (display info-edit-ctl) "none") - (cond - ((editorp ctl) - (setf (attribute downbtn "title") "move track down" - (attribute upbtn "title") "move track up") - (set-on-click edit-save-btn (thunk* (open-track-editor track-ctl)) :one-time t) - (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) - (delete-zipped-playlist (cur-playlist-ctl parent)) - (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 (:class "container") - (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 (:class "column" :bind dl-elem) - (button (:content "Create Zipped Playlist" :bind zip-download-button))) - (div () - (new-track-form (pl)) - (editor-managment (pl))))) - - (setf (pl-title ctl) title-elem - (pl-dur ctl) dur-elem - (pl-download ctl) dl-elem - (display input) "none" - (display title-elem) "inline") - - (when (zipped-playlist-exists-p pl) - (setf (pl-zip ctl) (make-zipped-playlist-link pl body)) - (place-after zip-download-button (pl-zip ctl))) - - (set-on-click zip-download-button - (thunk* - (zip-playlist pl) - (add-zipped-playlist-link ctl pl))) - - (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))) - (delete-zipped-playlist ctl) ;; must happen first - (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))))) diff --git a/session.lisp b/session.lisp index d7bd937..6d704f7 100644 --- a/session.lisp +++ b/session.lisp @@ -17,17 +17,3 @@ "Stored in the browser's local storage") -;;; 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) - (when-let (obj (object-with-key (session-key (window (connection-body clog-obj))))) - (when (typep obj 'session) - (user obj)))) - - diff --git a/style.lisp b/style.lisp deleted file mode 100644 index 6ee60a7..0000000 --- a/style.lisp +++ /dev/null @@ -1,8 +0,0 @@ -;;;; css.lisp - -(in-package :vampire) - -(defparameter *css-version* "4") - -(defun include-style (body) - (load-css (html-document body) (format nil "/css/main-~a.css" *css-version*) :load-only-once nil)) diff --git a/vampire.asd b/vampire.asd index 9014aa8..10c0453 100644 --- a/vampire.asd +++ b/vampire.asd @@ -6,9 +6,8 @@ :license "AGPL-3.0" :version "0.1.0" :serial t - :depends-on (#:clog + :depends-on (#:weekend #:hunchentoot - #:clack-handler-hunchentoot #:bknr.datastore #:legion #:defclass-std @@ -17,21 +16,21 @@ #:jonathan #:swank #:zippy) - :components ((:file "hunchentoot-handle-static-file") + :components (;(:file "hunchentoot-handle-static-file") (:file "package") (:file "definition-macros") (:file "utilities") (:file "downloader") (:file "model") (:file "session") - (:file "style") - (:file "navigation") - (:file "about") - (:file "new-account") - (:file "explore") - (:file "login") - (:file "home") - (:file "playlist") + ;(:file "navigation") + ;(:file "about") + ;(:file "new-account") + ;(:file "explore") + ;(:file "login") + ;(:file "home") + ;(:file "playlist") (:file "vampire") (:file "run") - (:file "zipper"))) + (:file "zipper") + )) diff --git a/vampire.lisp b/vampire.lisp index a45b853..247ff4d 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -47,28 +47,15 @@ (setf *config* config) (initialize-database config ) (start-downloader-service config) - (clog:initialize 'main - :port (port config) - :host (host config) - :extended-routing t - :static-root (static-directory config)) - (set-on-new-window (when-logged-in? 'about-page) :path "/about") - (set-on-new-window (when-logged-in? 'user-home-page) :path "/home") - (set-on-new-window (when-logged-in? 'user-listing-page) :path "/user") - (set-on-new-window 'login-page :path "/login") - (set-on-new-window (when-logged-in? 'playlist-page) :path "/playlist") - (set-on-new-window 'new-accout-page :path "/new-account") - (set-on-new-window (when-logged-in? 'explore-page) :path "/explore") (when (swank-port config) (swank:create-server :port (swank-port config) :dont-close t))) (defun hacking-start () - (start-vampire (make-instance - 'config - :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname)) - :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))) - (clog:open-browser)) + (start-vampire + (make-instance 'config + :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname)) + :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname))))) |