1 files changed, 63 insertions, 0 deletions
diff --git a/new-account.lisp b/new-account.lisp
new file mode 100644
index 0000000..10311af
--- /dev/null
+++ b/new-account.lisp
@@ -0,0 +1,63 @@
+;;;; new-account.lisp
+
+(in-package :vampire)
+
+(defun valid-invite-code-p (arg) arg)
+(defun use-invite-with-code (code username pw))
+
+(defun new-accout-page (body)
+  (with-clog-create body
+      (div ()
+           (section (:h2 :content "Create a new account"))
+           (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))))
+
+    (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 (valid-invite-code-p (value invite))
+                   "✔"
+                   "Bad Invite Code"))))
+    (set-on-blur
+     name
+     (thunk*
+         (setf (text name-status)
+               (if (user-with-name name)
+                   "Name Already Taken"
+                   "✔"))))
+
+    (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 "✔" (value 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."))))))