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       'sleep)
  23      ((console 'user user) =>
  24       (send-message console 'print "password: ")
  25       (send-message console 'read
  26                     (make-actor-with-beh
  27                      (self)
  28                      ((pass) =>
  29                       (send-message login console 'user user 'pass pass)
  30                       'done)))
  31       'sleep)
  32      ((console 'user user 'pass pass) =>
  33       (send-message console 'print "Logged in user " user " with password " pass)
  34       'sleep)
  35      ((console 'new-user) =>
  36       (send-message console 'print "What should I call your character?")
  37       (send-message console 'read
  38                     (make-actor-with-beh
  39                      (self)
  40                      ((user) =>
  41                       (if (assoc user accounts)
  42                           (begin
  43                             (send-message console 'print
  44                                           "A character with that name already exists.")
  45                             (send-message login console 'new-user))
  46                           (send-message login console 'new-user user))
  47                       'done)))
  48       'sleep)
  49      ((console 'new-user user) =>
  50       (send-message console 'print "Please enter a good password/phrase:")
  51       (send-message console 'read
  52                     (make-actor-with-beh
  53                      (self)
  54                      ((pass) =>
  55                       (send-message login console 'new-user user 'pass-confirm pass)
  56                       'done)))
  57       'sleep)
  58      ((console 'new-user user 'pass-confirm pass) =>
  59       (send-message console 'print "Please confirm your password:")
  60       (send-message console 'read
  61                     (make-actor-with-beh
  62                      (self)
  63                      ((pass-conf) =>
  64                       (if (equal? pass pass-conf)
  65                           (send-message login console 'new-user user 'pass pass)
  66                           (begin
  67                             (send-message console 'print "Passwords do not match. Try again.")
  68                             (send-message login console 'new-user user)))
  69                       'done)))
  70       'sleep)
  71      ((console 'new-user user 'pass pass) =>
  72       (let ((player (make-actor (make-player-beh user))))
  73         (set! accounts (cons (list user pass player)))
  74         (send-message console 'print "New account created!  Welcome!"))
  75       'sleep))))
  76
  77
  78 (define-beh main-beh (self)
  79   ((system) =>
  80    (send-message (make-actor login-beh) system)
  81    'done))
  82