X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=f95ebd9ab51f4dc61817e7a57fdee2607e61e99e;hp=5797785579950f23f596cd8ace21b1f3f1ddb190;hb=50cd2aba8f13ec7aecb58a683aa55ae665cf83ab;hpb=ccbe2f18eb338a77b9a1986a3a36c7c9af07389c

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 5797785..f95ebd9 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -19,10 +19,12 @@
 ;;; Hotel Bricabrac
 
 (use-modules (mudsync)
+             (mudsync parser)
              (8sync systems actors)
              (8sync agenda)
              (oop goops)
-             (ice-9 format))
+             (ice-9 format)
+             (rx irregex))
 
 
 
@@ -77,7 +79,8 @@
 
 (define chat-commands
   (list
-   (direct-command "chat" 'cmd-chat)))
+   (direct-command "chat" 'cmd-chat)
+   (direct-command "talk" 'cmd-chat)))
 (define chat-actions
   (build-actions
    (cmd-chat (wrap-apply npc-chat-randomly))))
@@ -117,6 +120,51 @@ or 'skribe'?  Now *that's* composition!"))
     "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.")))
+
+
 (define lobby
   (lol
    ('room:lobby
@@ -135,7 +183,7 @@ kind of objects they found lying around.
     #:exits
     (list (make <exit>
             #:name "north"
-            #:to-symbol 'room:grand-hallway)))
+            #:to 'room:grand-hallway)))
    ;; NPC: hotel owner
    ('npc:hotel-owner
     <chatty-npc> 'room:lobby
@@ -180,7 +228,11 @@ Classy!"
              (format #f "  The curio cabinet is full of all sorts of oddities!
 Something catches your eye!
 Ooh, ~a!" (random-choice random-bricabrac))))
-
+   ('thing:sign-in-form
+    <sign-in-form> 'room:lobby
+    #:name "sign-in form"
+    #:goes-by '("sign-in form" "form" "signin form")
+    #:desc "It looks like you could sign this form and set your name.")
    ;; Object: desk
    ;;  - Object: bell
    ;;  - Object: sign in form
@@ -208,7 +260,7 @@ they're all boarded up.  Guess this is still a work in progress, huh?"
     #:exits
     (list (make <exit>
             #:name "south"
-            #:to-symbol 'room:lobby))
+            #:to 'room:lobby))
     )))
 
 
@@ -245,6 +297,7 @@ they're all boarded up.  Guess this is still a work in progress, huh?"
 (define game-spec
   (append lobby grand-hallway))
 
+;; TODO: Provide command line args
 (define (run-game . args)
-  (run-demo "/tmp/bricabrac-game.db" game-spec 'room:lobby))
+  (run-demo game-spec 'room:lobby #:repl-server #t))