(defpackage #:vampire.site (:import-from #:lazybones #:defendpoint*) (:import-from #:spinneret #:with-html #:with-html-string #:deftag) (:local-nicknames (#:lzb #:lazybones) (#:client #:lazybones/client.parenscript) (#:json #:jonathan) (#:a #:alexandria-2) (#:util #:vampire.utilities) (#:control #:vampire.control) (#:model #:vampire.model) (#:api #:vampire.api)) (:use #:cl)) (in-package #:vampire.site) ;;; APP (lzb:provision-app () :content-type "text/html") ;;; SPECIALS ;;; MACROS (defmacro defpage (path (&key (title "") params (auth t auth-supplied-p) notauth setup) &body body) "PATH is a LAYZBONES ENDPOINT path, and can contain variables. TITLE is a form that is evalued in the context of the current request, including any bindings from the PATH or QUERY params. PARAMS are optional query parameters, parsed like they would be for an lazybones endpoint definition. AUTH is an arbitrary expression evaluated in the context of current request. If it returns null, then a 403 is returned. Otherwise the body is returned. SETUP is a form, evaluted after AUTH, but before the body expands. It can do anything; e.g. setting headers. BODY is SPINNERET code defining the body (but not the header) of a page." `(defendpoint* :get ,path ,params () ,(when auth-supplied-p `(unless ,auth ,(if notauth notauth `(lzb:http-err 403)))) ,setup (with-html-string (:doctype) (:head (:title ,title) (:meta :charset "UTF-8") (:meta :name "viewport" :content "width=device-width, initial-scale=1.0") (:link :rel "stylesheet" :href "/css/theme.css")) (:body ,@body)))) (defmacro defpage/session (path (&key (title "") params setup) &body body) `(defpage ,path (:title ,title :params ,params :setup ,setup :auth (browser-session) :notauth (lzb:http-redirect "/login")) (header) ,@body)) (defmacro two-columns (col1 col2) "A Two-Column Layout Macro" `(with-html (:div :class "container two-cols" (:div ,col1) (:div ,col2)))) ;;; HELPERS (defun playlist-title-string (pl) (concatenate 'string "~ " (model:title pl))) ;;; REQUEST AUTH AND HELPERS (defun can-view-playlist-p (pl) t) ;;; PAGE ELEMENTS (deftag form (inputs attrs &key (button "submit")) `(progn (:form ,@attrs (progn ,@inputs) (:button :type "submit" ,button)))) (deftag col (content attrs &key class) (let ((class (if class (concatenate 'string "col " class) "col"))) `(progn (:div :class ,class ,@attrs (progn ,@content))))) (deftag row (content attrs &key class) (let ((class (if class (concatenate 'string "row " class) "row"))) `(progn (:div :class ,class ,@attrs (progn ,@content))))) (defun input (name placeholder &optional (type "text")) (with-html (:input :name name :placeholder placeholder :type type))) (defun active-a (path text &key (class "")) "generates an A element that has the `active` class when PATH is the path we're visiting" (with-html (let ((classes (if (string-equal path (lzb:request-path)) (str:join " " (list "active" class)) class))) (if (plusp (length classes)) (:a :class classes :href path text) (:a :href path text))))) ;;; LOGIN PAGE ;;; HOME PAGE ;;; USER PAGE ;;; EXPLORE PAGE ;;; PLAYLIST PAGE (defun ps-prev-track () (ps:ps (ps:chain -vampire-control (play-previous-track)))) (defun ps-next-track () (ps:ps (ps:chain -vampire-control (play-next-track)))) (defun ps-play/pause () (ps:ps (ps:chain -vampire-control (toggle-playback)))) (defun ps-play-track (track-key) (ps:ps (ps:chain -vampire-control (play-track (ps:lisp track-key))))) (defun previous-track-button () (with-html (:button :class "audio-control-button" :id "previous-track" :onclick (:raw (ps-prev-track)) "⏮"))) (defun next-track-button () (with-html (:button :class "audio-control-button" :id "next-track" :onclick (:raw (ps-next-track)) "⏭"))) (defun play/pause-button () (with-html (:button :class "audio-control-button" :id "play-pause" :onclick (:raw (ps-play/pause)) "⏯"))) (defun now-playing-view (pl) (with-html (:div :class "now-playing" (:img :id "now-playing-img" :src (or (model::cover-image pl) "")) (:div :class "playback-controls" (previous-track-button) (play/pause-button) (next-track-button))))) (defun playlist-track-item (track) "Generates a view of TRACK as it should appear in a list of tracks." (with-html (:li :class "track-list-item" :onclick (:raw (ps-play-track track)) (:div (:span :class "track-title" (model:title track)) (:span :class "track-duration" (write-to-string (model::duration track)))) (when (and (stringp (model:artist track)) (plusp (length (model:artist track)))) (:div (:span :class "track-artist" (model:artist track))))))) (defun playlist-tracks-view (playlist) (with-html (:ol :class "track-list" :id "track-list" (dolist (track (model:tracks playlist)) (playlist-track-item track))))) (defun playlist-title-view (playlist) (with-html (:h3 :class "playlist-title" (model:title playlist) " -- " (:span "playlist-duration" (util:secs-to-hms (model::playlist-duration playlist)))))) (defun playlist-control-app (playlist) (with-html (:script))) (defparameter +vampire-session-cookie+ "SESSIONKEY") (defun browser-session () (a:when-let* ((token (lzb:request-cookie +vampire-session-cookie+)) (session (model:lookup token))) (when (typep session 'model:session) session))) (defun session-user () (a:when-let (session (browser-session)) (model:user session))) (defun header () (with-html (:header (:hgroup (:div :class "navbar2" (:div :class "right vsep-container" (:a :class "vsep-item" :href "/about" "about") (:a :class "vsep-item" :href "/logout" "logout")) (:h1 "⹋ V̷ † ̷A̷ ⸸ ̷M̷ † ̷P̷ ⸸ ̷I̷ † ̷R̷ ⸸ ̷E̷ ⹋"))) (:hgroup (:nav (:div :class "navbar" (active-a "/you" "YOU") (active-a "/us" "US") (active-a "/tracks" "TRACKS"))))))) (defendpoint* :get "/" () () (if (browser-session) (lzb:http-redirect "/you") (lzb:http-redirect "/login"))) (defun gibberish () (with-html (:p "At the Reagan National Defense Forum in Simi Valley, California, on Saturday, US Commerce Secretary Gina Raimondo issued a cautionary statement to Nvidia, urging them to stop redesigning AI chips for China that maneuver around export restrictions. \"We cannot let China get these chips. Period,\" she said. \"We're going to deny them our most cutting-edge technology.\" Fortune reports: Raimondo said American companies will need to adapt to US national security priorities, including export controls that her department has placed on semiconductor exports. \"I know there are CEOs of chip companies in this audience who were a little cranky with me when I did that because you're losing revenue,\" she said. \"Such is life. Protecting our national security matters more than short-term revenue.\" Raimondo called out Nvidia Corp., which designed chips specifically for the Chinese market after the US imposed its initial round of curbs in October 2022. \"If you redesign a chip around a particular cut line that enables them to do AI, I'm going to control it the very next day,\" Raimondo said. Communication with China can help stabilize ties between the two countries, but \"on matters of national security, we've got to be eyes wide open about the threat,\" she said. \"This is the biggest threat we've ever had and we need to meet the moment,\" she said. Further reading: Nvidia CEO Says US Will Take Years To Achieve Chip Independence"))) (defun playlist-page-url (pl) (format nil "/playlist/~a/~a" (model:key pl) (url-rewrite:url-encode (model:title pl)))) #+off (defun playlist-card (pl) (with-html (:div :class "card" (:img :src (model::cover-image pl)) (:a :href (playlist-page-url pl) (model:title pl))))) (defun playlist-card (pl) (with-html (:a :href (playlist-page-url pl) :class "card" (:img :src (model::cover-image pl)) (:span (model:title pl))))) (defun user-playlists (lists) (with-html (:h2 "Your Playlists") (:div :class "playlists" (dolist (pl lists) (playlist-card pl))))) (defun make-playlist-form () (with-html (:h2 "Create a Playlist") (form :class "center" :button "Create" :method "POST" :action "/playlist" (input "title" "Playlist Title")))) (defendpoint* :post "/playlist" () (:auth #'browser-session :body-vars (title)) (control:check-title title) (let ((pl (model:new-playlist (session-user) :title title))) (lzb:http-redirect (playlist-page-url pl)))) (defun invites-control () (with-html (:h2 "Invite Friends") (:div (:p "Invites go here")))) (defun password-reset-link () (with-html (:div (:a :href "/reset-password" "Reset Password")))) (defpage/session "/you" (:title "Vampire ~ Your Stuff") (:div (row (col (user-playlists (print (model:playlists (session-user))))) (col (make-playlist-form) (invites-control) (password-reset-link))))) (defpage/session "/us" (:title "Vampire ~ Our Playlists") (:div :class "container")) (defpage/session "/tracks" (:title "Vampire ~ Track Library") (:div :class "container")) (defpage/session "/about" (:title "Vampore ~ About") (:div :class "container" "to be done")) (defpage/session "/library" (:title "Vampire ~ Track Library")) (defpage "/login" (:title "Vampire - Login") (:div :class "container" (form :button "Login" :method "POST" :action "/login" (input "username" "User name") (input "password" "Password" "password")) (:a :href "/create-account" "Create Account"))) (defendpoint* :post "/login" () (:body-vars (username password)) (a:if-let (user (model:login-user username password)) (let ((session (model:make-session user))) (lzb:set-response-cookie +vampire-session-cookie+ (model:key session)) (lzb:http-redirect "/")) (lzb:http-redirect "/login"))) (defpage "/create-account" (:title "Vampire - Create Account") (:div :class "container" (form :action "/create-account" :method "POST" (input "token" "Invite Token") (input "name" "Choose User Name") (input "password" "Choose a Passwrod" "password")))) (defpage/session "/playlist/:pl control:a-playlist:/:title:" (:title (model:title pl)) (:h1 (model:title pl))) ;;; CSS (defendpoint* :get "/css/theme.css" () () (setf (lzb:response-header :content-type) "text/css") (lass:compile-and-write '(:let ((main-background "#343434") (main-textcolor "#dfdede") (active-color "#aabbcc") (active-background-color "#222222") (link-color "#aaddbb") (hover-color "#ddeeff") (hover-backround-color "black") (fringe-color "#aabbcc") (padding "5px") (bigger "1.7em")) (body :background #(main-background) :color #(main-textcolor)) (a :color #(link-color)) (header :font-size 1.1em) (.vsep-container :display inline :border-left 1px solid #(fringe-color) (.vsep-item :padding-right 4px :padding-left 4px :border-right 1px solid #(fringe-color))) (.right :float right) (.inline :display inline) (.navbar2 :width 100% :overflow auto (h1 :float left :width 100% :text-align center)) (.center :margin auto :max-width 80%) (.navbar :width 100% :overflow auto :border-bottom 1px solid #(fringe-color) (a :float left :width 33% :font-size #(bigger) :text-align center :text-decoration none) ((:and a :hover) :color #(hover-color) :background #(hover-backround-color)) (a.active :background #(active-background-color) :color #(active-color))) (.row :display flex) (.col :flex 1) (.playlists :display flex :justify-content space-around :flex-wrap wrap :width 100%) (.card :margin #(padding) :border 1px solid #(fringe-color) :width 200px :height 200px :display block) ((:or h1 h2) :width 80% :margin-left auto :margin-right auto :text-align center :border-bottom 1px dotted #(fringe-color)) (:media "(max-width: 650px)" (.navbar (a :float none :display block :width 100% :text-align left))) (:media "(max-width: 800px)" (.row :display block))))) ;;; JAVASCRIPT (defendpoint* :get "/js/vampire-api.js" () () "Serves a javascript module called 'VampireApi'" (setf (lzb:response-header :content-type) "text/javascript") (client:generate-js (lzb:app 'vampire.api::vampire.api))) (defendpoint* :get "/js/vampire-util.js" () () "Serves a javascript module called" ) (defendpoint* :get "/js/vampire-app.js" () () "Serves a javascript module called VampireApp." (setf (lzb:response-header :content-type) "text/javascript") (ps:ps (defmodule -vampire-app "vampire control app" (defprivate element (lambda (id) (ps:chain document (get-element-by-id id)))) (defprivate stop-media-playback (lambda ())) (defprivate forward-one-track (lambda ())) (defprivate back-one-track (lambda ())) (defprivate start-media-playback (lambda ())) (defprivate media-now-playing-p (lambda ())) (defpublic play-next-track (lambda () (stop-media-playback) (when (forward-one-track) (start-media-playback)))) (defpublic play-previous-track (lambda () (stop-media-playback) (when (back-one-track) (start-media-playback)))) (defpublic toggle-playback (lambda () (if (media-now-playing-p) (stop-media-playback) (start-media-playback)))) (defpublic play-track (lambda (key) (stop-media-playback) (set-track-to key) (start-media-playback))) (defpublic load (lambda () (ps:chain -vampire-api (get-session-playlist (ps:chain -vampire-client (get-session))) (then )))) ;; moocow )))