aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2024-05-18 07:50:16 -0700
committercolin <colin@cicadas.surf>2024-05-18 07:50:16 -0700
commit23873b455554ba40f79be561b5150b4526a19d3f (patch)
treebbb29e580e99f45c62fae376db5e75615015a830
parent9ab26f07d209a387252a87dc10e986995bbc154a (diff)
Remove: Purged CLOG
-rw-r--r--about.lisp23
-rw-r--r--explore.lisp46
-rw-r--r--home.lisp166
-rw-r--r--login.lisp32
-rw-r--r--navigation.lisp11
-rw-r--r--new-account.lisp75
-rw-r--r--package.lisp8
-rw-r--r--playlist.lisp544
-rw-r--r--session.lisp14
-rw-r--r--style.lisp8
-rw-r--r--vampire.asd23
-rw-r--r--vampire.lisp21
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)))))