+(define random-bricabrac
+ '("a creepy porcelain doll"
+ "assorted 1950s robots"
+ "an exquisite tea set"
+ "an antique mustard pot"
+ "the pickled head of Elvis"
+ "the pickled circuitboard of EVLIS"
+ "a scroll of teletype paper holding the software Four Freedoms"
+ "a telephone shaped like an orange cartoon cat"))
+
+(define-class <sign-in-form> (<gameobj>)
+ (commands
+ #:init-value
+ (list
+ (indir-as-direct-command "sign" 'cmd-sign-form
+ '("as"))))
+ (message-handler
+ #:init-value
+ (simple-dispatcher
+ (append
+ (build-actions
+ (cmd-sign-form (wrap-apply sign-cmd-sign-in)))
+ gameobj-actions))))
+
+
+(define name-sre
+ (sre->irregex '(: alpha (** 1 14 (or alphanum "-" "_")))))
+
+(define forbidden-words
+ (append article preposition
+ '("and" "or" "but" "admin")))
+
+(define (valid-name? name)
+ (and (irregex-match name-sre name)
+ (not (member name forbidden-words))))
+
+(define-mhandler (sign-cmd-sign-in actor message direct-obj indir-obj)
+ (define old-name
+ (message-ref
+ (<-wait actor (message-from message) 'get-name)
+ 'val))
+ (define name indir-obj)
+ (if (valid-name? indir-obj)
+ (begin
+ (<-wait actor (message-from message) 'set-name!
+ #:val name)
+ (<- actor (slot-ref actor 'loc) 'tell-room
+ #:text (format #f "~a signs the form!\n~a is now known as ~a\n"
+ old-name old-name name)))
+ (<- actor (message-from message) 'tell
+ "Sorry, that's not a valid name.
+Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic
+character.")))
+
+