world.scm

   1 (import matchable
   2         srfi-13
   3         sam-macros)
   4
   5 (define login-beh
   6   (let ((accounts '()))
   7     (make-beh
   8      (login)
   9      ((console) =>
  10       (send-message console 'print "Welcome to the world!\n"
  11                     "\n"
  12                     "Enter your username or \"NEW\" to create a new account:")
  13       (send-message console 'read
  14                     (make-actor-with-beh
  15                      (self)
  16                      (("NEW") =>
  17                       (send-message login console 'new-user)
  18                       'done)
  19                      ((user) =>
  20                       (send-message login console 'user user)
  21                       'done))))
  22      ((console 'user user) =>
  23       (send-message console 'print "password: ")
  24       (send-message console 'read
  25                     (make-actor-with-beh
  26                      (self)
  27                      ((pass) =>
  28                       (send-message login console 'user user 'pass pass)
  29                       'done))))
  30      ((console 'user user 'pass pass) =>
  31       (send-message console 'print "Logged in user " user " with password " pass))
  32      ((console 'new-user) =>
  33       (send-message console 'print "What should I call your character?")
  34       (send-message console 'read
  35                     (make-actor-with-beh
  36                      (self)
  37                      ((user) =>
  38                       (if (assoc user accounts)
  39                           (begin
  40                             (send-message console 'print
  41                                           "A character with that name already exists.")
  42                             (send-message login console 'new-user))
  43                           (send-message login console 'new-user user))
  44                       'done))))
  45      ((console 'new-user user) =>
  46       (send-message console 'print "Please enter a good password/phrase:")
  47       (send-message console 'read
  48                     (make-actor-with-beh
  49                      (self)
  50                      ((pass) =>
  51                       (send-message login console 'new-user user 'pass-confirm pass)
  52                       'done))))
  53      ((console 'new-user user 'pass-confirm pass) =>
  54       (send-message console 'print "Please confirm your password:")
  55       (send-message console 'read
  56                     (make-actor-with-beh
  57                      (self)
  58                      ((pass-conf) =>
  59                       (if (equal? pass pass-conf)
  60                           (send-message login console 'new-user user 'pass pass)
  61                           (begin
  62                             (send-message console 'print "Passwords do not match. Try again.")
  63                             (send-message login console 'new-user user)))
  64                       'done))))
  65      ((console 'new-user user 'pass pass) =>
  66       (let ((player (make-actor (make-player-beh user))))
  67         (set! accounts (cons (list user pass player)))
  68         (send-message console 'print "New account created!  Welcome!"))))))
  69
  70
  71 (define-beh main-beh (self)
  72   ((system) =>
  73    (send-message (make-actor login-beh) system)
  74    'done))
  75