@prog mailaddr.muf 1 999 d 1 i : say me @ swap notify ; : isspace (c -- i) " " strcmp not ; : sstrip begin dup not if exit then 1 strcut over isspace while swap pop loop strcat begin -1 strcut dup isspace while pop loop strcat ; : do-null me @ wizard? if "No @function has been set on this action yet." say "Valid functions are \"register\" and \"get-address\"." say then ; : Your dup me @ dbcmp if pop "Your" else name "'s" strcat then ; : make-address-public dup "~email" prop-exists? if dup Your " address is already public!" strcat say else dup "@email" prop-exists? eif dup "~email" over "@email" getpropstr 3 pick "@email" remove_prop addprop dup Your " address is now public." strcat say else "There is nothing to make public!" say dup Your " address has not been set." strcat say then pop ; : make-address-private dup "~email" prop-exists? if dup "@email" over "~email" getpropstr 3 pick "~email" remove_prop addprop dup Your " address is now private." strcat say else dup "@email" prop-exists? eif dup Your " address is already private!" strcat say else "There is nothing to make private!" say dup Your " address has not been set." strcat say then pop ; : remove-address dup "@email" prop-exists? over "~email" prop-exists? or if dup "@email" remove_prop dup "~email" remove_prop dup Your " email address has been removed." strcat say else "Nothing to remove!" say dup Your " email address has not been set." strcat say then pop ; : set-address over "~email" prop-exists? if over "~email" rot addprop "public" "reset" else over "@email" prop-exists? eif over "@email" rot addprop "private" "reset" else over "@email" rot addprop "private" "set" then 3 pick Your " email address has been " strcat swap strcat "; it's " strcat swap strcat "." strcat say pop ; : do-register dup not if pop "This command registers your email address." say "You must give an address to register, or a command:" say "public - make the address public information (anyone can get it)" say "private - make the address non-public information (only wizards can get it)" say me @ wizard? not if exit then "----" say "Since you're a wizard, you can specify a player name" say "by adding \"=\" before the operation, as in" say "register joe=joeblow@somewhere.edu" say "You may also omit the part after the = to remove an" say "email address entirely." say exit then me @ swap me @ wizard? if dup "=" instr dup if 1 - strcut 1 strcut swap pop sstrip swap sstrip .pmatch+ dup player? if rot pop swap else "That's not a player!" say pop pop pop exit then else pop then then dup "public" strcmp not if pop make-address-public else dup "private" strcmp not eif pop make-address-private else dup not eif pop remove-address else set-address then ; : do-get-address dup not if pop "This command inquires about email addresses." say "You must give the name of the player whose address" say "you are interested in finding out about." say me @ wizard? not if exit then "----" say "As a wizard, note that you will be told addresses even" say "if they're private; normal players will not be told" say "about private addresses." say exit then .pmatch+ dup player? not if "That's not a player!" say pop exit then dup "~email" prop-exists? if dup Your " email address is public: " strcat over "~email" getpropstr strcat say else dup me @ dbcmp me @ wizard? or eif dup "@email" prop-exists? if dup Your " email address is private: " strcat over "@email" getpropstr strcat say else dup Your " email address is not set." strcat say then else dup name "'s email address is not public." strcat say then pop ; : main sstrip trigger @ "@function" getpropstr dup "register" strcmp not if pop do-register exit then dup "get-address" strcmp not if pop do-get-address exit then dup "" strcmp not if pop do-null exit then "Invalid function " swap strcat say exit ; . c q