blob: 173700cf3915e7779008f42408eec9615365ec8f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
;;;; 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")
(p (:content "ANNOUNCEMENT: Vampire Sucks (ha ha). No really. It has been regularly refusing connections. You may have noticed a White Screen Of Death. I (colin) have been (very slowly) working on an improved application. Stay tuned: IMPROVEMENTS LAND IN OCTOBER 2024. Forthcoming new features: Comments! Search! Exploration!")))
(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)))))))))
|
