Index: bindings/ruby/lib/mooix/thing.rb =================================================================== --- bindings/ruby/lib/mooix/thing.rb (revision 23) +++ bindings/ruby/lib/mooix/thing.rb (working copy) @@ -343,47 +343,47 @@ lock end -=begin ---- Thing.prettyname -Returns a name suitable for pretty-printing. Adds an article if one is defined, else adds nothing. - :Returns: - pretty-printable name for this. -=end - - def prettyname - if self.has?("article") and self.article != nil - return "#{article} #{name}" - else - return "#{name}" - end - end - -=begin ---- Thing.prettylist(objects) -Prepares ((|objects|)) for pretty-printing. - :Parameters: - : ((|objects|)) - list of objects or strings whose value is to be pretty-printed. - :Returns: - string listing all objects and strings contained within ((|objects|)) in a format suitable for printing. -=end - - def prettylist(objects) - return "nothing" if objects.length == 0 - result = "" - objects.each_index do |x| - if objects[x] == self - result += "you" - else - if objects[x].class != String - result += "#{objects[x].prettyname}" - else - result += "#{objects[x]}" - end - end - result += ", " if x <= (objects.length-3) - result += " and " if x == (objects.length-2) - end - return result - end +## =begin +## --- Thing.prettyname +## Returns a name suitable for pretty-printing. Adds an article if one is defined, else adds nothing. +## :Returns: +## pretty-printable name for this. +## =end +## +## def prettyname +## if self.has?("article") and self.article != nil +## return "#{article} #{name}" +## else +## return "#{name}" +## end +## end +## +## =begin +## --- Thing.prettylist(objects) +## Prepares ((|objects|)) for pretty-printing. +## :Parameters: +## : ((|objects|)) +## list of objects or strings whose value is to be pretty-printed. +## :Returns: +## string listing all objects and strings contained within ((|objects|)) in a format suitable for printing. +## =end +## +## def prettylist(objects) +## return "nothing" if objects.length == 0 +## result = "" +## objects.each_index do |x| +## if objects[x] == self +## result += "you" +## else +## if objects[x].class != String +## result += "#{objects[x].prettyname}" +## else +## result += "#{objects[x]}" +## end +## end +## result += ", " if x <= (objects.length-3) +## result += " and " if x == (objects.length-2) +## end +## return result +## end end Index: bindings/python/mooix/variables.py =================================================================== --- bindings/python/mooix/variables.py (revision 23) +++ bindings/python/mooix/variables.py (working copy) @@ -24,7 +24,7 @@ # this gets set at compile time try: - MOOROOT = MOOROOT_FROM_BUILD + MOOROOT = '/var/lib/mooix' except NameError: MOOROOT = None Index: bindings/python/mooix/Thing.py =================================================================== --- bindings/python/mooix/Thing.py (revision 23) +++ bindings/python/mooix/Thing.py (working copy) @@ -31,8 +31,8 @@ """A generic exception for something going wrong.""" pass -def _prettyname(thing): - return (thing.article and '%s ' % thing.article) + thing.name +## def _prettyname(thing): +## return (thing.article and '%s ' % thing.article) + thing.name class Thing(object): """This is the mooix object class for Python. It provides a standard class @@ -437,24 +437,24 @@ stacklevel = 2) return None - def prettyname(self): - """prettyname() -> the object's name with any article prepended""" - return _prettyname(self) +## def prettyname(self): +## """prettyname() -> the object's name with any article prepended""" +## return _prettyname(self) +## +## def prettylist(self, object_list): +## """prettylist(object_list) -> a pretty-printed list of objects +## +## Generates a very pretty-printed list of objects, and returns it. +## The object it's run on will appear in the list as "you".""" +## object_list = tolist(object_list) +## if object_list: +## return (len(object_list) > 2 +## and ', ' +## or ' and ').join([ _prettyname(o) +## for o in object_list +## if isinstance(o, Thing) ]) +## else: +## return 'nothing' - def prettylist(self, object_list): - """prettylist(object_list) -> a pretty-printed list of objects - Generates a very pretty-printed list of objects, and returns it. - The object it's run on will appear in the list as "you".""" - object_list = tolist(object_list) - if object_list: - return (len(object_list) > 2 - and ', ' - or ' and ').join([ _prettyname(o) - for o in object_list - if isinstance(o, Thing) ]) - else: - return 'nothing' - - __all__ = [ 'MooixError', 'Thing', 'LOCK_UN', 'LOCK_SH', 'LOCK_EX', 'LOCK_NB' ] Index: bindings/perl/lib/Mooix/Thing.pm =================================================================== --- bindings/perl/lib/Mooix/Thing.pm (revision 23) +++ bindings/perl/lib/Mooix/Thing.pm (working copy) @@ -90,8 +90,9 @@ Mooix::Thing also exports into your namespace a function called "fail". This function can be used by verbs (and occasional other methods) to exit with a -numeric exit code that indicates failure, and at the same time return a value -to the caller. +numeric exit code that indicates failure. It takes no arguments. +Before running it, you should use $this->msg() to let the user know +what happened. =cut @@ -118,7 +119,10 @@ # no strict 'refs'; *debuglog = *_debuglog_null; *{"${callpkg}::fail"} = sub { - print join("\n",map { "\"$_\"" } @_)."\n"; + if( @_ ) + { + print "UNTRANTSLATED FAIL MESSAGE!: ". join("\n",map { "\"$_\"" } @_)."\n"; + } exit 10; # FAIL }; *{"${callpkg}::run"} = sub { @@ -733,36 +737,45 @@ return 1; } -=item prettylist +## =item prettylist +## +## Generates a very pretty-printed list of objects, and returns it. The +## object it's run on will appear in the list as "you". +## +## =cut +## +## sub prettylist { +## my $this=shift; +## my $avatar=shift; +## my @objects=@_; +## +## # Get the list seperators for this language. +## my $list_sep = $this->language->list_seperator; +## my $list_sep_end = $this->language->list_seperator_last; +## +## return "nothing" if ! @objects; +## @objects = map { $_->prettyname( recipient => $this, avatar => $avatar ) } +## grep ref, @objects; +## $objects[$#objects] = $list_sep_end . $objects[$#objects] if @objects > 1; +## return join((@objects > 2) ? $list_sep : '', @objects); +## } -Generates a very pretty-printed list of objects, and returns it. The -object it's run on will appear in the list as "you". +## =item prettyname +## +## Returns the object's name with any article prepended. +## +## =cut +## +## sub prettyname { +## my $this=shift; +## my $avatar=shift; +## my $a = $this->article; +## $a.="" if length $a; +## my $text = $a.$this->name; +## $text = $this->dexml( avatar => $avatar, text => $text ); +## return $text; +## } -=cut - -sub prettylist { - my $this=shift; - my @objects=@_; - - return "nothing" if ! @objects; - @objects = map { $_ == $this ? 'you' : $_->prettyname } - grep ref, @objects; - $objects[$#objects] = 'and '.$objects[$#objects] if @objects > 1; - return join((@objects > 2) ? ', ' : ' ', @objects); -} - -=item prettyname - -Returns the object's name with any article prepended. - -=cut - -sub prettyname { - my $a = $_[0]->article; - $a.=" " if length $a; - return $a.$_[0]->name; -} - =item untaint If perl is run with taint checking enabled, and some method returns a mooix @@ -848,7 +861,11 @@ my $fh; if (! open ($fh, $file)) { - $this->croak($file); + # Can't use croak here! This is because croak + # *itself* does (many) field reads, so infinite + # loops can result! + ## $this->croak($file); + die "Failure in _readfield reading $file.\n"; } if (wantarray) { my $sticky=-k _; Index: bindings/c/moomethod.h =================================================================== --- bindings/c/moomethod.h (revision 23) +++ bindings/c/moomethod.h (working copy) @@ -3,6 +3,14 @@ * It's very incomplete so far. It doesn't try to be pseudo-OO (yet). */ +/* For information on how to pass values out, read "help + * methods-lowlevel". + */ + +/* To print debugging messages, send stuff to stderr. It's + * primitive, but it'll get sent to the calling session. + */ + #include #include #include @@ -65,7 +73,9 @@ * a true value (1) */ int truefield (object *obj, const char *field); /* Gets and returns a field of the current object. Does not do inheritence, - * and only returns the first line of the field. */ + * and only returns the first line of the field. Can be used on the + * return value of fieldfile, however, which makes it not entirely + * useless. */ char *getfield (const char *field); /* Sets a field of the current object to a value. Returns true if the set * succeeds. */ @@ -94,3 +104,27 @@ /* Read a line of any size and return a malloced string, or NULL on eof. */ char *mooix_getline (FILE *f, int killquotes); + +/* Generate a prettified name for an object, from the POV of the + * recipient. */ +char *prettyname( object *obj, object *recipient ); + +/* Read all parameters, return NULL terminated array. */ +param **getparams( void ); + +/* Look up a parameter from an array by name. */ +char *findparam (const char *key, param **params); + +/* Remove xml tags from the text. is supported; marked up + * in bold down the stream, all else are ignored. Also handle + * entities. In the vast majority of cases, uses dexml_recipient, + * which is an avatar, to determine the preferred language, but in + * some cases (read: parsers), uses the language argument instead. + */ +char *dexml( char *text, object *avatar_ptr, char *language ); + +/* Just like runmethod, but takes a param structure list instead of a bunch of strings */ +FILE *runmethod_param( object *obj, const char *method, param **params ); + +/* Runs prettyname as though a third-person perspective pertains */ +char *other_prettyname( object *obj, object *recipient ); Index: bindings/c/moomethod.c =================================================================== --- bindings/c/moomethod.c (revision 23) +++ bindings/c/moomethod.c (working copy) @@ -13,400 +13,1197 @@ #include #include #include +#include +#include +#include + +#include + #include "moomethod.h" int methinit (void) { - char *dir = getenv("THIS"); - if (dir == NULL) - return 0; - return chdir(getenv("THIS")); + char *dir = getenv("THIS"); + if (dir == NULL) + return 0; + return chdir(getenv("THIS")); } void freeparam (param *param) { - free(param->name); - free(param->value); - free(param); + free(param->name); + free(param->value); + free(param); } char *mooix_getline (FILE *f, int killquotes) { - int size = 0; - char *ret = NULL; + int size = 0; + char *ret = NULL; - if (feof(f)) - return NULL; - - do { - ret = realloc(ret, size + 128 + 1); - if (! fgets(ret + size, 128, f)) { - if (size == 0) { - free(ret); - return NULL; /* reached eof with empty string */ - } - else { - ret[size]='\0'; - break; - } - } - size = strlen(ret); - } while (size > 0 && ret[size - 1] != '\n'); + if (feof(f)) + return NULL; - /* remove trailing newline */ - if (ret[size - 1] == '\n') - ret[--size] = '\0'; - - /* Remove quotes? */ - if (killquotes) { - if (size > 1 && ret[0] == '"' && ret[size - 1] == '"') { - ret[--size] = '\0'; - memmove(ret, ret + 1, size); /* left shift by one char */ - } + do { + ret = realloc(ret, size + 128 + 1); + if (! fgets(ret + size, 128, f)) { + if (size == 0) { + free(ret); + return NULL; /* reached eof with empty string */ + } + else { + ret[size]='\0'; + break; + } } - return ret; + size = strlen(ret); + } while (size > 0 && ret[size - 1] != '\n'); + + /* remove trailing newline */ + if (ret[size - 1] == '\n') + ret[--size] = '\0'; + + /* Remove quotes? */ + if (killquotes) { + if (size > 1 && ret[0] == '"' && ret[size - 1] == '"') { + ret[--size] = '\0'; + memmove(ret, ret + 1, size); /* left shift by one char */ + } + } + return ret; } char *getkey () { - return mooix_getline(stdin, 1); + return mooix_getline(stdin, 1); } char *escape (const char *s) { - /* Change embedded newlines to \\n, and double slashes. Add quotes. */ - if (strchr(s, '\n') || strchr(s, '\\')) { - char *q, *t = malloc(strlen(s) * 2 + 3); - const char *p; - - for (p = s, q = t + 1; p[0] != '\0'; p++, q++) { - if (p[0] == '\n') { - q[0] = '\\'; - q[1] = 'n'; - q++; - } - else if (p[0] == '\\') { - q[0] = '\\'; - q[1] = '\\'; - q++; - } - else { - q[0] = p[0]; - } - } - t[0] = q[0] = '"'; - q[1] = '\0'; - return t; + /* Change embedded newlines to \\n, and double slashes. Add quotes. */ + if (strchr(s, '\n') || strchr(s, '\\')) { + char *q, *t = malloc(strlen(s) * 2 + 3); + const char *p; + + for (p = s, q = t + 1; p[0] != '\0'; p++, q++) { + if (p[0] == '\n') { + q[0] = '\\'; + q[1] = 'n'; + q++; + } + else if (p[0] == '\\') { + q[0] = '\\'; + q[1] = '\\'; + q++; + } + else { + q[0] = p[0]; + } } - else { - int len = strlen(s); - char *t = malloc(len + 3); - t[0] = '"'; - strcpy(t+1, s); - t[0] = t[len + 1] = '"'; - t[len + 2] = '\0'; - return t; - } + t[0] = q[0] = '"'; + q[1] = '\0'; + return t; + } + else { + int len = strlen(s); + char *t = malloc(len + 3); + t[0] = '"'; + strcpy(t+1, s); + t[0] = t[len + 1] = '"'; + t[len + 2] = '\0'; + return t; + } } char *unescape (char *s) { - char *p = s; - - while (p && (p = strstr(p, "\\"))) { - int len = strlen(s); + char *p = s; - if (p[1] == '\\') { - /* memmove below will remove first slash */ - } - else if (p[1] == 'n' && (p == s || p[-1] != '\\')) { - /* Turn "\n" into a literal newline. */ - p[1] = '\n'; - } - else { - p++; - continue; - } - - /* Copy remainder of line over slash. */ - memmove(p, p+1, len - (p - s) + 1); - p++; + while (p && (p = strstr(p, "\\"))) { + int len = strlen(s); + + if (p[1] == '\\') { + /* memmove below will remove first slash */ } - - return s; + else if (p[1] == 'n' && (p == s || p[-1] != '\\')) { + /* Turn "\n" into a literal newline. */ + p[1] = '\n'; + } + else { + p++; + continue; + } + + /* Copy remainder of line over slash. */ + memmove(p, p+1, len - (p - s) + 1); + p++; + } + + return s; } char *fgetvalue (FILE *f) { - return unescape(mooix_getline(f, 1)); + return unescape(mooix_getline(f, 1)); } char *getvalue () { - return fgetvalue(stdin); + return fgetvalue(stdin); } char **fgetallvals (FILE *f) { - int size=16, count=0; - char **ret=malloc(size * sizeof(char *)); - char *s; - - while ((s = fgetvalue(f))) { - ret[count] = s; - count++; - if (count >= size) { - size *= 2; - ret = realloc(ret, size * sizeof(char *)); - } + int size=16, count=0; + char **ret=malloc(size * sizeof(char *)); + char *s; + + while ((s = fgetvalue(f))) { + ret[count] = s; + count++; + if (count >= size) { + size *= 2; + ret = realloc(ret, size * sizeof(char *)); } - ret[count] = NULL; - return ret; + } + ret[count] = NULL; + return ret; } char **getallvals () { - return fgetallvals(stdin); + return fgetallvals(stdin); } param *getparam (void) { - param *ret = malloc(sizeof(param)); - - ret->name = NULL; - ret->value = NULL; - - if ((ret->name = getkey()) == NULL || + param *ret = malloc(sizeof(param)); + + ret->name = NULL; + ret->value = NULL; + + if ((ret->name = getkey()) == NULL || (ret->value = getvalue()) == NULL) { - freeparam(ret); - return NULL; - } + freeparam(ret); + return NULL; + } - return ret; + return ret; } +/* Read all parameters, return NULL terminated array */ +param **getparams( void ) { /* {{{ */ + /* Holds the parameters passed to this method. */ + param **params; + + param *p; + int numparams=4; + int curparam=0; + + params = malloc(sizeof(param *) * numparams + 1 ); + while ((p = getparam())) + { + //fprintf( stderr, "param: %s, %s.\n", p->name, p->value ); + params[curparam++]=p; + if (curparam >= numparams) + { + numparams = numparams * 2; + params=realloc(params, sizeof(param *) * (numparams + 1)); + } + } + params[curparam]=NULL; + + return params; +} /* }}} */ + +/* Look up a parameter from an array by name. */ +char *findparam (const char *key, param **params) { /* {{{ */ + /* TODO: optimize. hash? tsearch? */ + int i; + for (i=0; params[i] != NULL; i++) + { + if (strcmp(key, params[i]->name) == 0) + { + return params[i]->value; + } + } + return NULL; +} /* }}} */ + int truefield (object *obj, const char *field) { - char *file, *value; - - file = fieldfile(obj, field); - if (! file) - return 0; + char *file, *value; - value = getfield(file); - if (! value) - return 0; - if (! strlen(value)) - return 0; - if (strcmp(value, "0") == 0) - return 0; - else - return 1; + file = fieldfile(obj, field); + if (! file) + return 0; + + value = getfield(file); + if (! value) + return 0; + if (! strlen(value)) + return 0; + if (strcmp(value, "0") == 0) + return 0; + else + return 1; } char *getfield (const char *field) { - char *ret; - FILE *f = fopen(field, "r"); - if (f == NULL) - return NULL; - ret = mooix_getline(f, 0); - fclose(f); - return ret; + char *ret; + FILE *f = fopen(field, "r"); + if (f == NULL) + return NULL; + ret = mooix_getline(f, 0); + fclose(f); + return ret; } int setfield (const char *field, const char *value) { - FILE *f = fopen(field, "w"); - if (f == NULL) - return 0; - fprintf(f, "%s", value); - fclose(f); - return 1; + FILE *f = fopen(field, "w"); + if (f == NULL) + return 0; + fprintf(f, "%s", value); + fclose(f); + return 1; } char *fieldfile (object *obj, const char *field) { - int size, ods, fs, len; - char *ret; - char *p; - struct stat buf; - int depth = 0; + int size, ods, fs, len; + char *ret; + char *p; + struct stat buf; + int depth = 0; - /* set up ret to hold obj->dir/field */ - ods = strlen(obj->dir); - fs = strlen(field); - len = ods + 1; - size = len + fs + 128; - ret=malloc(size * sizeof(char)); - ret[0]='\0'; - strcat(ret, obj->dir); - strcat(ret, "/"); - p = ret + ods + 1; - - for (;;) { - /* Add field to end and see if anything turns up. */ - len += fs; - if (len >= size) { - size *= 2; - ret=realloc(ret, size * sizeof(char)); - /* ret might move, and thus so must p */ - p = ret + len - fs; - } - strcat(ret, field); - if (stat(ret, &buf) == 0) { - return ret; - } - - /* jump back to end of directory */ - len -= fs; - p[0]='\0'; + /* set up ret to hold obj->dir/field */ + ods = strlen(obj->dir); + fs = strlen(field); + len = ods + 1; + size = len + fs + 128; + ret=malloc(size * sizeof(char)); + ret[0]='\0'; + strcat(ret, obj->dir); + strcat(ret, "/"); + p = ret + ods + 1; - /* Add parent/ to end; make sure there is a parent */ - len += 7; - if (len >= size) { - size *= 2; - ret=realloc(ret, size * sizeof(char)); - p = ret + len - 7; - } - strcat(ret, "parent/"); - p += 7; /* points to end of parent/ */ - if (stat(ret, &buf) != 0) { - free(ret); - return NULL; /* no more parents */ - } + for (;;) { + /* Add field to end and see if anything turns up. */ + len += fs; + if (len >= size) { + size *= 2; + ret=realloc(ret, size * sizeof(char)); + /* ret might move, and thus so must p */ + p = ret + len - fs; + } + strcat(ret, field); + if (stat(ret, &buf) == 0) { + return ret; + } - /* Just in case.. */ - depth++; - if (depth > 200) { - fprintf(stderr, "possible recursive parent loop: %s\n", ret); - exit(1); - } + /* jump back to end of directory */ + len -= fs; + p[0]='\0'; + + /* Add parent/ to end; make sure there is a parent */ + len += 7; + if (len >= size) { + size *= 2; + ret=realloc(ret, size * sizeof(char)); + p = ret + len - 7; } + strcat(ret, "parent/"); + p += 7; /* points to end of parent/ */ + if (stat(ret, &buf) != 0) { + free(ret); + return NULL; /* no more parents */ + } + + /* Just in case.. */ + depth++; + if (depth > 200) { + fprintf(stderr, "possible recursive parent loop: %s\n", ret); + exit(1); + } + } } object *derefobj (const char *s) { - object *ret; + object *ret; - if (! s || strncmp(s, "mooix:", 6) != 0) - return NULL; - - ret = malloc(sizeof(object)); - ret->dev = 0; - ret->dir = strdup(s + 6); + if (! s || strncmp(s, "mooix:", 6) != 0) + return NULL; - return ret; + ret = malloc(sizeof(object)); + ret->dev = 0; + ret->dir = strdup(s + 6); + + /* Clean newline from the dir */ + ret->dir[ strcspn( ret->dir, "\n" ) ] = '\0'; + + return ret; } object *getobj (char *s) { - object *ret = malloc(sizeof(object)); - ret->dev = 0; - ret->dir = s; - return ret; + object *ret = malloc(sizeof(object)); + ret->dev = 0; + ret->dir = s; + return ret; } void freeobj (object *obj) { - free(obj->dir); - free(obj); + free(obj->dir); + free(obj); } /* This is very similar to _runmethod in the Mooix::Thing perl module.. */ FILE **runmethod_raw (object *obj, const char *method) { - static FILE *ret[2]; - int pipe1[2], pipe2[2]; - int parent_rdr, child_wtr; - int child_rdr, parent_wtr; - pid_t pid; + static FILE *ret[2]; + int pipe1[2], pipe2[2]; + int parent_rdr, child_wtr; + int child_rdr, parent_wtr; + pid_t pid; - /* Parent and child communication pipes. */ - pipe(pipe1); - parent_rdr=pipe1[0]; - child_wtr=pipe1[1]; - pipe(pipe2); - child_rdr=pipe2[0]; - parent_wtr=pipe2[1]; + /* Parent and child communication pipes. */ + pipe(pipe1); + parent_rdr=pipe1[0]; + child_wtr=pipe1[1]; + pipe(pipe2); + child_rdr=pipe2[0]; + parent_wtr=pipe2[1]; - pid = fork(); - if (pid == -1) { - close(parent_rdr); - close(parent_wtr); - close(child_rdr); - close(child_wtr); - return NULL; - } - else if (pid != 0) { - ret[0]=fdopen(child_wtr, "w"); - ret[1]=fdopen(child_rdr, "r"); - - /* Ignore sigpipes, which can easily occur if the child is - * very quick to run and does not read its input. */ - signal(SIGPIPE, SIG_IGN); + pid = fork(); + if (pid == -1) { + close(parent_rdr); + close(parent_wtr); + close(child_rdr); + close(child_wtr); + return NULL; + } + else if (pid != 0) { + ret[0]=fdopen(child_wtr, "w"); + ret[1]=fdopen(child_rdr, "r"); - close(parent_rdr); - close(parent_wtr); + /* Ignore sigpipes, which can easily occur if the child is + * very quick to run and does not read its input. */ + signal(SIGPIPE, SIG_IGN); - return ret; + close(parent_rdr); + close(parent_wtr); + + return ret; + } + else { + char *qualmethod; + + close(child_rdr); + close(child_wtr); + + close(0); + dup2(parent_rdr, 0); + close(parent_rdr); + close(1); + dup2(parent_wtr, 1); + close(parent_wtr); + + if (chdir(obj->dir) != 0) + exit(1); + + qualmethod=fieldfile(getobj("."), method); + if (! qualmethod) { + exit(1); } + + if (getenv("THIS")) { /* in the moo */ + execlp(qualmethod, qualmethod, NULL); + } else { - char *qualmethod; - - close(child_rdr); - close(child_wtr); + execlp("runmeth", "runmeth", qualmethod, NULL); + } + fprintf(stderr, "failed to exec %s %s\n", obj->dir, qualmethod); + exit(1); + } +} - close(0); - dup2(parent_rdr, 0); - close(parent_rdr); - close(1); - dup2(parent_wtr, 1); - close(parent_wtr); +FILE *runmethod_param( object *obj, const char *method, param **params ) { + FILE *wtr, *rdr, **fds; - if (chdir(obj->dir) != 0) - exit(1); + fds = runmethod_raw(obj, method); + if (fds == NULL) + return NULL; + wtr = fds[0]; + rdr = fds[1]; - qualmethod=fieldfile(getobj("."), method); - if (! qualmethod) { - exit(1); - } - - if (getenv("THIS")) { /* in the moo */ - execlp(qualmethod, qualmethod, NULL); - } - else { - execlp("runmeth", "runmeth", qualmethod, NULL); - } - fprintf(stderr, "failed to exec %s %s\n", obj->dir, qualmethod); - exit(1); + /* Pass params to child. */ + if (params) { + int i; + for (i = 0; params[i] != NULL; i++) + { + fprintf(wtr, "%s\n", params[i]->name); + //fprintf(stderr, "%s\n", params[i]->name); + fprintf(wtr, "%s\n", params[i]->value); + //fprintf(stderr, "%s\n", params[i]->value); } -} + } + fclose(wtr); /* let child know we're done so it can run */ + return rdr; +} FILE *runmethod (object *obj, const char *method, char **params) { - FILE *wtr, *rdr, **fds; - - fds = runmethod_raw(obj, method); - if (fds == NULL) - return NULL; - wtr = fds[0]; - rdr = fds[1]; - - /* Pass params to child. */ - if (params) { - int i; - for (i = 0; params[i] != NULL; i++) - fprintf(wtr, "%s\n", params[i]); + FILE *wtr, *rdr, **fds; + + fds = runmethod_raw(obj, method); + if (fds == NULL) + return NULL; + wtr = fds[0]; + rdr = fds[1]; + + /* Pass params to child. */ + if (params) { + int i; + for (i = 0; params[i] != NULL; i++) + { + fprintf(wtr, "%s\n", params[i]); + //fprintf(stderr, "%s\n", params[i]); } - fclose(wtr); /* let child know we're done so it can run */ - - return rdr; + } + fclose(wtr); /* let child know we're done so it can run */ + + return rdr; } int statobj (object *obj) { - struct stat buf; - if (stat(obj->dir, &buf) != 0) - return 0; - obj->dev = buf.st_dev; - obj->ino = buf.st_ino; - return 1; + struct stat buf; + if (stat(obj->dir, &buf) != 0) + return 0; + obj->dev = buf.st_dev; + obj->ino = buf.st_ino; + return 1; } int objcmp (object *a, object *b) { - /* The stat info is cached between calls. */ - if (! a->dev) { - if (! statobj(a)) - return -1; + /* The stat info is cached between calls. */ + if (! a->dev) { + if (! statobj(a)) + return -1; + } + if (! b->dev) { + if (! statobj(b)) + return -1; + } + + /* Return as does strcmp. */ + if (a->dev != b->dev) + return (a->dev > b->dev) - (a->dev < b->dev); + else + return (a->ino > b->ino) - (a->ino < b->ino); +} + +/* Generate a prettified name for an object, from the POV of the + * recipient. other_pov means that the name is to be treated as + * though a third-person perspective pertained. + */ + +char *internal_prettyname( object *obj, object *recipient, int other_pov ) { /* {{{ */ + char *name, *article, *file; + struct stat buf; + + if( objcmp(obj, recipient) == 0 && ! other_pov ) + { + char *lang_field_file; + object *lang_obj; + char *pronoun; + + /* At this point, we need at least the final seperator. */ + + lang_field_file = fieldfile( recipient, "language" ); + + if( lang_field_file == NULL ) { + /* No language; can't pick a seperator. Error out. + * */ + fprintf( stderr, "Recipient %s has no language in prettyname.\n", recipient->dir ); + pronoun = malloc( 1024 * sizeof( char ) ); + sprintf( pronoun, "ERROR: Recipient %s has no language in prettyname.\n", recipient->dir ); + return pronoun; } - if (! b->dev) { - if (! statobj(b)) - return -1; + + lang_obj = getobj( lang_field_file ); + + pronoun = getfield( fieldfile( lang_obj, "second_person_singular_pronoun" ) ); + + return pronoun; + } + + file = fieldfile(obj, "name"); + if (! file) + return ""; + /* The name might be a method to be called with no parameters. + * Rarely, but worth the stat for consistency. */ + if (stat(file, &buf) != 0) + return ""; + if (((buf.st_mode & S_IXUSR) == S_IXUSR) || + ((buf.st_mode & S_IXGRP) == S_IXGRP) || + ((buf.st_mode & S_IXOTH) == S_IXOTH)) { + /* Only allow running of methods that are marked as safe. */ + if (! truefield(obj, ".name-safe")) { + return ""; } + else { + FILE *f = runmethod(obj, "name", NULL); + if (! f) + return ""; + name = fgetvalue(f); + fclose(f); + } + } + else { + name = getfield(file); + } - /* Return as does strcmp. */ - if (a->dev != b->dev) - return (a->dev > b->dev) - (a->dev < b->dev); - else - return (a->ino > b->ino) - (a->ino < b->ino); + /* Hmm, article could be a method too, but it seems a little silly + * to support that. */ + file = fieldfile(obj, "article"); + + if (! file) + { + return ""; + } + + article = dexml( getfield(file), recipient, "" ); + + if (! article || ! strlen(article)) + { + char *ret = malloc(strlen(article) + 1 + strlen(name) + 1 + 13); + sprintf(ret, "%s", name); + return dexml( ret, recipient, "" ); + } else { + char *ret = malloc(strlen(article) + 1 + strlen(name) + 1 + 13); + sprintf(ret, "%s %s", article, name); + return dexml( ret, recipient, "" ); + } +} /* }}} */ + +/* Wrapper for internal_prettyname with other_pov off */ +char *prettyname( object *obj, object *recipient ) +{ + return internal_prettyname( obj, recipient, 0 ); } + +/* Wrapper for internal_prettyname with other_pov on */ +char *other_prettyname( object *obj, object *recipient ) +{ + return internal_prettyname( obj, recipient, 1 ); +} + + +/* + * Everything from here down + * + * is support functions for dexml, which is rather complicated. It + * strips XML tags out based on the avatar's language and other + * factors. + * + */ + +//FILE *log_file; +int skip=0; +int skip_depth=0; +int trailing_space=0; +char *parse_result; +char *parse_lang_code; + +/* Marks that the next initial alphabetic character should be made + * upper case + */ +int uc_next=0; +/* Marks that this is a language in which sentence-initial + * characters are made upper case. + */ +int uc_initial_lang=0; + +/* Pull a list of language codes used in the current text. */ +char **find_text_lang_codes( char *text, int *num_codes ) +{ + int status; + /* Only two possible matches: the main match and the one + * sub-expression. We only care about the latter. + * */ + regmatch_t lang_matches[2]; + regex_t lang_re; + int offset=0; + + /* Truly it would be a happy day when a moo has stuff translated + * into 129 languages... + */ + char **lang_codes; + + /* 128 32 byte lang codes */ + lang_codes = malloc( 128 * sizeof( char * ) ); + lang_codes[0] = malloc( 32 * sizeof( char ) ); + lang_codes[0][0] = '\0'; + + if( regcomp( &lang_re, "[<]lang code=['\"]([^'\"<>]*)['\"][>]", REG_EXTENDED ) != 0 ) + { + return( NULL ); /* report error */ + } + + status = regexec( &lang_re, text, (size_t) 2, lang_matches, 0); + + /* If no matches found */ + if (status != 0) { + return NULL; + } + + //printf( "Test: %d, %d.\n", lang_matches[0].rm_so, status ); + + while( regexec( &lang_re, text+offset, 2, lang_matches, 0) == 0 && lang_matches[1].rm_so >= 0 ) /* Found a match */ + { + /* See if this one is new */ + int j = 0; + int found = 0; + + //printf( "Test1.5: %d, %d, %d.\n", lang_matches[1].rm_so, j, *num_codes ); + + for( j = 0; j < *num_codes; j++ ) + { + //printf( "Test1.75: %s.\n", lang_codes[j] ); + /* If this one does not match an old one */ + if( strncmp( lang_codes[j], + text + offset + lang_matches[1].rm_so, + lang_matches[1].rm_eo - lang_matches[1].rm_so + ) == 0 ) + { + found = 1; + } + } + //printf( "Test2: %d, %d, %d, %s.\n", j, *num_codes, found, lang_codes[*num_codes] ); + + /* If we didn't find a match */ + if( found == 0 ) + { + strncpy( lang_codes[*num_codes], + text + offset + lang_matches[1].rm_so, + lang_matches[1].rm_eo - lang_matches[1].rm_so + ); + + lang_codes[*num_codes][lang_matches[1].rm_eo - lang_matches[1].rm_so] = '\0'; + + //printf( "Test2.1: %d, %d, %d, %s.\n", j, *num_codes, found, lang_codes[*num_codes] ); + *num_codes = *num_codes + 1; + + lang_codes[*num_codes] = malloc( 32 * sizeof( char ) ); + lang_codes[*num_codes][0] = '\0'; + //printf( "Test2.2: %d, %d, %d, %s.\n", j, *num_codes, found, lang_codes[*num_codes] ); + } + + offset += lang_matches[1].rm_eo; /* Update the offset */ + } + + regfree( &lang_re ); + + return lang_codes; +} + +/* Looks at the language codes present in the text, and compares + * them with the language codes the user prefers, in order, + * attempting to find the best match. + * + * If no language codes are present in the text, sets + * parse_lang_code to the user's first language preference. + * + * If the user has no language preferences, sets parse_lang_code to + * the first language code found in the text, if any. + * + * Returns 0 if no language codes were found in the text (so we can + * avoid further processing), 1 otherwise. + * */ +void find_best_lang_code( char *text, object *dexml_recipient ) +{ + char **lang_codes; + char *lang_field_file; + char *code_field_file; + FILE *code_field_fp; + char language[256]; + char best_language[256]; + int num_codes=0; + object *lang_obj; + + parse_lang_code = malloc( 256 * sizeof( char ) ); + parse_lang_code[0] = '\0'; + + lang_codes = find_text_lang_codes( text, &num_codes ); + + //printf( "Test3: %s.\n", getenv( "THIS" ) ); + + lang_field_file = fieldfile( dexml_recipient, "language" ); + + if( lang_field_file == NULL ) { + fprintf( stderr, "No language field in avatar %s in dexml.\n", dexml_recipient->dir ); + /* No language preferences */ + strcpy( parse_lang_code, lang_codes[0] ); + return; + } + + lang_obj = getobj( lang_field_file ); + + code_field_file = fieldfile( lang_obj, "code" ); + + if( code_field_file == NULL ) { + /* No language preferences */ + strcpy( parse_lang_code, lang_codes[0] ); + return; + } + + /* What we really want is the language's code file */ + //printf( "Test4: %s.\n",code_field_file ); + + code_field_fp = fopen(code_field_file, "r"); + + if( code_field_fp == NULL ) { + /* No language preferences */ + strcpy( parse_lang_code, lang_codes[0] ); + return; + } + + //printf( "Test5.\n" ); + + /* Check for a match between the language's code and the ones we + * pulled from the text in question. We allow it to be + * mult-line in case one wants aliases or to match extended + * languages like en-uk + */ + while( fgets(language, 256, code_field_fp) != NULL ) + { + + /* This will only run on the first run of the while, as we + * return, so it will only act on the first line of the + * languages field. */ + if( num_codes == 0 ) + { + /* Call it the user's most preferred language; this will be + * used for initial upper case decision making. + * */ + strcpy( parse_lang_code, language ); + //printf("no lang codes found; parse langcode: %s.\n", parse_lang_code ); + return; + } + + /* Kill the newline. */ + language[ strspn( language, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-" ) ] = '\0'; + //printf( "Test6: %s.\n", language ); + int j; + + for( j = 0; j < num_codes; j++ ) + { + /* Look for a match between the codes in the text and + * the languages the avatar will accept, in order of + * acceptance. + * */ + if( strcmp( language, lang_codes[j] ) == 0 ) + { + strcpy( best_language, language ); + /* sprintf( parse_lang_code, "joy: We found %d lang codes; %s, %s; %s.\n", num_codes, lang_codes[0], lang_codes[1], best_language );*/ + //printf( "joy: We found %d lang codes; %s, %s; %s.\n", num_codes, lang_codes[0], lang_codes[1], best_language ); + + strcpy( parse_lang_code, best_language ); + return; + } + } + + } + + /* Else, just return whatever language we saw first in the text. + sprintf( parse_lang_code, "no joy; We found %d lang codes; %s, %s; %s.\n", num_codes, lang_codes[0], lang_codes[1], lang_codes[0] ); + * */ + //printf( "no joy; We found %d lang codes; %s, %s; %s.\n", num_codes, lang_codes[0], lang_codes[1], lang_codes[0] ); + + strcpy( parse_lang_code, lang_codes[0] ); + + //printf("langcode: %s.\n", parse_lang_code ); + + return; +} + + +void replaceWordInText(const char* find, const char* replace, char* text) +{ + /* Cook until done */ + while( 1 ) + { + char *beginning=strstr(text, find); + + if( beginning ) + { + memmove(beginning+strlen(replace), beginning+strlen(find), 1+strlen(beginning+strlen(find))); + strncpy(beginning, replace, strlen(replace)); + } else { + break; + } + } +} + +static void XMLCALL xml_start(void *data, const char *el, const char **attr) +{ + int i; + + //printf("start tag: %s\n", el); + + /* If we found a lang tag, process it looking to see if the code + * matches */ + if( strcmp( el, "lang" ) == 0 ) + { + //printf( "lang start tag found.\n" ); + /* Increase our depth within the skip block, if this is a + * valid lang tag */ + if( skip == 1 ) + { + //printf( "lang start tag found in skip block.\n" ); + /* Look for a code attribute; otherwise this is an + * invalid lang tag, so we ignore it. + */ + for (i = 0; attr[i]; i += 2) + { + //printf("start tag attr: %s='%s', %s\n", attr[i], attr[i + 1], parse_lang_code); + if( strcmp( attr[i], "code" ) == 0 ) + { + skip_depth++; + //printf( "Increasing skip depth to %d.\n", skip_depth ); + } + } + //printf( "done with lang start tag found in skip block.\n" ); + } else { + /* Not skipping, find out if we should be. */ + for (i = 0; attr[i]; i += 2) + { + //printf("start tag attr: %s='%s', %s\n", attr[i], attr[i + 1], parse_lang_code); + if( strcmp( attr[i], "code" ) == 0 ) + { + if( strcmp( attr[i + 1], parse_lang_code ) == 0 ) + { + //printf( "best lang found.\n" ); + } else { + //printf( "non-best lang found.\n" ); + skip = 1; + skip_depth = 0; + } + } + } + } + } else if( strcmp( el, "document" ) == 0 ) { + /* If tag is the artificially added tag, drop it + */ + ; + } else if( skip == 1 ) { + /* Drop all skipped tags, unless otherwise handled above */ + ; + } else if( strcmp( el, "mspace" ) == 0 ) { + /* is used where we want a space, but only if + * there isn't already one just in front. This is for + * articles; the article in one language might be blank, so + * we can't just put in spaces every time. + */ + if( ! trailing_space ) + { + strcat( parse_result, " " ); + } + } else if( strcmp( el, "initial" ) == 0 ) { + /* The tag is added by msg.c to point out the + * place where the next non-tagged character should be + * counted as in initial character in a string in languages + * that have that sort of thing. + */ + //printf( "Initial tag found.\n" ); + if( uc_initial_lang ) + { + //printf( "UC next set.\n" ); + uc_next = 1; + } + } else { + /* If the tag is not a tag we want to process, preserve it */ + + strcat( parse_result, "<" ); + strcat( parse_result, el ); + + for (i = 0; attr[i]; i += 2) + { + strcat( parse_result, " " ); + strcat( parse_result, attr[i] ); + strcat( parse_result, "=" ); + strcat( parse_result, attr[i + 1] ); + } + + strcat( parse_result, ">" ); + //printf( "Updated p_r: %s.\n", parse_result ); + } + + //printf("\n"); +} + +static void XMLCALL xml_end(void *data, const char *el) +{ + //printf("end tag: %s, %d, %d\n", el, skip, skip_depth); + + if( strcmp( el, "lang" ) == 0 ) + { + /* Decrease our depth within the skip block */ + if( skip == 1 ) + { + skip_depth--; + //printf( "Decreasing skip depth to %d.\n", skip_depth ); + } + + /* If this is the end of the outermost skip block, stop + * skipping. */ + if( skip_depth < 0 ) + { + skip = 0; + skip_depth = 0; + //printf( "Turning skip off.\n"); + } + } else if( strcmp( el, "document" ) == 0 ) { + /* If tag is the artificially added tag, drop it + */ + ; + } else if( skip == 1 ) { + /* Drop all skipped tags, unless otherwise handled above */ + ; + } else if( strcmp( el, "mspace" ) == 0 ) { + /* We only use the end tag. Discard. */ + ; + } else if( strcmp( el, "initial" ) == 0 ) { + /* We only use the end tag. Discard. */ + ; + } else { + /* If the tag is not a tag we want to process, preserve it */ + strcat( parse_result, "" ); + } + +} + +/* Upper cases the first alphabetic character in the string. */ +void upper_case_next( char *scratch ) +{ + /* Walk the string for the first alphabetic + * character and uppercase it. + * */ + int i; + + for( i = 0; i < strlen( scratch ); i++ ) + { + if( isalpha( scratch[i] ) ) + { + scratch[i] = toupper( scratch[i] ); + /* Reset the flag to upper-case the next character */ + uc_next = 0; + break; + } + } +} + +static void XMLCALL char_data_handler(void *data, const char *el, int len) +{ + char *scratch; + + /* Give extra space because of the < to < expansion. */ + scratch = malloc( ( ( len * 2 ) + 1 ) * sizeof( char ) ); + scratch[0] = '\0'; + + if( skip == 0 ) + { + //printf("YES char data: %d, %.*s\n", len, len, el); + + strncat( scratch, el, len ); + + /* If we need to upper case the next letter, go and do it. + */ + if( uc_next ) + { + upper_case_next( scratch ); + } + + /* Don't want to break privledged tag protection. */ + replaceWordInText( "<", "<", scratch ); + replaceWordInText( ">", ">", scratch ); + + strcat( parse_result, scratch ); + + /* Look for a space at the end of the text */ + if( isblank( el[ len - 1] ) ) + { + //printf( "Setting trailing space based on: %c from %.*s.\n", el[ len - 1], len, el ); + trailing_space = 1; + } else { + //printf( "Unsetting trailing space based on: %c from %.*s.\n", el[ len - 1], len, el ); + trailing_space = 0; + } + + //printf( "Updated p_r: %s.\n", parse_result ); + } else { + //printf("NO char data: %d, %.*s\n", len, len, el); + } + + free( scratch ); +} + +/* Attempt to parse text, putting the raw text into parse_result if + * an error occurs. + */ +void my_parse( char *text, int length ) +{ + char *original_parse_result_end; + char *fixed_text; + + XML_Parser p = XML_ParserCreate(NULL); + + if (! p) { + //fprintf(stderr, "Couldn't allocate memory for parser\n"); + exit(-1); + } + + XML_SetElementHandler(p, xml_start, xml_end); + XML_SetCharacterDataHandler(p, char_data_handler); + + /* Mark the current end of parse_result in case we need + * to blow away what we've done because of an XML error. + */ + original_parse_result_end = &parse_result[strlen(parse_result)]; + + fixed_text = malloc( ( ( length * sizeof( char ) ) + 128 ) * 2 ); + fixed_text[0] = '\0'; + + sprintf( fixed_text, "%.*s", length, text ); + + //fprintf( stderr, "my_parse langcode: %s.\n", parse_lang_code ); + //fprintf( stderr, "my_parse fixed text: %s.\n", fixed_text ); + + if( XML_Parse(p, fixed_text, strlen( fixed_text ), 1) == XML_STATUS_ERROR ) + { + /* Copy the de-tagged text to parse_result */ + original_parse_result_end[0] = '\0'; + strncat( parse_result, text, length ); + + /* Put the terminator back in. */ + text[length] = '\0'; + //printf( "parse result after error: %s.\n", parse_result ); + } + + /* Reset all parsing flags. */ + skip=0; + skip_depth=0; +} + +/* Remove xml tags from the text. is supported; marked up + * in bold alter down the stream, all else are ignored. Also handle + * entities. In the vast majority of cases, uses dexml_recipient, + * which is an avatar, to determine the preferred language, but in + * some cases (read: parsers), uses the language argument instead. + */ +char *dexml( char *text, object *dexml_recipient, char *language ) +{ + int len; + + //fprintf( stderr, "In dexml.\n", text ); + + if( text ) + { + len = strlen(text); + } else { + return ""; + } + + if (len == 0) + { + return ""; + } + + //fprintf( stderr, "dexml pre: %s.\n", text ); + + /* Allocate some extra space (double, in fact, plus some extra + * for the xml header crap) for XML processing to increase the + * size of the string + */ + parse_result = malloc( ( ( len * sizeof( char ) ) + 128 ) * 2 ); + + parse_result[0] = '\0'; + + /* Only check the avatar's language if we weren't passed an + * explicit language code. + */ + if( dexml_recipient && ( ! language || strlen( language ) == 0 ) ) + { + //fprintf( stderr, "dexml recip: %s.\n", dexml_recipient->dir ); + find_best_lang_code( text, dexml_recipient ); + } else { + if( language ) + { + //fprintf( stderr, "dexml lang: %s.\n", language ); + parse_lang_code = language; + } else { + return text; + } + } + + //fprintf( stderr, "still in dexml.\n" ); + + /* Make sure we have a terminating null before any wierd + * characters, like newline. Even in C there has to be a + * better way to do this. */ + parse_lang_code[ strspn( parse_lang_code, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-" ) ] = '\0'; + + //fprintf( stderr, "dexml parse_lang_code: %s.\n", parse_lang_code ); + + /* Don't run XML processing if we've got no lang codes at all. + */ + if( parse_lang_code != NULL && parse_lang_code[0] != '\0' ) + { + char *lang_field_file; + char *uc_initial_lang_file; + FILE *uc_initial_lang_fp; + + /* Set uc_initial to zero if we were passed a lang code; + * should only be used by short text blocks passed by + * parsers. + */ + if( language && strlen( language ) > 0 ) + { + uc_initial_lang = 0; + } else { + /* Only find out about upper case initial status if we + * weren't passed a language code. + */ + + /* Find the list of languages that have their initial + * letter upper-cased (i.e., most romance languages) */ + lang_field_file = fieldfile( dexml_recipient, "language" ); + + if( lang_field_file != NULL ) + { + object *lang_obj; + lang_obj = getobj( lang_field_file ); + + uc_initial_lang_file = fieldfile( lang_obj, "upper_case_initial" ); + + if( uc_initial_lang_file != NULL ) + { + //printf( "uc_initial_lang_file: %s.\n", uc_initial_lang_file ); + uc_initial_lang_fp = fopen(uc_initial_lang_file, "r"); + + if( uc_initial_lang_fp != NULL ) + { + char flag_string[8]; + + if( fgets(flag_string, 8, uc_initial_lang_fp) != NULL ) + { + int flag; + + /* Grab the field as an integer; it's either 0 or 1 */ + flag = strtol(flag_string, (char **)NULL, 10); + if( flag ) + { + uc_initial_lang = 1; + } + } + } + } + } + } + + //fprintf( stderr, "Language UC initial is %d.\n", uc_initial_lang ); + + my_parse( text, strlen(text) ); + + //fprintf( stderr, "dexml post: %s.\n", parse_result ); + return parse_result; + } else { + return text; + } +} Index: bindings/c/Makefile =================================================================== --- bindings/c/Makefile (revision 23) +++ bindings/c/Makefile (working copy) @@ -10,7 +10,7 @@ CFLAGS += -g -fPIC -DPIC -Wall $(LIB): $(objs) - $(CC) $(CFLAGS) -lc -shared -Wl,-soname -Wl,$(LIB).$(SONAME) $(objs) -o $(LIB).$(SONAME) + $(CC) $(CFLAGS) -lexpat -lc -shared -Wl,-soname -Wl,$(LIB).$(SONAME) $(objs) -o $(LIB).$(SONAME) rm -f $(LIB) $(LN_S) $(LIB).$(SONAME) $(LIB) Index: INSTALL =================================================================== --- INSTALL (revision 23) +++ INSTALL (working copy) @@ -58,6 +58,14 @@ /etc/ld.so.conf to list the directory the mooix libraries were installed into, and run ldconfig. + To install to somewhere other than the location the code + will be running at (something like a chroot or VServer, + where mood might be in /usr/sbin/mood but you want to + install to /chroot/path/usr/sbin/moot) run make install as + follows: + + make PREFIX=[wierd installation path] install + Initialization ============== Index: mooix.conf =================================================================== --- mooix.conf (revision 23) +++ mooix.conf (working copy) @@ -16,33 +16,33 @@ # running at a time in the moo, and more is better. Mood will only use # users in this space as scratch users if they have no entries in the # password file at the time it is started up. -LOWUID=31000 -HIGHUID=32000 +LOWUID=3000 +HIGHUID=4000 # Base of the moo object tree. Please note that you can change this at # build time, but it's fairly rooted to this location once installed. -MOOROOT=$(localstatedir)/lib/mooix +MOOROOT=/var/lib/mooix # Distributed objects. This directory holds all the static mooix # objects that are distributed with mooix. -DISTOBJ=$(libdir)/mooix +DISTOBJ=/usr/lib/mooix # These are objects that have the same powers as the moo admin, but more # limited purposes. Note that the order is significant; the first object # listed should be the one most often used. -MOOADMINOBJ=$(localstatedir)/lib/mooix/abstract/physics -MOOADMINOBJ=$(localstatedir)/lib/mooix/system/heartbeat +MOOADMINOBJ=/var/lib/mooix/abstract/physics +MOOADMINOBJ=/var/lib/mooix/system/heartbeat # This is the object that is the moo admin. It can modify any field of any # other object. -MOOADMINOBJ=$(localstatedir)/lib/mooix/system/admin +MOOADMINOBJ=/var/lib/mooix/system/admin # This string is prefixed to the user names of new users who register for # moo accounts. It should be short, since there are only 8 characters # available for the whole name on most systems. -MOOUSERPREFIX=m- +MOOUSERPREFIX= # Newly registered users will get this type of avatar. -PARENTAVATAR="$(localstatedir)/lib/mooix/abstract/avatar" +PARENTAVATAR="/var/lib/mooix/abstract/avatar" # This command is run at moo startup time. STARTHOOK="cd $MOOROOT/system/init && runmeth startup" @@ -55,7 +55,7 @@ # Some commands, like moologin, need a sanitized PATH, not the one from the # environment. This sets that path. -SAFEPATH=/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:$(sbindir) +SAFEPATH=/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/sbin # The following variables set hard resource limits for the mood daemon, and # the mooix methods it executes. @@ -89,10 +89,10 @@ # part of a single method. It is useful to prevent methods from fork bombing # the moo. This does not influence the number of methods that may run at # once. For that you can make the gap between HIGHUID and LOWUID be small. -RLIMIT_NPROC=10 +RLIMIT_NPROC=128 # # The maximum number of files that a process can open at a time. -RLIMIT_NOFILE=100 +RLIMIT_NOFILE=1024 # # The total amount of memory a process can get. #RLIMIT_AS= Index: MULTILINGUAL =================================================================== --- MULTILINGUAL (revision 0) +++ MULTILINGUAL (revision 0) @@ -0,0 +1,21 @@ +mooix now has full support for multilingual MOOs, that is, MOOs in +which different users are interacting with the MOO, and seeing the +MOO presented in, different languages. + +For details of how to set this up for new languages can be found by +doing "help multilingual" in the MOO itself. + +All of this work was done by Robin Powell, aka +rlpowell@digitalkingdom.org; all comments, questions, and bug +reports on the multilingual code should be directed to him. + +PLEASE NOTE: No work was done on UTF-8 or other high byte handling! + +The language I was using (Lojban, see http://www.lojban.org/) is +expressible in ASCII, and I don't know enough C or enough about +UTF-* to know how to make things work properly at the C level. + +I would be VERY HAPPY if someone else made mooix UTF-8 safe! + +-Robin Lee Powell, 2 Jan 2005 + Index: obj/mixin/mcp/simpleedit/receive_set =================================================================== --- obj/mixin/mcp/simpleedit/receive_set (revision 23) +++ obj/mixin/mcp/simpleedit/receive_set (working copy) @@ -15,5 +15,5 @@ } return $this->avatar->edit_finish(session => $this, value => $content, - id => $_{reference}); + id => $_{reference}, avatar => $this->avatar ); } Index: obj/mixin/parser/supply.msg =================================================================== --- obj/mixin/parser/supply.msg (revision 0) +++ obj/mixin/parser/supply.msg (revision 0) @@ -0,0 +1 @@ +The parser believes that you need to supply the following parts of speech: $incompletes. Index: obj/mixin/parser/pronouns =================================================================== --- obj/mixin/parser/pronouns (revision 23) +++ obj/mixin/parser/pronouns (working copy) @@ -1,31 +0,0 @@ -it -its -me -myself -I -my -here -you -your -her -she -he -him -his -us -our -them -their -this -these -that -those -everything -everythings -everyone -everyones -anything -anythings -all -any -each Index: obj/mixin/parser/wtf.msg =================================================================== --- obj/mixin/parser/wtf.msg (revision 0) +++ obj/mixin/parser/wtf.msg (revision 0) @@ -0,0 +1 @@ +I have no idea what you said. I see no verb. Index: obj/mixin/parser/grammar =================================================================== --- obj/mixin/parser/grammar (revision 23) +++ obj/mixin/parser/grammar (working copy) @@ -1,302 +0,0 @@ -#!/usr/bin/perl (more or less) - -# This file contains the Parse::RecDescent grammar used by the parser to -# deconstruct imperative sentences. -# -# The resulting parser builds and returns a parse tree. -# The form of the tree is a list of hashes (sentences). -# The sentance hashes can have keys named verb, direct_object, -# indirect_object, do_preposition, io_preposition, and quote -# (and a couple more weird ones). -# -# Thank god for HyperGrammar! -# - -# Handle compound sentences, and multiple sentences too. -input: sentence (sentence_separator sentence)(s?) sentence_punct(?) - { $item[2] ? [ $item[1], @{$item[2]} ] : [ $item[1] ] } -sentence_separator: /$/ | sentence_punct(?) coordinating_conjunction(s) | sentence_punct - -# All the sentence forms. The ordering is quite important. I've tried to -# put the most commonly used forms first, so they'll be faster. Note that -# the use of lookahead is important in getting those fast, commonly-used -# forms to not match on subsets of longer sentences. -# -# Once each sentence is parsed, a call to main::recent_obj() is made, -# passing in any recently referred to objects. This is generally used to -# set up the 'it' and 'them' prepositions, or similar. - -# Talking is quick to match. -sentence: verb quote ...sentence_separator - { { verb => $item[1], quote => $item[2] } } -# This form is used to invoke the name of an exit to use it. -# (It can also be used to answer some questions.) It needs to come before -# the verb direct_object form. Probably calling recent_obj here would just -# be confusing. -sentence: object ...sentence_separator - { { direct_object => $item[1] } } -# "sit down", "get up", etc. Has to come before the verb direct_object form. -sentence: verb preposition ...sentence_separator - { { verb => $item[1], preposition => $item[2] } } -# Probably the most common sentence form. -sentence: verb direct_object ...sentence_separator - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2] } } -# This form is used to "pick up foo", etc. -sentence: verb do_preposition direct_object ...sentence_separator - { &::recent_obj(@{$item[3]}); - { verb => $item[1], do_preposition => $item[2], - direct_object => $item[3] } } -# This form is used in eg, "put it down" or "wind it up". -sentence: verb direct_object do_preposition ...sentence_separator - { &::recent_obj(@{$item[2]}); - { verb => $item[1], do_preposition => $item[3], - direct_object => $item[2] } } -# "put blah in foo", etc is quite common. -sentence: verb do_preposition(?) direct_object io_preposition(?) indirect_object - { &::recent_obj(@{$item[3]}); # which object? Dunno. :-/ - { verb => $item[1], do_preposition => $item[2][0], - direct_object => $item[3], io_preposition => $item[4][0], - indirect_object => $item[5] } } -# Not exactly sentences per se, but support answers to recently asked -# questions. That generally involves picking a choice from a list or -# answers, either by name or number. Or it might involve referring to a -# particular object, or be a prepositional phrase. -sentence: article(?) answer(s) ...sentence_separator - { { answer => $item{'answer(s)'} } } -sentence: article(?) number ...sentence_separator - { { number => $item{number} } } -sentence: do_preposition object ...sentence_separator - { { direct_object => $item{object}, - do_preposition => $item{do_preposition} } } -# Simple commands are way up there too (but must come after the simple -# question answer forms). -sentence: verb ...sentence_separator - { { verb => $item[1] } } - -# This is a gross special case for a few commands that take a field as -# their last argument. -fieldverb: /(show|showall|set|unset|edit|delete|usage|help|go|list)\b/i -# A special terminator is needed to disambiguate from things like -# "show ball then drop it", where "then" could be misinterpreted as a -# field. -# Must come before the verb quote direct_object form. -sentence: fieldverb do_preposition(?) possessive_object field ...sentence_separator - { &::recent_obj(@{$item[3]}); - { verb => $item[1], do_preposition => $item[2][0], - direct_object => $item[3], field => $item[4] } } -sentence: fieldverb do_preposition(?) possessive_object number field ...sentence_separator - { &::recent_obj(@{$item[3]}); - { verb => $item[1], do_preposition => $item[2][0], - direct_object => $item[3], number => $item[4], field => $item[5] } } -# Used for the help command. -sentence: fieldverb do_preposition(?) field ...sentence_separator - { { verb => $item[1], do_preposition => $item[2][0], field => $item[3] } } - -# "say "blah" to him", "derive a "ball" from foo", etc. -# This is strictly speaking, an indirect object, not a direct object. -# However, it simplfies processing to treat it like a direct object. -sentence: verb do_preposition(?) article(?) quote io_preposition direct_object - { &::recent_obj(@{$item[6]}); - { verb => $item[1], quote => $item[4], - do_preposition => $item[5], direct_object => $item[6] } } - -# Now some declarative sentence forms. Matching a possessive object is -# expensive, so do it only once. -sentence: possessive_object declaration - { &::recent_obj(@{$item[1]}); - { direct_object => $item[1], %{$item[2]} } } - -# Stuff like "it's not hidden". -declaration: ess /\bnot\b/i field ...sentence_separator - { { verb => "is", field => $item[3], negated_verb => 1 } } -# "it's hidden", etc -declaration: ess field ...sentence_separator - { { verb => "is", field => $item[2] } } -# "I'm not benchmarked" -declaration: /'?m?\b/i /\bnot\b/i field ...sentence_separator - { { verb => "am", field => $item[3], negated_verb => 1 } } -# "I'm benchmarked" -declaration: /'?m?\b/i field ...sentence_separator - { { verb => "am", field => $item[2] } } -# Used, for example, to just say what a field's value is, to set it. -declaration: field verb quote - { { field => $item[1], verb => $item[2], quote => $item[3] } } -# Similar form can be used (by builders) to say that an object's field is a -# reference to another object. -declaration: field verb indirect_object - { { field => $item[1], verb => $item[2], indirect_object => $item[3] } } -# This is used to set metadata about fields. -declaration: field verb field number - { { field => $item[1], verb => $item[2], - metadata => $item[3], number => $item[4] } } -# Even a list of references could be set. -declaration: number field verb indirect_object - { { number => $item[1], field => $item[2], - verb => $item[3], indirect_object => $item[4] } } -# A number can also be given, if there are multiple values of a field. -declaration: number field verb quote - { { number => $item[1], field => $item[2], - verb => $item[3], quote => $item[4] } } -# This is used to set and unset boolean fields. -declaration: negated_verb field - { { verb => $item[1], field => $item[2], negated_verb => 1 } } -declaration: verb field - { { verb => $item[1], field => $item[2] } } - -# These forms are used by the signal command. -sentence: verb direct_object preposition(?) number - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2], number => $item[4] } } -sentence: verb direct_object quote preposition(?) number - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2], quote => $item[3], - number => $item[5] } } - -# And this is is used for dialing telephones. I suppose it could be used -# for signals too.. Like the verb quote direct_object form, the object is -# really indirect, but we'll call it the direct object for simplicity. -sentence: verb do_preposition(?) number io_preposition direct_object - { &::recent_obj(@{$item[5]}); - { verb => $item[1], number => $item[3], - do_preposition => $item[4], direct_object => $item[5] } } - -# "call me "Fred"", "rename me to "Fred"", etc. Must come after the -# declarative forms, otherwise the quote matches too freely. -sentence: verb do_preposition(?) direct_object io_preposition(?) quote - { &::recent_obj(@{$item[3]}); - { verb => $item[1], do_preposition => $item[2][0], - direct_object => $item[3], io_preposition => $item[4][0], - quote => $item[5] } } - -# This wacky form is used for digging. -sentence: verb quote io_preposition quote - { { verb => $item[1], quote => $item[2], io_preposition => $item[3], - quote2 => $item[4] } } # XXX there must be a better name than "quote2"? - -# These forms are used to do stuff with fields. -sentence: verb possessive_object field io_preposition quote - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2], - field => $item[3], quote => $item[5] } } -sentence: verb possessive_object field io_preposition indirect_object - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2], - field => $item[3], indirect_object => $item[5] } } -sentence: verb possessive_object number field io_preposition quote - { &::recent_obj(@{$item[2]}); - { verb => $item[1], direct_object => $item[2], - number => $item[3], field => $item[4], quote => $item[6] } } - -# For the eval command. -sentence: verb quote io_preposition field ...sentence_separator - { { verb => $item[1], quote => $item[2], io_preposition => $item[3], - field => $item[4] } } - -# This is a repeat of the simple sentence form, but it does not require an -# obvious separator. The only reason for this is to make reinjection work -# for stuff like "say hi" -- this parses the verb, then the "hi" is quoted -# and the lot is re-injected. -# This should be the last sentence type listed. -sentence: verb - { { verb => $item[1] } } - -# End of the entences, now on to the parts of speech.. - -direct_object: objectlist -indirect_object: object -# Allows for multiple prepositions to be used before a direct object. They -# are joined together into one. -do_preposition: preposition(s) - { join(" ", @{$item[1]}) } -io_preposition: preposition -objectlist: object (/(?:(?:,\s*)?and|,)/ object)(s?) - # Flatten the nested lists into one list ref. - { [ $item[2] ? ( @{$item[1]}, map { @{$_} } @{$item[2]} ) : @{$item[1]} ] } - -# "foo's bar" -object: basic_object ess object - { &::is_obj_in_obj($item[3], "", $item[1]) } -# "my bar" -object: basic_object object - { &::is_obj_in_obj($item[2], "", $item[1]) } -# "bar in foo". Note that multiple prepositions might be used; all must -# match. -object: basic_object preposition(s) object - { &::is_obj_in_obj($item[1], $item[2], $item[3]) } -# Quantifying the number of objects expected can resolve possible -# ambiguities. -object: /(a\b)?/ quantifier /(of\b)?/ object - { &::check_quantification($item{quantifier}, $item{object}) } -# Must some after the quantified object test, because "all" could be part -# of a quantification, or a preposition. -object: basic_object -# Another form of quantification, a trifle expensive. -object: number /(of)?/ basic_object - { &::check_quantification($item{number}, $item{basic_object}) } - -possessive_object: object ess - { $item[1] } - -# This is the set of simple ways to refer to an object, and is used as the -# base for both regular and possessive forms of objects. -basic_object: pronoun - { &::lookup_pronoun($item{pronoun}) } -basic_object: article(?) /mooix:([^ ]+)/ - { &::lookup_reference($1) } -basic_object: article(?) adjectivelist noun - { &::lookup_noun($item{noun}, $item{adjectivelist}) } -# This version is needed for cases like 'red guest', where red is a known -# adjective, but it's actually being used as part of the noun instead. -basic_object: article(?) noun - { &::lookup_noun($item{noun}) } -# A production without the article in front, in case the noun seems to strt -# with an article (probably due to user confusion). -basic_object: noun - { &::lookup_noun($item{noun}) } - -adjectivelist: - -number: /[-+.\w]+\b/ - # lookup_number is passed a textual representation of a number, and - # should return the number so represented, or undef on error - { { &::lookup_number($item[1]) } } - -# Single or double quoted text. Allow the closing quote to be left off, if -# the text extends to end of string without one. This also recognizes stuff -# bracketed by {..} as a quote. This special style is used by the shortcuts -# substitutions, to unambiguously quote text that may contain other quote -# characters. Quotes can have a comma before them. -quote: /,?\s*(?:"([^"]*)(?:"|$)|{(.*)})/ { $1.$2 } -# Things like object field names. Note that they cannot end in a period; -# that would be ambiguous with a period at the end of a sentence. -field: /[-_.+A-Za-z0-9]*[-_+A-Za-z0-9]/ - -# This only works for verbs like 'is' in declarative sentence forms. -negated_verb: verb /not\b/i - { $item[1] } -negated_verb: /($::verbs)n't\b/i - { $1 } - -# Some of the parts of speech are broken out into variables in main; -# these variables must be defined before asking the parser to parse -# something, and can be changed as needed between parsings w/o rebuilding -# the whole parser. This makes it easy to eg, populate $::nouns with all -# the names of all the objects the user could refer to. Set the variables -# to compiled regexp's, that | together the possibilities. Like: -# $::nouns=qr/cat|dog/; -preposition: /($::prepositions)\b/i -adjective: /($::adjectives)\b/i -noun: /($::nouns)\b/i -verb: /($::verbs)\b/i -# The \b is necessary, since "i" is a pronoun, and that could match at the -# start of other words. -pronoun: /($::pronouns)\b/i -# Matches answers to a recent question. -answer: /($::answers)/i -quantifier: /($::quantifiers)/i - -article: /(an|a|the)\b/i -coordinating_conjunction: /(and|then|next)\b/i -ess: /'?s?\b/i -sentence_punct: /[,;.!]+/ Index: obj/mixin/parser/confused.msg =================================================================== --- obj/mixin/parser/confused.msg (revision 0) +++ obj/mixin/parser/confused.msg (revision 0) @@ -0,0 +1 @@ +I'm sorry, either what you're asking to do isn't possible, or you've managed to confuse me. Index: obj/mixin/parser/pronouns.inf =================================================================== --- obj/mixin/parser/pronouns.inf (revision 23) +++ obj/mixin/parser/pronouns.inf (working copy) @@ -1,2 +0,0 @@ -This field needs to have a list of every pronoun the parser will -recognize. Index: obj/mixin/parser/prepositions =================================================================== --- obj/mixin/parser/prepositions (revision 23) +++ obj/mixin/parser/prepositions (working copy) @@ -1,60 +0,0 @@ -as -about -above -across -after -against -along -among -around -at -before -behind -below -beneath -beside -between -beyond -but -by -despite -down -during -except -for -from -inside -into -in -like -near -off -of -onto -on -outside -out -over -past -since -throughout -through -till -toward -to -underneath -under -until -upon -up -within -without -with -called -named -held -carried -away -using -front -top Index: obj/mixin/parser/compilegrammar =================================================================== --- obj/mixin/parser/compilegrammar (revision 23) +++ obj/mixin/parser/compilegrammar (working copy) @@ -1,20 +1,29 @@ #!/usr/bin/perl #use Mooix::Thing; use Parse::RecDescent; -run sub ($) { - my $this=shift; +run sub { + my $this=shift; + %_ = @_; + my $avatar=$_{avatar}; - # Only compile the grammar if it is newer than the compiled form. - my $gpm = $this->fieldfile("Grammar.pm"); - my $gra = $this->fieldfile("grammar"); - if (! $gpm || (stat($gpm))[9] < (stat($gra))[9]) { - # Output to "myGrammar", then rename, so the update is atomic. - Parse::RecDescent->Precompile(scalar $this->grammar, "myGrammar"); - rename("myGrammar.pm", "Grammar.pm") || die "rename: $!"; - # Mark it as a method. This prevents show from trying to display - # the whole thing.. - chmod(0755, "Grammar.pm"); - } + # Only compile the grammar if it is newer than the compiled form. + my $gpm = $this->fieldfile("Grammar.pm"); + my $gra = $avatar->language->fieldfile("grammar"); - return 1; + if (! $gpm || (stat($gpm))[9] < (stat($gra))[9]) { + + # Output to "my[code]Grammar", then rename, so the update is atomic. + my $gram = "my" . $avatar->language->code . "Grammar"; + my $pm = $avatar->language->code . "Grammar.pm"; + + Parse::RecDescent->Precompile( scalar $avatar->language->grammar, $gram ); + + rename( $gram . ".pm", $pm ) || die "rename: $!"; + + # Mark it as a method. This prevents show from trying to display + # the whole thing.. + chmod(0755, $pm ); + } + + return 1; } Index: obj/mixin/parser/grammar.inf =================================================================== --- obj/mixin/parser/grammar.inf (revision 23) +++ obj/mixin/parser/grammar.inf (working copy) @@ -1,2 +0,0 @@ -This is a Parse::RecDescent grammar for parsing imperative English -sentences. Index: obj/mixin/parser/disambig.msg =================================================================== --- obj/mixin/parser/disambig.msg (revision 0) +++ obj/mixin/parser/disambig.msg (revision 0) @@ -0,0 +1 @@ +Which one of $choices do you mean? Index: obj/mixin/parser/prepositions.inf =================================================================== --- obj/mixin/parser/prepositions.inf (revision 23) +++ obj/mixin/parser/prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field needs to have a list of every preposition the parser will -recognize. Index: obj/mixin/parser/parse =================================================================== --- obj/mixin/parser/parse (revision 23) +++ obj/mixin/parser/parse (working copy) @@ -13,6 +13,7 @@ #use Mooix::Thing; #use Mooix::Verb; #use Mooix::Root; +use Data::Dumper; # This is used to mark a Mooix::Thing as coming from a reference. use constant ISREF => Mooix::Thing::_LAST_FIELD + 1; @@ -20,184 +21,307 @@ use constant ISAMB => Mooix::Thing::_LAST_FIELD + 2; # These are referenced by the grammar, and it's up to us to provide them. -use vars qw{$prepositions $pronouns $adjectives $verbs $nouns $answers - $quantifiers}; +use vars qw{$prepositions $relative_tags $pronouns $languages $adjectives + $verbs $nouns $answers $quantifiers}; -# Some global variables used by the subs below (too many, sigh). #{{{ -our @known; # objects the user might be referring to -our @all; # object's we're sure the user knows about, that "all" - # can refer to. -our %nametoobj; # map names to objects. Hash values are arrays. -our %adjtoobj; # map adjectives to the objects that have them -our %pronouns; # map pronouns to objects. Hash values are arrays. -our $loop; # set to 0 to stop the loop from looping -our $session; # set to the session that is being parsed for -our $caller; # set to the avatar that we're acting for -our $stop; # set to 1 to stop processing of the current command -our $parser; # parser object -our $anshandler; # this sub is run if the user seems to aswer a question -our $timings; # set to true to make timing info be output -our $failreason; # why a command couldn't be run (short phrase) -our %incomplete; # if a command can't be run, this holds parts of speech - # that might be missing -our $interceptor; # may be set to a command interceptor verb -our @prompt; # prompt to use for command gathering (optional) -our $dynprompt; # set if prompt is a method -our $debugger; # set the the debugger object, if the user is debugging -#}}} +# This has actually has its values set by the language object, for +# use by the grammar. Basically, it lets the language direct the +# grammar without interference from the "parser". +use vars qw{%lang_to_grammar}; +# Some global variables used by the subs below (too many, sigh). +# objects the user might be referring to +our @known; +# object's we're sure the user knows about, that "all" can refer to. +our @all; +# map names to objects. Hash values are arrays. +our %nametoobj; +# map adjectives to the objects that have them +our %adjtoobj; +# map pronouns to objects. Hash values are arrays. +our %pronouns; +# set to 0 to stop the loop from looping +our $loop; +# set to the session that is being parsed for +our $session; +# set to the avatar that we're acting for +our $caller; +# set to 1 to stop processing of the current command +our $stop; +# parser object +our $parser; +# this sub is run if the user seems to aswer a question +our $anshandler; +# set to true to make timing info be output +our $timings; +# why a command couldn't be run (short phrase) +our $failreason; +# if a command can't be run, this holds parts of speech +our %incomplete; +# that might be missing +# may be set to a command interceptor verb +our $interceptor; +# prompt to use for command gathering (optional) +our @prompt; +# set if prompt is a method +our $dynprompt; +# set the the debugger object, if the user is debugging +our $debugger; +# Ignore all other languages in strings we pull from objects +our $best_lang_code; +# The name of the part of the parse tree that the .cmd files are +# named after. +our $cmd_parse_command; +# A list of the names of the parts of the parse tree that return +# objects and have object-related limits applied to them. +our @cmd_parse_object; +# Command substitutions +our $subst; + +sub strip_xml { + my $lang_code; + $_ = $_[0]; + + # If lang code tags are found + if( m/]*\1>/ ) + { + my $quote_char = $1; + if( m/]*$quote_char>/ ) + { + # If lang code tags of the kind we like are found, use that + $lang_code = $best_lang_code; + } else { + # Else use the first lang code we see + m/]*)$quote_char>/; + $lang_code = $1; + } + # Get rid of all text for non-matching lang tags + # Does not handle nesting, but shouldn't have to + s/]*$quote_char>.*?<\/lang>//g; + + # Get rid of the remaining lang tags. + s/]*$quote_char>//g; + s/<\/lang>//g; + } + + return $_; +} + + # Examine the environment for settings. This is recalled if the parser is # hupped. sub init { #{{{ - # Allow timing info to be output by setting a field in the avatar. - $timings = $caller->benchmarked; - $interceptor = $caller->command_interceptor; - $dynprompt=0; - if ($caller->defines("prompt")) { - if ($caller->implements("prompt")) { - $dynprompt=1; - # prompt is gathered before every command - } - else { - # gather prompt once - @prompt = (prompt => $caller->prompt); - } + # There are no answers, at first. + $answers = genregex(); + + # Let a verb be anything that looks like a word. Starting the + # beginning of a sentence is enough of a disambiguator. + $verbs = qr/\w+/; + + $best_lang_code=$caller->language->code; + $cmd_parse_command = $caller->language->cmd_parse_command; + @cmd_parse_object = $caller->language->cmd_parse_object; + + # Set up a few of the parts of speech that don't change + # dynamically. These are referenced by the grammar. + $prepositions = genregex($caller->language->prepositions); + $relative_tags = genregex($caller->language->relative_tags); + $pronouns = genregex($caller->language->pronouns); + + # Get the language to set up some more complicate stuff for us + my $gv = $caller->language->fieldfile("grammar_variables"); + + if( $gv ) + { + do $gv; + } + + # Use the languages list thus generated. + $languages = genregex( @{$lang_to_grammar{languages}} ); + + # To cut down on startup speed, use the precompiled Grammar.pm, unless + # the grammar file is newer. + my $gram = $caller->language->code . "Grammar"; + my $gpm = $caller->fieldfile( $gram . ".pm" ); + my $gra = $caller->language->fieldfile( "grammar" ); + + if (! $gpm || (stat($gpm))[9] < (stat($gra))[9]) { + $session->write("Compiling grammar, please wait.."); + $caller->parser_compilegrammar( avatar => $caller ); + $gpm = $caller->fieldfile( $gram . ".pm" ); + } + do $gpm; #sorta gross, but what the hey + + # It's "my[code]Grammar" because that's the module name used. See + # compilegrammar. + my $gram2 = "my" . $caller->language->code . "Grammar"; + $parser = $gram2->new; + + # Load in file and compile a sub to do preparsing substitutions. + $subst = eval 'sub { $_=shift;'.$caller->parser_shortcuts."\n".';$_}'; + if ($@) { + $subst = sub {return shift}; # do nothing sub + warn "shortcuts broken: $@"; + } + + # Allow timing info to be output by setting a field in the avatar. + $timings = $caller->benchmarked; + $interceptor = $caller->command_interceptor; + $dynprompt=0; + if ($caller->fieldfile("prompt")) { + if ($caller->implements("prompt")) { + # prompt is gathered before every command + $dynprompt=1; + } else { + # gather prompt once + @prompt = (prompt => $caller->prompt); } - # Turn debugging on or off. - if ($caller->debugging && $caller->defines("debug")) { - $caller->debugger($debugger = $caller->debug); + } + + # Check the caller's language as well. + if ($caller->language->fieldfile("prompt")) { + if ($caller->language->implements("prompt")) { + # prompt is gathered before every command + $dynprompt=2; + } else { + # gather prompt once + @prompt = (prompt => $caller->language->prompt); } - else { - $caller->debugger($debugger = ''); - } + } + + # Turn debugging on or off. + if ($caller->debugging && $caller->defines("debug")) { + $caller->debugger($debugger = $caller->debug); + } + else { + $caller->debugger($debugger = ''); + } } #}}} # Build up and return a list of nearby objects the caller might know about. # The order of this is signifiicant, since the first matching object gets # to run a command. Also sets up the @all list. sub nearbyobjs { #{{{ - my %contentsseen; - my @ret=($caller); - @all=(); + my %contentsseen; + my @ret=($caller); + @all=(); - if ($caller->contents) { - $contentsseen{$caller->index}=1; - push @all, grep ref, $caller->contents->list; - push @ret, @all; + if ($caller->contents) { + $contentsseen{$caller->index}=1; + push @all, grep ref, $caller->contents->list; + push @ret, @all; + } + my $loc=$caller->location; + if ($loc) { + # Add the location near to front. Simple commands like "look" + # are handled by the location often. + $contentsseen{$loc->index}=1; + my @list=grep ref, $loc->contents->list; + push @ret, $loc, @list; + push @all, @list; + + # If the caller's location is itself located somewhere, + # drill down to that uber-location, and add its contents. + # This makes things work properly while you're sitting on + # furniture, etc. + if ($loc->location) { + while ($loc->location) { + $loc=$loc->location; + } + $contentsseen{$loc->index}=1; + @list = grep ref, $loc->contents->list; + push @ret, $loc, @list; + push @all, @list; } - my $loc=$caller->location; - if ($loc) { - # Add the location near to front. Simple commands like "look" - # are handled by the location often. - $contentsseen{$loc->index}=1; - my @list=grep ref, $loc->contents->list; - push @ret, $loc, @list; - push @all, @list; + } - # If the caller's location is itself located somewhere, - # drill down to that uber-location, and add its contents. - # This makes things work properly while you're sitting on - # furniture, etc. - if ($loc->location) { - while ($loc->location) { - $loc=$loc->location; - } - $contentsseen{$loc->index}=1; - @list = grep ref, $loc->contents->list; - push @ret, $loc, @list; - push @all, @list; - } + # Recursively add the contents of every container to the list. + foreach (@ret) { + if (! $contentsseen{$_->index} && $_->contents) { + $contentsseen{$_->index}=1; + # Newly added objects will be processed as part of + # this very same loop. + push @ret, grep ref, $_->accessible_contents; } - - # Recursively add the contents of every container to the list. - foreach (@ret) { - if (! $contentsseen{$_->index} && $_->contents) { - next if $_->closed && ! $_->transparent; - - $contentsseen{$_->index}=1; - # Newly added objects will be processed as part of - # this very same loop. - push @ret, grep ref, $_->contents->list; - } - } - - return @ret; + } + + return @ret; } #}}} # Given a noun, return an object or objects that match it. sub lookup_noun { #{{{ - my $noun = lc(shift); - my $adjectives = shift; - - return unless exists $nametoobj{$noun}; - - my %seen; - my @matches; - my $allplural = 1; - if ($adjectives && @{$adjectives} > 0) { - # Use adjectives to disambiguate. Return all objects that - # match all the adjectives and have the right name. - my %count; - foreach my $adj (@{$adjectives}) { - if (exists $adjtoobj{$adj}) { - map { $count{$_}++ } @{$adjtoobj{$adj}}; - } - } - foreach (@{$nametoobj{$noun}}) { - if (exists $count{$_->[0]} && - $count{$_->[0]} == @{$adjectives} && - ! $seen{$_->[0]->index}) { - $seen{$_->[0]->index}=1; - push @matches, $_->[0]; - $allplural = 0 if $allplural && ! $_->[1]; - } - } + my $noun = lc(shift); + my $adjectives = shift; + + return unless exists $nametoobj{$noun}; + + my %seen; + my @matches; + my $allplural = 1; + if ($adjectives && @{$adjectives} > 0) { + # Use adjectives to disambiguate. Return all objects that + # match all the adjectives and have the right name. + my %count; + foreach my $adj (@{$adjectives}) { + if (exists $adjtoobj{$adj}) { + map { $count{$_}++ } @{$adjtoobj{$adj}}; + } } - else { - foreach (@{$nametoobj{$noun}}) { - if (! $seen{$_->[0]->index}) { - $seen{$_->[0]->index}=1; - push @matches, $_->[0]; - $allplural = 0 if $allplural && ! $_->[1]; - } - } + foreach (@{$nametoobj{$noun}}) { + if (exists $count{$_->[0]} && + $count{$_->[0]} == @{$adjectives} && + ! $seen{$_->[0]->index}) { + $seen{$_->[0]->index}=1; + push @matches, $_->[0]; + $allplural = 0 if $allplural && ! $_->[1]; + } } + } + else { + foreach (@{$nametoobj{$noun}}) { + if (! $seen{$_->[0]->index}) { + $seen{$_->[0]->index}=1; + push @matches, $_->[0]; + $allplural = 0 if $allplural && ! $_->[1]; + } + } + } - if (@matches > 1 && ! $allplural) { - # Mark ambiguities. - my @new; - my @ambs = map { $_->index } @matches; - foreach my $o (@matches) { - # Create a new object pointing at the same real - # object, so this one can be marked ambiguous - # without it polluting other refs to the same - # object. - $_=bless([@{$o}], ref $o); - $_->[ISAMB] = \@ambs; - push @new, $_; - } - return \@new; + if (@matches > 1 && ! $allplural) { + # Mark ambiguities. + my @new; + my @ambs = map { $_->index } @matches; + foreach my $o (@matches) { + # Create a new object pointing at the same real + # object, so this one can be marked ambiguous + # without it polluting other refs to the same + # object. + $_=bless([@{$o}], ref $o); + $_->[ISAMB] = \@ambs; + push @new, $_; } - - return (@matches ? \@matches : undef); + return \@new; + } + + return (@matches ? \@matches : undef); } #}}} # Given a pronoun, return an object or objects that match it. sub lookup_pronoun { #{{{ - my $pronoun = lc(shift); - return $pronouns{$pronoun} if exists $pronouns{$pronoun}; + my $pronoun = lc(shift); + return $pronouns{$pronoun} if exists $pronouns{$pronoun}; - # Non-pre-calculated pronouns. - if ($pronoun =~ /everythings?/ || $pronoun eq 'all') { - my @ret = grep { ! $_->hidden && $_ != $caller } @all; - return \@ret if @ret; - } - elsif ($pronoun eq 'here') { - # There may be no location. - my $loc=$caller->location; - return [$loc] if $loc; - } - return; + # Non-pre-calculated pronouns. + if( grep /^$pronoun$/, $caller->language->all_pronouns ) + { + my @ret = grep { ! $_->hidden && $_ != $caller } @all; + return \@ret if @ret; + } elsif( grep /^$pronoun$/, $caller->language->here_pronouns ) { + # There may be no location. + my $loc=$caller->location; + return [$loc] if $loc; + } + return; } #}}} # Given an object reference (sans the leading "mooix"), return @@ -210,94 +334,109 @@ # if it fails.. But the memoization needs to be undone after each # command that is run, since any command could change the result. sub lookup_reference { #{{{ - my $id = shift; - my $obj = $caller->reference(id => $id); - if ($obj) { - $obj->[ISREF] = 1; - return [$obj]; - } - return; + my $id = shift; + my $obj = $caller->reference(id => $id); + if ($obj) { + $obj->[ISREF] = 1; + return [$obj]; + } + return; } #}}} -# Given a number representation (which might be the raw number, or the -# written-out form, or some ordinal form), return the number it -# represents, or undef if none. -my $word2num_loaded=0; -sub lookup_number { #{{{ - my $word=shift; - if (! $word2num_loaded) { - # Try to use Lingua::EN::Words2Nums, but don't depend - # on it being installed. - eval "use Lingua::EN::Words2Nums"; - if ($@) { - # Install stub function that only does simple numbers. - *::words2nums = sub { - $_ = shift; - return $1 if /^(\d+)(?:st|nd|rd|th)?$/; - return; - }; - } - $word2num_loaded=1; - } - # This is a hack, for "next alias is" type of things. - return 9999 if lc $word eq 'next'; - return words2nums($word); -} #}}} +## # Given a number representation (which might be the raw number, or the +## # written-out form, or some ordinal form), return the number it +## # represents, or undef if none. +## my $word2num_loaded=0; +## sub lookup_number { #{{{ +## my $word=shift; +## if (! $word2num_loaded) { +## # Try to use Lingua::EN::Words2Nums, but don't depend +## # on it being installed. +## eval "use Lingua::EN::Words2Nums"; +## if ($@) { +## # Install stub function that only does simple numbers. +## *::words2nums = sub { +## $_ = shift; +## return $1 if /^(\d+)(?:st|nd|rd|th)?$/; +## return; +## }; +## } +## $word2num_loaded=1; +## } +## # This is a hack, for "next alias is" type of things. +## return 9999 if lc $word eq 'next'; +## return words2nums($word); +## } #}}} +## +## # Called by the grammar to point out recently referred to objects that may +## # set the 'it' pronoun, etc. Pass in a list of objects. +## sub recent_obj { #{{{ +## my @objs = @_; +## if (@objs == 1) { +## # Don't set "it" if the caller talks about themself. +## $pronouns{that} = $pronouns{thats} = $pronouns{it} = +## $pronouns{its} = \@objs +## unless $objs[0] == $caller; +## my $gender=$objs[0]->gender; +## if ($gender) { +## $pronouns{$gender->object_pronoun} = \@objs; +## } +## $pronouns +## } +## elsif (@objs) { +## # TODO To be strictly correct, I should only set 'these' and +## # 'those' if all the objects are not people, and always set +## # 'them'. +## $pronouns{these} = $pronouns{those} = $pronouns{them} = +## $pronouns{their} = \@objs; +## } +## } #}}} -# Called by the grammar to point out recently referred to objects that may -# set the 'it' pronoun, etc. Pass in a list of objects. -sub recent_obj { #{{{ - my @objs = @_; - if (@objs == 1) { - # Don't set "it" if the caller talks about themself. - $pronouns{that} = $pronouns{thats} = $pronouns{it} = - $pronouns{its} = \@objs - unless $objs[0] == $caller; - my $gender=$objs[0]->gender; - if ($gender) { - $pronouns{$gender->object_pronoun} = \@objs; - } - $pronouns - } - elsif (@objs) { - # TODO To be strictly correct, I should only set 'these' and - # 'those' if all the objects are not people, and always set - # 'them'. - $pronouns{these} = $pronouns{those} = $pronouns{them} = - $pronouns{their} = \@objs; - } -} #}}} - # Returns an object if it is inside some other object. # (Actually, it might be called for several objects.) sub is_obj_in_obj { #{{{ - my @objs=@{shift()}; - my $prepositions=shift; - my $container=@{shift()}[0]; - - my @ret; + my @objs=@{shift()}; + my $relative_tag=shift; + my $container=@{shift()}[0]; + ## print STDERR "is_obj relative_tag: $relative_tag \n"; + + my @ret; OBJ: foreach (@objs) { - # If there are prepositions, make sure that the - # prepositions can indeed be used. If so, it'll be in - # the object's preposition list. - if (ref $prepositions) { - my %preps = map { $_ => 1 } $_->preposition; - foreach (@$prepositions) { - next OBJ unless $preps{$_}; - } + # If there is a relative clause tag, make sure that it's + # correct for the relationship the object has to its + # container. + my $ok = 0; + if( length $relative_tag ) { + my $relative_field = $_->relation . "_relatives"; + ## print STDERR "is_obj field: $relative_field\n"; + foreach $_ ($caller->language->$relative_field) + { + ## print STDERR "relative: " . $_ . "\n"; + if( $_ eq $relative_tag ) + { + $ok = 1; + last; + } } - - if ($_->location == $container) { - push @ret, $_; - } + } + + if( ! $ok ) + { + next OBJ; + } + + if ($_->location == $container) { + push @ret, $_; + } } - + # Telling where an object is this way can serve to disambiguate # it, if it was ambiguous. if (@ret == 1) { - $ret[0]->[ISAMB] = undef; + $ret[0]->[ISAMB] = undef; } - + + ## print STDERR "is_obj ret: " . join( ' ', @ret ) . "\n"; return \@ret if @ret; return; } #}}} @@ -307,131 +446,187 @@ # in the prototype, and if the protoype specifies an allowable value set, # the value must be in that set. sub checkproto { #{{{ - my $this = shift; - my $multobj = shift; - my %command = @_; + my $this = shift; + my $multobj = shift; + my %command = @_; - my $cmdfield; - if (exists $command{verb}) { - $cmdfield = lc($command{verb}).".cmd"; + my $cmdfield; + + #print STDERR "command: " . Dumper(\%command) . ".\n"; + + # First try .cmd.[lang], then try .cmd + foreach my $cmd_extension ( ".cmd.".$caller->language->code, ".cmd",) + { + if( exists $command{$cmd_parse_command} ) { + $cmdfield = lc($command{$cmd_parse_command}).$cmd_extension; + } else { + # Check the default.cmd for weirdly formed commands that + # lack a verb. + $cmdfield = "default".$cmd_extension; } - else { - # Check the default.cmd for weirdly formed commands that - # lack a verb. - $cmdfield = "default.cmd"; - } if (! $this) { - use Carp; - Carp::cluck("called on null object"); + use Carp; + Carp::cluck("called on null object"); } - + PROTO: foreach my $prototype ($this->$cmdfield) { - my %remains=%command; + #print STDERR "prototype: $prototype.\n"; + my %remains=%command; - next if $prototype =~ /^#/; - next unless defined $prototype && length $prototype; - my ($prototype, $command) = split(/\s*:\s*/, $prototype, 2); - $command = lc($command{verb}) unless defined $command; - - my (@checknearby, @checktouchable, @checkvisible, + next if $prototype =~ /^#/; + next unless defined $prototype && length $prototype; + my ($prototype, $command) = split(/\s*:\s*/, $prototype, 2); + $command = lc($command{$cmd_parse_command}) unless defined $command; + + my (@checknearby, @checktouchable, @checkvisible, @lockpos, @lockmove, @checkopen); - - my $fail=0; - foreach my $section (split(/\s*,\s*/, $prototype)) { - my ($part, $limits) = $section =~ /(\w+)\s*(?:\((.*)\))?/; - if (! exists $remains{$part}) { - $incomplete{$part}=1; - $fail=1; - next; + + my $fail=0; + foreach my $section (split(/\s*,\s*/, $prototype)) { + my ($orig_part, $limits) = $section =~ /([\w=]+)\s*(?:\((.*)\))?/; + my ( $part, $name ); + #print STDERR "part1: $orig_part.\n"; + # Deal with aliasing + if( $orig_part =~ m/=/ ) + { + $orig_part =~ m/(.*)=(.*)/; + ( $part, $name ) = ( $1, $2 ); + if( $remains{$name} ) + { + $remains{$part} = $remains{$name}; + delete $remains{$name}; + } + } else { + $part = $orig_part; + $name = $orig_part; + } + #print STDERR "part2: $part.\n"; + #print STDERR "remains: " . Dumper(\%remains) . ".\n"; + if (defined $limits) { + #print STDERR "limits: $limits.\n"; + } + if( ! defined $remains{$part} || ! length $remains{$part} ) { + # De-alias parts before setting incomplete, so + # we can do language-specific failure messages. + $incomplete{$name}=1; + $fail=1; + next; + } + if (defined $limits) { + #print STDERR "in main limits.\n"; + my $lockpos=0; + my $checknearby=0; + my $checktouchable=0; + my $checkvisible=0; + my $checkopen=0; + foreach my $limit (split(/\)\(/, $limits)) { + my %limit = map { lc($_) => 1 } split(/\s*\|\s*/, $limit); + my $ok=0; + + if( $limit =~ m/set@/ ) + { + # For example, preposition must be of a + # particular type. So + # io_preposition(set@in_prepositions) + # matches any prepositions in the + # language's in_prepositions field. + my $limit_set = $limit; + $limit_set =~ s/set@([^|)]*)/$1/; + if( grep( /$remains{$part}/, $caller->language->$limit_set ) ) + { + $ok=1; + } } - if (defined $limits) { - my $lockpos=0; - my $checknearby=0; - my $checktouchable=0; - my $checkvisible=0; - my $checkopen=0; - foreach my $limit (split(/\)\(/, $limits)) { - my %limit = map { lc($_) => 1 } split(/\s*\|\s*/, $limit); - my $ok=0; - if ($part eq 'direct_object' || $part eq 'indirect_object') { - # Order is important.. - if ($limit{tomove}) { - push @lockmove, $remains{$part}[0]; - delete $limit{tomove}; # still auto-check nearby - } - if ($limit{nearby} || ! %limit) { - $ok=$lockpos=$checknearby=1; - } - if ($limit{touchable}) { - $ok=$lockpos=$checknearby=$checktouchable=1; - } - if ($limit{visible}) { - $ok=$lockpos=$checknearby=$checkvisible=1; - } - if ($limit{reference} && defined $remains{$part}[0]->[ISREF]) { - $ok=1; - $checknearby=0; - } - if ($limit{single} && (! $multobj || $part ne 'direct_object')) { - $ok=1; - } - if ($limit{anywhere}) { - $ok=1; - $checknearby=0; - } - if ($limit{this} && $remains{$part}[0] == $this) { - $ok=1; - } - if ($limit{open}) { - $ok=$checkopen=1; - } - } - elsif ($part eq 'verb') { - if ($limit{this} && $this == $caller) { - $ok=1; - } - } - elsif (exists $remains{$part} && - defined $remains{$part} && - $limit{$remains{$part}}) { - $ok=1; - } - next PROTO unless $ok; - } - - if ($lockpos) { - push @lockpos, $remains{$part}[0]; - } - if ($checknearby) { - push @checknearby, $remains{$part}[0]; - } - if ($checktouchable) { - push @checktouchable, $remains{$part}[0]; - } - if ($checkvisible) { - push @checkvisible, $remains{$part}[0]; - } - if ($checkopen) { - push @checkopen, $remains{$part}[0]; - } + + ## if( grep( /$part/, @cmd_parse_object ) ) + if ($part eq 'direct_object' || $part eq 'indirect_object') + { + # Order is important.. + if ($limit{tomove}) { + push @lockmove, $remains{$part}[0]; + delete $limit{tomove}; # still auto-check nearby + } + if ($limit{nearby} || ! %limit) { + $ok=$lockpos=$checknearby=1; + } + if ($limit{touchable}) { + $ok=$lockpos=$checknearby=$checktouchable=1; + } + if ($limit{visible}) { + $ok=$lockpos=$checknearby=$checkvisible=1; + } + if ($limit{reference} && defined $remains{$part}[0]->[ISREF]) { + $ok=1; + $checknearby=0; + } + if ($limit{single} && (! $multobj || $part ne 'direct_object')) { + $ok=1; + } + if ($limit{anywhere}) { + $ok=1; + $checknearby=0; + } + if ($limit{this} && $remains{$part}[0] == $this) { + $ok=1; + } + if ($limit{open}) { + $ok=$checkopen=1; + } + } elsif( $part eq $cmd_parse_command ) { + if ($limit{this} && $this == $caller) { + $ok=1; + } + } elsif (exists $remains{$part} && + defined $remains{$part} && + $limit{$remains{$part}}) { + # This section handles stuff + # like do_preposition(down), + # which matches only if the + # literal word "down" is in + # there as a do_preposition. + $ok=1; } + next PROTO unless $ok; + } - delete $remains{$part}; + if ($lockpos) { + push @lockpos, $remains{$part}[0]; + } + if ($checknearby) { + push @checknearby, $remains{$part}[0]; + } + if ($checktouchable) { + push @checktouchable, $remains{$part}[0]; + } + if ($checkvisible) { + push @checkvisible, $remains{$part}[0]; + } + if ($checkopen) { + push @checkopen, $remains{$part}[0]; + } } - delete $remains{do_preposition}; - delete $remains{io_preposition}; - if ($fail) { - if (%remains) { - %incomplete=(); - } - next; + + delete $remains{$part}; + } + + #print STDERR "remains after most stuff: " . Dumper(\%remains) . ".\n"; + + clean_remains( \%command, \%remains ); + + #print STDERR "remains after all stuff: " . Dumper(\%remains) . ".\n"; + if ($fail) { + if (%remains) { + %incomplete=(); } - #print STDERR "$this $cmdfield remains: ".join(", ", keys %remains)."\n"; - return ($command, \@checknearby , \@checktouchable, \@checkvisible, - \@lockpos, \@lockmove, \@checkopen) unless %remains; + next; + } + #print STDERR "$this $cmdfield remains: ".join(", ", keys %remains)."\n"; + return ($command, \@checknearby , \@checktouchable, \@checkvisible, + \@lockpos, \@lockmove, \@checkopen, $prototype) unless %remains; } - return; # failure + } + return; # failure } #}}} # Given a reference to a sentence and a list of objects, constructs a @@ -442,284 +637,362 @@ # objects are pretty much indistinguishable, and a good question cannot be # constructed. sub gen_disambiguator { #{{{ - my %sentence=%{shift @_}; - my @objs=@_; - - # Build up a hash of possible answers to the question. - # It'll be used by the returned subroutine. - my %answers; + my $object_type = shift; + my %sentence=%{shift @_}; + my @objs=@_; - # Support "the former" and "the latter" style responses, and - # "both". - if (@objs == 2) { - $answers{former} = [ $objs[0] ]; - $answers{latter} = [ $objs[1] ]; - $answers{both} = [ @objs ]; # XXX would it be better to use the quantifier sub here? + # Build up a hash of possible answers to the question. + # It'll be used by the returned subroutine. + my %answers; + + # Support "the former" and "the latter" style responses, and + # "both". + if (@objs == 2) { + $answers{former} = [ $objs[0] ]; + $answers{latter} = [ $objs[1] ]; + $answers{both} = [ @objs ]; # XXX would it be better to use the quantifier sub here? + } + + # Let's see if the locations of the objects vary; if so they could + # be used to help disambiguate. The hash values will hold the names + # of the locations. + my %locs; + foreach my $obj (@objs) { + my $loc=$obj->location; + next if ! $loc; + my $id=$loc->id; + if (! exists $locs{$id}) { + my $article = strip_xml( $loc->article ); + $locs{$id} = strip_xml( $article ) ." " if length strip_xml( $article ); + $locs{$id} .= strip_xml( $loc->name ); } - - # Let's see if the locations of the objects vary; if so they could - # be used to help disambiguate. The hash values will hold the names - # of the locations. - my %locs; - foreach my $obj (@objs) { - my $loc=$obj->location; - next if ! $loc; - my $id=$loc->id; - if (! exists $locs{$id}) { - my $article = $loc->article; - $locs{$id} = "$article " if length $article; - $locs{$id} .= $loc->name; - } + } + + # It's quite possible that two objects have nothing really to + # distinguish them. So, this hash will be used to keep track of + # unique choices. + my %seen; + # And this array will hold the arrays of objects that each choice + # corresponds to. + my @choices; + my $count=0; + foreach my $obj (@objs) { + #print STDERR "obj: ".Dumper($obj)."\n"; + my $bit=""; + + if( length strip_xml( $obj->article ) ) + { + # The reason to ignore the object's stated article and use + # the definate article is because it looks weird if it asks + # "Do you mean the red ball or a green ball". + $bit .= $caller->language->definate_article; } - # It's quite possible that two objects have nothing really to - # distinguish them. So, this hash will be used to keep track of - # unique choices. - my %seen; - # And this array will hold the arrays of objects that each choice - # corresponds to. - my @choices; - my $count=0; - foreach my $obj (@objs) { - my $bit=""; - # The reason to ignore the object's stated article and use - # "the" is because it looks weird if it asks "Do you mean - # the red ball or a green ball". - $bit .= "the " if length $obj->article; - my @adj=$obj->adjective; - # Add the adjectives to the answers list. - map { push @{$answers{$_}}, $obj } @adj; - $bit .= join(" ", @adj)." " if @adj; - $bit .= $obj->name; - if (scalar keys %locs > 1) { - my $loc = $obj->location; - if ($loc == $caller) { - $bit .= " you're holding"; - } - else { - my @prep=$obj->preposition; - my $prep=$prep[0]; - $prep = "in" if ! length $prep; - $bit .= " $prep ".$locs{$loc->id}; - } - } + my @adj = map { strip_xml( $_ ) } $obj->adjective; - if (! $seen{$bit}) { - $seen{$bit} = 1; - push @choices, $bit; - push @{$answers{++$count}}, $obj; - } + # Add the adjectives to the answers list. + map { push @{$answers{$_}}, $obj } @adj; + + #print STDERR "bit1: ".Dumper($bit)."\n"; + $bit .= join(" ", @adj)." " if @adj; + #print STDERR "bit2: ".Dumper($bit)."\n"; + $bit .= strip_xml( $obj->name ); + #print STDERR "obj name: ".Dumper($obj->name)."\n"; + #print STDERR "obj name2: ".Dumper( strip_xml( $obj->name ) )."\n"; + #print STDERR "bit3: ".Dumper($bit)."\n"; + if (scalar keys %locs > 1) { + my $loc = $obj->location; + if ($loc == $caller) { + $bit .= $caller->language->holding_postfix; + } + else { + # Generate relative clause lists like "The box which + # is under the table". + my $relation=$obj->relation; + my $relative_field_name = $relation . "_relatives"; + my @relative_field=$caller->language->$relative_field_name; + my $relative=$relative_field[0]; + $bit .= " $relative " . + $locs{$loc->id} . " " . $caller->language->relative_ender; + } } - - # Do all objects seem to be identical? - return undef if @choices == 1; - # Register the answers and the handler. - $answers=genregex(keys %answers); - $anshandler=sub { - my %response = @_; - - my $selected; - if (exists $response{direct_object}) { - # Trim the list down to the objects in @objs. - my %objs = map { $_->index => $_ } @objs; - $selected = [ grep { $objs{$_->index} } @{$response{direct_object}} ]; - } - elsif (exists $response{number} && exists $answers{$response{number}}) { - $selected = $answers{$response{number}}; - } - elsif (exists $response{answer}) { - my $answer = $response{answer}; - # Check each of the user's responses against the - # answers, and select any that match them all. - my $first = shift @$answer; - my @sel = @{$answers{lc $first}}; - foreach my $a (@{$answer}) { - my %matches = map { $_->index => 1} - @{$answers{lc($a)}}; - @sel = grep { $matches{$_->index} } @sel; - } - if (! @sel) { - $session->write("None of the choices is ". - join(" and ", $first, @{$answer})."."); - return 1; - } - $selected = [ @sel ]; - } + #print STDERR "bit: ".Dumper($bit)."\n"; + if (! $seen{$bit}) { + $seen{$bit} = 1; + push @choices, $bit; + push @{$answers{++$count}}, $obj; + } + } - if (! $selected) { - $session->write("Invalid selection."); - return 1; # question was anwered, though not well - } + # Do all objects seem to be identical? + return undef if @choices == 1; - # Register the objects as recently referred to objects now. - recent_obj(@{$selected}); - - # There may be multiple objects still, and this may well lead - # to another round of disambiguation.. anyway, the user has - # answered the question, so deregister it. - $answers=genregex(); - $anshandler=undef; - do_multobj_sentence(%sentence, direct_object => $selected); - return 1; # question was answered, maybe not well - }; - - $choices[-1]="or ".$choices[-1]; - return "Do you mean ".join((@choices > 2) ? ', ' : ' ', @choices)."?"; + #print STDERR "choices1: ".Dumper(\@choices)."\n"; + + # Register the answers and the handler. + $answers=genregex(keys %answers); + print STDERR "answers: ".Dumper(\$answers)."\n"; + $anshandler=sub { + my %response = @_; + print STDERR "In anshandler: ".Dumper(\%response).".\n"; + + my $selected; + if (exists $response{$object_type}) { + # Trim the list down to the objects in @objs. + my %objs = map { $_->index => $_ } @objs; + $selected = [ grep { $objs{$_->index} } @{$response{$object_type}} ]; + } + elsif (exists $response{number} && exists $answers{$response{number}}) { + $selected = $answers{$response{number}}; + } + elsif (exists $response{answer}) { + my $answer = $response{answer}; + # Check each of the user's responses against the + # answers, and select any that match them all. + my $first = shift @$answer; + my @sel = @{$answers{lc $first}}; + foreach my $a (@{$answer}) { + my %matches = map { $_->index => 1} + @{$answers{lc($a)}}; + @sel = grep { $matches{$_->index} } @sel; + } + if (! @sel) { + $session->write("None of the choices is ". + join(" and ", $first, @{$answer})."."); + return 1; + } + $selected = [ @sel ]; + } + + if (! $selected) { + $session->write("Invalid selection."); + return 1; # question was anwered, though not well + } + + # Register the objects as recently referred to objects now. + $lang_to_grammar{recent_obj}->(@{$selected}); + + # There may be multiple objects still, and this may well lead + # to another round of disambiguation.. anyway, the user has + # answered the question, so deregister it. + $answers=genregex(); + $anshandler=undef; + my %new_sentence = %sentence; + delete $new_sentence{$object_type}; + do_multobj_sentence(%new_sentence, $object_type, $selected); + return 1; # question was answered, maybe not well + }; + + my $choices_string = $#choices > 0 + ? join( + $caller->language->list_seperator, + @choices[0 .. $#choices-1] + ) + . $caller->language->list_seperator_last + . $choices[-1] + : $choices[0]; + + #$choices[-1]="or ".$choices[-1]; + + #print STDERR "choices2: ".Dumper(\@choices)."\n"; + + # Hack together the message + my $msg_field = 'parser_disambig.msg'; + my $msg = strip_xml( $caller->$msg_field ); + $msg =~ s/\$choices/$choices_string/; + + return $msg; + #return "Do you mean ".join((@choices > 2) ? ', ' : ' ', @choices)."?"; } #}}} # This takes care of a sentence that has multiple direct objects in it. # Detecting ambiguously referred to direct objects and properly dispatching # everything is a mite complicated. sub do_multobj_sentence { #{{{ - my %sentence = @_; - + my %sentence = @_; + #print STDERR "In do_multiobj: ".Dumper(\%sentence).".\n"; + + foreach my $object_type (@cmd_parse_object) + { + #print STDERR "In do_multiobj foreach: $object_type.\n"; # Putting things in a hash prevents operating on the same direct # object twice. - my %dobjs = map { $_->index => $_ } @{$sentence{direct_object}}; - + my %my_objs = map { $_->index => $_ } @{$sentence{$object_type}}; + + if (scalar values %my_objs <= 1) { + if( @{$sentence{$object_type}} == 0 ) + { + delete $sentence{$object_type}; + } + next; + } + # Check to see if there are any possibly ambiguous references to # objects. my $first_time = 1; - my @list=values %dobjs; - foreach my $direct_object (@list) { - next unless $direct_object->[ISAMB]; - if ($first_time && $direct_object->[ISAMB] && - grep { $_ ne $direct_object->index && $dobjs{$_} } @{$direct_object->[ISAMB]}) { - # Check to see which of the direct objects this - # sentence can actually be run on, and ignore the - # rest. That might elminiate the ambiguities. It is - # a bit expensive though. - $first_time = 0; - foreach my $direct_object (values %dobjs) { - # Test, don't do it. - if (! do_sentence(0, 0, "", %sentence, direct_object => [ $direct_object ])) { - delete $dobjs{$direct_object->index}; - } - } - last if ! %dobjs; # whoops, none can be used. + my @list=values %my_objs; + foreach my $object (@list) { + next unless $object->[ISAMB]; + if ($first_time && $object->[ISAMB] && + grep { $_ ne $object->index && $my_objs{$_} } @{$object->[ISAMB]}) { + # Check to see which of the direct objects this + # sentence can actually be run on, and ignore the + # rest. That might elminiate the ambiguities. It is + # a bit expensive though. + $first_time = 0; + foreach my $object (values %my_objs) { + # Test, don't do it. + if (! do_sentence(0, 0, "", %sentence, $object_type => [ $object ])) { + delete $my_objs{$object->index}; + } } - if ($direct_object && $dobjs{$direct_object->index} && - grep { $_ ne $direct_object->index && $dobjs{$_} } @{$direct_object->[ISAMB]}) { - my @possibles=map { $dobjs{$_} } grep { $dobjs{$_} } @{$direct_object->[ISAMB]}; - my $disambiguator=gen_disambiguator(\%sentence, @possibles); - if (! defined $disambiguator) { - # Act on only one of the objects, since - # they are all much the same. - $session->write("(Picking one of them at random ...)"); - return do_sentence(1, 0, '', %sentence, direct_object => [ $possibles[rand @possibles] ]); - } - else { - $session->write($disambiguator); - # The ISAMB flag needs to be unset now; these - # objects might be used again and it shouldn't - # taint them. - $_->[ISAMB] = undef foreach @list; - return; - } + last if ! %my_objs; # whoops, none can be used. + } + if ($object && $my_objs{$object->index} && + grep { $_ ne $object->index && $my_objs{$_} } @{$object->[ISAMB]}) { + my @possibles=map { $my_objs{$_} } grep { $my_objs{$_} } @{$object->[ISAMB]}; + print STDERR "In do_multiobj disam.\n"; + my $disambiguator=gen_disambiguator( $object_type, \%sentence, @possibles); + if (! defined $disambiguator) { + # Act on only one of the objects, since + # they are all much the same. + $session->write("(Picking one of them at random ...)"); + return do_sentence(1, 0, '', %sentence, $object_type => [ $possibles[rand @possibles] ]); } - $direct_object->[ISAMB] = undef; # not any more + else { + $session->write($disambiguator); + # The ISAMB flag needs to be unset now; these + # objects might be used again and it shouldn't + # taint them. + $_->[ISAMB] = undef foreach @list; + print STDERR "In do_multiobj disam still.\n"; + return; + } + } + $object->[ISAMB] = undef; # not any more } + print STDERR "In do_multiobj done foreach.\n"; - if (! %dobjs) { - showfailure("", %sentence); - return; + if (! %my_objs) { + print STDERR "In do_multiobj showfailure.\n"; + showfailure("", %sentence); + return; } - - if (scalar values %dobjs == 1) { - # There is only one d.o. left after deduping and so on. - if (! do_sentence(1, 0, '', %sentence, direct_object => [ values %dobjs ])) { - showfailure('', %sentence, direct_object => [ values %dobjs ]); - return; - } - return 1; + } + + foreach my $object_type (@cmd_parse_object) + { + my %my_objs = map { $_->index => $_ } @{$sentence{$object_type}}; + + if (scalar values %my_objs < 1) { + if( @{$sentence{$object_type}} == 0 ) + { + delete $sentence{$object_type}; + } + next; } + if (scalar values %my_objs == 1) { + # There is only one d.o. left after deduping and so on. + if (! do_sentence(1, 0, '', %sentence, $object_type => [ values %my_objs ])) { + showfailure('', %sentence, $object_type => [ values %my_objs ]); + return; + } + return 1; + } + # Do the sentence once per direct object. Do it in the original order # the user requested, skipping items that aren't in the hash. Delay # failures until end; if everything failed just show one failure. my @failed; my $tried = 0; - foreach my $direct_object (@{$sentence{direct_object}}) { - next unless $dobjs{$direct_object->index}; - $tried++; - if (! do_sentence(1, 1, $direct_object->name.": ", %sentence, direct_object => [ $direct_object ])) { - push @failed, $direct_object; - } - # Don't operate on this object again.. - delete $dobjs{$direct_object->index}; + foreach my $object (@{$sentence{$object_type}}) { + next unless $my_objs{$object->index}; + $tried++; + if (! do_sentence(1, 1, strip_xml( $object->name ).": ", %sentence, $object_type => [ $object ])) { + push @failed, $object; + } + # Don't operate on this object again.. + delete $my_objs{$object->index}; } if (@failed) { - if (@failed == $tried) { - showfailure("", %sentence, direct_object => $sentence{direct_object}->[0]); - } - else { - showfailure($_->name.": ", %sentence, direct_object => [ $_ ]) - foreach @failed; - } - return; + if (@failed == $tried) { + showfailure("", %sentence, $object_type => $sentence{$object_type}->[0]); + } + else { + showfailure( strip_xml( $_->name ).": ", %sentence, $object_type => [ $_ ]) + foreach @failed; + } + return; } else { - return 1; + return 1; } + } } #}}} - + # Given a sentence finds the object that can handle the command and runs # it. Returns true if something could be done, and false otherwise. sub do_sentence { #{{{ - my $reallydo = shift; # set if the command should really be executed + my $reallydo = shift; # set if the command should really be executed my $multobj = shift; # set if there are really multiple d.o.'s my $prefix = shift; # prefix text to display before output my %sentence = @_; - - my @objs=@known; - - # The caller's command_intercept can, as a special case, intercept - # *anything*. - if (defined $interceptor && length $interceptor) { - my $ret=runcommand($caller, $interceptor, \%sentence); - return $ret if $ret; + + my @objs=@known; + + # The caller's command_intercept can, as a special case, intercept + # *anything*. + if (defined $interceptor && length $interceptor) { + my $ret=runcommand($caller, $interceptor, \%sentence); + return $ret if $ret; + } + + # First, look for verbs on the direct or indirect object. Doing + # this first optimizes for the common case. It also means that is + # the direct or indirect object was referred to using mooix:, and + # is not nearby, they still can have verbs run on them. + if ($sentence{direct_object} && @{$sentence{direct_object}}) { + if (dispatch($reallydo, $multobj, $sentence{direct_object}->[0], $prefix, %sentence)) { + return 1; } - - # First, look for verbs on the direct or indirect object. Doing - # this first optimizes for the common case. It also means that is - # the direct or indirect object was referred to using mooix:, and - # is not nearby, they still can have verbs run on them. - if ($sentence{direct_object} && @{$sentence{direct_object}}) { - if (dispatch($reallydo, $multobj, $sentence{direct_object}->[0], $prefix, %sentence)) { - return 1; - } - @objs=grep { $_ != $sentence{direct_object} } @objs; + @objs=grep { $_ != $sentence{direct_object} } @objs; + } + elsif ($sentence{indirect_object} && @{$sentence{indirect_object}}) { + if (dispatch($reallydo, $multobj, $sentence{indirect_object}->[0], $prefix, %sentence)) { + return 1; } - elsif ($sentence{indirect_object} && @{$sentence{indirect_object}}) { - if (dispatch($reallydo, $multobj, $sentence{indirect_object}->[0], $prefix, %sentence)) { - return 1; - } - @objs=grep { $_ != $sentence{indirect_object} } @objs; + @objs=grep { $_ != $sentence{indirect_object} } @objs; + } + + # Failing all the above, just try checking all other nearby objects. + foreach my $obj (@objs) { + if (dispatch($reallydo, $multobj, $obj, $prefix, %sentence)) { + return 1; } - - # Failing all the above, just try checking all other nearby objects. - foreach my $obj (@objs) { - if (dispatch($reallydo, $multobj, $obj, $prefix, %sentence)) { - return 1; - } + } + + # If we have only a verb and a preposition, then it could be that + # instead of a preposition, they meant to refer to an object. For + # example, "go down" causes down to be parsed as a preposition. + if (! grep { $_ ne 'verb' && $_ ne 'preposition' } keys %sentence) { + my $direct_object = lookup_noun( + $caller->dexml( + text => $sentence{preposition}, + language => $best_lang_code + ) + ); + if ($direct_object) { + return do_sentence($reallydo, 0, $prefix, + verb => $sentence{verb}, + direct_object => $direct_object); } + } - # If we have only a verb and a preposition, then it could be that - # instead of a preposition, they meant to refer to an object. For - # example, "go down" causes down to be parsed as a preposition. - if (! grep { $_ ne 'verb' && $_ ne 'preposition' } keys %sentence) { - my $direct_object = lookup_noun($sentence{preposition}); - if ($direct_object) { - return do_sentence($reallydo, 0, $prefix, - verb => $sentence{verb}, - direct_object => $direct_object); - } - } - - return; # failure + return; # failure } #}}} - + # This is called when the user's command cannot be run for some reason. If # $failreason is set, then it is just displayed, telling them why whatever # they wanted to do can't work. If it is empty, then if %incomplete has @@ -729,418 +1002,472 @@ # The first parameter is an optional prefix to prepend to the output. # The sentence is required. sub showfailure { #{{{ - my $prefix = shift; - my %sentence = @_; - $prefix = "" unless defined $prefix; - # These parts of speech almost never matter. - delete $incomplete{io_preposition}; - delete $incomplete{do_preposition}; - - if (length $failreason) { - $session->write($prefix.$failreason); - } - elsif (%incomplete) { - # Build up a question indicating what parts of speech they - # were missing. - my @message; - if (! $sentence{verb}) { - # Whee, they typed something really weird. - $session->write("Beg pardon?"); - return; - } - elsif ($incomplete{direct_object}) { - push @message, $sentence{verb}, "what"; - if ($incomplete{indirect_object}) { - push @message, "where"; - } + my $prefix = shift; + my %sentence = @_; + $prefix = "" unless defined $prefix; - # Set up answer handler. - $anshandler=sub { - my %response = @_; - if (exists $response{direct_object}) { - $sentence{direct_object} = $response{direct_object}; - recent_obj(@{$response{direct_object}}); - $answers=genregex(); - $anshandler=undef; - do_multobj_sentence(%sentence); - return 1; + if (length $failreason) { + $session->write($prefix.$failreason); + } elsif (%incomplete) { + # Build up a question indicating what parts of speech they + # were missing. + my @message; + if (! $sentence{$cmd_parse_command}) { + # Whee, they typed something really weird. + my $msg_field = 'parser_wtf.msg'; + $session->write( + strip_xml( $caller->$msg_field ) + ); + return; + } elsif( grep { exists $incomplete{$_} } @cmd_parse_object ) { + foreach my $part (@cmd_parse_object) + { + if ($incomplete{$part}) { + push @message, $sentence{$cmd_parse_command}; + + my $question_word = 'question_word_'.$part; + push @message, $caller->language->$question_word; + + # Set up answer handler. + $anshandler=sub { + my %response = @_; + if( exists $response{$part} ) { + + # This part allows us to grab extra + # fields associated with the object, + # like the associated preposition. + my $extra_parts_field = $part.'_extras'; + foreach my $extra_part ($caller->language->$extra_parts_field) + { + if( exists $response{$extra_part} ) { + $sentence{$extra_part} = $response{$extra_part}; } - return; - }; - } - elsif ($incomplete{indirect_object}) { - push @message, $sentence{verb}; - push @message, "it"; - push @message, "where"; - - # Set up answer handler. - $anshandler=sub { - my %response = @_; - if (exists $response{direct_object}) { - $sentence{indirect_object} = $response{direct_object}; - recent_obj(@{$response{direct_object}}); - $sentence{io_preposition} = $response{do_preposition} - if exists $response{do_preposition}; - $answers=genregex(); - $anshandler=undef; - do_multobj_sentence(%sentence); - return 1; - } - return; - }; - } - else { - $session->write("You need to supply ". - join(" and ", map { s/_/ /g; "a $_" } - keys %incomplete)."."); + } + $sentence{$part} = $response{$part}; + $lang_to_grammar{recent_obj}->(@{$response{$part}}); + $answers=genregex(); + $anshandler=undef; + do_multobj_sentence(%sentence); + return 1; + } return; + }; + + last; } - $session->write(ucfirst join(" ", @message)."?"); + + } + } else { + my @incompletes = map { clean_incomplete( $_ ) } keys %incomplete; + + my $incompletes_string = $#incompletes > 0 + ? $caller->language->indefinate_article . + join( + $caller->language->list_seperator . + $caller->language->indefinate_article , + @incompletes[0 .. $#incompletes-1] + ) + . $caller->language->list_seperator_last + . $caller->language->indefinate_article . $incompletes[-1] + : $caller->language->indefinate_article . $incompletes[0]; + + # Hack together the message + my $msg_field = 'parser_supply.msg'; + my $msg = strip_xml( $caller->$msg_field ); + $msg =~ s/\$incompletes/$incompletes_string/; + $session->write($msg); + + return; } - else { - $session->write($prefix."You can't do that."); + + my $message = join(" ", @message); + $message = $caller->language->question_starter . $message . $caller->language->question_ender; + + if( $caller->language->upper_case_initial ) + { + $message = ucfirst $message; } + + $session->write( $message ); + } else { + # Hack together the message + my $msg_field = 'parser_confused.msg'; + my $msg = strip_xml( $caller->$msg_field ); + $session->write($msg); + } } #}}} # Tries to find a prototype in an object to match a command, and if it # finds one, does necessary locking, runs the command and returns true. sub dispatch { #{{{ - my $reallydo = shift; # really lock and run command + my $reallydo = shift; # really lock and run command my $multobj = shift; # set if there are really multiple d.o's my $this = shift; # object to check my $prefix = shift; # prefix text to display before output my %sentence = @_; # the parameters of the command my ($command, $checknearby, $checktouchable, $checkvisible, - $lockpos, $lockmove, $checkopen) = - checkproto($this, $multobj, %sentence); - return 0 unless defined $command; - - # Now we have to lock some objects in position, and maybe - # check to make sure they're still nearby (to avoid races). - # - # Keeps locks open until the function returns, and keeps - # track of what is locked. - my %locked; + $lockpos, $lockmove, $checkopen, $prototype) = + checkproto($this, $multobj, %sentence); + return 0 unless defined $command; + #print STDERR "dispactch: $command, $checknearby, $checktouchable, $checkvisible, $lockpos, $lockmove, $checkopen.\n"; - if ($reallydo) { - # First, handle any objects that need to be locked for move. - # This is an exclusive lock. - foreach my $obj (@{$lockmove}) { - next if $locked{$obj->index}; - return unless $locked{$obj->index} = - $obj->getlock(LOCK_EX); - } + # Now we have to lock some objects in position, and maybe + # check to make sure they're still nearby (to avoid races). + # + # Keeps locks open until the function returns, and keeps + # track of what is locked. + my %locked; - # Then, lock any remaining objects that need to be locked, - # to prevent moving by third parties. This is a shared lock. - foreach my $obj (@{$lockpos}) { - next if $locked{$obj->index}; - return unless $locked{$obj->index} = - $obj->getlock(LOCK_SH); - } + if ($reallydo) { + # First, handle any objects that need to be locked for move. + # This is an exclusive lock. + foreach my $obj (@{$lockmove}) { + next if $locked{$obj->index}; + return unless $locked{$obj->index} = + $obj->getlock(LOCK_EX); } - - # The caller's location. - my $cloc=$caller->location; - # If the caller's location is itself in some location, use its - # location. - while ($cloc && $cloc->location) { - $cloc = $cloc->location; + + # Then, lock any remaining objects that need to be locked, + # to prevent moving by third parties. This is a shared lock. + foreach my $obj (@{$lockpos}) { + next if $locked{$obj->index}; + return unless $locked{$obj->index} = + $obj->getlock(LOCK_SH); } - - # Check to see if objects that must be touchable are. That means - # that every container between the user and the object must be - # open. - foreach my $obj (@{$checktouchable}) { - my $loc=$obj->location; - if (! $loc) { - next if $cloc == $obj; - return; - } - while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { - # The container the object is in needs to be locked - # in position to prevent it from being moved in - # the middle of a command. - if ($locked{$obj->index}) { - if (! $locked{$loc->index}) { - $locked{$loc->index} = $loc->getlock(LOCK_SH); - } - } - # And the container must be locked open, to prevent - # it from closing during the command. - if ($loc && ! $locked{"closed".$loc->index}) { - $locked{"closed".$loc->index} = $loc->getlock(LOCK_SH, "closed"); - } - # Only check its state after taking the lock. - if (! $loc || $loc->closed) { - $failreason="You can't touch that."; - return; - } - $loc=$loc->location; # advance to next container - } - return unless $loc; + } + + # The caller's location. + my $cloc=$caller->location; + # If the caller's location is itself in some location, use its + # location. + while ($cloc && $cloc->location) { + $cloc = $cloc->location; + } + + # Check to see if objects that must be touchable are. That means + # that every container between the user and the object must be + # open, or the objects must be otherwise accessible. + foreach my $obj (@{$checktouchable}) { + my $loc=$obj->location; + if (! $loc) { + next if $cloc == $obj; + return; } - - # Check to see if objects that must be nearby are. - foreach my $obj (@{$checknearby}) { - my $loc=$obj->location; - if (! $loc) { - next if $cloc == $obj; - return; + while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { + # The container the object is in needs to be locked + # in position to prevent it from being moved in + # the middle of a command. + if ($locked{$obj->index}) { + if (! $locked{$loc->index}) { + $locked{$loc->index} = $loc->getlock(LOCK_SH); } - while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { - # The container the object is in needs to be locked - # in position to prevent it from being moved in - # the middle of a command. - if ($locked{$obj->index}) { - if (! $locked{$loc->index}) { - $locked{$loc->index} = $loc->getlock(LOCK_SH); - } - } - $loc=$loc->location; # advance to next container + } + # And the container must be locked open, to prevent + # it from closing during the command. + if ($loc && ! $locked{"closed".$loc->index}) { + $locked{"closed".$loc->index} = $loc->getlock(LOCK_SH, "closed"); + } + # Only check its state after taking the lock. + if (! $loc || $loc->closed) { + # Check if the object is accessible anyways. + if( ! $loc + || ! grep( { $_ == $obj } $loc->accessible_contents ) ) + { + $failreason="You can't touch that."; + return; } - return unless $loc; + } + $loc=$loc->location; # advance to next container } + return unless $loc; + } - # Check to see if objects that must be visible are. This is nearly - # the same as the touchable test, except the contents of - # transparent containers are visible too, and so are things seem - # out of windows and so on. - foreach my $obj (@{$checkvisible}) { - my $loc=$obj->location; - my $lastloc; - if (! $loc) { - next if $cloc == $obj; - return; + # Check to see if objects that must be nearby are. + foreach my $obj (@{$checknearby}) { + my $loc=$obj->location; + if (! $loc) { + next if $cloc == $obj; + return; + } + while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { + # The container the object is in needs to be locked + # in position to prevent it from being moved in + # the middle of a command. + if ($locked{$obj->index}) { + if (! $locked{$loc->index}) { + $locked{$loc->index} = $loc->getlock(LOCK_SH); } - - while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { - # The container the object is in needs to be locked - # in position to prevent it from being moved in - # the middle of a command. - if ($locked{$obj->index}) { - if (! $locked{$loc->index}) { - $locked{$loc->index} = $loc->getlock(LOCK_SH); - } - } - - # And the container must be locked open and - # transparent, to prevent any changes while the - # command runs. - if ($loc && ! $locked{"closed".$loc->index}) { - $locked{"closed".$loc->index} = $loc->getlock(LOCK_SH, "closed"); - } - if ($loc && ! $locked{"transparent".$loc->index}) { - $locked{"transparent".$loc->index} = $loc->getlock(LOCK_SH, "transparent"); - } - # Only check its state after taking the lock. - if (! $loc || ($loc->closed && ! $loc->transparent)) { - $lastloc=$loc if $loc; - # Before giving up, check to see if the - # object is visible through a window or - # something. A container can indicate - # windowlike things by simply listing the - # objects out the window in its contents - # list. - if (grep { $_ == $lastloc || $_ == $obj } - $cloc->contents->list) { - last; # success - } - return; # failure - } - - $loc=$loc->location; # advance to next container - } - return unless $loc; + } + $loc=$loc->location; # advance to next container } - - # Check to see if containers that should be open are, and lock them - # to keep them open. - foreach my $obj (@{$checkopen}) { - if (! $locked{"closed".$obj->index}) { - $locked{"closed".$obj->index} = $obj->getlock(LOCK_SH, "closed"); + return unless $loc; + } + + # Check to see if objects that must be visible are. This is nearly + # the same as the touchable test, except the contents of + # transparent containers are visible too, and so are things seem + # out of windows and so on. + foreach my $obj (@{$checkvisible}) { + my $loc=$obj->location; + my $lastloc; + if (! $loc) { + next if $cloc == $obj; + return; + } + + while ($loc && ($loc != $caller && $cloc != $loc && $cloc != $obj)) { + # The container the object is in needs to be locked + # in position to prevent it from being moved in + # the middle of a command. + if ($locked{$obj->index}) { + if (! $locked{$loc->index}) { + $locked{$loc->index} = $loc->getlock(LOCK_SH); } - if ($obj->closed) { - return; + } + + # And the container must be locked open and + # transparent, to prevent any changes while the + # command runs. + if ($loc && ! $locked{"closed".$loc->index}) { + $locked{"closed".$loc->index} = $loc->getlock(LOCK_SH, "closed"); + } + if ($loc && ! $locked{"transparent".$loc->index}) { + $locked{"transparent".$loc->index} = $loc->getlock(LOCK_SH, "transparent"); + } + # Only check its state after taking the lock. + if (! $loc || ($loc->closed && ! $loc->transparent)) { + $lastloc=$loc if $loc; + # Before giving up, check to see if the + # object is visible through a window or + # something. A container can indicate + # windowlike things by simply listing the + # objects out the window in its contents + # list, or using visiblecontents. + if( grep { $_ == $lastloc || $_ == $obj } $cloc->contents->list + || grep { $_ == $lastloc || $_ == $obj } $cloc->visiblecontents + ) { + last; # success } + return; # failure + } + + $loc=$loc->location; # advance to next container } - - return 1 unless $reallydo; + return unless $loc; + } - $command=$command."_verb"; + # Check to see if containers that should be open are, and lock them + # to keep them open. + foreach my $obj (@{$checkopen}) { + if (! $locked{"closed".$obj->index}) { + $locked{"closed".$obj->index} = $obj->getlock(LOCK_SH, "closed"); + } + if ($obj->closed) { + return; + } + } + + return 1 unless $reallydo; + + $command=$command."_verb"; + + foreach my $object_type (@cmd_parse_object) + { # Fix up direct and indirect objects, removing the array # they're nested in. Assuming they are parameters.. - $sentence{direct_object} = $sentence{direct_object}[0] - if ref $sentence{direct_object} eq 'ARRAY'; - $sentence{indirect_object} = $sentence{indirect_object}[0] - if ref $sentence{indirect_object} eq 'ARRAY'; - - finished("prepping command"); + $sentence{$object_type} = $sentence{$object_type}[0] + if ref $sentence{$object_type} eq 'ARRAY'; + } - if (length $prefix) { - $session->write($prefix); + + # Deal with aliasing + foreach my $section (split(/\s*,\s*/, $prototype)) { + my ($part, $limits) = $section =~ /([\w=]+)\s*(?:\((.*)\))?/; + if( $part =~ m/=/ ) + { + $part =~ m/(.*)=(.*)/; + my ( $alias, $name ) = ( $1, $2 ); + if( $sentence{$name} ) + { + $sentence{$alias} = $sentence{$name}; + delete $sentence{$name}; + } + $part = $alias; } + } + finished("prepping command"); - return runcommand($this, $command, \%sentence); + if (length $prefix) { + $session->write($prefix); + } + + return runcommand($this, $command, \%sentence); } #}}} # Runs a particular command and deals with its return code. sub runcommand { #{{{ - my $this=shift; - my $command=shift; - my %sentence=%{shift()}; - - my @ret = $this->$command(avatar => $caller, session => $session, %sentence); - my $retcode = $? >> 8; - return 1 unless $retcode; + my $this=shift; + my $command=shift; + my %sentence=%{shift()}; + #print STDERR "runcommand: $command, ".Dumper(\%sentence)."\n"; - if ($retcode == Mooix::Verb::SETIT) { - # Set "it". Actually, just call recent_obj, and this could be - # used to set "them" too. - recent_obj(@ret); - return 1; - } - elsif ($retcode == Mooix::Verb::SETITREF) { - # Set "it", but this is for objects that can be treated as - # references. - foreach (@ret) { - $_->[ISREF] = 1; - } - recent_obj(@ret); - return 1; - } - elsif ($retcode == Mooix::Verb::FAIL) { - if (@ret && length $ret[0]) { - $session->write(@ret); - } - $stop = 1; # stop processing of any other pending commands.. - return 1; - } - elsif ($retcode == Mooix::Verb::EXIT) { - $loop = 0; - return 1; - } + if( ! $this->implements( $command ) ) + { + # FIXXX: This could use a nice error message like "that + # object doesn't implement that verb!" return 0; -} #}}} + } -# Given a number or one of a few known words that can be used to quantify a -# set of objects, and an array of objects that might be meant, returns -# either undef if the two don't make sense together, or an array of -# unambiguously quantified objects. -sub check_quantification { #{{{ - my $quant = lc(shift); - my @objs = @{shift()}; - - if ($quant eq 'all' || $quant eq 'every') { - # easy enough; all match + my @ret = $this->$command(avatar => $caller, session => $session, %sentence); + my $retcode = $? >> 8; + return 1 unless $retcode; + + if ($retcode == Mooix::Verb::SETIT) { + # Set "it". Actually, just call recent_obj, and this could be + # used to set "them" too. + $lang_to_grammar{recent_obj}->(@ret); + return 1; + } + elsif ($retcode == Mooix::Verb::SETITREF) { + # Set "it", but this is for objects that can be treated as + # references. + foreach (@ret) { + $_->[ISREF] = 1; } - elsif ($quant eq 'both') { - # so there must be exactly two objects - if (@objs > 2) { - $failreason = "There are more than two."; - return; - } - elsif (@objs < 2) { - $failreason = "There is only one."; - return; - } + $lang_to_grammar{recent_obj}->(@ret); + return 1; + } + elsif ($retcode == Mooix::Verb::FAIL) { + if (@ret && length $ret[0]) { + $session->write(@ret); } - elsif ($quant eq 'any' || $quant eq 'either' || $quant eq 'either one') { - # pick one of the objects at random, ditch the rest - @objs=$objs[rand @objs] - } - elsif ($quant eq 'several') { - # "Consisting of a number more than two, but not very many" - # -- websters - # TODO I should really permute the array first. Same with - # next two elsifs. - my $num=3 + rand(2); # 3 to 5 - @objs=grep { $_ } @objs[0..$num - 1]; - } - elsif ($quant eq 'some') { - # Whatever, between a third and a fifth? - my $num = @objs / (3 + rand(2)); - if ($num < 2) { $num = 2 } - @objs=grep { $_ } @objs[0..$num - 1]; - } - elsif ($quant eq 'most') { - @objs=grep { $_ } @objs[0..$#objs / 0.9]; - } - elsif ($quant eq 'couple' || $quant eq 'few') { - # Take two. - @objs=grep { $_ } @objs[0..1]; - } - elsif ($quant + 0 != 0) { - if ($quant > @objs) { - $failreason="There ".(@objs == 1 ? "is" : "are"). - " only ".scalar @objs."."; - return; - } - @objs=@objs[0..$quant - 1]; - } - else { - return; - } - - # Quantifying objects disambiguates them. - map { delete $_->[ISAMB] } @objs; - return \@objs; + $stop = 1; # stop processing of any other pending commands.. + return 1; + } + elsif ($retcode == Mooix::Verb::EXIT) { + $loop = 0; + return 1; + } + return 0; } #}}} +## # Given a number or one of a few known words that can be used to quantify a +## # set of objects, and an array of objects that might be meant, returns +## # either undef if the two don't make sense together, or an array of +## # unambiguously quantified objects. +## sub check_quantification { #{{{ +## my $quant = lc(shift); +## my @objs = @{shift()}; +## +## if ($quant eq 'all' || $quant eq 'every') { +## # easy enough; all match +## } +## elsif ($quant eq 'both') { +## # so there must be exactly two objects +## if (@objs > 2) { +## $failreason = "There are more than two."; +## return; +## } +## elsif (@objs < 2) { +## $failreason = "There is only one."; +## return; +## } +## } +## elsif ($quant eq 'any' || $quant eq 'either' || $quant eq 'either one') { +## # pick one of the objects at random, ditch the rest +## @objs=$objs[rand @objs] +## } +## elsif ($quant eq 'several') { +## # "Consisting of a number more than two, but not very many" +## # -- websters +## # TODO I should really permute the array first. Same with +## # next two elsifs. +## my $num=3 + rand(2); # 3 to 5 +## @objs=grep { $_ } @objs[0..$num - 1]; +## } +## elsif ($quant eq 'some') { +## # Whatever, between a third and a fifth? +## my $num = @objs / (3 + rand(2)); +## if ($num < 2) { $num = 2 } +## @objs=grep { $_ } @objs[0..$num - 1]; +## } +## elsif ($quant eq 'most') { +## @objs=grep { $_ } @objs[0..$#objs / 0.9]; +## } +## elsif ($quant eq 'couple' || $quant eq 'few') { +## # Take two. +## @objs=grep { $_ } @objs[0..1]; +## } +## elsif ($quant + 0 != 0) { +## if ($quant > @objs) { +## $failreason="There ".(@objs == 1 ? "is" : "are"). +## " only ".scalar @objs."."; +## return; +## } +## @objs=@objs[0..$quant - 1]; +## } +## else { +## return; +## } +## +## # Quantifying objects disambiguates them. +## map { delete $_->[ISAMB] } @objs; +## return \@objs; +## } #}}} + # Prepare for parsing by populating $nouns with all the names # of the passed objects (and recently referred to objects, sometimes). # At the same time, build up a name -> object hash. Do the same stuff # for adjectives. sub prepparser { #{{{ - my @objs=@_; + my @objs=@_; + $caller->debuglog(type => "info", message => "stripping.\n" ); - # Dedup list and add to @known, preserving order. - my %seen; - @known=(); - foreach (@objs) { - push @known, $_ unless exists $seen{$_->index}; - $seen{$_->index}=1; + # Dedup list and add to @known, preserving order. + my %seen; + @known=(); + foreach (@objs) { + push @known, $_ unless exists $seen{$_->index}; + $seen{$_->index}=1; + } + + %nametoobj=(); + %adjtoobj=(); + foreach (@known) { + # Note the values of the nametoobj hash are array refs, + # where the second array element is 1 if the name is + # plural. + foreach my $name (map { lc( strip_xml( $_ ) ) } $_->name, $_->alias) { + $caller->debuglog(type => "info", message => "stripped name is: ". $name ); + push @{$nametoobj{$name}}, [ $_, 0 ]; + # Stupid pluralization. + push @{$nametoobj{$name."s"}}, [ $_, 1 ]; } - - %nametoobj=(); - %adjtoobj=(); - foreach (@known) { - # Note the values of the nametoobj hash are array refs, - # where the second array element is 1 if the name is - # plural. - foreach my $name (map { lc $_ } $_->name, $_->alias) { - push @{$nametoobj{$name}}, [ $_, 0 ]; - # Stupid pluralization. - push @{$nametoobj{$name."s"}}, [ $_, 1 ]; - } - # Non-stupid pluralization. - foreach my $name ($_->plural_name) { - push @{$nametoobj{lc($name)}}, [ $_, 1 ]; - } + # Non-stupid pluralization. + foreach my $name (map { lc( strip_xml( $_ ) ) } $_->plural_name) { + push @{$nametoobj{lc($name)}}, [ $_, 1 ]; + } - foreach my $adjective ($_->adjective) { - push @{$adjtoobj{lc($adjective)}}, $_; - } + foreach my $adjective (map { lc( strip_xml( $_ ) ) } $_->adjective) { + push @{$adjtoobj{lc($adjective)}}, $_; } - - $nouns=genregex(keys %nametoobj); - $adjectives=genregex(keys %adjtoobj); + } } #}}} # Given a list of words, this generates and returns a regex that matches # any of the words. sub genregex { #{{{ - # The sort ensures that it matches long words even if a shorter - # word is a subset of the long one. - # An empty item in the alternation can make the parser hang, if - # so detect them and skip em. - $_=join('|', reverse sort { $a cmp $b } grep { length $_ } @_); - if (! length $_) { - # An expty regex could make the parser hang.. - $_="\n\n"; # impossible string - } - $_=qr/$_/i; # is this really useful? + # The sort ensures that it matches long words even if a shorter + # word is a subset of the long one. + # An empty item in the alternation can make the parser hang, if + # so detect them and skip em. + $_=join('|', reverse sort { $a cmp $b } grep { length $_ } @_); + if (! length $_) { + # An expty regex could make the parser hang.. + $_="\n\n"; # impossible string + } + $_=qr/$_/i; # is this really useful? return $_; } #}}} @@ -1149,214 +1476,234 @@ my $lasttime; my $starttime; sub starting { #{{{ - return unless $timings; - require Time::HiRes; - $lasttime=$starttime=$timepoints{start} = Time::HiRes::time(); + return unless $timings; + require Time::HiRes; + $lasttime=$starttime=$timepoints{start} = Time::HiRes::time(); } #}}} sub finished { #{{{ - return unless $timings; - my $point = shift; - require Time::HiRes; - $timepoints{$point} = Time::HiRes::time(); - print STDERR "[$point took ".($timepoints{$point} - $lasttime)." secs (".($timepoints{$point} - $starttime)." secs total)]\n"; - $lasttime = $timepoints{$point}; + return unless $timings; + my $point = shift; + require Time::HiRes; + $timepoints{$point} = Time::HiRes::time(); + print STDERR "[$point took ".($timepoints{$point} - $lasttime)." secs (".($timepoints{$point} - $starttime)." secs total)]\n"; + $lasttime = $timepoints{$point}; } #}}} # The main subroutine. run sub { #{{{ - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; - $session = $_{session} or $this->parser_usage("bad session"); - $caller = $this; - $pronouns{me} = $pronouns{my} = $pronouns{myself} = $pronouns{i} = [$caller]; - - # To cut down on startup speed, use the precompiled Grammar.pm, unless - # the grammar file is newer. - my $gpm = $this->parser->fieldfile("Grammar.pm"); - my $gra = $this->parser->fieldfile("grammar"); - if (! $gpm || (stat($gpm))[9] < (stat($gra))[9]) { - $session->write("Compiling grammar, please wait.."); - $this->parser->compilegrammar; - $gpm = $this->parser->fieldfile("Grammar.pm"); + my $command; + my $command_run=0; + + # This facility allows command to run exactly one more-or-less + # artifical command against the parser. + if( $_{command} ) + { + $command = $_{command}; + } + + $session = $_{session} or $this->parser_usage("bad session"); + $caller = $this; + + # Init now, and reinit on HUP. + init(); + $SIG{HUP}=\&init; + + $loop = 1; + while ($loop) { + # If we were passed a command, we only do the one. + if( $_{command} ) + { + if( $command_run ) + { + last; + } else { + $command_run = 1; + } } - require $gpm; #sorta gross, but what the hey - # It's "myGrammar" because that's the module name used. See - # compilegrammar. - $parser = myGrammar->new; - - # Load in file and compile a sub to do preparsing substitutions. - my $subst = eval 'sub { $_=shift;'.$this->parser_shortcuts."\n".';$_}'; - if ($@) { - $subst = sub {return shift}; # do nothing sub - warn "shortcuts broken: $@"; + + if( $caller->reset_parse ) + { + # print STDERR "Resetting.\n"; + $caller->reset_parse( 0 ); + delete @prompt[1 .. $#prompt]; + my $gram = "my" . $caller->language->code . "Grammar"; + delete $::{"${gram}::"}; + delete $::{"$gram"}; + init(); } - # Set up a few of the parts of speech that don't change - # dynamically. These are referenced by the grammar. - $prepositions = genregex($this->parser_prepositions); - $pronouns = genregex($this->parser_pronouns); - $quantifiers=genregex(qw{all both any every several some few couple - most either}, "either one"); - - # There are no answers, at first. - $answers = genregex(); - - # Let a verb be anything that looks like a word. Starting the - # beginning of a sentence is enough of a disambiguator. - $verbs = qr/\w+/; + if( $dynprompt == 1 ) { + @prompt=(prompt => $caller->prompt); + } elsif( $dynprompt == 2 ) { + @prompt=(prompt => $caller->language->prompt); + } - # Init now, and reinit on HUP. - init(); - $SIG{HUP}=\&init; - - $loop = 1; - while ($loop) { - if ($dynprompt) { - @prompt=(prompt => $caller->prompt); + # Only want to prompt if we don't already have a command. + if( ! $_{command} ) + { + $command = $session->prompt( + # Pass in pronouns as completions. + completions => completions(), + @prompt + ); + } + + starting(); + last unless defined $command; + $command=~s/\s+$//; + chomp $command; + next if ! length $command; + $command=$subst->($command); + + finished('preprocessing'); + + # Do this after the prompt, and not before, so that any + # changes that occur while the user is entering text can be + # understood. + my @nearbyobjs=nearbyobjs(); + prepparser(@nearbyobjs); + + $adjectives=genregex(keys %adjtoobj); + + build_nouns(); + + reset_it(); + + # Various functions will try to set this to something + # sane depending on type of failure. + $failreason=""; + %incomplete=(); + + finished("gathering info"); + + # Do parsing, trap errors and display portion that failed + # to match. + my $origcommand=$command; + my $pt = $parser->input(\$command); + ## print STDERR "pt: ".Dumper($pt).".\n"; + + if ($failreason) { + $session->write($failreason); + } + elsif (length $command) { + if ($command !~ /"/ && $command !~ /\{.*\}/) { + # So there was something at the end that could not + # be parsed. Most likely it was intended to be a + # quote, so quote it and re-inject it into the + # parser. Note that I re-inject, instead of just + # adding a quote to the existing parsed sentence, + # because it often parses it wrong w/o the known + # quote at the end. + $command=~s/^\s*//; + my $quote=$command; + my $command=$origcommand; + $command=~s/\Q$quote\E$/"$quote"/; + my $incommand=$command; + $pt = $parser->input(\$command); + if ($failreason) { + $session->write($failreason); + } + if (length $command) { + $session->write("It's not clear what you mean by \"$quote\"."); + next; + } + else { + # Help the user learn. + $session->write("(Guessing that you meant to type: $incommand ...)"); + } + } + else { + # Let the block below handle this failure. + $pt = undef; + } + } + if (! defined $pt) { + # Whole command failed to parse, but was all + # consumed by parser. + $command=$origcommand; + $command=~s/^\s*\w+\s+//; + $session->write("It's not clear what you mean by \"$command\"."); + } + next unless ref $pt; # null command + + finished("parsing"); + + # Find an object that can handle each command and dispatch + # to them. + $stop = 0; + foreach my $sentence (@{$pt}) { + last if $stop; + + $caller->debuglog(type => "command", message => sub { + # This sub is a callback that will be + # called only if the log is sent to the + # debugger. + my @dbg; + foreach my $part (keys %$sentence) { + my $val=$sentence->{$part}; + next unless defined $val; + if (ref $val eq 'ARRAY') { + $val=join(" ", @$val); + } + elsif ($val !~ /^[A-Za-z0-9_]+$/) { + $val=qq{"$val"}; + } + push @dbg, "$part($val)"; + } + return join(", ", @dbg); + }); + + # Did the user perhaps answer a question? + if ($anshandler) { + if (! exists $sentence->{verb}) { + next if $anshandler->(%$sentence); } - my $command = $session->prompt( - # Pass in pronouns as completions. - completions => join('|', 'here', 'all', 'everything', - grep { $_ ne 'i' } keys %pronouns), - @prompt - ); - starting(); - last unless defined $command; - $command=~s/\s+$//; - chomp $command; - next if ! length $command; - $command=$subst->($command); + $anshandler=undef; + } - finished('preprocessing'); - - # Do this after the prompt, and not before, so that any - # changes that occur while the user is entering text can be - # understood. - my @nearbyobjs=nearbyobjs(); - prepparser(@nearbyobjs); - - # Unset the ISREF field, it is no longer relevant if the - # object is nearby now. This takes care of 'teleport mooix:foo - # here and look at it'. - if ($pronouns{it} && grep { $pronouns{it}->[0] == $_ } @nearbyobjs) { - $pronouns{it}->[0]->[ISREF] = undef; + my $is_multi_obj=0; + foreach my $object_type (@cmd_parse_object) + { + # Multiple objects? + if( $sentence->{$object_type} && + @{$sentence->{$object_type}} > 1) + { + $is_multi_obj=1; } - - # Various functions will try to set this to something - # sane depending on type of failure. - $failreason=""; - %incomplete=(); - - finished("gathering info"); - - # Do parsing, trap errors and display portion that failed - # to match. - my $origcommand=$command; - my $pt = $parser->input(\$command); - - if ($failreason) { - $session->write($failreason); - } - elsif (length $command) { - if ($command !~ /"/ && $command !~ /\{.*\}/) { - # So there was something at the end that could not - # be parsed. Most likely it was intended to be a - # quote, so quote it and re-inject it into the - # parser. Note that I re-inject, instead of just - # adding a quote to the existing parsed sentence, - # because it often parses it wrong w/o the known - # quote at the end. - $command=~s/^\s*//; - my $quote=$command; - my $command=$origcommand; - $command=~s/\Q$quote\E$/"$quote"/; - my $incommand=$command; - $pt = $parser->input(\$command); - if ($failreason) { - $session->write($failreason); - } - if (length $command) { - $session->write("It's not clear what you mean by \"$quote\"."); - next; - } - else { - # Help the user learn. - $session->write("(Guessing that you meant to type: $incommand ...)"); - } - } - else { - # Let the block below handle this failure. - $pt = undef; - } - } - if (! defined $pt) { - # Whole command failed to parse, but was all - # consumed by parser. - $command=$origcommand; - $command=~s/^\s*\w+\s+//; - $session->write("It's not clear what you mean by \"$command\"."); - } - next unless ref $pt; # null command - - finished("parsing"); - - # Find an object that can handle each command and dispatch - # to them. - $stop = 0; - foreach my $sentence (@{$pt}) { - last if $stop; - - $caller->debuglog(type => "command", message => sub { - # This sub is a callback that will be - # called only if the log is sent to the - # debugger. - my @dbg; - foreach my $part (keys %$sentence) { - my $val=$sentence->{$part}; - next unless defined $val; - if (ref $val eq 'ARRAY') { - $val=join(" ", @$val); - } - elsif ($val !~ /^[A-Za-z0-9_]+$/) { - $val=qq{"$val"}; - } - push @dbg, "$part($val)"; - } - return join(", ", @dbg); - }); - - # Did the user perhaps answer a question? - if ($anshandler) { - if (! exists $sentence->{verb}) { - next if $anshandler->(%$sentence); - } - $anshandler=undef; - } + } - # Multiple direct objects? - if ($sentence->{direct_object} && - @{$sentence->{direct_object}} > 1) { - next if do_multobj_sentence(%$sentence); - } - else { - next if do_sentence(1, 0, "", %$sentence); - showfailure("", %$sentence); - } - - last; - } - - if ($debugger && ! $Mooix::Thing::debugging) { - # Force debugging back on. In case the user had - # disallowed all debugging, or debugging by this - # object, and the command turned it back on. If - # debugging is still off, it will be turned off - # again next time something is logged. - $caller->debugger($debugger); - } - - finished("running command"); + if( $is_multi_obj == 1 ) + { + print STDERR "Calling do_multiobj.\n"; + next if do_multobj_sentence(%$sentence); + print STDERR "Done calling do_multiobj.\n"; + } else { + next if do_sentence(1, 0, "", %$sentence); + showfailure("", %$sentence); + } + + last; } - return; + + if ($debugger && ! $Mooix::Thing::debugging) { + # Force debugging back on. In case the user had + # disallowed all debugging, or debugging by this + # object, and the command turned it back on. If + # debugging is still off, it will be turned off + # again next time something is logged. + $caller->debugger($debugger); + } + + finished("running command"); + + # If we were passed a command, we only do the one. + if( $_{command} ) + { + last; + } + } + return; }; #}}} Index: obj/system/admin/multilingual.hlp.en =================================================================== --- obj/system/admin/multilingual.hlp.en (revision 0) +++ obj/system/admin/multilingual.hlp.en (revision 0) @@ -0,0 +1,62 @@ +How to set up mooix to be properly multilingual + +Caveats: + + Making multilingualism work in mooix was a multi-month project; + I can't guarantee that I didn't miss something in this how-to. + + PLEASE NOTE: No work was done on UTF-8 or other high byte + handling! + + The language I was using (Lojban, see http://www.lojban.org/) is + expressible in ASCII, and I don't know enough C or enough about + UTF-* to know how to make things work properly at the C level. + + I would be VERY HAPPY if someone else made mooix UTF-8 safe! + + All of the multilingualism work was done by Robin Powell, aka + rlpowell@digitalkingdom.org; all comments, questions, and bug + reports on the multilingual code should be directed to him. + + -Robin Lee Powell, 2 Jan 2005 + +mooix now has full support for multilingual MOOs, that is, MOOs in +which different users are interacting with the MOO, and seeing the +MOO presented in, different languages. + +To change the moo's default language, alter the "language" reference +on the mooix:abstract/avatar to point to a different language. + +To activate or deactivate a language's availability to your users: + + edit mooix:abstract/language/languages list + +Adding a brand new language is a detailed and complicated +undertaking! It consists of basically two parts: making a new +language object, and translating lots of stuff. + +Making a new language object: + + Look at the objects under mooix:abstract/language (except + languages; that's just a list of valid languages). Copy one of + them, and update basically every field in it. + + The hard part is making a new grammar. The grammar file is a + grammatical definition in Parse::RecDescent. You'll want the + man files for that installed. + +Translating lots of stuff: + + To have things actually work properly, you'll need to translate + *large* volumes of text. Start with running something like: + + find /usr/lib/mooix/ /var/lib/mooix/ -name '*.msg' + + for a list of message files. + + You'll also need to make new .cmd files in your language to + match your verb names (at least), and new .hlp files as well. + + One of my users wrote scripts to list out untranslated msg and + cmd files; let me (rlpowell@digitalkingdom.org) know if you want + a copy. Index: obj/system/admin/reglog_verb =================================================================== --- obj/system/admin/reglog_verb (revision 23) +++ obj/system/admin/reglog_verb (working copy) @@ -6,8 +6,9 @@ %_=@_; # Don't let a someone spoof an admin that they own to call this method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } $_{session}->page($Mooix::Root->system->reglog->format(reverse => 1)); Index: obj/system/admin/reparent_verb =================================================================== --- obj/system/admin/reparent_verb (revision 23) +++ obj/system/admin/reparent_verb (working copy) @@ -6,8 +6,9 @@ %_=@_; # Don't let a someone spoof an admin that they own to call this method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } $this->super(avatar_reparent_ok => 1, @_); Index: obj/system/admin/reglog.hlp =================================================================== --- obj/system/admin/reglog.hlp (revision 23) +++ obj/system/admin/reglog.hlp (working copy) @@ -1,6 +0,0 @@ -Display the registration log. - -The reglog command displays the registration log, which holds both pending -and complete user registration information. Note that the reglog defaults -to holding only the most recent 500 registrations. Only an =admin= can -view the reglog, since it contains confidential information. Index: obj/system/admin/admin-guide.hlp =================================================================== --- obj/system/admin/admin-guide.hlp (revision 23) +++ obj/system/admin/admin-guide.hlp (working copy) @@ -1,159 +0,0 @@ -Mooix Administrator's Guide - -So you have mooix installed and running. Now what? - -First, I suggest you read the =programmer-tutorial= up until it starts -talking about the specifics of programming. That will give you a good -overview of how the moo works, and how to edit stuff in the moo. The -=builder-tutorial= is also useful reading. - -Mooadmin user: - - There is a special user called "mooadmin" (aka "admin" or "god") that - root can log in as. This is the user you can use to perform - administrative duties. The regular permissions system does not apply when - you're logged in as this user; like unix's root account it can do - anything. Use it with care. You can log in as the moo admin with the - command "moologin admin", run as root. - - (Maybe you already did that, if you're reading this help in the moo..) - -Setting up guests: - - Mooix comes with the ability to host guests turned on. This lets anyone - on the local system log into the moo using a temporary guest account. - - If you want to expand this to the world at large, you need only make a - user in /etc/passwd have an empty password and a shell of - /usr/bin/moologin (or wherever you installed moologin), and anyone can - log into your system remotely, and get a guest login. (If they're logging - in via ssh, you may need to configure ssh to allow empty passwords, for - this to work.) Note that since ssh allows anyone who can log in to do - evil port forwarding stuff, you will probably need to turn that off, or - deal with it. Don't assume ssh is secure. - - It is recommended that you configure telnet, ssh, etc, to not display - what host the user last logged in from; a .hushlogin file in the guest - account's home directory may be helpful in accomplishing that. The moo, - when installed, makes a directory /usr/share/mooix/guesthome/ (path may - vary) that has such a file, and can be used as the home directory of a - guest user. - - To quickly set up a "moo" account that can log in as a guest, with no - password, using the useradd program, run this command: - - useradd -c "moo guest account" -d /usr/share/mooix/guesthome/ \ - -p "" -s /usr/bin/moologin moo - - If instead you want to disable guests, just type: - mooix:system/guestmanager isn't enabled - -Enabling remote logins: - - Remote users can access the moo by telneting or sshing into the regular - unix system, and running "moologin". If you set up a guest account as - described above, guests can telnet or ssh into your moo using it. - - However, many users will probably want to use more traditional MUD - clients such as TinyFugue to log into the moo. These clients expect a - more traditional interface, and to make them work with the moo, - you must enable the in.mooix(8) login server, in inetd. Consult its man - page for details. - -Letting existing users use the moo: - - The unix makeavatar(8) command can be used to create avatars for existing - users of your unix system, and is the easiest way to give existing users - access to the moo. See its man page for details. - -Setting up user registration: - - Mooix can be configured to allow guests to register for real user - accounts. The registration process is as follows: - - - Someone logged in to the guest account runs the "register" - command. - - They answer a few questions that include their name and email - address. - - A password is generated for them, and it is mailed to them. - - They then tell the moo the password, and their account is set up. - - This provides a fair level of assurance that we know the email addresses - of all of the users of the moo. That's not much, but it's better than - nothing. - - The "register" command will only work if the guest has their register_ok - field set. By default, mooix:abstract/guest does not, so to enable this - registration process, you need to use: - mooix:abstract/guest is register_ok - - The moo administrator can use the =reglog= command to view the log of - registrations, both pending, and complete. - -Making Builders: - - Users who are builders can create objects inside the moo. They cannot - write methods though. - - You make someone a builder by changing the parent of their avatar to - mooix:abstract/builder with the =reparent= command. - -Making Programmers: - - Users who are programmers can edit fields and methods from inside the - moo. Note that making a user a programmer is equivalent to giving them - shell access to your machine (as their user id), as there is nothing - stopping them from writing a program that runs any command they like. - So don't make people programmers unless you trust them at that level. - - You make someone a programmer by changing the parent of their avatar to - mooix:abstract/programmer - -Miscellaneous settings: - - There are a lot of miscellaneous settings that a moo admin might want to - tweak, and this section will list some of them. - - The mooinfo object (mooix:system/mooinfo) has some useful fields. The - first one to change is the mooname field, which holds the name of the - moo. You may also find it useful to set the hostname field. - - The mooadmin's user's field holds a list of users who can log in as the - mooadmin. - - The sessionmanager object (mooix:system/sessionmanager) is what brokers - logins to the moo. Its allowlogin field must be set to a true value or - new logins are not allowed at all. - - The sesisonmanager's avatars list (mooix:system/sessionmanager/avatars) - holds references to all the avatars that are allowed to log into the moo. - You can =edit= that list to remove users to keep them from logging in. - - The sessionmanager's sessions list (mooix:system/sessionmanager/sessions) - holds all currently logged-in sessions. - - The guestmanager (mooix:system/guestmanager) is what brokers requests for - guests. Its adjectives field hold a list of adjectives used for guest's - names (by default, it uses colors). Only as many guests as there are - adjectives in the file can log in at a time. - - The home field of mooix:abstract/avatar points to the room where new - users start out by default. That room, which defaults to - mooix:system/entrance, is the entryway of your moo. - - Similarly, the home field of mooix:abstract/guest points to the room - where new guests start out by default. - - The combat_ok field of an avatar may be unset to not let that avatar - engage in combat or damage anything in the moo. It is, by default, unset - for guests, and set for all other avatars. - - The editor field of an avatar controls what editor they can use to edit - stuff in the moo. You can set the avatar field of mooix:abstract/avatar - to control this on a global basis. Since the editor is used by users who - do not have shell accounts, it must be a restricted editor, that does not - allow writing aritrary files, or executing shell commands. You should - probably pick a restricted editor that does not allow reading in of - arbitrary text files (like /etc/passwd) to avoid information leakage. It - should only edit the file specified on the command line. Note that rvim - fails this last criteria. The default is rjoe. Index: obj/system/admin/admin.hlp =================================================================== --- obj/system/admin/admin.hlp (revision 23) +++ obj/system/admin/admin.hlp (working copy) @@ -1,9 +0,0 @@ -Administering the moo. - -As the moo administrator, you have special powers -- you can edit any field -of any object. You can also do anything any other =programmer= can do. - -If you've just installed mooix, you should probably read the =admin-guide= -which will guide you through customizing the moo. - -See also: =basics=, =builder=, =programmer=. Index: obj/system/sessionmanager/login =================================================================== --- obj/system/sessionmanager/login (revision 23) +++ obj/system/sessionmanager/login (working copy) @@ -50,10 +50,29 @@ unless ($_{nobanner}) { my $banner=$this->banner; if (length $banner) { - $session->write($banner); + $session->write( + $avatar->dexml( + avatar => $avatar, + text => $banner, + ) + ); + } } - $session->write("Logging in as ".$avatar->name."."); + $session->write( + $avatar->dexml( + avatar => $avatar, + text => $this->login_pre1, + ) . + $avatar->dexml( + avatar => $avatar, + text => $avatar->name, + ) . + $avatar->dexml( + avatar => $avatar, + text => $this->login_pre2, + ) + ); } my $lastlogid; Index: obj/system/sessionmanager/logout =================================================================== --- obj/system/sessionmanager/logout (revision 23) +++ obj/system/sessionmanager/logout (working copy) @@ -10,6 +10,7 @@ # This method should be run by reap or directly via runmeth. # Or, it can be run by a the avatar who the session belongs to. my $avatar=$session->avatar; + my $stack=Mooix::CallStack->get; #$stack=$stack->nextsegment; my $b=0; @@ -30,7 +31,13 @@ # If we lost a race getting the lock, the session could be gone at # this point. if (-d $session->id) { - $session->write("Logging out.") unless $_{quiet}; + if( ! $_{quiet} && $avatar ) + { + $avatar->msg( 'logout', + onlyto => $avatar, + session => $session, + ); + } $session->avatar->logout(session => $session, quiet => $_{quiet}) if $session->avatar; # Record login duration to lastlog. if (ref $this->lastlog && ! $_{nolog}) { Index: obj/system/sessionmanager/login_pre1 =================================================================== --- obj/system/sessionmanager/login_pre1 (revision 0) +++ obj/system/sessionmanager/login_pre1 (revision 0) @@ -0,0 +1 @@ +Logging in as Index: obj/system/sessionmanager/login_pre2 =================================================================== --- obj/system/sessionmanager/login_pre2 (revision 0) +++ obj/system/sessionmanager/login_pre2 (revision 0) @@ -0,0 +1 @@ +. Index: obj/filter/base/unfilter_fail_none.msg =================================================================== --- obj/filter/base/unfilter_fail_none.msg (revision 0) +++ obj/filter/base/unfilter_fail_none.msg (revision 0) @@ -0,0 +1 @@ +session: Filter is not in place. Index: obj/filter/base/filter_fail.msg =================================================================== --- obj/filter/base/filter_fail.msg (revision 0) +++ obj/filter/base/filter_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Unable to add filter. Index: obj/filter/base/unfilter_verb =================================================================== --- obj/filter/base/unfilter_verb (revision 23) +++ obj/filter/base/unfilter_verb (working copy) @@ -7,21 +7,24 @@ # Only allow use by builders. unless ($_{avatar}->isa($Mooix::Root->abstract->builder)) { - fail "You can't do that."; + $avatar->msg( 'not_builder', %_ ); + fail(); } my $mf = $_{direct_object}->messagefilters; unless (ref $mf && grep $this, $mf->list) { - fail "Filter is not in place."; + $this->msg( 'unfilter_fail_none', %_ ); + fail(); } if (! $mf->remove(object => $this)) { - fail "Removal failed."; + $this->msg( 'unfilter_fail', %_ ); + fail(); } else { # In case the filter was multiply applied. 1 while $mf->remove(object => $this); } - $_{session}->write("Filter removed."); + $this->msg( 'unfilter', %_ ); } Index: obj/filter/base/filter_fail_already.msg =================================================================== --- obj/filter/base/filter_fail_already.msg (revision 0) +++ obj/filter/base/filter_fail_already.msg (revision 0) @@ -0,0 +1 @@ +session: Filter is already in place. Index: obj/filter/base/filter_fail_cannot.msg =================================================================== --- obj/filter/base/filter_fail_cannot.msg (revision 0) +++ obj/filter/base/filter_fail_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot apply filter to that object. Index: obj/filter/base/filter_verb =================================================================== --- obj/filter/base/filter_verb (revision 23) +++ obj/filter/base/filter_verb (working copy) @@ -8,20 +8,24 @@ # Only allow use by builders, since this command can be used for # some pretty evil stuff, like blinding avatars. unless ($_{avatar}->isa($Mooix::Root->abstract->builder)) { - fail "You can't do that."; + $avatar->msg( 'not_builder', %_ ); + fail(); } my $mf = $_{direct_object}->messagefilters; unless (ref $mf) { - fail "Cannot apply filter to that object."; + $this->msg( 'filter_fail_cannot', %_ ); + fail(); } if (grep $this, $mf->list) { - fail "Filter is already in place."; + $this->msg( 'filter_fail_already', %_ ); + fail(); } if (! $mf->add(object => $this)) { - fail "Unable to add filter."; + $this->msg( 'filter_fail', %_ ); + fail(); } - $_{session}->write("Filter applied. Use unfilter command to remove."); + $this->msg( 'filter', %_ ); } Index: obj/filter/base/unfilter_fail.msg =================================================================== --- obj/filter/base/unfilter_fail.msg (revision 0) +++ obj/filter/base/unfilter_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Filter removal failed. Index: obj/filter/base/filter.msg =================================================================== --- obj/filter/base/filter.msg (revision 0) +++ obj/filter/base/filter.msg (revision 0) @@ -0,0 +1 @@ +session: Filter applied. Use unfilter command to remove. Index: obj/filter/base/unfilter.msg =================================================================== --- obj/filter/base/unfilter.msg (revision 0) +++ obj/filter/base/unfilter.msg (revision 0) @@ -0,0 +1 @@ +session: Filter removed. Index: obj/contrib/bird/land =================================================================== --- obj/contrib/bird/land (revision 23) +++ obj/contrib/bird/land (working copy) @@ -21,7 +21,7 @@ push @objs, $this->location; my $dest=$objs[rand @objs]; if ($dest && $this->physics->move(object => $this, to => $dest, - preposition => "on")) { + relation => "on")) { $this->msg("landon") unless $_{quiet}; } else { Index: obj/contrib/telephone/answer_not_ringing.msg =================================================================== --- obj/contrib/telephone/answer_not_ringing.msg (revision 0) +++ obj/contrib/telephone/answer_not_ringing.msg (revision 0) @@ -0,0 +1 @@ +session: The phone is not ringing. Index: obj/contrib/telephone/answer_verb =================================================================== --- obj/contrib/telephone/answer_verb (revision 23) +++ obj/contrib/telephone/answer_verb (working copy) @@ -5,7 +5,8 @@ %_=@_; if (! $this->caller) { - fail "The phone is not ringing."; + $this->msg( 'answer_not_ringing', %_ ); + fail(); } if ($this->caller->target && $this->caller->target eq $this) { Index: obj/contrib/phonebook/look.cmd =================================================================== --- obj/contrib/phonebook/look.cmd (revision 23) +++ obj/contrib/phonebook/look.cmd (working copy) @@ -1,2 +1,10 @@ verb, direct_object(this)(visible), quote : read +# From "thing": +# look the ball verb, direct_object(this)(visible) +# look at the ball, look at the ball which is in the box +verb, do_preposition(at), direct_object(this)(visible) +# look the ball in the box +verb, direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look at the ball in the box +verb, do_preposition(at), direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in Index: obj/contrib/phonebook/read_verb =================================================================== --- obj/contrib/phonebook/read_verb (revision 23) +++ obj/contrib/phonebook/read_verb (working copy) @@ -30,7 +30,7 @@ lc $entry->number !~ /\Q$find\E/; } - my $n=$location->prettyname; + my $n=$location->prettyname( recipient => $_{avatar} ); push @results, ucfirst($n).(" " x (30 - length $n))." ". $entry->number; } Index: obj/contrib/toad/look_nothing.msg =================================================================== --- obj/contrib/toad/look_nothing.msg (revision 0) +++ obj/contrib/toad/look_nothing.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: An ugly toad. +session: You cannot see $this. Index: obj/contrib/toad/notice =================================================================== --- obj/contrib/toad/notice (revision 23) +++ obj/contrib/toad/notice (working copy) @@ -2,18 +2,25 @@ # This is very evil. Make toads incapable of understanding conversation. #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; - # Of course this would be better implemented if there was a - # "conversation" tag. - if ($_{sense} eq 'hear' && $_{event} =~ /(say|whisper|yell)/ && $_{originator} != $this) { - # And this just sucks. - my $name=$_{originator}->name; - if (length $_{originator}->article) { - $name=$_{originator}->article." ".$name; - } - $_{message} = ucfirst "$name says something that you cannot understand."; - } - $this->super(%_); + # Of course this would be better implemented if there was a + # "conversation" tag. + if ($_{sense} eq 'hear' && $_{event} =~ /(say|whisper|yell)/ && $_{originator} != $this) { + my $name=$_{message}; + my $msg_field="notice.msg"; + + # Grab the sender + $name =~ s/.*(.*?)<\/sender>.*/$1/; + + # Clear out all other tags + $name =~ s/<.*?>//g; + print STDERR "name: $name.\n"; + + # Fake .msg file + $_{message} = $this->dexml( avatar => $this, text => $this->$msg_field ); + $_{message} =~ s:\$name:$name:g; + } + $this->super(%_); } Index: obj/contrib/toad/directed_say.msg =================================================================== --- obj/contrib/toad/directed_say.msg (revision 23) +++ obj/contrib/toad/directed_say.msg (working copy) @@ -1 +1 @@ -hear: $avatar $avatar->verb(croaks) $do_preposition $direct_object. +hear: $avatar $avatar->verb(croaks) to $direct_object. Index: obj/contrib/toad/basics.hlp =================================================================== --- obj/contrib/toad/basics.hlp (revision 23) +++ obj/contrib/toad/basics.hlp (working copy) @@ -1,4 +0,0 @@ -You are a toad. This sucks. - -Someone powerful took a disliking to you, and you are now a toad. Sucks to -be you. Index: obj/contrib/toad/look.msg =================================================================== --- obj/contrib/toad/look.msg (revision 23) +++ obj/contrib/toad/look.msg (working copy) @@ -1,2 +1,2 @@ -see,session: $this->description\n$this->gender_subject_pronoun $this->verb(is,are) holding $contents in $this->gender_possessive_adjective mouth. -session: You cannot see $avatar. +see,session: An ugly toad.\n$this->gender_subject_pronoun $this->verb(is,are) holding $contents in $this->gender_possessive_adjective mouth. +session: You cannot see $this. Index: obj/contrib/toad/look_wearing_not_holding.msg =================================================================== --- obj/contrib/toad/look_wearing_not_holding.msg (revision 0) +++ obj/contrib/toad/look_wearing_not_holding.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: An ugly toad.\n$this->gender_subject_pronoun $this->verb(is,are) wearing $wearing. +session: You cannot see $this. Index: obj/contrib/toad/paste_verb =================================================================== --- obj/contrib/toad/paste_verb (revision 23) +++ obj/contrib/toad/paste_verb (working copy) @@ -1,5 +1,6 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - fail "No go, toad."; + $this->msg( 'paste_toad', %_ ); + fail(); } Index: obj/contrib/toad/look_wearing.msg =================================================================== --- obj/contrib/toad/look_wearing.msg (revision 0) +++ obj/contrib/toad/look_wearing.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: An ugly toad.\n$this->gender_subject_pronoun $this->verb(is,are) holding $contents in $this->gender_possessive_adjective mouth and wearing $wearing. +session: You cannot see $this. Index: obj/contrib/toad/notice.msg =================================================================== --- obj/contrib/toad/notice.msg (revision 0) +++ obj/contrib/toad/notice.msg (revision 0) @@ -0,0 +1 @@ +$name says something that you cannot understand. Index: obj/contrib/toad/paste_toad.msg =================================================================== --- obj/contrib/toad/paste_toad.msg (revision 0) +++ obj/contrib/toad/paste_toad.msg (revision 0) @@ -0,0 +1 @@ +session: No go, toad. Index: obj/contrib/scale/valid_relations =================================================================== --- obj/contrib/scale/valid_relations (revision 0) +++ obj/contrib/scale/valid_relations (revision 0) @@ -0,0 +1,3 @@ +on +under +stand Index: obj/contrib/scale/preplists =================================================================== --- obj/contrib/scale/preplists (revision 23) +++ obj/contrib/scale/preplists (working copy) @@ -1,3 +0,0 @@ -on_prepositions -under_prepositions -stand_prepositions Index: obj/contrib/lightswitch/switch_verb =================================================================== --- obj/contrib/lightswitch/switch_verb (revision 23) +++ obj/contrib/lightswitch/switch_verb (working copy) @@ -1,37 +0,0 @@ -#!/usr/bin/perl -# This can be run stackless. -#use Mooix::Thing; -#use Mooix::Root; -run sub { - my $this=shift; - %_=@_; - - my $loc=$this->location; - unless ($loc->isa($Mooix::Root->concrete->room)) { - fail "The switch won't do anything if it is not on a wall."; - } - - my $newstate = ($_{do_preposition} eq 'on') ? 1 : 0; - if ($this->state == $newstate) { - fail "It is already ".($newstate ? 'on' : 'off')."."; - } - if ($this->state($newstate) != $newstate) { - fail "For some reason it won't switch."; - } - - if ($newstate != $this->filterstate) { - # Turn on lights before showing message. - if (! $loc->messagefilters->remove(object => $this->filter)) { - fail "The switch doesn't do anything."; - } - } - - $this->msg('switch', %_, - state => $newstate ? 'on' : 'off'); - - if ($newstate == $this->filterstate) { - if (! $loc->messagefilters->add(object => $this->filter)) { - fail "The switch doesn't do anything."; - } - } -} Index: obj/contrib/lightswitch/switch_off.msg =================================================================== --- obj/contrib/lightswitch/switch_off.msg (revision 0) +++ obj/contrib/lightswitch/switch_off.msg (revision 0) @@ -0,0 +1,3 @@ +see: $avatar $avatar->verb(switches,switch) off the lights. +$avatar: You switch off the lights. +hear(20): You hear a click. Index: obj/contrib/lightswitch/switch_fail.msg =================================================================== --- obj/contrib/lightswitch/switch_fail.msg (revision 0) +++ obj/contrib/lightswitch/switch_fail.msg (revision 0) @@ -0,0 +1 @@ +session: The switch doesn't do anything. Index: obj/contrib/lightswitch/switch_on.msg =================================================================== --- obj/contrib/lightswitch/switch_on.msg (revision 18) +++ obj/contrib/lightswitch/switch_on.msg (working copy) @@ -1,3 +1,3 @@ -see: $avatar $avatar->verb(switches,switch) $state the lights. -$avatar: You switch $state the lights. +see: $avatar $avatar->verb(switches,switch) on the lights. +$avatar: You switch on the lights. hear(20): You hear a click. Index: obj/contrib/lightswitch/switch_fail_bad_loc.msg =================================================================== --- obj/contrib/lightswitch/switch_fail_bad_loc.msg (revision 0) +++ obj/contrib/lightswitch/switch_fail_bad_loc.msg (revision 0) @@ -0,0 +1 @@ +session: The switch won't do anything if it is not on a wall. Index: obj/contrib/lightswitch/switch.msg =================================================================== --- obj/contrib/lightswitch/switch.msg (revision 23) +++ obj/contrib/lightswitch/switch.msg (working copy) @@ -1,3 +0,0 @@ -see: $avatar $avatar->verb(switches,switch) $state the lights. -$avatar: You switch $state the lights. -hear(20): You hear a click. Index: obj/contrib/lightswitch/switch_fail_stuck.msg =================================================================== --- obj/contrib/lightswitch/switch_fail_stuck.msg (revision 0) +++ obj/contrib/lightswitch/switch_fail_stuck.msg (revision 0) @@ -0,0 +1 @@ +session: For some reason it won't switch. Index: obj/contrib/lightswitch/switch.cmd =================================================================== --- obj/contrib/lightswitch/switch.cmd (revision 23) +++ obj/contrib/lightswitch/switch.cmd (working copy) @@ -1 +1,2 @@ -verb, do_preposition(on|off|out), direct_object(this)(touchable) : switch +verb, do_preposition(on), direct_object(this)(touchable) : switch_on +verb, do_preposition(off|out), direct_object(this)(touchable) : switch_off Index: obj/contrib/lightswitch/switch_off_verb =================================================================== --- obj/contrib/lightswitch/switch_off_verb (revision 0) +++ obj/contrib/lightswitch/switch_off_verb (revision 0) @@ -0,0 +1,44 @@ +#!/usr/bin/perl +# This can be run stackless. +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + my $loc=$this->location; + + unless ($loc->isa($Mooix::Root->concrete->room)) { + $this->msg( 'switch_fail_bad_loc', %_ ); + fail(); + } + + # 1 == on, 0 == off + my $newstate = 0; + + if( $this->state == $newstate ) { + $this->msg( 'switch_fail_already_off', %_ ); + fail(); + } + if( $this->state( $newstate ) != $newstate ) { + $this->msg( 'switch_fail_stuck', %_ ); + fail(); + } + + if( $newstate != $this->filterstate ) { + # Turn on/off lights before showing message. + if( ! $loc->messagefilters->remove(object => $this->filter) ) { + $this->msg( 'switch_fail', %_ ); + fail(); + } + } + + $this->msg('switch_off', %_ ); + + if( $newstate == $this->filterstate ) { + if( ! $loc->messagefilters->add(object => $this->filter) ) { + $this->msg( 'switch_fail', %_ ); + fail(); + } + } +} Property changes on: obj/contrib/lightswitch/switch_off_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/contrib/lightswitch/switch_on_verb =================================================================== --- obj/contrib/lightswitch/switch_on_verb (revision 18) +++ obj/contrib/lightswitch/switch_on_verb (working copy) @@ -3,35 +3,42 @@ #use Mooix::Thing; #use Mooix::Root; run sub { - my $this=shift; - %_=@_; - - my $loc=$this->location; - unless ($loc->isa($Mooix::Root->concrete->room)) { - fail "The switch won't do anything if it is not on a wall."; + my $this=shift; + %_=@_; + + my $loc=$this->location; + + unless ($loc->isa($Mooix::Root->concrete->room)) { + $this->msg( 'switch_fail_bad_loc', %_ ); + fail(); + } + + # 1 == on, 0 == off + my $newstate = 1; + + if( $this->state == $newstate ) { + $this->msg( 'switch_fail_already_on', %_ ); + fail(); + } + if( $this->state( $newstate ) != $newstate ) { + $this->msg( 'switch_fail_stuck', %_ ); + fail(); + } + + if( $newstate != $this->filterstate ) { + # Turn on/off lights before showing message. + if( ! $loc->messagefilters->remove(object => $this->filter) ) { + $this->msg( 'switch_fail', %_ ); + fail(); } - - my $newstate = ($_{do_preposition} eq 'on') ? 1 : 0; - if ($this->state == $newstate) { - fail "It is already ".($newstate ? 'on' : 'off')."."; + } + + $this->msg('switch_on', %_ ); + + if( $newstate == $this->filterstate ) { + if( ! $loc->messagefilters->add(object => $this->filter) ) { + $this->msg( 'switch_fail', %_ ); + fail(); } - if ($this->state($newstate) != $newstate) { - fail "For some reason it won't switch."; - } - - if ($newstate != $this->filterstate) { - # Turn on lights before showing message. - if (! $loc->messagefilters->remove(object => $this->filter)) { - fail "The switch doesn't do anything."; - } - } - - $this->msg('switch', %_, - state => $newstate ? 'on' : 'off'); - - if ($newstate == $this->filterstate) { - if (! $loc->messagefilters->add(object => $this->filter)) { - fail "The switch doesn't do anything."; - } - } + } } Index: obj/contrib/lightswitch/switch_fail_already_off.msg =================================================================== --- obj/contrib/lightswitch/switch_fail_already_off.msg (revision 0) +++ obj/contrib/lightswitch/switch_fail_already_off.msg (revision 0) @@ -0,0 +1 @@ +session: It is already off. Index: obj/contrib/lightswitch/Makefile =================================================================== --- obj/contrib/lightswitch/Makefile (revision 23) +++ obj/contrib/lightswitch/Makefile (working copy) @@ -1,7 +1,8 @@ include ../../../makeinfo build:: - $(SETSTACKLESS) switch_verb + $(SETSTACKLESS) switch_on_verb + $(SETSTACKLESS) switch_off_verb ln -f switch.cmd turn.cmd Index: obj/contrib/lightswitch/switch_fail_already_on.msg =================================================================== --- obj/contrib/lightswitch/switch_fail_already_on.msg (revision 0) +++ obj/contrib/lightswitch/switch_fail_already_on.msg (revision 0) @@ -0,0 +1 @@ +session: It is already on. Index: obj/contrib/animal/feed_verb =================================================================== --- obj/contrib/animal/feed_verb (revision 23) +++ obj/contrib/animal/feed_verb (working copy) @@ -20,7 +20,8 @@ $_{indirect_object} : $_{direct_object}; if ($food == $_{avatar} || $food == $this) { - fail "Surely you're kidding!"; + $this->msg( 'feed_silly', %_ ); + fail(); } if (! $food) { @@ -33,7 +34,8 @@ } } if (! $food) { - fail "Feed it what?"; + $this->msg( 'feed_what', %_ ); + fail(); return; } } @@ -49,7 +51,8 @@ $food->take_verb(avatar => $_{avatar}, direct_object => $food, session => $_{session}); if ($food->location != $_{avatar}) { - fail "You're not holding that."; + $this->msg( 'feed_fail_not_holding', %_ ); + fail(); } } Index: obj/contrib/animal/feed_silly.msg =================================================================== --- obj/contrib/animal/feed_silly.msg (revision 0) +++ obj/contrib/animal/feed_silly.msg (revision 0) @@ -0,0 +1 @@ +session: Surely you're kidding! Index: obj/contrib/animal/feed_fail_not_holding.msg =================================================================== --- obj/contrib/animal/feed_fail_not_holding.msg (revision 0) +++ obj/contrib/animal/feed_fail_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that. Index: obj/contrib/animal/feed_what.msg =================================================================== --- obj/contrib/animal/feed_what.msg (revision 0) +++ obj/contrib/animal/feed_what.msg (revision 0) @@ -0,0 +1 @@ +session: Feed it what? Index: obj/contrib/dictionary/read_fail_no_word.msg =================================================================== --- obj/contrib/dictionary/read_fail_no_word.msg (revision 0) +++ obj/contrib/dictionary/read_fail_no_word.msg (revision 0) @@ -0,0 +1 @@ +session: You should supply a word to read in quotes, like: read about "love" in $this. Index: obj/contrib/dictionary/read_verb =================================================================== --- obj/contrib/dictionary/read_verb (revision 23) +++ obj/contrib/dictionary/read_verb (working copy) @@ -9,7 +9,8 @@ $entry=~s/[^\w\s]//g; if (! length $entry) { - fail "You should supply a word to read in quotes, like: read about \"love\" in ".$this->name."."; + $this->msg( 'read_fail_no_word', %_ ); + fail(); } # Only show entry if the avatar manages to read it. @@ -19,7 +20,8 @@ my @lines=; close DICT; if (! @lines) { - fail "The words just won't come clear."; + $this->msg( 'read_fail', %_ ); + fail(); } $session->page(@lines); } Index: obj/contrib/dictionary/read_fail.msg =================================================================== --- obj/contrib/dictionary/read_fail.msg (revision 0) +++ obj/contrib/dictionary/read_fail.msg (revision 0) @@ -0,0 +1 @@ +session: The words just won't come clear. Index: obj/contrib/dictionary/look.cmd =================================================================== --- obj/contrib/dictionary/look.cmd (revision 23) +++ obj/contrib/dictionary/look.cmd (working copy) @@ -1,2 +1,10 @@ verb, direct_object(this)(visible), quote : read +# From "thing": +# look the ball verb, direct_object(this)(visible) +# look at the ball, look at the ball which is in the box +verb, do_preposition(at), direct_object(this)(visible) +# look the ball in the box +verb, direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look at the ball in the box +verb, do_preposition(at), direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in Index: obj/contrib/parrot/feed_verb =================================================================== --- obj/contrib/parrot/feed_verb (revision 23) +++ obj/contrib/parrot/feed_verb (working copy) @@ -7,7 +7,8 @@ # limits it to being called on (touchable) objects. So no locking # needed before checking this field. if ($this->flying) { - fail "It's flying and doesn't notice."; + $this->msg( 'feed_flying', %_ ); + fail(); } else { $this->exec->super(@_); Index: obj/contrib/parrot/feed_flying.msg =================================================================== --- obj/contrib/parrot/feed_flying.msg (revision 0) +++ obj/contrib/parrot/feed_flying.msg (revision 0) @@ -0,0 +1 @@ +session: It's flying and doesn't notice. Index: obj/contrib/wind_up_duck/python/put_verb =================================================================== --- obj/contrib/wind_up_duck/python/put_verb (revision 23) +++ obj/contrib/wind_up_duck/python/put_verb (working copy) @@ -1,13 +0,0 @@ -#!/usr/bin/python - -from mooix import * - -# Remember where the duck currenty is. -old_loc = this.location - -# Call super to atually handle the put. -this.super() - -# Was it put down, and did it move? If so, make it waddle. -if args['do_preposition'] == 'down' and old_loc != this.location: - this.waddle() Index: obj/contrib/wind_up_duck/python/put.cmd =================================================================== --- obj/contrib/wind_up_duck/python/put.cmd (revision 0) +++ obj/contrib/wind_up_duck/python/put.cmd (revision 0) @@ -0,0 +1,10 @@ +# "put down object / put object down" +verb, do_preposition(down), direct_object(this)(touchable)(tomove) : put_down +# "put object in object" +verb, direct_object(touchable)(tomove), io_preposition(set@in_prepositions), indirect_object(this)(touchable)(open) : put_in +# "put object on object" +verb, direct_object(touchable)(tomove), io_preposition(set@on_prepositions), indirect_object(this)(touchable) : put_on +# "put object under object" +verb, direct_object(touchable)(tomove), io_preposition(set@under_prepositions), indirect_object(this)(touchable) : put_under +# "put object behind object" +verb, direct_object(touchable)(tomove), io_preposition(set@behind_prepositions), indirect_object(this)(touchable) : put_under Index: obj/contrib/wind_up_duck/python/put_down_verb =================================================================== --- obj/contrib/wind_up_duck/python/put_down_verb (revision 18) +++ obj/contrib/wind_up_duck/python/put_down_verb (working copy) @@ -5,9 +5,9 @@ # Remember where the duck currenty is. old_loc = this.location -# Call super to atually handle the put. -this.super() +# Call regular put_in_verb to atually handle the put. +this.put_in_verb() -# Was it put down, and did it move? If so, make it waddle. -if args['do_preposition'] == 'down' and old_loc != this.location: +# Did it move? If so, make it waddle. +if old_loc != this.location: this.waddle() Index: obj/contrib/wind_up_duck/ruby/put_verb =================================================================== --- obj/contrib/wind_up_duck/ruby/put_verb (revision 23) +++ obj/contrib/wind_up_duck/ruby/put_verb (working copy) @@ -1,15 +0,0 @@ -#!/usr/bin/ruby - -require "mooix" -require "mooix/thing" - -Mooix.run do - old_loc = self.location - - self.super(@args) - - args = Hash[*@args] - if (args["do_preposition"] == "down") and (self.location != old_loc) - self.waddle - end -end Index: obj/contrib/wind_up_duck/ruby/put.cmd =================================================================== --- obj/contrib/wind_up_duck/ruby/put.cmd (revision 0) +++ obj/contrib/wind_up_duck/ruby/put.cmd (revision 0) @@ -0,0 +1,10 @@ +# "put down object / put object down" +verb, do_preposition(down), direct_object(this)(touchable)(tomove) : put_down +# "put object in object" +verb, direct_object(touchable)(tomove), io_preposition(set@in_prepositions), indirect_object(this)(touchable)(open) : put_in +# "put object on object" +verb, direct_object(touchable)(tomove), io_preposition(set@on_prepositions), indirect_object(this)(touchable) : put_on +# "put object under object" +verb, direct_object(touchable)(tomove), io_preposition(set@under_prepositions), indirect_object(this)(touchable) : put_under +# "put object behind object" +verb, direct_object(touchable)(tomove), io_preposition(set@behind_prepositions), indirect_object(this)(touchable) : put_under Index: obj/contrib/wind_up_duck/ruby/put_down_verb =================================================================== --- obj/contrib/wind_up_duck/ruby/put_down_verb (revision 18) +++ obj/contrib/wind_up_duck/ruby/put_down_verb (working copy) @@ -4,12 +4,16 @@ require "mooix/thing" Mooix.run do + # Remember where the duck currenty is. old_loc = self.location - self.super(@args) + # Call regular put_in_verb to atually handle the put. + self.put_in_verb(@args) args = Hash[*@args] - if (args["do_preposition"] == "down") and (self.location != old_loc) + + # Did it move? If so, make it waddle. + if( self.location != old_loc ) self.waddle end end Index: obj/contrib/wind_up_duck/put_verb =================================================================== --- obj/contrib/wind_up_duck/put_verb (revision 23) +++ obj/contrib/wind_up_duck/put_verb (working copy) @@ -1,17 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -run sub { - my $this=shift; - %_=@_; - - # Remember where the duck currently is. - my $old_loc=$this->location; - - # Call super to atually handle the put. - $this->super(@_); - - # Was it put down, and did it move? If so, make it waddle. - if ($_{do_preposition} == "down" && $old_loc != $this->location) { - $this->waddle; - } -} Index: obj/contrib/wind_up_duck/put.cmd =================================================================== --- obj/contrib/wind_up_duck/put.cmd (revision 0) +++ obj/contrib/wind_up_duck/put.cmd (revision 0) @@ -0,0 +1,10 @@ +# "put down object / put object down" +verb, do_preposition(down), direct_object(this)(touchable)(tomove) : put_down +# "put object in object" +verb, direct_object(touchable)(tomove), io_preposition(set@in_prepositions), indirect_object(this)(touchable)(open) : put_in +# "put object on object" +verb, direct_object(touchable)(tomove), io_preposition(set@on_prepositions), indirect_object(this)(touchable) : put_on +# "put object under object" +verb, direct_object(touchable)(tomove), io_preposition(set@under_prepositions), indirect_object(this)(touchable) : put_under +# "put object behind object" +verb, direct_object(touchable)(tomove), io_preposition(set@behind_prepositions), indirect_object(this)(touchable) : put_under Index: obj/contrib/wind_up_duck/put_down_verb =================================================================== --- obj/contrib/wind_up_duck/put_down_verb (revision 18) +++ obj/contrib/wind_up_duck/put_down_verb (working copy) @@ -1,17 +1,17 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; - # Remember where the duck currently is. - my $old_loc=$this->location; + # Remember where the duck currently is. + my $old_loc=$this->location; - # Call super to atually handle the put. - $this->super(@_); + # Call the regular put_in_verb verb to atually handle the put. + $this->put_in_verb(@_); - # Was it put down, and did it move? If so, make it waddle. - if ($_{do_preposition} == "down" && $old_loc != $this->location) { - $this->waddle; - } + # Did it move? If so, make it waddle. + if( $old_loc != $this->location ) { + $this->waddle; + } } Index: obj/concrete/container/open_verb =================================================================== --- obj/concrete/container/open_verb (revision 23) +++ obj/concrete/container/open_verb (working copy) @@ -8,15 +8,22 @@ %_=@_; my $avatar=$_{avatar}; - my $lock = $this->getlock(LOCK_EX, "closed"); # lock field + # lock field + my $lock = $this->getlock(LOCK_EX, "closed"); + if (! $this->closed) { - fail "It's already open."; + $this->msg('open_fail_already', %_); + fail(); } + if ($this->locked || $this->closed(0) != 0) { - fail "You can't open that."; + $this->msg('open_fail_cannot', %_); + fail(); } + if (ref $this->messagefilters && ref $this->closed_filter) { - $this->messagefilters->remove(object => $this->closed_filter); + $this->messagefilters->remove(object => $this->closed_filter); } + $this->msg('open', %_); } Index: obj/concrete/container/valid_relations =================================================================== --- obj/concrete/container/valid_relations (revision 0) +++ obj/concrete/container/valid_relations (revision 0) @@ -0,0 +1 @@ +in Index: obj/concrete/container/look_under_fail.msg =================================================================== --- obj/concrete/container/look_under_fail.msg (revision 0) +++ obj/concrete/container/look_under_fail.msg (revision 0) @@ -0,0 +1,2 @@ +session,see: There is no space under $this. +session: You can't see $this. Index: obj/concrete/container/accessible_contents.inf =================================================================== --- obj/concrete/container/accessible_contents.inf (revision 0) +++ obj/concrete/container/accessible_contents.inf (revision 0) @@ -0,0 +1,7 @@ +Used by the parser to get a list of those things in a container that +are easily accessible, and hence might be targets of a command by +someone in a room with that container in it. + +Parameters: + + None. Index: obj/concrete/container/get_preposition.inf =================================================================== --- obj/concrete/container/get_preposition.inf (revision 23) +++ obj/concrete/container/get_preposition.inf (working copy) @@ -1,26 +0,0 @@ -Returns the prepositions that can be used to refer to an object in this -container. - -If a preposition is passed, checks to see if the passed preposition is a -valid way of referring to an object in (or "on", or "under" or whatever) the -container. - -If it is not, returns nothing. If it is, it returns a list of all the valid -prepositions. - -If no preposition is passed, returns the default prepositions to use for -referring to an object in the container. - -The order of the returned list is significant: The first preposition on it -is the one that will be used to state where the object is in relation to -the container. - -Note that it is a very good idea to make sure that that preposition makes -sense in a sentence like "Bob takes the object from the -container." - -Parameters: - - preposition The preposition to check (optional) - object The object that is going to be added to the - container. Index: obj/concrete/container/look_contents.msg =================================================================== --- obj/concrete/container/look_contents.msg (revision 23) +++ obj/concrete/container/look_contents.msg (working copy) @@ -1,3 +1,3 @@ -see,session: $this->description$details\n$contents $are inside. +see,session: $this->description$details\nInside this you see $contents. session: You can't see $this. see: $avatar $avatar->verb(looks) into $this. Index: obj/concrete/container/look_on_fail_verb =================================================================== --- obj/concrete/container/look_on_fail_verb (revision 0) +++ obj/concrete/container/look_on_fail_verb (revision 0) @@ -0,0 +1,9 @@ +#!/usr/bin/perl +#use Mooix::Thing; +run sub { + my $this=shift; + %_=@_; + + $this->msg("look_on_fail", %_); + fail(); +} Property changes on: obj/concrete/container/look_on_fail_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/container/look_under_fail_verb =================================================================== --- obj/concrete/container/look_under_fail_verb (revision 0) +++ obj/concrete/container/look_under_fail_verb (revision 0) @@ -0,0 +1,9 @@ +#!/usr/bin/perl +#use Mooix::Thing; +run sub { + my $this=shift; + %_=@_; + + $this->msg("look_under_fail", %_); + fail(); +} Property changes on: obj/concrete/container/look_under_fail_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/container/valid_prepositions =================================================================== --- obj/concrete/container/valid_prepositions (revision 23) +++ obj/concrete/container/valid_prepositions (working copy) @@ -1,8 +0,0 @@ -inside -in -into -within -from -out -of -to Index: obj/concrete/container/listcontents_in =================================================================== --- obj/concrete/container/listcontents_in (revision 18) +++ obj/concrete/container/listcontents_in (working copy) @@ -1,7 +1,9 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - my @contents=grep { ! $_->hidden} $this->contents->list; - return $this->prettylist(@contents); + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + my @contents=grep { ! $_->hidden && $_->relation eq "in" } $this->contents->list; + return $this->prettylist($avatar, @contents); } Index: obj/concrete/container/look_on_fail.msg =================================================================== --- obj/concrete/container/look_on_fail.msg (revision 0) +++ obj/concrete/container/look_on_fail.msg (revision 0) @@ -0,0 +1,2 @@ +session,see: There is no space on $this. +session: You can't see $this. Index: obj/concrete/container/open_fail_cannot.msg =================================================================== --- obj/concrete/container/open_fail_cannot.msg (revision 0) +++ obj/concrete/container/open_fail_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: You can't open $this. Index: obj/concrete/container/close_fail_already.msg =================================================================== --- obj/concrete/container/close_fail_already.msg (revision 0) +++ obj/concrete/container/close_fail_already.msg (revision 0) @@ -0,0 +1 @@ +session: $this is already closed. Index: obj/concrete/container/valid_relations.inf =================================================================== --- obj/concrete/container/valid_relations.inf (revision 0) +++ obj/concrete/container/valid_relations.inf (revision 0) @@ -0,0 +1,4 @@ +Lists all of the relations that are valid for objects contained by +this one (that is, objects that are listed in this objects +contents). Possibilities are "in", "on", "under", "stand", "sit" +and "lie". Index: obj/concrete/container/.listcontents_in-safe =================================================================== --- obj/concrete/container/.listcontents_in-safe (revision 0) +++ obj/concrete/container/.listcontents_in-safe (revision 0) @@ -0,0 +1 @@ +1 Index: obj/concrete/container/look_verb =================================================================== --- obj/concrete/container/look_verb (revision 23) +++ obj/concrete/container/look_verb (working copy) @@ -1,51 +1,42 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar} || $this->croak("what, no avatar?"); + my $this=shift; + %_=@_; + my $avatar=$_{avatar} || $this->croak("what, no avatar?"); - # look in, on, under, etc. - my $preposition=lc($_{do_preposition}); - if (length $preposition && $preposition ne 'at' && - ! grep { $_ eq $preposition } $this->valid_prepositions) { - fail "Nothing there."; - } - - my $msg='look'; - if (! $this->closed || $this->transparent) { - my @contents; - foreach ($this->contents->list) { - if (! $_->hidden) { - push @contents, $_; - } - elsif ($_->defines("detail")) { - $_{details} .= " ".$_->detail; - } - } + my $msg='look'; + if (! $this->closed || $this->transparent) { + my @contents; + foreach ($this->contents->list) { + if (! $_->hidden) { + push @contents, $_; + } + elsif ($_->defines("detail")) { + $_{details} .= " ".$_->detail; + } + } - # The contents of some containers are visible to just plain - # look. - foreach (@contents) { - my @visi = $_->visiblecontents; - if (@visi) { - push @contents, @visi; - } - } - - # Don't bother if the avatar is the only contents, since that - # looks silly (and it'd gets the 'is/are' grammar wrong, too. - if (@contents && (@contents > 1 || $contents[0] != $avatar)) { - # This can be used for '$contents $are here.' as a - # message, getting the number of the noun right. - $_{are}=(@contents > 1) ? 'are' : 'is'; - $_{contents}=$avatar->prettylist(@contents); - $msg='look_contents'; - } + # The contents of some containers are visible to just plain + # look. + foreach (@contents) { + my @visi = $_->visiblecontents; + if (@visi) { + push @contents, @visi; + } } - elsif ($this->closed) { - $msg='look_closed'; + + # Don't bother if the avatar is the only contents, since that + # looks silly. + if( + @contents && (@contents > 1 || $contents[0] != $avatar) + ) { + $_{contents}=$avatar->prettylist($avatar, @contents); + $msg='look_contents'; } - - $this->msg($msg, %_); + } elsif ($this->closed) { + $msg='look_closed'; + } + + $this->msg($msg, %_); } Index: obj/concrete/container/close_verb =================================================================== --- obj/concrete/container/close_verb (revision 23) +++ obj/concrete/container/close_verb (working copy) @@ -4,19 +4,26 @@ #use Fcntl q{:flock}; #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; - - my $lock = $this->getlock(LOCK_EX, "closed"); # lock field - if ($this->closed) { - fail "It's already closed."; - } - if ($this->locked || $this->closed(1) != 1) { - fail "You can't close that."; - } - if (ref $this->messagefilters && ref $this->closed_filter) { - $this->messagefilters->add(object => $this->closed_filter); - } - $this->msg('close', %_); + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + + # lock field + my $lock = $this->getlock(LOCK_EX, "closed"); + + if ($this->closed) { + $this->msg('close_fail_already', %_); + fail(); + } + + if ($this->locked || $this->closed(1) != 1) { + $this->msg('close_fail_cannot', %_); + fail(); + } + + if (ref $this->messagefilters && ref $this->closed_filter) { + $this->messagefilters->add(object => $this->closed_filter); + } + + $this->msg('close', %_); } Index: obj/concrete/container/open.msg =================================================================== --- obj/concrete/container/open.msg (revision 23) +++ obj/concrete/container/open.msg (working copy) @@ -1,3 +1,3 @@ -see,$avatar: You open $this, revealing $this->listcontents. +see,$avatar: You open $this, revealing $this->listcontents_in. $avatar: You open $this. see: $avatar $avatar->verb(opens) $this. Index: obj/concrete/container/valid_prepositions.inf =================================================================== --- obj/concrete/container/valid_prepositions.inf (revision 23) +++ obj/concrete/container/valid_prepositions.inf (working copy) @@ -1,3 +0,0 @@ -This field should hold a list of all the prepositions that can be used to -refer to objects in the container. The first listed is the preposition that -is used by default to refer to object inside it. Index: obj/concrete/container/closed_relations =================================================================== --- obj/concrete/container/closed_relations (revision 0) +++ obj/concrete/container/closed_relations (revision 0) @@ -0,0 +1 @@ +in Index: obj/concrete/container/listcontents =================================================================== --- obj/concrete/container/listcontents (revision 23) +++ obj/concrete/container/listcontents (working copy) @@ -1,7 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -run sub { - my $this=shift; - my @contents=grep { ! $_->hidden} $this->contents->list; - return $this->prettylist(@contents); -} Index: obj/concrete/container/look.cmd =================================================================== --- obj/concrete/container/look.cmd (revision 0) +++ obj/concrete/container/look.cmd (revision 0) @@ -0,0 +1,15 @@ +# From "thing": +# look the ball +verb, direct_object(this)(visible) +# look at the ball, look at the ball which is in the box +verb, do_preposition(at), direct_object(this)(visible) +# look the ball in the box +verb, direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look at the ball in the box +verb, do_preposition(at), direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look in container +verb, do_preposition(set@in_prepositions), direct_object(this)(visible) +# look under container +verb, do_preposition(set@under_prepositions), direct_object(this)(visible) : look_under_fail +# look on container +verb, do_preposition(set@on_prepositions), direct_object(this)(visible) : look_on_fail Index: obj/concrete/container/get_preposition =================================================================== --- obj/concrete/container/get_preposition (revision 23) +++ obj/concrete/container/get_preposition (working copy) @@ -1,13 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -run sub { - my $this=shift; - %_=@_; - my $preposition = lc($_{preposition}); - - my @valid = $this->valid_prepositions; - if (length $preposition && ! grep { $_ eq $preposition } @valid) { - return; # bad one - } - return @valid; -} Index: obj/concrete/container/accessible_contents =================================================================== --- obj/concrete/container/accessible_contents (revision 0) +++ obj/concrete/container/accessible_contents (revision 0) @@ -0,0 +1,15 @@ +#!/usr/bin/perl +#use Mooix::Thing; +run sub { + my $this=shift; + my %not_ok_relations = map { $_ => 1 } $this->closed_relations; + my @contents; + + if( $this->closed ) + { + @contents = grep { ! $_->hidden && ! $not_ok_relations{$_->relation} } $this->contents->list; + } else { + @contents = grep { ! $_->hidden } $this->contents->list; + } + return @contents; +} Property changes on: obj/concrete/container/accessible_contents ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/container/open_fail_already.msg =================================================================== --- obj/concrete/container/open_fail_already.msg (revision 0) +++ obj/concrete/container/open_fail_already.msg (revision 0) @@ -0,0 +1 @@ +session: $this is already open. Index: obj/concrete/container/.listcontents-safe =================================================================== --- obj/concrete/container/.listcontents-safe (revision 23) +++ obj/concrete/container/.listcontents-safe (working copy) @@ -1 +0,0 @@ -1 Index: obj/concrete/container/close_fail_cannot.msg =================================================================== --- obj/concrete/container/close_fail_cannot.msg (revision 0) +++ obj/concrete/container/close_fail_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: You can't close $this. Index: obj/concrete/container/listcontents.inf =================================================================== --- obj/concrete/container/listcontents.inf (revision 23) +++ obj/concrete/container/listcontents.inf (working copy) @@ -1 +0,0 @@ -This method returns a pretty-printed version of the contents of an object. Index: obj/concrete/container/closed_relations.inf =================================================================== --- obj/concrete/container/closed_relations.inf (revision 0) +++ obj/concrete/container/closed_relations.inf (revision 0) @@ -0,0 +1,2 @@ +This field lists relations that are blocked off when an object is +closed. Index: obj/concrete/furniture/valid_relations =================================================================== --- obj/concrete/furniture/valid_relations (revision 0) +++ obj/concrete/furniture/valid_relations (revision 0) @@ -0,0 +1,6 @@ +on +in +under +behind +stand +sit Index: obj/concrete/furniture/visiblepreps.inf =================================================================== --- obj/concrete/furniture/visiblepreps.inf (revision 23) +++ obj/concrete/furniture/visiblepreps.inf (working copy) @@ -1,2 +0,0 @@ -Not all objects in/on/under furniture is visible to plain looks. This lists -sets of prepositions that are so visible. Index: obj/concrete/furniture/get_preposition.inf =================================================================== --- obj/concrete/furniture/get_preposition.inf (revision 23) +++ obj/concrete/furniture/get_preposition.inf (working copy) @@ -1,4 +0,0 @@ -Objects can be placed around furniture in various ways, as listed in the -preptypes field. This method figures out which type of placement is being -done, based on the input preposition, and returns appropriately. If there is -no input preposition, it uses the first item listed in preptypes. Index: obj/concrete/furniture/preplists =================================================================== --- obj/concrete/furniture/preplists (revision 23) +++ obj/concrete/furniture/preplists (working copy) @@ -1,5 +0,0 @@ -on_prepositions -in_prepositions -under_prepositions -behind_prepositions -stand_prepositions Index: obj/concrete/furniture/visiblecontents.inf =================================================================== --- obj/concrete/furniture/visiblecontents.inf (revision 23) +++ obj/concrete/furniture/visiblecontents.inf (working copy) @@ -1,2 +1,2 @@ Not all objects in/on/under furniture is visible to plain looks. Consults -visiblepreps to see which lists of prepositions are visible. +visible_relations to see which objects are visible. Index: obj/concrete/furniture/visible_relations.inf =================================================================== --- obj/concrete/furniture/visible_relations.inf (revision 0) +++ obj/concrete/furniture/visible_relations.inf (revision 0) @@ -0,0 +1,2 @@ +Not all objects in/on/under furniture is visible to plain looks. This lists +relations that are so visible. Index: obj/concrete/furniture/getoff_verb =================================================================== --- obj/concrete/furniture/getoff_verb (revision 23) +++ obj/concrete/furniture/getoff_verb (working copy) @@ -17,6 +17,7 @@ $this->msg('getoff', %_) } else { - fail "You can't get off it!"; + $this->msg( 'getoff_fail', %_ ); + fail(); } } Index: obj/concrete/furniture/occupied_behind.msg =================================================================== --- obj/concrete/furniture/occupied_behind.msg (revision 0) +++ obj/concrete/furniture/occupied_behind.msg (revision 0) @@ -0,0 +1 @@ +session: You are behind $this. Index: obj/concrete/furniture/look_around_verb =================================================================== --- obj/concrete/furniture/look_around_verb (revision 0) +++ obj/concrete/furniture/look_around_verb (revision 0) @@ -0,0 +1,31 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + +my @visicontents; + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + # If no direct object was specified, the user just did a "look", + # and then they must be in/on/whatever this furniture. Display a + # message to that effect, and then let them look at the + # enclosing room. + if ($avatar->location != $this) { + exit Mooix::Verb::SKIP; + } + + # Print the room's description + if( $this->location ) + { + $this->location->look_verb(@_) || fail(); + } + + $this->msg( 'occupied_'.$avatar->relation, %_ ); + + if ($this->closed) { + $this->msg('closed', %_); + } +} Property changes on: obj/concrete/furniture/look_around_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/stand_up_verb =================================================================== --- obj/concrete/furniture/stand_up_verb (revision 0) +++ obj/concrete/furniture/stand_up_verb (revision 0) @@ -0,0 +1,26 @@ +#!/usr/bin/perl +#use Fcntl q{:flock}; +#use Mooix::Thing; +#use Mooix::Verb; + +# Standing up means get off the furniture. +run sub { + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + + my $lock = $avatar->getlock(LOCK_EX); + + if( $avatar->location != $this ) { + $this->msg('stand_up_already', %_); + fail(); + } + + if ($avatar->physics->move(object => $avatar, to => $this->location)) + { + $this->msg('stand_up', %_) + } else { + $this->msg("stand_up_fail", %_); + fail(); + } +} Property changes on: obj/concrete/furniture/stand_up_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/look_behind_verb =================================================================== --- obj/concrete/furniture/look_behind_verb (revision 0) +++ obj/concrete/furniture/look_behind_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->look_relation( %_, relation => "behind" ); +} Property changes on: obj/concrete/furniture/look_behind_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/in_prepositions.inf =================================================================== --- obj/concrete/furniture/in_prepositions.inf (revision 23) +++ obj/concrete/furniture/in_prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field is a list of prepositions that can be used by objects inside the -furniture. Index: obj/concrete/furniture/stand_prepositions.inf =================================================================== --- obj/concrete/furniture/stand_prepositions.inf (revision 23) +++ obj/concrete/furniture/stand_prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field is a list of prepositions that can be used by objects standing -on the furniture. Index: obj/concrete/furniture/stand_up_already.msg =================================================================== --- obj/concrete/furniture/stand_up_already.msg (revision 0) +++ obj/concrete/furniture/stand_up_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already standing up. Index: obj/concrete/furniture/on_prepositions.inf =================================================================== --- obj/concrete/furniture/on_prepositions.inf (revision 23) +++ obj/concrete/furniture/on_prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field is a list of prepositions that can be used by objects on top of -the furniture. Index: obj/concrete/furniture/look_nothing_there.msg =================================================================== --- obj/concrete/furniture/look_nothing_there.msg (revision 0) +++ obj/concrete/furniture/look_nothing_there.msg (revision 0) @@ -0,0 +1 @@ +session: No place for anything there. Index: obj/concrete/furniture/occupied_stand.msg =================================================================== --- obj/concrete/furniture/occupied_stand.msg (revision 0) +++ obj/concrete/furniture/occupied_stand.msg (revision 0) @@ -0,0 +1 @@ +session: You are standing on $this. Index: obj/concrete/furniture/stand.cmd =================================================================== --- obj/concrete/furniture/stand.cmd (revision 23) +++ obj/concrete/furniture/stand.cmd (working copy) @@ -1,3 +1,3 @@ -verb, preposition(up) -verb, direct_object(this)(touchable) -verb +verb, preposition(up) : stand_up +verb, do_preposition(set@stand_prepositions), direct_object(this)(touchable) +verb : stand_up Index: obj/concrete/furniture/occupied_on.msg =================================================================== --- obj/concrete/furniture/occupied_on.msg (revision 0) +++ obj/concrete/furniture/occupied_on.msg (revision 0) @@ -0,0 +1 @@ +session: You are on $this. Index: obj/concrete/furniture/Makefile =================================================================== --- obj/concrete/furniture/Makefile (revision 23) +++ obj/concrete/furniture/Makefile (working copy) @@ -1,7 +1,7 @@ build:: - cat `cat preplists` | sort | uniq > valid_prepositions + # cat `cat preplists` | sort | uniq > valid_prepositions cp .basemass .mass clean:: - rm -f .mass valid_prepositions + rm -f .mass #valid_prepositions realclean:: Index: obj/concrete/furniture/sit_fail.msg =================================================================== --- obj/concrete/furniture/sit_fail.msg (revision 0) +++ obj/concrete/furniture/sit_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't sit there. Index: obj/concrete/furniture/sit_on_already.msg =================================================================== --- obj/concrete/furniture/sit_on_already.msg (revision 0) +++ obj/concrete/furniture/sit_on_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already sitting on that. Index: obj/concrete/furniture/behind_prepositions.inf =================================================================== --- obj/concrete/furniture/behind_prepositions.inf (revision 23) +++ obj/concrete/furniture/behind_prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field is a list of prepositions that can be used by objects behind the -furniture. Index: obj/concrete/furniture/stand_verb =================================================================== --- obj/concrete/furniture/stand_verb (revision 23) +++ obj/concrete/furniture/stand_verb (working copy) @@ -1,46 +1,34 @@ #!/usr/bin/perl -# Standing up means get off the furniture, but it's also possible to stand -# on the furniture. Therefore, just do a toggle. If you're on it, stnd -# takes you off, if you're off, it takes you on. #use Fcntl q{:flock}; #use Mooix::Thing; #use Mooix::Verb; + +# This verb is for standing on furniture. run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; - my $prep = ($this->stand_prepositions)[0]; - - my $lock = $avatar->getlock(LOCK_EX); - - if (($avatar->preposition)[0] eq $prep && - $avatar->location == $this && $_{direct_object} == $this) { - fail "You're already standing there."; - } - - # Stand up to get off of furniture. - if ($avatar->location == $this && ! $_{direct_object}) { - if ($avatar->physics->move(object => $avatar, to => $this->location)) { - $this->msg('stand', %_) - } - else { - fail "You can't get up!"; - } - } - else { - - if (! $this->location->isa($Mooix::Root->concrete->room)) { - # Let the parser try some better peice of furniture. - exit Mooix::Verb::SKIP; - } - - if ($prep && - $avatar->physics->move(object => $avatar, to => $this, preposition => $prep)) { - $this->msg('stand_on', %_); - } - else { - fail "You can't stand on that."; - } - } + my $lock = $avatar->getlock(LOCK_EX); + + if( $avatar->relation eq "stand" && $avatar->location == $this ) { + $this->msg("stand_on_already", %_); + fail(); + } + + # Stand on the furniture + if( ! $this->location->isa($Mooix::Root->concrete->room) ) { + # Let the parser try some better peice of furniture. + exit Mooix::Verb::SKIP; + } + + if( + $avatar->physics->move(object => $avatar, + to => $this, relation => "stand" ) + ) { + $this->msg('stand_on', %_); + } else { + $this->msg("stand_on_fail", %_); + fail(); + } } Index: obj/concrete/furniture/look_behind_nothing.msg =================================================================== --- obj/concrete/furniture/look_behind_nothing.msg (revision 0) +++ obj/concrete/furniture/look_behind_nothing.msg (revision 0) @@ -0,0 +1 @@ +session,see: You see nothing behind $this. Index: obj/concrete/furniture/look.msg =================================================================== --- obj/concrete/furniture/look.msg (revision 23) +++ obj/concrete/furniture/look.msg (working copy) @@ -1,2 +1,2 @@ -session,see: $this->description$details -session: You cannot see $this. +see,session: $this->description$details\nOn $this you see $contents. +session: It's dark. Index: obj/concrete/furniture/getoff_fail.msg =================================================================== --- obj/concrete/furniture/getoff_fail.msg (revision 0) +++ obj/concrete/furniture/getoff_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't get off it! Index: obj/concrete/furniture/stand_up_fail.msg =================================================================== --- obj/concrete/furniture/stand_up_fail.msg (revision 0) +++ obj/concrete/furniture/stand_up_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't get up! Index: obj/concrete/furniture/preplists.inf =================================================================== --- obj/concrete/furniture/preplists.inf (revision 23) +++ obj/concrete/furniture/preplists.inf (working copy) @@ -1,3 +0,0 @@ -This field lists the names of fields that list prepositions that refer to -various ways that objects can be placed around furniture. The first one on -the list is the default. Index: obj/concrete/furniture/sit.cmd =================================================================== --- obj/concrete/furniture/sit.cmd (revision 23) +++ obj/concrete/furniture/sit.cmd (working copy) @@ -1,3 +1,3 @@ -verb, direct_object(this)(touchable) +verb, do_preposition(set@sit_prepositions), direct_object(this)(touchable) verb, preposition(down) verb Index: obj/concrete/furniture/look_empty.msg =================================================================== --- obj/concrete/furniture/look_empty.msg (revision 0) +++ obj/concrete/furniture/look_empty.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: $this->description$details +session: It's dark. Index: obj/concrete/furniture/look_on_nothing.msg =================================================================== --- obj/concrete/furniture/look_on_nothing.msg (revision 0) +++ obj/concrete/furniture/look_on_nothing.msg (revision 0) @@ -0,0 +1 @@ +session,see: Looking on $this, you find nothing. Index: obj/concrete/furniture/occupied.msg =================================================================== --- obj/concrete/furniture/occupied.msg (revision 23) +++ obj/concrete/furniture/occupied.msg (working copy) @@ -1 +0,0 @@ -session: You are $preposition $this. Index: obj/concrete/furniture/look_verb =================================================================== --- obj/concrete/furniture/look_verb (revision 23) +++ obj/concrete/furniture/look_verb (working copy) @@ -1,100 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -#use Mooix::Verb; - -my @visicontents; - -# This sub handles a look for objects that have a particular releationship -# to the furniture. -sub look_prep { - my $this=shift; - my $preplist=shift; - my %okpreps = map { $_ => 1 } @{shift()}; - %_=@_; - my $avatar=$_{avatar}; - - my ($message)=$preplist=~m/(.*)_/; - - # Show standing on scale the same as just being on it. This is a - # special case. - if ($message eq 'on') { - map { $okpreps{$_} = 1 } $this->stand_prepositions; - } - - # If its closed, and not transparent, then skip some lists. - if ($this->closed && ! $this->transparent) { - return if grep { $_ eq $preplist } $this->closedpreps; - } - - # Find objects that match the preposition list. - my @contents; - foreach my $obj (@visicontents) { - # Only look at objects that have the right leading - # preposition. - next unless $okpreps{($obj->preposition)[0]}; - push @contents, $obj; - } - - $this->msg("look_$message", %_, - contents => @contents ? $avatar->prettylist(@contents) : 'nothing', - are => (@contents > 1 || ($contents[0] == $avatar && @contents == 1)) ? 'are' : 'is', - ); -} - -run sub { - my $this=shift; - %_=@_; - my $preposition=lc($_{do_preposition}); - $avatar=$_{avatar}; - - foreach ($this->contents->list) { - if (! $_->hidden) { - push @visicontents, $_; - } - elsif ($_->defines("detail")) { - $_{details}.=" ".$_->detail; - } - } - - if (! $_{direct_object}) { - # If no direct object was specified (the user just - # did a "look", then they must be in/on/whatever this - # furniture. Display a message to that effect, and then - # let them look at the enclosing room. - if ($avatar->location != $this) { - exit Mooix::Verb::SKIP; - } - - $this->location->look_verb(@_) if $this->location; - $this->msg('occupied', %_, preposition => ($avatar->preposition)[0]); - } - elsif (length $preposition && $preposition ne 'at') { - # If certian prepositions are specified, what is seen depends - # on the preposition. Looking underneath the object could - # return one set, while looking in it might return another. - my $ok=0; - foreach my $preplist ($this->preplists) { - my @list=$this->$preplist; - if (grep { $_ eq $preposition } @list) { - look_prep($this, $preplist, \@list, %_); - $ok=1; - last; - } - } - if (! $ok) { - fail "Nothing there."; - } - } - else { - # If no preposition was specified, do a regular look, and - # use the visible ones. - $this->msg('look', %_); - foreach my $preplist ($this->visiblepreps) { - look_prep($this, $preplist, [$this->$preplist], %_); - } - } - - if ($this->closed) { - $this->msg('closed', %_); - } -} Index: obj/concrete/furniture/closedpreps =================================================================== --- obj/concrete/furniture/closedpreps (revision 23) +++ obj/concrete/furniture/closedpreps (working copy) @@ -1 +0,0 @@ -in_prepositions Index: obj/concrete/furniture/sit_already.msg =================================================================== --- obj/concrete/furniture/sit_already.msg (revision 0) +++ obj/concrete/furniture/sit_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already sitting down. Index: obj/concrete/furniture/stand_on_already.msg =================================================================== --- obj/concrete/furniture/stand_on_already.msg (revision 0) +++ obj/concrete/furniture/stand_on_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already standing there. Index: obj/concrete/furniture/under_prepositions =================================================================== --- obj/concrete/furniture/under_prepositions (revision 23) +++ obj/concrete/furniture/under_prepositions (working copy) @@ -1,5 +0,0 @@ -under -underneath -beneath -from -out Index: obj/concrete/furniture/look_relation =================================================================== --- obj/concrete/furniture/look_relation (revision 0) +++ obj/concrete/furniture/look_relation (revision 0) @@ -0,0 +1,73 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + +my @visicontents; + +# This sub handles a look for objects that have a particular releationship +# to the furniture. +sub look_relation { + my $this=shift; + my $relation=shift; + %_=@_; + my $avatar=$_{avatar}; + + # If its closed, and not transparent, then skip some lists. + if( $this->closed && ! $this->transparent ) { + return if grep { $_ eq $relation } $this->closed_relations; + } + + # Find objects that match the relation. + my @contents; + foreach my $obj (@visicontents) { + my $test_relation; + # Several things count as "on" for our purposes. + if( $obj->relation eq "stand" || + $obj->relation eq "stand" || + $obj->relation eq "set" ) { + $test_relation = "on"; + } else { + $test_relation = $obj->relation; + } + next unless $test_relation eq $relation; + push @contents, $obj; + } + + if( @contents ) + { + $this->msg("look_$relation", %_, contents => $this->prettylist( $avatar, @contents ) ); + } else { + $this->msg( "look_${relation}_nothing", %_ ); + } +} + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + $relation=$_{relation}; + + foreach ($this->contents->list) { + if (! $_->hidden) { + push @visicontents, $_; + } + elsif ($_->defines("detail")) { + $_{details}.=" ".$_->detail; + } + } + + # If certain relations are specified, what is seen + # depends on the relations. Looking underneath the + # object could return one set, while looking in it + # might return another. + if (grep { $_ eq $relation } $this->valid_relations ) { + look_relation($this, $relation, %_); + } else { + $this->msg("look_nothing_there", %_); + fail(); + } + + if ($this->closed) { + $this->msg('closed', %_); + } +} Property changes on: obj/concrete/furniture/look_relation ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/look_behind.msg =================================================================== --- obj/concrete/furniture/look_behind.msg (revision 23) +++ obj/concrete/furniture/look_behind.msg (working copy) @@ -1 +1 @@ -session,see: $contents $are behind $this. +session,see: Looking behind $this you see $contents. Index: obj/concrete/furniture/onmove =================================================================== --- obj/concrete/furniture/onmove (revision 23) +++ obj/concrete/furniture/onmove (working copy) @@ -2,20 +2,20 @@ #use Fcntl q{:flock}; #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $underprep=($this->under_prepositions)[0]; - foreach my $obj ($this->contents->list) { - if (($obj->preposition)[0] eq $underprep) { - # Lock the object for movement. Since it could have - # moved while we were reading the contents list, - # check its location after. - # (FIXME There is also a race that an object could be - # added to a container just as it is being moved, - # and this loop would not see it.) - my $lock = $obj->getlock(LOCK_EX); - next if $obj->location != $this; - $obj->physics->move(object => $obj, to => $_{oldloc}); - } + my $this=shift; + %_=@_; + foreach my $obj ($this->contents->list) { + if( $obj->relation eq "under" ) { + # Lock the object for movement. Since it could have + # moved while we were reading the contents list, + # check its location after. + + # FIXME: There is also a race that an object could be + # added to a container just as it is being moved, + # and this loop would not see it. + my $lock = $obj->getlock(LOCK_EX); + next if $obj->location != $this; + $obj->physics->move(object => $obj, to => $_{oldloc}); } + } } Index: obj/concrete/furniture/look.cmd =================================================================== --- obj/concrete/furniture/look.cmd (revision 23) +++ obj/concrete/furniture/look.cmd (working copy) @@ -1,3 +1,19 @@ -verb -verb, direct_object(this)(visible) -verb, preposition(around) +## From furniture: +# "look" from inside the furniture +verb : look_around +verb, preposition(around) : look_around +## From "thing": +# look the ball +verb, direct_object(this)(visible) : look +# look at the ball, look at the ball which is in the box +verb, do_preposition(at), direct_object(this)(visible) : look +# look the ball in the box +verb, direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look at the ball in the box +verb, do_preposition(at), direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +## From furniture: +# looking at specific parts of the furniture's contents +verb, do_preposition(set@in_prepositions), direct_object(this)(visible) : look_in +verb, do_preposition(set@on_prepositions), direct_object(this)(visible) : look_on +verb, do_preposition(set@under_prepositions), direct_object(this)(visible) : look_under +verb, do_preposition(set@behind_prepositions), direct_object(this)(visible) : look_behind Index: obj/concrete/furniture/occupied_in.msg =================================================================== --- obj/concrete/furniture/occupied_in.msg (revision 0) +++ obj/concrete/furniture/occupied_in.msg (revision 0) @@ -0,0 +1 @@ +session: You are in $this. Index: obj/concrete/furniture/visiblepreps =================================================================== --- obj/concrete/furniture/visiblepreps (revision 23) +++ obj/concrete/furniture/visiblepreps (working copy) @@ -1 +0,0 @@ -on_prepositions Index: obj/concrete/furniture/get_preposition =================================================================== --- obj/concrete/furniture/get_preposition (revision 23) +++ obj/concrete/furniture/get_preposition (working copy) @@ -1,27 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -run sub { - my $this=shift; - %_=@_; - my $preposition = lc($_{preposition}); - my @preplists=$this->preplists; - - if (length $preposition) { - my %closedpreps; - if ($this->closed) { - %closedpreps = map { $_ => 1 } $this->closedpreps; - } - foreach my $list (@preplists) { - next if $closedpreps{$list}; - my @list=$this->$list; - if (grep { $_ eq $preposition } @list) { - return @list; - } - } - return; # no matches - } - else { - my $default=$preplists[0]; - return $this->$default; - } -} Index: obj/concrete/furniture/visiblecontents =================================================================== --- obj/concrete/furniture/visiblecontents (revision 23) +++ obj/concrete/furniture/visiblecontents (working copy) @@ -1,8 +1,9 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - my %okpreps = map { $_ => 1 } map { $this->$_ } $this->visiblepreps; - return grep { ! $_->hidden && $okpreps{($_->preposition)[0]} } - $this->contents->list + my $this=shift; + my %ok_relations = map { $_ => 1 } $this->visible_relations; + my @contents; + @contents = grep { ! $_->hidden && $ok_relations{$_->relation} } $this->contents->list; + return @contents; } Index: obj/concrete/furniture/visible_relations =================================================================== --- obj/concrete/furniture/visible_relations (revision 0) +++ obj/concrete/furniture/visible_relations (revision 0) @@ -0,0 +1 @@ +on Index: obj/concrete/furniture/look_under_verb =================================================================== --- obj/concrete/furniture/look_under_verb (revision 0) +++ obj/concrete/furniture/look_under_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->look_relation( %_, relation => "under" ); +} Property changes on: obj/concrete/furniture/look_under_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/in_prepositions =================================================================== --- obj/concrete/furniture/in_prepositions (revision 23) +++ obj/concrete/furniture/in_prepositions (working copy) @@ -1,8 +0,0 @@ -in -lying -into -inside -out -of -from -within Index: obj/concrete/furniture/look_on.msg =================================================================== --- obj/concrete/furniture/look_on.msg (revision 23) +++ obj/concrete/furniture/look_on.msg (working copy) @@ -1 +1 @@ -session,see: $contents $are on $this. +session,see: Looking on $this, you find $contents. Index: obj/concrete/furniture/stand_on_fail.msg =================================================================== --- obj/concrete/furniture/stand_on_fail.msg (revision 0) +++ obj/concrete/furniture/stand_on_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't stand on that. Index: obj/concrete/furniture/stand_prepositions =================================================================== --- obj/concrete/furniture/stand_prepositions (revision 23) +++ obj/concrete/furniture/stand_prepositions (working copy) @@ -1,7 +0,0 @@ -standing on -standing -on -top -of -from -onto Index: obj/concrete/furniture/on_prepositions =================================================================== --- obj/concrete/furniture/on_prepositions (revision 23) +++ obj/concrete/furniture/on_prepositions (working copy) @@ -1,8 +0,0 @@ -on -sitting on -sitting -lying -top -of -from -onto Index: obj/concrete/furniture/closedpreps.inf =================================================================== --- obj/concrete/furniture/closedpreps.inf (revision 23) +++ obj/concrete/furniture/closedpreps.inf (working copy) @@ -1,2 +0,0 @@ -This field lists preposition lists that are blocked off when an object is -closed. Index: obj/concrete/furniture/stand.msg =================================================================== --- obj/concrete/furniture/stand.msg (revision 23) +++ obj/concrete/furniture/stand.msg (working copy) @@ -1,2 +0,0 @@ -$avatar: You stand up. -see: $avatar $avatar->verb(stands) up. Index: obj/concrete/furniture/occupied_sit.msg =================================================================== --- obj/concrete/furniture/occupied_sit.msg (revision 0) +++ obj/concrete/furniture/occupied_sit.msg (revision 0) @@ -0,0 +1 @@ +session: You are sitting on $this. Index: obj/concrete/furniture/locked =================================================================== --- obj/concrete/furniture/locked (revision 0) +++ obj/concrete/furniture/locked (revision 0) @@ -0,0 +1 @@ +0 Index: obj/concrete/furniture/look_in_nothing.msg =================================================================== --- obj/concrete/furniture/look_in_nothing.msg (revision 0) +++ obj/concrete/furniture/look_in_nothing.msg (revision 0) @@ -0,0 +1,2 @@ +session: Rummaging around in $this, you find nothing. +see: $avatar $avatar->verb(rummages) around in $this. Index: obj/concrete/furniture/under_prepositions.inf =================================================================== --- obj/concrete/furniture/under_prepositions.inf (revision 23) +++ obj/concrete/furniture/under_prepositions.inf (working copy) @@ -1,2 +0,0 @@ -This field is a list of prepositions that can be used by objects under the -furniture. Index: obj/concrete/furniture/behind_prepositions =================================================================== --- obj/concrete/furniture/behind_prepositions (revision 23) +++ obj/concrete/furniture/behind_prepositions (working copy) @@ -1,4 +0,0 @@ -behind -in back of -back of -back Index: obj/concrete/furniture/look_in_verb =================================================================== --- obj/concrete/furniture/look_in_verb (revision 0) +++ obj/concrete/furniture/look_in_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->look_relation( %_, relation => "in" ); +} Property changes on: obj/concrete/furniture/look_in_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/furniture/look_under_nothing.msg =================================================================== --- obj/concrete/furniture/look_under_nothing.msg (revision 0) +++ obj/concrete/furniture/look_under_nothing.msg (revision 0) @@ -0,0 +1,8 @@ +session: Groping around under $this you find nothing. +see: $avatar $avatar->verb(pokes) around under $this. + +session: Groping around under $this you find nothing. +see: $avatar $avatar->verb(looks) under $this. + +session: Groping around under $this you find nothing. +see: $avatar $avatar->verb(gropes) around under $this. Index: obj/concrete/furniture/sit_verb =================================================================== --- obj/concrete/furniture/sit_verb (revision 23) +++ obj/concrete/furniture/sit_verb (working copy) @@ -4,27 +4,35 @@ #use Mooix::Verb; #use Mooix::Root; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; - my $prep = ($this->on_prepositions)[0]; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; - my $lock = $avatar->getlock(LOCK_EX); + my $lock = $avatar->getlock(LOCK_EX); - if ($avatar->location == $this && ($avatar->preposition)[0] eq $prep) { - fail "You're already seated." + if( $avatar->relation eq "sit" && $avatar->location == $this ) { + if( $_{direct_object} ) + { + $this->msg("sit_on_already", %_); + } else { + $this->msg("sit_already", %_); } + fail(); + } - if (! $this->location->isa($Mooix::Root->concrete->room)) { - # Let the parser try some better peice of furniture. - exit Mooix::Verb::SKIP; - } - - if ($prep && - $avatar->physics->move(object => $avatar, to => $this, preposition => $prep)) { - $this->msg('sit', %_); - } - else { - fail "You can't sit there."; - } + if( ! $this->location->isa($Mooix::Root->concrete->room) ) { + # Let the parser try some better peice of furniture. + exit Mooix::Verb::SKIP; + } + + if( + $avatar->physics->move(object => $avatar, + to => $this, relation => "sit" ) + ) + { + $this->msg('sit', %_); + } else { + $this->msg("sit_fail", %_); + fail(); + } } Index: obj/concrete/furniture/occupied_under.msg =================================================================== --- obj/concrete/furniture/occupied_under.msg (revision 0) +++ obj/concrete/furniture/occupied_under.msg (revision 0) @@ -0,0 +1 @@ +session: You are under $this. Index: obj/concrete/furniture/look_on_verb =================================================================== --- obj/concrete/furniture/look_on_verb (revision 0) +++ obj/concrete/furniture/look_on_verb (revision 0) @@ -0,0 +1,11 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->look_relation( %_, relation => "on" ); +} Property changes on: obj/concrete/furniture/look_on_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/chair/valid_relations =================================================================== --- obj/concrete/chair/valid_relations (revision 0) +++ obj/concrete/chair/valid_relations (revision 0) @@ -0,0 +1,4 @@ +on +under +stand +sit Index: obj/concrete/chair/preplists =================================================================== --- obj/concrete/chair/preplists (revision 23) +++ obj/concrete/chair/preplists (working copy) @@ -1,3 +0,0 @@ -on_prepositions -under_prepositions -stand_prepositions Index: obj/concrete/chair/Makefile =================================================================== --- obj/concrete/chair/Makefile (revision 23) +++ obj/concrete/chair/Makefile (working copy) @@ -1,7 +1,7 @@ build:: - (cd ../furniture && cat `cat ../chair/preplists`) | sort | uniq > valid_prepositions + #(cd ../furniture && cat `cat ../chair/preplists`) | sort | uniq > valid_prepositions cp .basemass .mass clean:: - rm -f .mass valid_prepositions + rm -f .mass #valid_prepositions realclean:: Index: obj/concrete/table/valid_relations =================================================================== --- obj/concrete/table/valid_relations (revision 0) +++ obj/concrete/table/valid_relations (revision 0) @@ -0,0 +1,3 @@ +on +under +stand Index: obj/concrete/table/preplists =================================================================== --- obj/concrete/table/preplists (revision 23) +++ obj/concrete/table/preplists (working copy) @@ -1,3 +0,0 @@ -on_prepositions -under_prepositions -stand_prepositions Index: obj/concrete/table/look_under.msg =================================================================== --- obj/concrete/table/look_under.msg (revision 23) +++ obj/concrete/table/look_under.msg (working copy) @@ -1,2 +1,2 @@ -session: $contents $are under $this. +session: Under this you find $contents. see: $avatar $avatar->verb(looks) under $this. Index: obj/concrete/table/Makefile =================================================================== --- obj/concrete/table/Makefile (revision 23) +++ obj/concrete/table/Makefile (working copy) @@ -1,7 +1,7 @@ build:: - (cd ../furniture && cat `cat ../table/preplists`) | sort | uniq > valid_prepositions + #(cd ../furniture && cat `cat ../table/preplists`) | sort | uniq > valid_prepositions cp .basemass .mass clean:: - rm -f .mass valid_prepositions + rm -f .mass #valid_prepositions realclean:: Index: obj/concrete/consumable/consume_not_holding.msg =================================================================== --- obj/concrete/consumable/consume_not_holding.msg (revision 0) +++ obj/concrete/consumable/consume_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You must be holding that. Index: obj/concrete/consumable/consume_verb =================================================================== --- obj/concrete/consumable/consume_verb (revision 23) +++ obj/concrete/consumable/consume_verb (working copy) @@ -17,7 +17,8 @@ if (! $_{direct_object}) { exit Mooix::Verb::SKIP; } - fail "It's all used up."; + $this->msg( 'consume_none', %_ ); + fail(); } if (! $_{notake}) { # take the consumable @@ -25,7 +26,8 @@ $this->take_verb(%_); } if ($this->location != $avatar) { - fail "You must be holding that." + $this->msg( 'consume_not_holding', %_ ); + fail(); } } Index: obj/concrete/consumable/consume_none.msg =================================================================== --- obj/concrete/consumable/consume_none.msg (revision 0) +++ obj/concrete/consumable/consume_none.msg (revision 0) @@ -0,0 +1 @@ +session: It's all used up. Index: obj/concrete/weapon/wield_verb =================================================================== --- obj/concrete/weapon/wield_verb (revision 23) +++ obj/concrete/weapon/wield_verb (working copy) @@ -7,10 +7,12 @@ if ($this->wielded) { if ($this->location == $avatar) { - fail "You're already wielding that."; + $this->msg( 'wield_already', %_ ); + fail(); } else { - fail "Someone else is wielding that."; + $this->msg( 'wield_someone_else', %_ ); + fail(); } } @@ -18,7 +20,8 @@ if ($this->location != $avatar) { $this->take_verb(avatar => $avatar); if ($this->location != $avatar) { - fail "You're not holding that."; + $this->msg( 'wield_not_holding', %_ ); + fail(); } } @@ -31,6 +34,7 @@ $avatar->unwield(object => $this); $this->wielded(0) if $this->wielded; $this->immobile(0) if $this->immobile; - fail "You cannot wield that."; + $this->msg( 'wield_cannot', %_ ); + fail(); } } Index: obj/concrete/weapon/attack_verb =================================================================== --- obj/concrete/weapon/attack_verb (revision 23) +++ obj/concrete/weapon/attack_verb (working copy) @@ -5,7 +5,8 @@ if (! $this->wielded) { $this->wield_verb(@_); if ($?) { - fail "You look for some other weapon to attack with."; + $this->msg( 'attack_new_weapon', %_ ); + fail(); } } $this->exec->super(@_); Index: obj/concrete/weapon/wield_someone_else.msg =================================================================== --- obj/concrete/weapon/wield_someone_else.msg (revision 0) +++ obj/concrete/weapon/wield_someone_else.msg (revision 0) @@ -0,0 +1 @@ +session: Someone else is wielding that. Index: obj/concrete/weapon/wield_already.msg =================================================================== --- obj/concrete/weapon/wield_already.msg (revision 0) +++ obj/concrete/weapon/wield_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already wielding that. Index: obj/concrete/weapon/wield_cannot.msg =================================================================== --- obj/concrete/weapon/wield_cannot.msg (revision 0) +++ obj/concrete/weapon/wield_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot wield that. Index: obj/concrete/weapon/wield_not_holding.msg =================================================================== --- obj/concrete/weapon/wield_not_holding.msg (revision 0) +++ obj/concrete/weapon/wield_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that. Index: obj/concrete/weapon/attack_new_weapon.msg =================================================================== --- obj/concrete/weapon/attack_new_weapon.msg (revision 0) +++ obj/concrete/weapon/attack_new_weapon.msg (revision 0) @@ -0,0 +1 @@ +session: You look for some other weapon to attack with. Index: obj/concrete/bed/sit_fail.msg =================================================================== --- obj/concrete/bed/sit_fail.msg (revision 0) +++ obj/concrete/bed/sit_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't sit there. Index: obj/concrete/bed/valid_relations =================================================================== --- obj/concrete/bed/valid_relations (revision 0) +++ obj/concrete/bed/valid_relations (revision 0) @@ -0,0 +1,6 @@ +on +in +under +stand +sit +lie Index: obj/concrete/bed/sit_already.msg =================================================================== --- obj/concrete/bed/sit_already.msg (revision 0) +++ obj/concrete/bed/sit_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already seated. Index: obj/concrete/bed/lie_verb =================================================================== --- obj/concrete/bed/lie_verb (revision 23) +++ obj/concrete/bed/lie_verb (working copy) @@ -7,10 +7,10 @@ my $this=shift; %_=@_; my $avatar=$_{avatar}; - my $prep = ($this->in_prepositions)[0]; - if ($avatar->location == $this && ($avatar->preposition)[0] eq $prep) { - fail "You're already there." + if ($avatar->location == $this && $avatar->relatien eq "lie") { + $this->msg( 'lie_already', %_ ); + fail(); } if (! $this->location->isa($Mooix::Root->concrete->room)) { @@ -18,11 +18,11 @@ } my $lock = $avatar->getlock(LOCK_EX); - if ($prep && - $avatar->physics->move(object => $avatar, to => $this, preposition => $prep)) { + + if( $avatar->physics->move(object => $avatar, to => $this, relation => "lie" )) { $this->msg('lie', %_); + } else { + $this->msg( 'lie_fail', %_ ); + fail(); } - else { - fail "You can't lie down there."; - } } Index: obj/concrete/bed/lie_fail.msg =================================================================== --- obj/concrete/bed/lie_fail.msg (revision 0) +++ obj/concrete/bed/lie_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't lie down there. Index: obj/concrete/bed/lie_already.msg =================================================================== --- obj/concrete/bed/lie_already.msg (revision 0) +++ obj/concrete/bed/lie_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already there. Index: obj/concrete/bed/sit.cmd =================================================================== --- obj/concrete/bed/sit.cmd (revision 23) +++ obj/concrete/bed/sit.cmd (working copy) @@ -1,3 +1,3 @@ -verb, direct_object(this)(touchable) +verb, do_preposition(set@sit_prepositions), direct_object(this)(touchable) verb, preposition(down|up) verb Index: obj/concrete/bed/occupied_lie.msg =================================================================== --- obj/concrete/bed/occupied_lie.msg (revision 0) +++ obj/concrete/bed/occupied_lie.msg (revision 0) @@ -0,0 +1 @@ +session: You are lying on $this. Index: obj/concrete/bed/lie.cmd =================================================================== --- obj/concrete/bed/lie.cmd (revision 23) +++ obj/concrete/bed/lie.cmd (working copy) @@ -1,2 +1,3 @@ +verb, do_preposition(set@lie_prepositions), direct_object(this) verb, direct_object(this) verb, preposition(down) Index: obj/concrete/bed/sit_verb =================================================================== --- obj/concrete/bed/sit_verb (revision 23) +++ obj/concrete/bed/sit_verb (working copy) @@ -2,28 +2,29 @@ #use Fcntl q{:flock}; #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $avatar = $_{avatar}; + my $this=shift; + %_=@_; + my $avatar = $_{avatar}; - # Handle the case of "sit up" and "sit bed", when the avatar - # is already lying in the bed. - if ($_{preposition} eq 'up' || $this == $avatar->location) { - my $prep = ($this->on_prepositions)[0]; - if (($avatar->preposition)[0] eq $prep) { - fail "You're already seated." - } - my $lock = $avatar->getlock(LOCK_EX); - if ($prep && - $avatar->physics->move(object => $avatar, to => $this, preposition => $prep)) { - $this->msg('situp', %_); - } - else { - fail "You can't sit there."; - } + # Handle the case of "sit up" and "sit bed", when the avatar + # is already lying in the bed. + if( $this == $avatar->location ) { + if( $avatar->relation eq "sit" ) { + $this->msg( 'sit_already', %_ ); + fail(); } + my $lock = $avatar->getlock(LOCK_EX); + if( + $avatar->physics->move(object => $avatar, to => $this, relation => "sit" ) + ) { + $this->msg('situp', %_); + } else { - # Regular sitting. - $this->super(@_); + $this->msg( 'sit_fail', %_ ); + fail(); } + } else { + # Regular sitting. + $this->super(@_); + } } Index: obj/concrete/package/check_bad_format.msg =================================================================== --- obj/concrete/package/check_bad_format.msg (revision 0) +++ obj/concrete/package/check_bad_format.msg (revision 0) @@ -0,0 +1 @@ +session: Package format mismatch. Index: obj/concrete/package/look_verb =================================================================== --- obj/concrete/package/look_verb (revision 23) +++ obj/concrete/package/look_verb (working copy) @@ -12,7 +12,7 @@ } elsif ($this->objects) { $state="When built it will include ". - $avatar->prettylist(grep ref, $this->objects)."."; + $avatar->prettylist($avatar, grep ref, $this->objects)."."; } elsif ($this->installs) { $state="When installed it will create ". Index: obj/concrete/package/remove.msg =================================================================== --- obj/concrete/package/remove.msg (revision 0) +++ obj/concrete/package/remove.msg (revision 0) @@ -0,0 +1 @@ +session: Contents: $contents. Index: obj/concrete/package/build.msg =================================================================== --- obj/concrete/package/build.msg (revision 0) +++ obj/concrete/package/build.msg (revision 0) @@ -0,0 +1 @@ +session: Built the package. Index: obj/concrete/package/dump_fail.msg =================================================================== --- obj/concrete/package/dump_fail.msg (revision 0) +++ obj/concrete/package/dump_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Error building package. Index: obj/concrete/package/import_cannot_read.msg =================================================================== --- obj/concrete/package/import_cannot_read.msg (revision 0) +++ obj/concrete/package/import_cannot_read.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot read that file. Index: obj/concrete/package/import.msg =================================================================== --- obj/concrete/package/import.msg (revision 0) +++ obj/concrete/package/import.msg (revision 0) @@ -0,0 +1 @@ +session: File imported. Index: obj/concrete/package/build_empty.msg =================================================================== --- obj/concrete/package/build_empty.msg (revision 0) +++ obj/concrete/package/build_empty.msg (revision 0) @@ -0,0 +1 @@ +session: The package is empty! Index: obj/concrete/package/check_newer.msg =================================================================== --- obj/concrete/package/check_newer.msg (revision 0) +++ obj/concrete/package/check_newer.msg (revision 0) @@ -0,0 +1 @@ +session: The package is from a newer version of mooix, and cannot be installed here. Index: obj/concrete/package/import_bad_name.msg =================================================================== --- obj/concrete/package/import_bad_name.msg (revision 0) +++ obj/concrete/package/import_bad_name.msg (revision 0) @@ -0,0 +1 @@ +session: Bad file name. Index: obj/concrete/package/add_verb =================================================================== --- obj/concrete/package/add_verb (revision 23) +++ obj/concrete/package/add_verb (working copy) @@ -11,11 +11,14 @@ $objects{$obj->index} = $obj; eval {$this->objects(values %objects)}; if ($@) { - fail "You can't do that." + $this->msg( 'add_fail', %_ ); + fail(); } $this->data(''); - $this->installs(Mooix::Thing->prettylist(values %objects)); + $this->installs(Mooix::Thing->prettylist($avatar, values %objects)); - $session->write("Contents: ".$avatar->prettylist(values %objects)); + $this->msg( 'add', + contents => $avatar->prettylist($avatar, values %objects), + %_ ); } Index: obj/concrete/package/check =================================================================== --- obj/concrete/package/check (revision 23) +++ obj/concrete/package/check (working copy) @@ -6,7 +6,7 @@ my @err; if (! @_) { - push @err, "Cannot parse that package data."; + push @err, 'check_cannot_parse'; } # These are the fields in this package that can be set based on @@ -22,17 +22,17 @@ if ($object eq $first && defined $field) { if ($field eq 'dbversion') { if ($value[0] > $Mooix::Root->system->mooinfo->dbversion) { - push @err, "The package is from a newer version of mooix, and cannot be installed here."; + push @err, 'check_newer'; } } elsif ($field eq 'format') { if ($value[0] ne $this->format) { - push @err, "Package format mismatch."; + push @err, 'check_bad_format'; } } elsif ($field eq 'parent') { if ($value[0] != $this->parent) { - push @err, "This package object cannot install that data. You need an object derived from $value[0] to handle it."; + push @err, 'check_bad_parent'; } } Index: obj/concrete/package/remove_fail.msg =================================================================== --- obj/concrete/package/remove_fail.msg (revision 0) +++ obj/concrete/package/remove_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that. Index: obj/concrete/package/build_fail.msg =================================================================== --- obj/concrete/package/build_fail.msg (revision 0) +++ obj/concrete/package/build_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Error building package. Index: obj/concrete/package/check_bad_parent.msg =================================================================== --- obj/concrete/package/check_bad_parent.msg (revision 0) +++ obj/concrete/package/check_bad_parent.msg (revision 0) @@ -0,0 +1 @@ +session: This package object cannot install that data. It defines a different package parent. Index: obj/concrete/package/dump_verb =================================================================== --- obj/concrete/package/dump_verb (revision 23) +++ obj/concrete/package/dump_verb (working copy) @@ -7,12 +7,14 @@ my $avatar=$_{avatar}; if (! grep ref, $this->objects) { - fail "The package is empty!"; + $this->msg( 'dump_empty', %_ ); + fail(); } my @data=$this->generate; if (! @data) { - fail "Error building package."; + $this->msg( 'dump_fail', %_ ); + fail(); } $session->page(@data); Index: obj/concrete/package/design.inf =================================================================== --- obj/concrete/package/design.inf (revision 23) +++ obj/concrete/package/design.inf (working copy) @@ -7,7 +7,7 @@ It's designed for machine generation and for mooix's method argument passing scheme (such as it is), and is subject to change, probably. The safechange methods of avatars consume this serialisation form and produce -objects, (or changes to objects). And the documentaton of those methods +objects (or changes to objects). And the documentaton of those methods explains how this serialisation works. The other is used to transport objects between systems. Its design goals Index: obj/concrete/package/basics.hlp =================================================================== --- obj/concrete/package/basics.hlp (revision 23) +++ obj/concrete/package/basics.hlp (working copy) @@ -1,116 +0,0 @@ -All about mooix packages. - -This object can create mooix package files, that can be distributed -to other mooix systems. It can also install such files. - -Getting started: - - To create or install a package file, you must first create a new package - object, if you don't have one. But you probably already do if you're - reading this help. Anyway, the command is: - - > derive from mooix:package - -Installing a package: - - WARNING! If you're a =programmer=, then a package can add new methods - to the moo. This code can do anything, and you'll be held responsible. - If you're a =builder=, a package can still add various messed up - references and other sorts of broken objects that can royally confuse - things. And you'll be held responsible. Do not install packages from - untrusted sources, and do look them over before you install them.. - - If you have a mooix package file, which will usually have a name ending - in ".mooix", you can use this object to install it. This object has a - field named data, that must first be loaded up with the contents of - your package file. You can fill the data field any way you like; one - way is to =edit= the field, and paste in your file. - - If the package file is already on the mooix server, you can instead use - the import command to load the file into the package. - - > import "/path/to/package.mooix" into my package - - Once the package is readied, you can install it: - - > install my package - - Assuming everything went ok, the objects in the package will be added to - your portfolio, and will be put in your inventory for you to use. - -Building a package: - - To create a package file, start by adding whatever objects you want to - distribute into the package. - - > add object1 and object2 to my package - - If you have a set of objects that form some whole you want to distribute - as one, then put them all in a single package. If you add an object, like - an avatar, that has encapsulated sub-objects, those objects will - automatically be included in the package. However, if you have a - container with something in it, adding the container does not - automatically add its contents -- the contents should be added - explicitly. - - You can describe the package in the usual way, and add any additional - fields to it you like. You can even set its version number. Most of its - fields will be included in the package file when it's build. - - > describe my package as "A package of object1 and object2." - > its version is "1.0" - - Now that the package is set up, you need to get the package file to - distribute to others. There are two ways to do this. The dump command - will output the package file to your screen, and you can copy and paste - it or capture it to a file on your local system. You should name the file - with the extension ".mooix" that is used to indicate this is a mooix - package. - - > dump the package - [package] - date "Tue Jun 24 15:25:24 2003" - ... - - Alternatively, if you have a way to download files from the moo, you can - update the package's data field using the build command: - - > build the package - - And then copy the data field out of the package (to a filename ending in - ".mooix" to indicate it's a mooix package), and distribute it. - -Things that can go wrong: - - Let's look at some situations this package system cannot deal with - properly. All of these can be avoided if you think about the object's - you are packaging up, and do some testing. - - If you package an object that is based on some non-standard object in - your moo, then it will be useless on other moos that do not have its - parent. The solution is to package both objects together. - - Suppose you package up a room, that happens to have some object like - the moo admin in it. If this package is installed on another moo (or on - the origin moo!), the result will be another room, that has a contents - list. That includes the moo admin. The moo admin will now be sorta in two - places at once, he'll be told about anything that goes on in this new - room as if he's there, when in fact he's not. The result will likely be a - rather annoyed moo admin. - - Suppose you package up an avatar, while the avatar's logged in. Then you - install it onto another moo. There will probably be problems, since the - object represents a logged-in avatar, and has its aware field set to - true. It may even end up with a session list that includes someone else's - session. - - Maybe the object you package up is derived from a mooix system object, - but your moo has modified that object in some way. Then it may be broken - on the destination moo. - -Limitations: - - Does not preserve any file dates. - - There is no way to upgrade a package after installing it, aside from a - removal and reinstall. Index: obj/concrete/package/import_warn.msg =================================================================== --- obj/concrete/package/import_warn.msg (revision 0) +++ obj/concrete/package/import_warn.msg (revision 0) @@ -0,0 +1 @@ +session: File imported, with warnings. Index: obj/concrete/package/import_verb =================================================================== --- obj/concrete/package/import_verb (revision 23) +++ obj/concrete/package/import_verb (working copy) @@ -7,14 +7,19 @@ my $file=$_{quote}; if ($file !~ /.+\.mooix/) { - fail "Only files ending in \".mooix\" can be imported."; + $this->msg( 'import_wrong_type', %_ ); + fail(); } if (! -f $file) { - fail "Bad filename."; + $this->msg( 'import_bad_name', %_ ); + fail(); } - open (IN, $file) || fail "Cannot read that file."; + if( ! open (IN, $file) ) { + $this->msg( 'import_cannot_read', %_ ); + fail(); + } my @lines; while () { chomp; @@ -25,9 +30,10 @@ $this->data(@lines); my @ret=$this->check($this->parse(map {( line => $_ )} @lines)); if (@ret) { - $session->write($_) foreach @ret; - fail "File imported, with warnings."; + $this->msg( $_, %_ ) foreach @ret; + $this->msg( 'import_warn', %_ ); + fail(); } - $session->write("File imported."); + $this->msg( 'import', %_ ); } Index: obj/concrete/package/generate =================================================================== --- obj/concrete/package/generate (revision 23) +++ obj/concrete/package/generate (working copy) @@ -14,6 +14,7 @@ run sub { my $this=shift; %_=@_; + my $avatar=$_{avatar}; if (! grep ref, $this->objects) { return; # error @@ -31,7 +32,7 @@ $this->hostname($Mooix::Root->system->mooinfo->hostname); $this->date(scalar localtime); $this->format($this->format); # force into serialisation - $this->installs(Mooix::Thing->prettylist(grep ref, $this->objects)); + $this->installs(Mooix::Thing->prettylist($avatar, grep ref, $this->objects)); # Get all the serialisations. my @s = $this->serialise; @@ -153,8 +154,8 @@ foreach my $field (sort keys %{$objects{$object}->{fields}}, keys %{$objects{$object}->{empties}}) { # If the object location is not included, skip the - # preposition field too, to save space. - if ($field eq 'preposition' && + # relation field too, to save space. + if ($field eq 'relation' && ! defined $objects{$object}->{fields}->{location}) { next; } Index: obj/concrete/package/check_cannot_parse.msg =================================================================== --- obj/concrete/package/check_cannot_parse.msg (revision 0) +++ obj/concrete/package/check_cannot_parse.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot parse that package data. Index: obj/concrete/package/install =================================================================== --- obj/concrete/package/install (revision 23) +++ obj/concrete/package/install (working copy) @@ -20,7 +20,7 @@ my @err=$this->check(@s); if (@err) { foreach (@err) { - $_{session}->write($_); + $this->msg($_); } return; } Index: obj/concrete/package/build_not_needed.msg =================================================================== --- obj/concrete/package/build_not_needed.msg (revision 0) +++ obj/concrete/package/build_not_needed.msg (revision 0) @@ -0,0 +1 @@ +session: No need to build it, it's ready to be installed. Index: obj/concrete/package/add_fail.msg =================================================================== --- obj/concrete/package/add_fail.msg (revision 0) +++ obj/concrete/package/add_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that. Index: obj/concrete/package/dump_empty.msg =================================================================== --- obj/concrete/package/dump_empty.msg (revision 0) +++ obj/concrete/package/dump_empty.msg (revision 0) @@ -0,0 +1 @@ +session: The package is empty! Index: obj/concrete/package/remove_verb =================================================================== --- obj/concrete/package/remove_verb (revision 23) +++ obj/concrete/package/remove_verb (working copy) @@ -18,11 +18,16 @@ } }; if ($@) { - fail "You can't do that."; + $this->msg( 'remove_fail', %_ ); + fail(); } $this->data(''); - $this->installs(Mooix::Thing->prettylist(values %objects)); + $this->installs(Mooix::Thing->prettylist($avatar, values %objects)); - $session->write("Contents: ".$avatar->prettylist(values %objects)); + $this->msg( + 'remove', + contents => $avatar->prettylist($avatar, values %objects) , + %_, + ); } Index: obj/concrete/package/import_wrong_type.msg =================================================================== --- obj/concrete/package/import_wrong_type.msg (revision 0) +++ obj/concrete/package/import_wrong_type.msg (revision 0) @@ -0,0 +1 @@ +session: Only files ending in ".mooix" can be imported. Index: obj/concrete/package/build_verb =================================================================== --- obj/concrete/package/build_verb (revision 23) +++ obj/concrete/package/build_verb (working copy) @@ -8,18 +8,21 @@ if (! grep ref, $this->objects) { if ($this->data && $this->installs) { - fail "No need to build it, it's ready to be installed."; + $this->msg( 'build_not_needed', %_ ); + fail(); } else { - fail "The package is empty!"; + $this->msg( 'build_empty', %_ ); + fail(); } } my @data=$this->generate; if (! @data) { - fail "Error building package."; + $this->msg( 'build_fail', %_ ); + fail(); } $this->data(@data); - $session->write("Built the package."); + $this->msg( 'build', %_ ); }; Index: obj/concrete/package/add.msg =================================================================== --- obj/concrete/package/add.msg (revision 0) +++ obj/concrete/package/add.msg (revision 0) @@ -0,0 +1 @@ +session: Contents: $contents. Index: obj/concrete/couch/lie_already.msg =================================================================== --- obj/concrete/couch/lie_already.msg (revision 0) +++ obj/concrete/couch/lie_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already there. Index: obj/concrete/couch/lie_verb =================================================================== --- obj/concrete/couch/lie_verb (revision 23) +++ obj/concrete/couch/lie_verb (working copy) @@ -7,28 +7,29 @@ my $this=shift; %_=@_; my $avatar=$_{avatar}; - my $prep = ($this->on_prepositions)[0]; - # TODO if there are other avatars on the couch, probably shouldn't - # let this one lie down. I could just make lying down increase - # the volume used, and get this behavior for free (once I have - # volume tracking). + # TODO if there are other avatars on the couch, probably + # shouldn't let this one lie down. I could just make lying + # down increase the volume used, and get this behavior for + # free (once I have volume tracking). my $lock = $avatar->getlock(LOCK_EX); - if ($avatar->location == $this && ($avatar->preposition)[0] eq $prep) { - fail "You're already there." + if( $avatar->location == $this && $avatar->relation eq "lie" ) { + $this->msg( 'lie_already', %_ ); + fail(); } - if (! $this->location->isa($Mooix::Root->concrete->room)) { + if( ! $this->location->isa($Mooix::Root->concrete->room)) { exit Mooix::Verb::SKIP; # to next furniture } - if ($prep && - $avatar->physics->move(object => $avatar, to => $this, preposition => $prep)) { - $this->msg('lie', %_); + if( + $avatar->physics->move(object => $avatar, to => $this, relation => "lie" ) + ) { + $this->msg('lie', %_); + } else { + $this->msg( 'lie_fail', %_ ); + fail(); } - else { - fail "You can't lie down there."; - } } Index: obj/concrete/couch/lie_fail.msg =================================================================== --- obj/concrete/couch/lie_fail.msg (revision 0) +++ obj/concrete/couch/lie_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't lie down there. Index: obj/concrete/door/open_verb =================================================================== --- obj/concrete/door/open_verb (revision 23) +++ obj/concrete/door/open_verb (working copy) @@ -11,7 +11,8 @@ my @locks=getduallock($this, LOCK_EX, "closed"); if (! $this->closed) { - fail "It's already open."; + $this->msg( 'open_already', %_ ); + fail(); } if ($this->locked || ! $this->open(quiet => 1)) { $this->msg('openfail', %_); Index: obj/concrete/door/lock_need_key.msg =================================================================== --- obj/concrete/door/lock_need_key.msg (revision 0) +++ obj/concrete/door/lock_need_key.msg (revision 0) @@ -0,0 +1 @@ +session: You need a key to lock this door. Index: obj/concrete/door/open_already.msg =================================================================== --- obj/concrete/door/open_already.msg (revision 0) +++ obj/concrete/door/open_already.msg (revision 0) @@ -0,0 +1 @@ +session: It's already open. Index: obj/concrete/door/lock_not_holding.msg =================================================================== --- obj/concrete/door/lock_not_holding.msg (revision 0) +++ obj/concrete/door/lock_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that key. Index: obj/concrete/door/unlock_verb =================================================================== --- obj/concrete/door/unlock_verb (revision 23) +++ obj/concrete/door/unlock_verb (working copy) @@ -14,7 +14,8 @@ my @locks=getduallock($this, LOCK_EX, "locked"); if (! $this->locked) { - fail "It is not locked."; + $this->msg( 'unlock_not_locked', %_ ); + fail(); } if (! $this->manuallock) { @@ -38,25 +39,30 @@ # See if the given key is valid. if (! exists $keys{$key->key}) { $this->msg('badkey', key => $key, %_); - fail; + fail(); } if ($key->location != $avatar) { - fail "You're not holding that key."; + $this->msg( 'unlock_not_got_key', %_ ); + fail(); } } else { - fail "You need a key to unlock this door."; + $this->msg( 'unlock_need_key', %_ ); + fail(); } } if ($this->manuallock && $key && ! %keys) { - fail "You can unlock this door without a key."; + $this->msg( 'unlock_need_no_key', %_ ); + fail(); } elsif (! $this->manuallock && ! $key) { - fail "You need a key to unlock this door."; + $this->msg( 'unlock_need_key', %_ ); + fail(); } elsif (! $this->unlock) { - fail "You cannot unlock the door."; + $this->msg( 'unlock_fail', %_ ); + fail(); } $this->msg('unlock', %_); Index: obj/concrete/door/lock_verb =================================================================== --- obj/concrete/door/lock_verb (revision 23) +++ obj/concrete/door/lock_verb (working copy) @@ -15,7 +15,8 @@ my @locks=getduallock($this, LOCK_EX, "locked"); if ($this->locked) { - fail "It is already locked."; + $this->msg( 'lock_already', %_ ); + fail(); } if (! $this->manuallock) { @@ -42,16 +43,19 @@ fail; } if ($key->location != $avatar) { - fail "You're not holding that key."; + $this->msg( 'lock_not_holding', %_ ); + fail(); } } else { - fail "You need a key to lock this door."; + $this->msg( 'lock_need_key', %_ ); + fail(); } } if ($this->manuallock && $key && ! %keys) { - fail "You can lock this door without a key."; + $this->msg( 'lock_need_no_key', %_ ); + fail(); } elsif (! $this->manuallock && ! $key) { # See if the other side of the door can be manually locked, @@ -63,11 +67,13 @@ $this->msg('lock_otherside', %_) } else { - fail "You need a key to lock this door."; + $this->msg( 'lock_need_key', %_ ); + fail(); } } elsif (! $this->lock) { - fail "You cannot lock the door."; + $this->msg( 'lock_fail', %_ ); + fail(); } $this->msg('lock', %_); Index: obj/concrete/door/unlock_fail.msg =================================================================== --- obj/concrete/door/unlock_fail.msg (revision 0) +++ obj/concrete/door/unlock_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot unlock the door. Index: obj/concrete/door/lock_need_no_key.msg =================================================================== --- obj/concrete/door/lock_need_no_key.msg (revision 0) +++ obj/concrete/door/lock_need_no_key.msg (revision 0) @@ -0,0 +1 @@ +session: You can lock this door without a key. Index: obj/concrete/door/unlock_key_not_holding.msg =================================================================== --- obj/concrete/door/unlock_key_not_holding.msg (revision 0) +++ obj/concrete/door/unlock_key_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that key. Index: obj/concrete/door/unlock_need_no_key.msg =================================================================== --- obj/concrete/door/unlock_need_no_key.msg (revision 0) +++ obj/concrete/door/unlock_need_no_key.msg (revision 0) @@ -0,0 +1 @@ +session: You can unlock this door without a key. Index: obj/concrete/door/close_verb =================================================================== --- obj/concrete/door/close_verb (revision 23) +++ obj/concrete/door/close_verb (working copy) @@ -10,10 +10,12 @@ my @locks=getduallock($this, LOCK_EX, "closed"); if ($this->closed) { - fail "It's already closed."; + $this->msg( 'close_already', %_ ); + fail(); } if (! $this->close(quiet => 1)) { - fail "You can't close that."; + $this->msg( 'close_fail', %_ ); + fail(); } $this->msg('close', %_); Index: obj/concrete/door/go_verb =================================================================== --- obj/concrete/door/go_verb (revision 23) +++ obj/concrete/door/go_verb (working copy) @@ -21,7 +21,8 @@ } if ($this->closed) { - fail "You can't go that way."; + $this->msg( 'go_fail', %_ ); + fail(); } } Index: obj/concrete/door/close_already.msg =================================================================== --- obj/concrete/door/close_already.msg (revision 0) +++ obj/concrete/door/close_already.msg (revision 0) @@ -0,0 +1 @@ +session: It's already closed. Index: obj/concrete/door/lock_fail.msg =================================================================== --- obj/concrete/door/lock_fail.msg (revision 0) +++ obj/concrete/door/lock_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot lock the door. Index: obj/concrete/door/lock_already.msg =================================================================== --- obj/concrete/door/lock_already.msg (revision 0) +++ obj/concrete/door/lock_already.msg (revision 0) @@ -0,0 +1 @@ +session: It is already locked. Index: obj/concrete/door/unlock_not_locked.msg =================================================================== --- obj/concrete/door/unlock_not_locked.msg (revision 0) +++ obj/concrete/door/unlock_not_locked.msg (revision 0) @@ -0,0 +1 @@ +session: It is not locked. Index: obj/concrete/door/unlock_need_key.msg =================================================================== --- obj/concrete/door/unlock_need_key.msg (revision 0) +++ obj/concrete/door/unlock_need_key.msg (revision 0) @@ -0,0 +1 @@ +session: You need a key to unlock this door. Index: obj/concrete/door/go_fail.msg =================================================================== --- obj/concrete/door/go_fail.msg (revision 0) +++ obj/concrete/door/go_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't go that way. Index: obj/concrete/door/close_fail.msg =================================================================== --- obj/concrete/door/close_fail.msg (revision 0) +++ obj/concrete/door/close_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't close that. Index: obj/concrete/clothing/wear_someone_else.msg =================================================================== --- obj/concrete/clothing/wear_someone_else.msg (revision 0) +++ obj/concrete/clothing/wear_someone_else.msg (revision 0) @@ -0,0 +1 @@ +session: Someone else is wearing that. Index: obj/concrete/clothing/drop_verb =================================================================== --- obj/concrete/clothing/drop_verb (revision 23) +++ obj/concrete/clothing/drop_verb (working copy) @@ -6,7 +6,8 @@ my $avatar=$_{avatar}; if ($this->location != $avatar) { - fail "You are not holding that."; + $this->msg( 'drop_not_holding', %_ ); + fail(); } # auto-take off before drop to get the message order right Index: obj/concrete/clothing/wear_already.msg =================================================================== --- obj/concrete/clothing/wear_already.msg (revision 0) +++ obj/concrete/clothing/wear_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already wearing that. Index: obj/concrete/clothing/wear_not_holding.msg =================================================================== --- obj/concrete/clothing/wear_not_holding.msg (revision 0) +++ obj/concrete/clothing/wear_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that. Index: obj/concrete/clothing/remove_verb =================================================================== --- obj/concrete/clothing/remove_verb (revision 23) +++ obj/concrete/clothing/remove_verb (working copy) @@ -6,7 +6,8 @@ my $avatar=$_{avatar}; if (! $this->worn || $this->location != $avatar) { - fail "You are not wearing that."; + $this->msg( 'remove_not_wearing', %_ ); + fail(); } if ($this->worn(0) == 0 && $this->immobile(0) == 0) { @@ -16,6 +17,7 @@ # Back out any changes made. $this->worn(0) if $this->worn == 0; $this->immobile(0) if $this->immobile == 0; - fail "You cannot take it off!"; + $this->msg( 'remove_fail', %_ ); + fail(); } } Index: obj/concrete/clothing/wear_verb =================================================================== --- obj/concrete/clothing/wear_verb (revision 23) +++ obj/concrete/clothing/wear_verb (working copy) @@ -7,10 +7,12 @@ if ($this->worn) { if ($this->location == $avatar) { - fail "You're already wearing that."; + $this->msg( 'wear_already', %_ ); + fail(); } else { - fail "Someone else is wearing that."; + $this->msg( 'wear_someone_else', %_ ); + fail(); } } @@ -18,7 +20,8 @@ if ($this->location != $avatar) { $this->take_verb(avatar => $avatar); if ($this->location != $avatar) { - fail "You're not holding that."; + $this->msg( 'wear_not_holding', %_ ); + fail(); } } @@ -32,6 +35,7 @@ # back out any changes made $this->worn(0) if $this->worn; $this->immobile(0) if $this->immobile; - fail "You cannot wear that."; + $this->msg( 'wear_fail', %_ ); + fail(); } } Index: obj/concrete/clothing/drop_not_holding.msg =================================================================== --- obj/concrete/clothing/drop_not_holding.msg (revision 0) +++ obj/concrete/clothing/drop_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You are not holding that. Index: obj/concrete/clothing/remove_fail.msg =================================================================== --- obj/concrete/clothing/remove_fail.msg (revision 0) +++ obj/concrete/clothing/remove_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot take it off! Index: obj/concrete/clothing/remove_not_wearing.msg =================================================================== --- obj/concrete/clothing/remove_not_wearing.msg (revision 0) +++ obj/concrete/clothing/remove_not_wearing.msg (revision 0) @@ -0,0 +1 @@ +session: You are not wearing that. Index: obj/concrete/clothing/wear_fail.msg =================================================================== --- obj/concrete/clothing/wear_fail.msg (revision 0) +++ obj/concrete/clothing/wear_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot wear that. Index: obj/concrete/exit/go_verb =================================================================== --- obj/concrete/exit/go_verb (revision 23) +++ obj/concrete/exit/go_verb (working copy) @@ -26,7 +26,8 @@ $leave = "leave_not_exit_ok"; } else { - fail "You can't go that way."; + $this->msg( 'go_fail', %_ ); + fail(); } } @@ -41,12 +42,12 @@ $this->msg($leave, %_); if ($avatar->physics->move(object => $avatar, to => $this->destination)) { $this->destination->msg('arrive', %_, - originator => $this, + originator => $avatar, skip => $avatar, ); } else { - $this->msg('leave_fail', %_); - fail "You can't go that way."; + $this->msg( 'go_fail', %_ ); + fail(); } } Index: obj/concrete/exit/go_fail.msg =================================================================== --- obj/concrete/exit/go_fail.msg (revision 0) +++ obj/concrete/exit/go_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't go that way. Index: obj/concrete/exit/leave_fail.msg =================================================================== --- obj/concrete/exit/leave_fail.msg (revision 23) +++ obj/concrete/exit/leave_fail.msg (working copy) @@ -1,2 +0,0 @@ -$avatar: You can't go that way. -see: $avatar doesn't get very far. Index: obj/concrete/thing/drop_verb =================================================================== --- obj/concrete/thing/drop_verb (revision 23) +++ obj/concrete/thing/drop_verb (working copy) @@ -6,10 +6,12 @@ my $avatar=$_{avatar}; if ($this->location != $avatar) { - fail "You are not holding that."; + $this->msg( 'drop_not_holding', %_ ); + fail(); } $this->msg('drop', %_); if (! $this->drop(to => $avatar->location)) { - fail "For some reason, you cannot drop it!"; + $this->msg( 'drop_fail', %_ ); + fail(); } } Index: obj/concrete/thing/put_under_verb =================================================================== --- obj/concrete/thing/put_under_verb (revision 0) +++ obj/concrete/thing/put_under_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->put_relation( %_, relation => "under" ); +} Property changes on: obj/concrete/thing/put_under_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/get_preposition.inf =================================================================== --- obj/concrete/thing/get_preposition.inf (revision 23) +++ obj/concrete/thing/get_preposition.inf (working copy) @@ -1 +0,0 @@ -This is a dummy sub that is overridden by containers. Index: obj/concrete/thing/put_on.msg =================================================================== --- obj/concrete/thing/put_on.msg (revision 0) +++ obj/concrete/thing/put_on.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(puts) $direct_object on to $where. +$avatar: $avatar $avatar->verb(puts) $direct_object on to $where. Index: obj/concrete/thing/.location_list-safe =================================================================== --- obj/concrete/thing/.location_list-safe (revision 0) +++ obj/concrete/thing/.location_list-safe (revision 0) @@ -0,0 +1 @@ +1 Index: obj/concrete/thing/describe_verb =================================================================== --- obj/concrete/thing/describe_verb (revision 23) +++ obj/concrete/thing/describe_verb (working copy) @@ -5,13 +5,15 @@ %_=@_; my $desc=$_{quote}; if ($desc !~ /[^\s]/) { - fail "That's not a valid description."; + $this->msg( 'describe_invalid', %_ ); + fail(); } eval { $this->description($desc) }; if ($@) { - fail "You can't change the description of that."; + $this->msg( 'describe_fail', %_ ); + fail(); } - $_{session}->write("Description set."); + $this->msg( 'describe', %_ ); } Index: obj/concrete/thing/look_at_in_fail.msg =================================================================== --- obj/concrete/thing/look_at_in_fail.msg (revision 0) +++ obj/concrete/thing/look_at_in_fail.msg (revision 0) @@ -0,0 +1 @@ +session: I didn't understand that. Did you mean to say "look at $direct_object which is in $indirect_object"? Index: obj/concrete/thing/take_fail_already.msg =================================================================== --- obj/concrete/thing/take_fail_already.msg (revision 0) +++ obj/concrete/thing/take_fail_already.msg (revision 0) @@ -0,0 +1 @@ +session: You already have that. Index: obj/concrete/thing/help.hlp =================================================================== --- obj/concrete/thing/help.hlp (revision 23) +++ obj/concrete/thing/help.hlp (working copy) @@ -1,25 +0,0 @@ -How to use the online help. - -This moo has an integrated online help system, which you are using right -now. You can ask for help with the "help" command. If you use "help index", -you will be presented with an index of available documentation. To choose -an item from the index, type "help subject", for example, "help basics", -"help movement". - -You can also ask for help on a specific object in the moo. For example, -"help on the complex machine" will show available help for said complex -machine, if there is any. - -Help texts may contain links to other related help topics. For example, -this is a link to the help index: =index=. - -Some interfaces may allow you to select the linked help topic directly to -go to that help page. Or you can just type "help index" at the prompt. - -Finally, "help missing" will list any help topics that are referred to by -help texts but do not exist. - -You can abbreviate the name of any help topic, as long as the abbreviation -is unambiguous. - -From here you probably should check out the help =index=. Index: obj/concrete/thing/put_in_verb =================================================================== --- obj/concrete/thing/put_in_verb (revision 0) +++ obj/concrete/thing/put_in_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->put_relation( %_, relation => "in" ); +} Property changes on: obj/concrete/thing/put_in_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/location_list.inf =================================================================== --- obj/concrete/thing/location_list.inf (revision 0) +++ obj/concrete/thing/location_list.inf (revision 0) @@ -0,0 +1,8 @@ +This is to deal with creating lists like "You take the blue ball +from the mauve box which is in the green box.". + +Parameters: + + None; this should only be used in .msg files, as in: + + $avatar: $avatar $avatar->verb(takes) $this from $container->location_list. Index: obj/concrete/thing/location_list_on.msg =================================================================== --- obj/concrete/thing/location_list_on.msg (revision 0) +++ obj/concrete/thing/location_list_on.msg (revision 0) @@ -0,0 +1 @@ +$this which is on $location_list Index: obj/concrete/thing/drop_fail.msg =================================================================== --- obj/concrete/thing/drop_fail.msg (revision 0) +++ obj/concrete/thing/drop_fail.msg (revision 0) @@ -0,0 +1 @@ +session: For some reason, you cannot drop it! Index: obj/concrete/thing/relation.inf =================================================================== --- obj/concrete/thing/relation.inf (revision 0) +++ obj/concrete/thing/relation.inf (revision 0) @@ -0,0 +1,3 @@ +Describes the relationship between the object and the thing +containing it. Possibilities are "in" (the default), "on", "under", +"stand", "sit", and "lie". Index: obj/concrete/thing/put_behind_verb =================================================================== --- obj/concrete/thing/put_behind_verb (revision 0) +++ obj/concrete/thing/put_behind_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->put_relation( %_, relation => "behind" ); +} Property changes on: obj/concrete/thing/put_behind_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/describe_fail.msg =================================================================== --- obj/concrete/thing/describe_fail.msg (revision 0) +++ obj/concrete/thing/describe_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't change the description of that. Index: obj/concrete/thing/take_verb =================================================================== --- obj/concrete/thing/take_verb (revision 23) +++ obj/concrete/thing/take_verb (working copy) @@ -1,32 +1,30 @@ #!/usr/bin/perl -#use Mooix::Thing; +use Mooix::Thing; #use Mooix::Root; + run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; - my $oldloc = $this->location; - - if ($oldloc == $avatar) { - fail "You already have that."; + use Data::Dumper; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + my $oldloc = $this->location; + my $room=$avatar->location; + + if ($oldloc == $avatar) { + $this->msg("take_fail_already", %_); + fail(); + } + if ($this->physics->move(object => $this, to => $avatar)) { + # Degenerate case; for stuff just sitting in the room. + if( $oldloc == $room || $oldloc == $avatar) + { + #print STDERR "take_room.\n"; + $this->msg( 'take_room', %_); + } else { + $this->msg( 'take', %_, container => $oldloc ); } - if ($this->physics->move(object => $this, to => $avatar)) { - my $room=$avatar->location; - my @locs; - my $obj=$this; - my $oldprep = "from"; - while ($oldloc && $oldloc != $room && $oldloc != $avatar) { - push @locs, $oldprep, $oldloc->prettyname; - $obj=$oldloc; - $oldprep=($obj->preposition)[0]; - $oldloc=$oldloc->location; - } - if (@locs) { - $_{fromcontainer}=" ".join(" ", @locs); - } - $this->msg('take', %_); - } - else { - fail "You can't take that."; - } + } else { + $this->msg("take_fail_cannot", %_); + fail(); + } } Index: obj/concrete/thing/prettylist.c =================================================================== --- obj/concrete/thing/prettylist.c (revision 0) +++ obj/concrete/thing/prettylist.c (revision 0) @@ -0,0 +1,164 @@ +/* + * This method is written in C for speed. + * + */ + +#include +#include +#include +#include +#include +#include +#include + +/* Arguments on stdin are the name of the avatar that will be seeing + * this, and then a list of objects to build a list of names for. + */ + +int main (int argc, char **argv) { /* {{{ */ + object *avatar; + object *this; + object *lang_obj; + + char *text; + char text2[1024]; + char text3[1024]; + char *ret; + char *lang_field_file; + char *seperator; + char *last_seperator; + int first_pair=1; + + text = malloc( 1024 * sizeof( char ) ); + + methinit(); + + this = getobj(getenv("THIS")); + + ret = fgets( text, 1024, stdin ); + + if( ret == NULL ) + { + fprintf( stderr, "No avatar passed to prettylist.\n" ); + return 1; + } + + /* Get the avatar object */ + avatar = derefobj( text ); + + /* Get our first line of objects */ + ret = fgets( text, 1024, stdin ); + + //fprintf( stderr, "Got first.\n" ); + if( ret == NULL ) + { + /* No objects in the list. Stupid, perhaps, but not an + * error. + */ + printf( "\n" ); + return 0; + } + + /* Try to get a second object name */ + ret = fgets( text2, 1024, stdin ); + + //fprintf( stderr, "Got second.\n" ); + if( ret == NULL ) + { + /* Single-element list. Return the name. */ + printf( "%s\n", prettyname( derefobj( text ), avatar ) ); + return 0; + } + + /* At this point, we need at least the final seperator. */ + + lang_field_file = fieldfile( avatar, "language" ); + + if( lang_field_file == NULL ) { + /* No language; can't pick a seperator. Error out. */ + fprintf( stderr, "Avatar %s has no language in prettylist.\n", avatar->dir ); + printf( "ERROR: Avatar %s has no language in prettylist.\n", avatar->dir ); + return 1; + } + + lang_obj = getobj( lang_field_file ); + + seperator = getfield( fieldfile( lang_obj, "list_seperator" ) ); + last_seperator = getfield( fieldfile( lang_obj, "list_seperator_last" ) ); + + /* Try to get a third object name; we need three to know which + * seperator is the final one. + */ + ret = fgets( text3, 1024, stdin ); + + //fprintf( stderr, "Got third.\n" ); + while( ret != NULL ) + { + /* Move the first two elements into text */ + text = realloc( text, ( strlen( text ) + strlen( text2 ) + 1024 ) * sizeof( char ) ); + + /* For the first pair, text is an object ref. For all + * subsequent ones, it's just some text. + */ + if( first_pair ) + { + sprintf( text, "%s%s%s", + prettyname( derefobj( text ), avatar ), + seperator, + prettyname( derefobj( text2 ), avatar ) + ); + first_pair = 0; + } else { + sprintf( text, "%s%s%s", + text, + seperator, + prettyname( derefobj( text2 ), avatar ) + ); + } + + //fprintf( stderr, "new text: %s.\n", text ); + /* Move the third element into text2 */ + strcpy( text2, text3 ); + + /* Get another element */ + ret = fgets( text3, 1024, stdin ); + } + //fprintf( stderr, "second-last text: %s.\n", text ); + + /* Whatever we have here is a two-element list of text and + * text2, which want the final seperator between them. */ + if( first_pair ) + { + //fprintf( stderr, "finishing, first pair.\n" ); + /* + fprintf( stderr, "About to print %s%s%s\n", + prettyname( derefobj( text ), avatar ), + seperator, + prettyname( derefobj( text2 ), avatar ) + ); + */ + printf( "%s%s%s", + prettyname( derefobj( text ), avatar ), + last_seperator, + prettyname( derefobj( text2 ), avatar ) + ); + first_pair = 0; + } else { + /* + fprintf( stderr, "finishing, not first pair.\n" ); + fprintf( stderr, "About to print %s%s%s\n", + text, + seperator, + prettyname( derefobj( text2 ), avatar ) + ); + */ + printf( "%s%s%s", + text, + last_seperator, + prettyname( derefobj( text2 ), avatar ) + ); + } + + return 0; + +} /* }}} */ Index: obj/concrete/thing/help_missing.msg =================================================================== --- obj/concrete/thing/help_missing.msg (revision 0) +++ obj/concrete/thing/help_missing.msg (revision 0) @@ -0,0 +1 @@ +session: Missing help topics:\n$topics Index: obj/concrete/thing/help_related.msg =================================================================== --- obj/concrete/thing/help_related.msg (revision 0) +++ obj/concrete/thing/help_related.msg (revision 0) @@ -0,0 +1 @@ +session: Other related topics: =$related= Index: obj/concrete/thing/help_fail_multi.msg =================================================================== --- obj/concrete/thing/help_fail_multi.msg (revision 0) +++ obj/concrete/thing/help_fail_multi.msg (revision 0) @@ -0,0 +1 @@ +session: Do you mean one of the following?\n$possibilities Index: obj/concrete/thing/put_in.msg =================================================================== --- obj/concrete/thing/put_in.msg (revision 0) +++ obj/concrete/thing/put_in.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(puts) $direct_object in to $where. +$avatar: $avatar $avatar->verb(puts) $direct_object in to $where. Index: obj/concrete/thing/dexml.inf =================================================================== --- obj/concrete/thing/dexml.inf (revision 0) +++ obj/concrete/thing/dexml.inf (revision 0) @@ -0,0 +1,19 @@ +Used to strip XML tags (language tags, in particular) from its +input. Selects the correct language for the avatar passed to it. + +Parameters: + + text + + The text to strip. + + avatar + + The avatar whose language settings should be respected + during the stripping. + + language + + An specific language code to use. Only used by the parser + itself; please don't use it directly, as it's bad + multilingual practice. Index: obj/concrete/thing/attack_no.msg =================================================================== --- obj/concrete/thing/attack_no.msg (revision 0) +++ obj/concrete/thing/attack_no.msg (revision 0) @@ -0,0 +1 @@ +session: A mysterious force quells your thoughts of violence. Index: obj/concrete/thing/put_under.msg =================================================================== --- obj/concrete/thing/put_under.msg (revision 0) +++ obj/concrete/thing/put_under.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(puts) $direct_object under $where. +$avatar: $avatar $avatar->verb(puts) $direct_object under $where. Index: obj/concrete/thing/helpall_verb =================================================================== --- obj/concrete/thing/helpall_verb (revision 0) +++ obj/concrete/thing/helpall_verb (revision 0) @@ -0,0 +1,9 @@ +#!/usr/bin/perl +#use Mooix::Thing; + +run sub { + my $this=shift; + %_=@_; + + $this->help_verb( this => $this, %_, 'all' => 1 ); +} Property changes on: obj/concrete/thing/helpall_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/gender_bad.msg =================================================================== --- obj/concrete/thing/gender_bad.msg (revision 0) +++ obj/concrete/thing/gender_bad.msg (revision 0) @@ -0,0 +1 @@ +session: Bad gender object. Index: obj/concrete/thing/throw_self.msg =================================================================== --- obj/concrete/thing/throw_self.msg (revision 0) +++ obj/concrete/thing/throw_self.msg (revision 0) @@ -0,0 +1 @@ +session: Throw it at yourself? Index: obj/concrete/thing/help_verb =================================================================== --- obj/concrete/thing/help_verb (revision 23) +++ obj/concrete/thing/help_verb (working copy) @@ -1,10 +1,262 @@ #!/usr/bin/perl #use Mooix::Thing; +my @helpfields; + +# Given a help field without .hlp or language markers, find the best +# language field to match it. +sub best_lang_help +{ + my $this = shift; + my $avatar = shift; + my $field = shift; + + if( $this->fieldfile( "$field.hlp." . $avatar->language->code ) ) + { + return "$field.hlp." . $avatar->language->code; + } elsif( $this->fieldfile( "$field.hlp" ) ) { + return "$field.hlp"; + } else { + # Get a last-ditch field list. + my @worst_helpfields = grep { /$field\.hlp(\.[a-z-]+)?$/ } $this->fields; + + if( @worst_helpfields ) { + return $worst_helpfields[0]; + } else { + # Error condition, but an unlikely/impossible one, and not + # sure what to do with it. + return ""; + } + } +} + +sub gethelp { + my $this=shift; + my $field=shift; + my $avatar=shift; + my $no_fail=shift; + + my @matches = grep m/\Q$field\E/i, @helpfields; + + # Try to find the best language match + if( @matches ) + { + # If there's only one match, we're done. + if( @matches == 1 ) { + $field = best_lang_help( $this, $avatar, $matches[0] ); + return $this->$field; + } else { + # Try to narrow it down by anchoring the match + @matches = grep m/^\Q$field\E$/i, @helpfields; + + if (@matches == 1) { + $field = best_lang_help( $this, $avatar, $matches[0] ); + return $this->$field; + } elsif (@matches) { + # More than one match found still; can't do much + # with this. + if( $no_fail ) + { + return "=".join("=\n=", sort @matches)."="; + } else { + $this->msg( 'help_fail_multi', + %_, 'possibilities' => "=".join("=\n=", sort @matches)."=" + ); + fail(); + } + } else { + # No matches at all with the stricter version; get the old stuff. + @matches = grep m/\Q$field\E/i, @helpfields; + if( $no_fail ) + { + return "=".join("=\n=", sort @matches)."="; + } else { + $this->msg( 'help_fail_multi', + %_, 'possibilities' => "=".join("=\n=", sort @matches)."=" + ); + fail(); + } + } + return; + } + } + return; +} + +sub links { + return map { m/=([-_a-zA-Z0-9.]+?)=/g } @_; +} + +sub get_avatar_help { + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + + # It's possible that the user meant not to get help + # on this object, but on a help topic with a name + # that happens to match this object's name or + # aliases. + if( $_{avatar} ) { + foreach my $topic ($this->name, $this->alias) { + my @help=help($avatar, topic => $topic, direct_object => $avatar, avatar => $avatar, last => 0, %_ ); + # If the help text is just one line + # long, it might be a "do you + # mean...?" question message, or an + # error, so ignore those. + if (@help > 1) { + return @help; + } + } + } + return; +} + +sub help { + my $this=shift; + %_=@_; + my $field = $_{topic}; + my $avatar = $_{avatar}; + my $session = $_{session}; + my $last = $_{last}; + + # "all" indicates whether results from every language should be shown. + my $all = $_{all}; + + if( ! length $field ) { + $field = $avatar->language->help_basics; + if( ! $_{direct_object} ) { + my @help=get_avatar_help($this, %_, field => $field ) if $avatar; + if( @help ) + { + $session->showhelp( @help ); + exit; + } + } + } + + if( ! $all ) + { + # First try to generate a language-specific help list. + my $help_extension = ".hlp." . $avatar->language->code; + @helpfields = map { s/$help_extension$//; $_ } grep { /$help_extension$/ } $this->fields; + @helpfields = keys %{ { map { $_ => 1 } @helpfields } }; + } + + if( ! @helpfields || $all ) + { + @helpfields = map { s/\.hlp(\.[a-z-]+)?$//; $_ } grep { /\.hlp(\.[a-z-]+)?$/ } $this->fields; + @helpfields = keys %{ { map { $_ => 1 } @helpfields } }; + } + + + if ($field eq $avatar->language->help_index ) { + my @index; + my $maxlen=0; + foreach my $field (sort @helpfields) { + my $title=(gethelp($this, $field, $avatar, 1))[0]; + push @index, "=$field=", $title; + $maxlen = length $field if length $field > $maxlen; + } + if (@index) { + # Turn put fields and titles on the same lines. + my @form; + while (@index) { + my $topic = shift @index; + my $title = shift @index; + push @form, $topic. + (' ' x (4 + $maxlen - length($topic))). + $title; + } + $this->msg( 'help_index', %_ ); + $session->showhelp( @form ); + exit; + } else { + $this->msg( 'help_fail_index_none', %_ ); + fail(); + } + } elsif ($field eq $avatar->language->help_missing ) { + my %links; + foreach my $field (sort @helpfields) { + map { $links{$_} = 1 } links(gethelp($this, $field, $avatar, 1)); + } + my @missing = grep { $_ ne 'index' && $_ ne 'missing' && + ! gethelp($this, $_, $avatar, 1 ) } keys %links; + if (@missing) { + $this->msg( 'help_missing', %_, + 'topics' => "=".join("=\n=", sort @missing)."=" + ); + exit; + } + else { + $this->msg( 'help_fail_none_missing', %_ ); + fail(); + } + } else { + # Help on a given topic. + # Try first preserving case, then without case. + my @help=gethelp($this, $field, $avatar, 0 ); + if (! @help) { + if( $last ) + { + $this->msg( 'help_fail_none', %_, field => $field ); + fail(); + } else { + return; + } + } + my %links = map { $_ => 1 } links(@help); + # Find related help topics and add links to them. + my @related; + foreach my $ofield (@helpfields) { + next if $ofield eq $field; + next if $links{$ofield}; + my $of=$ofield.".hlp"; + if (gethelp($this, $ofield, $avatar, 1 ) =~ /=\Q$field\E=/) { + push @related, $ofield; + } + } + $session->showhelp( @help ); + if (@related) { + @related = sort @related; + $this->msg( + 'help_related', + session => $session, + onlyto => $avatar, + %_, + related => $#related > 0 + ? join( + "=".$avatar->language->list_seperator."=", + @related[0 .. $#related-1] + ) . + "=".$avatar->language->list_seperator_last."=" . + $related[-1] + : $related[0] + ); + } + exit; + } +} + run sub { - my $this=shift; - %_=@_; - my $field = $_{field}; - my $session = $_{session}; - $session->showhelp($this->help(topic => $field, %_)); + my $this=shift; + %_=@_; + my $field = $_{field}; + my $quote = $_{quote}; + my $session = $_{session}; + + # "all" indicates whether results from every language should be shown. + my $all = $_{all}; + + if( ! length $field && length $quote ) + { + $field = $quote; + } + + if( ! $all ) + { + $all = 0; + } + + help( $this, %_, 'topic' => $field, field => $field, 'last' => 1, 'all' => $all ); + #$session->showhelp( $this->help( topic => $field, %_) ); } Index: obj/concrete/thing/look.cmd =================================================================== --- obj/concrete/thing/look.cmd (revision 23) +++ obj/concrete/thing/look.cmd (working copy) @@ -1 +1,8 @@ +# look the ball verb, direct_object(this)(visible) +# look at the ball, look at the ball which is in the box +verb, do_preposition(at), direct_object(this)(visible) +# look the ball in the box +verb, direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in +# look at the ball in the box +verb, do_preposition(at), direct_object(this)(visible), io_preposition(set@in_prepositions), indirect_object(visible) : look_at_in Index: obj/concrete/thing/location_list_on_last.msg =================================================================== --- obj/concrete/thing/location_list_on_last.msg (revision 0) +++ obj/concrete/thing/location_list_on_last.msg (revision 0) @@ -0,0 +1 @@ +$this Index: obj/concrete/thing/location_list_under_last.msg =================================================================== --- obj/concrete/thing/location_list_under_last.msg (revision 0) +++ obj/concrete/thing/location_list_under_last.msg (revision 0) @@ -0,0 +1 @@ +$this Index: obj/concrete/thing/attack_dead.msg =================================================================== --- obj/concrete/thing/attack_dead.msg (revision 0) +++ obj/concrete/thing/attack_dead.msg (revision 0) @@ -0,0 +1 @@ +session: $target->gender_subject_pronoun's already dead! Index: obj/concrete/thing/prettyname.c =================================================================== --- obj/concrete/thing/prettyname.c (revision 0) +++ obj/concrete/thing/prettyname.c (revision 0) @@ -0,0 +1,28 @@ +/* + * This method is written in C for speed. + * + */ + +#include +#include +#include +#include +#include +#include +#include + +int main (int argc, char **argv) { /* {{{ */ + param **params; + object *recipient; + object *this; + + methinit(); + params = getparams(); + + this = getobj(getenv("THIS")); + recipient = derefobj(findparam("recipient", params)); + + printf( "%s\n", dexml( prettyname( this, recipient ), recipient, "" ) ); + + return 0; +} /* }}} */ Index: obj/concrete/thing/describe_invalid.msg =================================================================== --- obj/concrete/thing/describe_invalid.msg (revision 0) +++ obj/concrete/thing/describe_invalid.msg (revision 0) @@ -0,0 +1 @@ +session: That's not a valid description. Index: obj/concrete/thing/candestroy =================================================================== --- obj/concrete/thing/candestroy (revision 23) +++ obj/concrete/thing/candestroy (working copy) @@ -1,35 +1,38 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; + my $this=shift; - # Test to see if the caller can destroy this object. - # This method is not stackless, so the easiest test is to attempt - # to write to a field of the object; if the write succeeds then the - # caller can destroy it. - if (! open (OUT, ">.mooix")) { - # The other possibility is if this object is being - # destroyed by the object that encapsulates it. This leaves - # it up to the encapsulator to check its caller. - require Mooix::CallStack; - import Mooix::CalStack; - my $stack=Mooix::CallStack::get(); - while ($stack) { - if (length $stack->method) { - if ($stack->index eq $this->encapsulator->index) { - last; # success - } + # Test to see if the caller can destroy this object. + # This method is not stackless, so the easiest test is to attempt + # to write to a field of the object; if the write succeeds then the + # caller can destroy it. + if (! open (OUT, ">.mooix")) { + # The other possibility is if this object is being + # destroyed by the object that encapsulates it. This leaves + # it up to the encapsulator to check its caller. + require Mooix::CallStack; + import Mooix::CalStack; + my $stack=Mooix::CallStack::get(); + while ($stack) { + if (length $stack->method) { + if ($stack->index eq $this->encapsulator->index) { + last; # success + } - if ($stack->index ne $this->index || - ($stack->basemethod ne 'destroy' && $stack->basemethod ne 'candestroy')) { - $this->croak("invalid caller"); - } - } + if ($stack->index ne $this->index || + ($stack->basemethod ne 'destroy' && $stack->basemethod ne 'candestroy')) { + # Croaking seems like a bad idea; just sends the + # user a stack trace that is meaningless to them. + ##$this->croak("invalid caller"); + return 0; + } + } - $stack=$stack->next; - } + $stack=$stack->next; } - close OUT; - - return 1; + } + close OUT; + + return 1; } Index: obj/concrete/thing/put_fail_without.msg =================================================================== --- obj/concrete/thing/put_fail_without.msg (revision 0) +++ obj/concrete/thing/put_fail_without.msg (revision 0) @@ -0,0 +1 @@ +session: You are not holding that. Index: obj/concrete/thing/location_list_in.msg =================================================================== --- obj/concrete/thing/location_list_in.msg (revision 0) +++ obj/concrete/thing/location_list_in.msg (revision 0) @@ -0,0 +1 @@ +$this which is in $location_list Index: obj/concrete/thing/deindex =================================================================== --- obj/concrete/thing/deindex (revision 23) +++ obj/concrete/thing/deindex (working copy) @@ -22,7 +22,8 @@ opendir(DIR, $obj->id); while (my $f = readdir(DIR)) { next if $f eq '.' || $f eq '..'; - if (-d $obj->id."/$f") { + if( -d $obj->id."/$f" && -r $obj->id."/$f" ) + { my $v=$obj->$f; push @todo, $v if ref $v eq 'Mooix::Thing'; } Index: obj/concrete/thing/throw_verb =================================================================== --- obj/concrete/thing/throw_verb (revision 23) +++ obj/concrete/thing/throw_verb (working copy) @@ -10,7 +10,8 @@ # dependant on the avatar's dexterity and the object's size and # target's size and distance..), pick some object to be the target. if ($target == $avatar) { - fail "Throw it at yourself?"; + $this->msg( 'throw_self', %_ ); + fail(); } if (! $target || rand > 0.5) { my @objs=grep { ! $_->hidden && $_ != $avatar && $_ != $this } @@ -22,7 +23,8 @@ } if ($this->location != $avatar) { - fail "You are not holding that."; + $this->msg( 'throw_not_holding', %_ ); + fail(); } $this->msg('throw', %_); $this->throw(target => $target) if $this->background; Index: obj/concrete/thing/gender_list.msg =================================================================== --- obj/concrete/thing/gender_list.msg (revision 0) +++ obj/concrete/thing/gender_list.msg (revision 0) @@ -0,0 +1 @@ +session: Choose from: $genders. Index: obj/concrete/thing/help =================================================================== --- obj/concrete/thing/help (revision 23) +++ obj/concrete/thing/help (working copy) @@ -1,135 +0,0 @@ -#!/usr/bin/perl -use Mooix::Thing; -use Text::Wrap; - -my @helpfields; - -sub gethelp { - my $this=shift; - my $field=shift; - - my @matches = grep { lc($_) eq lc($field) } @helpfields; - if (@matches == 1) { - $field=$matches[0].".hlp"; - return $this->$field; - } - else { - @matches = grep /^\Q$field\E/i, @helpfields; - if (@matches == 1) { - $field="$matches[0].hlp"; - return $this->$field; - } - elsif (@matches) { - return "Do you mean =".join("= or =", sort @matches)."=?"; - } - return; - } -} - -sub links { - return map { m/=([-_a-zA-Z0-9]+)=/g } @_; -} - -sub get_avatar_help { - my $this=shift; - my $avatar=shift; - # It's possible that the user meant not to get help - # on this object, but on a help topic with a name - # that happens to match this object's name or - # aliases. - if ($_{avatar}) { - foreach my $topic ($this->name, $this->alias) { - my @help=$_{avatar}->help(topic => $topic); - # If the help text is just one line - # long, it might be a "do you - # mean...?" question message, or an - # error, so ignore those. - if (@help > 1) { - return @help; - } - } - } - return; -} - -run sub { - my $this=shift; - %_=@_; - my $field = $_{topic}; - @helpfields = map { s/\.hlp$//; $_ } grep { /\.hlp$/ } $this->fields; - - if (! length $field) { - if (! $_{do_preposition}) { - my @help=get_avatar_help($this, $_{avatar}) if $_{avatar}; - return @help if @help; - } - - $field = 'basics'; - } - - if ($field eq 'index') { - my @index; - my $maxlen=0; - foreach my $field (sort @helpfields) { - my $title=(gethelp($this, $field))[0]; - push @index, "=$field=", $title; - $maxlen = length $field if length $field > $maxlen; - } - if (@index) { - # Turn put fields and titles on the same lines. - my @form; - while (@index) { - my $topic = shift @index; - my $title = shift @index; - push @form, $topic. - (' ' x (4 + $maxlen - length($topic))). - $title; - } - return "Help index.", "", @form; - } - else { - return "No help is available."; - } - } - elsif ($field eq 'missing') { - my %links; - foreach my $field (sort @helpfields) { - map { $links{$_} = 1 } links(gethelp($this, $field)); - } - my @missing = grep { $_ ne 'index' && $_ ne 'missing' && - ! gethelp($this, $_) } keys %links; - if (@missing) { - return "Missing help topics: =". - join("=, =", sort @missing)."="; - } - else { - return "There are no missing help topics!"; - } - } - else { - # Help on a given topic. - # Try first preserving case, then without case. - my @help=gethelp($this, $field); - @help=gethelp($this, lc $field) if ! @help; - if (! @help) { - return "Sorry, there is no help available on \"$field\".\nTry \"help index\" for an index of help topics."; - } - my %links = map { $_ => 1 } links(@help); - # Find related help topics and add links to them. - my @related; - foreach my $ofield (@helpfields) { - next if $ofield eq $field; - next if $links{$ofield}; - my $of=$ofield.".hlp"; - if (gethelp($this, $ofield) =~ /=\Q$field\E=/) { - push @related, $ofield; - } - } - if (@related) { - push @help, "", - wrap("","", "Other related topics: =". - join("=, =", sort @related)."="); - } - return @help; - } -} Index: obj/concrete/thing/dexml.c =================================================================== --- obj/concrete/thing/dexml.c (revision 0) +++ obj/concrete/thing/dexml.c (revision 0) @@ -0,0 +1,49 @@ +/* + * This method is written in C for speed. + * + */ + +#include +#include +#include +#include +#include +#include +#include + +int main (int argc, char **argv) { /* {{{ */ + /* Global holds the parameters passed to this method. */ + param **params; + + object *avatar; + + char *text, *language; + + methinit(); + params = getparams(); + + text = strdup(findparam("text", params)); + + if( findparam("avatar", params) ) + { + avatar = derefobj(findparam("avatar", params)); + } else { + avatar = strdup( "" ); + } + + if( findparam("language", params) ) + { + language = findparam("language", params); + } else { + language = strdup( "" ); + } + + //fprintf( stderr, "text: %s.\n", text ); + //fprintf( stderr, "avatar: %s.\n", avatar->dir ); + //fprintf( stderr, "language: %s.\n", language ); + + text = dexml( text, avatar, language ); + //fprintf( stderr, "text after: %s.\n", text ); + printf( "%s\n", text ); + return 0; +} /* }}} */ Index: obj/concrete/thing/location_list =================================================================== --- obj/concrete/thing/location_list (revision 0) +++ obj/concrete/thing/location_list (revision 0) @@ -0,0 +1,51 @@ +#!/usr/bin/perl +#use Mooix::Thing; +use Data::Dumper; + +sub recurse_location_list { + my $this = shift; + my $recipient = shift; + my $avatar = shift; + + my $prettyname = $this->prettyname( recipient => $recipient ); + + if( ! $avatar || ! $this || ! $this->location || $this->location == $avatar || $this->location == $avatar->location ) + { + # If we've reached the outer-most location we want to report, + # stop. + my $template_field = 'location_list_'.$this->relation.'_last.msg'; + my $template = $this->dexml( + text => $this->$template_field, avatar => $recipient + ); + + $template =~ s/\$this/$prettyname/g; + + return $template; + } else { + # If we've not reached the outer-most location we want to report, + # recurse into more-outer-most locations. + my $template_field = 'location_list_'.$this->relation.'.msg'; + + my $template = $this->dexml( + text => $this->$template_field, avatar => $recipient + ); + + $template =~ s/\$this/$prettyname/g; + $template =~ s/\$location_list/recurse_location_list( $this->location, $recipient, $avatar )/eg; + + return $template; + } +} + +run sub { + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + my $recipient=$_{recipient}; + + # This is to deal with creating lists like "You take the blue + # ball from the mauve box which is in the green box.". Note + # that this gets called from msg() itself, so $recipient has the + # user the message is actually intended for. + return recurse_location_list( $this, $recipient, $avatar ); +} Property changes on: obj/concrete/thing/location_list ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/getusage =================================================================== --- obj/concrete/thing/getusage (revision 23) +++ obj/concrete/thing/getusage (working copy) @@ -8,81 +8,139 @@ use strict; use Cwd q{realpath}; #use Mooix::Thing; +use Mooix::Root; run sub { - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; + my $avatar = $_{avatar}; - # Hash of arrays. - my %entries; + # Hash of arrays. + my %entries; - # Holds the keys of %entries in the order they were seen. - my @entries; + # Holds the keys of %entries in the order they were seen. + my @entries; - # Holds fields, and if the values are true, the fields are documented. - my %documented; + # Holds fields, and if the values are true, the fields are documented. + my %documented; - my $obj=$this; - while ($obj) { - opendir (COLLECT, $obj->id); - foreach my $field (sort readdir COLLECT) { - if ($_{field}) { - next unless $field eq $_{field} or - $field eq $_{field}.'.inf'; + my $obj=$this; + while ($obj) { + opendir (COLLECT, $obj->id); + my @fields = sort readdir COLLECT; + my $child_obj; + + # This bit of wierdness here is to let local versions of a + # .inf file *override*, rather than append to, the + # distributed versions. + if( $obj =~ m/^$Mooix::Root/ ) + { + $child_obj = $obj; + if (chdir("parent")) { + $obj = Mooix::Thing->get("."); + } + opendir (COLLECT, $obj->id); + @fields = sort ( readdir COLLECT, @fields ); + } + + my %u = (); + @fields = grep {defined} map { + if (exists $u{$_}) { undef; } else { $u{$_}=undef;$_; } + } @fields; + undef %u; + use Data::Dumper; + foreach my $field (@fields) + { + if ($_{field}) { + my $grep_field = $_{field}.'(\.inf)?(\.[a-z-]+)?$'; + if( ! ( $field =~ m/$grep_field/ ) ) + { + next; + } + if( $avatar ) + { + # See if one in the best possible + # language exists; if so, and it's not + # this one, skip this one. + my $short_field = $field; + $short_field =~ s/(.*?)(\.inf(\.[a-z-]+)?)?$/$1/; + $grep_field = $short_field.".inf".".".$_{avatar}->language->code; + my @best_fields = grep + /^$grep_field$/, + @fields; + if( @best_fields == 1 ) + { + # Found one in our best language; + # skip if this isn't it + if( $field ne $best_fields[0] ) + { + next; } - if ($field =~ /(.*)\.inf$/) { - my $base=$1; - $documented{$base} = 1; - if (! exists $entries{$base}) { - $entries{$base} = []; - push @entries, $base; - } - my $line; - # Realpath used just for prettiness. - $line .= " [From mooix:".realpath($obj->id)."]\n\n" - if $this != $obj; - $line .= " ".join("\n ", $obj->$field); - push @{$entries{$base}}, $line; - } - elsif (! exists $documented{$field}) { - $documented{$field} = 0; - } + } } - closedir COLLECT; - - # Opendir won't work, since it typically means opening a - # symlink, and mood enforces O_NOFOLLOW. So change to the dir, - # and get a new object. Mooix::Thing doesn't really like - # changing dirs all around, but as long as we throw away - # our old object, and get a new one, it won't get confused. - if (chdir("parent")) { - $obj = Mooix::Thing->get("."); + + } + if ($field =~ /(.*)\.inf(\.[a-z-]+)?$/) { + my $base=$1; + $documented{$base} = 1; + if (! exists $entries{$base}) { + $entries{$base} = []; + push @entries, $base; } - else { - last; + my $line; + if( $obj->$field ) + { + # Realpath used just for prettiness. + $line .= " [From mooix:".realpath($obj->id)."]\n\n" + if $this != $obj; + $line .= " ".join("\n ", $obj->$field); + } else { + # Realpath used just for prettiness. + $line .= " [From mooix:".realpath($child_obj->id)."]\n\n" + if $this != $child_obj; + $line .= " ".join("\n ", $child_obj->$field); } + push @{$entries{$base}}, $line; + } + elsif (! exists $documented{$field}) { + $documented{$field} = 0; + } } + closedir COLLECT; - if (@entries) { - foreach my $entry ('design', grep { $_ ne 'design' } @entries) { - if (exists $entries{$entry}) { - print "$entry\n\n"; - - foreach my $inf (@{$entries{$entry}}) { - print "$inf\n\n"; - } - } - } + # Opendir won't work, since it typically means opening a + # symlink, and mood enforces O_NOFOLLOW. So change to the dir, + # and get a new object. Mooix::Thing doesn't really like + # changing dirs all around, but as long as we throw away + # our old object, and get a new one, it won't get confused. + if (chdir("parent")) { + $obj = Mooix::Thing->get("."); } + else { + last; + } + } - # Ignore a lot of stuff that doesn't need usage docs. - my @undoc=grep { ! $documented{$_} && $_ !~ /(^\.|~$|^CVS$|^\.svn$|\.lnk|\.msg|_verb|\.cmd|\.hlp$|\.c$|^Makefile$)/ } keys %documented; - if (@undoc) { - print join ("\n\t", "Undocumented:", @undoc), "\n"; + if (@entries) { + foreach my $entry ('design', grep { $_ ne 'design' } @entries) { + if (exists $entries{$entry}) { + print "$entry\n\n"; + + foreach my $inf (@{$entries{$entry}}) { + print "$inf\n\n"; + } + } } + } - if (! @entries and ! @undoc) { - print "No such field or method."; - } - - return; + # Ignore a lot of stuff that doesn't need usage docs. + my @undoc=grep { ! $documented{$_} && $_ !~ /(^\.|~$|^CVS$|^\.svn$|\.lnk|\.msg|_verb|\.cmd|\.hlp|\.c$|^Makefile$)/ } keys %documented; + if (@undoc) { + print join ("\n\t", "Undocumented:", @undoc), "\n"; + } + + if (! @entries and ! @undoc) { + print "No such field or method."; + } + + return; } Index: obj/concrete/thing/take_fail_cannot.msg =================================================================== --- obj/concrete/thing/take_fail_cannot.msg (revision 0) +++ obj/concrete/thing/take_fail_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: You can't take that. Index: obj/concrete/thing/put.cmd =================================================================== --- obj/concrete/thing/put.cmd (revision 23) +++ obj/concrete/thing/put.cmd (working copy) @@ -1,4 +1,10 @@ -# "put down object" -verb, do_preposition(down), direct_object(this)(touchable)(tomove) +# "put down object / put object down" +verb, do_preposition(down), direct_object(this)(touchable)(tomove) : put_in # "put object in object" -verb, direct_object(touchable)(tomove), io_preposition, indirect_object(this)(touchable)(open) +verb, direct_object(touchable)(tomove), io_preposition(set@in_prepositions), indirect_object(this)(touchable)(open) : put_in +# "put object on object" +verb, direct_object(touchable)(tomove), io_preposition(set@on_prepositions), indirect_object(this)(touchable) : put_on +# "put object under object" +verb, direct_object(touchable)(tomove), io_preposition(set@under_prepositions), indirect_object(this)(touchable) : put_under +# "put object behind object" +verb, direct_object(touchable)(tomove), io_preposition(set@behind_prepositions), indirect_object(this)(touchable) : put_under Index: obj/concrete/thing/relation =================================================================== --- obj/concrete/thing/relation (revision 0) +++ obj/concrete/thing/relation (revision 0) @@ -0,0 +1 @@ +in Index: obj/concrete/thing/location_list_under.msg =================================================================== --- obj/concrete/thing/location_list_under.msg (revision 0) +++ obj/concrete/thing/location_list_under.msg (revision 0) @@ -0,0 +1 @@ +$this which is under $location_list Index: obj/concrete/thing/attack_verb =================================================================== --- obj/concrete/thing/attack_verb (revision 23) +++ obj/concrete/thing/attack_verb (working copy) @@ -12,7 +12,8 @@ if ($this != $avatar && $this->location != $avatar) { $this->take_verb(%_); if ($this->location != $avatar) { - fail "You look for something else to attack with."; + $this->msg( 'attack_autotake', %_ ); + fail(); } } @@ -23,15 +24,18 @@ $loc=$loc->location; } unless ($loc->combat_ok) { - fail "A mysterious force quells your thoughts of violence."; + $this->msg( 'attack_no', %_ ); + fail(); } } if ($target->hitpoints <= $target->minhitpoints) { - fail ucfirst($target->gender_subject_pronoun)."'s already dead!"; + $this->msg( 'attack_dead', target => $target, %_ ); + fail(); } elsif ($target == $this) { - fail "That is foolish."; + $this->msg( 'attack_silly', %_ ); + fail(); } # Close to D&D style dice rolling here with natural 20 and 1. @@ -50,7 +54,8 @@ if ($hit) { my $damage=int($this->calcdamage(target => $target, %_)); if ($damage <= 0) { - fail "That seems unlikely to do any real damage."; + $this->msg( 'attack_no_damage', %_ ); + fail(); } $this->msg('attack', %_, target => $target); $target->damage($damage) if $damage > 0; Index: obj/concrete/thing/attack_autotake.msg =================================================================== --- obj/concrete/thing/attack_autotake.msg (revision 0) +++ obj/concrete/thing/attack_autotake.msg (revision 0) @@ -0,0 +1 @@ +session: You look for something else to attack with. Index: obj/concrete/thing/prettylist.inf =================================================================== --- obj/concrete/thing/prettylist.inf (revision 0) +++ obj/concrete/thing/prettylist.inf (revision 0) @@ -0,0 +1,8 @@ +Takes an avatar and a list of objects and creates a list (i.e. "foo, +bar and baz") of the names of the objects localized for the language +of the avatar. + +Parameters: + + Parameters are un-named. The first is the avatar, the rest is + the list of objects. Index: obj/concrete/thing/help.inf =================================================================== --- obj/concrete/thing/help.inf (revision 23) +++ obj/concrete/thing/help.inf (working copy) @@ -1,8 +0,0 @@ -Formats and returns a help text or help index. - -Parameters: - - topic The requested help topic. May be a substring of the full - topic name. May be "index" for an index, or "missing" to - show missing help topics. Optional. - avatar Optional, the help_verb should pass this. Index: obj/concrete/thing/take.msg =================================================================== --- obj/concrete/thing/take.msg (revision 23) +++ obj/concrete/thing/take.msg (working copy) @@ -1,2 +1,2 @@ -see: $avatar $avatar->verb(takes) $this$fromcontainer. -$avatar: $avatar $avatar->verb(takes) $this$fromcontainer. +see: $avatar $avatar->verb(takes) $this from $container->location_list. +$avatar: $avatar $avatar->verb(takes) $this from $container->location_list. Index: obj/concrete/thing/Makefile =================================================================== --- obj/concrete/thing/Makefile (revision 23) +++ obj/concrete/thing/Makefile (working copy) @@ -1,7 +1,7 @@ include ../../../makeinfo CFLAGS += -I../../../bindings/c -L../../../bindings/c -lmoomethod -finline-functions -bins = signal setfield msg +bins = signal setfield msg dexml prettyname prettylist build: $(bins) $(STRIP_PROGRAM) $(bins) @@ -13,24 +13,26 @@ ln -f take.cmd get.cmd ln -f attack.cmd hit.cmd - rm -f version.hlp - echo "Mooix version." > version.hlp - echo "" >> version.hlp - echo "This system is using version $(VER) of mooix." >> version.hlp - echo "See the =copyright= for legal information." >> version.hlp - chmod 644 version.hlp + rm -f version.hlp.* + echo "Mooix version." > version.hlp.en + echo "" >> version.hlp.en + echo "This system is using version $(VER) of mooix." >> version.hlp.en + echo "See the =copyright= for legal information." >> version.hlp.en + chmod 644 version.hlp.en + cp version.hlp.en version.hlp.jbo - rm -f copyright.hlp - echo "Boring copyright information." > copyright.hlp - echo "" >> copyright.hlp - cat ../../../debian/copyright >> copyright.hlp - chmod 644 copyright.hlp + rm -f copyright.hlp.* + echo "Boring copyright information." > copyright.hlp.en + echo "" >> copyright.hlp.en + cat ../../../debian/copyright >> copyright.hlp.en + chmod 644 copyright.hlp.en + cp copyright.hlp.en copyright.hlp.jbo signal: signal.c $(CC) $(CFLAGS) -I../../../libmoocallstack/ \ -L../../../libmoocallstack/ -lmoocallstack signal.c -o signal clean: - rm -f get.cmd hit.cmd $(bins) version.hlp copyright.hlp + rm -f get.cmd hit.cmd $(bins) version.hlp.* copyright.hlp.* realclean: Index: obj/concrete/thing/put_relation.inf =================================================================== --- obj/concrete/thing/put_relation.inf (revision 0) +++ obj/concrete/thing/put_relation.inf (revision 0) @@ -0,0 +1,27 @@ +Used by the various put_*_verb methods, this method puts something +somewhere based on a particular desired relationship (in, on, under, +etc). + +This command can be called in two ways: with an indirect object (the +place to put the direct object) or with no indirect object, in which +case it means to drop the direct object in the current room. + + +Parameters + + avatar + + The avatar calling the verb. + + relation + + The relation desired for the result of the movement. + + direct_object + + The thing to move. + + indirect_object + + Where to put the direct object. If not set, the direct + object gets put in the player's current room. Index: obj/concrete/thing/describe.cmd =================================================================== --- obj/concrete/thing/describe.cmd (revision 23) +++ obj/concrete/thing/describe.cmd (working copy) @@ -1 +1,2 @@ verb, direct_object(this)(nearby|reference), quote +verb, direct_object(this)(nearby|reference), io_preposition(as), quote Index: obj/concrete/thing/put_on_verb =================================================================== --- obj/concrete/thing/put_on_verb (revision 0) +++ obj/concrete/thing/put_on_verb (revision 0) @@ -0,0 +1,12 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Verb; + + +run sub { + my $this=shift; + %_=@_; + $avatar=$_{avatar}; + + $this->exec->put_relation( %_, relation => "on" ); +} Property changes on: obj/concrete/thing/put_on_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/put_down.msg =================================================================== --- obj/concrete/thing/put_down.msg (revision 0) +++ obj/concrete/thing/put_down.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(puts) $direct_object down. +$avatar: $avatar $avatar->verb(puts) $direct_object down. Index: obj/concrete/thing/basics.hlp =================================================================== --- obj/concrete/thing/basics.hlp (revision 23) +++ obj/concrete/thing/basics.hlp (working copy) @@ -1,4 +0,0 @@ -No help available. - -There is no help available for this particular object. For an index, -see =index=. Index: obj/concrete/thing/put_fail_cannot.msg =================================================================== --- obj/concrete/thing/put_fail_cannot.msg (revision 0) +++ obj/concrete/thing/put_fail_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: You can't put that there. Index: obj/concrete/thing/help_index.msg =================================================================== --- obj/concrete/thing/help_index.msg (revision 0) +++ obj/concrete/thing/help_index.msg (revision 0) @@ -0,0 +1 @@ +session: Help index:\n\n Index: obj/concrete/thing/take_room.msg =================================================================== --- obj/concrete/thing/take_room.msg (revision 0) +++ obj/concrete/thing/take_room.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(takes) $this. +$avatar: $avatar $avatar->verb(takes) $this. Index: obj/concrete/thing/gender_validate =================================================================== --- obj/concrete/thing/gender_validate (revision 23) +++ obj/concrete/thing/gender_validate (working copy) @@ -8,14 +8,18 @@ if (ref $gen) { if (! grep { $_ == $gen } $genroot->list) { - fail "Bad gender object."; + $this->msg( 'gender_bad', %_ ); + fail(); } return $gen; } my %genders = map { $_->name => $_ } $genroot->list; if (! $genders{lc($gen)}) { - fail "Choose from: ".join(" ", keys %genders); + $this->msg( 'gender_list', + genders => join(" ", keys %genders), + %_ ); + fail(); } else { return $genders{lc($gen)}; Index: obj/concrete/thing/help_fail_none_missing.msg =================================================================== --- obj/concrete/thing/help_fail_none_missing.msg (revision 0) +++ obj/concrete/thing/help_fail_none_missing.msg (revision 0) @@ -0,0 +1 @@ +session: There are no missing help topics! Index: obj/concrete/thing/helpall.cmd =================================================================== --- obj/concrete/thing/helpall.cmd (revision 0) +++ obj/concrete/thing/helpall.cmd (revision 0) @@ -0,0 +1,12 @@ +# For a help index. +verb +# For a help index on a specific object. +verb, direct_object(this)(nearby|reference) +# For a given help topic of a specific object. +verb, direct_object(this)(nearby|reference), field +# For a given help topic of a specific object. +verb, direct_object(this)(nearby|reference), quote +# For a given help topic. +verb, field +# For a given help topic. +verb, quote Index: obj/concrete/thing/put_fail_heavy.msg =================================================================== --- obj/concrete/thing/put_fail_heavy.msg (revision 0) +++ obj/concrete/thing/put_fail_heavy.msg (revision 0) @@ -0,0 +1 @@ +session: It's too heavy to move. Index: obj/concrete/thing/attack_no_damage.msg =================================================================== --- obj/concrete/thing/attack_no_damage.msg (revision 0) +++ obj/concrete/thing/attack_no_damage.msg (revision 0) @@ -0,0 +1 @@ +session: That seems unlikely to do any real damage. Index: obj/concrete/thing/help_fail_none.msg =================================================================== --- obj/concrete/thing/help_fail_none.msg (revision 0) +++ obj/concrete/thing/help_fail_none.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, there is no help available on "$field".\nTry "help index" for an index of help topics. Index: obj/concrete/thing/name_validate =================================================================== --- obj/concrete/thing/name_validate (revision 23) +++ obj/concrete/thing/name_validate (working copy) @@ -7,7 +7,8 @@ } my $val=shift; if ($val !~ /[a-zA-Z0-9]/) { - fail "Name must contain at least one alphanumeric."; + $this->msg( 'name_bad', %_ ); + fail(); } else { return $val; Index: obj/concrete/thing/put_fail_already.msg =================================================================== --- obj/concrete/thing/put_fail_already.msg (revision 0) +++ obj/concrete/thing/put_fail_already.msg (revision 0) @@ -0,0 +1 @@ +session: It's already there. Index: obj/concrete/thing/put.msg =================================================================== --- obj/concrete/thing/put.msg (revision 23) +++ obj/concrete/thing/put.msg (working copy) @@ -1,2 +0,0 @@ -see: $avatar $avatar->verb(puts) $direct_object $prep$where. -$avatar: $avatar $avatar->verb(puts) $direct_object $prep$where. Index: obj/concrete/thing/location_list_in_last.msg =================================================================== --- obj/concrete/thing/location_list_in_last.msg (revision 0) +++ obj/concrete/thing/location_list_in_last.msg (revision 0) @@ -0,0 +1 @@ +$this Index: obj/concrete/thing/attack_silly.msg =================================================================== --- obj/concrete/thing/attack_silly.msg (revision 0) +++ obj/concrete/thing/attack_silly.msg (revision 0) @@ -0,0 +1 @@ +session: That is foolish. Index: obj/concrete/thing/get_preposition =================================================================== --- obj/concrete/thing/get_preposition (revision 23) +++ obj/concrete/thing/get_preposition (working copy) @@ -1,2 +0,0 @@ -#!/bin/false -# Always fail Index: obj/concrete/thing/name_bad.msg =================================================================== --- obj/concrete/thing/name_bad.msg (revision 0) +++ obj/concrete/thing/name_bad.msg (revision 0) @@ -0,0 +1 @@ +session: Name must contain at least one alphanumeric. Index: obj/concrete/thing/throw_not_holding.msg =================================================================== --- obj/concrete/thing/throw_not_holding.msg (revision 0) +++ obj/concrete/thing/throw_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You are not holding that. Index: obj/concrete/thing/drop_not_holding.msg =================================================================== --- obj/concrete/thing/drop_not_holding.msg (revision 0) +++ obj/concrete/thing/drop_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You are not holding that. Index: obj/concrete/thing/help_fail_index_none.msg =================================================================== --- obj/concrete/thing/help_fail_index_none.msg (revision 0) +++ obj/concrete/thing/help_fail_index_none.msg (revision 0) @@ -0,0 +1 @@ +session: No help is available. Index: obj/concrete/thing/preposition.inf =================================================================== --- obj/concrete/thing/preposition.inf (revision 23) +++ obj/concrete/thing/preposition.inf (working copy) @@ -1,8 +0,0 @@ -This field holds a single preposition or a list of prepositions, that can -be used to describe how the object is related to its location. For example, -an object might be "in" a container (and you'd want "inside" and "from" etc -to work as prepositions when referring to that object). Or it might be -under a container instead. - -Generally this field should not be set manually, but should be set to the -return value of the container's check_preposition method. Index: obj/concrete/thing/put_verb =================================================================== --- obj/concrete/thing/put_verb (revision 23) +++ obj/concrete/thing/put_verb (working copy) @@ -1,56 +0,0 @@ -#!/usr/bin/perl -#use Mooix::Thing; -run sub { - my $this=shift; - %_=@_; - my $avatar = $_{avatar}; - - # This verb can be called two ways, and what $this is varies. So - # it's easiest to use the direct object as the object that is being - # put, rather than $this. - my $object=$_{direct_object}; - - # Let's see if the avatar can even heft the object. If not, they - # shouldn't be moveing it around. - if ($object->_mass + $avatar->_mass > $avatar->maxweight) { - fail "It's too heavy to move."; - } - - my ($where, @preposition); - if ($_{indirect_object}) { - # "put object in object" - $where = $_{indirect_object}; - - # Adding this to the parameters of the move call below - # gets it to check the preposition to see if it's valid. - @preposition = (preposition => $_{io_preposition}); - - # Check to see if the new location is the same, and the - # preposition is the same as one of the objects existing - # prepositions. If so, it's a no-op. - if ($object->location == $where && - grep { $_ eq $_{io_preposition} } $object->preposition ) { - fail "It's already there."; - } - } - else { - # "put down object" - if ($this->location != $avatar) { - fail "You are not holding that."; - } - $where = $avatar->location; - } - - if ($object->physics->move(object => $object, to => $where, @preposition)) { - if ($_{indirect_object}) { - my $prep = (length $_{io_preposition} ? $_{io_preposition} : ($object->preposition)[0]); - $this->msg('put', %_, where => $where, prep => $prep." "); - } - else { - $this->msg('put', %_, prep => $_{do_preposition}) - } - } - else { - fail "You can't put that there."; - } -} Index: obj/concrete/thing/help.cmd =================================================================== --- obj/concrete/thing/help.cmd (revision 23) +++ obj/concrete/thing/help.cmd (working copy) @@ -4,5 +4,9 @@ verb, direct_object(this)(nearby|reference) # For a given help topic of a specific object. verb, direct_object(this)(nearby|reference), field +# For a given help topic of a specific object. +verb, direct_object(this)(nearby|reference), quote # For a given help topic. verb, field +# For a given help topic. +verb, quote Index: obj/concrete/thing/look_at_in_verb =================================================================== --- obj/concrete/thing/look_at_in_verb (revision 0) +++ obj/concrete/thing/look_at_in_verb (revision 0) @@ -0,0 +1,17 @@ +#!/usr/bin/perl +#use Mooix::Thing; +run sub { + my $this=shift; + %_=@_; + + # Check we're in the thing we're supposed to be in. + if( length grep { $this->location == $_ } $_{indirect_object} + && $this->relation eq 'in' + ) + { + $this->msg('look', %_); + } else { + $this->msg('look_at_in_fail', %_); + fail(); + } +} Property changes on: obj/concrete/thing/look_at_in_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/prettyname.inf =================================================================== --- obj/concrete/thing/prettyname.inf (revision 0) +++ obj/concrete/thing/prettyname.inf (revision 0) @@ -0,0 +1,7 @@ +Prints out the name of the object, localized to the recipient. + +Parameters: + + recipient + + The avatar whose language settings should be respected. Index: obj/concrete/thing/put_relation =================================================================== --- obj/concrete/thing/put_relation (revision 0) +++ obj/concrete/thing/put_relation (revision 0) @@ -0,0 +1,53 @@ +#!/usr/bin/perl +#use Mooix::Thing; +run sub { + my $this=shift; + %_=@_; + my $avatar = $_{avatar}; + my $relation = $_{relation}; + + # This verb can be called two ways, and what $this is varies. So + # it's easiest to use the direct object as the object that is being + # put, rather than $this. + my $object=$_{direct_object}; + + # Let's see if the avatar can even heft the object. If not, they + # shouldn't be moveing it around. + if ($object->_mass + $avatar->_mass > $avatar->maxweight) { + $this->msg("put_fail_heavy", %_); + fail(); + } + + my $where; + if ($_{indirect_object}) { + # "put object in/on/under object" + $where = $_{indirect_object}; + + ## print STDERR "loc: " . $object->location . ", loc2: $where, rel: " . $object->relation . ", rel2: $relation.\n"; + # Check to see if the new location and relation is + # the same. If so, it's a no-op. + if( $object->location eq $where && $object->relation eq $relation ) + { + $this->msg("put_fail_already", %_); + fail(); + } + } else { + # "put down object" + if ($this->location != $avatar) { + $this->msg("put_fail_without", %_); + fail(); + } + $where = $avatar->location; + } + + if ($object->physics->move(object => $object, to => $where, relation => $relation )) { + if ($_{indirect_object}) { + $this->msg("put_${relation}", %_, where => $where ); + } else { + $this->msg('put_down', %_ ); + } + } else { + $this->msg("put_fail_cannot", %_); + fail(); + } +} Property changes on: obj/concrete/thing/put_relation ___________________________________________________________________ Name: svn:executable + * Index: obj/concrete/thing/describe.msg =================================================================== --- obj/concrete/thing/describe.msg (revision 0) +++ obj/concrete/thing/describe.msg (revision 0) @@ -0,0 +1 @@ +session: Description set. Index: obj/concrete/thing/put_behind.msg =================================================================== --- obj/concrete/thing/put_behind.msg (revision 0) +++ obj/concrete/thing/put_behind.msg (revision 0) @@ -0,0 +1,2 @@ +see: $avatar $avatar->verb(puts) $direct_object behind $where. +$avatar: $avatar $avatar->verb(puts) $direct_object behind $where. Index: obj/concrete/thing/msg.c =================================================================== --- obj/concrete/thing/msg.c (revision 23) +++ obj/concrete/thing/msg.c (working copy) @@ -40,34 +40,34 @@ /* The types of message criteria. */ enum criteria_type { - crit_sense, - crit_object, - crit_session, + crit_sense, + crit_object, + crit_session, }; /* Message criteria of sense type can have an associated intensity, and the * criteria field is used to hold either the sense or the name of the * object. */ struct criteria { - enum criteria_type type; - int intensity; - char *criteria; + enum criteria_type type; + int intensity; + char *criteria; }; /* A message is a set of criteria plus message text to send. */ struct message { - struct criteria **criteria; - int numcriteria; - int criteriaspace; /* amount of space currently alloced for criteria */ - char *message; + struct criteria **criteria; + int numcriteria; + int criteriaspace; /* amount of space currently alloced for criteria */ + char *message; }; /* A message block is a set of messages. Messages are tried in order, and * delivered when their criteria match. */ struct message_block { - struct message **messages; - int num; + struct message **messages; + int num; }; /* This is a list of the senses that matter when seeing if criteria allow a @@ -80,768 +80,777 @@ /* Adds a sense to the senses list, if it is not in there already. */ void add_sense (char *sense) { /* {{{ */ - int i; - int seen = 0; + int i; + int seen = 0; - for (i = 0; ! seen && i < num_senses; i++) - if (strcmp(sense, senses[i]) == 0) - seen =1; - if (! seen) { - num_senses++; - if (senses_size < num_senses) { - senses_size += 8; - senses = realloc(senses, sizeof(char *) * senses_size); - } - senses[num_senses - 1] = sense; + for (i = 0; ! seen && i < num_senses; i++) + if (strcmp(sense, senses[i]) == 0) + seen =1; + if (! seen) { + num_senses++; + if (senses_size < num_senses) { + senses_size += 8; + senses = realloc(senses, sizeof(char *) * senses_size); } + senses[num_senses - 1] = sense; + } } /* }}} */ /* Creates a new filter array. A filter is just an integer array of length * num_senses; so it has room for filter info for each sense on the senses * list. */ int *new_filter (void) { /* {{{ */ - int *ret; - int i; + int *ret; + int i; - ret = malloc(num_senses * sizeof(int *)); - for (i = 0; i < num_senses; i++) - ret[i] = 0; - return ret; + ret = malloc(num_senses * sizeof(int *)); + for (i = 0; i < num_senses; i++) + ret[i] = 0; + return ret; } /* }}} */ /* Creates a copy of an existing filter. */ int *copy_filter (const int *filter) { /* {{{ */ - int *ret; - int i; - - ret = malloc(num_senses * sizeof(int *)); - for (i = 0; i < num_senses; i++) - ret[i] = filter[i]; - return ret; + int *ret; + int i; + + ret = malloc(num_senses * sizeof(int *)); + for (i = 0; i < num_senses; i++) + ret[i] = filter[i]; + return ret; } /* }}} */ /* Prints a filter to stderr for debugging. */ void dump_filter(const int *filter, const char *msg) { /* {{{ */ - int i; - if (! filter) { - fprintf(stderr, "%s: (null)\n", msg); - } - else { - fprintf(stderr, "%s: ", msg); - for (i = 0; i < num_senses; i++) - fprintf(stderr, "%s = %i ", senses[i], filter[i]); - fprintf(stderr, "\n"); - } + int i; + if (! filter) { + fprintf(stderr, "%s: (null)\n", msg); + } + else { + fprintf(stderr, "%s: ", msg); + for (i = 0; i < num_senses; i++) + fprintf(stderr, "%s = %i ", senses[i], filter[i]); + fprintf(stderr, "\n"); + } } /* }}} */ -/* Read all parameters, return NULL terminated array */ -void getparams (void) { /* {{{ */ - param *p; - int numparams=4; - int curparam=0; - - params = malloc(sizeof(param *) * (numparams + 1)); - while ((p = getparam())) { - params[curparam++]=p; - if (curparam >= numparams) { - numparams = numparams * 2; - params=realloc(params, sizeof(param *) * (numparams + 1)); - } - } - params[curparam]=NULL; -} /* }}} */ - -/* Look up a parameter from an array by name. */ -char *findparam (const char *key) { /* {{{ */ - /* TODO: optimize. hash? tsearch? */ - int i; - for (i=0; params[i] != NULL; i++) - if (strcmp(key, params[i]->name) == 0) - return params[i]->value; - return NULL; -} /* }}} */ - /* Parses a criteria string into a criteria structure, and adds it to the * list in the passed message structure. */ void parsecriteria (char *cstring, struct message *m) { /* {{{ */ - char *end; - struct criteria *criteria = malloc(sizeof(struct criteria)); + char *end; + struct criteria *criteria = malloc(sizeof(struct criteria)); - m->numcriteria++; - if (m->numcriteria >= m->criteriaspace) { - if (m->criteriaspace == 0) - m->criteriaspace = 4; - else - m->criteriaspace *= 2; - m->criteria = realloc(m->criteria, m->criteriaspace * - sizeof(struct criteria *)); - } - criteria->intensity = DEFAULTINTENSITY; - m->criteria[m->numcriteria - 1] = criteria; + m->numcriteria++; + if (m->numcriteria >= m->criteriaspace) { + if (m->criteriaspace == 0) + m->criteriaspace = 4; + else + m->criteriaspace *= 2; + m->criteria = realloc(m->criteria, m->criteriaspace * + sizeof(struct criteria *)); + } + criteria->intensity = DEFAULTINTENSITY; + m->criteria[m->numcriteria - 1] = criteria; - /* There can be whitespace both before and after the criteria - * string; remove it. */ - while (isspace(cstring[0])) - cstring++; + /* There can be whitespace both before and after the criteria + * string; remove it. */ + while (isspace(cstring[0])) + cstring++; - if (cstring[0] == '\0') - return; /* empty */ - - /* Remove trailing whitespace and make end point to the last - * character of the criteria string. */ - end = cstring + strlen(cstring) - 1; - if (end > cstring) { - while (isspace(end[0])) - end--; - end[1] = '\0'; + if (cstring[0] == '\0') + return; /* empty */ + + /* Remove trailing whitespace and make end point to the last + * character of the criteria string. */ + end = cstring + strlen(cstring) - 1; + if (end > cstring) { + while (isspace(end[0])) + end--; + end[1] = '\0'; + } + + /* Determine what type of criteria we have. */ + if (cstring[0] == '$') { + criteria->type = crit_object; + cstring++; + } + else if (strcmp(cstring, "session") == 0) { + criteria->type = crit_session; + } + else { + criteria->type = crit_sense; + /* Is there an intensity? */ + if (end[0] == ')') { + char *istart = strchr(cstring, '('); + if (istart) { + criteria->intensity = atoi(istart+1); + istart[0] = '\0'; + } } - - /* Determine what type of criteria we have. */ - if (cstring[0] == '$') { - criteria->type = crit_object; - cstring++; - } - else if (strcmp(cstring, "session") == 0) { - criteria->type = crit_session; - } - else { - criteria->type = crit_sense; - /* Is there an intensity? */ - if (end[0] == ')') { - char *istart = strchr(cstring, '('); - if (istart) { - criteria->intensity = atoi(istart+1); - istart[0] = '\0'; - } - } - add_sense(cstring); - } + add_sense(cstring); + } - criteria->criteria = cstring; + criteria->criteria = cstring; } /* }}} */ /* Parses a line of text into a message structure. */ struct message *parse_message (char *line) { /* {{{ */ - char *s; - struct message *ret = malloc(sizeof(struct message)); - - ret->numcriteria = 0; - ret->criteriaspace = 0; - ret->criteria = NULL; - - /* Split into message and criteria at the colon, with optional - * whitespace after. */ - s = strchr(line, ':'); - if (! s) { - fprintf(stderr, "message parse error near \"%s\"\n", line); - exit(1); - } - ret->message = s+1; + char *s; + struct message *ret = malloc(sizeof(struct message)); + + ret->numcriteria = 0; + ret->criteriaspace = 0; + ret->criteria = NULL; + + /* Split into message and criteria at the colon, with optional + * whitespace after. */ + s = strchr(line, ':'); + if (! s) { + fprintf(stderr, "message parse error near \"%s\"\n", line); + exit(1); + } + ret->message = s+1; + s[0] = '\0'; + while (isspace(ret->message[0])) + ret->message++; + + /* Criteria are delimited by commas. */ + while ((s = strchr(line, ',')) != NULL) { s[0] = '\0'; - while (isspace(ret->message[0])) - ret->message++; - - /* Criteria are delimited by commas. */ - while ((s = strchr(line, ',')) != NULL) { - s[0] = '\0'; - parsecriteria(line, ret); - line = s+1; - } - if (line[0] != '\0') - parsecriteria(line, ret); - - return ret; + parsecriteria(line, ret); + line = s+1; + } + if (line[0] != '\0') + parsecriteria(line, ret); + + return ret; } /* }}} */ /* Reads messaages from the passed filename. If there are multiple blocks, * picks one at random. Parses the selected message block and returns it in * a structure. */ struct message_block *read_messages (const char *filename) { /* {{{ */ - char **lines; - char *line; - signed int *blocks; - int line_count, block_count, lines_size, blocks_size; - int start, end, pick, i; - struct message_block *ret = malloc(sizeof(struct message_block)); - FILE *f = fopen(filename, "r"); - - if (! f) - return (struct message_block *) NULL; - - /* Read in all lines, keeping track of block boundries. */ - lines_size = 8; - lines = malloc(lines_size * sizeof(char *)); - blocks_size = 3; - blocks = malloc(blocks_size * sizeof(int *)); - block_count=0; - blocks[block_count] = -1; - for (line_count = 0; (line = mooix_getline(f, 0)); line_count++) { - if (line_count == lines_size) { - lines_size = line_count * 2; - lines = realloc(lines, lines_size * sizeof(char *)); - } - lines[line_count] = line; - if (line[0] == '\0') { - block_count++; - if (block_count == blocks_size) { - blocks_size = blocks_size * 2; - blocks = realloc(blocks, blocks_size * sizeof(int)); - } - blocks[block_count] = line_count; - } + char **lines; + char *line; + signed int *blocks; + int line_count, block_count, lines_size, blocks_size; + int start, end, pick, i; + struct message_block *ret = malloc(sizeof(struct message_block)); + FILE *f = fopen(filename, "r"); + + if (! f) + { + fprintf( stderr, "WARNING: msg() passed non-existent file %s.\n", filename ); + return (struct message_block *) NULL; + } + + /* Read in all lines, keeping track of block boundries. */ + lines_size = 8; + lines = malloc(lines_size * sizeof(char *)); + blocks_size = 3; + blocks = malloc(blocks_size * sizeof(int *)); + block_count=0; + blocks[block_count] = -1; + for (line_count = 0; (line = mooix_getline(f, 0)); line_count++) { + if (line_count == lines_size) { + lines_size = line_count * 2; + lines = realloc(lines, lines_size * sizeof(char *)); } - if (line_count > blocks[block_count]) { - block_count++; - if (block_count == blocks_size) { - blocks_size = blocks_size * 2; - blocks = realloc(blocks, blocks_size * sizeof(int)); - } - blocks[block_count] = line_count; + lines[line_count] = line; + if (line[0] == '\0') { + block_count++; + if (block_count == blocks_size) { + blocks_size = blocks_size * 2; + blocks = realloc(blocks, blocks_size * sizeof(int)); + } + blocks[block_count] = line_count; } + } + if (line_count > blocks[block_count]) { + block_count++; + if (block_count == blocks_size) { + blocks_size = blocks_size * 2; + blocks = realloc(blocks, blocks_size * sizeof(int)); + } + blocks[block_count] = line_count; + } - if (line_count == 0) - return (struct message_block *) NULL; + if (line_count == 0) + return (struct message_block *) NULL; - /* Select a block at random. */ - srand(getpid() * (int) time(NULL)); - pick = (float) block_count * rand() / (RAND_MAX + 1.0); - start = blocks[pick] + 1; - end = blocks[pick + 1] - 1; - - /* Parse block. */ - ret->num = end - start; - ret->messages = malloc((ret->num + 1) * sizeof(struct message *)); - for (i = start; i <= end; i++) - ret->messages[i - start] = parse_message(lines[i]); + /* Select a block at random. */ + srand(getpid() * (int) time(NULL)); + pick = (float) block_count * rand() / (RAND_MAX + 1.0); + start = blocks[pick] + 1; + end = blocks[pick + 1] - 1; - return ret; + /* Parse block. */ + ret->num = end - start; + ret->messages = malloc((ret->num + 1) * sizeof(struct message *)); + for (i = start; i <= end; i++) + ret->messages[i - start] = parse_message(lines[i]); + + return ret; } /* }}} */ -/* Generate a prettified name for an object, from the POV of the recipient. */ -char *prettyname (object *obj, object *recipient) { /* {{{ */ - char *name, *article, *file; - struct stat buf; - - if (objcmp(obj, recipient) == 0) - return "you"; - - file = fieldfile(obj, "name"); - if (! file) +/* Used to expand things of the form "object->field" in messages. */ +char *expandfield (char *var, char *field, object *recipient) { /* {{{ */ + struct stat buf; + char *file, *val; + object *obj; + + if (strcmp(var, "this") == 0) { + obj = originator; + } else { + val = findparam(var, params); + if (! val) + return ""; + obj = derefobj(val); + if (! obj) + return ""; + } + + /* This is a special case to get the pronoun right for gender mixin + * lookups. It also works around fieldfile not supporting mixins.. */ + if( strncmp(field, "gender_", strlen("gender_")) == 0 ) { + object *newobj; + char *dir = fieldfile(obj, "gender"); + if (! dir) { + return ""; + } + newobj = getobj(dir); + + if (objcmp(obj, recipient) == 0) { + dir = fieldfile(newobj, "self"); + if (! dir) { return ""; - /* The name might be a method to be called with no parameters. - * Rarely, but worth the stat for consistency. */ - if (stat(file, &buf) != 0) - return ""; - if (((buf.st_mode & S_IXUSR) == S_IXUSR) || + } + newobj = getobj(dir); + } + + obj = newobj; + + field = field + strlen("gender_"); + + if (! obj) + return ""; + } + + /* Don't allow expansion of private fields. */ + if (field[0] == '.') + return ""; + + file = fieldfile(obj, field); + if (! file) + return ""; + + if (stat(file, &buf) != 0) + return ""; + + /* If the file is another object, then pretty-print its name. */ + if (S_ISDIR(buf.st_mode)) + return prettyname(getobj(file), recipient ); + + /* The "field" might be a method to be called with no parameters. */ + if (((buf.st_mode & S_IXUSR) == S_IXUSR) || ((buf.st_mode & S_IXGRP) == S_IXGRP) || ((buf.st_mode & S_IXOTH) == S_IXOTH)) { - /* Only allow running of methods that are marked as safe. */ - if (! truefield(obj, ".name-safe")) { - return ""; - } - else { - FILE *f = runmethod(obj, "name", NULL); - if (! f) - return ""; - name = fgetvalue(f); - fclose(f); - } + /* Only allow running of methods that are marked as safe. */ + char *safefield = malloc(1 + strlen(field) + strlen("-safe") + 1); + sprintf(safefield, ".%s-safe", field); + if (! truefield(obj, safefield)) { + return ""; } else { - name = getfield(file); - } - - /* Hmm, article could be a method too, but it seems a little silly - * to support that. */ - file = fieldfile(obj, "article"); - if (! file) + FILE *f; + char *ret; + param **my_params; + int num_params = 0; + + /* Add the recipient to the params. */ + while( params[num_params] != NULL ) + { + num_params++; + } + + my_params = malloc( sizeof(param *) * num_params + 1 ); + num_params = 0; + + while( params[num_params] != NULL ) + { + my_params[num_params] = params[num_params]; + num_params++; + } + my_params[num_params] = malloc(sizeof(param)); + my_params[num_params]->name = "recipient"; + my_params[num_params]->value = malloc( sizeof(char) * ( strlen( recipient->dir ) + 8 ) ); + sprintf( my_params[num_params]->value, "mooix:%s", recipient->dir ); + my_params[num_params + 1] = NULL; + + f = runmethod_param(obj, field, my_params); + + if (! f) return ""; - article = getfield(file); - if (! article || ! strlen(article)) { - return name; - } - else { - char *ret = malloc(strlen(article) + 1 + strlen(name) + 1); - sprintf(ret, "%s %s", article, name); - return ret; - } -} /* }}} */ -/* Used to expand things of the form "object->field" in messages. */ -char *expandfield (char *var, char *field, object *recipient) { /* {{{ */ - struct stat buf; - char *file, *val; - object *obj; - - if (strcmp(var, "this") == 0) { - obj = originator; + ret = fgetvalue(f); + fclose(f); + return ret; } - else { - val = findparam(var); - if (! val) - return ""; - obj = derefobj(val); - if (! obj) - return ""; - } + } else { + /* Return the entire file, no matter how many lines. */ + FILE *f = fopen(file, "r"); + int size = 0; + char *ret = NULL; - /* This is a special case to get the pronoun right for gender mixin - * lookups. It also works around fieldfile not supporting mixins.. */ - if (strncmp(field, "gender_", strlen("gender_")) == 0) { - object *newobj; - char *dir = fieldfile(obj, "gender"); - if (! dir) { - return ""; - } - newobj = getobj(dir); - - if (objcmp(obj, recipient) == 0) { - dir = fieldfile(newobj, "self"); - if (! dir) { - return ""; - } - newobj = getobj(dir); - } + if (! f || feof(f)) + return ""; - obj = newobj; - - field = field + strlen("gender_"); - - if (! obj) - return ""; - } - - /* Don't allow expansion of private fields. */ - if (field[0] == '.') - return ""; - - file = fieldfile(obj, field); - if (! file) - return ""; - - if (stat(file, &buf) != 0) - return ""; - - /* If the file is another object, then pretty-print its name. */ - if (S_ISDIR(buf.st_mode)) - return prettyname(getobj(file), recipient); - - /* The "field" might be a method to be called with no parameters. */ - if (((buf.st_mode & S_IXUSR) == S_IXUSR) || - ((buf.st_mode & S_IXGRP) == S_IXGRP) || - ((buf.st_mode & S_IXOTH) == S_IXOTH)) { - /* Only allow running of methods that are marked as safe. */ - char *safefield = malloc(1 + strlen(field) + strlen("-safe") + 1); - sprintf(safefield, ".%s-safe", field); - if (! truefield(obj, safefield)) { - return ""; + do { + ret = realloc(ret, size + 128 + 1); + if (! fgets(ret + size, 128, f)) { + if (size == 0) { + free(ret); + return ""; /* eof with empty string */ } else { - FILE *f = runmethod(obj, field, NULL); - char *ret; - if (! f) - return ""; - ret = fgetvalue(f); - fclose(f); - return ret; + ret[size]='\0'; + break; } - } - else { - /* Return the entire file, no matter how many lines. */ - FILE *f = fopen(file, "r"); - int size = 0; - char *ret = NULL; - - if (! f || feof(f)) - return ""; - - do { - ret = realloc(ret, size + 128 + 1); - if (! fgets(ret + size, 128, f)) { - if (size == 0) { - free(ret); - return ""; /* eof with empty string */ - } - else { - ret[size]='\0'; - break; - } - } - size = strlen(ret); - } while (size > 0); + } + size = strlen(ret); + } while (size > 0); - /* Remove trailing newlines. */ - while (ret[size - 1] == '\n') - ret[--size] = '\0'; - - return ret; - } + /* Remove trailing newlines. */ + while (ret[size - 1] == '\n') + ret[--size] = '\0'; + + return dexml( ret, recipient, "" ); + } } /* }}} */ /* Used to expand things of the form "object->method(arg)" in messages */ char *expandmethod (char *var, char *method, char *param, object *recipient) { /* {{{ */ - /* Params are only currently supported for a special "verb" - * pseudo-method, that does verb conjugaton. */ - if (strlen(param) == 0) { - return expandfield(var, method, recipient); - } - else if (strcmp(method, "verb") == 0) { - char *comma; - char *val; - object *obj; + /* Params are only currently supported for a special "verb" + * pseudo-method, that does verb conjugaton. */ + if (strlen(param) == 0) { + return expandfield(var, method, recipient); + } else if (strcmp(method, "verb") == 0) { + char *comma; + char *val; + object *obj; - if (strcmp(var, "this") == 0) { - obj = originator; - } - else { - val = findparam(var); - if (! val) - return ""; - - obj = derefobj(val); - if (! obj) - return ""; - } - - comma = strchr(param, ','); - if (! comma) { - /* Crummy basic conjugation: remove 's' for d.o. */ - if (objcmp(recipient, obj) == 0) { - int len = strlen(param); - if (param[len - 1] == 's') - param[len - 1] = '\0'; - } - return param; - } - else { - /* Conjugations supplied in the param, pick right one. */ - if (objcmp(recipient, obj) == 0) { - return comma + 1; - } - else { - comma[0] = '\0'; - return param; - } - } + if (strcmp(var, "this") == 0) { + obj = originator; } else { + val = findparam(var, params); + if (! val) return ""; + + obj = derefobj(val); + if (! obj) + return ""; } + + comma = strchr(param, ','); + if (! comma) { + /* Crummy basic conjugation: remove 's' for d.o. */ + if (objcmp(recipient, obj) == 0) { + int len = strlen(param); + if (param[len - 1] == 's') + param[len - 1] = '\0'; + } + return param; + } + else { + /* Conjugations supplied in the param, pick right one. */ + if (objcmp(recipient, obj) == 0) { + return comma + 1; + } + else { + comma[0] = '\0'; + return param; + } + } + } else { + return ""; + } } /* }}} */ /* Escape xml tags and entities in the input. */ -char *escapexml (char *text) { /* {{{ */ - char *s, *p=text, *ret=NULL; - - while ((s = strpbrk(p, "<>&"))) { - if (! ret) { - /* Worst case, every character must be escaped to - * &, so it grows 4 times as large. */ - ret = malloc(strlen(text) * 4 + 1); - ret[0] = '\0'; - } - if (s > p) - strncat(ret, p, s - p); - switch (s[0]) { - case '<': - strcat(ret, "<"); - break; - case '>': - strcat(ret, ">"); - break; - case '&': - strcat(ret, "&"); - break; - } - p = s+1; - } +char *escapexml (char *text, object *recipient) { /* {{{ */ + char *s, *p, *ret=NULL; + //text = dexml( text, recipient, "" ); + + p = text; + + while ((s = strpbrk(p, "<>&"))) { if (! ret) { - return text; + /* Worst case, every character must be escaped to + * &, so it grows 4 times as large. */ + ret = malloc(strlen(text) * 4 + 1); + ret[0] = '\0'; } - else { - strcat(ret, p); - return ret; + if (s > p) + strncat(ret, p, s - p); + switch (s[0]) { + case '<': + strcat(ret, "<"); + break; + case '>': + strcat(ret, ">"); + break; + case '&': + strcat(ret, "&"); + break; } + p = s+1; + } + + //fprintf( stderr, "new escapexml: %s, %s, %s.\n", text, p, ret ); + + if( ret == NULL || strlen( ret ) == 0 ) { + //fprintf( stderr, "escapexml returning text %s.\n", text ); + return text; + } else { + strcat(ret, p); + //fprintf( stderr, "escapexml returning ret %s.\n", ret ); + return ret; + } } /* }}} */ /* Generate a message for an object from a template. */ char *expandmessage (const char *template, object *recipient) { /* {{{ */ - char *tmpl = strdup(template); - char *s, *result; - int retlen = 0; - int retsize = strlen(template) + 80; - char *p, *ret = malloc(retsize * sizeof(char)); - char *retlinestart = ret; - int resultissender = 0; - ret[0] = '\0'; - - /* Break the template at \\n strings, and process each - * independently. Rejoin results with newlines. */ - while (tmpl) { - char *nl = strstr(tmpl, "\\n"); - if (nl) - nl[0] = '\0'; - - /* Do not allow spoofing of tags in the template. */ - if ((p = strstr(tmpl, ""))) { - tmpl = escapexml(tmpl); /* No more Mr. nice guy. */ + char *tmpl = strdup(template); + char *s, *result; + int retlen = 0; + int retsize = strlen(template) + 80; + char *p, *ret = malloc(retsize * sizeof(char)); + int retlinestart = 0; + int resultissender = 0; + ret[0] = '\0'; + + /* Break the template at \\n strings, and process each + * independently. Rejoin results with newlines. */ + while (tmpl) { + char *nl = strstr(tmpl, "\\n"); + if (nl) + nl[0] = '\0'; + + /* Do not allow spoofing of tags in the template. */ + if ((p = strstr(tmpl, ""))) { + tmpl = escapexml(tmpl, recipient); /* No more Mr. nice guy. */ + } + + /* Looking for things of the forms: + * $var + * $var->field + * $var->method(param) + * Cannot modify the template, and s should be set to the + * end of anything found. + */ + while ((s = strchr(tmpl, '$'))) { + char *var, *varstart = s + 1; + + /* Add anything before the var to ret. */ + s[0] = '\0'; + if (s > tmpl) { + int span = s - tmpl; + if (retlen + span >= retsize) { + retsize = retlen + span + 1; + ret = realloc(ret, retsize * sizeof(char)); } - - /* Looking for things of the forms: - * $var - * $var->field - * $var->method(param) - * Cannot modify the template, and s should be set to the - * end of anything found. - */ - while ((s = strchr(tmpl, '$'))) { - char *var, *varstart = s + 1; - - /* Add anything before the var to ret. */ - s[0] = '\0'; - if (s > tmpl) { - int span = s - tmpl; - if (retlen + span >= retsize) { - retsize = retlen + span + 1; - ret = realloc(ret, retsize * sizeof(char)); - } - strcat(ret, tmpl); - retlen += span; - } - result = NULL; - - /* Find var. */ + strcat(ret, tmpl); + retlen += span; + } + result = NULL; + + /* Find var. */ + s++; + while (isalnum(s[0]) || s[0] == '_') + s++; + if (s > varstart) { + var = malloc(s - varstart + 1); + bzero(var, s - varstart + 1); + memcpy(var, varstart, s - varstart); + + /* Find field or method. */ + if (s[0] == '-' && s[1] == '>') { + char *fm, *fmstart = s + 2; + s+=2; + while (isalnum(s[0]) || s[0] == '_') s++; - while (isalnum(s[0]) || s[0] == '_') + if (s > fmstart) { + fm = malloc(s - fmstart + 1); + bzero(fm, s - fmstart + 1); + memcpy(fm, fmstart, s - fmstart); + + /* Find param. */ + if (s[0] == '(') { + char *param, *paramstart = s + 1; + s++; + while (s && s[0] != ')') s++; - if (s > varstart) { - var = malloc(s - varstart + 1); - bzero(var, s - varstart + 1); - memcpy(var, varstart, s - varstart); - - /* Find field or method. */ - if (s[0] == '-' && s[1] == '>') { - char *fm, *fmstart = s + 2; - s+=2; - while (isalnum(s[0]) || s[0] == '_') - s++; - if (s > fmstart) { - fm = malloc(s - fmstart + 1); - bzero(fm, s - fmstart + 1); - memcpy(fm, fmstart, s - fmstart); + if (s[0] == ')') { + param = malloc(s - paramstart + 1); + bzero(param, s - paramstart + 1); + memcpy(param, paramstart, s - paramstart); + s++; - /* Find param. */ - if (s[0] == '(') { - char *param, *paramstart = s + 1; - s++; - while (s && s[0] != ')') - s++; - if (s[0] == ')') { - param = malloc(s - paramstart + 1); - bzero(param, s - paramstart + 1); - memcpy(param, paramstart, s - paramstart); - s++; - - result = expandmethod(var, fm, param, recipient); - } - } - else { - result = expandfield(var, fm, recipient); - } - } - } - else { - /* Expand a variable. */ - object *obj = NULL; - char *val = NULL; + result = expandmethod(var, fm, param, recipient); + } + } + else { + result = expandfield(var, fm, recipient); + } + } + } + else { + /* Expand a variable. */ + object *obj = NULL; + char *val = NULL; + int pretty_other = 0; - if (strcmp(var, "this") == 0) { - obj = originator; - } - else { - val = findparam(var); - obj = derefobj(val); - if (! obj) { - result = val; - } - } - - if (obj) { - result = prettyname(obj, recipient); - if (avatar && objcmp(obj, avatar) == 0) - resultissender = 1; - } - } + if (strcmp(var, "this") == 0) { + obj = originator; + } else if (strcmp(var, "othis") == 0) { + /* "othis" means treat as though someone + * else was seeing it, even if it's the user + * themselves. + */ + obj = originator; + pretty_other = 1; + } else { + char *param_val; + param_val = findparam(var, params); - if (result) { - int span; + //fprintf( stderr, "msg pre-val: %s,%s,%s.\n", var, param_val, recipient->dir ); - result = escapexml(result); - - span = strlen(result); + val = dexml( param_val, recipient, "" ); - if (resultissender) { - /* Will add tag for antispoofing display. */ - span += strlen(""); - /* Adjust where the beginning of the real line (to uppercase) is, skipping over the tag. */ - if (ret[0] == '\0' || ret[-1] == '\n') - retlinestart += strlen(""); - } - - if (retlen + span >= retsize) { - retsize = retlen + span + 1; - ret = realloc(ret, retsize * sizeof(char)); - } - - if (resultissender) { - strcat(ret, ""); - } - strcat(ret, result); - if (resultissender) { - strcat(ret, ""); - } - resultissender = 0; - retlen += span; - } + //fprintf( stderr, "msg val: %s.\n", val ); + + obj = derefobj(val); + if (! obj) { + result = val; } + } - tmpl = s; - - } - - /* Add anything after the last expansion to ret. */ - if (tmpl) { - int span = strlen(tmpl); - if (retlen + span >= retsize) { - retsize = retlen + span + 1; - ret = realloc(ret, retsize * sizeof(char)); + if (obj) { + if( pretty_other == 1 ) + { + result = other_prettyname( obj, recipient ); + } else { + result = prettyname( obj, recipient ); } - strcat(ret, tmpl); - retlen += span; - } - - if (nl) { - /* Add newline to ret. */ - if (retlen + 1 >= retsize) { - retsize = retlen + 2; - ret = realloc(ret, retsize * sizeof(char)); + // fprintf( stderr, "result: %s.\n", result ); + // fprintf( stderr, "avatar: %s.\n", avatar->dir ); + // fprintf( stderr, "obj: %s.\n", obj->dir ); + if (avatar && objcmp(obj, avatar) == 0) + { + // fprintf( stderr, "result is sender.\n" ); + resultissender = 1; } - ret[retlen] = '\n'; - ret[retlen + 1] = '\0'; - retlen++; - - tmpl = nl+2; + } } - else { - tmpl = nl; /* break loop */ + + if (result) { + int span; + + result = escapexml(result, recipient); + + span = strlen(result); + + if (resultissender) { + /* Will add tag for antispoofing display. */ + span += strlen(""); + /* Adjust where the beginning of the real line (to uppercase) is, skipping over the tag. */ + if (ret[0] == '\0' || ret[-1] == '\n') + retlinestart += strlen(""); + } + + if (retlen + span >= retsize) { + retsize = retlen + span + 1; + ret = realloc(ret, retsize * sizeof(char)); + } + + if (resultissender) { + strcat(ret, ""); + } + strcat(ret, result); + if (resultissender) { + strcat(ret, ""); + } + resultissender = 0; + retlen += span; } + } - /* Upper-case the beginning of the line in ret. */ - retlinestart[0] = toupper(retlinestart[0]); - retlinestart = ret + strlen(ret); + tmpl = s; + } - - return ret; + + /* Add anything after the last expansion to ret. */ + if (tmpl) { + int span = strlen(tmpl); + if (retlen + span >= retsize) { + retsize = retlen + span + 1; + ret = realloc(ret, retsize * sizeof(char)); + } + strcat(ret, tmpl); + retlen += span; + } + + if (nl) { + /* Add newline to ret. */ + if (retlen + 1 >= retsize) { + retsize = retlen + 2; + ret = realloc(ret, retsize * sizeof(char)); + } + ret[retlen] = '\n'; + ret[retlen + 1] = '\0'; + retlen++; + + tmpl = nl+2; + } + else { + tmpl = nl; /* break loop */ + } + + { + int span; + char *scratch; + + span = strlen( "" ); + + if (retlen + span >= retsize) { + retsize = retlen + span + 1; + ret = realloc(ret, retsize * sizeof(char)); + } + + /* Reposition the newline */ + retlen = retlen + span; + + scratch = malloc( retsize * sizeof(char) ); + + /* Mark the beginning of the line for upper + * casing in those languages that have that + * "feature" (done in notice.c). + */ + scratch[0] = '\0'; + strncat( scratch, ret, retlinestart ); + strcat( scratch, "" ); + strcat( scratch, &ret[retlinestart] ); + strcpy( ret, scratch ); + + free( scratch ); + + retlinestart = strlen(ret); + } + } + + return ret; } /* }}} */ /* Check criteria and maybe deliver a message to an object. */ int deliver_message (object *obj, const struct message *msg, const int *filter) { /* {{{ */ - int i, j; - int isthis; - int send = 1; - struct criteria *crit; - object *pobj, *onlyto_session = NULL; - int *usedsenses = new_filter(); /* not strictly a filter, but same - data structure will do */ - - for (i = 0; i < msg->numcriteria && send; i++) { - crit = msg->criteria[i]; - switch (crit->type) { - case crit_sense: - for (j = 0; j < num_senses; j++) { - if (strcmp(senses[j], crit->criteria) == 0) { - if (crit->intensity < filter[j]) - send = 0; - usedsenses[j] = crit->intensity; - break; - } - } - break; - case crit_object: - if (strcmp(crit->criteria, "this") == 0) { - pobj = originator; - isthis = 1; - } - else { - pobj = derefobj(findparam(crit->criteria)); - isthis = 0; - } - if (pobj) { - if (objcmp(obj, pobj) != 0) - send = 0; - if (! isthis) - free(pobj); - } - else { - send = 0; - } - break; - case crit_session: - { - onlyto_session = derefobj(findparam("session")); - if (avatar && objcmp(obj, avatar) != 0) - send = 0; - } - break; - } - } + int i, j; + int isthis; + int send = 1; + struct criteria *crit; + object *pobj, *onlyto_session = NULL; + int *usedsenses = new_filter(); /* not strictly a filter, but same + data structure will do */ - if (send) { - /* Pass the list of senses that this messages uses along - * with the expanded message, and all the parameters passed - * to this method on to the tell method. */ - FILE **fds, *wtr, *rdr; - char *message = expandmessage(msg->message, obj); - - /* Use runmethod_raw to avoid having to build up a big - * parameters data structure. */ - fds = runmethod_raw(obj, "notice"); - if (fds == NULL) - return 0; - wtr = fds[0]; - rdr = fds[1]; - - /* Let the notice method know it goes only to the one - * session. */ - if (onlyto_session) { - fprintf(wtr, "session\nmooix:%s\n", onlyto_session->dir); + for (i = 0; i < msg->numcriteria && send; i++) { + crit = msg->criteria[i]; + switch (crit->type) { + case crit_sense: + for (j = 0; j < num_senses; j++) { + if (strcmp(senses[j], crit->criteria) == 0) { + if (crit->intensity < filter[j]) + send = 0; + usedsenses[j] = crit->intensity; + break; + } } - - fprintf(wtr, "message\n%s\n", escape(message)); - for (i = 0; i < num_senses; i++) { - if (usedsenses[i]) { - fprintf(wtr, "sense\n%s\nintensity\n%i\n", - senses[i], usedsenses[i]); - } + break; + case crit_object: + if (strcmp(crit->criteria, "this") == 0) { + pobj = originator; + isthis = 1; } - fprintf(wtr, "originator\nmooix:%s\n", originator->dir); - for (i=0; params[i] != NULL; i++) { - fprintf(wtr, "%s\n%s\n", params[i]->name, params[i]->value); + else { + pobj = derefobj(findparam(crit->criteria, params)); + isthis = 0; } + if (pobj) { + if (objcmp(obj, pobj) != 0) + send = 0; + if (! isthis) + free(pobj); + } + else { + send = 0; + } + break; + case crit_session: + { + onlyto_session = derefobj(findparam("session", params)); + if (avatar && objcmp(obj, avatar) != 0) + send = 0; + } + break; + } + } - /* Let the method know the params are done. */ - fclose(wtr); - fgetallvals(rdr); - free(message); + if (send) { + /* Pass the list of senses that this messages uses along + * with the expanded message, and all the parameters passed + * to this method on to the tell method. */ + FILE **fds, *wtr, *rdr; + char *message = expandmessage(msg->message, obj); - /* This method returns a list of objects the message was sent - * to. Just print them out.. */ - printf("mooix:%s\n", obj->dir); + /* Use runmethod_raw to avoid having to build up a big + * parameters data structure. */ + fds = runmethod_raw(obj, "notice"); + if (fds == NULL) + return 0; + wtr = fds[0]; + rdr = fds[1]; + + /* Let the notice method know it goes only to the one + * session. */ + if (onlyto_session) { + fprintf(wtr, "session\nmooix:%s\n", onlyto_session->dir); } - free(usedsenses); - return send; + // fprintf(stderr, "msg message\n%s\n", escape(message)); + fprintf(wtr, "message\n%s\n", escape(message)); + for (i = 0; i < num_senses; i++) { + if (usedsenses[i]) { + fprintf(wtr, "sense\n%s\nintensity\n%i\n", + senses[i], usedsenses[i]); + } + } + fprintf(wtr, "originator\nmooix:%s\n", originator->dir); + for (i=0; params[i] != NULL; i++) { + fprintf(wtr, "%s\n%s\n", params[i]->name, params[i]->value); + } + + /* Let the method know the params are done. */ + fclose(wtr); + fgetallvals(rdr); + free(message); + + /* This method returns a list of objects the message was sent + * to. Just print them out.. */ + printf("mooix:%s\n", obj->dir); + } + + free(usedsenses); + return send; } /* }}} */ /* Types of filters. See mooix:filter/base->trigger.inf */ @@ -855,116 +864,116 @@ * accumulates its filters to passed filter arrays. If an array is NULL, * does not bother accumulating to that array. */ void filter (object *obj, int *to_f, int *in_f, int *out_f, int *inter_f) { /* {{{ */ - int i; - char fieldname[32]; - char *file; - char *value; - char *line; - FILE *f = NULL, *df; - int trigger; - int *to_filter[4]; /* 4 = number of filters in parameters */ - int num_to_filter = 0; - char *list; - object *messagefilter_list, *messagefilter; - char *messagefilters_dir; + int i; + char fieldname[32]; + char *file; + char *value; + char *line; + FILE *f = NULL, *df; + int trigger; + int *to_filter[4]; /* 4 = number of filters in parameters */ + int num_to_filter = 0; + char *list; + object *messagefilter_list, *messagefilter; + char *messagefilters_dir; - /* I don't bother to check for inherited messageflter objects. - * Quicker not to. */ - messagefilters_dir = malloc(strlen(obj->dir) + strlen("/messagefilters") + 1); - sprintf(messagefilters_dir, "%s/messagefilters", obj->dir); - messagefilter_list = getobj(messagefilters_dir); - list=fieldfile(messagefilter_list, "list"); - if (list) - f = fopen(list, "r"); - freeobj(messagefilter_list); - if (! f) - return; - - while ((line = mooix_getline(f, 0))) { - messagefilter=derefobj(line); - free(line); + /* I don't bother to check for inherited messageflter objects. + * Quicker not to. */ + messagefilters_dir = malloc(strlen(obj->dir) + strlen("/messagefilters") + 1); + sprintf(messagefilters_dir, "%s/messagefilters", obj->dir); + messagefilter_list = getobj(messagefilters_dir); + list=fieldfile(messagefilter_list, "list"); + if (list) + f = fopen(list, "r"); + freeobj(messagefilter_list); + if (! f) + return; - file = fieldfile(messagefilter, "trigger"); - if (! file) - continue; - value = getfield(file); - if (! value) - continue; - trigger=atoi(value); - if (! trigger) - continue; - - /* Work out which of the input filters can be affected by - * this object based on the value of is_filter. Fill an array - * with the filters to act on, and then we can just loop over - * it below. */ - num_to_filter=0; - if (to_f && trigger & TO_TRIGGERED) { - to_filter[num_to_filter] = to_f; - num_to_filter++; + while ((line = mooix_getline(f, 0))) { + messagefilter=derefobj(line); + free(line); + + file = fieldfile(messagefilter, "trigger"); + if (! file) + continue; + value = getfield(file); + if (! value) + continue; + trigger=atoi(value); + if (! trigger) + continue; + + /* Work out which of the input filters can be affected by + * this object based on the value of is_filter. Fill an array + * with the filters to act on, and then we can just loop over + * it below. */ + num_to_filter=0; + if (to_f && trigger & TO_TRIGGERED) { + to_filter[num_to_filter] = to_f; + num_to_filter++; + } + if (in_f && trigger & IN_TRIGGERED) { + to_filter[num_to_filter] = in_f; + num_to_filter++; + } + if (out_f && trigger & OUT_TRIGGERED) { + to_filter[num_to_filter] = out_f; + num_to_filter++; + } + if (inter_f && trigger & INTER_TRIGGERED) { + to_filter[num_to_filter] = inter_f; + num_to_filter++; + } + if (! num_to_filter) + continue; + + /* Static filters. */ + for (i = 0; i < num_senses; i++) { + snprintf(fieldname, 31, "filter_%s", senses[i]); + file = fieldfile(messagefilter, fieldname); + if (file != NULL) { + FILE *fh = fopen(file, "r"); + if (fh != NULL) { + value = mooix_getline(fh, 0); + if (value) { + int f; + int v = atoi(value); + free(value); + for (f = 0; f < num_to_filter; f++) + to_filter[f][i] += v; + } } - if (in_f && trigger & IN_TRIGGERED) { - to_filter[num_to_filter] = in_f; - num_to_filter++; - } - if (out_f && trigger & OUT_TRIGGERED) { - to_filter[num_to_filter] = out_f; - num_to_filter++; - } - if (inter_f && trigger & INTER_TRIGGERED) { - to_filter[num_to_filter] = inter_f; - num_to_filter++; - } - if (! num_to_filter) - continue; - - /* Static filters. */ - for (i = 0; i < num_senses; i++) { - snprintf(fieldname, 31, "filter_%s", senses[i]); - file = fieldfile(messagefilter, fieldname); - if (file != NULL) { - FILE *fh = fopen(file, "r"); - if (fh != NULL) { - value = mooix_getline(fh, 0); - if (value) { - int f; - int v = atoi(value); - free(value); - for (f = 0; f < num_to_filter; f++) - to_filter[f][i] += v; - } - } - fclose(fh); - free(file); - } - } + fclose(fh); + free(file); + } + } - /* Dynamic filter. Since this is a mite expensive to do every - * time, only do it if the trigger was ORed with 1. */ - if (trigger & 1 && - (df = runmethod(messagefilter, "filtermessage", NULL))) { - while (! feof(df)) { - char *sense = fgetvalue(df); - value = fgetvalue(df); - if (sense != NULL && filter != NULL) { - for (i = 0; i < num_senses; i++) { - if (strcmp(senses[i], sense) == 0) { - int f; - int v = atoi(value); - for (f = 0; f < num_to_filter; f++) - to_filter[f][i] += v; - break; - } - } - } - free(sense); - free(value); + /* Dynamic filter. Since this is a mite expensive to do every + * time, only do it if the trigger was ORed with 1. */ + if (trigger & 1 && + (df = runmethod(messagefilter, "filtermessage", NULL))) { + while (! feof(df)) { + char *sense = fgetvalue(df); + value = fgetvalue(df); + if (sense != NULL && filter != NULL) { + for (i = 0; i < num_senses; i++) { + if (strcmp(senses[i], sense) == 0) { + int f; + int v = atoi(value); + for (f = 0; f < num_to_filter; f++) + to_filter[f][i] += v; + break; } - fclose(df); + } } - - freeobj(messagefilter); + free(sense); + free(value); + } + fclose(df); } + + freeobj(messagefilter); + } } /* }}} */ /* Propigates a message throughout the current location. The parameters @@ -980,186 +989,206 @@ * not set, then this parameter is MODIFIED by this call. */ void propigate (object *obj, object *from, int fromloc, - const struct message_block *messages, - int *traverse_f, int *inter_f) { /* {{{ */ - int *to_f; - int *out_f = NULL; - int *my_inter_f = NULL; - FILE *c; - object *location = NULL; - int traverse_location = 0; - int is_aware = truefield(obj, "aware"); - char *contents_file = malloc(strlen(obj->dir) + strlen("/contents/list") + 1); - sprintf(contents_file, "%s/contents/list", obj->dir); - - if (fromloc) { - /* Leaf object optimisation: If the object is not a - * container, and the message has propigated from its - * location, and the object is not aware, then there is no - * point in worrying about filters, or doing delivery, or - * any of that. */ - if (! is_aware) { - struct stat st_buf; - if (stat(contents_file, &st_buf) != 0) { - free(contents_file); - return; - } - } + const struct message_block *messages, + int *traverse_f, int *inter_f) { /* {{{ */ + int *to_f; + int *out_f = NULL; + int *my_inter_f = NULL; + FILE *c; + object *location = NULL; + int traverse_location = 0; + int is_aware = truefield(obj, "aware"); + char *contents_file = malloc(strlen(obj->dir) + strlen("/contents/list") + 1); + sprintf(contents_file, "%s/contents/list", obj->dir); + + if (fromloc) { + /* Leaf object optimisation: If the object is not a + * container, and the message has propigated from its + * location, and the object is not aware, then there is no + * point in worrying about filters, or doing delivery, or + * any of that. */ + if (! is_aware) { + struct stat st_buf; + if (stat(contents_file, &st_buf) != 0) { + free(contents_file); + return; + } } - else { - /* Find the location, if there is one, and see if it - * should be traversed. */ - char *file = malloc(strlen(obj->dir) + strlen("/location") + 1); - sprintf(file, "%s/location", obj->dir); - location = getobj(file); - if (statobj(location) && (! from || objcmp(from, location) != 0)) { - traverse_location = 1; - out_f = new_filter(); - } + } + else { + /* Find the location, if there is one, and see if it + * should be traversed. */ + char *file = malloc(strlen(obj->dir) + strlen("/location") + 1); + sprintf(file, "%s/location", obj->dir); + location = getobj(file); + if (statobj(location) && (! from || objcmp(from, location) != 0)) { + traverse_location = 1; + out_f = new_filter(); } + } - /* Always copy traverse_f, to avoid modifying it. */ - traverse_f = copy_filter(traverse_f); + /* Always copy traverse_f, to avoid modifying it. */ + traverse_f = copy_filter(traverse_f); - /* Apply filters for this object. If the message is coming from the - * location, apply in_triggered filters to traverse_f. Note that - * out_f will be NULL unless there's an untraversed location. */ - to_f=new_filter(); - if (fromloc) { - /* Since fromloc is set, do not modify inter_f. - * Instead, make a copy now. */ - inter_f = copy_filter(inter_f); - filter(obj, to_f, traverse_f, out_f, inter_f); + /* Apply filters for this object. If the message is coming from the + * location, apply in_triggered filters to traverse_f. Note that + * out_f will be NULL unless there's an untraversed location. */ + to_f=new_filter(); + if (fromloc) { + /* Since fromloc is set, do not modify inter_f. + * Instead, make a copy now. */ + inter_f = copy_filter(inter_f); + filter(obj, to_f, traverse_f, out_f, inter_f); + } + else { + /* Don't change inter_f yet, since location propigation + * needs to use the one that is not filtered through this + * object. */ + my_inter_f = new_filter(); + filter(obj, to_f, NULL, out_f, my_inter_f); + } + + if (traverse_location) { + /* Propigate to the location (and deeper, recursively). As + * locations are traversed, inter_f accululates all the + * inter_triggered filters for the locations, which is why + * locations are traversed first. For traverse_f, + * pass a filter that is the sum of our traverse_f and the + * out_triggered filters for this object, if the message is + * coming from somthing other than this object. If it comes + * directly from this object, then the out_f does not + * apply. */ + int *f; + int i; + if (from) { + f = malloc(num_senses * sizeof(int *)); + for (i= 0; i < num_senses; i++) + f[i] = out_f[i] + traverse_f[i]; } else { - /* Don't change inter_f yet, since location propigation - * needs to use the one that is not filtered through this - * object. */ - my_inter_f = new_filter(); - filter(obj, to_f, NULL, out_f, my_inter_f); + f = new_filter(); } - - if (traverse_location) { - /* Propigate to the location (and deeper, recursively). As - * locations are traversed, inter_f accululates all the - * inter_triggered filters for the locations, which is why - * locations are traversed first. For traverse_f, - * pass a filter that is the sum of our traverse_f and the - * out_triggered filters for this object, if the message is - * coming from somthing other than this object. If it comes - * directly from this object, then the out_f does not - * apply. */ - int *f; - int i; - if (from) { - f = malloc(num_senses * sizeof(int *)); - for (i= 0; i < num_senses; i++) - f[i] = out_f[i] + traverse_f[i]; + propigate(location, obj, 0, messages, f, inter_f); + free(f); + freeobj(location); + } + + if (! fromloc) { + /* Merge my_inter_f into inter_f, after location + * propigation is complete. */ + int i; + for (i= 0; i < num_senses; i++) + inter_f[i] += my_inter_f[i]; + free(my_inter_f); + } + + /* Is this a container? If so, propigate to all the contents. */ + c = fopen(contents_file, "r"); + free(contents_file); + if (c) { + /* Get all contents of the container in an array first, + * then close the fd, before filtering through them. This + * avoids problems with possibly running out of fds if + * there are a lot of objects to traverse. */ + int size = 16; + object **contents = malloc(size * sizeof(object *)); + int i, num_contents = 0; + char *item; + + while ((item = fgetvalue(c))) { + object *contents_obj = derefobj(item); + if (contents_obj) { + contents[num_contents] = contents_obj; + free(item); + num_contents++; + if (num_contents >= size) { + size *= 2; + contents = realloc(contents, size * sizeof(object *)); } - else { - f = new_filter(); - } - propigate(location, obj, 0, messages, f, inter_f); - free(f); - freeobj(location); + } } - - if (! fromloc) { - /* Merge my_inter_f into inter_f, after location - * propigation is complete. */ - int i; - for (i= 0; i < num_senses; i++) - inter_f[i] += my_inter_f[i]; - free(my_inter_f); - } - - /* Is this a container? If so, propigate to all the contents. */ - c = fopen(contents_file, "r"); - free(contents_file); - if (c) { - /* Get all contents of the container in an array first, - * then close the fd, before filtering through them. This - * avoids problems with possibly running out of fds if - * there are a lot of objects to traverse. */ - int size = 16; - object **contents = malloc(size * sizeof(object *)); - int i, num_contents = 0; - char *item; - - while ((item = fgetvalue(c))) { - object *contents_obj = derefobj(item); - if (contents_obj) { - contents[num_contents] = contents_obj; - free(item); - num_contents++; - if (num_contents >= size) { - size *= 2; - contents = realloc(contents, size * sizeof(object *)); - } - } - } - - fclose(c); - - for (i = 0; i < num_contents; i++) { - if (! from || objcmp(contents[i], from) != 0) { - /* Since fromloc is not set, this call will - * not modify the passed filters. */ - propigate(contents[i], obj, 1, messages, traverse_f, inter_f); - } - freeobj(contents[i]); - } - free(contents); + fclose(c); + + for (i = 0; i < num_contents; i++) { + if (! from || objcmp(contents[i], from) != 0) { + /* Since fromloc is not set, this call will + * not modify the passed filters. */ + propigate(contents[i], obj, 1, messages, traverse_f, inter_f); + } + freeobj(contents[i]); } - /* Finally, delivery to this object. */ - if (is_aware && + free(contents); + } + + /* Finally, delivery to this object. */ + if (is_aware && (! skip || objcmp(obj, skip) != 0) && (! onlyto || objcmp(obj, onlyto) == 0)) { - int i; - /* Combine to_f, traverse_f, and inter_f into one. */ - for (i= 0; i < num_senses; i++) - to_f[i] += traverse_f[i] + inter_f[i]; - /* Delivery. */ - for (i = 0; i <= messages->num; i++) { - if (deliver_message(obj, messages->messages[i], to_f)) - break; - } + int i; + /* Combine to_f, traverse_f, and inter_f into one. */ + for (i= 0; i < num_senses; i++) + to_f[i] += traverse_f[i] + inter_f[i]; + /* Delivery. */ + for (i = 0; i <= messages->num; i++) { + if (deliver_message(obj, messages->messages[i], to_f)) + break; } - - /* Cleanup copies made to prevent filter modifications. */ - free(traverse_f); - if (fromloc) - free(inter_f); + } + + /* Cleanup copies made to prevent filter modifications. */ + free(traverse_f); + if (fromloc) + free(inter_f); } /* }}} */ int main (int argc, char **argv) { /* {{{ */ - object *this; - char *messagefield; - struct message_block *messages; - - methinit(); - getparams(); + object *this; + char *messagefield; + struct message_block *messages; - this = getobj(getenv("THIS")); /* needs to be an abs path */ - avatar = derefobj(findparam("avatar")); - skip = derefobj(findparam("skip")); - onlyto = derefobj(findparam("onlyto")); - originator = derefobj(findparam("originator")); - if (! originator) - originator=this; - messagefield = strdup(findparam("event")); - if (! messagefield) { - fprintf(stderr, "event field required\n"); - exit(1); - } - messagefield = realloc(messagefield, strlen(messagefield) + 5); - messagefield = strcat(messagefield, ".msg"); - + //fprintf( stderr, "In msg.\n" ); + + methinit(); + params = getparams(); + + this = getobj(getenv("THIS")); /* needs to be an abs path */ + avatar = derefobj(findparam("avatar", params)); + skip = derefobj(findparam("skip", params)); + onlyto = derefobj(findparam("onlyto", params)); + originator = derefobj(findparam("originator", params)); + + //fprintf( stderr, "msg: Got basic params.\n" ); + //fprintf( stderr, "msg: this: %s.\n", this->dir ); + //fprintf( stderr, "msg: avatar: %s.\n", avatar->dir ); + + if (! originator) + originator=this; + messagefield = strdup(findparam("event", params)); + if (! messagefield) { + fprintf(stderr, "event field required\n"); + exit(1); + } + messagefield = realloc(messagefield, strlen(messagefield) + 5); + messagefield = strcat(messagefield, ".msg"); + + //fprintf( stderr, "msg: messagefield: %s.\n", messagefield ); + + // Check for absolute path message fields, so scratch messages + // can be put in /tmp. + if( strchr( messagefield, '/' ) != NULL ) + { + messages = read_messages( messagefield ); + } else { messages = read_messages(fieldfile(originator, messagefield)); - if (messages == NULL) - exit(0); - propigate(this, NULL, 0, messages, new_filter(), new_filter()); - return 0; + } + + if (messages == NULL) + exit(0); + + //fprintf( stderr, "msg: About to propigate.\n" ); + propigate(this, NULL, 0, messages, new_filter(), new_filter()); + //fprintf( stderr, "msg: Done.\n" ); + return 0; } /* }}} */ Index: obj/concrete/ball/bounce_verb =================================================================== --- obj/concrete/ball/bounce_verb (revision 23) +++ obj/concrete/ball/bounce_verb (working copy) @@ -7,8 +7,10 @@ # Move the ball into the avatar's location. if ($avatar->location != $this->location) { - $this->physics->move(object => $this, to => $avatar->location) || - fail "It won't bounce."; + if( ! $this->physics->move(object => $this, to => $avatar->location) ) { + $this->msg( 'bounce_fail', %_ ); + fail(); + } } $this->msg('startbounce', %_); Index: obj/concrete/ball/bounce_fail.msg =================================================================== --- obj/concrete/ball/bounce_fail.msg (revision 0) +++ obj/concrete/ball/bounce_fail.msg (revision 0) @@ -0,0 +1 @@ +session: It won't bounce. Index: obj/concrete/room/look_verb =================================================================== --- obj/concrete/room/look_verb (revision 23) +++ obj/concrete/room/look_verb (working copy) @@ -2,37 +2,52 @@ #use Mooix::Thing; #use Mooix::Root; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; - my @allcontents = $this->contents->list; - my $exit=$Mooix::Root->concrete->exit; - my (@contents, @exits, $details); + my @allcontents = $this->contents->list; + my $exit=$Mooix::Root->concrete->exit; + my (@contents, @exits, $details); - foreach (@allcontents) { - if (! $_->hidden) { - push @contents, $_; - } - elsif ($_->defines("detail")) { - $details .= " ".$_->detail; - } - elsif ($_->listable && $_->isa($exit)) { - push @exits, $_; - } + foreach (@allcontents) { + if (! $_->hidden) { + push @contents, $_; } + elsif ($_->defines("detail")) { + $details .= " ".$_->detail; + } + elsif ($_->listable && $_->isa($exit)) { + push @exits, $_; + } + } - foreach (@contents) { - my @visi = $_->visiblecontents; - if (@visi) { - push @contents, @visi; - } + # For each item in the contents, add to the overall room + # contents list those things in or on the items in the room that + # are easily visible from the outside. The ball on the desk, for + # example, shows up in the room listing as "you see the ball and + # the desk here". + foreach (@contents) { + my @visi = $_->visiblecontents; + if (@visi) { + push @contents, @visi; } - my @contents = grep { $_ != $avatar } @contents; - + } + + my @contents = grep { $_ != $avatar } @contents; + + if( @contents ) + { + # If there are contents to display. $this->msg("look", %_, - contents => @contents ? ucfirst $avatar->prettylist(@contents) : ($details ? "Nothing else" : "Nothing"), + contents => $avatar->prettylist($avatar, @contents), details => $details, - are => (@contents > 1) ? "are" : "is", - exits => @exits ? $avatar->prettylist(@exits) : "none"); + exits => @exits ? $avatar->prettylist($avatar, @exits) : "" + ); + } else { + $this->msg("look_empty", %_, + details => $details, + exits => @exits ? $avatar->prettylist($avatar, @exits) : "" + ); + } } Index: obj/concrete/room/look.cmd =================================================================== --- obj/concrete/room/look.cmd (revision 23) +++ obj/concrete/room/look.cmd (working copy) @@ -1,6 +1,14 @@ +# look verb +# look around +verb, preposition(around) +# look at the room verb, do_preposition(at), direct_object(this)(visible) -# Look under, in, etc room. -verb, do_preposition, direct_object(this)(visible) : look_prep +# look the room verb, direct_object(this)(visible) -verb, preposition(around) +# look in the room +verb, do_preposition(set@in_prepositions), direct_object(this)(visible) +# look under the room +verb, do_preposition(set@under_prepositions), direct_object(this)(visible) : look_under_fail +# look on the room +verb, do_preposition(set@on_prepositions), direct_object(this)(visible) : look_on_fail Index: obj/concrete/room/exits_verb =================================================================== --- obj/concrete/room/exits_verb (revision 23) +++ obj/concrete/room/exits_verb (working copy) @@ -20,16 +20,16 @@ # This is rather specific to the precise ways the variables are # used in the exits.msg. Oh well. if (@someexits > 1) { - $_{someexits}="exits ".$avatar->prettylist(@someexits); + $_{someexits}="exits ".$avatar->prettylist($avatar, @someexits); } elsif (@someexits) { - $_{someexits}="an exit ".$avatar->prettylist(@someexits); + $_{someexits}="an exit ".$avatar->prettylist($avatar, @someexits); } else { $_{someexits}="nothing"; } $this->msg('exits', %_, - exits => @exits ? $avatar->prettylist(@exits) : 'none', + exits => @exits ? $avatar->prettylist($avatar, @exits) : 'none', s => (@exits == 1) ? "" : "s", ); } Index: obj/concrete/room/look.msg =================================================================== --- obj/concrete/room/look.msg (revision 23) +++ obj/concrete/room/look.msg (working copy) @@ -1,2 +1,2 @@ -see,session: $this.\n$this->description$details\n$contents $are here. +see,session: $this.\n$this->description$details\nYou see $contents here. session: It's dark. Index: obj/concrete/room/look_empty.msg =================================================================== --- obj/concrete/room/look_empty.msg (revision 0) +++ obj/concrete/room/look_empty.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: $this.\n$this->description$details +session: It's dark. Index: obj/abstract/physics/move.inf =================================================================== --- obj/abstract/physics/move.inf (revision 23) +++ obj/abstract/physics/move.inf (working copy) @@ -15,7 +15,9 @@ object The object to move. to Where to put the object. Optional, if not set the object will be teleported to nowhere. - preposition An optional preposition describing in what relation - the object will have to its new location. + relation An optional word, such as "in", "on", + "under", etc describing in what relation the + object will have to its new location. The + default is "in". teleport Allow moving of the object even if its immobile flag is set (but only if its owner is moving it..) Index: obj/abstract/physics/move =================================================================== --- obj/abstract/physics/move (revision 23) +++ obj/abstract/physics/move (working copy) @@ -5,8 +5,12 @@ my $this=shift; %_=@_; my $to = $_{to}; + my $relation = $_{relation} ? $_{relation} : "in"; my $object = $_{object} || $this->usage("missing object in move"); + # Whether to leave even if the room doesn't want us to. + my $force = $_{force} ? $_{force} : ""; + if ($object->immobile) { return unless $_{teleport}; require Mooix::CallStack; @@ -51,19 +55,11 @@ } } - # If there is a preposition, check it to see if the new location will - # allow that preposition to be used. If not, get the default - # prepositions. In any event, set @prepositions to the list of - # prepositions it returns. - my @prepositions; - if ($to) { - if (length $_{preposition}) { - @prepositions=$to->get_preposition(preposition => $_{preposition}, object => $object); - } - else { - @prepositions=$to->get_preposition(object => $object); - } - return unless @prepositions; + # Check that the location will allow the relation requested. + if( $to ) + { + #print STDERR "relation: $relation, valid: " . $to->valid_relations . "\n"; + return unless grep( /^$relation$/, $to->valid_relations ); } # Unfortunatly, moves can't be done atomically. Given the choice @@ -78,7 +74,18 @@ # Of course, we may not need to move it really. if ($oldlocation != $to) { if (ref $oldlocation) { - return unless $oldlocation->contents->remove(object => $object); + # Make sure the oldloc thinks it has us + if( grep { $_ == $object } $oldlocation->contents->list ) + { + # If force is on, don't return if this + # doesn't work. + if( $force ) + { + $oldlocation->contents->remove(object => $object); + } else { + return unless $oldlocation->contents->remove(object => $object); + } + } } $object->location($to); if (ref $to) { @@ -143,11 +150,9 @@ } } - # Now that the object is moved, update its preposition field with - # the prepositions the location's get_preposition method returned - # earlier. If there are none, just set it to an empty value. - push @prepositions, "" unless @prepositions; - $object->preposition(@prepositions); + # Now that the object is moved, update its relation field with + # the relationship it has just acquired with its location. + $object->relation($relation); return $object; } Index: obj/abstract/language/name =================================================================== --- obj/abstract/language/name (revision 0) +++ obj/abstract/language/name (revision 0) @@ -0,0 +1 @@ +Language Index: obj/abstract/language/languages.inf =================================================================== --- obj/abstract/language/languages.inf (revision 0) +++ obj/abstract/language/languages.inf (revision 0) @@ -0,0 +1,2 @@ +The object that contains a list off all the languages that are valid +in the MOO. Index: obj/abstract/language/description =================================================================== --- obj/abstract/language/description (revision 0) +++ obj/abstract/language/description (revision 0) @@ -0,0 +1 @@ +Parent of the classes for spoken languages in the moo. Index: obj/abstract/language/lojban/object3_extras =================================================================== --- obj/abstract/language/lojban/object3_extras (revision 0) +++ obj/abstract/language/lojban/object3_extras (revision 0) @@ -0,0 +1,3 @@ +lojban_quote3 +non_lojban_quote3 +preposition3 Index: obj/abstract/language/lojban/prompt =================================================================== --- obj/abstract/language/lojban/prompt (revision 0) +++ obj/abstract/language/lojban/prompt (revision 0) @@ -0,0 +1 @@ +.i gau mi > Index: obj/abstract/language/lojban/article =================================================================== --- obj/abstract/language/lojban/article (revision 0) +++ obj/abstract/language/lojban/article (revision 0) @@ -0,0 +1 @@ +la Index: obj/abstract/language/lojban/pronouns =================================================================== --- obj/abstract/language/lojban/pronouns (revision 0) +++ obj/abstract/language/lojban/pronouns (revision 0) @@ -0,0 +1,41 @@ +ti +ta +tu +ri +ra +ru +ko'a +le diklo +le ru'u stuzi +le se zvati be mi +ro da +roda +ro dacti +mi +by +cy +dy +fy +gy +jy +ky +ly +my +ny +py +ry +sy +ty +vy +xy +zy +abu +a bu +ebu +e bu +ibu +i bu +obu +o bu +ubu +u bu Index: obj/abstract/language/lojban/question_ender =================================================================== Index: obj/abstract/language/lojban/question_word_object1.inf =================================================================== --- obj/abstract/language/lojban/question_word_object1.inf (revision 0) +++ obj/abstract/language/lojban/question_word_object1.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/lojban/duration =================================================================== --- obj/abstract/language/lojban/duration (revision 0) +++ obj/abstract/language/lojban/duration (revision 0) @@ -0,0 +1,35 @@ +#!/usr/bin/perl +#use Mooix::Thing; + +run sub { + my $this=shift; + %_=@_; + my $idletime = $_{idletime}; + + my $days, $hours, $minutes, $seconds; + + $days = int( $idletime / 86400 ); + $idletime = $idletime - ( 86400 * $days ); + $hours = int( $idletime / 3600 ); + $idletime = $idletime - ( 3600 * $hours ); + $minutes = int( $idletime / 60 ); + $idletime = $idletime - ( 60 * $minutes ); + $seconds = $idletime; + + my $retstring = ""; + if( $days ) + { + $retstring .= $days ? "lo djedi be li $days ce'o " : ""; + $retstring .= $hours ? "lo cacra be li $hours" : ""; + } elsif( $hours ) { + $retstring .= $hours ? "lo cacra be li $hours ce'o " : ""; + $retstring .= $minutes ? "lo mentu be li $minutes" : ""; + } elsif( $minutes ) { + $retstring .= $minutes ? "lo mentu be li $minutes ce'o " : ""; + $retstring .= $seconds ? "lo snidu be li $seconds" : ""; + } else { + $retstring .= $seconds ? "lo snidu be li $seconds" : ""; + } + + return $retstring; +} Property changes on: obj/abstract/language/lojban/duration ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/language/lojban/question_word_object2.inf =================================================================== --- obj/abstract/language/lojban/question_word_object2.inf (revision 0) +++ obj/abstract/language/lojban/question_word_object2.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/lojban/here_pronouns =================================================================== --- obj/abstract/language/lojban/here_pronouns (revision 0) +++ obj/abstract/language/lojban/here_pronouns (revision 0) @@ -0,0 +1,4 @@ +le diklo +le ru'u stuzi +le se zvati be mi +ti Index: obj/abstract/language/lojban/question_word_object3.inf =================================================================== --- obj/abstract/language/lojban/question_word_object3.inf (revision 0) +++ obj/abstract/language/lojban/question_word_object3.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/lojban/question_word_object4.inf =================================================================== --- obj/abstract/language/lojban/question_word_object4.inf (revision 0) +++ obj/abstract/language/lojban/question_word_object4.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/lojban/help_basics.inf =================================================================== --- obj/abstract/language/lojban/help_basics.inf (revision 0) +++ obj/abstract/language/lojban/help_basics.inf (revision 0) @@ -0,0 +1,2 @@ +The name of the help file that should appear when a user in this +language types "help" by itself. Index: obj/abstract/language/lojban/question_word_object5.inf =================================================================== --- obj/abstract/language/lojban/question_word_object5.inf (revision 0) +++ obj/abstract/language/lojban/question_word_object5.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/lojban/relative_ender =================================================================== --- obj/abstract/language/lojban/relative_ender (revision 0) +++ obj/abstract/language/lojban/relative_ender (revision 0) @@ -0,0 +1 @@ +ku'o Index: obj/abstract/language/lojban/on_relatives =================================================================== --- obj/abstract/language/lojban/on_relatives (revision 0) +++ obj/abstract/language/lojban/on_relatives (revision 0) @@ -0,0 +1,2 @@ +poi gapru +poi cpana Index: obj/abstract/language/lojban/help_index.inf =================================================================== --- obj/abstract/language/lojban/help_index.inf (revision 0) +++ obj/abstract/language/lojban/help_index.inf (revision 0) @@ -0,0 +1 @@ +The text of the argument passed to "help" to ask for a help index. Index: obj/abstract/language/lojban/cmd_parse_command =================================================================== --- obj/abstract/language/lojban/cmd_parse_command (revision 0) +++ obj/abstract/language/lojban/cmd_parse_command (revision 0) @@ -0,0 +1 @@ +brivla Index: obj/abstract/language/lojban/under_relatives =================================================================== --- obj/abstract/language/lojban/under_relatives (revision 0) +++ obj/abstract/language/lojban/under_relatives (revision 0) @@ -0,0 +1 @@ +poi cnita Index: obj/abstract/language/lojban/object4_extras.inf =================================================================== --- obj/abstract/language/lojban/object4_extras.inf (revision 0) +++ obj/abstract/language/lojban/object4_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/lojban/help_missing.inf =================================================================== --- obj/abstract/language/lojban/help_missing.inf (revision 0) +++ obj/abstract/language/lojban/help_missing.inf (revision 0) @@ -0,0 +1,2 @@ +The text of the argument passed to "help" to ask for a list of +missing help files. Index: obj/abstract/language/lojban/list_seperator_last.inf =================================================================== --- obj/abstract/language/lojban/list_seperator_last.inf (revision 0) +++ obj/abstract/language/lojban/list_seperator_last.inf (revision 0) @@ -0,0 +1,2 @@ +The characters used to seperate the last two elements of a list in +this language, including spaces. Index: obj/abstract/language/lojban/in_prepositions.inf =================================================================== --- obj/abstract/language/lojban/in_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/in_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is inside something +else. Index: obj/abstract/language/lojban/lie_relatives.inf =================================================================== --- obj/abstract/language/lojban/lie_relatives.inf (revision 0) +++ obj/abstract/language/lojban/lie_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +lying on something else; in "look at the user which is lying on the +couch", "which is lying on" is what goes in this file. Index: obj/abstract/language/lojban/stand_prepositions.inf =================================================================== --- obj/abstract/language/lojban/stand_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/stand_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is standing on +something else. Index: obj/abstract/language/lojban/on_prepositions.inf =================================================================== --- obj/abstract/language/lojban/on_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/on_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is on something +else. Index: obj/abstract/language/lojban/.mooix =================================================================== Index: obj/abstract/language/lojban/extra_relatives.inf =================================================================== --- obj/abstract/language/lojban/extra_relatives.inf (revision 0) +++ obj/abstract/language/lojban/extra_relatives.inf (revision 0) @@ -0,0 +1,2 @@ +Any relative tags that should be recognized but don't belong in the +locational lists. Index: obj/abstract/language/lojban/extra_prepositions.inf =================================================================== --- obj/abstract/language/lojban/extra_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/extra_prepositions.inf (revision 0) @@ -0,0 +1 @@ +A trying-to-be-complete list of prepositions in the language. Index: obj/abstract/language/lojban/Makefile =================================================================== --- obj/abstract/language/lojban/Makefile (revision 0) +++ obj/abstract/language/lojban/Makefile (revision 0) @@ -0,0 +1,19 @@ +build:: prepositions relative_tags + +# Collect all the prepositions from the sub files +prepositions: behind_prepositions in_prepositions lie_prepositions on_prepositions sit_prepositions stand_prepositions under_prepositions + cat behind_prepositions in_prepositions \ + lie_prepositions on_prepositions sit_prepositions \ + stand_prepositions under_prepositions \ + extra_prepositions | sort | uniq >prepositions + +# Collect all the relative tags from the sub files +relative_tags: behind_relatives in_relatives lie_relatives on_relatives sit_relatives stand_relatives under_relatives + cat behind_relatives in_relatives \ + lie_relatives on_relatives sit_relatives \ + stand_relatives under_relatives \ + extra_relatives | sort | uniq >relative_tags + +clean:: + rm -f prepositions relative_tags +realclean:: Index: obj/abstract/language/lojban/object2_extras =================================================================== --- obj/abstract/language/lojban/object2_extras (revision 0) +++ obj/abstract/language/lojban/object2_extras (revision 0) @@ -0,0 +1,3 @@ +lojban_quote2 +non_lojban_quote2 +preposition2 Index: obj/abstract/language/lojban/behind_prepositions.inf =================================================================== --- obj/abstract/language/lojban/behind_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/behind_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is behind something +else. Index: obj/abstract/language/lojban/description =================================================================== --- obj/abstract/language/lojban/description (revision 0) +++ obj/abstract/language/lojban/description (revision 0) @@ -0,0 +1 @@ +.uu Index: obj/abstract/language/lojban/code.inf =================================================================== --- obj/abstract/language/lojban/code.inf (revision 0) +++ obj/abstract/language/lojban/code.inf (revision 0) @@ -0,0 +1 @@ +The language's ISO code (generally 2 or 3 letters). Index: obj/abstract/language/lojban/second_person_singular_pronoun =================================================================== --- obj/abstract/language/lojban/second_person_singular_pronoun (revision 0) +++ obj/abstract/language/lojban/second_person_singular_pronoun (revision 0) @@ -0,0 +1 @@ +do Index: obj/abstract/language/lojban/all_pronouns.inf =================================================================== --- obj/abstract/language/lojban/all_pronouns.inf (revision 0) +++ obj/abstract/language/lojban/all_pronouns.inf (revision 0) @@ -0,0 +1,3 @@ +Hold those pronouns that match the concept of "all", as in "affect +absolutely everything". In English these are "all" and +"everything". Index: obj/abstract/language/lojban/grammar =================================================================== --- obj/abstract/language/lojban/grammar (revision 0) +++ obj/abstract/language/lojban/grammar (revision 0) @@ -0,0 +1,640 @@ +#more or less #!/usr/bin/perl + +# This file contains the Parse::RecDescent grammar used by the parser to +# deconstruct imperative sentences. +# +# The resulting parser builds and returns a parse tree. +# The form of the tree is a list of hashes (sentences). +# The sentance hashes can have keys named verb, direct_object, +# indirect_object, do_preposition, io_preposition, and quote +# (and a couple more weird ones). + +{ +my $sumti_position = 1; +$skip='[ \t.]*'; +sub SE_swap { + my $swap_num = shift; + my %bridi_map = @_; + my @keys = grep( /1$/, (keys %bridi_map) ); + foreach my $key (@keys) + { + $key =~ s/.$//; + @bridi_map{$key.'1',$key.$swap_num} = @bridi_map{$key.$swap_num,$key.'1'}; + } + map { delete $bridi_map{$_} if ! $bridi_map{$_} } (keys %bridi_map); + return \%bridi_map; + } +} + +## input: bridi +## { [ $item{bridi} ] } +input: bridi (bridi_separator bridi)(s?) /[\s.]*/ + { $item{bridi} ? [ $item{bridi}, @{$item[2]} ] : [ $item{bridi} ] } + +bridi_separator: /$/ | /[\s.]+i[\s.]*/i + +############# +# Not exactly sentences per se, but support answers to recently asked +# questions. That generally involves picking a choice from a list or +# answers, either by name or number. Or it might involve referring to a +# particular object, or be a prepositional phrase. +############# + +# This is used for object-based answers to recently asked +# questions. We stuff the answer into every possible sumti slot, +# just for coverage. +bridi: reset sumti ...bridi_separator + { + my %ret_hash; + foreach my $num (1, 2, 3, 4, 5) + { + $ret_hash{'object'.$num} = $item{sumti}->{object1}; + if( exists $item{sumti}->{preposition1} ) + { + $ret_hash{'preposition'.$num} = $item{sumti}->{preposition1}; + } + if( exists $item{sumti}->{lojban_quote1} ) + { + $ret_hash{'lojban_quote'.$num} = $item{sumti}->{lojban_quote1}; + } + if( exists $item{sumti}->{non_lojban_quote1} ) + { + $ret_hash{'non_lojban_quote'.$num} = $item{sumti}->{non_lojban_quote1}; + } + } + $return = \%ret_hash; + } + +# This is used for adjective-based answers to recently asked +# questions. +bridi: reset gadri(?) answer(s) ...bridi_separator + { { answer => $item{'answer(s)'} } } + +## sentence: gadri(?) number +## { { number => $item{number} } } + +############# +# Real bridi +############# + +bridi: reset terms (...!brivla /ku/i)(?) (...!brivla /cu/i)(?) /xe\b/i bridi_tail + { + &::recent_obj( +{ %{$item{terms}}, %{$item{bridi_tail}} } ); + SE_swap( '5', ( %{$item{terms}}, %{$item{bridi_tail}} ) ); + } + +bridi: reset terms (...!brivla /ku/i)(?) (...!brivla /cu/i)(?) /ve\b/i bridi_tail + { + &::recent_obj( +{ %{$item{terms}}, %{$item{bridi_tail}} } ); + SE_swap( '4', ( %{$item{terms}}, %{$item{bridi_tail}} ) ); + } + +bridi: reset terms (...!brivla /ku/i)(?) (...!brivla /cu/i)(?) /te\b/i bridi_tail + { + &::recent_obj( +{ %{$item{terms}}, %{$item{bridi_tail}} } ); + SE_swap( '3', ( %{$item{terms}}, %{$item{bridi_tail}} ) ); + } + +bridi: reset terms (...!brivla /ku/i)(?) (...!brivla /cu/i)(?) /se\b/i bridi_tail + { + &::recent_obj( +{ %{$item{terms}}, %{$item{bridi_tail}} } ); + SE_swap( '2', ( %{$item{terms}}, %{$item{bridi_tail}} ) ); + } + +bridi: reset terms (...!brivla /ku/i)(?) (...!brivla /cu/i)(?) bridi_tail + { + &::recent_obj( +{ %{$item{terms}}, %{$item{bridi_tail}} } ); + +{ %{$item{terms}}, %{$item{bridi_tail}} } + } + +############# +# bridi components +############# + +reset: + { $sumti_position = 1; } + +bridi_tail: brivla sumti(s?) ...bridi_separator + { + my $brivla = $item{brivla}; + $brivla =~ s/'/h/g; + +{ brivla => $brivla, map { %{$_} } @{$item{'sumti(s?)'}} } + } + +terms: sumti(s?) + { + +{ map { %{$_} } @{$item{'sumti(s?)'}} } + } + +############# +# sumti +############# + +sumti: FA(?) sumti2 + +FA: fa | fe | fi | fo | fu + +fa: /fa\b/i { $sumti_position = 1; } +fe: /fe\b/i { $sumti_position = 2; } +fi: /fi\b/i { $sumti_position = 3; } +fo: /fo\b/i { $sumti_position = 4; } +fu: /fu\b/i { $sumti_position = 5; } + +# zoi zoi cmene zoi po la cipra pilno +sumti2: basic_sumti relative_phrase_tag basic_sumti + { $sumti_position++; +{ %{$item[1]}, %{$item[-1]} } } + +sumti2: basic_sumti + { $sumti_position++; $item{basic_sumti} } + +basic_sumti: quote + +basic_sumti: preposition object + { + +{ + 'preposition'.$sumti_position => $item{preposition}, + 'object'.$sumti_position => $item{object} + } + } + +basic_sumti: object + { +{ 'object'.$sumti_position => $item{object} } } + +basic_sumti: koha + { +{ 'sumti'.$sumti_position => $item{koha} } } + +basic_sumti: gadri brivla(s) + { + +{ + 'sumti'.$sumti_position => join(' ', @{$item{'brivla(s)'}} ), + 'gadri'.$sumti_position => $item{gadri}, + } + } + +basic_sumti: language + +language: /la\b/i /($::languages)\b/i + { + +{ 'language'.$sumti_position => $item[2] } + } + +koha: /(ma)\b/i + +quote: non_lojban_quote + { + +{ + 'non_lojban_quote'.$sumti_position => $item{non_lojban_quote}, + 'any_quote'.$sumti_position => $item{non_lojban_quote} + } + } +quote: lojban_quote + { + +{ + 'lojban_quote'.$sumti_position => $item{lojban_quote}, + 'any_quote'.$sumti_position => $item{lojban_quote} + } + } + +non_lojban_quote: char_quote + { $item{char_quote} } +lojban_quote: /\s*lu\s*/i quote_body(s?) lihu + { join( '', @{$item{'quote_body(s?)'}} ) } +quote_body: lojban_quote + { " lu ".$item{lojban_quote}." li'u " } +quote_body: /\s*/ ...!lihu /\S/ + { $item[1] . $item[3] } +lihu: /\s*li'u\s*/i + +# Single or double quoted text. Allow the closing quote to be left off, if +# the text extends to end of string without one. This also recognizes stuff +# bracketed by {..} as a quote. This special style is used by the shortcuts +# substitutions, to unambiguously quote text that may contain other quote +# characters. +char_quote: /\\?/ /\s*{(.*)}/ { $1 } +char_quote: /\\?/ /\s*(?:'([^']*)(?:'|$))/ { $1 } +char_quote: /\\?/ /\s*(?:"([^"]*)(?:"|$))/ { $1 } +## char_quote: /\\?/ /\s*(?:'([^']*)(?:'|$)|{(.*)})/ { $1.$2 } +## char_quote: /\\?/ /\s*(?:"([^"]*)(?:"|$)|{(.*)})/ { $1.$2 } + +# le bolci poi nenri le tanxe +object: basic_object relative_clause_tag object + { &::is_obj_in_obj($item{basic_object}, $item{relative_clause_tag}, $item{object}) } + +object: basic_object + +basic_object: pronoun + { &::lookup_pronoun($item{pronoun}) } + +basic_object: gadri(?) /mooix:([^ ]+)/ + { &::lookup_reference($1) } + +basic_object: gadri noun + { &::lookup_noun($item{noun}) || &::lookup_noun(".".$item{noun}) || &::lookup_noun($item{noun}.".") || &::lookup_noun(".".$item{noun}.".") } + +basic_object: gadri adjectivelist noun + { &::lookup_noun($item{noun}, $item{adjectivelist}) || &::lookup_noun(".".$item{noun}, $item{adjectivelist}) || &::lookup_noun($item{noun}.".", $item{adjectivelist}) || &::lookup_noun(".".$item{noun}.".", $item{adjectivelist}) } + +# Quantifying the number of objects expected can resolve possible +# ambiguities. +basic_object: quantifier object + { &::check_quantification($item{quantifier}, $item{object}) } + +# Another form of quantification, a trifle expensive. +basic_object: number object + { &::check_quantification($item{number}, $item{object}) } + +############# +# Specials +############# + +relative_phrase_tag: /(po|pe|ne|po'e)\b/i + +pronoun: /($::pronouns)\b/i + +adjectivelist: adjective(s) + +noun: /($::nouns)\b/i + +gadri: /(lo|le|la|li)\b/i + +adjective: /($::adjectives)\b/i + +lojban_digit: /(no|pa|re|ci|vo|mu|xa|ze|bi|so)\b/i + +digit: /[0-9]\b/i + +number: digit(s) + { { join( '', @{$item[1]} ) } } + +number: lojban_digit(s) + # lookup_number is passed a textual representation of a number, and + # should return the number so represented, or undef on error + { { &::lookup_number( join( '', @{$item[1]} ) ) } } + +quantifier: /($::quantifiers)/i + +# Matches answers to a recent question. +answer: /($::answers)/i + +relative_clause_tag: /($::relative_tags)\b/i + +preposition: /($::prepositions)\b/i + +## Veeeeery simple Lojban morphology +consonant: /[bcdfgjklmnprstvxz]/ +vowel: /[aeiou]/ +tick: /['h]/ +lojban_letter: consonant +lojban_letter: vowel +lojban_letter: tick +vowel_ender: /[aeiou]\b/ +initial_consonant_pair: /(?: + bd|bl|br| + cf|ck|cl|cm|cn|cp|cr|ct| + dj|dr|dz| + fl|fr| + gl|gr| + jb|jd|jg|jm|jv| + kl|kr| + ml|mr| + pl|pr| + sf|sk|sl|sm|sn|sp|sr|st| + tc|tr|ts| + vl|vr|xl|xr|zb|zd|zg|zm|zv +)/x + { + $item[1] + } +y_char: /y/i +consonant_pair: consonant y_char(?) consonant + { + $item[2].join('',@{$item[3]}).$item[4] + } +dipthong: /(?:ai|ei|oi|au)/ +cmavo: /\s*/ ( vowel | dipthong | consonant vowel | consonant dipthong | consonant vowel "'" vowel ) + +brivla: /\s*/ ...lojban_letter(5) brivla_start1 brivla_ender ...(/[\s.]/|/$/) + { + if( $sumti_position == 1 ) + { + $sumti_position = 2; + } + $item{brivla_start1} . $item{brivla_ender}; + } + +brivla_ender: vowel_ender + { + $item{vowel_ender} + } + +brivla_ender: ...lojban_letter(2) lojban_letter brivla_ender + { + $item{lojban_letter} . $item{brivla_ender} + } + +brivla_start1: initial_consonant_pair + { + $item{initial_consonant_pair} + } +brivla_start1: brivla_start2(1..4) consonant_pair + { + join( '', @{$item[2]} ) . $item[3] + } +brivla_start2: ...!consonant_pair lojban_letter + { + $item{lojban_letter} + } + +## # +## # Thank god for HyperGrammar! +## # +## +## # Handle compound sentences, and multiple sentences too. +## input: sentence (sentence_separator sentence)(s?) sentence_punct(?) +## { $item[2] ? [ $item[1], @{$item[2]} ] : [ $item[1] ] } +## sentence_separator: /$/ | sentence_punct(?) coordinating_conjunction(s) | sentence_punct +## +## # All the sentence forms. The ordering is quite important. I've tried to +## # put the most commonly used forms first, so they'll be faster. Note that +## # the use of lookahead is important in getting those fast, commonly-used +## # forms to not match on subsets of longer sentences. +## # +## # Once each sentence is parsed, a call to main::recent_obj() is made, +## # passing in any recently referred to objects. This is generally used to +## # set up the 'it' and 'them' prepositions, or similar. +## +## # Talking is quick to match. +## sentence: verb quote ...sentence_separator +## { { verb => $item[1], quote => $item[2] } } +## # This form is used to invoke the name of an exit to use it. +## # (It can also be used to answer some questions.) It needs to come before +## # the verb direct_object form. Probably calling recent_obj here would just +## # be confusing. +## sentence: object ...sentence_separator +## { { direct_object => $item[1] } } +## # "sit down", "get up", etc. Has to come before the verb direct_object form. +## sentence: verb preposition ...sentence_separator +## { { verb => $item[1], preposition => $item[2] } } +## # Probably the most common sentence form. +## sentence: verb direct_object ...sentence_separator +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2] } } +## # This form is used to "pick up foo", etc. +## sentence: verb do_preposition direct_object ...sentence_separator +## { &::recent_obj(@{$item[3]}); +## { verb => $item[1], do_preposition => $item[2], +## direct_object => $item[3] } } +## # This form is used in eg, "put it down" or "wind it up". +## sentence: verb direct_object do_preposition ...sentence_separator +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], do_preposition => $item[3], +## direct_object => $item[2] } } +## # "put blah in foo", etc is quite common. +## sentence: verb do_preposition(?) direct_object io_preposition(?) indirect_object +## { &::recent_obj(@{$item[3]}); # which object? Dunno. :-/ +## { verb => $item[1], do_preposition => $item[2][0], +## direct_object => $item[3], io_preposition => $item[4][0], +## indirect_object => $item[5] } } +## # Not exactly sentences per se, but support answers to recently asked +## # questions. That generally involves picking a choice from a list or +## # answers, either by name or number. Or it might involve referring to a +## # particular object, or be a prepositional phrase. +## sentence: article(?) answer(s) ...sentence_separator +## { { answer => $item{'answer(s)'} } } +## sentence: article(?) number ...sentence_separator +## { { number => $item{number} } } +## sentence: do_preposition object ...sentence_separator +## { { direct_object => $item{object}, +## do_preposition => $item{do_preposition} } } +## # Simple commands are way up there too (but must come after the simple +## # question answer forms). +## sentence: verb ...sentence_separator +## { { verb => $item[1] } } +## +## # This is a gross special case for a few commands that take a field as +## # their last argument. +## fieldverb: /(show|showall|set|unset|edit|delete|usage|help|go|list)\b/i +## # A special terminator is needed to disambiguate from things like +## # "show ball then drop it", where "then" could be misinterpreted as a +## # field. +## # Must come before the verb quote direct_object form. +## sentence: fieldverb do_preposition(?) possessive_object field ...sentence_separator +## { &::recent_obj(@{$item[3]}); +## { verb => $item[1], do_preposition => $item[2][0], +## direct_object => $item[3], field => $item[4] } } +## sentence: fieldverb do_preposition(?) possessive_object number field ...sentence_separator +## { &::recent_obj(@{$item[3]}); +## { verb => $item[1], do_preposition => $item[2][0], +## direct_object => $item[3], number => $item[4], field => $item[5] } } +## # Used for the help command. +## sentence: fieldverb do_preposition(?) field ...sentence_separator +## { { verb => $item[1], do_preposition => $item[2][0], field => $item[3] } } +## +## # "say "blah" to him", "derive a "ball" from foo", etc. +## # This is strictly speaking, an indirect object, not a direct object. +## # However, it simplfies processing to treat it like a direct object. +## sentence: verb do_preposition(?) article(?) quote io_preposition direct_object +## { &::recent_obj(@{$item[6]}); +## { verb => $item[1], quote => $item[4], +## do_preposition => $item[5], direct_object => $item[6] } } +## +## # Now some declarative sentence forms. Matching a possessive object is +## # expensive, so do it only once. +## sentence: possessive_object declaration +## { &::recent_obj(@{$item[1]}); +## { direct_object => $item[1], %{$item[2]} } } +## +## # Stuff like "it's not hidden". +## declaration: ess /\bnot\b/i field ...sentence_separator +## { { verb => "is", field => $item[3], negated_verb => 1 } } +## # "it's hidden", etc +## declaration: ess field ...sentence_separator +## { { verb => "is", field => $item[2] } } +## # "I'm not benchmarked" +## declaration: /'?m?\b/i /\bnot\b/i field ...sentence_separator +## { { verb => "am", field => $item[3], negated_verb => 1 } } +## # "I'm benchmarked" +## declaration: /'?m?\b/i field ...sentence_separator +## { { verb => "am", field => $item[2] } } +## # Used, for example, to just say what a field's value is, to set it. +## declaration: field verb quote +## { { field => $item[1], verb => $item[2], quote => $item[3] } } +## # Similar form can be used (by builders) to say that an object's field is a +## # reference to another object. +## declaration: field verb indirect_object +## { { field => $item[1], verb => $item[2], indirect_object => $item[3] } } +## # This is used to set metadata about fields. +## declaration: field verb field number +## { { field => $item[1], verb => $item[2], +## metadata => $item[3], number => $item[4] } } +## # Even a list of references could be set. +## declaration: number field verb indirect_object +## { { number => $item[1], field => $item[2], +## verb => $item[3], indirect_object => $item[4] } } +## # A number can also be given, if there are multiple values of a field. +## declaration: number field verb quote +## { { number => $item[1], field => $item[2], +## verb => $item[3], quote => $item[4] } } +## # This is used to set and unset boolean fields. +## declaration: negated_verb field +## { { verb => $item[1], field => $item[2], negated_verb => 1 } } +## declaration: verb field +## { { verb => $item[1], field => $item[2] } } +## +## # These forms are used by the signal command. +## sentence: verb direct_object preposition(?) number +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2], number => $item[4] } } +## sentence: verb direct_object quote preposition(?) number +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2], quote => $item[3], +## number => $item[5] } } +## +## # And this is is used for dialing telephones. I suppose it could be used +## # for signals too.. Like the verb quote direct_object form, the object is +## # really indirect, but we'll call it the direct object for simplicity. +## sentence: verb do_preposition(?) number io_preposition direct_object +## { &::recent_obj(@{$item[5]}); +## { verb => $item[1], number => $item[3], +## do_preposition => $item[4], direct_object => $item[5] } } +## +## # "call me "Fred"", "rename me to "Fred"", etc. Must come after the +## # declarative forms, otherwise the quote matches too freely. +## sentence: verb do_preposition(?) direct_object io_preposition(?) quote +## { &::recent_obj(@{$item[3]}); +## { verb => $item[1], do_preposition => $item[2][0], +## direct_object => $item[3], io_preposition => $item[4][0], +## quote => $item[5] } } +## +## # This wacky form is used for digging. +## sentence: verb quote io_preposition quote +## { { verb => $item[1], quote => $item[2], io_preposition => $item[3], +## quote2 => $item[4] } } # XXX there must be a better name than "quote2"? +## +## # These forms are used to do stuff with fields. +## sentence: verb possessive_object field io_preposition quote +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2], +## field => $item[3], quote => $item[5] } } +## sentence: verb possessive_object field io_preposition indirect_object +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2], +## field => $item[3], indirect_object => $item[5] } } +## sentence: verb possessive_object number field io_preposition quote +## { &::recent_obj(@{$item[2]}); +## { verb => $item[1], direct_object => $item[2], +## number => $item[3], field => $item[4], quote => $item[6] } } +## +## # For the eval command. +## sentence: verb quote io_preposition field ...sentence_separator +## { { verb => $item[1], quote => $item[2], io_preposition => $item[3], +## field => $item[4] } } +## +## # This is a repeat of the simple sentence form, but it does not require an +## # obvious separator. The only reason for this is to make reinjection work +## # for stuff like "say hi" -- this parses the verb, then the "hi" is quoted +## # and the lot is re-injected. +## # This should be the last sentence type listed. +## sentence: verb +## { { verb => $item[1] } } +## +## # End of the entences, now on to the parts of speech.. +## +## direct_object: objectlist +## indirect_object: object +## # Allows for multiple prepositions to be used before a direct or +## # indirect object. They are joined together into one. +## do_preposition: preposition(s) +## { join(" ", @{$item[1]}) } +## io_preposition: preposition(s) +## { join(" ", @{$item[1]}) } +## objectlist: object (/(?:(?:,\s*)?and|,)/ object)(s?) +## # Flatten the nested lists into one list ref. +## { [ $item[2] ? ( @{$item[1]}, map { @{$_} } @{$item[2]} ) : @{$item[1]} ] } +## +## # "foo's bar" +## object: basic_object ess object +## { &::is_obj_in_obj($item[3], "", $item[1]) } +## # "my bar" +## object: basic_object object +## { &::is_obj_in_obj($item[2], "", $item[1]) } +## # "bar in foo". Note that multiple prepositions might be used; all must +## # match. +## object: basic_object preposition(s) object +## { &::is_obj_in_obj($item[1], $item[2], $item[3]) } +## # Quantifying the number of objects expected can resolve possible +## # ambiguities. +## object: /(a\b)?/ quantifier /(of\b)?/ object +## { &::check_quantification($item{quantifier}, $item{object}) } +## # Must some after the quantified object test, because "all" could be part +## # of a quantification, or a preposition. +## object: basic_object +## # Another form of quantification, a trifle expensive. +## object: number /(of)?/ basic_object +## { &::check_quantification($item{number}, $item{basic_object}) } +## +## possessive_object: object ess +## { $item[1] } +## +## # This is the set of simple ways to refer to an object, and is used as the +## # base for both regular and possessive forms of objects. +## basic_object: pronoun +## { &::lookup_pronoun($item{pronoun}) } +## basic_object: article(?) /mooix:([^ ]+)/ +## { &::lookup_reference($1) } +## basic_object: article(?) adjectivelist noun +## { &::lookup_noun($item{noun}, $item{adjectivelist}) } +## # This version is needed for cases like 'red guest', where red is a known +## # adjective, but it's actually being used as part of the noun instead. +## basic_object: article(?) noun +## { &::lookup_noun($item{noun}) } +## # A production without the article in front, in case the noun seems to strt +## # with an article (probably due to user confusion). +## basic_object: noun +## { &::lookup_noun($item{noun}) } +## +## adjectivelist: +## +## number: /[-+.\w]+\b/ +## # lookup_number is passed a textual representation of a number, and +## # should return the number so represented, or undef on error +## { { &::lookup_number($item[1]) } } +## +## # Single or double quoted text. Allow the closing quote to be left off, if +## # the text extends to end of string without one. This also recognizes stuff +## # bracketed by {..} as a quote. This special style is used by the shortcuts +## # substitutions, to unambiguously quote text that may contain other quote +## # characters. Quotes can have a comma before them. +## quote: /,?\s*(?:"([^"]*)(?:"|$)|{(.*)})/ { $1.$2 } +## # Things like object field names. Note that they cannot end in a period; +## # that would be ambiguous with a period at the end of a sentence. +## field: /[-_.+A-Za-z0-9]*[-_+A-Za-z0-9]/ +## +## # This only works for verbs like 'is' in declarative sentence forms. +## negated_verb: verb /not\b/i +## { $item[1] } +## negated_verb: /($::verbs)n't\b/i +## { $1 } +## +## # Some of the parts of speech are broken out into variables in main; +## # these variables must be defined before asking the parser to parse +## # something, and can be changed as needed between parsings w/o rebuilding +## # the whole parser. This makes it easy to eg, populate $::nouns with all +## # the names of all the objects the user could refer to. Set the variables +## # to compiled regexp's, that | together the possibilities. Like: +## # $::nouns=qr/cat|dog/; +## preposition: /($::prepositions)\b/i +## adjective: /($::adjectives)\b/i +## noun: /($::nouns)\b/i +## verb: /($::verbs)\b/i +## # The \b is necessary, since "i" is a pronoun, and that could match at the +## # start of other words. +## pronoun: /($::pronouns)\b/i +## # Matches answers to a recent question. +## answer: /($::answers)/i +## quantifier: /($::quantifiers)/i +## +## article: /(an|a|the)\b/i +## coordinating_conjunction: /(and|then|next)\b/i +## ess: /'?s?\b/i +## sentence_punct: /[,;.!]+/ Index: obj/abstract/language/lojban/question_starter.inf =================================================================== --- obj/abstract/language/lojban/question_starter.inf (revision 0) +++ obj/abstract/language/lojban/question_starter.inf (revision 0) @@ -0,0 +1,2 @@ +The characters to put at the beginning of a question in this +language; used by the parser to build questions about objects. Index: obj/abstract/language/lojban/stand_relatives =================================================================== --- obj/abstract/language/lojban/stand_relatives (revision 0) +++ obj/abstract/language/lojban/stand_relatives (revision 0) @@ -0,0 +1 @@ +poi gapru Index: obj/abstract/language/lojban/lie_prepositions =================================================================== --- obj/abstract/language/lojban/lie_prepositions (revision 0) +++ obj/abstract/language/lojban/lie_prepositions (revision 0) @@ -0,0 +1 @@ +le gapru be Index: obj/abstract/language/lojban/object3_extras.inf =================================================================== --- obj/abstract/language/lojban/object3_extras.inf (revision 0) +++ obj/abstract/language/lojban/object3_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/lojban/prompt.inf =================================================================== --- obj/abstract/language/lojban/prompt.inf (revision 0) +++ obj/abstract/language/lojban/prompt.inf (revision 0) @@ -0,0 +1 @@ +The prompt to present to the user, if not over-ridden. Index: obj/abstract/language/lojban/pronouns.inf =================================================================== --- obj/abstract/language/lojban/pronouns.inf (revision 0) +++ obj/abstract/language/lojban/pronouns.inf (revision 0) @@ -0,0 +1,2 @@ +This field needs to have a list of every pronoun the parser will +recognize. Index: obj/abstract/language/lojban/list_seperator =================================================================== --- obj/abstract/language/lojban/list_seperator (revision 0) +++ obj/abstract/language/lojban/list_seperator (revision 0) @@ -0,0 +1 @@ + .e Index: obj/abstract/language/lojban/question_ender.inf =================================================================== --- obj/abstract/language/lojban/question_ender.inf (revision 0) +++ obj/abstract/language/lojban/question_ender.inf (revision 0) @@ -0,0 +1,2 @@ +The characters to put at the end of a question in this language; +used by the parser to build questions about objects. Index: obj/abstract/language/lojban/duration.inf =================================================================== --- obj/abstract/language/lojban/duration.inf (revision 0) +++ obj/abstract/language/lojban/duration.inf (revision 0) @@ -0,0 +1,7 @@ +Prints out the given time in an appropriate natural language format. + +Parameters: + + idletime + + The amount of seconds to print out an idle time for. Index: obj/abstract/language/lojban/here_pronouns.inf =================================================================== --- obj/abstract/language/lojban/here_pronouns.inf (revision 0) +++ obj/abstract/language/lojban/here_pronouns.inf (revision 0) @@ -0,0 +1 @@ +A list of pronouns that match the concept of "here". Index: obj/abstract/language/lojban/relative_ender.inf =================================================================== --- obj/abstract/language/lojban/relative_ender.inf (revision 0) +++ obj/abstract/language/lojban/relative_ender.inf (revision 0) @@ -0,0 +1 @@ +The characters with which to end a relative clause in this language. Index: obj/abstract/language/lojban/relative_tags.inf =================================================================== --- obj/abstract/language/lojban/relative_tags.inf (revision 0) +++ obj/abstract/language/lojban/relative_tags.inf (revision 0) @@ -0,0 +1 @@ +A list of all relative clause bits (i.e. the stuff in *_relatives). Index: obj/abstract/language/lojban/on_relatives.inf =================================================================== --- obj/abstract/language/lojban/on_relatives.inf (revision 0) +++ obj/abstract/language/lojban/on_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is on the +couch", "which is on" is what goes in this file. Index: obj/abstract/language/lojban/cmd_parse_command.inf =================================================================== --- obj/abstract/language/lojban/cmd_parse_command.inf (revision 0) +++ obj/abstract/language/lojban/cmd_parse_command.inf (revision 0) @@ -0,0 +1,2 @@ +Holds the name of the grammatical element output by the parser that +should be matched to the name of .cmd files. Index: obj/abstract/language/lojban/under_relatives.inf =================================================================== --- obj/abstract/language/lojban/under_relatives.inf (revision 0) +++ obj/abstract/language/lojban/under_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +under something else; in "look at the ball which is under the +couch", "which is under" is what goes in this file. Index: obj/abstract/language/lojban/behind_relatives =================================================================== --- obj/abstract/language/lojban/behind_relatives (revision 0) +++ obj/abstract/language/lojban/behind_relatives (revision 0) @@ -0,0 +1 @@ +poi trixe Index: obj/abstract/language/lojban/indefinate_article =================================================================== --- obj/abstract/language/lojban/indefinate_article (revision 0) +++ obj/abstract/language/lojban/indefinate_article (revision 0) @@ -0,0 +1 @@ +lo Index: obj/abstract/language/lojban/object1_extras =================================================================== --- obj/abstract/language/lojban/object1_extras (revision 0) +++ obj/abstract/language/lojban/object1_extras (revision 0) @@ -0,0 +1,3 @@ +lojban_quote1 +non_lojban_quote1 +preposition1 Index: obj/abstract/language/lojban/sit_relatives =================================================================== --- obj/abstract/language/lojban/sit_relatives (revision 0) +++ obj/abstract/language/lojban/sit_relatives (revision 0) @@ -0,0 +1 @@ +poi zutse Index: obj/abstract/language/lojban/sit_prepositions =================================================================== --- obj/abstract/language/lojban/sit_prepositions (revision 0) +++ obj/abstract/language/lojban/sit_prepositions (revision 0) @@ -0,0 +1 @@ +le gapru be Index: obj/abstract/language/lojban/grammar_variables =================================================================== --- obj/abstract/language/lojban/grammar_variables (revision 0) +++ obj/abstract/language/lojban/grammar_variables (revision 0) @@ -0,0 +1,230 @@ +# This stuff is directly included by the parser, so it has access to all parser +# variables and such like. + +# Given a number representation (which might be the raw number, or the +# written-out form, or some ordinal form), return the number it +# represents, or undef if none. +sub lookup_number { #{{{ + $_=shift; + + s/no/0/; + s/pa/1/; + s/re/2/; + s/ci/3/; + s/vo/4/; + s/mu/5/; + s/xa/6/; + s/ze/7/; + s/bi/8/; + s/so/9/; + + s/\s*//g; + + return $_; +} #}}} + + +# Called by the grammar to point out recently referred to objects that may +# set the 'it' pronoun, etc. Pass in a list of objects. +sub recent_obj { #{{{ + my $objs = shift; + my @objs; + + if( ref( $objs ) eq "HASH" ) + { + while (my ($key, @value) = each %{$objs}) { + if( $key =~ m/^object[0-9]+/ ) + { + my $obj; + if( ref( $value[0] ) eq ARRAY ) + { + $obj = $value[0][0]; + } else { + $obj = $value[0]; + } + push @objs, $obj; + } + } + } + + foreach my $obj (@objs) + { + # Might as well handle BY pronouns right here. + my $name = strip_xml( $obj->name ); + if( $name =~ m/^\s*([bcdfgjklmnprstvxz])/ ) + { + $pronouns{$1."y"} = [ $obj ]; + } elsif ( $name =~ m/^[\s.]*([aeiou])/ ) { + $pronouns{$1." bu"} = [ $obj ]; + $pronouns{$1."bu"} = [ $obj ]; + } + } + if( @objs == 1 ) { + if( $objs[0] != $caller ) + { + $pronouns{ru} = $pronouns{ra}; + $pronouns{ra} = $pronouns{ri}; + # Don't set "it" if the caller talks about themself. + $pronouns{ri} = $pronouns{"ko'a"} = \@objs; + } + } elsif (@objs) { + # TODO To be strictly correct, I should only set 'these' and + # 'those' if all the objects are not people, and always set + # 'them'. + $pronouns{these} = $pronouns{those} = $pronouns{them} = $pronouns{their} = \@objs; + } +} #}}} + +# Given a number or one of a few known words that can be used to quantify a +# set of objects, and an array of objects that might be meant, returns +# either undef if the two don't make sense together, or an array of +# unambiguously quantified objects. +sub check_quantification { #{{{ + my $quant = lc(shift); + my @objs = @{shift()}; + + if ($quant eq 'ro' ) { + # easy enough; all match + } elsif( $quant eq "su'o" ) { + # pick one of the objects at random, ditch the rest + @objs=$objs[rand @objs] + } elsif( $quant eq "so'u" ) { + # Take two. + @objs=grep { $_ } @objs[0..1]; + } elsif( $quant eq "so'o" ) { + # "Consisting of a number more than two, but not very many" + # -- websters + # TODO I should really permute the array first. Same with + # next two elsifs. + my $num=3 + rand(2); # 3 to 5 + @objs=grep { $_ } @objs[0..$num - 1]; + } elsif( $quant eq "so'i" ) { + # Whatever, between a third and a fifth? + my $num = @objs / (3 + rand(2)); + if ($num < 2) { $num = 2 } + @objs=grep { $_ } @objs[0..$num - 1]; + } elsif( $quant eq "so'e" ) { + @objs=grep { $_ } @objs[0..$#objs / 0.9]; + } elsif( $quant eq "so'a" ) { + # All but one + @objs=grep { $_ } @objs[0..$#objs-1]; + } elsif ($quant + 0 != 0) { + if ($quant > @objs) { + $failreason=".i ".scalar @objs." po'o dacti cu zasti"; + return; + } + @objs=@objs[0..$quant - 1]; + } else { + return; + } + + # Quantifying objects disambiguates them. + map { delete $_->[ISAMB] } @objs; + return \@objs; +} #}}} + +# Unset the ISREF field, it is no longer relevant if the +# object is nearby now. This takes care of 'teleport mooix:foo +# here and look at it'. +sub reset_it +{ + if ($pronouns{ri} && grep { $pronouns{ri}->[0] == $_ } @nearbyobjs) + { + $pronouns{ri}->[0]->[ISREF] = undef; + } +} + +# Provide completions for the prompt +sub completions +{ + return join('|', $caller->language->here_pronouns, $caller->language->all_pronouns, keys %pronouns), +} + +# Build a regex for nouns. +sub build_nouns +{ + my @nouns; + foreach my $noun (keys %nametoobj) + { + $noun =~ s/^[.]*//; + $noun =~ s/[.]*$//; + push @nouns, $noun; + } + $nouns=genregex(@nouns); +} + + +# Clean those things out of %remains in checkproto for which the +# existence of them shouldn't invalidate a match. +sub clean_remains +{ + my $command = shift; + my $remains = shift; + + # For each thing like any_quote* that was used, delete the + # corresponding lojban_quote* and non_lojban_quote*, and + # contrariwise. + foreach my $key (keys %{$command}) + { + if( $key =~ m/^any_quote([0-9]*)/ ) + { + my $num = $1; + # Found a quote; see if it was consumed + if( ! exists $remains->{$key} ) + { + # It was; kill its relatives + delete $remains->{"lojban_quote$num"}; + delete $remains->{"non_lojban_quote$num"}; + } + } + if( $key =~ m/^lojban_quote([0-9]*)/ || $key =~ m/^non_lojban_quote([0-9]*)/ ) + { + my $num = $1; + # Found a quote; see if it was consumed + if( ! exists $remains->{$key} ) + { + # It was; kill its relatives + delete $remains->{"any_quote$num"}; + } + } + } +} + +# Clean up the names of parts of speech as used in .cmd files to be +# more human-readable. Takes on at a time. +sub clean_incomplete +{ + $_ = shift; + + if( m/sumti([0-9]+)/ ) { + return "$1 moi sumti"; + } elsif ( m/object([0-9]+)/ ) { + return "$1 moi sumti poi dacti cmene"; + } elsif ( m/any_quote([0-9]+)/ ) { + return "$1 moi sumti poi sitna selsku"; + } elsif ( m/lojban_quote([0-9]+)/ ) { + return "$1 moi sumti poi sitna selsku gi'e pilno zo lu"; + } elsif ( m/non_lojban_quote([0-9]+)/ ) { + return "$1 moi sumti poi sitna selsku gi'e pilno zo zoi"; + } elsif ( m/language([0-9]+)/ ) { + return "$1 moi sumti poi bangu cmene"; + } elsif ( m/preposition([0-9]+)/ ) { + return "$1 moi sumti poi skicu le pagbu be lo dacti gi'e simsa lu le cnita be lo tanxe li'u"; + } else { + return $_; + } + +} + +$pronouns{mi} = [$caller]; + +$quantifiers=genregex(qw{ro so'a so'e so'i so'o so'u su'o}); + +$lang_to_grammar{lookup_number} = \&lookup_number; +$lang_to_grammar{recent_obj} = \&recent_obj; + +my @langs = + map{ $caller->dexml( avatar => $caller, text => $_->name ) } + map { s/^mooix://; $caller->get( $_ ) } + $Mooix::Root->abstract->language->languages->list; +$lang_to_grammar{languages} = \@langs; Property changes on: obj/abstract/language/lojban/grammar_variables ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/language/lojban/name =================================================================== --- obj/abstract/language/lojban/name (revision 0) +++ obj/abstract/language/lojban/name (revision 0) @@ -0,0 +1 @@ +Lojbanlojban Index: obj/abstract/language/lojban/object5_extras =================================================================== --- obj/abstract/language/lojban/object5_extras (revision 0) +++ obj/abstract/language/lojban/object5_extras (revision 0) @@ -0,0 +1,3 @@ +lojban_quote5 +non_lojban_quote5 +preposition5 Index: obj/abstract/language/lojban/definate_article =================================================================== --- obj/abstract/language/lojban/definate_article (revision 0) +++ obj/abstract/language/lojban/definate_article (revision 0) @@ -0,0 +1 @@ +le Index: obj/abstract/language/lojban/cmd_parse_object =================================================================== --- obj/abstract/language/lojban/cmd_parse_object (revision 0) +++ obj/abstract/language/lojban/cmd_parse_object (revision 0) @@ -0,0 +1,5 @@ +object1 +object2 +object3 +object4 +object5 Index: obj/abstract/language/lojban/in_relatives =================================================================== --- obj/abstract/language/lojban/in_relatives (revision 0) +++ obj/abstract/language/lojban/in_relatives (revision 0) @@ -0,0 +1,2 @@ +poi nenri +be ne'i Index: obj/abstract/language/lojban/object2_extras.inf =================================================================== --- obj/abstract/language/lojban/object2_extras.inf (revision 0) +++ obj/abstract/language/lojban/object2_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/lojban/under_prepositions =================================================================== --- obj/abstract/language/lojban/under_prepositions (revision 0) +++ obj/abstract/language/lojban/under_prepositions (revision 0) @@ -0,0 +1 @@ +le cnita be Index: obj/abstract/language/lojban/upper_case_initial =================================================================== --- obj/abstract/language/lojban/upper_case_initial (revision 0) +++ obj/abstract/language/lojban/upper_case_initial (revision 0) @@ -0,0 +1 @@ +0 Index: obj/abstract/language/lojban/holding_postfix =================================================================== --- obj/abstract/language/lojban/holding_postfix (revision 0) +++ obj/abstract/language/lojban/holding_postfix (revision 0) @@ -0,0 +1 @@ + poi do bevri ku'o Index: obj/abstract/language/lojban/second_person_singular_pronoun.inf =================================================================== --- obj/abstract/language/lojban/second_person_singular_pronoun.inf (revision 0) +++ obj/abstract/language/lojban/second_person_singular_pronoun.inf (revision 0) @@ -0,0 +1 @@ +Contains the part of speech, i.e. "you" in English. Index: obj/abstract/language/lojban/grammar.inf =================================================================== --- obj/abstract/language/lojban/grammar.inf (revision 0) +++ obj/abstract/language/lojban/grammar.inf (revision 0) @@ -0,0 +1,2 @@ +This is a Parse::RecDescent grammar for parsing imperative English +sentences. Index: obj/abstract/language/lojban/lie_prepositions.inf =================================================================== --- obj/abstract/language/lojban/lie_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/lie_prepositions.inf (revision 0) @@ -0,0 +1 @@ +A list of prepositions that fit when someone is lying on an object. Index: obj/abstract/language/lojban/stand_relatives.inf =================================================================== --- obj/abstract/language/lojban/stand_relatives.inf (revision 0) +++ obj/abstract/language/lojban/stand_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +standing on something else; in "look at the user which is standing +on the couch", "which is standing on" is what goes in this file. Index: obj/abstract/language/lojban/question_word_object1 =================================================================== --- obj/abstract/language/lojban/question_word_object1 (revision 0) +++ obj/abstract/language/lojban/question_word_object1 (revision 0) @@ -0,0 +1 @@ +fa ma Index: obj/abstract/language/lojban/prepositions.inf =================================================================== --- obj/abstract/language/lojban/prepositions.inf (revision 0) +++ obj/abstract/language/lojban/prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +This field needs to have a list of every preposition the parser will +recognize. Index: obj/abstract/language/lojban/question_word_object2 =================================================================== --- obj/abstract/language/lojban/question_word_object2 (revision 0) +++ obj/abstract/language/lojban/question_word_object2 (revision 0) @@ -0,0 +1 @@ +fe ma Index: obj/abstract/language/lojban/list_seperator.inf =================================================================== --- obj/abstract/language/lojban/list_seperator.inf (revision 0) +++ obj/abstract/language/lojban/list_seperator.inf (revision 0) @@ -0,0 +1,2 @@ +The characters used to seperate elements of a list in this language, +including spaces. Index: obj/abstract/language/lojban/question_word_object3 =================================================================== --- obj/abstract/language/lojban/question_word_object3 (revision 0) +++ obj/abstract/language/lojban/question_word_object3 (revision 0) @@ -0,0 +1 @@ +fi ma Index: obj/abstract/language/lojban/question_word_object4 =================================================================== --- obj/abstract/language/lojban/question_word_object4 (revision 0) +++ obj/abstract/language/lojban/question_word_object4 (revision 0) @@ -0,0 +1 @@ +fo ma Index: obj/abstract/language/lojban/help_basics =================================================================== --- obj/abstract/language/lojban/help_basics (revision 0) +++ obj/abstract/language/lojban/help_basics (revision 0) @@ -0,0 +1 @@ +jicmu Index: obj/abstract/language/lojban/question_word_object5 =================================================================== --- obj/abstract/language/lojban/question_word_object5 (revision 0) +++ obj/abstract/language/lojban/question_word_object5 (revision 0) @@ -0,0 +1 @@ +fu ma Index: obj/abstract/language/lojban/help_index =================================================================== --- obj/abstract/language/lojban/help_index (revision 0) +++ obj/abstract/language/lojban/help_index (revision 0) @@ -0,0 +1 @@ +liste Index: obj/abstract/language/lojban/object4_extras =================================================================== --- obj/abstract/language/lojban/object4_extras (revision 0) +++ obj/abstract/language/lojban/object4_extras (revision 0) @@ -0,0 +1,3 @@ +lojban_quote4 +non_lojban_quote4 +preposition4 Index: obj/abstract/language/lojban/help_missing =================================================================== --- obj/abstract/language/lojban/help_missing (revision 0) +++ obj/abstract/language/lojban/help_missing (revision 0) @@ -0,0 +1 @@ +seltcu Index: obj/abstract/language/lojban/list_seperator_last =================================================================== --- obj/abstract/language/lojban/list_seperator_last (revision 0) +++ obj/abstract/language/lojban/list_seperator_last (revision 0) @@ -0,0 +1 @@ + .e Index: obj/abstract/language/lojban/behind_relatives.inf =================================================================== --- obj/abstract/language/lojban/behind_relatives.inf (revision 0) +++ obj/abstract/language/lojban/behind_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is behind the +couch", "which is behind" is what goes in this file. Index: obj/abstract/language/lojban/in_prepositions =================================================================== --- obj/abstract/language/lojban/in_prepositions (revision 0) +++ obj/abstract/language/lojban/in_prepositions (revision 0) @@ -0,0 +1 @@ +le nenri be Index: obj/abstract/language/lojban/indefinate_article.inf =================================================================== --- obj/abstract/language/lojban/indefinate_article.inf (revision 0) +++ obj/abstract/language/lojban/indefinate_article.inf (revision 0) @@ -0,0 +1 @@ +Lists the language's indefinate article(s), i.e. "a". Index: obj/abstract/language/lojban/stand_prepositions =================================================================== --- obj/abstract/language/lojban/stand_prepositions (revision 0) +++ obj/abstract/language/lojban/stand_prepositions (revision 0) @@ -0,0 +1 @@ +le gapru be Index: obj/abstract/language/lojban/lie_relatives =================================================================== --- obj/abstract/language/lojban/lie_relatives (revision 0) +++ obj/abstract/language/lojban/lie_relatives (revision 0) @@ -0,0 +1 @@ +poi gapru Index: obj/abstract/language/lojban/sit_prepositions.inf =================================================================== --- obj/abstract/language/lojban/sit_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/sit_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is sitting on +something else. Index: obj/abstract/language/lojban/sit_relatives.inf =================================================================== --- obj/abstract/language/lojban/sit_relatives.inf (revision 0) +++ obj/abstract/language/lojban/sit_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +sitting on something else; in "look at the user which is sitting on +the couch", "which is sitting on" is what goes in this file. Index: obj/abstract/language/lojban/object1_extras.inf =================================================================== --- obj/abstract/language/lojban/object1_extras.inf (revision 0) +++ obj/abstract/language/lojban/object1_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/lojban/grammar_variables.inf =================================================================== --- obj/abstract/language/lojban/grammar_variables.inf (revision 0) +++ obj/abstract/language/lojban/grammar_variables.inf (revision 0) @@ -0,0 +1,3 @@ +Called by the parser to set up variables for the parser's use in a +way appropriate to this language. Runs in the parser's context. +Mostly sets elements of %lang_to_grammar. Index: obj/abstract/language/lojban/on_prepositions =================================================================== --- obj/abstract/language/lojban/on_prepositions (revision 0) +++ obj/abstract/language/lojban/on_prepositions (revision 0) @@ -0,0 +1,2 @@ +le gapru be +le cpana be Index: obj/abstract/language/lojban/object5_extras.inf =================================================================== --- obj/abstract/language/lojban/object5_extras.inf (revision 0) +++ obj/abstract/language/lojban/object5_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/lojban/definate_article.inf =================================================================== --- obj/abstract/language/lojban/definate_article.inf (revision 0) +++ obj/abstract/language/lojban/definate_article.inf (revision 0) @@ -0,0 +1 @@ +Lists the language's definate article(s), i.e. "the". Index: obj/abstract/language/lojban/cmd_parse_object.inf =================================================================== --- obj/abstract/language/lojban/cmd_parse_object.inf (revision 0) +++ obj/abstract/language/lojban/cmd_parse_object.inf (revision 0) @@ -0,0 +1,2 @@ +Lists those parts of speech that should be considered by the parser +to correspond to objects in the room. Index: obj/abstract/language/lojban/in_relatives.inf =================================================================== --- obj/abstract/language/lojban/in_relatives.inf (revision 0) +++ obj/abstract/language/lojban/in_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is inside the +couch", "which is inside" is what goes in this file. Index: obj/abstract/language/lojban/extra_prepositions =================================================================== --- obj/abstract/language/lojban/extra_prepositions (revision 0) +++ obj/abstract/language/lojban/extra_prepositions (revision 0) @@ -0,0 +1,8 @@ +le trixe be +le nenri be +le gapru be +le gapru be +le cpana be +le gapru be +le gapru be +le cnita be Index: obj/abstract/language/lojban/extra_relatives =================================================================== --- obj/abstract/language/lojban/extra_relatives (revision 0) +++ obj/abstract/language/lojban/extra_relatives (revision 0) @@ -0,0 +1,7 @@ +poi trixe +poi nenri +poi gapru +poi gapru +poi zutse +poi gapru +poi cnita Index: obj/abstract/language/lojban/under_prepositions.inf =================================================================== --- obj/abstract/language/lojban/under_prepositions.inf (revision 0) +++ obj/abstract/language/lojban/under_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is under something +else. Index: obj/abstract/language/lojban/behind_prepositions =================================================================== --- obj/abstract/language/lojban/behind_prepositions (revision 0) +++ obj/abstract/language/lojban/behind_prepositions (revision 0) @@ -0,0 +1 @@ +le trixe be Index: obj/abstract/language/lojban/code =================================================================== --- obj/abstract/language/lojban/code (revision 0) +++ obj/abstract/language/lojban/code (revision 0) @@ -0,0 +1 @@ +jbo Index: obj/abstract/language/lojban/upper_case_initial.inf =================================================================== --- obj/abstract/language/lojban/upper_case_initial.inf (revision 0) +++ obj/abstract/language/lojban/upper_case_initial.inf (revision 0) @@ -0,0 +1,2 @@ +Set to 0 if the language does not always upper-case the first letter +of sentences, 1 if it does. Index: obj/abstract/language/lojban/all_pronouns =================================================================== --- obj/abstract/language/lojban/all_pronouns (revision 0) +++ obj/abstract/language/lojban/all_pronouns (revision 0) @@ -0,0 +1,3 @@ +ro da +roda +ro dacti Index: obj/abstract/language/lojban/question_starter =================================================================== --- obj/abstract/language/lojban/question_starter (revision 0) +++ obj/abstract/language/lojban/question_starter (revision 0) @@ -0,0 +1 @@ +.i Index: obj/abstract/language/lojban/holding_postfix.inf =================================================================== --- obj/abstract/language/lojban/holding_postfix.inf (revision 0) +++ obj/abstract/language/lojban/holding_postfix.inf (revision 0) @@ -0,0 +1,2 @@ +Used by the parser to print out questions about what the user is +holding. Index: obj/abstract/language/languages/.mooix =================================================================== Index: obj/abstract/language/languages/list =================================================================== --- obj/abstract/language/languages/list (revision 0) +++ obj/abstract/language/languages/list (revision 0) @@ -0,0 +1,2 @@ +mooix:/var/lib/mooix/abstract/language/English +mooix:/var/lib/mooix/abstract/language/lojban Index: obj/abstract/language/.mooix =================================================================== Index: obj/abstract/language/English/pronouns =================================================================== --- obj/abstract/language/English/pronouns (revision 0) +++ obj/abstract/language/English/pronouns (revision 0) @@ -0,0 +1,31 @@ +it +its +me +myself +I +my +here +you +your +her +she +he +him +his +us +our +them +their +this +these +that +those +everything +everythings +everyone +everyones +anything +anythings +all +any +each Index: obj/abstract/language/English/article =================================================================== --- obj/abstract/language/English/article (revision 0) +++ obj/abstract/language/English/article (revision 0) @@ -0,0 +1 @@ +la Index: obj/abstract/language/English/question_ender =================================================================== --- obj/abstract/language/English/question_ender (revision 0) +++ obj/abstract/language/English/question_ender (revision 0) @@ -0,0 +1 @@ +? Index: obj/abstract/language/English/duration =================================================================== --- obj/abstract/language/English/duration (revision 0) +++ obj/abstract/language/English/duration (revision 0) @@ -0,0 +1,16 @@ +#!/usr/bin/perl +#use Mooix::Thing; + +run sub { + my $this=shift; + %_=@_; + my $idletime = $_{idletime}; + + # I'd like to use Time::Duration, but I don't haveta. + eval "use Time::Duration"; + if ($@) { + return $idletime." seconds"; + } else { + return duration( $idletime, 2 ); + } +} Property changes on: obj/abstract/language/English/duration ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/language/English/here_pronouns =================================================================== --- obj/abstract/language/English/here_pronouns (revision 0) +++ obj/abstract/language/English/here_pronouns (revision 0) @@ -0,0 +1 @@ +here Index: obj/abstract/language/English/help_basics.inf =================================================================== --- obj/abstract/language/English/help_basics.inf (revision 0) +++ obj/abstract/language/English/help_basics.inf (revision 0) @@ -0,0 +1,2 @@ +The name of the help file that should appear when a user in this +language types "help" by itself. Index: obj/abstract/language/English/relative_ender =================================================================== Index: obj/abstract/language/English/on_relatives =================================================================== --- obj/abstract/language/English/on_relatives (revision 0) +++ obj/abstract/language/English/on_relatives (revision 0) @@ -0,0 +1,6 @@ +which is on +which is on top of +who is on +who is on top of +that is on +that is on top of Index: obj/abstract/language/English/help_index.inf =================================================================== --- obj/abstract/language/English/help_index.inf (revision 0) +++ obj/abstract/language/English/help_index.inf (revision 0) @@ -0,0 +1 @@ +The text of the argument passed to "help" to ask for a help index. Index: obj/abstract/language/English/under_relatives =================================================================== --- obj/abstract/language/English/under_relatives (revision 0) +++ obj/abstract/language/English/under_relatives (revision 0) @@ -0,0 +1,3 @@ +which is under +who is under +that is under Index: obj/abstract/language/English/cmd_parse_command =================================================================== --- obj/abstract/language/English/cmd_parse_command (revision 0) +++ obj/abstract/language/English/cmd_parse_command (revision 0) @@ -0,0 +1 @@ +verb Index: obj/abstract/language/English/help_missing.inf =================================================================== --- obj/abstract/language/English/help_missing.inf (revision 0) +++ obj/abstract/language/English/help_missing.inf (revision 0) @@ -0,0 +1,2 @@ +The text of the argument passed to "help" to ask for a list of +missing help files. Index: obj/abstract/language/English/list_seperator_last.inf =================================================================== --- obj/abstract/language/English/list_seperator_last.inf (revision 0) +++ obj/abstract/language/English/list_seperator_last.inf (revision 0) @@ -0,0 +1,2 @@ +The characters used to seperate the last two elements of a list in +this language, including spaces. Index: obj/abstract/language/English/question_word_direct_object.inf =================================================================== --- obj/abstract/language/English/question_word_direct_object.inf (revision 0) +++ obj/abstract/language/English/question_word_direct_object.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/English/in_prepositions.inf =================================================================== --- obj/abstract/language/English/in_prepositions.inf (revision 0) +++ obj/abstract/language/English/in_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is inside something +else. Index: obj/abstract/language/English/lie_relatives.inf =================================================================== --- obj/abstract/language/English/lie_relatives.inf (revision 0) +++ obj/abstract/language/English/lie_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +lying on something else; in "look at the user which is lying on the +couch", "which is lying on" is what goes in this file. Index: obj/abstract/language/English/stand_prepositions.inf =================================================================== --- obj/abstract/language/English/stand_prepositions.inf (revision 0) +++ obj/abstract/language/English/stand_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is standing on +something else. Index: obj/abstract/language/English/on_prepositions.inf =================================================================== --- obj/abstract/language/English/on_prepositions.inf (revision 0) +++ obj/abstract/language/English/on_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is on something +else. Index: obj/abstract/language/English/.mooix =================================================================== Index: obj/abstract/language/English/extra_prepositions.inf =================================================================== --- obj/abstract/language/English/extra_prepositions.inf (revision 0) +++ obj/abstract/language/English/extra_prepositions.inf (revision 0) @@ -0,0 +1 @@ +A trying-to-be-complete list of prepositions in the language. Index: obj/abstract/language/English/extra_relatives.inf =================================================================== --- obj/abstract/language/English/extra_relatives.inf (revision 0) +++ obj/abstract/language/English/extra_relatives.inf (revision 0) @@ -0,0 +1,2 @@ +Any relative tags that should be recognized but don't belong in the +locational lists. Index: obj/abstract/language/English/indirect_object_extras =================================================================== --- obj/abstract/language/English/indirect_object_extras (revision 0) +++ obj/abstract/language/English/indirect_object_extras (revision 0) @@ -0,0 +1 @@ +io_preposition Index: obj/abstract/language/English/Makefile =================================================================== --- obj/abstract/language/English/Makefile (revision 0) +++ obj/abstract/language/English/Makefile (revision 0) @@ -0,0 +1,19 @@ +build:: prepositions relative_tags + +# Collect all the prepositions from the sub files +prepositions: behind_prepositions in_prepositions lie_prepositions on_prepositions sit_prepositions stand_prepositions under_prepositions + cat behind_prepositions in_prepositions \ + lie_prepositions on_prepositions sit_prepositions \ + stand_prepositions under_prepositions \ + extra_prepositions | sort | uniq >prepositions + +# Collect all the relative tags from the sub files +relative_tags: behind_relatives in_relatives lie_relatives on_relatives sit_relatives stand_relatives under_relatives + cat behind_relatives in_relatives \ + lie_relatives on_relatives sit_relatives \ + stand_relatives under_relatives \ + extra_relatives | sort | uniq >relative_tags + +clean:: + rm -f prepositions relative_tags +realclean:: Index: obj/abstract/language/English/behind_prepositions.inf =================================================================== --- obj/abstract/language/English/behind_prepositions.inf (revision 0) +++ obj/abstract/language/English/behind_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is behind something +else. Index: obj/abstract/language/English/description =================================================================== --- obj/abstract/language/English/description (revision 0) +++ obj/abstract/language/English/description (revision 0) @@ -0,0 +1 @@ +None yet. Index: obj/abstract/language/English/second_person_singular_pronoun =================================================================== --- obj/abstract/language/English/second_person_singular_pronoun (revision 0) +++ obj/abstract/language/English/second_person_singular_pronoun (revision 0) @@ -0,0 +1 @@ +you Index: obj/abstract/language/English/code.inf =================================================================== --- obj/abstract/language/English/code.inf (revision 0) +++ obj/abstract/language/English/code.inf (revision 0) @@ -0,0 +1 @@ +The language's ISO code (generally 2 or 3 letters). Index: obj/abstract/language/English/question_starter.inf =================================================================== --- obj/abstract/language/English/question_starter.inf (revision 0) +++ obj/abstract/language/English/question_starter.inf (revision 0) @@ -0,0 +1,2 @@ +The characters to put at the beginning of a question in this +language; used by the parser to build questions about objects. Index: obj/abstract/language/English/grammar =================================================================== --- obj/abstract/language/English/grammar (revision 0) +++ obj/abstract/language/English/grammar (revision 0) @@ -0,0 +1,315 @@ +#more or less #!/usr/bin/perl + +# This file contains the Parse::RecDescent grammar used by the parser to +# deconstruct imperative sentences. +# +# The resulting parser builds and returns a parse tree. +# The form of the tree is a list of hashes (sentences). +# The sentance hashes can have keys named verb, direct_object, +# indirect_object, do_preposition, io_preposition, and quote +# (and a couple more weird ones). +# +# Thank god for HyperGrammar! +# + +# Handle compound sentences, and multiple sentences too. +input: sentence (sentence_separator sentence)(s?) sentence_punct(?) + { $item[2] ? [ $item[1], @{$item[2]} ] : [ $item[1] ] } +sentence_separator: /$/ | sentence_punct(?) coordinating_conjunction(s) | sentence_punct + +# All the sentence forms. The ordering is quite important. I've tried to +# put the most commonly used forms first, so they'll be faster. Note that +# the use of lookahead is important in getting those fast, commonly-used +# forms to not match on subsets of longer sentences. +# +# Once each sentence is parsed, a call to $::lang_to_grammar{recent_obj}->() is made, +# passing in any recently referred to objects. This is generally used to +# set up the 'it' and 'them' prepositions, or similar. + +# Talking is quick to match. +sentence: verb quote ...sentence_separator + { { verb => $item[1], quote => $item[2] } } +# This form is used to invoke the name of an exit to use it. +# (It can also be used to answer some questions.) It needs to come before +# the verb direct_object form. Probably calling recent_obj here would just +# be confusing. +sentence: object ...sentence_separator + { { direct_object => $item[1] } } +# "sit down", "get up", etc. Has to come before the verb direct_object form. +sentence: verb preposition ...sentence_separator + { { verb => $item[1], preposition => $item[2] } } +# Probably the most common sentence form. +sentence: verb direct_object ...sentence_separator + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2] } } +# This form is used to "pick up foo", etc. +sentence: verb do_preposition direct_object ...sentence_separator + { $::lang_to_grammar{recent_obj}->(@{$item[3]}); + { verb => $item[1], do_preposition => $item[2], + direct_object => $item[3] } } +# This form is used in eg, "put it down" or "wind it up". +sentence: verb direct_object do_preposition ...sentence_separator + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], do_preposition => $item[3], + direct_object => $item[2] } } +# "put blah in foo", etc is quite common. +sentence: verb do_preposition(?) direct_object io_preposition(?) indirect_object + { $::lang_to_grammar{recent_obj}->(@{$item[3]}); # which object? Dunno. :-/ + { verb => $item[1], do_preposition => $item[2][0], + direct_object => $item[3], io_preposition => $item[4][0], + indirect_object => $item[5] } } +# Not exactly sentences per se, but support answers to recently asked +# questions. That generally involves picking a choice from a list or +# answers, either by name or number. Or it might involve referring to a +# particular object, or be a prepositional phrase. +sentence: article(?) answer(s) ...sentence_separator + { { answer => $item{'answer(s)'} } } +sentence: article(?) number ...sentence_separator + { { number => $item{number} } } +sentence: do_preposition object ...sentence_separator + { { direct_object => $item{object}, + do_preposition => $item{do_preposition} } } +# Simple commands are way up there too (but must come after the simple +# question answer forms). +sentence: verb ...sentence_separator + { { verb => $item[1] } } + +# This is a gross special case for a few commands that take a field as +# their last argument. +fieldverb: /(show|showall|set|unset|edit|delete|usage|help|go|list)\b/i +# A special terminator is needed to disambiguate from things like +# "show ball then drop it", where "then" could be misinterpreted as a +# field. +# Must come before the verb quote direct_object form. +sentence: fieldverb do_preposition(?) possessive_object field ...sentence_separator + { $::lang_to_grammar{recent_obj}->(@{$item[3]}); + { verb => $item[1], do_preposition => $item[2][0], + direct_object => $item[3], field => $item[4] } } +sentence: fieldverb do_preposition(?) possessive_object number field ...sentence_separator + { $::lang_to_grammar{recent_obj}->(@{$item[3]}); + { verb => $item[1], do_preposition => $item[2][0], + direct_object => $item[3], number => $item[4], field => $item[5] } } +# Used for the help command. +sentence: fieldverb do_preposition(?) field ...sentence_separator + { { verb => $item[1], do_preposition => $item[2][0], field => $item[3] } } + +# "say "blah" to him", "derive a "ball" from foo", etc. +# This is strictly speaking, an indirect object, not a direct object. +# However, it simplfies processing to treat it like a direct object. +sentence: verb do_preposition(?) article(?) quote io_preposition direct_object + { $::lang_to_grammar{recent_obj}->(@{$item[6]}); + { verb => $item[1], quote => $item[4], + do_preposition => $item[5], direct_object => $item[6] } } + +# Now some declarative sentence forms. Matching a possessive object is +# expensive, so do it only once. +sentence: possessive_object declaration + { $::lang_to_grammar{recent_obj}->(@{$item[1]}); + { direct_object => $item[1], %{$item[2]} } } + +# Stuff like "it's not hidden". +declaration: ess /\bnot\b/i field ...sentence_separator + { { verb => "is", field => $item[3], negated_verb => 1 } } +# "it's hidden", etc +declaration: ess field ...sentence_separator + { { verb => "is", field => $item[2] } } +# "I'm not benchmarked" +declaration: /'?m?\b/i /\bnot\b/i field ...sentence_separator + { { verb => "am", field => $item[3], negated_verb => 1 } } +# "I'm benchmarked" +declaration: /'?m?\b/i field ...sentence_separator + { { verb => "am", field => $item[2] } } +# Used, for example, to just say what a field's value is, to set it. +declaration: field verb quote + { { field => $item[1], verb => $item[2], quote => $item[3] } } +# Similar form can be used (by builders) to say that an object's field is a +# reference to another object. +declaration: field verb indirect_object + { { field => $item[1], verb => $item[2], indirect_object => $item[3] } } +# This is used to set metadata about fields. +declaration: field verb field number + { { field => $item[1], verb => $item[2], + metadata => $item[3], number => $item[4] } } +# Even a list of references could be set. +declaration: number field verb indirect_object + { { number => $item[1], field => $item[2], + verb => $item[3], indirect_object => $item[4] } } +# A number can also be given, if there are multiple values of a field. +declaration: number field verb quote + { { number => $item[1], field => $item[2], + verb => $item[3], quote => $item[4] } } +# This is used to set and unset boolean fields. +declaration: negated_verb field + { { verb => $item[1], field => $item[2], negated_verb => 1 } } +declaration: verb field + { { verb => $item[1], field => $item[2] } } + +# These forms are used by the signal command. +sentence: verb direct_object preposition(?) number + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2], number => $item[4] } } +sentence: verb direct_object quote preposition(?) number + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2], quote => $item[3], + number => $item[5] } } + +# And this is is used for dialing telephones. I suppose it could be used +# for signals too.. Like the verb quote direct_object form, the object is +# really indirect, but we'll call it the direct object for simplicity. +sentence: verb do_preposition(?) number io_preposition direct_object + { $::lang_to_grammar{recent_obj}->(@{$item[5]}); + { verb => $item[1], number => $item[3], + do_preposition => $item[4], direct_object => $item[5] } } + +# "call me "Fred"", "rename me to "Fred"", etc. Must come after the +# declarative forms, otherwise the quote matches too freely. +sentence: verb do_preposition(?) direct_object io_preposition(?) quote + { $::lang_to_grammar{recent_obj}->(@{$item[3]}); + { verb => $item[1], do_preposition => $item[2][0], + direct_object => $item[3], io_preposition => $item[4][0], + quote => $item[5] } } + +# This wacky form is used for digging. +sentence: verb quote io_preposition quote + { { verb => $item[1], quote => $item[2], io_preposition => $item[3], + quote2 => $item[4] } } # XXX there must be a better name than "quote2"? + +# These forms are used to do stuff with fields. +sentence: verb possessive_object field io_preposition quote + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2], + field => $item[3], quote => $item[5] } } +sentence: verb possessive_object field io_preposition indirect_object + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2], + field => $item[3], indirect_object => $item[5] } } +sentence: verb possessive_object number field io_preposition quote + { $::lang_to_grammar{recent_obj}->(@{$item[2]}); + { verb => $item[1], direct_object => $item[2], + number => $item[3], field => $item[4], quote => $item[6] } } + +# For the "language" command. +sentence: verb language preposition quote + { { verb => $item[1], language => $item[2], preposition => $item[3], + quote => $item[4] } } +sentence: verb language + { { verb => $item[1], language => $item[2] } } + +# For the eval command. +sentence: verb quote io_preposition field ...sentence_separator + { { verb => $item[1], quote => $item[2], io_preposition => $item[3], + field => $item[4] } } + +# This is a repeat of the simple sentence form, but it does not require an +# obvious separator. The only reason for this is to make reinjection work +# for stuff like "say hi" -- this parses the verb, then the "hi" is quoted +# and the lot is re-injected. +# This should be the last sentence type listed. +sentence: verb + { { verb => $item[1] } } + +# End of the entences, now on to the parts of speech.. + +direct_object: objectlist +indirect_object: object +# Allows for multiple prepositions to be used before a direct or +# indirect object. They are joined together into one. +do_preposition: preposition(s) + { join(" ", @{$item[1]}) } +io_preposition: preposition(s) + { join(" ", @{$item[1]}) } +objectlist: object (/(?:(?:,\s*)?and|,)/ object)(s?) + # Flatten the nested lists into one list ref. + { [ $item[2] ? ( @{$item[1]}, map { @{$_} } @{$item[2]} ) : @{$item[1]} ] } + +# "foo's bar" +object: basic_object ess object + { &::is_obj_in_obj($item[3], "", $item[1]) } +# "my bar" +object: basic_object object + { &::is_obj_in_obj($item[2], "", $item[1]) } +# "bar which is in foo". +object: basic_object relative_tag object + { &::is_obj_in_obj($item[1], $item[2], $item[3]) } +# Quantifying the number of objects expected can resolve possible +# ambiguities. +object: /(a\b)?/ quantifier /(of\b)?/ object + { &::check_quantification($item{quantifier}, $item{object}) } +# Must some after the quantified object test, because "all" could be part +# of a quantification, or a preposition. +object: basic_object +# Another form of quantification, a trifle expensive. +object: number /(of)?/ basic_object + { &::check_quantification($item{number}, $item{basic_object}) } + +possessive_object: object ess + { $item[1] } + +# This is the set of simple ways to refer to an object, and is used as the +# base for both regular and possessive forms of objects. +basic_object: pronoun + { &::lookup_pronoun($item{pronoun}) } +basic_object: article(?) /mooix:([^ ]+)/ + { &::lookup_reference($1) } +basic_object: article(?) adjectivelist noun + { &::lookup_noun($item{noun}, $item{adjectivelist}) } +# This version is needed for cases like 'red guest', where red is a known +# adjective, but it's actually being used as part of the noun instead. +basic_object: article(?) noun + { &::lookup_noun($item{noun}) } +# A production without the article in front, in case the noun seems to strt +# with an article (probably due to user confusion). +basic_object: noun + { &::lookup_noun($item{noun}) } + +adjectivelist: + +language: /($::languages)\b/i + +number: /[-+.\w]+\b/ + # lookup_number is passed a textual representation of a number, and + # should return the number so represented, or undef on error + { { $::lang_to_grammar{lookup_number}->($item[1]) } } + +# Single or double quoted text. Allow the closing quote to be left off, if +# the text extends to end of string without one. This also recognizes stuff +# bracketed by {..} as a quote. This special style is used by the shortcuts +# substitutions, to unambiguously quote text that may contain other quote +# characters. Quotes can have a comma before them. +quote: /\\?/ /\s*{(.*)}/ { $1 } +quote: /\\?/ /\s*(?:'([^']*)(?:'|$))/ { $1 } +quote: /\\?/ /\s*(?:"([^"]*)(?:"|$))/ { $1 } +## used to be: quote: /,?\s*(?:"([^"]*)(?:"|$)|{(.*)})/ { $1.$2 } +# Things like object field names. Note that they cannot end in a period; +# that would be ambiguous with a period at the end of a sentence. +field: /[-_.+A-Za-z0-9]*[-_+A-Za-z0-9]/ + +# This only works for verbs like 'is' in declarative sentence forms. +negated_verb: verb /not\b/i + { $item[1] } +negated_verb: /($::verbs)n't\b/i + { $1 } + +# Some of the parts of speech are broken out into variables in main; +# these variables must be defined before asking the parser to parse +# something, and can be changed as needed between parsings w/o rebuilding +# the whole parser. This makes it easy to eg, populate $::nouns with all +# the names of all the objects the user could refer to. Set the variables +# to compiled regexp's, that | together the possibilities. Like: +# $::nouns=qr/cat|dog/; +preposition: /($::prepositions)\b/i +relative_tag: /($::relative_tags)\b/i +adjective: /($::adjectives)\b/i +noun: /($::nouns)\b/i +verb: /($::verbs)\b/i +# The \b is necessary, since "i" is a pronoun, and that could match at the +# start of other words. +pronoun: /($::pronouns)\b/i +# Matches answers to a recent question. +answer: /($::answers)/i +quantifier: /($::quantifiers)/i + +article: /(an|a|the)\b/i +coordinating_conjunction: /(and|then|next)\b/i +ess: /'?s?\b/i +sentence_punct: /[,;.!]+/ Index: obj/abstract/language/English/direct_object_extras =================================================================== --- obj/abstract/language/English/direct_object_extras (revision 0) +++ obj/abstract/language/English/direct_object_extras (revision 0) @@ -0,0 +1 @@ +do_preposition Index: obj/abstract/language/English/all_pronouns.inf =================================================================== --- obj/abstract/language/English/all_pronouns.inf (revision 0) +++ obj/abstract/language/English/all_pronouns.inf (revision 0) @@ -0,0 +1,3 @@ +Hold those pronouns that match the concept of "all", as in "affect +absolutely everything". In English these are "all" and +"everything". Index: obj/abstract/language/English/lie_prepositions =================================================================== --- obj/abstract/language/English/lie_prepositions (revision 0) +++ obj/abstract/language/English/lie_prepositions (revision 0) @@ -0,0 +1,5 @@ +on +on top of +top +of +down on Index: obj/abstract/language/English/stand_relatives =================================================================== --- obj/abstract/language/English/stand_relatives (revision 0) +++ obj/abstract/language/English/stand_relatives (revision 0) @@ -0,0 +1,3 @@ +which is standing on +who is standing on +that is standing on Index: obj/abstract/language/English/prompt.inf =================================================================== --- obj/abstract/language/English/prompt.inf (revision 0) +++ obj/abstract/language/English/prompt.inf (revision 0) @@ -0,0 +1 @@ +The prompt to present to the user, if not over-ridden. Index: obj/abstract/language/English/pronouns.inf =================================================================== --- obj/abstract/language/English/pronouns.inf (revision 0) +++ obj/abstract/language/English/pronouns.inf (revision 0) @@ -0,0 +1,2 @@ +This field needs to have a list of every pronoun the parser will +recognize. Index: obj/abstract/language/English/question_ender.inf =================================================================== --- obj/abstract/language/English/question_ender.inf (revision 0) +++ obj/abstract/language/English/question_ender.inf (revision 0) @@ -0,0 +1,2 @@ +The characters to put at the end of a question in this language; +used by the parser to build questions about objects. Index: obj/abstract/language/English/list_seperator =================================================================== --- obj/abstract/language/English/list_seperator (revision 0) +++ obj/abstract/language/English/list_seperator (revision 0) @@ -0,0 +1 @@ +, Index: obj/abstract/language/English/duration.inf =================================================================== --- obj/abstract/language/English/duration.inf (revision 0) +++ obj/abstract/language/English/duration.inf (revision 0) @@ -0,0 +1,7 @@ +Prints out the given time in an appropriate natural language format. + +Parameters: + + idletime + + The amount of seconds to print out an idle time for. Index: obj/abstract/language/English/here_pronouns.inf =================================================================== --- obj/abstract/language/English/here_pronouns.inf (revision 0) +++ obj/abstract/language/English/here_pronouns.inf (revision 0) @@ -0,0 +1 @@ +A list of pronouns that match the concept of "here". Index: obj/abstract/language/English/relative_ender.inf =================================================================== --- obj/abstract/language/English/relative_ender.inf (revision 0) +++ obj/abstract/language/English/relative_ender.inf (revision 0) @@ -0,0 +1 @@ +The characters with which to end a relative clause in this language. Index: obj/abstract/language/English/relative_tags.inf =================================================================== --- obj/abstract/language/English/relative_tags.inf (revision 0) +++ obj/abstract/language/English/relative_tags.inf (revision 0) @@ -0,0 +1 @@ +A list of all relative clause bits (i.e. the stuff in *_relatives). Index: obj/abstract/language/English/on_relatives.inf =================================================================== --- obj/abstract/language/English/on_relatives.inf (revision 0) +++ obj/abstract/language/English/on_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is on the +couch", "which is on" is what goes in this file. Index: obj/abstract/language/English/under_relatives.inf =================================================================== --- obj/abstract/language/English/under_relatives.inf (revision 0) +++ obj/abstract/language/English/under_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +under something else; in "look at the ball which is under the +couch", "which is under" is what goes in this file. Index: obj/abstract/language/English/cmd_parse_command.inf =================================================================== --- obj/abstract/language/English/cmd_parse_command.inf (revision 0) +++ obj/abstract/language/English/cmd_parse_command.inf (revision 0) @@ -0,0 +1,2 @@ +Holds the name of the grammatical element output by the parser that +should be matched to the name of .cmd files. Index: obj/abstract/language/English/behind_relatives =================================================================== --- obj/abstract/language/English/behind_relatives (revision 0) +++ obj/abstract/language/English/behind_relatives (revision 0) @@ -0,0 +1,3 @@ +which is behind +who is behind +that is behind Index: obj/abstract/language/English/indefinate_article =================================================================== --- obj/abstract/language/English/indefinate_article (revision 0) +++ obj/abstract/language/English/indefinate_article (revision 0) @@ -0,0 +1 @@ +a Index: obj/abstract/language/English/question_word_indirect_object =================================================================== --- obj/abstract/language/English/question_word_indirect_object (revision 0) +++ obj/abstract/language/English/question_word_indirect_object (revision 0) @@ -0,0 +1 @@ +where Index: obj/abstract/language/English/sit_relatives =================================================================== --- obj/abstract/language/English/sit_relatives (revision 0) +++ obj/abstract/language/English/sit_relatives (revision 0) @@ -0,0 +1,3 @@ +which is sitting on +who is sitting on +that is sitting on Index: obj/abstract/language/English/sit_prepositions =================================================================== --- obj/abstract/language/English/sit_prepositions (revision 0) +++ obj/abstract/language/English/sit_prepositions (revision 0) @@ -0,0 +1,3 @@ +down on +on +down Index: obj/abstract/language/English/grammar_variables =================================================================== --- obj/abstract/language/English/grammar_variables (revision 0) +++ obj/abstract/language/English/grammar_variables (revision 0) @@ -0,0 +1,195 @@ +# This stuff is directly included by the parser, so it has access to all parser +# variables and such like. + +# Given a number representation (which might be the raw number, or the +# written-out form, or some ordinal form), return the number it +# represents, or undef if none. +my $word2num_loaded=0; +sub lookup_number { #{{{ + my $word=shift; + if (! $word2num_loaded) { + # Try to use Lingua::EN::Words2Nums, but don't depend + # on it being installed. + eval "use Lingua::EN::Words2Nums"; + if ($@) { + # Install stub function that only does simple numbers. + *::words2nums = sub { + $_ = shift; + return $1 if /^(\d+)(?:st|nd|rd|th)?$/; + return; + }; + } + $word2num_loaded=1; + } + # This is a hack, for "next alias is" type of things. + return 9999 if lc $word eq 'next'; + return words2nums($word); +} #}}} + + +# Called by the grammar to point out recently referred to objects that may +# set the 'it' pronoun, etc. Pass in a list of objects. +sub recent_obj { #{{{ + my @objs = @_; + if (@objs == 1) { + # Don't set "it" if the caller talks about themself. + $pronouns{that} = $pronouns{thats} = $pronouns{it} = + $pronouns{its} = \@objs + unless $objs[0] == $caller; + my $gender=$objs[0]->gender; + if ($gender) { + $pronouns{$gender->object_pronoun} = \@objs; + } + $pronouns + } + elsif (@objs) { + # TODO To be strictly correct, I should only set 'these' and + # 'those' if all the objects are not people, and always set + # 'them'. + $pronouns{these} = $pronouns{those} = $pronouns{them} = + $pronouns{their} = \@objs; + } +} #}}} + + +# Given a number or one of a few known words that can be used to quantify a +# set of objects, and an array of objects that might be meant, returns +# either undef if the two don't make sense together, or an array of +# unambiguously quantified objects. +sub check_quantification { #{{{ + my $quant = lc(shift); + my @objs = @{shift()}; + + if ($quant eq 'all' || $quant eq 'every') { + # easy enough; all match + } + elsif ($quant eq 'both') { + # so there must be exactly two objects + if (@objs > 2) { + $failreason = "There are more than two."; + return; + } + elsif (@objs < 2) { + $failreason = "There is only one."; + return; + } + } + elsif ($quant eq 'any' || $quant eq 'either' || $quant eq 'either one') { + # pick one of the objects at random, ditch the rest + @objs=$objs[rand @objs] + } + elsif ($quant eq 'several') { + # "Consisting of a number more than two, but not very many" + # -- websters + # TODO I should really permute the array first. Same with + # next two elsifs. + my $num=3 + rand(2); # 3 to 5 + @objs=grep { $_ } @objs[0..$num - 1]; + } + elsif ($quant eq 'some') { + # Whatever, between a third and a fifth? + my $num = @objs / (3 + rand(2)); + if ($num < 2) { $num = 2 } + @objs=grep { $_ } @objs[0..$num - 1]; + } + elsif ($quant eq 'most') { + @objs=grep { $_ } @objs[0..$#objs / 0.9]; + } + elsif ($quant eq 'couple' || $quant eq 'few') { + # Take two. + @objs=grep { $_ } @objs[0..1]; + } + elsif ($quant + 0 != 0) { + if ($quant > @objs) { + $failreason="There ".(@objs == 1 ? "is" : "are"). + " only ".scalar @objs."."; + return; + } + @objs=@objs[0..$quant - 1]; + } + else { + return; + } + + # Quantifying objects disambiguates them. + map { delete $_->[ISAMB] } @objs; + return \@objs; +} #}}} + +# Unset the ISREF field, it is no longer relevant if the +# object is nearby now. This takes care of 'teleport mooix:foo +# here and look at it'. +sub reset_it +{ + if ($pronouns{it} && grep { $pronouns{it}->[0] == $_ } @nearbyobjs) + { + $pronouns{it}->[0]->[ISREF] = undef; + } +} + +# Build a regex for nouns. +sub build_nouns +{ + $nouns=genregex(keys %nametoobj); +} + + + +# Provide completions for the prompt +sub completions +{ + return join('|', + $caller->language->here_pronouns, + $caller->language->all_pronouns, + grep { $_ ne 'i' } keys %pronouns + ); +} + +# Clean those things out of %remains in checkproto for which the +# existence of them shouldn't invalidate a match. +sub clean_remains +{ + my $command = shift; + my $remains = shift; + + if( ! defined( $remains->{do_preposition} ) ) + { + #print STDERR "Deleting do_prep.\n"; + delete $remains->{do_preposition}; + } + + if( ! defined( $remains->{io_preposition} ) ) + { + #print STDERR "Deleting io_prep.\n"; + delete $remains->{io_preposition}; + } +} + +# Clean up the names of parts of speech as used in .cmd files to be +# more human-readable. Takes on at a time. +sub clean_incomplete +{ + $_ = shift; + + if( m/do_preposition/ ) { + return "preposition for the direct object"; + } elsif( m/io_preposition/ ) { + return "preposition for the indirect object"; + } else { + return $_; + } +} + +$quantifiers=genregex(qw{all both any every several some few couple most either}, "either one"); + +$pronouns{me} = $pronouns{my} = $pronouns{myself} = $pronouns{i} = [$caller]; + +$lang_to_grammar{lookup_number} = \&lookup_number; +$lang_to_grammar{recent_obj} = \&recent_obj; + +my @langs = + map{ $caller->dexml( avatar => $caller, text => $_->name ) } + map { s/^mooix://; $caller->get( $_ ) } + $Mooix::Root->abstract->language->languages->list; + +$lang_to_grammar{languages} = \@langs; Property changes on: obj/abstract/language/English/grammar_variables ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/language/English/name =================================================================== --- obj/abstract/language/English/name (revision 0) +++ obj/abstract/language/English/name (revision 0) @@ -0,0 +1 @@ +Englishgliban Index: obj/abstract/language/English/definate_article =================================================================== --- obj/abstract/language/English/definate_article (revision 0) +++ obj/abstract/language/English/definate_article (revision 0) @@ -0,0 +1 @@ +the Index: obj/abstract/language/English/cmd_parse_object =================================================================== --- obj/abstract/language/English/cmd_parse_object (revision 0) +++ obj/abstract/language/English/cmd_parse_object (revision 0) @@ -0,0 +1,2 @@ +direct_object +indirect_object Index: obj/abstract/language/English/in_relatives =================================================================== --- obj/abstract/language/English/in_relatives (revision 0) +++ obj/abstract/language/English/in_relatives (revision 0) @@ -0,0 +1,6 @@ +which is in +which is inside +who is in +who is inside +that is in +that is inside Index: obj/abstract/language/English/indirect_object_extras.inf =================================================================== --- obj/abstract/language/English/indirect_object_extras.inf (revision 0) +++ obj/abstract/language/English/indirect_object_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/English/under_prepositions =================================================================== --- obj/abstract/language/English/under_prepositions (revision 0) +++ obj/abstract/language/English/under_prepositions (revision 0) @@ -0,0 +1,3 @@ +under +underneath +below Index: obj/abstract/language/English/upper_case_initial =================================================================== --- obj/abstract/language/English/upper_case_initial (revision 0) +++ obj/abstract/language/English/upper_case_initial (revision 0) @@ -0,0 +1 @@ +1 Index: obj/abstract/language/English/second_person_singular_pronoun.inf =================================================================== --- obj/abstract/language/English/second_person_singular_pronoun.inf (revision 0) +++ obj/abstract/language/English/second_person_singular_pronoun.inf (revision 0) @@ -0,0 +1 @@ +Contains the part of speech, i.e. "you" in English. Index: obj/abstract/language/English/holding_postfix =================================================================== --- obj/abstract/language/English/holding_postfix (revision 0) +++ obj/abstract/language/English/holding_postfix (revision 0) @@ -0,0 +1 @@ + you're holding Index: obj/abstract/language/English/grammar.inf =================================================================== --- obj/abstract/language/English/grammar.inf (revision 0) +++ obj/abstract/language/English/grammar.inf (revision 0) @@ -0,0 +1,2 @@ +This is a Parse::RecDescent grammar for parsing imperative English +sentences. Index: obj/abstract/language/English/direct_object_extras.inf =================================================================== --- obj/abstract/language/English/direct_object_extras.inf (revision 0) +++ obj/abstract/language/English/direct_object_extras.inf (revision 0) @@ -0,0 +1,3 @@ +This part is used by the parser to grab extra fields associated with +the object, like the associated preposition, for use in presenting +questions to the user. Index: obj/abstract/language/English/lie_prepositions.inf =================================================================== --- obj/abstract/language/English/lie_prepositions.inf (revision 0) +++ obj/abstract/language/English/lie_prepositions.inf (revision 0) @@ -0,0 +1 @@ +A list of prepositions that fit when someone is lying on an object. Index: obj/abstract/language/English/stand_relatives.inf =================================================================== --- obj/abstract/language/English/stand_relatives.inf (revision 0) +++ obj/abstract/language/English/stand_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +standing on something else; in "look at the user which is standing +on the couch", "which is standing on" is what goes in this file. Index: obj/abstract/language/English/prepositions.inf =================================================================== --- obj/abstract/language/English/prepositions.inf (revision 0) +++ obj/abstract/language/English/prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +This field needs to have a list of every preposition the parser will +recognize. Index: obj/abstract/language/English/list_seperator.inf =================================================================== --- obj/abstract/language/English/list_seperator.inf (revision 0) +++ obj/abstract/language/English/list_seperator.inf (revision 0) @@ -0,0 +1,2 @@ +The characters used to seperate elements of a list in this language, +including spaces. Index: obj/abstract/language/English/help_basics =================================================================== --- obj/abstract/language/English/help_basics (revision 0) +++ obj/abstract/language/English/help_basics (revision 0) @@ -0,0 +1 @@ +basics Index: obj/abstract/language/English/help_index =================================================================== --- obj/abstract/language/English/help_index (revision 0) +++ obj/abstract/language/English/help_index (revision 0) @@ -0,0 +1 @@ +index Index: obj/abstract/language/English/help_missing =================================================================== --- obj/abstract/language/English/help_missing (revision 0) +++ obj/abstract/language/English/help_missing (revision 0) @@ -0,0 +1 @@ +missing Index: obj/abstract/language/English/list_seperator_last =================================================================== --- obj/abstract/language/English/list_seperator_last (revision 0) +++ obj/abstract/language/English/list_seperator_last (revision 0) @@ -0,0 +1 @@ +, and Index: obj/abstract/language/English/behind_relatives.inf =================================================================== --- obj/abstract/language/English/behind_relatives.inf (revision 0) +++ obj/abstract/language/English/behind_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is behind the +couch", "which is behind" is what goes in this file. Index: obj/abstract/language/English/question_word_direct_object =================================================================== --- obj/abstract/language/English/question_word_direct_object (revision 0) +++ obj/abstract/language/English/question_word_direct_object (revision 0) @@ -0,0 +1 @@ +what Index: obj/abstract/language/English/in_prepositions =================================================================== --- obj/abstract/language/English/in_prepositions (revision 0) +++ obj/abstract/language/English/in_prepositions (revision 0) @@ -0,0 +1,11 @@ +inside +in +into +within +in to +to +out of +out +of +from out of +from Index: obj/abstract/language/English/indefinate_article.inf =================================================================== --- obj/abstract/language/English/indefinate_article.inf (revision 0) +++ obj/abstract/language/English/indefinate_article.inf (revision 0) @@ -0,0 +1 @@ +Lists the language's indefinate article(s), i.e. "a". Index: obj/abstract/language/English/question_word_indirect_object.inf =================================================================== --- obj/abstract/language/English/question_word_indirect_object.inf (revision 0) +++ obj/abstract/language/English/question_word_indirect_object.inf (revision 0) @@ -0,0 +1,2 @@ +The question word to present to the user when asking questions about +this part of speech. Index: obj/abstract/language/English/lie_relatives =================================================================== --- obj/abstract/language/English/lie_relatives (revision 0) +++ obj/abstract/language/English/lie_relatives (revision 0) @@ -0,0 +1,3 @@ +which is lying on +who is lying on +that is lying on Index: obj/abstract/language/English/stand_prepositions =================================================================== --- obj/abstract/language/English/stand_prepositions (revision 0) +++ obj/abstract/language/English/stand_prepositions (revision 0) @@ -0,0 +1,4 @@ +on +on top of +top +of Index: obj/abstract/language/English/sit_prepositions.inf =================================================================== --- obj/abstract/language/English/sit_prepositions.inf (revision 0) +++ obj/abstract/language/English/sit_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is sitting on +something else. Index: obj/abstract/language/English/sit_relatives.inf =================================================================== --- obj/abstract/language/English/sit_relatives.inf (revision 0) +++ obj/abstract/language/English/sit_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +sitting on something else; in "look at the user which is sitting on +the couch", "which is sitting on" is what goes in this file. Index: obj/abstract/language/English/grammar_variables.inf =================================================================== --- obj/abstract/language/English/grammar_variables.inf (revision 0) +++ obj/abstract/language/English/grammar_variables.inf (revision 0) @@ -0,0 +1,3 @@ +Called by the parser to set up variables for the parser's use in a +way appropriate to this language. Runs in the parser's context. +Mostly sets elements of %lang_to_grammar. Index: obj/abstract/language/English/on_prepositions =================================================================== --- obj/abstract/language/English/on_prepositions (revision 0) +++ obj/abstract/language/English/on_prepositions (revision 0) @@ -0,0 +1,4 @@ +on +on top of +top +of Index: obj/abstract/language/English/definate_article.inf =================================================================== --- obj/abstract/language/English/definate_article.inf (revision 0) +++ obj/abstract/language/English/definate_article.inf (revision 0) @@ -0,0 +1 @@ +Lists the language's definate article(s), i.e. "the". Index: obj/abstract/language/English/cmd_parse_object.inf =================================================================== --- obj/abstract/language/English/cmd_parse_object.inf (revision 0) +++ obj/abstract/language/English/cmd_parse_object.inf (revision 0) @@ -0,0 +1,2 @@ +Lists those parts of speech that should be considered by the parser +to correspond to objects in the room. Index: obj/abstract/language/English/in_relatives.inf =================================================================== --- obj/abstract/language/English/in_relatives.inf (revision 0) +++ obj/abstract/language/English/in_relatives.inf (revision 0) @@ -0,0 +1,3 @@ +A list of relative clause starters that match when something is +behind something else; in "look at the ball which is inside the +couch", "which is inside" is what goes in this file. Index: obj/abstract/language/English/extra_prepositions =================================================================== --- obj/abstract/language/English/extra_prepositions (revision 0) +++ obj/abstract/language/English/extra_prepositions (revision 0) @@ -0,0 +1,60 @@ +as +about +above +across +after +against +along +among +around +at +before +behind +below +beneath +beside +between +beyond +but +by +despite +down +during +except +for +from +inside +into +in +like +near +off +of +onto +on +outside +out +over +past +since +throughout +through +till +toward +to +underneath +under +until +upon +up +within +without +with +called +named +held +carried +away +using +front +top Index: obj/abstract/language/English/extra_relatives =================================================================== Index: obj/abstract/language/English/under_prepositions.inf =================================================================== --- obj/abstract/language/English/under_prepositions.inf (revision 0) +++ obj/abstract/language/English/under_prepositions.inf (revision 0) @@ -0,0 +1,2 @@ +A list of prepositions that fit when something is under something +else. Index: obj/abstract/language/English/behind_prepositions =================================================================== --- obj/abstract/language/English/behind_prepositions (revision 0) +++ obj/abstract/language/English/behind_prepositions (revision 0) @@ -0,0 +1 @@ +behind Index: obj/abstract/language/English/code =================================================================== --- obj/abstract/language/English/code (revision 0) +++ obj/abstract/language/English/code (revision 0) @@ -0,0 +1 @@ +en Index: obj/abstract/language/English/upper_case_initial.inf =================================================================== --- obj/abstract/language/English/upper_case_initial.inf (revision 0) +++ obj/abstract/language/English/upper_case_initial.inf (revision 0) @@ -0,0 +1,2 @@ +Set to 0 if the language does not always upper-case the first letter +of sentences, 1 if it does. Index: obj/abstract/language/English/holding_postfix.inf =================================================================== --- obj/abstract/language/English/holding_postfix.inf (revision 0) +++ obj/abstract/language/English/holding_postfix.inf (revision 0) @@ -0,0 +1,2 @@ +Used by the parser to print out questions about what the user is +holding. Index: obj/abstract/language/English/all_pronouns =================================================================== --- obj/abstract/language/English/all_pronouns (revision 0) +++ obj/abstract/language/English/all_pronouns (revision 0) @@ -0,0 +1,2 @@ +everything +all Index: obj/abstract/language/English/question_starter =================================================================== Index: obj/abstract/language/parent.lnk =================================================================== --- obj/abstract/language/parent.lnk (revision 0) +++ obj/abstract/language/parent.lnk (revision 0) @@ -0,0 +1 @@ +../../concrete/thing Index: obj/abstract/builder/unset.hlp =================================================================== --- obj/abstract/builder/unset.hlp (revision 23) +++ obj/abstract/builder/unset.hlp (working copy) @@ -1,13 +0,0 @@ -Unsetting fields. - -This command is used to unset a field, if the field is not being inherited -from the parent. After unsetting a field, the parent's value of that -field (if there is one) will be inherited (see =inheritance= for details), -so this doesn't necessarily clear a field. - - > unset my description - -If the field has a list of values, this command can also be used to remove -a single item from the list. Just include the number of the item to remove. - - > unset my second alias Index: obj/abstract/builder/safechange_bad_object_id.msg =================================================================== --- obj/abstract/builder/safechange_bad_object_id.msg (revision 0) +++ obj/abstract/builder/safechange_bad_object_id.msg (revision 0) @@ -0,0 +1 @@ +session: Bad object id. Index: obj/abstract/builder/signal_limits.msg =================================================================== --- obj/abstract/builder/signal_limits.msg (revision 0) +++ obj/abstract/builder/signal_limits.msg (revision 0) @@ -0,0 +1 @@ +session: As a builder, you're limited to signals $sigterm and $sigkill. Index: obj/abstract/builder/safechange =================================================================== --- obj/abstract/builder/safechange (revision 23) +++ obj/abstract/builder/safechange (working copy) @@ -40,7 +40,7 @@ } my $ret=validate($this, $field, $object, \%params); if (length $ret) { - push @ret, (0, "$object->$field\: $ret"); + push @ret, (0, $ret); if ($field eq 'parent') { # Failed to create an object. Keep the # @objs list consistent. @@ -146,18 +146,18 @@ if ($field eq 'parent') { if (! ref $params->{value} || ! @{$params->{value}}) { - return "Parent object not specified."; + return 'safechange_no_parent'; } my $parent = @{$params->{value}}[0]; if (! ref $parent) { - return "Bad parent object."; + return 'safechange_bad_parent'; } #ifndef programmer if ($parent->isa(getavatar())) { - return "You cannot create avatars."; + return 'safechange_fail_avatar'; } #endif @@ -168,11 +168,11 @@ my ($edir, $hint) = splitid($obj); if (! defined $edir || ! defined $hint || ! length $edir || ! length $hint) { - return "Bad object id."; + return 'safechange_bad_object_id'; } my $encapsulator = Mooix::Thing->get($edir); if (! ref $encapsulator) { - return "Bad object id."; + return 'safechange_bad_object_id'; } #ifndef programmer @@ -184,7 +184,7 @@ $o=$o->encapsulator; } if (! ref $o) { - return "You can only create new objects in your portfolio."; + return 'safechange_create_not_portfolio'; } #endif @@ -200,14 +200,14 @@ # The new field should not already exist. if ($obj->defines($field)) { - return "Object already exists."; + return 'safechange_object_already'; } # If a parent has a field by this name, it # must be an object too. $file = $obj->fieldfile($field); unless (defined $file && -x $file && -d $file && -e "$file/.mooix") { - return "Cannot replace an inherited field with an object."; + return 'safechange_field_to_object'; } # No inheritance, because an object is @@ -220,11 +220,11 @@ #ifndef programmer # Slightly over-strict. if ($encapsulator != $portfolio) { - return "newid used for encapsulator != portfolio"; + return 'safechange_create_not_portfolio'; } #endif if (! $encapsulator->isa($Mooix::Root->abstract->thingset)) { - return "newid used for object not a thingset"; + return 'safechange_newid_not_thingset'; } return ""; # valid; skip rest of unnecessary checks } @@ -235,12 +235,12 @@ # too many locking issues in doing it safely. The # reparent_verb knows how it was called and can do # locking safely. - return "Use the reparent command to change an object's parent."; + return 'safechange_no_reparent'; } } if (! ref $obj) { - return "Expected an object reference, but got a string ($obj)."; + return 'safechange_string_not_ref'; } @@ -252,13 +252,13 @@ # the current field (probably inherited) is # already a reference. if ($obj == $this) { - return "Cannot modify one of your avatar's references."; + return 'safechange_fail_avatar_ref'; } if (! defined $file) { - return "Cannot create a new sticky reference list."; + return 'safechange_fail_ref_list'; } if (! -k $file && ! (-l $file && -d $file)) { - return "Cannot turn a field into a sticky reference list."; + return 'safechange_field_to_ref_list'; } #endif } @@ -269,13 +269,13 @@ # permissions cannot be changed, and this check # prevents unreadable files from being set up. if ((oct($params->{mode}) & ~07000) < 0400) { - return "The requested mode is not allowed."; + return 'safechange_bad_mode'; } #ifndef programmer # Check for executable, setuid, setgid. if ((oct($params->{mode}) & ~00666) > 0) { - return "Invalid mode."; + return 'safechange_bad_mode'; } # Let's not allow removal of the executable, setuid, @@ -283,10 +283,10 @@ if (defined $file) { my $mode=(stat($file))[2] & 01777; if (! $mode) { - return "Permission denied."; + return 'safechange_fail_perm'; } if (($mode & ~00666) > 0) { - return "You cannot change the permissions of a method."; + return 'safechange_fail_method_perms'; } } #endif @@ -297,15 +297,15 @@ #ifndef programmer if ($obj->can($field) || (defined $file && -f $file && -x $file)) { - return "You cannot unset a method."; + return 'safechange_fail_unset_method'; } #endif if (! $obj->defines($field)) { if ($obj->fieldfile($field)) { - return "That field is inherited."; + return 'safechange_fail_inherited'; } else { - return "That field is not set."; + return 'safechange_fail_not_set'; } } } @@ -326,50 +326,50 @@ #ifndef programmer if ($field =~ /^[_.].*-(safe|opaque)$/) { - return "Permission denied."; + return 'safechange_fail_perm'; } if ($field =~ /^[_.]/ && defined $file) { - return "You cannot change private fields."; + return 'safechange_fail_private'; } if ($field =~ /\// || $field eq '..') { - return "Nothing doing!"; + return 'safechange_fail_dir_chars'; } if ($obj == $this && defined $file && (-d $file || -k $file)) { - return "You cannot change one of your own reference fields."; + return 'safechange_change_own_ref'; } if ($obj == $this && ref $params->{value} && grep ref, @{$params->{value}}) { - return "You cannot set references on your avatar."; + return 'safechange_fail_own_ref'; } my $safefield=".$field-safe"; if (defined $file && -f $file && -x $file) { # They're trying to set a method.. if (! $obj->$safefield) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } if (defined $params->{mode}) { - return "Cannot change the mode of a method."; + return 'safechange_fail_change_method_mode'; } if ($params->{noexec}) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } } else { # Notice if there's a .field-safe with a false value. my $safefile=$obj->fieldfile($safefield); if (defined $safefile && -e $safefile && ! $obj->$safefield) { - return "You cannot change that field."; + return 'safechange_fail_not_safe'; } } # Perl internal methods.. if ($obj->can($field)) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } if (defined $file && -l $file) { @@ -377,11 +377,11 @@ # value must also be a reference. if (! ref $params->{value} || grep ! ref, @{$params->{value}}) { - return "Cannot convert a reference to a string."; + return 'safechange_string_to_ref'; } } elsif (defined $file && -e $file && ! -f $file) { - return "You cannot change that field, whatever it is."; + return 'safechange_fail_change_unknown'; } #endif } @@ -425,7 +425,7 @@ push @objs, ref $obj ? $obj : undef; if (! ref $obj) { - return 0, "Failed to create object."; + return 0, 'safechange_fail_object_creation'; } # Don't fall through to the mode setting code below; @@ -446,7 +446,7 @@ my $file=$obj->id."/".$field; if (defined $file && -e $file) { $obj->deletefield($field) || - return 0, "Permission denied."; + return 0, 'safechange_fail_perm'; } $ret=''; } @@ -468,7 +468,7 @@ $?=0; $ret=eval { $obj->$field(@{$params->{value}}) }; if ($@) { - return 0, "Permission denied."; + return 0, 'safechange_fail_perm'; } } else { @@ -477,7 +477,7 @@ } } if ($?) { - return 0, "Permission denied."; + return 0, 'safechange_fail_perm'; } } @@ -491,7 +491,7 @@ if (defined $params->{mode}) { if (! $obj->setmode(field => $field, mode => $params->{mode})) { - return 0, "Unable to set mode of $field."; + return 0, 'safechange_unable_mode'; } $ret=$params->{mode} unless defined $ret; } Index: obj/abstract/builder/show_none.msg =================================================================== --- obj/abstract/builder/show_none.msg (revision 0) +++ obj/abstract/builder/show_none.msg (revision 0) @@ -0,0 +1 @@ +session: No such category or field. Index: obj/abstract/builder/door.hlp =================================================================== --- obj/abstract/builder/door.hlp (revision 23) +++ obj/abstract/builder/door.hlp (working copy) @@ -1,48 +0,0 @@ -Doors. - -A door is a special kind of exit that can be open and shut, and maybe -locked with a key. A door is actually two exits linked via their otherside -fields. If you want to make a lot of rooms all connected by doors, see -=terrain=. If you have just dug one room and want to make the exit to it a -door, just reparent the exits to and from the room to mooix:concrete/door. - -A door can be opened and closed in the ways you would expect. It is also -possible to set up a door so it can be locked. Some doors must be locked -with a key, while others can be locked on one side by some manual means, -and others cannot be locked at all (the default). - -To make one side of a door lockable by manual means, set its manuallock -field. - - > the door's manuallock is "1" - -Then just "lock door" will suffice to lock it, and "unlock door" to unlock -it. - -To make one side of a door lockable by a key, you set one or more values in -the door's key field. Each value is just a string, and a key with a key field -matching any of the values can open the door. - - > the door's key is "05052113a" - > derive a "key" from mooix:key - > the key's key is "05052113a" - > lock door with key - You lock the door. - -If you wanted to make the door accept a skeleton key, you could add a value -to its key field for that: - - > the door's second key is "skeleton" - -Of course to be a useful skeleton key, several doors would need to accept -that key. - -To make things a bit easier, the moo will take care of opening doors when -you pass through them, and will check all the keys you're carrying to try -to find a match if you lock or unlock a door without specifying a key. - -Bear in mind that setting keys or the manuallock field only applies to the -side of the door you do it on. While it really only makes sense to let one -side of a door be manually locked, a door with a keyhole can typically be -unlocked from either side, so you'll want to set the key fields of both -sides of the door identically. Index: obj/abstract/builder/install_fail_find.msg =================================================================== --- obj/abstract/builder/install_fail_find.msg (revision 0) +++ obj/abstract/builder/install_fail_find.msg (revision 0) @@ -0,0 +1 @@ +session: Install failed to find any of the supposedly created objects. Index: obj/abstract/builder/install.msg =================================================================== --- obj/abstract/builder/install.msg (revision 0) +++ obj/abstract/builder/install.msg (revision 0) @@ -0,0 +1 @@ +session: Installed $objects. Index: obj/abstract/builder/list.hlp =================================================================== --- obj/abstract/builder/list.hlp (revision 23) +++ obj/abstract/builder/list.hlp (working copy) @@ -1,21 +0,0 @@ -Listing the source of a mooix method. - -A =builder= can display the source of a mooix method with the list command. -While builders cannot modify a method (you have to be a =programmer= to do -that), it can still be useful or interesting to view source. - -Note that some methods may not allow their source to be viewed. Also, this -command is smart enough to detect binary methods and either find a .c file -that looks like it produced them, or avoid displaying them. - -To use the command, give the object and the method to list, as in the -=show= command: - - > list my list_verb - #!/usr/bin/perl - #use Mooix::Thing; - ... - -List can also be used to display fields, it's not limited to methods. -The =show= command is more generally useful for poking around in objects -though. Index: obj/abstract/builder/reparent_verb =================================================================== --- obj/abstract/builder/reparent_verb (revision 23) +++ obj/abstract/builder/reparent_verb (working copy) @@ -12,12 +12,14 @@ # set, to allow reparents of avatars. By default it's not allowed. if ($_{avatar_reparent_ok} != 1) { if ($obj == $this || $obj->isa($Mooix::Root->abstract->avatar)) { - fail "You cannot reparent yourself or other avatars."; + $this->msg( 'reparent_fail_avatars', %_ ); + fail(); } # This is just paranioa. if ($newparent->isa($Mooix::Root->abstract->avatar)) { - fail "You can't do that."; + $this->msg( 'reparent_no_reanimating', %_ ); + fail(); } } @@ -47,10 +49,12 @@ my $parent=$newparent; while (ref $parent) { if ($parent == $obj) { - fail "That would create a parent loop!"; + $this->msg( 'reparent_would_loop', %_ ); + fail(); } if ($seenobjs{$parent->index}) { - fail "There seems to be a parent loop!"; + $this->msg( 'reparent_loop', %_ ); + fail(); } $seenobjs{$parent->index}=1; push @locks, $parent->getlock(LOCK_EX); @@ -65,6 +69,7 @@ $obj->init; } else { - fail "You cannot reparent that."; + $this->msg( 'reparent_fail', %_ ); + fail(); } } Index: obj/abstract/builder/ps_verb =================================================================== --- obj/abstract/builder/ps_verb (revision 23) +++ obj/abstract/builder/ps_verb (working copy) @@ -33,10 +33,11 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + my $obj = $_{direct_object}; my $session = $_{session}; Index: obj/abstract/builder/install_package_fail.msg =================================================================== --- obj/abstract/builder/install_package_fail.msg (revision 0) +++ obj/abstract/builder/install_package_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Package serialisation/extraction failed. Index: obj/abstract/builder/derive.msg =================================================================== --- obj/abstract/builder/derive.msg (revision 0) +++ obj/abstract/builder/derive.msg (revision 0) @@ -0,0 +1 @@ +session: Object created ($ref). Index: obj/abstract/builder/safechange_field_to_object.msg =================================================================== --- obj/abstract/builder/safechange_field_to_object.msg (revision 0) +++ obj/abstract/builder/safechange_field_to_object.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot replace an inherited field with an object. Index: obj/abstract/builder/safechange_no_reparent.msg =================================================================== --- obj/abstract/builder/safechange_no_reparent.msg (revision 0) +++ obj/abstract/builder/safechange_no_reparent.msg (revision 0) @@ -0,0 +1 @@ +session: Use the reparent command to change an object's parent. Index: obj/abstract/builder/safechange_string_not_ref.msg =================================================================== --- obj/abstract/builder/safechange_string_not_ref.msg (revision 0) +++ obj/abstract/builder/safechange_string_not_ref.msg (revision 0) @@ -0,0 +1 @@ +session: Expected an object reference, but got a string. Index: obj/abstract/builder/dig_fail_room.msg =================================================================== --- obj/abstract/builder/dig_fail_room.msg (revision 0) +++ obj/abstract/builder/dig_fail_room.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to create room. Index: obj/abstract/builder/reference.hlp =================================================================== --- obj/abstract/builder/reference.hlp (revision 23) +++ obj/abstract/builder/reference.hlp (working copy) @@ -1,48 +0,0 @@ -Referring to an object that is not present. - -If an object is not present, and you want to do something with it, you must -refer to it using a mooix object reference. Only a =builder= or above may do -so. - -Mooix object references have the form: - - mooix:path - -The path part should be the path to the object directory of the object that -you wish to refer to. For example: - - mooix:/var/lib/mooix/concrete/thing - -There are some abbreviations possible. If the path is relative, the moo -will search for an object using your refpath field. That field holds a list -of directories whose contents will be examined. By default, that includes -your avatar, the root of the main object tree, and the concrete object tree. -Thus, the above reference can be shortened to: - - mooix:concrete/thing - mooix:thing - -The first is less ambiguous than the second, since if you had a "thing" -field in your avatar that was an object reference, the second of these -would match it instead. - -The best way to refer to an object in your =portfolio= is: - - mooix:portfolio/object - -If you find typing "portfolio" all the time grows tiresome, you can add the -portfolio to your refpath. Some may want to add the root of the contrib -objects tree to it as well. - -If you find that you often need to refer to an object with an obnoxiously -long mooix: reference, you can create a =shortcut= to it and use that -instead. - -As a special case, if the path begins with a "~" and the name of an avatar, -then the reference is relative to that avatar. It looks something like a -unix home directory notation: - - mooix:~bob/portfolio/object - -The =show= command can be used to display references that are part of -objects. Index: obj/abstract/builder/dig_verb =================================================================== --- obj/abstract/builder/dig_verb (revision 23) +++ obj/abstract/builder/dig_verb (working copy) @@ -22,15 +22,16 @@ run sub { my $this=shift; %_=@_; + my $avatar=$_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + my @created_objs; my $session=$_{session}; - my $avatar=$_{avatar}; # The verb can be called in three different ways. Either there is a # second quote, and exits are to be made, or there is just one # quote, the name of the room to make, or there is a direct object, @@ -135,7 +136,7 @@ # Make room. if (! $room) { my ($stat, $val, @rest) = $this->safechange( - object => $this->portfolio."/".$roomname, + object => $this->portfolio."/".$avatar->dexml( avatar => $avatar, text => $roomname ), newid => 1, field => "parent", value => $roomparent, @@ -144,11 +145,18 @@ field => "name", value => $roomname, ); - fail "Failed to create room." unless $stat; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $val, %_ ); + $this->msg( 'dig_fail_room', %_ ); + fail(); + } $room = $val; $room->init; - $session->write("Created ".A($roomparent->name). - " (".$this->refstring($room).")."); + $this->msg( 'dig_room_created', + parent => $roomparent, + room => $this->refstring($room), + %_ ); push @created_objs, $room; } @@ -157,7 +165,7 @@ # Make exit into the room, and put in avatar's location. if (length $toname) { my ($stat, $val, @rest) = $this->safechange( - object => $this->portfolio."/".$toname, + object => $this->portfolio."/".$avatar->dexml( avatar => $avatar, text => $toname ), newid => 1, field => "parent", value => $exitparent, @@ -178,19 +186,30 @@ ) : "" ), ); - fail "Failed to create exit." unless $stat; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $val, %_ ); + $this->msg( 'dig_fail_exit', %_ ); + fail(); + } $toexit=$val; $toexit->init; if (! $toexit->physics->move(object => $toexit, to => $avatar->location, teleport => 1)) { - $session->write("Failed to add an exit from here to ".$room->name." (contact ".$room->owner->name." to get that done)."); + $this->msg( 'dig_fail_to_exit', + room => $room, + owner => $room->owner, + %_ ); $this->portfolio->remove(object => $toexit, quiet => 1); $toexit=undef; } else { - $session->write("Added ".AN($exitparent->name)." ". - "(".$this->refstring($toexit).") from here ". - $toexit->name." to ".$room->prettyname."."); + $this->msg( 'dig_to_exit', + toexit_str => $this->refstring($toexit), + exitparent => $exitparent, + toexit => $toexit, + room => $room, + %_ ); push @created_objs, $toexit; } } @@ -198,7 +217,7 @@ # Make exit from room, and put in room. if (length $fromname) { my ($stat, $val, @rest) = $this->safechange( - object => $this->portfolio."/".$fromname, + object => $this->portfolio."/".$avatar->dexml( avatar => $avatar, text => $fromname ), newid => 1, field => "parent", value => $exitparent, @@ -219,20 +238,30 @@ ) : "" ), ); - fail "Failed to create exit." unless $stat; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $val, %_ ); + $this->msg( 'dig_fail_exit', %_ ); + fail(); + } $fromexit=$val; $fromexit->init; if (! $fromexit->physics->move(object => $fromexit, to => $room, teleport => 1)) { - $session->write("Failed to add an exit from ".$room->name." to here."); + $this->msg( 'dig_fail_from_exit', + room => $room, + owner => $room->owner, + %_ ); $this->portfolio->remove(object => $fromexit); $fromexit=undef; } else { - $session->write("Added ".AN($exitparent->name)." ". - "(".$this->refstring($fromexit).") from ". - $room->prettyname." ".$fromexit->name. - " to here."); + $this->msg( 'dig_from_exit', + fromexit_str => $this->refstring($fromexit), + exitparent => $exitparent, + fromexit => $fromexit, + room => $room, + %_ ); push @created_objs, $fromexit; } } Index: obj/abstract/builder/reparent_fail_avatars.msg =================================================================== --- obj/abstract/builder/reparent_fail_avatars.msg (revision 0) +++ obj/abstract/builder/reparent_fail_avatars.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot reparent yourself or other avatars. Index: obj/abstract/builder/pronoun.hlp =================================================================== --- obj/abstract/builder/pronoun.hlp (revision 23) +++ obj/abstract/builder/pronoun.hlp (working copy) @@ -1,33 +0,0 @@ -Dealing with pronouns in messages. - -=messages= will frequently need to have a pronoun in them, referring to the -avatar who initiated an action, or the object or person acted on. It's -possible, though a bit painful, to make the right pronoun get substituted -in every time. - -For example, suppose the desired message is something like, "Mary pats her -laptop and picks it up." A first take message -might be something like "$avatar pats her $this and picks it up." -But that works pretty bad when the avatar is a man who is picking up his -child; resulting in a mess like: "Bob pats her child and picks it up." -What is called for are two pronoun substitutions, one for the avatar's -possessive adjective (her/his), and one for the objective personal pronoun -of whatever is being picked up (it/him/her). These need to vary depending -on the gender of the objects. - -The gender of an object is pointed to by its gender field, which points to -a gender object. These gender objects just have a bunch of fields with -names like "object_pronoun", "possessive_adjective", and so on. And it -turns out that these can be accessed in a message substitution by -constructs like these: - $object->gender_object_pronoun - $object->gender_possessive_adjective - -For the details of exactly what fields are available and what they are for, -type the following command: - - > usage mooix:mixin/gender - -In our example above, the message should really be: -"$avatar pats $avatar->gender_possessive_adjective $this and picks -$this->gender_object_pronoun up" Whew! Index: obj/abstract/builder/safechange_newid_not_thingset.msg =================================================================== --- obj/abstract/builder/safechange_newid_not_thingset.msg (revision 0) +++ obj/abstract/builder/safechange_newid_not_thingset.msg (revision 0) @@ -0,0 +1 @@ +session: newid used for object not a thingset Index: obj/abstract/builder/set_fieldmode.msg =================================================================== --- obj/abstract/builder/set_fieldmode.msg (revision 0) +++ obj/abstract/builder/set_fieldmode.msg (revision 0) @@ -0,0 +1 @@ +session: $field is now mode $msg. Index: obj/abstract/builder/shortcut_verb =================================================================== --- obj/abstract/builder/shortcut_verb (revision 23) +++ obj/abstract/builder/shortcut_verb (working copy) @@ -6,10 +6,11 @@ my $session=$_{session}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + if (exists $_{direct_object} && exists $_{quote}) { # Add shortcut. my $object=$_{direct_object}; @@ -17,18 +18,21 @@ if (-l $this->shortcuts->id."/$name") { unless ($this->shortcuts->remove(object => $this->shortcuts->$name)) { - fail "Could not remove the old link!"; + $this->msg( 'shortcut_fail_remove_link', %_ ); + fail(); } } unless ($this->shortcuts->add(object => $object, hint => $name)) { - fail "Could not add the object!"; + $this->msg( 'shortcut_fail_add', %_ ); + fail(); } } elsif (exists $_{direct_object}) { # Remove shortcut. Called by unshortcut.cmd. unless ($this->shortcuts->remove(object => $_{direct_object})) { - fail "Could not remove the shortcut."; + $this->msg( 'shortcut_fail_remove', %_ ); + fail(); } } Index: obj/abstract/builder/signal_verb =================================================================== --- obj/abstract/builder/signal_verb (revision 23) +++ obj/abstract/builder/signal_verb (working copy) @@ -6,10 +6,11 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + my $obj = $_{direct_object}; my $session = $_{session}; my $signal = POSIX::SIGTERM; @@ -20,8 +21,12 @@ # to behave in ways that are not really intended, it's best to not # let builders play with it. This is overridden for programmers. if ($signal != POSIX::SIGTERM && $signal != POSIX::SIGKILL) { - fail "As a builder, you're limited to signals ".POSIX::SIGTERM. - "and ".POSIX::SIGKILL."."; + $this->msg( 'signal_limits', + sigterm => POSIX::SIGTERM, + sigkill => POSIX::SIGTERM, + %_ + ); + fail(); } my @args; @@ -30,9 +35,10 @@ } if ($obj->signal(with => $signal, @args)) { - $session->write("Signal sent."); + $this->msg( 'signal', %_ ); } else { - fail "Failed to send signal."; + $this->msg( 'signal_fail', %_ ); + fail(); } } Index: obj/abstract/builder/safechange_fail_avatar_ref.msg =================================================================== --- obj/abstract/builder/safechange_fail_avatar_ref.msg (revision 0) +++ obj/abstract/builder/safechange_fail_avatar_ref.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot modify one of your avatar's references. Index: obj/abstract/builder/safechange.inf =================================================================== --- obj/abstract/builder/safechange.inf (revision 23) +++ obj/abstract/builder/safechange.inf (working copy) @@ -17,7 +17,7 @@ but the new objects can only be put in the builder's portfolio, or in objects already in the portfolio. - Can set private fields (except for fields named ".*-safe" and - fields named ".*-opaque" of other objects than themselves, but + fields named ".*-opaque") of other objects than themselves, but only if the private field does not already exist and is not inherited (and they cannot be unset). - Can create new fields, but cannot override inherited methods with Index: obj/abstract/builder/addcomand.msg =================================================================== --- obj/abstract/builder/addcomand.msg (revision 0) +++ obj/abstract/builder/addcomand.msg (revision 0) @@ -0,0 +1 @@ +session: Command added. Set $command.msg to customize. Index: obj/abstract/builder/dig_fail_from_exit.msg =================================================================== --- obj/abstract/builder/dig_fail_from_exit.msg (revision 0) +++ obj/abstract/builder/dig_fail_from_exit.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to add an exit from $room to here. You may want to discuss this with $owner. Index: obj/abstract/builder/teleport.cmd =================================================================== --- obj/abstract/builder/teleport.cmd (revision 23) +++ obj/abstract/builder/teleport.cmd (working copy) @@ -1,7 +1,8 @@ +# General teleport foo to bar verb(this), direct_object(tomove)(anywhere), io_preposition, indirect_object(anywhere) # Teleport without a destination. -verb(this), direct_object(this)(tomove), do_preposition(away|out) +verb(this), direct_object(tomove)(anywhere), do_preposition(away|out) : teleport_out # Complement to teleport an object in to the location. -verb(this), direct_object(this)(tomove), do_preposition(in) +verb(this), direct_object(tomove)(anywhere), do_preposition(in) : teleport_in # This form is used for self teleports. -verb(this), direct_object(anywhere) +verb(this), direct_object(this)(tomove), io_preposition, indirect_object : teleport_self Index: obj/abstract/builder/reparent_fail.msg =================================================================== --- obj/abstract/builder/reparent_fail.msg (revision 0) +++ obj/abstract/builder/reparent_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot reparent that. Index: obj/abstract/builder/shortcut_fail_add.msg =================================================================== --- obj/abstract/builder/shortcut_fail_add.msg (revision 0) +++ obj/abstract/builder/shortcut_fail_add.msg (revision 0) @@ -0,0 +1 @@ +session: Could not add the object! Index: obj/abstract/builder/builder-tutorial.hlp =================================================================== --- obj/abstract/builder/builder-tutorial.hlp (revision 23) +++ obj/abstract/builder/builder-tutorial.hlp (working copy) @@ -1,411 +0,0 @@ -A Mooix Builder's Tutorial - -This tutorial is for people who have been given the power of building -objects and places in the moo. - -Making your first object: - - Before you can make an object you need to find an object to base it on. - Then you can =create= a new object based on the parent object. The child - starts out looking and behaving like a near-exact copy of the parent (it - has the same description, and so forth). - - You can =create= new objects from any object that you can see in the - moo, plus some objects that you probably can't see. Let's start by - creating a football, based on the moo's ball class. Don't worry about the - exact meaning of the "mooix:ball" bit just yet. (It's an object - =reference=.) - - > create a "ball" from mooix:ball - Object created. - > drop it - You drop the ball. - The ball bounces around the room. - - Now that you have one ball, it's easy enough to make another object - based on that one: - - > create a "football" from the ball - Object created. - > look at it - A bouncy ball. - - Well that's a start. But the description is wrong, as it is being - inherited from the ball the football is derived from. Here's how you might - change it. This gives the football a description of its own, so it stops - inheriting its parent's description: - - > describe the football as "A pigskin." - Description changed. - > look at the football and the ball - football: - A pigskin. - ball: - A bouncy ball. - - Here's another way to change the description. Use whichever you prefer. - - > The football's description is "A prolate spheroid." - Set. - -Recycling an object: - - Sometimes you'll find that you don't need an object any more. To stop it - from cluttering up the moo, just =recycle= it: - - > recycle the football - The football vanishes with a soft popping sound. - Object recycled. - - Less politically correct folks might prefer the =destroy= command, which - does exactly the same thing. - -Object references: - - Sometimes you are making some object that is not so closely related to - anything else in the moo. It can be useful to start out with a blank - slate. As a builder, you can derive objects from some other objects that - might not be in the same room as you. In the example above, a ball was - derived from mooix:ball. - - mooix:ball is an object =reference=; a special way to refer to the system's - ball object. Builders can refer to any of the system's core objects in - this way. You can also use these references to refer to objects that you - have previously created even if they're not in sight. Such objects are - called your portfolio, and the =portfolio= command can be used to list - everything in your portfolio. - - > portfolio - Your portfolio: - hat (mooix:portfolio/hat) - hat (mooix:portfolio/hat2) - - In this example, there are two objects in the portfolio with the same name, - but different ids. If you wanted to recycle the second hat, you might - type, "recycle mooix:portfolio/hat2". - - To get a list of all the system objects, which can be useful parents for - your objects, use the =classes= command, which works much the same as - the =portfolio= command. - - You can also refer to other objects on the system using the full path to - the object, if you know it. This typically requires unwieldy constructs - like mooix:/var/lib/mooix/blah, but you can create a shortened form of - any =reference= with the =shortcut= command. One other handy shortcut is - if you want to refer to someone else in the moo, you can use mooix:~name. - For example, if you want to refer to the house that Jack built, use - mooix:~jack/portfolio/house. - -Messages: - - Ball objects, such as the ball you created at the start of this tutorial, - have the amusing property of bouncing around when they're dropped, or - when you explicitly bounce them: - - > drop ball - You drop the ball. - The ball bounces around the room. - > bounce ball - The ball bounces around the room. - - You can change these =messages= (any many, many others) to customize what - people see when various actions are performed. First you need to know - what messages are available for customization. Here is a way to =show= the - messages that are available to customize an object: - - > showall the ball's messages - Messages: - * bounce.msg see: $this bounces around $this->location. - hear: You hear a ball bouncing. - - - So, the message that is displayed when you bounce a ball around is the - bounce.msg. Notice how "$this" is replaced with the name of the ball (and - it's even smart enough to prefix "The"), and how "$location" is similarly - replaced with the name of the location of the ball. - - Besides $this, which works in any message, you can use some other - variables and things that expand to useful values. $this->field will - expand to the value of a field of the object referred to by $this. Other - variables in addition to $this might be usable in a message, for example - some messages use $direct_object to refer to the object which is being - acted on (and $direct_object->somefield thing will work here too). Or - $location might be used to refer to the current location. The available - variables vary from message to message. - - For more details, see =messages=. - -Examining an object in detail: - - Besides messages, objects in the moo have plenty of other fields - associated with them. The =show= and =showall= commands can be used to - take a look at them. =show= displays values that are part of the object - it is used on, while =showall= includes values that are inherited from - parent objects, and so often displays a great deal more. - - If you don't specify a category of things to display, the showall command - shows everything the moo knows about the object, and it will output quite - a lot! - - > showall me - Fields: - * article - name - Messages: - [...] - Commands: - [...] - * say.cmd verb, quote, direct_object - verb, quote - * show.cmd verb(this), direct_object - verb(this), direct_object, field - [...] - [...] - Methods: - * canlogin 12 lines of perl - * classes_verb 15 lines of perl - [...] - - Notice how it breaks up the various types of information by category. - Any of these categories can be queried individually ("showall my fields", - or whatever). Individual items can also be looked up: - - > show my name - Fields: - name - - Remember that you can use these commands to examine other objects, not - just yourself (ie: "show the ball's fields"). - -Setting messages and fields: - - Now that you know how to poke around in them, you probably want to change - some messages or fields, or add new ones. Here's how you can do that: - - > The ball's bounce.msg is "see: $this bounces a few times." - Set. - > bounce the ball - The ball bounces a few times. - - This powerful command form can set more than just messages, though. You - can use it to change other fields as well, like the description of an - object: - - > ball's description is "A beach ball." - Set. - > my name is "Fred". - Name set. - - Or the article that the moo uses before the object's name, - - > bounce ball - The ball bounces a few times. - > the ball's article is "a" - Set. - > bounce ball - A ball bounces a few times. - - Even non-builders can set their own messages and fields (though guests - cannot). You can set messages and fields of any object you own, and some - objects might have messages and fields that are open to modification by - all. You can't use this to change object methods (programming), or - certain hidden or read-only fields. - -Multi-valued fields: - - Recall that a single message can have multiple values, one of which is - picked at random when it is displayed. Similarly, some other fields can - have multiple values. For example, if an object has multiple values in - its alias field, it will "answer" to any of its aliases in addition to - its name. Another example is the adjective field, which can hold any - number of adjectives useful in referring to the object ("bouncy", - "ugly", whatever). You can access these multiple values by specifying - which to set: - - > my alias is "bilbo" - Set. - > my second alias is "frodo" - Set. - > my third alias is "sam" - Set. - > show my alias - Fields: - alias bilbo - frodo - sam - - You can also remove values, with the =unset= command. If you specify a - particular value to remove, only that one is removed (unless it's the - only value). If you don't specify the number of the value to remove, then - the field is removed; if the parent object defines the field, then the - field will inherit the value from its parent. - - > unset my second alias - Unset. - > show my alias - Fields: - alias bilbo - sam - > unset my alias - > show my alias - No such category or field. - -Boolean fields: - - Some objects have fields that can have either a true or a false value in - them. Is a container closed or not? Is a ball bouncy? While you can set - such fields using the techniques described earlier, it is awkward: - - > the ball bouncy is "1" - Set. - > set the ball bouncy to "0" - Set. - - So it's better to just type: - - > the ball is bouncy - Set. - > the ball isn't bouncy - Set. - - This "bouncy" field is just an example, but some real fields of this type - are the "closed", "transparent", and "locked" fields of containers, and - the "immobile" and "hidden" fields that can be set on any object. - -Building rooms: - - As a builder you can not only make objects, you can add to the - =topography= of the moo. You do this by making rooms, and linking them to - other rooms with exits. Note that exits are unidirectional, so a pair is - needed, one to get from room A to room B, and another to get back from - room B to room A. - - There is an easy way to create a new room and a pair of exits linking it - to the current room. It is the =dig= command, and is used like this: - - > dig "up|down" to "treehouse" - - The first exit in the list is the name of the exit from the current room - to the new room, while the second exit name is for the exit back from the - new room to the current room. For each exit, you may specify aliases - after the name, separated by commas: - - > dig "north,n|south,s" to "desert" - - If you only wanted to make one exit in the pair, you could just leave out - the name for the other exit. Or you can leave out the names of both to - create an unconnected room. Or you can use dig to dig exits to or from an - existing room. So all of these are some of the ways to use the =dig= - command: - - > dig "up" to "treehouse" - > dig "|down" to "treehouse" - > dig "treehouse" - - Once you have created a room, the first thing to do is to dress it up a - bit -- use the describe or set similar command to give it a description. - - There are also some useful messages available on exits that can be used - to add flavour to the moo: the leave.msg and arrive.msg. Exits have very - bland descriptions by default, and you'll almost always want to change - that. The default messages will make a modicum of sense, but it's much - more fun to watch someone climb a tree than it is to be told, "Fred goes - up." In particular, the default arrive.msg is very uninformative and - boring, and it's best to replace it with a custom one for each exit. - - Some rooms -- those which do not have their exit_ok field set -- do not - let just anyone add generally usable exits to them. You might want to - unset the exit_ok field of a room if it is a space which you need to have - full control over. On the other hand, many moos include spaces where - anyone can add an exit. Rooms default to not being exit_ok (unless this - default is changed in your own moo). If a room is not exit_ok, and - someone adds an exit to it, the exit will be unusable to anyone except: - - The owner of the exit. - - The owner of the room. - - The moo admin. - And these users will be warned when they use the exit. - -Terrain: - - After a while you may find that you're making the same basic types of - rooms over and over. To save time you can create a =terrain= and use it - to automate some of the process. - -Periodic and random effects: - - Objects of type mooix:event can be added to rooms to produce periodic and - random effects like the sound of water dripping, a light flickering on - and off, or a clock striking the time. Here's a quick example of setting - up a random dripping noise: - - > create a "drip" from mooix:event - > drop it - > it's hidden - > it's immobile - > its description is "Hm, it's hard to tell where the drip is." - > its event.msg is "hear: Drip. Drip." - > its interval is "9" - > its probability is "0.1" - - Now one of the two messages will be displayed every 9 seconds, with a - probability of 1 in 10 that the message is displayed each time. You can - also set up a start date and a end date for when the event can occur. - A wide variety of date specifications are accepted: - - > the drip's enddate is "March 11 2005" - > the drip's startdate is "in 5 minutes". - -Adding details to rooms: - - If an object is hidden and has some text in its detail field, this text - is displayed as part of the description of its location. You can use this - to add details to rooms. For example, let's add a grandfather clock to - a room: - - > derive a "grandfather clock" from mooix:contrib/clock - > put it down - > its alias is "clock" - > it is hidden - > it is immobile - > its detail is "A tall grandfather clock ticks quietly in a corner." - > look - Some room. - A very bland-looking place. A tall grandfather clock is in a corner of the - room. - > look clock - According to the grandfather clock, it's almost ten to four. - - It's best to make detail objects immobile as well as hidden, since the - details may also apply to the description of an avatar who has picked - them up, and that would look strange. - -Teleporting: - - Besides being able to build and modify objects, builders can =teleport= - stuff around. This can be very convenient to move objects into place. The - command is simple: - - > teleport me to mooix:portfolio/myroom - - Of course, you can teleport not only yourself, but other objects. - -Adding commands to objects: - - You can add simple commands to objects with the =addcommand= command. No - programming is required to do this. For example: - - > addcommand "kick" to ball - Command added. Set kick.msg and kick.msg to customize. - > kick the ball - Joey kicks the ball. - - See =addcommand= for details. - -Putting it all together: - - Now you know how to make objects, examine them in detail, and modify - their messages and fields, and even add new commands to them, you should - know enough to make an interesting object or two. It's easy enough to - create yet another ball, chair, table, or container, or dig out a set of - rooms, but you should be imaginative. Make the descriptions interesting - and fun to read, adjust messages in amusing ways, and so on. Index: obj/abstract/builder/removecommand_verb =================================================================== --- obj/abstract/builder/removecommand_verb (revision 23) +++ obj/abstract/builder/removecommand_verb (working copy) @@ -3,10 +3,12 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. if ($_{avatar} != $this) { - fail "No!"; + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my ($stat, $msg) = $this->safechange( @@ -19,10 +21,13 @@ unset => 1, ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + $this->msg( 'removecommand_fail', %_ ); + fail(); } else { - $_{session}->write("Command removed."); + $this->msg( 'removecommand', %_ ); } } Index: obj/abstract/builder/install_none.msg =================================================================== --- obj/abstract/builder/install_none.msg (revision 0) +++ obj/abstract/builder/install_none.msg (revision 0) @@ -0,0 +1 @@ +session: You have no portfolio. Index: obj/abstract/builder/dig_fail_exit.msg =================================================================== --- obj/abstract/builder/dig_fail_exit.msg (revision 0) +++ obj/abstract/builder/dig_fail_exit.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to create exit. Index: obj/abstract/builder/safechange_no_parent.msg =================================================================== --- obj/abstract/builder/safechange_no_parent.msg (revision 0) +++ obj/abstract/builder/safechange_no_parent.msg (revision 0) @@ -0,0 +1 @@ +session: Parent object not specified. Index: obj/abstract/builder/safechange_fail_object_creation.msg =================================================================== --- obj/abstract/builder/safechange_fail_object_creation.msg (revision 0) +++ obj/abstract/builder/safechange_fail_object_creation.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to create object. Index: obj/abstract/builder/usage_verb =================================================================== --- obj/abstract/builder/usage_verb (revision 23) +++ obj/abstract/builder/usage_verb (working copy) @@ -5,12 +5,13 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # Verb. - @params=(); + @params=@_; push @params, (field => $_{field}) if exists $_{field}; # The interface info can be long, so page it. $_{session}->page($_{direct_object}->getusage(@params)); Index: obj/abstract/builder/showall.hlp =================================================================== --- obj/abstract/builder/showall.hlp (revision 23) +++ obj/abstract/builder/showall.hlp (working copy) @@ -1,7 +0,0 @@ -Examining an object in great depth. - -The showall command displays a wealth of information about an object's -fields, including fields inherited from its parents. For a more manageable -display, you will often want to use the =show= command instead. Usage of -this command is much like usage of the =show= command. An asterisk will -appear in front of things that are inherited from a parent. Index: obj/abstract/builder/writing-help.hlp =================================================================== --- obj/abstract/builder/writing-help.hlp (revision 23) +++ obj/abstract/builder/writing-help.hlp (working copy) @@ -1,35 +0,0 @@ -Adding help topic to mooix's online help system. - -Mooix has an integrated online help system. It works by adding fields to -objects that have names ending in ".hlp". Each field is one help topic, and -the rest of the name of the field corresponds to the name of the help -topic. - -Inside a help topic field, the first line should hold the title of the help -topic, Then the second line should be blank, and the remainder of the field -is pretty much freeform, and is displayed as it is formatted. This file -itself is a good example of how to format a help topic. By convention, -examples are indented two spaces and are in a paragraph of their own. - -A simple form of hyperlinking is supported. A word inside equal signs, like -this: =writing-help= is a hyperlink to the help topic named "writing-help" -(this help topic). When a help topic is displayed, all help topics that -link to it are searched out, and will be listed at the end of the help -topic, if the help topic does not in turn link to them. This, all links are -bi-directional. - -Help topics appear automatically in the help index along with their titles. - -A help topic named "basics" is displayed if the user asks for help without -specifying a topic. - -Since each help topic is a field of an object, objects can inherit help -topics from their parents (and override inherited help topics). By default -the help command looks for help topics of the avatar that called it, but if -an object is specified after the help command, that object's help topics -are searched instead. - -This system is admittedly very simplistic, and the implementation of the -help index and bidirectional linking will not scale well to many help -topics. It may be relplaced with something with more explicit formatting at -a later date. Index: obj/abstract/builder/signal.hlp =================================================================== --- obj/abstract/builder/signal.hlp (revision 23) +++ obj/abstract/builder/signal.hlp (working copy) @@ -1,24 +0,0 @@ -Send a signal to an object. - -The signal command is used to send a UNIX signal to an object. This is -mostly only useful if one of the methods has hung or deadlocked. - -You may want to use the =ps= command first to look at what methods are -running; put the name of the method in quotes to only signal that method. -By default all running methods of the object are signaled. - -By default, a SIGTERM is sent, but you can specify the signal to send, by -number. If you're not familiar with UNIX signals, the most useful ones are -SIGTERM (15), which asks a method to terminate nicely, and SIGKILL (9), -which forces a method to die no matter what. As a builder, you're actually -limited to using those two signals for reasons of paranoia. A programmer can -use any signal he likes. - -For example: - - > signal object - > signal object "runnaway_method" with 9 - -Note that signal does not deal very well with fork bombs. If you have a -forb bomb it's best to destroy the object that's doing it, which is -guaranteed to stop the fork bomb. Index: obj/abstract/builder/safechange_unable_mode.msg =================================================================== --- obj/abstract/builder/safechange_unable_mode.msg (revision 0) +++ obj/abstract/builder/safechange_unable_mode.msg (revision 0) @@ -0,0 +1 @@ +session: Unable to set a field's mode. Index: obj/abstract/builder/list_binary.msg =================================================================== --- obj/abstract/builder/list_binary.msg (revision 0) +++ obj/abstract/builder/list_binary.msg (revision 0) @@ -0,0 +1 @@ +session: That is a binary method, and the source is not available. Index: obj/abstract/builder/recycle_verb =================================================================== --- obj/abstract/builder/recycle_verb (revision 23) +++ obj/abstract/builder/recycle_verb (working copy) @@ -6,14 +6,16 @@ my $obj=$_{direct_object} || $this->usage("direct object required"); # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + if (! $obj->destroy) { - $_{session}->write("Object destroyed."); + $this->msg( 'recycle', %_ ); } else { - fail "You can't destroy that."; + $this->msg( 'recycle_fail', %_ ); + fail(); } } Index: obj/abstract/builder/dig_from_exit.msg =================================================================== --- obj/abstract/builder/dig_from_exit.msg (revision 0) +++ obj/abstract/builder/dig_from_exit.msg (revision 0) @@ -0,0 +1 @@ +session: Added the new exit $fromexit_str with parent $exitparent from $room $fromexit to here. Index: obj/abstract/builder/edit_fail.msg =================================================================== --- obj/abstract/builder/edit_fail.msg (revision 0) +++ obj/abstract/builder/edit_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Edit failed. Index: obj/abstract/builder/dig.cmd =================================================================== --- obj/abstract/builder/dig.cmd (revision 23) +++ obj/abstract/builder/dig.cmd (working copy) @@ -1,5 +1,10 @@ +# dig "toexit|fromexit" to "roomname" verb(this), quote, quote2 +verb(this), quote, quote2, io_preposition(to) # This form makes no exits. +# dig "roomname" verb(this), quote # This form is used to dig exits to existing rooms. +# dig "exitspec" to mooix:roomref verb(this), quote, direct_object(anywhere) +verb(this), quote, direct_object(anywhere), io_preposition(to) Index: obj/abstract/builder/usage.cmd =================================================================== --- obj/abstract/builder/usage.cmd (revision 23) +++ obj/abstract/builder/usage.cmd (working copy) @@ -1,2 +1,2 @@ -verb(this), direct_object(nearby|reference), field -verb(this), direct_object(nearby|reference) +verb(this), do_preposition, direct_object(nearby|reference), field +verb(this), do_preposition, direct_object(nearby|reference) Index: obj/abstract/builder/teleport_fail_already_there.msg =================================================================== --- obj/abstract/builder/teleport_fail_already_there.msg (revision 0) +++ obj/abstract/builder/teleport_fail_already_there.msg (revision 0) @@ -0,0 +1 @@ +session: $object is already there. Index: obj/abstract/builder/recycle.hlp =================================================================== --- obj/abstract/builder/recycle.hlp (revision 23) +++ obj/abstract/builder/recycle.hlp (working copy) @@ -1,16 +0,0 @@ -Remove an object from the moo. - -A =builder= may recycle any object that is in his =portfolio=. -The syntax is simple: - - > recycle object - -Multiple objects can be listed. - -Warning: Don't try to recycle yourself, and don't recycle an object which -is the parent of other still existing objects in the moo. The consequences -can be ugly. - -An alternative to recycling is to =teleport= an object out of the way. - -"destroy" is a less PC name for this command. Index: obj/abstract/builder/removecommand_fail.msg =================================================================== --- obj/abstract/builder/removecommand_fail.msg (revision 0) +++ obj/abstract/builder/removecommand_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Could not remove the command. Index: obj/abstract/builder/teleport_verb =================================================================== --- obj/abstract/builder/teleport_verb (revision 23) +++ obj/abstract/builder/teleport_verb (working copy) @@ -2,64 +2,18 @@ #use Mooix::Thing; #use Mooix::Root; run sub { - my $this=shift; - %_=@_; - - # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; - } - - # This verb can be called several ways; if an indirect object is - # omiitted it is a self teleport to the direct object. - my ($object, $destination, $preposition); - if ($_{do_preposition} eq 'away' || $_{do_preposition} eq 'out') { - $object = $_{direct_object}; - $destination = undef; - $preposition = undef; - } - elsif ($_{do_preposition} eq 'in') { - $object = $_{direct_object}; - $destination=$this->location; - $preposition = $_{do_preposition}; - } - elsif ($_{indirect_object}) { - $object = $_{direct_object}; - $destination = $_{indirect_object}; - $preposition = $_{io_preposition}; - } - else { - $object = $this; - $destination = $_{direct_object}; - } - my $oldloc = $object->location; + my $this=shift; + %_=@_; - # Teleport to an exit goes to the exit's destination. - if ($destination && $destination->isa($Mooix::Root->concrete->exit)) { - $destination=$destination->destination; - } - - # TODO some rooms may want to disallow teleports into/out of them. - - if ($oldloc == $destination) { - if ($object == $this) { - fail "You're already there!"; - } - else { - fail ucfirst $object->gender_subject_pronoun."'s already there!"; - } - } + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } - # Note the use of the teleport flag, to let move know that even - # normally immobile objects should be 'ported, if possible. - $object->msg('teleport', %_, (destination => $destination ? $destination : 'limbo')); - if ($object->physics->move(object => $object, to => $destination, teleport => 1, preposition => $preposition)) { - $oldloc->msg('teleport_leave', %_, originator => $object) - if $oldloc; - $destination->msg('teleport_arrive', %_, skip => $object, originator => $object) - if $destination; - } - else { - fail "You can't do that."; - } + $this->exec->teleport( + %_, + object => $_{direct_object}, + destination => $_{indirect_object} + ); } Index: obj/abstract/builder/set_reference_not.msg =================================================================== --- obj/abstract/builder/set_reference_not.msg (revision 0) +++ obj/abstract/builder/set_reference_not.msg (revision 0) @@ -0,0 +1 @@ +session: That field is a string value, not a reference. Index: obj/abstract/builder/reparent_no_reanimating.msg =================================================================== --- obj/abstract/builder/reparent_no_reanimating.msg (revision 0) +++ obj/abstract/builder/reparent_no_reanimating.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that. No making things into avatars. Index: obj/abstract/builder/teleport.hlp =================================================================== --- obj/abstract/builder/teleport.hlp (revision 23) +++ obj/abstract/builder/teleport.hlp (working copy) @@ -1,33 +0,0 @@ -Teleporting yourself or an object. - -A =builder= can teleport stuff around. - -There are two forms to the teleport command. The simple form allows for -self teleportation, and the more complex form allows for teleporting any -object. - -Self teleportation: - - > teleport to destination - -General teleportation: - - > teleport object to destination - -The destination may be any container you can see, or an exit of the room -you're in, or an object =reference=. - -Not all containers will accept teleports, and you can only teleport an -avatar to a room or onto furniture. Another reason teleportation might fail -is if you are teleporting an object into an object inside itself, (or into -itself). - -You can also teleport an object to an undefined location. This actually -unsets its location field. Handy to temporarily get rid of an object that -you don't want to =recycle=, or to move an object, like a room, that -doesn't really need to be in a location. - - > teleport object away - > teleport object out - -You cannot do this to avatars. Index: obj/abstract/builder/commands.hlp =================================================================== --- obj/abstract/builder/commands.hlp (revision 23) +++ obj/abstract/builder/commands.hlp (working copy) @@ -1,105 +0,0 @@ -All about commands. - -=builder=s and =programmer=s can both add new commands to the moo. Builders -use the =addcommand= command to do so, while programmers can opt to write -more complex commands. - -A command has two parts. There is the .cmd field which is processed by the -moo parser and tells it which parts of speech the command requires. And -there is the _verb method, which is run when the user types in the command. -The name of the .cmd field directly corresponds to the verb that the user -can enter to run this command, and generally the _verb method starts with -the same thing, so there are pairs like eat.cmd and eat_verb. For info on -writing verbs, programmers should see =verbs=. - -Both programmers and builders may edit the .cmd fields, thus changing what -parts of speech the parser expects to come after the command. - -The .cmd field is an list of lines, which can be either comments (lines -beginning with '#', which are ignored), or a command specification. These -command specifications lists the parts of speech that can be used with the -verb (separated by commas). - -The available parts of speech are: - - verb - do_preposition (Preposition applying to direct object) - direct_object - io_preposition (Preposition applying to indirect object) - indirect_object - quote (Quoted literal text) - field (An object field name) - number (A number) - -With the exception of the prepositions, each part of speech listed must be -present in the sentence in question; the order they are listed does not -really matter. - -So an example for an "eat" command would be: - - verb, direct_object - -If the part of speech is followed by parentheses, the contents of the -parens is a limitation on what things can be used for that part of speech. - -For prepositions and quotes, the text itself must match. Note that some -sentence forms allow multiple prepositions to be used before a direct -object, and in that case the parser will treat the whole set of -prepositions as one string, and to match it you must include exactly the -same series of words. - -For verbs, (this) may be used to limit the verb so it can only be run if -the caller is the same as the object that contains the verb. - -For objects, the following limits may be used: - - this Object must be the object that defines the command. - This is useful for private commands. - nearby Object must be nearby (present, or inside some container - which is nearby; not necessarily visible or touchable, - but just clearly in the room with the avatar). This is the - default limit checked for all objects, and need not be - explicitly specified. It is useful to ensure that a command - does not act on an object at a distance. It also results in - the object being locked in place while the command executes, - which avoids some common races. - anywhere The inverse of nearby; object may be anywhere, and is not - locked into place. - touchable The object must not only be nearby, but the user should - be able to reach out and touch it. So an object in a - transparent container might be touchable, but only if the - container is open. On the other hand, such an object - would always be nearby. Like nearby, this results in the - object being locked in place while the command executes. - visible The object must be visible. This results in the same - locking as nearby. - open The object must be an open container. This prevents the - container from closing while the command runs. - reference The object must have been named by a reference, as - in "mooix:/path/to/object/". May be or'd with nearby - to result in a command that can only act on nearby - objects, or on objects by reference. - tomove The command may result in the object being moved. This is - not a limit per se, but it is useful since it takes care - of appropriate locking to avoid race conditions moving the - object. - single The command may only act on a single object at a time. - -Bars may be used to separate multiple alternatives inside a set of -parentheses. Multiple sets of parentheses may also be used, to specify -multiple required sets of limits. - -For example, this could be used by a look command, which can look at the -room, or at a nearby object (or a referenced object for builders), or at an -object in a container. - - verb - verb, direct_object(this)(nearby|reference) - verb, direct_object(s), io_preposition(in|inside), indirect_object - -If the command matches, a method named _verb is run by default. -Occasionally a command will want to run some other method. If the prototype -for the command ends in a colon and then a method name, the named method -(with "_verb" appended to it) will be run. For example: - - verb, direct_object(this) : someothermethod Index: obj/abstract/builder/safechange_fail_inherited.msg =================================================================== --- obj/abstract/builder/safechange_fail_inherited.msg (revision 0) +++ obj/abstract/builder/safechange_fail_inherited.msg (revision 0) @@ -0,0 +1 @@ +session: That field is inherited. Index: obj/abstract/builder/signal.msg =================================================================== --- obj/abstract/builder/signal.msg (revision 0) +++ obj/abstract/builder/signal.msg (revision 0) @@ -0,0 +1 @@ +session: Signal sent. Index: obj/abstract/builder/show.hlp =================================================================== --- obj/abstract/builder/show.hlp (revision 23) +++ obj/abstract/builder/show.hlp (working copy) @@ -1,56 +0,0 @@ -Examining an object in depth. - -The show command displays information about an object's fields. -The parts of a moo object can be broken down into these broad groups: - -* Fields - - Stuff like the object's name, description, and so on. Anything that - doesn't fit in one of the other categories. - -* Messages - - Fields that are used to display =messages= to the user. Names end in .msg. - -* References - - Fields that point to other moo objects. Examples: location, parent - -* Commands - - Verbs and .cmd fields that together constitute a command that - can be executed on an object. - -* Methods - - Executable functions of the object. The content of the method is not - displayed (you can use =list= to do so). - -* Id - - The mooix id of the object itself. - -If you ask for an object to be shown, the default is to display each of -these parts of the object, but only those that are not inherited from a -parent. To show things that are inherited from a parent as well, use the -=showall= command. - -You can also ask for only one of the above groups. - - > show my fields - Fields: - description Just some guy, you know. - name Joey - -The output shows the names of the fields, and their values (or some summary -of the field's content). A question mark in front means that the field is -undocumented. Generally though fields are documented, and the =usage= -command can be used to get information about any field (or method) that -you're interested in. - -You can also request to see a single field. Note that as a convenience, -this will display even fields that are inherited from the parent. - - > show the ball's bounce.msg - Messages: - * bounce.msg see: $this bounces around $location. Index: obj/abstract/builder/recycle_fail.msg =================================================================== --- obj/abstract/builder/recycle_fail.msg (revision 0) +++ obj/abstract/builder/recycle_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't destroy that. Index: obj/abstract/builder/edit_cannot_read.msg =================================================================== --- obj/abstract/builder/edit_cannot_read.msg (revision 0) +++ obj/abstract/builder/edit_cannot_read.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot read $file; errno $errno. Index: obj/abstract/builder/safechange_create_not_portfolio.msg =================================================================== --- obj/abstract/builder/safechange_create_not_portfolio.msg (revision 0) +++ obj/abstract/builder/safechange_create_not_portfolio.msg (revision 0) @@ -0,0 +1 @@ +session: You can only create new objects in your portfolio. Index: obj/abstract/builder/list_opaque.msg =================================================================== --- obj/abstract/builder/list_opaque.msg (revision 0) +++ obj/abstract/builder/list_opaque.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, that is an opaque method and cannot me listed. Index: obj/abstract/builder/inheritance.hlp =================================================================== --- obj/abstract/builder/inheritance.hlp (revision 23) +++ obj/abstract/builder/inheritance.hlp (working copy) @@ -1,16 +0,0 @@ -How inheritance works. - -Mooix is an classless object oriented system with single inheritance. Each -object can have one parent, which is some other object that is is based on. -An object inherits all fields from its parent (and its parent's ancestors) -that it doesn't override. - -So a new object has the same name and description as its parent object when -it is first made. If a field is =set= to a new value, the new value -overrides the inherited value from the parent object. Later a field might -get =unset= which would expose the inherited value again. - -A good analogy is a set of transparencies on projector. The parent -object is "underneath" the child object, and all of the values on the -parent shine through, unless something is written over top of them, on the -upper transparency. Index: obj/abstract/builder/recycle.msg =================================================================== --- obj/abstract/builder/recycle.msg (revision 0) +++ obj/abstract/builder/recycle.msg (revision 0) @@ -0,0 +1 @@ +session: Object destroyed. Index: obj/abstract/builder/teleport_fail.msg =================================================================== --- obj/abstract/builder/teleport_fail.msg (revision 0) +++ obj/abstract/builder/teleport_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Teleportation failed. Index: obj/abstract/builder/removecommand.hlp =================================================================== --- obj/abstract/builder/removecommand.hlp (revision 23) +++ obj/abstract/builder/removecommand.hlp (working copy) @@ -1,13 +0,0 @@ -Removing a command to an object. - -As a =builder=, you can add simple commands to objects with the -=addcommand= command. To remove commands added in that way, use the -removecommand command: - - > removecommand "kick" from ball - Command removed. - > kick the ball - You can't do that. - -Note that the message added by addcommand (in this case kick.msg) is -also removed. Index: obj/abstract/builder/topography.hlp =================================================================== --- obj/abstract/builder/topography.hlp (revision 23) +++ obj/abstract/builder/topography.hlp (working copy) @@ -1,24 +0,0 @@ -How rooms and exits make a virtual world. - -The world of the moo is essentially a collection of room objects, linked -together by exits that allow for =movement= between them. - -Generally a pair of rooms are linked by a pair of unidirectional exits, but -it doesn't have to be that way. Each room can have any number of exits, -each of which points to some other room (or back to the same room, in -perverse cases). Exits are unidirectional, and so it is possible to make an -exit from room A that leads to room B, while room B has no exit leading to -room A. If you've ever been lost in twisty little passages in Zork, you -know how frustrating that can be. - -There are two conventions used to name exits. Often an exit is just named -with the name of the room it leads to, so a house's living room might have -a "kitchen" exit that goes to the kitchen, an "upstairs" exit that leads -upstairs, an "out" exit that goes out of the house, and so on. Sometimes it -makes more sense to use compass directions, as in a large outdoor area. Be -sure to alias the compass names with n, s, e, and w (and ne, nw, se, sw) -to cut down on the amount of typing required. - -Exits are not (usually) explicitly listed when a user looks at a room, so you -have to give appropriate hints in the room description as to what the -exits are. Index: obj/abstract/builder/list_none.msg =================================================================== --- obj/abstract/builder/list_none.msg (revision 0) +++ obj/abstract/builder/list_none.msg (revision 0) @@ -0,0 +1 @@ +session: No such method. Index: obj/abstract/builder/dig_to_exit.msg =================================================================== --- obj/abstract/builder/dig_to_exit.msg (revision 0) +++ obj/abstract/builder/dig_to_exit.msg (revision 0) @@ -0,0 +1 @@ +session: Added the new exit $toexit_str with parent $exitparent from here $toexit to $room. Index: obj/abstract/builder/dig.hlp =================================================================== --- obj/abstract/builder/dig.hlp (revision 23) +++ obj/abstract/builder/dig.hlp (working copy) @@ -1,42 +0,0 @@ -Adding rooms and exits to the moo. - -The dig command, available only to a =builder=, is used to add rooms and -exits to the moo. See =topography= for an overview of how rooms and exits -work together. - -The command can be used in a number of ways. - - dig "toexit|fromexit" to "roomname" - dig "toexit" to "roomname" - dig "|fromexit" to "roomname" - dig "roomname" - dig "exitspec" to mooix:roomref - -The first of these is the most commonly used. It creates a room named -"roomname", and a pair of exits leading from the current location to that -room and back. The exits are named "toexit" and "fromexit", respectively. - -If you do not want to make one of the exits, leave its name off, as is -shown in the second and third examples above. Leaving off the exit names -entirely will make a room that is not attached to anything and can only be -reached by =teleport=. - -If you give a reference to an existing room instead of a name for -a new room, the exit or exits will be created using the referenced room. -This can be used to tie two existing rooms together. - -The names of the exits can have aliases after them, separated by commans. -So if you are using cardinal directions, you might type: - - dig "north,n|south,s" to "someplace" - -Note that many rooms will not let third parties create working exits in -them. If a room does not have its exit_ok field set, then exits added to -the room by anyone other than its owner will only be usable by the rooms's -owner, and by whoever added the exit, but not by the general populace. - -The dig command tries to make a new room and exits that match the room in -which you run the command. For example, if you're indoors and you dig -another room, the exit to that room should probably be a =door=. Or if -you're in a dark cave then a room you dig to from the cave should also be a -cave. See =terrain= for details. Index: obj/abstract/builder/usage.hlp =================================================================== --- obj/abstract/builder/usage.hlp (revision 23) +++ obj/abstract/builder/usage.hlp (working copy) @@ -1,35 +0,0 @@ -Usage information for methods and fields. - -The usage command displays usage information (from .inf files) for either -every field and method of an object (with a design overview first), or, if -one is specified, for just the single specified field or method. Every -field and method in the core of the moo has this usage information. For -fields, it tell what the field is used for. For methods, it tells what the -method does, what parameters it expects, and what it returns. Some -examples: - - > usage of my name - name - - [From /usr/lib/mooix/concrete/thing] - - A object's primary name (the one to be displayed). Other names for the - object can be set in aliases. - - > usage of ball's drop - drop - - [From /usr/lib/mooix/concrete/thing] - - Called when an object is dropped from some height. Should move the object - to the specified location, and output any messages. - - Returns the object if the move is successful. - - Parameters: - - to where to put the object - avatar who is dropping the object (optional) - -The special design.inf field can be used to give an overview of the design -of an object. Index: obj/abstract/builder/install_bad_object.msg =================================================================== --- obj/abstract/builder/install_bad_object.msg (revision 0) +++ obj/abstract/builder/install_bad_object.msg (revision 0) @@ -0,0 +1 @@ +session: The package wants to add an object to something that is not your portfolio. Not allowing this unsafe operation. Index: obj/abstract/builder/edit_cannot_set.msg =================================================================== --- obj/abstract/builder/edit_cannot_set.msg (revision 0) +++ obj/abstract/builder/edit_cannot_set.msg (revision 0) @@ -0,0 +1 @@ +session: Can't write that field. Index: obj/abstract/builder/set_reference_fail.msg =================================================================== --- obj/abstract/builder/set_reference_fail.msg (revision 0) +++ obj/abstract/builder/set_reference_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to set reference. Index: obj/abstract/builder/safechange_string_to_ref.msg =================================================================== --- obj/abstract/builder/safechange_string_to_ref.msg (revision 0) +++ obj/abstract/builder/safechange_string_to_ref.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot convert a reference to a string. Index: obj/abstract/builder/shortcut.hlp =================================================================== --- obj/abstract/builder/shortcut.hlp (revision 23) +++ obj/abstract/builder/shortcut.hlp (working copy) @@ -1,20 +0,0 @@ -Shortcut references to objects. - -Sometimes the mooix: =reference= to an object is too long to bother typing -all the time. The shortcut command is the solution, creating a quicker way -to reference the object. For example: - - > shortcut mooix:/gosh/this/is/an/annoying/path/to/type as "foo" - Your shortcuts: - mooix:foo (mooix:/gosh/this/is/an/annoying/path/to/type) - > teleport mooix:foo to here - -Old-school lambdamoo types might prefer to use hard-to-remember numbers -as the shortcut names, although you'll still have to type the mooix: stuff -unstead of good old "#". - -You can use the shortcut command alone to list your existing shortcuts. - -Use the unshortcut command to remove any shortcuts to a given object. - - > unshortcut mooix:foo Index: obj/abstract/builder/install_no_package.msg =================================================================== --- obj/abstract/builder/install_no_package.msg (revision 0) +++ obj/abstract/builder/install_no_package.msg (revision 0) @@ -0,0 +1 @@ +session: Package name required. Index: obj/abstract/builder/install_obj_fail_init.msg =================================================================== --- obj/abstract/builder/install_obj_fail_init.msg (revision 0) +++ obj/abstract/builder/install_obj_fail_init.msg (revision 0) @@ -0,0 +1 @@ +session: $obj failed to init Index: obj/abstract/builder/ps.hlp =================================================================== --- obj/abstract/builder/ps.hlp (revision 23) +++ obj/abstract/builder/ps.hlp (working copy) @@ -1,19 +0,0 @@ -Listing running methods. - -The ps command can be used to list running methods of an object. If you run -it without any parameters, it lists all running methods in the whole moo. -Give it an object name or reference and it will list the running methods of -that object. - -The methods are displayed in a tree structure to show which called which. -If there are multiple instances of a method running, the number of -instances will be displayed after its name. - - > ps me - mooix:/var/lib/mooix/system/admin->parse [x2] - \_ mooix:/var/lib/mooix/system/sessionmanager/sessions/item1->prompt - \_ mooix:/var/lib/mooix/system/admin->ps_verb - -In the above example, the mooadmin is logged in twice, and so has two -parse methods, and is running the ps command in one of the two sessions, -while the other waits at the prompt. Index: obj/abstract/builder/reparent_would_loop.msg =================================================================== --- obj/abstract/builder/reparent_would_loop.msg (revision 0) +++ obj/abstract/builder/reparent_would_loop.msg (revision 0) @@ -0,0 +1 @@ +session: That would create a parent loop! Index: obj/abstract/builder/safechange_fail_method_perms.msg =================================================================== --- obj/abstract/builder/safechange_fail_method_perms.msg (revision 0) +++ obj/abstract/builder/safechange_fail_method_perms.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change the permissions of a method. Index: obj/abstract/builder/Makefile =================================================================== --- obj/abstract/builder/Makefile (revision 23) +++ obj/abstract/builder/Makefile (working copy) @@ -1,11 +1,11 @@ build:: ln -f derive.cmd create.cmd - ln -f derive.hlp create.hlp + ln -f derive.hlp.en create.hlp.en ln -f show.cmd showall.cmd ln -f show_verb showall_verb ln -f recycle.cmd destroy.cmd ln -f is.cmd are.cmd clean:: - rm -f create.cmd create.hlp showall.cmd showall_verb destroy.cmd are.cmd + rm -f create.cmd create.hlp.en showall.cmd showall_verb destroy.cmd are.cmd realclean:: Index: obj/abstract/builder/dig_fail_to_exit.msg =================================================================== --- obj/abstract/builder/dig_fail_to_exit.msg (revision 0) +++ obj/abstract/builder/dig_fail_to_exit.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to add an exit from here to $room (contact $owner to get that done). Index: obj/abstract/builder/set_fieldmode_verb =================================================================== --- obj/abstract/builder/set_fieldmode_verb (revision 23) +++ obj/abstract/builder/set_fieldmode_verb (working copy) @@ -3,12 +3,14 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - + my $perm=oct($_{number}); my ($stat, $msg)=$this->safechange( @@ -17,10 +19,12 @@ mode => $_{number}, ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + fail(); } else { - $_{session}->write("$_{field} is now mode $msg."); + $this->msg( 'set_fieldmode', msg => $msg, %_ ); } } Index: obj/abstract/builder/removecommand.msg =================================================================== --- obj/abstract/builder/removecommand.msg (revision 0) +++ obj/abstract/builder/removecommand.msg (revision 0) @@ -0,0 +1 @@ +session: Command removed. Index: obj/abstract/builder/portfolio_none.msg =================================================================== --- obj/abstract/builder/portfolio_none.msg (revision 0) +++ obj/abstract/builder/portfolio_none.msg (revision 0) @@ -0,0 +1 @@ +session: No portfolio. Index: obj/abstract/builder/reparent.cmd =================================================================== --- obj/abstract/builder/reparent.cmd (revision 23) +++ obj/abstract/builder/reparent.cmd (working copy) @@ -1,3 +1,3 @@ # Note that this may not use (limits) that do any locking, as it has to # exclusively lock both objects. -verb(this), direct_object(anywhere|reference), indirect_object(anywhere|reference) +verb(this), direct_object(anywhere|reference), io_preposition(to), indirect_object(anywhere|reference) Index: obj/abstract/builder/safechange_bad_mode.msg =================================================================== --- obj/abstract/builder/safechange_bad_mode.msg (revision 0) +++ obj/abstract/builder/safechange_bad_mode.msg (revision 0) @@ -0,0 +1 @@ +session: The requested mode is not allowed. Index: obj/abstract/builder/install_obj_fail_upgrade.msg =================================================================== --- obj/abstract/builder/install_obj_fail_upgrade.msg (revision 0) +++ obj/abstract/builder/install_obj_fail_upgrade.msg (revision 0) @@ -0,0 +1 @@ +session: $obj failed up upgrade Index: obj/abstract/builder/safechange_bad_parent.msg =================================================================== --- obj/abstract/builder/safechange_bad_parent.msg (revision 0) +++ obj/abstract/builder/safechange_bad_parent.msg (revision 0) @@ -0,0 +1 @@ +session: Bad parent object. Index: obj/abstract/builder/list_verb =================================================================== --- obj/abstract/builder/list_verb (revision 23) +++ obj/abstract/builder/list_verb (working copy) @@ -8,17 +8,23 @@ my $field=$_{field}; my $fieldfile=$object->fieldfile($field); if (! $fieldfile) { - fail "No such method."; + $this->msg( 'list_none', %_ ); + fail(); } elsif (! -f $fieldfile) { - fail "Cannot list that."; + $this->msg( 'list_cannot', %_ ); + fail(); } my $opaque=".$field-opaque"; if ($object->$opaque) { - fail "Sorry, that is an opaque method and cannot me listed."; + $this->msg( 'list_opaque', %_ ); + fail(); } - open (METHOD, $fieldfile) || fail "Unable to read method."; + if( ! open (METHOD, $fieldfile) ) { + $this->msg( 'list_cannot_read', %_ ); + fail(); + } my @lines=; close METHOD; @@ -26,13 +32,17 @@ if (-x $fieldfile && $lines[0] !~ /^#!.*\/(.+)/) { $fieldfile.=".c"; if (-e $fieldfile) { - open (METHOD, $fieldfile) || fail "Unable to read method."; + if( ! open (METHOD, $fieldfile) ) { + $this->msg( 'list_cannot_read', %_ ); + fail(); + } @lines="That is a binary method, but this might be its source code:", push @lines, ; close METHOD; } else { - fail "That is a binary method, and the source is not available."; + $this->msg( 'list_binary', %_ ); + fail(); } } Index: obj/abstract/builder/safechange_fail_ref_list.msg =================================================================== --- obj/abstract/builder/safechange_fail_ref_list.msg (revision 0) +++ obj/abstract/builder/safechange_fail_ref_list.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot create a new sticky reference list. Index: obj/abstract/builder/list_cannot_read.msg =================================================================== --- obj/abstract/builder/list_cannot_read.msg (revision 0) +++ obj/abstract/builder/list_cannot_read.msg (revision 0) @@ -0,0 +1 @@ +session: Unable to read method. Index: obj/abstract/builder/safechange_change_own_ref.msg =================================================================== --- obj/abstract/builder/safechange_change_own_ref.msg (revision 0) +++ obj/abstract/builder/safechange_change_own_ref.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change one of your own reference fields. Index: obj/abstract/builder/show_verb =================================================================== --- obj/abstract/builder/show_verb (revision 23) +++ obj/abstract/builder/show_verb (working copy) @@ -137,8 +137,9 @@ my $object=$_{direct_object} || $this->usage("bad direct object"); # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $showall=1 if $0 =~ /showall/; @@ -164,12 +165,14 @@ push @{$cats{methods}}, $field; push @{$types{$field}}, 'methods'; next; - } - else { + } else { # It's hard to tell if these should only # show on showall, or not. $inheritedfields{$field} = 0; - # Fall through to normal field processing.. + + push @{$cats{methods}}, $field; + push @{$types{$field}}, 'methods'; + next; } } @@ -184,15 +187,15 @@ push @{$types{$field}}, 'messages'; $documented{$field}=1; # don't need docs } - elsif ($field =~ /\.cmd$/) { + elsif ($field =~ /\.cmd(\.[-a-z]+)?$/) { push @{$cats{commands}}, $field; push @{$types{$field}}, 'commands'; $documented{$field}=1; # don't need docs } - elsif ($field =~ /(.*)\.inf$/) { + elsif ($field =~ /(.*)\.inf(\.[-a-z]+)?$/) { $documented{$1}=1; } - elsif ($field =~ /(.*)\.hlp$/) { + elsif ($field =~ /(.*)\.hlp(\.[-a-z]+)?$/) { $documented{$1}=1; } else { @@ -217,7 +220,8 @@ return; } elsif (exists $_{field} && ! exists $cats{$_{field}}) { - fail "No such category or field."; + $this->msg( 'show_none', %_ ); + fail(); } # Generate output. @@ -239,8 +243,11 @@ } } - fail "Nothing to show; perhaps you should use showall." - if ! @ret && ! $showall; + if( ! @ret && ! $showall ) + { + $this->msg( 'show_nothing', %_ ); + fail(); + } # Page result. $_{session}->page(@ret); Index: obj/abstract/builder/teleport =================================================================== --- obj/abstract/builder/teleport (revision 0) +++ obj/abstract/builder/teleport (revision 0) @@ -0,0 +1,48 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + my $object = $_{object}; + my $destination = $_{destination}; + + # Let's see if the destination can even heft the object. + if( $destination && $destination->maxweight && + $object->_mass + $destination->_mass > $destination->maxweight ) { + $this->msg('teleport_fail_heavy', %_); + fail(); + } + + my $oldloc = $object->location; + + # Teleport to an exit goes to the exit's destination. + if ($destination && $destination->isa($Mooix::Root->concrete->exit)) { + $destination=$destination->destination; + } + + # TODO some rooms may want to disallow teleports into/out of them. + + if ($oldloc == $destination) { + if ($object == $this) { + $this->msg('teleport_fail_user_already_there', %_); + fail(); + } else { + $this->msg('teleport_fail_already_there', %_); + fail(); + } + } + + # Note the use of the teleport flag, to let move know that even + # normally immobile objects should be 'ported, if possible. + $object->msg('teleport', %_, (destination => $destination ? $destination : 'limbo')); + if ($object->physics->move(object => $object, to => $destination, teleport => 1 )) { + $oldloc->msg('teleport_leave', %_, originator => $object) + if $oldloc; + $destination->msg('teleport_arrive', %_, skip => $object, originator => $object) + if $destination; + } else { + $this->msg('teleport_fail', %_); + fail(); + } +} Property changes on: obj/abstract/builder/teleport ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/builder/set_reference.msg =================================================================== --- obj/abstract/builder/set_reference.msg (revision 0) +++ obj/abstract/builder/set_reference.msg (revision 0) @@ -0,0 +1 @@ +session: Reference set. Index: obj/abstract/builder/edit_verb =================================================================== --- obj/abstract/builder/edit_verb (revision 23) +++ obj/abstract/builder/edit_verb (working copy) @@ -8,11 +8,13 @@ my $object=$_{direct_object} || $this->usage("bad direct object"); my $field=$_{field} || ''; my $session=$_{session} || $this->usage("bad session"); + my $avatar = $_{avatar}; # Don't let a builder spoof a programmer that they own to call this # method. if ($_{avatar} != $this) { - fail "No!"; + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $contents=""; @@ -20,7 +22,14 @@ # methods, as overriding a method does not require editing it. my $file=$object->fieldfile($field); if (-e $file && (! -x $file || $file !~ m/parent\//)) { - open (IN, $file) || fail "Cannot read $file ($!)"; + if( ! open (IN, $file) ) { + $this->msg( 'edit_cannot_read', + file => $file, + errno => $!, + %_ + ); + fail(); + } local $/ = undef; $contents=; close IN; @@ -35,8 +44,11 @@ (map {( value => $_ )} split("\n", $contents, -1)), ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + $this->msg( 'edit_cannot_set', %_ ); + fail(); } # Tell the session to start the edit. It will call edit_finish when @@ -48,9 +60,10 @@ ); if ($status) { - $session->write("Edit in progress."); + $this->msg( 'edit', %_ ); } else { - fail "Edit failed."; + $this->msg( 'edit_fail', %_ ); + fail(); } } Index: obj/abstract/builder/shortcut_fail_remove.msg =================================================================== --- obj/abstract/builder/shortcut_fail_remove.msg (revision 0) +++ obj/abstract/builder/shortcut_fail_remove.msg (revision 0) @@ -0,0 +1 @@ +session: Could not remove the shortcut. Index: obj/abstract/builder/teleport_fail_heavy.msg =================================================================== --- obj/abstract/builder/teleport_fail_heavy.msg (revision 0) +++ obj/abstract/builder/teleport_fail_heavy.msg (revision 0) @@ -0,0 +1 @@ +session: It's too heavy for $destination to hold. Index: obj/abstract/builder/classes_verb =================================================================== --- obj/abstract/builder/classes_verb (revision 23) +++ obj/abstract/builder/classes_verb (working copy) @@ -7,8 +7,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my @ret; Index: obj/abstract/builder/addcommand_already.msg =================================================================== --- obj/abstract/builder/addcommand_already.msg (revision 0) +++ obj/abstract/builder/addcommand_already.msg (revision 0) @@ -0,0 +1 @@ +session: There is already a command $command defined on that object. Index: obj/abstract/builder/derive.cmd =================================================================== --- obj/abstract/builder/derive.cmd (revision 23) +++ obj/abstract/builder/derive.cmd (working copy) @@ -1,3 +1,5 @@ verb(this), quote, direct_object(nearby|reference) : derive +verb(this), quote, do_preposition, direct_object(nearby|reference) : derive +verb(this), do_preposition, direct_object(nearby|reference) : derive verb(this), direct_object(nearby|reference) : derive - +verb(this), direct_object(nearby|reference), io_preposition, quote : derive Index: obj/abstract/builder/shortcut_fail_remove_link.msg =================================================================== --- obj/abstract/builder/shortcut_fail_remove_link.msg (revision 0) +++ obj/abstract/builder/shortcut_fail_remove_link.msg (revision 0) @@ -0,0 +1 @@ +session: Could not remove the old link! Index: obj/abstract/builder/teleport_self_verb =================================================================== --- obj/abstract/builder/teleport_self_verb (revision 0) +++ obj/abstract/builder/teleport_self_verb (revision 0) @@ -0,0 +1,19 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + $this->exec->teleport( + %_, + object => $this, + destination => $_{direct_object}, + ); +} Property changes on: obj/abstract/builder/teleport_self_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/builder/messages.hlp =================================================================== --- obj/abstract/builder/messages.hlp (revision 23) +++ obj/abstract/builder/messages.hlp (working copy) @@ -1,103 +0,0 @@ -Writing messages. - -Objects in the moo use message fields to hold messages that are displayed -when various things happen. When a ball bounces, its bounce method displays -its bounce.msg to everyone in the location it is bouncing in. An object -derived from the ball might bounce differently, and so a =builder= can -change the bounce.msg to display something else, without having to do any -programming or modification of the bounce method. Thus, message fields -break out the parts a builder will want to modify from the parts that are -the domain of the programmer. - -Each message field has a name ending in ".msg". Each field can hold -multiple messages. One of the messages is picked, at random, when the field -is displayed. - -Messages are normally shown both to the avatar who triggers them, and to -anyone else in the room. Often such a message needs to be conjugated -differently for these two audiences; the avatar might see, "You kick the -ball.", while someone else in the room should see, "Bob kicks the ball." -The message system can create both of these messages from a single message -specification. In more complex circumstances, there might be more than two -audiences, or very different messages might be appropriate for the -different audiences, or you might want to specify what one avatar feels or -tastes or smells. The message format can deal with those circumstances too, -by the use of limits. - -The format of a message field is something like this: - - feel,$opponent: $avatar hits you with $weapon. Ouch! - see: $avatar $avatar->verb(hits) $opponent with $weapon! - feel,$avatar: You swing $weapon and hit something. - hear(90): $avatar $avatar->verb(grunts), and steel clashes! - - see: $avatar $avatar->verb(swings) $weapon at $opponent, but misses. - $avatar: You miss $opponent. - hear: $weapon whistles through the air. - -This sample message field has two messages in it. Each message is composed -of a number of lines. When delivering a message to some object, the moo -will go through the lines in order, and deliver the first text whose -criteria succeed. This is done for each object the message is delivered to, -so different objects can get different texts. If nothing matches, the -message is not delivered to that object. - -The criteria are of three kinds. You can specify the sense or senses that a -message uses. Any of the five senses can be used (see, hear, feel, smell, -taste), and others can easily be added. When specifying a sense, you can -put an intensity in parens after it, to indicate how intense the sensory -input it, ranging from 0 (which is not normally noticeable) through the -default of 50, to 100, which cannot be ignored unless you're unconscious. In -the above example, the clang of steel on steel is quite loud so the -intensity is adjusted up from the default. - -The second criteria you can use is the variable that refers to an object. -This limits the message to being delivered to the object that the variable -refers to, and no others. See below for more on the object variables. - -The third criteria you can use is the special flag, "session". This makes -the message only be shown to the session of the originator of the message -in which the command was run that resulted in the message. This is useful -in a few cases like the who and look commands, which should only display a -message to the avatar who initiated them, and only in the session where the -command was run. - -The messages texts are a mixture of English text and some special -variables. The variables are replaced with the names of objects, and other -stuff when the message is filled out and displayed. - -For example, in the text, "$avatar $avatar->verb(hits) $opponent with -$weapon!", "$weapon" is a variable that refers to the weapon being used, -and "$avatar" and "$opponent" refer to the combatants. When the message -is filled out, these variables are replaced with the names of the object, -and it even takes care of adding an appropriate article, and doing the -appropriate capitalization, so "$weapon" might become "a broadsword", while -"$avatar" might turn into "Conan". The available variables vary from -message to message, though "$location" will frequently be available, and -"$avatar" will generally be the avatar who initiated the action. - -A message text can also have what look like method calls or field accesses -in them, if you're familiar with perl. Stuff like: "$this->description" -These are not really method calls or field accesses (they are rather -limited), but they work much the same. The above example expands to the -description field of the object whose message is being expanded. One -special class of these pseudo-field-accesses that will frequently be used -is the =pronoun=. - -A message text can have the special "$object->verb(word)" form. In the -above example, "$avatar->verb(hits)". This is used to conjugate a verb -relative to an object. So if the message is delivered to the avatar object, -the verb will become "hit", otherwise it will be "hits". The conjugation -code is, for speed, very stupid -- it just removes the 's' at the end. For -irregular verbs where this fails, you can supply the first-person form of -the verb after the third-person form, separating them with a comma: - - see: $avatar $avatar->verb(tries,try) to climb the mountain. - -If you put a \n in a message, that turns into a newline when the message is -displayed. Messages are word-wrapped automatically, so you should rarely -need to do that. - -Finally, message texts can have xml tags in them. The tags are stripped out -by any mooix sessions that do not understand them. This is mostly for -future expansion. Index: obj/abstract/builder/portfolio_verb =================================================================== --- obj/abstract/builder/portfolio_verb (revision 23) +++ obj/abstract/builder/portfolio_verb (working copy) @@ -6,8 +6,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $pobj=$this; @@ -15,7 +16,8 @@ $pobj=$_{direct_object}; } if (! ref $pobj->portfolio) { - fail "No portfolio."; + $this->msg( 'portfolio_none', %_ ); + fail(); } my @pobjs = $pobj->portfolio->list; Index: obj/abstract/builder/signal_fail.msg =================================================================== --- obj/abstract/builder/signal_fail.msg (revision 0) +++ obj/abstract/builder/signal_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to send signal. Index: obj/abstract/builder/reparent_loop.msg =================================================================== --- obj/abstract/builder/reparent_loop.msg (revision 0) +++ obj/abstract/builder/reparent_loop.msg (revision 0) @@ -0,0 +1 @@ +session: There seems to be a parent loop! Index: obj/abstract/builder/safechange_object_already.msg =================================================================== --- obj/abstract/builder/safechange_object_already.msg (revision 0) +++ obj/abstract/builder/safechange_object_already.msg (revision 0) @@ -0,0 +1 @@ +session: Object already exists. Index: obj/abstract/builder/install_fail_owner_links.msg =================================================================== --- obj/abstract/builder/install_fail_owner_links.msg (revision 0) +++ obj/abstract/builder/install_fail_owner_links.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to set owner links properly. Index: obj/abstract/builder/reparent.hlp =================================================================== --- obj/abstract/builder/reparent.hlp (revision 23) +++ obj/abstract/builder/reparent.hlp (working copy) @@ -1,15 +0,0 @@ -Change the parent of an object. - -The reparent command can be used to change the parent of an object. This -can be used by the admin to make an avatar a builder or programmer, or to -demote a user to a lesser privilege level. The reparented object sent a -message to let it know it has changed class. - - > reparent Bob to mooix:abstract/programmer - Bob is now a programmer. - -A =builder= can use the reparent command only to change the parents of -objects they own (and not of themselves). - -It can theoretically be used to change any object into any other type of -object, but in practice that may not always work. Index: obj/abstract/builder/list_cannot.msg =================================================================== --- obj/abstract/builder/list_cannot.msg (revision 0) +++ obj/abstract/builder/list_cannot.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot list that. Index: obj/abstract/builder/teleport_in_verb =================================================================== --- obj/abstract/builder/teleport_in_verb (revision 0) +++ obj/abstract/builder/teleport_in_verb (revision 0) @@ -0,0 +1,19 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + $this->exec->teleport( + %_, + object => $_{direct_object}, + destination => $this->location, + ); +} Property changes on: obj/abstract/builder/teleport_in_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/builder/safechange_fail_avatar.msg =================================================================== --- obj/abstract/builder/safechange_fail_avatar.msg (revision 0) +++ obj/abstract/builder/safechange_fail_avatar.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot create avatars. Index: obj/abstract/builder/safechange_field_to_ref_list.msg =================================================================== --- obj/abstract/builder/safechange_field_to_ref_list.msg (revision 0) +++ obj/abstract/builder/safechange_field_to_ref_list.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot turn a field into a sticky reference list. Index: obj/abstract/builder/builder.hlp =================================================================== --- obj/abstract/builder/builder.hlp (revision 23) +++ obj/abstract/builder/builder.hlp (working copy) @@ -1,28 +0,0 @@ -Introduction to building the moo. - -As a builder, you have the power to add objects to the moo, modify the -objects you've created, and perhaps some others as well. You can also -examine the whole moo in detail and =teleport= around. - -With this power comes responsibility, and perhaps a little less fun. If -you're faced with a locked door, as a builder, you can teleport right past -it, or look up the condition it needs to open and arrange for that -condition to be met. A whole puzzle or quest is thus bypassed, and the -world of the moo loses its mystery. And perhaps that room is a private -space, into which it would be very rude, or even virtually criminal to -break in. - -As a builder you can add objects to the moo that break with the theme of -the world. You can really mess with people, teleporting them hither and -yon. The opportunities for doing something that will cause you to lose your -builder status abound. At the same time, building a moo can be quite -satisfying to those with the right mindset. Just think before you do, -mmkay? - -With that out of the way, you might want to get started by reading the -=builder-tutorial=. Or, check out the documentation for the =derive=, -=dig=, =show=, =set=, =teleport=, =portfolio=, =classes=, =recycle=, -and =addcommand= commands and the object =messages=, =reference= and -=inheritance= documentation. - -See also: =basics= Index: obj/abstract/builder/addcommand.hlp =================================================================== --- obj/abstract/builder/addcommand.hlp (revision 23) +++ obj/abstract/builder/addcommand.hlp (working copy) @@ -1,35 +0,0 @@ -Adding a command to an object. - -As a =builder=, you can add simple commands to objects with the -addcommand command. No programming is needed to do this. For example: - - > addcommand "kick" to ball - Command added. Set kick.msg to customize. - > kick the ball - You kick the ball. - -The =removecommand= command removes commands from objects. - -Once you're added a command, you will probably want to customize the -messages associated with it. In the above example, the kick command uses -a kick.msg. It is filled in with something reasonable, but better =messages= -are certainly possible. - -You can also edit the syntax of the command itself, adding other parts -of speech (perhaps an indirect object or a preposition or a quote should -be part of the command), and limiting when the command can be used. That -gets pretty involved, so see =commands= for details. - -Here is a more complicated example, of a megaphone object, which can be -spoken into. - - > derive a "megaphone" from mooix:thing - Object created (mooix:portfolio/megaphone). - > addcommand "say" to megaphone - Command added. Set say.msg to customize. - > megaphone's say.cmd is "verb, quote, direct_object(this)(present) : generic" - Set. - > megaphone's say.msg is "Hear: $avatar $avatar->verb(speaks) into $this, and it blares out loudly: $quote" - Set. - > say "testing 1 2 3" to the megaphone - You speak into the megaphone, and it blares out loudly: testing 1 2 3 Index: obj/abstract/builder/install_fail_create.msg =================================================================== --- obj/abstract/builder/install_fail_create.msg (revision 0) +++ obj/abstract/builder/install_fail_create.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to create objects from this package. Index: obj/abstract/builder/teleport.inf =================================================================== --- obj/abstract/builder/teleport.inf (revision 0) +++ obj/abstract/builder/teleport.inf (revision 0) @@ -0,0 +1,2 @@ +Called by the various teleport_*_verb commands to do the actual +teleportation. Index: obj/abstract/builder/messagefilter.hlp =================================================================== --- obj/abstract/builder/messagefilter.hlp (revision 23) +++ obj/abstract/builder/messagefilter.hlp (working copy) @@ -1,62 +0,0 @@ -Message filters. - -The moo has support for filtering =messages= when they're sent to someone. -The filters can adjust the intensity of various senses of the message, -which might make the intended recipient miss it, or perceive it with a -different sense than usual. This is very flexible, and is the way to get -effects such as these in the moo, with little or no programming: - - - dark rooms - - deafness, blindness - - light sources - - one-way mirrors - - containers that block sound when they're closed - -All this is accomplished by adding message filter objects to the -messagefilters list of an object. The message filter objects are children -of mooix:abstract/messagefilter, and have various fields, like filter_see -and filter_hear, that determine how messages get filtered. They can also -have a filtermessage method that is run for each message, for more dynamic -effects. - -To make a message filter apply to an object, add it to the object's -messagefilters list. There's a filter command that you can use to do that: - - > filter object with messagefilter - -Once a filter is added, it will be used to filter messages that pass by the -object. There are several reasons a message might pass by an object, and -whether a filter triggers on messages of each type depends on the value of -its *_triggered fields. - - to_triggered The message is being delivered to the object. - in_triggered The object is a container, and the message is being passed - in from outside to its contents. - out_triggered The message originated inside the container, and is passing - out of the container. - inter_triggered The message originated inside the container, and is being - sent to another object also inside it. - -Message filters can be set to filter messages that have passed by them for -any of the above reasons, or for a combination of reasons. - -For example, a container might have a message filter that blocks any sound -from entering or exiting. You would do this by making it in_triggered and -out_triggered, and setting filter_hear to 100, to decrease the volume of any -sounds by 100, which will block almost any sound. - -Another example is a dark room. While deriving from mooix:filter/dark and -dropping the resulting object is the easy way, you could also manually -create a message filter, make it inter_triggered, in_triggered and -out_triggered, set its filter_hear to 100, and add it to the room's -messagefilters list. This would be a better approach if you're creating a -whole class of dark rooms, perhaps for a cave. It's also just what -mooix:dark does when it's dropped. - -Making an avatar blind is similar, except you should make the filter -to_triggered, so only messages to the avatar are filtered, and not messages -to or from its contents. - -These examples only scratch the surface; with a little ingenuity you can -do amazing things with message filters. Don't forget that a message filter -can also increase the intensity of a message. Index: obj/abstract/builder/set.hlp =================================================================== --- obj/abstract/builder/set.hlp (revision 23) +++ obj/abstract/builder/set.hlp (working copy) @@ -1,36 +0,0 @@ -Setting fields. - -This command is used to set a field to a textual or numeric value. There -are really two ways to set a field: - - > set my name to "Bob" - > my name is "Bob" - -Some fields are pure boolean values, true or false. There is a special way -to set and unset those. For example, to set your "ugly" field to 0, and the -ball's "round" field to 1: - - > I am not ugly. - > The ball is round - -Setting a field that was previously inherited from the parent object -overrides the parent's value (see =inheritance= for details). The set -command can also create entirely new fields that are not present in the -parent object. Conversely, the =unset= command can unset fields. - -It's possible for a field to have a list of values. For example, the alias -field can store any number of aliases for an object's name. To manipulate -these with the set command, you tell it which item in the list to set. -Adding a new item is accomplished by giving a number that's not in the list -yet. - - > my alias is "Bobby" - > my second alias is "hey you" - > my second alias is "Count Zero" - > show my alias - Fields: - aliases Bobby - Count Zero - -Beware of giving multiple values to a field unless it is documented to -accept multiple values. That can really confuse the system. Index: obj/abstract/builder/install_names.msg =================================================================== --- obj/abstract/builder/install_names.msg (revision 0) +++ obj/abstract/builder/install_names.msg (revision 0) @@ -0,0 +1 @@ +$name ($ref) Index: obj/abstract/builder/classes.hlp =================================================================== --- obj/abstract/builder/classes.hlp (revision 23) +++ obj/abstract/builder/classes.hlp (working copy) @@ -1,8 +0,0 @@ -Listing available object classes. - -The classes command lists some object classes provided by the moo that a -builder will often find useful as parents to =derive= new objects from. -Like =portfolio=, the classes command lists the names of objects a -=reference= to each. - -The objects listed are simple all objects in mooix:concrete/ Index: obj/abstract/builder/safechange_fail_own_ref.msg =================================================================== --- obj/abstract/builder/safechange_fail_own_ref.msg (revision 0) +++ obj/abstract/builder/safechange_fail_own_ref.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot set references on your avatar. Index: obj/abstract/builder/install_verb =================================================================== --- obj/abstract/builder/install_verb (revision 23) +++ obj/abstract/builder/install_verb (working copy) @@ -9,19 +9,35 @@ #use Mooix::Root; use warnings; use strict; + +sub name_and_ref { + my $name_field = shift; + my $obj = shift; + my $refstring = shift; + my $avatar = shift; + + my $retval = $name_field; + $retval =~ s/\$name/$obj->prettyname( recipient => $avatar )/eg; + $retval =~ s/\$ref/$refstring/g; + return $retval; +} + run sub { my $this=shift; %_=@_; my $package = $_{direct_object}; my $session = $_{session}; my $destination = $this->portfolio; + my $avatar = $_{avatar}; if (! $destination) { - fail "You have no portfolio."; + $this->msg( 'install_none', %_ ); + fail(); } if (! ref $package) { - fail "direct object required"; + $this->msg( 'install_no_package', %_ ); + fail(); } if (! $package->implements('install')) { @@ -31,7 +47,8 @@ # Get the serialisation for the package contents. my @s = $package->install(destination => $destination, session => $session); if (! @s) { - fail "Install failed."; + $this->msg( 'install_package_fail', %_ ); + fail(); } # Look through the serialisation: @@ -55,13 +72,17 @@ # Don't let an object be added outside the # destination, say to some other thingset. my $id=$obj; - if (! ($id =~ s/^$destination\/+//) || $id =~ /\//) { - fail "The package wants to add an object to something that is not your portfolio. Not allowing this unsafe operation."; + if (! ($id =~ s/^$destination\/+//) || $id =~ /\//) + { + $this->msg( 'install_bad_object', %_ ); + fail(); } } else { - if (ref Mooix::Thing->get($obj)) { - fail "The package seems to want to modify an existing object ($obj). Not allowing this unsafe operation."; + if (ref Mooix::Thing->get($obj)) + { + $this->msg( 'install_modify', obj => $obj, %_ ); + fail(); } } @@ -99,7 +120,8 @@ # objects, and warnings. my @ret = $this->safechange(@s_rest); if (! @ret) { - fail "Install failed."; + $this->msg( 'install_fail_create', %_ ); + fail(); } my @newobjs; $stanza=0; @@ -111,8 +133,9 @@ push @newobjs, ref $msg ? $msg : ''; } - if (! $stat) { - $session->write("Warning: $msg"); + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); } } @@ -121,13 +144,15 @@ # init first. foreach my $obj (grep ref, @newobjs) { if (! $obj->init) { - $session->write("$obj failed to init"); + $this->msg( 'install_obj_fail_init', obj => $obj, %_ ); + fail(); } } if ($package->dbversion < $Mooix::Root->system->mooinfo->dbversion) { foreach my $obj (grep ref, @newobjs) { if (! $obj->upgrade(oldversion => $package->dbversion)) { - $session->write("$obj failed up upgrade"); + $this->msg( 'install_obj_fail_upgrade', obj => $obj, %_ ); + fail(); } } } @@ -153,14 +178,15 @@ @ret = $this->safechange(@s_munged); if (! @ret) { - $session->write("Failed to set owner links properly."); + $this->msg( 'install_fail_owner_links', %_ ); } while (@ret) { my $stat = shift @ret; my $msg = shift @ret; - if (! $stat) { - $session->write("Warning: $msg"); + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); } } } @@ -169,7 +195,8 @@ my @toplevel=grep { ref && $_->encapsulator == $this->portfolio } @newobjs; if (! @toplevel) { - fail "Install failed."; + $this->msg( 'install_fail_find', %_ ); + fail(); } # Move objects with no location to the avatar. @@ -184,11 +211,20 @@ # Final message. my @refstrings = $this->refstring(@toplevel); - $session->write("Installed ". - join(" and ", map { - $_->prettyname." (".shift(@refstrings).")" - } @toplevel). - "."); + my $name_field_name = 'install_names.msg'; + my $name_field = $this->$name_field_name; + $this->msg( 'install', + objects => $#toplevel > 0 + ? join( + $avatar->language->list_seperator, + map { + name_and_ref( $name_field, $_, shift(@refstrings), $avatar ) + } @toplevel[0 .. $#toplevel-1] + ) + . $avatar->language->list_seperator_last + . name_and_ref( $name_field, $toplevel[-1] shift(@refstrings), $avatar ) + : name_and_ref( $name_field, $toplevel[0] shift(@refstrings), $avatar ) + %_ ); # Make "it" or "them" point to the new objects. print "$_\n" foreach @toplevel; Index: obj/abstract/builder/terrain.hlp =================================================================== --- obj/abstract/builder/terrain.hlp (revision 23) +++ obj/abstract/builder/terrain.hlp (working copy) @@ -1,59 +0,0 @@ -Creating new types of terrain. - -The =dig= command tries to make a new room and exits that match the room in -which you run the command. For example, if you're indoors and you dig -another room, the exit to that room should probably be a =door=. Or if -you're in a cave (a class of room whose =messagefilter= makes it pitch -black), then a room you dig to from the cave should also be a cave. -Broadly, new rooms and exits are created to go with the current type of -terrain. - -A terrain is just a room, from which other rooms are derived. The terrain -can set the default values of various fields, like the room's description. -It might have =messagefilters= applied to it. One important field is the -exittype field, which controls what kind of exits are used to connect -rooms. - -It's a good idea to keep your terrain template rooms separate from the -rooms that are really used in the moo. After all, you wouldn't want to -accidentially =destroy= the terrain that is the parent of a lot of other -rooms. Let's create a cave template; this same technique can be used for -any other types of terrain you want to make. - - > dig "cave" - Created a room (mooix:portfolio/cave). - > teleport to it - You are teleported to the cave. - > describe here as "A limestone cave." - > derive from mooix:filter/dark - Object created (mooix:portfolio/dark). - > drop it - You drop the darkness. - > it is immobile - Set. - > look - It's dark. - -That's the basic object setup, which we want to avoid repeating for other -cave rooms. It could be more elaborate: You might also create a special -exit class with arrive.msg and leave.msg set to something appropriate, and -set the room's exittype to that exit. - -Now teleport out of the terrain template room, and go to wherever you want -the real cave to be. Instead of using the dig command, which does not let -you specify the parent of the room, use the create command to make a room -based on your template. Then you can use dig to add exits. - - > teleport me to mooix:portfolio/gulley - > create a mooix:portfolio/cave called "cave mouth" - Object created (mooix:portfolio/cave_mouth). - > teleport it out - The cave mouth vanishes. - > dig "in|out" to it - Added an exit (mooix:portfolio/in) from here in to the cave mouth. - Added an exit (mooix:portfolio/out) from the cave mouth out to here. - > go in - It's dark. - -Now you can dig all you like, and it will figure out that you're in a cave -and keep making rooms of that type. Index: obj/abstract/builder/set_reference_verb =================================================================== --- obj/abstract/builder/set_reference_verb (revision 23) +++ obj/abstract/builder/set_reference_verb (working copy) @@ -9,10 +9,12 @@ my $field=$_{field} or $this->usage("bad field"); my $index=$_{number} || 1; # index is 1-based my $val=$_{indirect_object} or $this->usage("bad indirect object"); + my $avatar = $_{avatar}; - # Sntispoofing. - if ($_{avatar} != $this) { - fail "No!"; + # Antispoofing. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if ($field eq 'parent') { @@ -24,7 +26,8 @@ # Prevent accidental overwrite of text field with reference. if ($object->defines($field) && ! -k $object->fieldfile($field) && ! ref $object->$field) { - fail "That field is a string value, not a reference."; + $this->msg( 'set_reference_not', %_ ); + fail(); } my @vals=$object->$field; @@ -44,10 +47,14 @@ (map { (value => $_ ) } @vals), ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + $this->msg( 'set_reference_fail', %_ ); + fail(); } else { - $_{session}->write("Set."); + $this->msg( 'set_reference', %_ ); + fail(); } } Index: obj/abstract/builder/show_nothing.msg =================================================================== --- obj/abstract/builder/show_nothing.msg (revision 0) +++ obj/abstract/builder/show_nothing.msg (revision 0) @@ -0,0 +1 @@ +session: Nothing to show; perhaps you should use showall. Index: obj/abstract/builder/derive_verb =================================================================== --- obj/abstract/builder/derive_verb (revision 23) +++ obj/abstract/builder/derive_verb (working copy) @@ -4,10 +4,12 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $object=$_{direct_object} || $this->usage("bad direct object"); @@ -24,7 +26,7 @@ # Make the object. my ($stat, $val, $nstat, $nmsg) = $this->safechange( - object => $this->portfolio."/".$id, + object => $this->portfolio."/".$avatar->dexml( avatar => $avatar, text => $id ), newid => 1, field => "parent", value => $object, @@ -37,11 +39,14 @@ ) : '' ) ); - if (! $stat) { - fail $val; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $val, %_ ); + fail(); } if (exists $_{quote} && ! $nstat) { - $session->write("Problem setting name: $nmsg"); + $this->msg( 'derive_fail_name', %_ ); + $avatar->msg( $nmsg, %_ ); } my $obj = $val; $obj->init; @@ -52,7 +57,9 @@ $obj->physics->move(object => $obj, to => $this->location); } - $session->write("Object created (".$this->refstring($obj).")."); + $this->msg( 'derive', + ref => $this->refstring($obj), + %_ ); # Cause "it" to be updated to point to the new object. print $obj."\n"; Index: obj/abstract/builder/derive_fail_name.msg =================================================================== --- obj/abstract/builder/derive_fail_name.msg (revision 0) +++ obj/abstract/builder/derive_fail_name.msg (revision 0) @@ -0,0 +1 @@ +session: Problem setting name: Index: obj/abstract/builder/portfolio.hlp =================================================================== --- obj/abstract/builder/portfolio.hlp (revision 23) +++ obj/abstract/builder/portfolio.hlp (working copy) @@ -1,16 +0,0 @@ -Display your portfolio. - -A =builder= has a portfolio, which lists every object they have made. The -portfolio command can be used to display the portfolio. - - > portfolio - ball (mooix:portfolio/ball) - box (mooix:portfolio/box) - -The thing in parentheses is a the =reference= you can use to refer to the -object. - -You can also use this command to look at the portfolios of other builders: - - > portfolio of bob - ... Index: obj/abstract/builder/derive.hlp =================================================================== --- obj/abstract/builder/derive.hlp (revision 23) +++ obj/abstract/builder/derive.hlp (working copy) @@ -1,22 +0,0 @@ -Creating a new object. - -The =create= command, for which the =derive= command is an alias, is the main -tool in a =builder='s toolbox. It creates a new object, based on some -existing object, which serves as its parent. The command needs a name for -the new object, and it needs to know what parent object it will be derived -from (see =inheritance= for details). - - > derive a "ball" from mooix:ball - > create a mooix:ball called "ball" - -The parent object will often be a =reference=, as above. The newly created -object will differ only in its name, so its description and other fields -should be =set= soon after it is created. You end up holding each new -object you create, and every object you create will be listed in your -=portfolio=. - -If you want to build a room the =dig= command should be used instead of -this one. - -You can leave out the name to get an object with the same name as its -parent. Index: obj/abstract/builder/install_modify.msg =================================================================== --- obj/abstract/builder/install_modify.msg (revision 0) +++ obj/abstract/builder/install_modify.msg (revision 0) @@ -0,0 +1 @@ +session: The package seems to want to modify an existing object ($obj). Not allowing this unsafe operation. Index: obj/abstract/builder/teleport_out_verb =================================================================== --- obj/abstract/builder/teleport_out_verb (revision 0) +++ obj/abstract/builder/teleport_out_verb (revision 0) @@ -0,0 +1,19 @@ +#!/usr/bin/perl +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + $this->exec->teleport( + %_, + object => $_{direct_object}, + destination => undef, + ); +} Property changes on: obj/abstract/builder/teleport_out_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/builder/teleport_fail_user_already_there.msg =================================================================== --- obj/abstract/builder/teleport_fail_user_already_there.msg (revision 0) +++ obj/abstract/builder/teleport_fail_user_already_there.msg (revision 0) @@ -0,0 +1 @@ +session: You're already there. Index: obj/abstract/builder/addcommand_verb =================================================================== --- obj/abstract/builder/addcommand_verb (revision 23) +++ obj/abstract/builder/addcommand_verb (working copy) @@ -12,14 +12,19 @@ my $obj=$_{direct_object}; my $command=$_{quote}; my $cmdfile="$command.cmd"; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if (length $obj->fieldfile($cmdfile)) { - fail "There is already a command \"$command\" defined on that object."; + $this->msg( 'addcommand_already', + command => $command, %_ + ); + fail(); } my ($ret1, $msg1, $ret2, $msg2) = $this->safechange( object => $obj, @@ -31,10 +36,14 @@ value => "see: \$this ".PL($command), ); if (! $ret1) { - fail $msg1; + $avatar->msg( $msg1, %_ ); + fail(); } elsif (! $ret2) { - fail $msg2; + $avatar->msg( $msg2, %_ ); + fail(); } - $_{session}->write("Command added. Set $command.msg to customize."); + $this->msg( 'addcomand', + command => $command, %_ + ); } Index: obj/abstract/builder/edit.msg =================================================================== --- obj/abstract/builder/edit.msg (revision 0) +++ obj/abstract/builder/edit.msg (revision 0) @@ -0,0 +1 @@ +session: Edit in progress. Index: obj/abstract/builder/dig_room_created.msg =================================================================== --- obj/abstract/builder/dig_room_created.msg (revision 0) +++ obj/abstract/builder/dig_room_created.msg (revision 0) @@ -0,0 +1 @@ +session: Created a new room $room from parent $parent. Index: obj/abstract/builder/debugging.hlp =================================================================== --- obj/abstract/builder/debugging.hlp (revision 23) +++ obj/abstract/builder/debugging.hlp (working copy) @@ -1,85 +0,0 @@ -Debugging problems in the moo. - -Mooix has built-in debugging facilities that let you trace what a method -does, at a fairly low level of detail, and even make some modifications -to objects while a method is running. This is useful for both =builder=s -and =programmer=s, in different ways. - -To turn debugging on or off, set the debugging field of your avatar: - - > I'm debugging - > I'm not debugging - -When you turn debugging on, at first nothing will seem different (you may -notice commands run slower when debugging is on). To take advantage of the -debugging, you need send commands to the debug object, which is created the -first time you turn debugging on. So put the debug object somewhere where -you can issue commands to it. - - > teleport mooix:debug to me - -The first thing to do with the debugger is to turn on display of the debug -traces. To jump in feet first and experience the traces in their full glory, -use this command: - - > trace "*" - -Then you'll see reams of debugging information for every command. To turn -this back off: - - > skip "*" - -For full details about the syntax and use of the trace command, consult the -help for your debug object. - - > help on my debugger's trace - -The key to effective use of the logs is finer control, so you only see the -interesting bits. Here's a command that will make the debugger log -information about how your parser is parsing your commands. This is rather -useful if you're trying to add a =command= to an object and can't seem to -get it to work. - - > trace my "parse command" - -With this expression in place, the debugger will only show you messages -like these: - - > wind the duck - [you]->parse: command verb(wind), direct_object(mooix:portfolio/duck) - You can't do that. - -If your wind.cmd does not have a line like "verb, direct_object", -then that's why the command is not matching it and the verb is not being -run. On the other hand, perhaps you do have such a line -- then it could -be that the limits you used are wrong. Or perhaps the verb is getting run, -but it doesn't work. To test these hypotheses, you can enable some more -debug tracing: - - > trace my "parse validate" - > trace my "parse call" - > trace the duck - -The first of those will make it also display any messages the parser might -display while it's validating an object against a command, such as this: - - [you]->parse: validate mooix:portfolio/duck is not touchable - -The second will make it display and verbs or other methods it calls, and -the third will turn on full logging for methods of the duck object. So -you might see something like this: - - [you]->parse: call [duck]->wind_verb - [duck]->wind_verb: read spring - [duck]->wind_verb: read max_spring - [duck]->wind_verb: call msg(event, overwind) - [duck]->msg: read overwind.msg - > - -From this you can guess that the overwind.msg is missing and the "msg" -method is giving up, and the whole wind_verb is then failing. - -You can do other useful things with the debugger, like setting breakpoints. -Its own help gives all the details. - - > help on my debugger Index: obj/abstract/debug/breakpoint.hlp =================================================================== --- obj/abstract/debug/breakpoint.hlp (revision 23) +++ obj/abstract/debug/breakpoint.hlp (working copy) @@ -1,32 +0,0 @@ -Using the debugger to pause method execution. - -The debugger has a breakpoint command that can be used to pause execution -of an object's method when it accesses a given field. - - breakpoint object "expression" - -The quoted expression controls what method, type of action, and field -should trigger the breakpoint. It has the same form as the expression used -by the =trace= command. A typical expression is "loop_meth read counter". - -If you run the breakpoint command without any parameters, it will list -currently active breakpoints. - -When the debugger receives a message that matches a breakpoint, it pauses -the method that was running, and waits for you to tell it to =continue=. -Before you continue, you are free to examine the state of the object with -the stopped method, and even change it. You may even (if you're a -=programmer=) change the value returned by method calls, which will be -stored in the "return" field of the debugger while it's stopped. - -Warning: It might be hard to tell it do do anything, if the breakpoint is -in a method that your parse method is in the process of calling. The method -will be paused, and the parser will never get back to the command prompt. - -When working with breakpoints, it's a good idea to log into the moo twice. -Use one session for talking to the debugger, and one for testing whatever -you're debugging. You can use the =redir= command to direct debugger -output to one of the sessions, generally the one in which you're talking -to the debugger. - -To remove a breakpoint, use the =clear= command. Index: obj/abstract/debug/trace_already.msg =================================================================== --- obj/abstract/debug/trace_already.msg (revision 0) +++ obj/abstract/debug/trace_already.msg (revision 0) @@ -0,0 +1 @@ +session: That is already being traced. Index: obj/abstract/debug/redir.hlp =================================================================== --- obj/abstract/debug/redir.hlp (revision 23) +++ obj/abstract/debug/redir.hlp (working copy) @@ -1,10 +0,0 @@ -Controlling how the debugger communicates with you. - -By default the debugger prints messages to standard error. This is not too -slow and generally works ok, but sometimes it is better to make it send -messages by writing properly to a session. The redir command can redirect -the debugging output to the session from which you run it, or to standard -error: - - > redir debugger to "session" - > redir debugger to "stderr" Index: obj/abstract/debug/skip_already.msg =================================================================== --- obj/abstract/debug/skip_already.msg (revision 0) +++ obj/abstract/debug/skip_already.msg (revision 0) @@ -0,0 +1 @@ +session: That was already skipped. Index: obj/abstract/debug/redir_session.msg =================================================================== --- obj/abstract/debug/redir_session.msg (revision 0) +++ obj/abstract/debug/redir_session.msg (revision 0) @@ -0,0 +1 @@ +session: Using this session. Index: obj/abstract/debug/continue_fail.msg =================================================================== --- obj/abstract/debug/continue_fail.msg (revision 0) +++ obj/abstract/debug/continue_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Unable to continue (not stopped?) Index: obj/abstract/debug/clear_verb =================================================================== --- obj/abstract/debug/clear_verb (revision 23) +++ obj/abstract/debug/clear_verb (working copy) @@ -6,7 +6,8 @@ %_=@_; if (! $_{avatar}->debugging) { - fail "You do not have debugging turned on."; + $this->msg( 'debugging_not_on', %_ ); + fail(); } my ($method, $type, $field) = split(' ', $_{quote}, 3); @@ -23,6 +24,7 @@ $_{session}->page("Breakpoints:", $this->format_expressions("breakpoint")); } else { - fail "No matching breakpoints."; + $this->msg( 'clear_no_breakpoints', %_ ); + fail(); } } Index: obj/abstract/debug/clear.hlp =================================================================== --- obj/abstract/debug/clear.hlp (revision 23) +++ obj/abstract/debug/clear.hlp (working copy) @@ -1,5 +0,0 @@ -Removing a breakpoint. - -This command removes a breakpoint. It should be passed the same paramters -that were used to create the breakpoint. However, you can use clear "*" -to clear all breakpoints. Index: obj/abstract/debug/continue.msg =================================================================== --- obj/abstract/debug/continue.msg (revision 0) +++ obj/abstract/debug/continue.msg (revision 0) @@ -0,0 +1 @@ +session: Continuing. Index: obj/abstract/debug/format.hlp =================================================================== --- obj/abstract/debug/format.hlp (revision 23) +++ obj/abstract/debug/format.hlp (working copy) @@ -1,35 +0,0 @@ -Understanding and changing the debugger trace format. - -You can use the =trace= command to turn on logging of what methods do as -they run. The traces look like this: - -[ball]->drop_verb: read location -[ball]->drop_verb: read mooix:/home/you/mooix->location -[ball]->drop_verb: call drop(to, mooix:/var/lib/mooix/system/entrance) -[ball]->drop: read location -[ball]->drop: read physics -[ball]->drop_verb: write status = dropping -[ball]->drop: call [physics object]->move(object, [ball], to, [room]) -[ball]->drop: info ball drop is complete -[ball]->drop_verb: return drop [ball] - -Mooix objects are referred to using their name in brackets (but see below). -On the left hand side, before the colon, is the object and method that is -logging the message. Right after the colon is the type of message that was -logged. Standard types include read, for field reads, write, for field -writes, call, for method calls. and return, for seeing the results of -message calls. Note that return may not be logged if the calling method is -ignoring the result of the message call. Methods can also make up their own -types of messages and log them. - -After the message type is the rest of the message, which gives the details -about what's happening. The format of this part is freeform, but you will -often see messages like the examples above, which give the field that is -being read, or method that's being called (with parameters), or value a -field is being set to. - -If you prefer to see object ids instead of object names, you can -change the debugger's traceformat field. The first value of the -field is used to format objects for display in the call trace. -The value is expanded, with any occurance of "$name" being replaced with -the object's name, and "$id" being replaced with its mooix id. Index: obj/abstract/debug/trace_verb =================================================================== --- obj/abstract/debug/trace_verb (revision 23) +++ obj/abstract/debug/trace_verb (working copy) @@ -10,11 +10,12 @@ } if (! $_{avatar}->debugging) { - fail "You do not have debugging turned on."; + $this->msg( 'debugging_not_on', %_ ); + fail(); } if ($this->session && $this->session != $_{session}) { - $_{session}->write("Note that traces are not directed to your current session."); + $this->msg( 'trace_away', %_ ); } if (! $_{direct_object} && ! length $_{quote}) { @@ -36,6 +37,7 @@ $_{session}->page("Now tracing:", $this->format_expressions("skip", "trace")); } else { - fail "That is already being traced."; + $this->msg( 'trace_already', %_ ); + fail(); } } Index: obj/abstract/debug/Makefile =================================================================== --- obj/abstract/debug/Makefile (revision 23) +++ obj/abstract/debug/Makefile (working copy) @@ -1,8 +1,8 @@ include ../../../makeinfo build:: - ln -f trace.hlp skip.hlp + ln -f trace.hlp.en skip.hlp.en clean:: - rm -f skip.hlp + rm -f skip.hlp.en realclean:: Index: obj/abstract/debug/trace.hlp =================================================================== --- obj/abstract/debug/trace.hlp (revision 23) +++ obj/abstract/debug/trace.hlp (working copy) @@ -1,57 +0,0 @@ -Controlling what the debugger displays. - -This debugger can display a complete trace of each method, including field -accesses, method calls, and more. This can be overwhelming, so by default -the trace is not displayed, and you can use the trace and skip commands -to make parts of it visible. There are three forms of the each command. - - trace object - trace "expression" - trace object "expression" - - skip object - skip "expression" - skip object "expression" - -(Additonally, you can run the trace command with no parameters and it will -list what is currently being traced.) - -If only an object is specified, then it controls whether the debugger will -display a complete trace for methods of that object. - -The quoted expression controls what method, type of action, and field -should be traced. The general form is "method action field", and any of the -three can be "*" to match anything. You can leave off trailing items, with -the same effect as if you had put in a "*" for them. The action is generally -one of read, write, or call. A typical expression is "loop_meth read counter". - -If only an expresison is specified, then it controls whether the debugger -will display any information matching the expression. If both the object -and expression are specified, then this controls whether the debugger -will display information about methods of the object matching the -expression. - -To turn on full tracing, use: - - trace "*" - -To turn off all tracing, use: - - skip "*" - -To only see what methods your parse method calls, use: - - trace my "parse call" - -Except for the commands that turn off all tracing, repeated trace and -skip commands are cumulative, so if you also want to see field reads and -method calls made by an object, you could say: - - trace the object's "* read" - trace the object's "* call" - -If you wanted to exclude from that any reads performed by the foo method: - - skip the object's "foo read" - -For help understanding traces, or customizing the display, see =format=. Index: obj/abstract/debug/redir_verb =================================================================== --- obj/abstract/debug/redir_verb (revision 23) +++ obj/abstract/debug/redir_verb (working copy) @@ -11,13 +11,14 @@ if (lc $_{quote} eq 'stderr') { unlink("session") || $this->croak("unlink session: $!"); - $_{session}->write("Using srderr."); + $this->msg( 'redir_stderr', %_ ); } elsif (lc $_{quote} eq 'session') { $this->session($_{session}); - $_{session}->write("Using this session."); + $this->msg( 'redir_session', %_ ); } else { - fail 'Usage: redir "srderr|session"'; + $this->msg( 'redir_usage', %_ ); + fail(); } } Index: obj/abstract/debug/skip_verb =================================================================== --- obj/abstract/debug/skip_verb (revision 23) +++ obj/abstract/debug/skip_verb (working copy) @@ -10,11 +10,12 @@ } if (! $_{avatar}->debugging) { - fail "You do not have debugging turned on."; + $this->msg( 'debugging_not_on', %_ ); + fail(); } if ($this->session && $this->session != $_{session}) { - $_{session}->write("Note that traces are not directed to your current session."); + $this->msg( 'skip_not_directed', %_ ); } my ($method, $type, $field) = split(' ', $_{quote}, 3); @@ -31,6 +32,7 @@ $_{session}->page("Now tracing:", $this->format_expressions("skip", "trace")); } else { - fail "That was already skipped."; + $this->msg( 'skip_already', %_ ); + fail(); } } Index: obj/abstract/debug/breakpoint_already.msg =================================================================== --- obj/abstract/debug/breakpoint_already.msg (revision 0) +++ obj/abstract/debug/breakpoint_already.msg (revision 0) @@ -0,0 +1 @@ +session: That breakpoint already exists. Index: obj/abstract/debug/basics.hlp =================================================================== --- obj/abstract/debug/basics.hlp (revision 23) +++ obj/abstract/debug/basics.hlp (working copy) @@ -1,24 +0,0 @@ -About this debugger object. - -This is a mooix debugger object, which you can use to trace and debug -methods as they run in the moo. - -For an overview of debugging, see the debugging help topic of your avatar. -You should be able to turn debugging on and of as follows: - - > I'm debugging - > I'm not debugging - -You will probably also want to have the debugger object nearby when you're -debugging, so you can easily use its command. - - > teleport mooix:debug to me - -You can choose to direct the debugger's messages to either standard error, -or a session, with the =redir= command. By default the debugger refers to -objects by name; you can make it use references instead by changing its -message =format=. - -The main uses for the debugger are =tracing= what methods do as they run, -and setting =breakpoint=s that let you pause a method to examine, and -possibly change, its state. Index: obj/abstract/debug/debugging_not_on.msg =================================================================== --- obj/abstract/debug/debugging_not_on.msg (revision 0) +++ obj/abstract/debug/debugging_not_on.msg (revision 0) @@ -0,0 +1 @@ +session: You do not have debugging turned on. Index: obj/abstract/debug/continue_verb =================================================================== --- obj/abstract/debug/continue_verb (revision 23) +++ obj/abstract/debug/continue_verb (working copy) @@ -11,13 +11,15 @@ } if (! $_{avatar}->debugging) { - fail "You do not have debugging turned on."; + $this->msg( 'debugging_not_on', %_ ); + fail(); } if ($this->signal(with => SIGCONT, method => "log")) { - $_{session}->write("Continuing."); + $this->msg( 'continue', %_ ); } else { - fail "Unable to continue (not stopped?)"; + $this->msg( 'continue_fail', %_ ); + fail(); } } Index: obj/abstract/debug/trace_away.msg =================================================================== --- obj/abstract/debug/trace_away.msg (revision 0) +++ obj/abstract/debug/trace_away.msg (revision 0) @@ -0,0 +1 @@ +session: Note that traces are not directed to your current session. Index: obj/abstract/debug/continue.hlp =================================================================== --- obj/abstract/debug/continue.hlp (revision 23) +++ obj/abstract/debug/continue.hlp (working copy) @@ -1,4 +0,0 @@ -Continuing past a breakpoint. - -The continue command makes the debugger continue past any breakpoints it's -currently stopped at. Index: obj/abstract/debug/clear_no_breakpoints.msg =================================================================== --- obj/abstract/debug/clear_no_breakpoints.msg (revision 0) +++ obj/abstract/debug/clear_no_breakpoints.msg (revision 0) @@ -0,0 +1 @@ +session: No matching breakpoints. Index: obj/abstract/debug/breakpoint_verb =================================================================== --- obj/abstract/debug/breakpoint_verb (revision 23) +++ obj/abstract/debug/breakpoint_verb (working copy) @@ -10,7 +10,8 @@ } if (! $_{avatar}->debugging) { - fail "You do not have debugging turned on."; + $this->msg( 'debugging_not_on', %_ ); + fail(); } if (! $_{direct_object} && ! length $_{quote}) { @@ -32,6 +33,7 @@ $_{session}->page("Breakpoints:", $this->format_expressions("breakpoint")); } else { - fail "That breakpoint already exists."; + $this->msg( 'breakpoint_already', %_ ); + fail(); } } Index: obj/abstract/debug/redir_stderr.msg =================================================================== --- obj/abstract/debug/redir_stderr.msg (revision 0) +++ obj/abstract/debug/redir_stderr.msg (revision 0) @@ -0,0 +1 @@ +session: Using stderr. Index: obj/abstract/debug/redir_usage.msg =================================================================== --- obj/abstract/debug/redir_usage.msg (revision 0) +++ obj/abstract/debug/redir_usage.msg (revision 0) @@ -0,0 +1 @@ +session: Usage: redir "srderr|session" Index: obj/abstract/debug/skip_not_directed.msg =================================================================== --- obj/abstract/debug/skip_not_directed.msg (revision 0) +++ obj/abstract/debug/skip_not_directed.msg (revision 0) @@ -0,0 +1 @@ +session: Note that traces are not directed to your current session. Index: obj/abstract/guest/register_blank_name.msg =================================================================== --- obj/abstract/guest/register_blank_name.msg (revision 0) +++ obj/abstract/guest/register_blank_name.msg (revision 0) @@ -0,0 +1 @@ +session: Aborting on blank name. Index: obj/abstract/guest/email_info.msg =================================================================== --- obj/abstract/guest/email_info.msg (revision 18) +++ obj/abstract/guest/email_info.msg (working copy) @@ -1 +1 @@ -Now you need to enter your email address, so the password to your account can be emailed to you. Your email address will not be used for anything else. +session: Now you need to enter your email address, so the password to your account can be emailed to you. Your email address will not be used for anything else. Index: obj/abstract/guest/regintro =================================================================== --- obj/abstract/guest/regintro (revision 23) +++ obj/abstract/guest/regintro (working copy) @@ -1,2 +0,0 @@ -You need to answer a couple of questions to set up your account. - Index: obj/abstract/guest/register_fail_class.msg =================================================================== --- obj/abstract/guest/register_fail_class.msg (revision 0) +++ obj/abstract/guest/register_fail_class.msg (revision 0) @@ -0,0 +1 @@ +session: I'm sorry, but registration is currently not allowed for your user class. Index: obj/abstract/guest/regsuccess.msg =================================================================== --- obj/abstract/guest/regsuccess.msg (revision 18) +++ obj/abstract/guest/regsuccess.msg (working copy) @@ -1,10 +1 @@ -Your requested account on $mooinfo->mooname has been set up. - -To use the account, telnet or ssh to $mooinfo->hostname, log in as -$username, and enter the password ($password) when you are prompted -to do so. - -Note that it is possible to set up your account for passwordless ssh -access. To do so, use the "ssh" command once you are logged in with your -new account. It would also be a good idea to change your password; use the -"password" command once you've logged in. +session: Your requested account on $mooinfo->mooname has been set up.\n\n To use the account, telnet or ssh to $mooinfo->hostname, log in as $username, and enter the password ($password) when you are prompted to do so.\n\n Note that it is possible to set up your account for passwordless ssh access. To do so, use the "ssh" command once you are logged in with your new account. It would also be a good idea to change your password; use the "password" command once you've logged in. Index: obj/abstract/guest/register_bad_password.msg =================================================================== --- obj/abstract/guest/register_bad_password.msg (revision 0) +++ obj/abstract/guest/register_bad_password.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, that's not the password. To try again: register "$email" Index: obj/abstract/guest/regwait =================================================================== --- obj/abstract/guest/regwait (revision 23) +++ obj/abstract/guest/regwait (working copy) @@ -1,11 +0,0 @@ - -Your password has been emailed to you. If you can go check your email now, -and tell me the password, that is the easiest way to complete the -registration process. - -If for some reason you cannot check your mail right now (or your email is -slow in arriving), don't worry -- you can get back to this point at any -time by logging into the moo as a guest again, and typing: - - register "$email" - Index: obj/abstract/guest/register_fail.msg =================================================================== --- obj/abstract/guest/register_fail.msg (revision 0) +++ obj/abstract/guest/register_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You entered the wrong password, or there was a problem adding the account. Index: obj/abstract/guest/register_fail_email.msg =================================================================== --- obj/abstract/guest/register_fail_email.msg (revision 0) +++ obj/abstract/guest/register_fail_email.msg (revision 0) @@ -0,0 +1 @@ +session: Failed to send mail: $error. Index: obj/abstract/guest/regintro.msg =================================================================== --- obj/abstract/guest/regintro.msg (revision 18) +++ obj/abstract/guest/regintro.msg (working copy) @@ -1,2 +1 @@ -You need to answer a couple of questions to set up your account. - +session: You need to answer a couple of questions to set up your account.\n\n Index: obj/abstract/guest/register_bad_name.msg =================================================================== --- obj/abstract/guest/register_bad_name.msg (revision 0) +++ obj/abstract/guest/register_bad_name.msg (revision 0) @@ -0,0 +1 @@ +session: Invalid name, try again. Index: obj/abstract/guest/register_fail_sendmail.msg =================================================================== --- obj/abstract/guest/register_fail_sendmail.msg (revision 0) +++ obj/abstract/guest/register_fail_sendmail.msg (revision 0) @@ -0,0 +1 @@ +session: I'm sorry, but registration is currently not allowd, as Mail::SendMail is not installed. Index: obj/abstract/guest/register_bad_email.msg =================================================================== --- obj/abstract/guest/register_bad_email.msg (revision 0) +++ obj/abstract/guest/register_bad_email.msg (revision 0) @@ -0,0 +1 @@ +session: That doesn't look like a valid email address. Index: obj/abstract/guest/regwait.msg =================================================================== --- obj/abstract/guest/regwait.msg (revision 18) +++ obj/abstract/guest/regwait.msg (working copy) @@ -1,11 +1 @@ - -Your password has been emailed to you. If you can go check your email now, -and tell me the password, that is the easiest way to complete the -registration process. - -If for some reason you cannot check your mail right now (or your email is -slow in arriving), don't worry -- you can get back to this point at any -time by logging into the moo as a guest again, and typing: - - register "$email" - +session: Your password has been emailed to you. If you can go check your email now, and tell me the password, that is the easiest way to complete the registration process.\n\n If for some reason you cannot check your mail right now (or your email is slow in arriving), don't worry -- you can get back to this point at any time by logging into the moo as a guest again, and typing:\n\n register "$email" Index: obj/abstract/guest/register_blank_email.msg =================================================================== --- obj/abstract/guest/register_blank_email.msg (revision 0) +++ obj/abstract/guest/register_blank_email.msg (revision 0) @@ -0,0 +1 @@ +session: Aborting on blank email. Index: obj/abstract/guest/registration.hlp =================================================================== --- obj/abstract/guest/registration.hlp (revision 23) +++ obj/abstract/guest/registration.hlp (working copy) @@ -1,10 +0,0 @@ -Registering for a real account. - -As a guest, you are limited in what you can do on the moo. This guest -account is just intended to give you a limited taste of what the moo has to -offer, not for long term use. - -To register for a real account, use the "register" command. You'll be -prompted for some basic information, and then emailed a password that you -can use to log in to the moo. The process should be self-explanatory and -will take only a few minutes. Index: obj/abstract/guest/email_info =================================================================== --- obj/abstract/guest/email_info (revision 23) +++ obj/abstract/guest/email_info (working copy) @@ -1 +0,0 @@ -Now you need to enter your email address, so the password to your account can be emailed to you. Your email address will not be used for anything else. Index: obj/abstract/guest/register_verb =================================================================== --- obj/abstract/guest/register_verb (revision 23) +++ obj/abstract/guest/register_verb (working copy) @@ -31,7 +31,7 @@ } if (ref($val) eq 'Mooix::Thing') { - return $val->prettyname; + return $val->prettyname( recipient => $_{avatar} ); } else { return $val; @@ -56,11 +56,19 @@ # Make sure that this command is not spoofed, just in case. if ($_{avatar} != $this) { - fail "No!"; + $_{avatar}->msg( "spoofing_bad", %_, + onlyto => $this, + session => $session, + ); + fail(); } if (! $this->register_ok) { - fail "I'm sorry, but registration is currently not allowed for your user class."; + $this->msg( 'register_fail_class', %_, + onlyto => $this, + session => $session, + ); + fail(); } # I settled on Mail::Sendmail because eg, exim refuses to send mail from a @@ -68,7 +76,11 @@ # historically insecure and buggy. eval "use Mail::Sendmail"; if ($@) { - fail "I'm sorry, but registration is currently not allowd, as Mail::SendMail is not installed."; + $this->msg( 'register_fail_sendmail', %_, + onlyto => $this, + session => $session, + ); + fail(); } @@ -79,30 +91,53 @@ # The first half of registration. if (! exists $_{quote}) { - $session->write($this->regintro); + $this->msg( 'regintro', %_, + onlyto => $this, + session => $session, + ); my $ok=0; while (! $ok) { $info{name} = $session->prompt(prompt => $this->name_prompt." ", default => $info{name}); my $uname = $info{name}; if (! length $uname) { - fail "Aborting on blank name."; + $this->msg( 'register_blank_name', + %_, + onlyto => $this, + session => $session, + ); + fail(); } $uname =~ s/[^a-zA-Z0-9]//g; if (! length $uname) { - $session->write("Invalid name, try again."); + $this->msg( 'register_bad_name', %_, + onlyto => $this, + session => $session, + ); next; } - $session->write($this->email_info); + $this->msg( 'email_info', %_, + onlyto => $this, + session => $session, + ); for (;;) { $info{email} = $session->prompt(prompt => $this->email_prompt." ", default => $info{email}); if (! length $info{email}) { - fail "Aborting on blank email."; + $this->msg( + 'register_blank_email', %_, + onlyto => $this, + session => $session, + ); + fail(); } $info{email} =~ s/\s+//g; last if $info{email} =~ /^.+@.+\..+$/; - $session->write("That doesn't look like a valid email address.") + $this->msg( 'register_bad_email', + %_, + onlyto => $this, + session => $session, + ); } $ok = $this->parser_parse_yesno( @@ -128,8 +163,19 @@ Subject => expand($this->email_subject, %info), Message => emailbody(expand(scalar $this->regemail, %info)), ); - sendmail(%mail) || fail("Failed to send mail: ".$Mail::Sendmail::error); - $session->write(split("\n", expand(scalar $this->regwait, %info))); + if( ! sendmail(%mail) ) { + $this->msg( 'register_fail_email', + error => $Mail::Sendmail::error, + %_, + onlyto => $this, + session => $session, + ); + fail(); + } + $this->msg( 'regwait', %info, %_, + onlyto => $this, + session => $session, + ); } else { $info{email}=$_{quote}; @@ -138,11 +184,23 @@ # The second half of registration. my $password = $session->password(prompt => $this->password_prompt." "); if (! length $password) { - fail "Aborting on empty password. To try again: register \"$info{email}\""; + $this->msg( 'register_blank_password', + email => $info{email}, + %_, + onlyto => $this, + session => $session, + ); + fail(); } if (exists $info{password} && $password ne $info{password}) { - fail "Sorry, that's not the password. To try again: register \"$info{email}\""; + $this->msg( 'register_bad_password', + email => $info{email}, + %_, + onlyto => $this, + session => $session, + ); + fail(); } $info{password}=$password; @@ -156,7 +214,11 @@ $info{username} = `mooregister`; chomp $info{username}; if (($? >> 8) != 0 || ! length $info{username}) { - fail "You entered the wrong password, or there was a problem adding the account."; + $this->msg( 'register_fail', %_, + onlyto => $this, + session => $session, + ); + fail(); } # Success! @@ -169,4 +231,9 @@ ); sendmail(%mail); $session->write(split("\n", $message)); + + $this->msg( 'regsuccess', %info, %_, + onlyto => $this, + session => $session, + ); } Index: obj/abstract/guest/register_blank_password.msg =================================================================== --- obj/abstract/guest/register_blank_password.msg (revision 0) +++ obj/abstract/guest/register_blank_password.msg (revision 0) @@ -0,0 +1 @@ +session: Aborting on empty password. To try again: register "$email" Index: obj/abstract/guest/personalization.hlp =================================================================== --- obj/abstract/guest/personalization.hlp (revision 23) +++ obj/abstract/guest/personalization.hlp (working copy) @@ -1,5 +0,0 @@ -Personalizing your moo account. - -As a guest, you cannot really personalize your moo account. If you'd like -to be able to set your name and description, and so on, you need to sign up -for an account first. See =registration=. Index: obj/abstract/guest/regsuccess =================================================================== --- obj/abstract/guest/regsuccess (revision 23) +++ obj/abstract/guest/regsuccess (working copy) @@ -1,10 +0,0 @@ -Your requested account on $mooinfo->mooname has been set up. - -To use the account, telnet or ssh to $mooinfo->hostname, log in as -$username, and enter the password ($password) when you are prompted -to do so. - -Note that it is possible to set up your account for passwordless ssh -access. To do so, use the "ssh" command once you are logged in with your -new account. It would also be a good idea to change your password; use the -"password" command once you've logged in. Index: obj/abstract/contentslist/add.c =================================================================== --- obj/abstract/contentslist/add.c (revision 23) +++ obj/abstract/contentslist/add.c (working copy) @@ -5,59 +5,63 @@ #include int main (int argc, char **argv) { - param *p; - FILE *f; - object *obj = NULL, *owner; - char *field, *s; - double ownermass, objmass, maxweight; - - methinit(); - while ((p = getparam())) { - if (strcmp(p->name, "object") == 0) { - obj = derefobj(p->value); - } + param *p; + FILE *f; + object *obj = NULL, *owner; + char *field, *s; + double ownermass, objmass, maxweight; + + methinit(); + while ((p = getparam())) { + if (strcmp(p->name, "object") == 0) { + obj = derefobj(p->value); } - - if (! obj) { - fprintf(stderr, "object field required\n"); - exit(1); - } + } - /* See if this object is too heavy to pick up. */ - owner = getobj("owner"); - if ((field = fieldfile(owner, "maxweight")) && + if (! obj) { + fprintf(stderr, "object field required\n"); + exit(1); + } + + /* See if this object is too heavy to pick up. */ + owner = getobj("owner"); + if ((field = fieldfile(owner, "maxweight")) && (s = getfield(field)) && (maxweight = atof(s)) && - - (field = fieldfile(obj, ".mass")) && + + (field = fieldfile(obj, ".mass")) && (s = getfield(field)) && (objmass = atof(s))) { - ownermass = 0; - if ((field = fieldfile(owner, ".mass")) && - (s = getfield(field))) { - ownermass = atof(s); - if (objmass + ownermass > maxweight) { - /* Yes, too heavy. */ - exit(0); - } - } + ownermass = 0; + if ((field = fieldfile(owner, ".mass")) && + (s = getfield(field))) { + ownermass = atof(s); + if (objmass + ownermass > maxweight) { + /* Yes, too heavy. */ + /* Note that no message is sent to the user; good + * code should be testing this stuff itself and + * sending pretty messages before it gets here. + */ + exit(0); + } } + } - f = fopen("list", "a"); - if (! f) { - perror("open list"); - exit(1); - } + f = fopen("list", "a"); + if (! f) { + perror("open list"); + exit(1); + } - /* lock to guard against races */ - if (flock(fileno(f), LOCK_EX) != 0) { - perror("flock"); - exit(1); - } + /* lock to guard against races */ + if (flock(fileno(f), LOCK_EX) != 0) { + perror("flock"); + exit(1); + } - fprintf(f, "mooix:%s\n", obj->dir); - fclose(f); - - printf("mooix:%s\n", obj->dir); - exit(0); + fprintf(f, "mooix:%s\n", obj->dir); + fclose(f); + + printf("mooix:%s\n", obj->dir); + exit(0); } Index: obj/abstract/restrictedavatar/safechange_no_personalize.msg =================================================================== --- obj/abstract/restrictedavatar/safechange_no_personalize.msg (revision 0) +++ obj/abstract/restrictedavatar/safechange_no_personalize.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, you cannot personalize yourself. Index: obj/abstract/restrictedavatar/lastlog_verb =================================================================== --- obj/abstract/restrictedavatar/lastlog_verb (revision 23) +++ obj/abstract/restrictedavatar/lastlog_verb (working copy) @@ -3,5 +3,6 @@ # want them to see. #use Mooix::Thing; run sub { - fail "Sorry, but the lastlog is not available."; + $this->msg( 'lastlog_none', %_ ); + fail(); } Index: obj/abstract/restrictedavatar/safechange =================================================================== --- obj/abstract/restrictedavatar/safechange (revision 23) +++ obj/abstract/restrictedavatar/safechange (working copy) @@ -11,10 +11,10 @@ my $addret = sub { return unless defined $field; if (defined $object && $object == $this) { - push @ret, (0, "Sorry, you cannot personalize yourself."); + push @ret, (0, 'safechange_no_personalize'); } else { - push @ret, (0, "Sorry, you cannot modify objects in the moo."); + push @ret, (0, 'safechange_no_modify'); } }; @@ -33,7 +33,7 @@ $addret->(); if (! @ret) { # paranoia - push @ret, (0, "You can't do that."); + push @ret, (0, 'safechange_fail'); } return @ret; Index: obj/abstract/restrictedavatar/safechange_fail.msg =================================================================== --- obj/abstract/restrictedavatar/safechange_fail.msg (revision 0) +++ obj/abstract/restrictedavatar/safechange_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that. Index: obj/abstract/restrictedavatar/lastlog_none.msg =================================================================== --- obj/abstract/restrictedavatar/lastlog_none.msg (revision 0) +++ obj/abstract/restrictedavatar/lastlog_none.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, but the lastlog is not available. Index: obj/abstract/restrictedavatar/safechange_no_modify.msg =================================================================== --- obj/abstract/restrictedavatar/safechange_no_modify.msg (revision 0) +++ obj/abstract/restrictedavatar/safechange_no_modify.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, you cannot modify objects in the moo. Index: obj/abstract/programmer/security-model.hlp =================================================================== --- obj/abstract/programmer/security-model.hlp (revision 23) +++ obj/abstract/programmer/security-model.hlp (working copy) @@ -1,181 +0,0 @@ -The mooix security model. - -Mooix =objects= are stored as directories of files on disk, and so -underlying the mooix security model is the standard unix filesystem. -Permissions on files and directories are used, with some unusual -wrinkles. One key thing is that all of the below only applies to mooix -objects -- directories with .mooix files in them. This is important, to -prevent directories that were never intended to be objects from being -accessed in the wrong way. - -An object may only be modified by (and private data may only be read by) -by a method that is running on that object. Such a method can't modify -any other objects (even if they have the same unix owner). Nor can it -touch anything else on the filesystem, aside from world-writable -directories like /tmp. - -Each running method has associated with it an "callstack". This is a list -of the objects that in some way participated in the calling process of -this method, and so, could theoretically have influenced what it is -doing. It also always includes the object the method is running on, and -all of the parents of that object. For the method to be able to do -anything to the object it is running on, every object in the callstack -must be able to do it. - -So, what objects can do what? Well, an object can modify itself, read -any field, and so on. The parent (and other ancestors) of an object can -too. Finally, if the object has an owner field, the object pointed to by -that field (and all of its ancestors) can likewise do anything to the -object. - -Don't get the wrong idea though -- these owners and parents can't -modify an object directly. But if one of the object's methods is running, -and they appear on the callstack, their presence will not prevent it from -modifying the object. By contrast, the presence of a single foreign -object on the callstack will prevent the object's method from doing any -privileged operations. - -The general behavior, then, is that objects can freely inherit methods -from their parents, that create or modify fields of the objects, and the -methods will just work, without worrying about file permissions at all. -An object's method can call a parent's method, and that method can call -another method, which can call a grandparent's method, etc., and still -they'll be able to access the object without trouble. - -But, add a foreign object to the mix, one that's not in the family, and -everything changes. If that foreign object calls the same method of the -object, the method is run with a stack that has both the foreigner and -the object on it. Such an callstack cannot normally modify any fields of -the object, or add new fields, or read any fields that aren't world -readable. Even though this is the object's own method running, it can't -do much of anything. - -This is frequently correct behavior, and it's a great default, because it -means you don't have to worry about security by default. But it can be -too limiting. And that brings us to some ways to do stuff even if a -foreigner is on your callstack. - -unimportant fields - - Sometimes it is useful to be able to mark a field of an object as - "unimportant". This means it's not security critical, it won't be a - big deal if someone tricks a method into writing garbage to this field. - - You do this by making the field group writable. - - Unimportant fields can be written to by any of the object's methods, - so long as they have the object on the top of their callstack. This - is normally the case. The rest of the callstack is ignored. - - It's also possible to make a field not be world readable, but make it - group readable. Then methods of other objects can't read it, but any - of the object's methods can, no matter what their callstack is. - - Note: Do be careful of your umask; many of us (myself included) set it - to 002, but this is very inappropriate for working on moo objects; use - 022 instead. - -unimportant objects - - It's also possible to set the group writable bit on an object's - directory. Similar to setting it on a field, this makes only the - topmost object in the callstack be considered when the directory is - being modified. This is only very rarely useful. - -stackless methods - - Unimportant fields are enough to make it possible to create objects - that you can give to other people, and let them run methods of the - objects, that can modify the object's state. Sometimes that's not - enough though. Sometimes, in (hopefully) very rare cases, you need - something like unix's suid bit, that clears out the callstack of a - method. - - This exists; it's called a stackless method, and it is achieved by - setting the sticky (+t) bit on its permissions. - - "Stackless" is a misnomer, because the method will run with an - callstack consisting of the object and all of its parents. Just nothing - else that might have been on the stack before. Still, it helps to - remember that sticky == stackless. - - Stackless methods are largely responsible for their own security. This - typically involves checking the callstack to see how they were called, - and deciding what they should allow. - -mixins - - It's actually possible to ask mood to run a method that is not part of - an object on an object, and it will do so (most of the time). For - example, you can ask it to run "foo/baz" on an object that has a - foo object in it, and it will run the baz method. The resulting - callstack will not have object foo added to it, but just the object - on which the method is run. (However, mood will not let a method run - this way be run stackless.) This odd feature is used to implement - mixin objects. - -The implementation of all this is done by the mooix daemon, mood. Mood's -main process is responsible for running each mooix method. Before running -a method, it sets up the callstack, and constructs a sandboxed environment -for the method to run in. This sandbox consists of a dedicated user id -(and group id) for the method to run as. This user and group can do -little on its own; it can read world readable files and write to world -readable directories. - -To do anything interesting, it has to communicate back to mood, and ask -it to open a file, or whatever. The instance of mood it can communicate -with is a forked version that runs as the user and group that own the -object. So this mood process can proxy requests to do anything that that -user and group can do, at a maximum. It refers to the callstack to decide -what to allow and what to deny. - -Important note: - - Anyone who can program a method in the moo can trivially get shell - access. This is unavoidable given mooix's design; methods are regular - unix programs and they are not insulated from the rest of the system - (unless the whole moo is put in some form of jail() or chroot()). This is - a feature, not a bug, or security hole. Programmers should generally just - be given a shell account to go with their moo account. - -On top of this foundation is built the mooix system. Aside from object -accesses, there are some other fields of security in the mooix system as a -whole: - -tainted data - - Some terminals can be exploited by way of special escape sequences. - Similarly, web browsers can be exploited by special html and/or - javascript. The model mooix uses to protect users from this is to - allow anyone to feed such malicous data into the moo, and require that - it is sanitized when it is output to users. This allows the tty session - to filter out tty bombs, while the html session can (try to) filter out - the myriad of things that can exploit browers, etc. - -spoofing - - Spoofing is making a message be displayed to others that claims someone - did something, when in fact they did not. See the classic Rape in - Cyberspace. Mooix tries to limit spoofing avenues to only to the .msg - fields. - - The notify method is passed an originator field, that is set to the - object which originated the message. So it is posible to tag every - message displayed to the user with the name of the object originating the - message. - - The write methods of sessions are passed text with - around the name of the object that originated the message. They can chose - to display the name in a special way, to let the user know that object - really did whatever the message says it did. - -avatar-level security - - Different classes of avatars have different things they can and cannot - do. Guests cannot personalize themselves, normal avatars cannot create - other objects, builders cannot run code. Aside from the mooadmin, who - gets its special powers from the mooix security model, all these - permissions levels are accomplished on an ad-hoc basis, by making sure - that the methods an avatar has available limit what it can do. This is, - unfortunatly, prone to errors. Several past bugs in the moo have let - builders run code, for example. Index: obj/abstract/programmer/set_reference_fail.msg =================================================================== --- obj/abstract/programmer/set_reference_fail.msg (revision 0) +++ obj/abstract/programmer/set_reference_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't set that. Index: obj/abstract/programmer/shell.hlp =================================================================== --- obj/abstract/programmer/shell.hlp (revision 23) +++ obj/abstract/programmer/shell.hlp (working copy) @@ -1,17 +0,0 @@ -Run a command on the fly. - -The shell command lets a =programmer= run a unix shell command on the fly. -You pass it the command to run in quotes. - - > shell "uname -a" - Linux kite 2.4.18 #1 Thu Apr 4 07:49:52 EST 2002 i586 unknown - -There is a shortcut to shell. Just type an exclamation point and then -the code to run. - - > ! uname -a - Linux kite 2.4.18 #1 Thu Apr 4 07:49:52 EST 2002 i586 unknown - -Beware of interactive commands, they cannot read from standard input. - -The =eval= command is similar, but allows running of code. Index: obj/abstract/programmer/locking.hlp =================================================================== --- obj/abstract/programmer/locking.hlp (revision 23) +++ obj/abstract/programmer/locking.hlp (working copy) @@ -1,64 +0,0 @@ -Concurrency and locking issues. - -Since mooix is fully multi-tasking, it is more prone to races than some -other MOOs. Often some locking will have to be used to lock a field while a -method is doing something with it, to avoid a race. - -We would like programmers to have to worry about this as little as -possible, so the parser takes care of locking objects in place when verbs -are running whose =commands= specify that the object must be nearby or -visible, or will be moved by the command. - -However, there are many other situations where you still have to worry -about locking. Any method that is not executed by a verb, or that moves an -object that a verb has not locked, needs to do its own locking before -moving an object. This can be especially sticky if the method is called -sometimes by a verb (that does locking) and sometimes by something else -(and needs to do its own locking). If one method accesses a field that some -other method might change at the same time, both methods need to do -locking. If a verb backgrounds itself, it needs to do its own locking -(since it is the parser that really takes locks on behalf of verbs, and -drops them when the verb returns). - -There are two sorts of locking generally used on mooix objects. The first -kind is locking the object itself, which locks its position in the moo. -This can be done by applying a lock on the .mooix attribute file of the -object using the flock(2) system call. Alternatively, if the language -binding provides it, you can simply use the getlock method, which is a -wrapper for flock. To lock the object in place, use a shared lock. To lock -an object before moving it, use an exclusive lock. - -The second kind of locking applies to an individual field of an -object. To avoid race conditions on reading and writing a particular -field, lock its file using flock(2) or the object's getlock method, if -available. For reading use a shared lock, and for writing use an -exclusive lock. An exclusive lock will block any method that wants to -read or write from the field until the writing is completed and the lock -is released. - -Whatver kind of locking you are doing, be sure to unlock as soon as the -lock is no longer needed. This can be done either by setting the lock -type to unlocked or by simply closing the file. Objects or fields that -are locked exclusively will block any other methods attempting to -acquire a lock. - -Of course the usual UNIX locking problems have to be avoided. If taking -more than one lock, make all methods take them in the same order, to avoid -deadlock. And if a method's caller has locked something, and the callee -tries to lock it too, exclusively, both will block. It's important to -document what locking a method does in its .inf field, so these situatons -can be avoided. - -An especially tricky situation crops up if a verb's command causes an -object to be locked, and the verb backgrounds itself, and needs to continue -to ensure that the object is locked. There is currently no known way to -ensure this -- if the backgrounded method takes a lock, there is still a -window before the lock it taken where some other method might queue up for -the lock, and win it. - -Instead, it is best to use a field as a flag to state that the object is -doing some action. Each time the backgrounded method prepares to do the -action, it locks the object, checks the field to make sure the action was -not interrupted, and then does the action and drops the lock. The ball -object is a good example: its bounce method checks its bouncing field, and -a ball can be interrupted in the middle of a bounce by being picked up. Index: obj/abstract/programmer/python-thing.hlp =================================================================== --- obj/abstract/programmer/python-thing.hlp (revision 23) +++ obj/abstract/programmer/python-thing.hlp (working copy) @@ -1,190 +0,0 @@ -Help on package mooix: - -NAME - mooix - -DESCRIPTION - Python 2.2.1+ binding for mooix - Copyright (c)2002,2003 Nicholas D. Borko. All Rights Reserved. - The author can be reached at nick@dd.revealed.net - - The Python binding for mooix is free software; you can redistribute - it and/or modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The Python binding for mooix is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with mooix; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - 02111-1307 USA. - -mooix.Thing = class Thing(__builtin__.object) - | This is the mooix object class for Python. It provides a standard class - | interface to the decidedly non-standard mooix objects. - | - | Please do not change directory after instantiating objects in this - | class; relative paths are used extensively, for security reasons. - | - | Available attributes: - | - | path: the absolute path that was used to instantiate the Thing. - | id: the same as path, for binding consistency - | - | Methods defined here: - | - | Return(self, value=None) - | Return([value]) - | - | value: None for nothing, or else a single value or list - | - | Returns a value (string, Thing, or a list of them) from the method - | being called. - | - | croak(self, error, status=0) - | croak(error[, status]) - | - | error: reason for failing - | status: result status to exit with, defaults to 0 - | - | Display a mooix calltrace instead of a Python traceback. - | - | defines(self, name) - | defines(name) -> filename if the object defines name, None if not - | - | name: string representing the field name - | - | Checks to see if an object contains a field. Inheriting the - | field from a parent does not count; the field must be part of - | the object the method is called on. If the object does define - | the field, returns the filename of the field in the object. - | - | encapsulator(self) - | encapsulator() -> object that contains this one - | - | Return the mooix object that the object is encapsulated in. That - | is, the object that the mooix object is a subdirectory underneath. - | - | fieldfile(self, name, abs_path=False) - | fieldfile(name, [ abs_path ]) -> path to file that contains - | the attribute/method - | - | name: name of attribute or method to find (string) - | abs_path: If true, return an absolute path, otherwise return a - | relative path. Default is False. - | - | Returns the path to the named attribute or method as it exists - | in the file system. Raises MoooxError on failure. - | - | getlock(self, locktype=2, field='.mooix') - | getlock([locktype[, filename]) -> open file object - | - | locktype: A valid lock type for flock() from the fcntl module. - | Defaults to LOCK_EX - | field: The name of the field to lock. Defaults to '.mooix' - | - | Return an open file object that represents a lock. Close the file - | to drop the lock. The field to lock must exist on the object and - | not be inherited, or else an IOError exception will be raised. - | - | hasattr(self, name) - | hasattr(name) -> true if named attribute is available, false if not - | - | name: string representing the attribute name - | - | This does the same thing as the builtin hasattr() function, but - | it does not call getattr() to make its determination. Always - | use this method instead of the hasattr() builtin. - | - | isa(self, other) - | isa(other) -> true or false - | - | other: a Thing or an absolute path as a string - | - | Returns true of Things are equal or the path is the same as the - | our path. - | - | msg(self, event, *arg, **kw) - | msg(self, event [, arg1 [, ...]]) - | - | message: a event to send as a message - | - | Sends an event to the outermost container of the object. The - | global args are automatically passed, so you don't have to - | explicitly pass them as in other language bindings. If you want - | to override a global arg, just specify it as an argument to msg - | and it will be overridden. - | - | prettylist(self, object_list) - | prettylist(object_list) -> a pretty-printed list of objects - | - | Generates a very pretty-printed list of objects, and returns it. - | The object it's run on will appear in the list as "you". - | - | prettyname(self) - | prettyname() -> the object's name with any article prepended - | - | safegetfield(self, field) - | safegetfield(field) -> value of safe attribute or method - | - | This method can be used to safely get the value of a field or - | method, which might be supplied by a non-programmer (e.g., as part - | of a message), without accidentially calling destructive methods - | like destroy. - | - | It only allows getting values of fields that are not private. - | - | It only allows calling of methods that are marked as safe by the - | existence of a field named .-safe with a true value. - | - | super(self, *arg, **kw) - | super([arg1 = value [ ,...]]) - | - | Call the predecessor's corresponding method and return whatever - | it returns. The global args are automatically passed, so you don't - | have to explicitly pass them as in other language bindings. If you - | want to override a global arg, just specify it as an argument to - | super and it will be overridden. - | - | usage(self, *arg) - | usage([arg1[, ...]]) - | - | Displays usage help on the currently running method (by calling - | the object's getusage method (which must exist if you want this to - | work)) and exits. Any arguments are printed out. - -FUNCTIONS - background() - background() -> false to parent, true to child - - A convenience function to fork to the background, taking care of - closing stdin and stdout for the child. - - exit(error=10, new_it=None) - exit(error [, new_it]) - - error: an error code, one of OK, FAIL, SKIP, EXIT, SETIT, or SETITREF - new_it: if error is SETIT or SETITREF, then new_it is the new "it" - - This function can be used by verbs (and occasional other methods) - to exit with a numeric exit code that indicates failure, and at the - same time return a value to the caller. - -DATA - MOOROOT = '/var/lib/mooix' - args = - this = - OK = 0 - SKIP = 20 - FAIL = 10 - EXIT = 30 - SETIT = 40 - SETITREF = 50 - LOCK_SH = 1 (shared lock) - LOCK_EX = 2 (exclusive lock) - LOCK_NB = 4 (nonblocking lock) - LOCK_UN = 8 (unlock) Index: obj/abstract/programmer/Makefile =================================================================== --- obj/abstract/programmer/Makefile (revision 23) +++ obj/abstract/programmer/Makefile (working copy) @@ -3,10 +3,7 @@ safechange: ../builder/safechange # Trim ifdeffed checks in builder safechange to produce one for # programmers. - perl -ne 'if (/^#ifndef programmer/) { $$skip = 1 } \ - elsif (/^#endif/) { $$skip = 0; next } \ - print $$_ unless $$skip \ - ' < ../builder/safechange > safechange + perl -ne 'if (/^#ifndef programmer/) { $$skip = 1 } elsif (/^#endif/) { $$skip = 0; next } print $$_ unless $$skip ' < ../builder/safechange > safechange chmod +x safechange clean:: Index: obj/abstract/programmer/python-tips.hlp =================================================================== --- obj/abstract/programmer/python-tips.hlp (revision 23) +++ obj/abstract/programmer/python-tips.hlp (working copy) @@ -1,76 +0,0 @@ -Tips on using the Python binding. - -Working with Result Objects - - Result objects cannot be altered, but for Property objects you *can* - assign values to any of its properties, and it will be as if you are - assigning the value to the Property itself: - - this.spring.int += 1 - - It doesn't matter which "type" property you are assigning the value to; - the value will be assigned to the actual mooix property regardless, - meaning you can assign a list to the int property. - - Property objects can become invalid if the type of the mooix method - changes, i.e. becomes an object reference, object list or executable - method. For example: - - my_spring = this.spring - my_spring.int === 1 - ...some stuff happens, in the meantime spring becomes a method - my.spring.int === 0 - my.spring.string === 'program line 1\nprogram line 2\n...' - my.spring.list === [ 'program line 1', 'program line 2', ... ] - - Generally, your best bet is to avoid creating references to Result - objects and just stick with object attribute accesses. - -Convenience Constants - - For convenience sake, the valid lock types from the fcntl module can - be imported from the mooix module directly for use with - Thing.getlock(). These are available as LOCK_UN, LOCK_SH, LOCK_EX and - LOCK_NB. - -Other Considerations - - Although the Thing object is documented in =python-thing=, you should - be aware of the hasattr() method, which is analogous to other - bindings' implements() functions. You can use Python's builtin - hasattr() function, but the hasattr() method is *much* faster, since - it only checks for the existence of the attribute rather than trying - to access it. To use hasattr() as a method rather than using the - builtin, transform all hasattr(object, 'attribute') calls into - object.hasattr('attribute'). - - There are some other limitations with the way you can use the binding - compared to what's considered to be "normal" use of Python. The reason - these limitations exist is because of the way Python must interact - with mooix in order to present a coherent object-oriented interface. - - First of all, avoid interacting with sys. I recommend you don't even - import it. Everything you need access to is provided by either mooix - module functions or else object methods. For example, sys.stdout never - needs to be used, nor should it ever be; use this.msg() or notice() to - produce output. Writing to sys.stdout either explicitly or through - print will screw up interaction with mooix. Also, use the exit() - function provided by the mooix module as documented in the =python= - help page, never sys.exit(). - - Second, do not pass dictionaries or any other arbitrary structure as - an argument to a method; they will not be interpreted correctly. - Arguments to mooix methods can only be strings, Things, or - lists/tuples of them. Anything else will be converted to a string, if - possible, which means you can pass numeric types or anything else - where its str() produces the correct argument. If you must, I suppose - it might be possible to pickle and encode python objects as strings to - pass between other methods also written in Python, but that's really - quite insane. And dangerous, since someone could override any method - with non-Python code. - - Finally, the builtins isinstance() and issubclass() will not work - along a mooix inheritance, only along Python's class structure. This - means that every object will only be an instance of Thing. Instead, - use the isa() method of a thing, as documented in the =python-thing= - help page, to determine if it's a descendent of another object. Index: obj/abstract/programmer/shell_verb =================================================================== --- obj/abstract/programmer/shell_verb (revision 23) +++ obj/abstract/programmer/shell_verb (working copy) @@ -6,8 +6,9 @@ # Don't let a builder spoof a programmer that they own to call this # method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } $_{session}->write(`$_{quote}`); Index: obj/abstract/programmer/signal_verb =================================================================== --- obj/abstract/programmer/signal_verb (revision 23) +++ obj/abstract/programmer/signal_verb (working copy) @@ -7,8 +7,9 @@ # Don't let a builder spoof a programmer that they own to call this # method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $obj = $_{direct_object}; @@ -25,9 +26,10 @@ } if ($obj->signal(with => $signal, @args)) { - $session->write("Signal sent."); + $this->msg( 'signal', %_ ); } else { - fail "Failed to send signal."; + $this->msg( 'signal_fail', %_ ); + fail(); } } Index: obj/abstract/programmer/set_reference.msg =================================================================== --- obj/abstract/programmer/set_reference.msg (revision 0) +++ obj/abstract/programmer/set_reference.msg (revision 0) @@ -0,0 +1 @@ +session: Reference set. Index: obj/abstract/programmer/ruby.hlp =================================================================== --- obj/abstract/programmer/ruby.hlp (revision 23) +++ obj/abstract/programmer/ruby.hlp (working copy) @@ -1,105 +0,0 @@ -Writing mooix methods in ruby. - -The ruby binding for mooix is relatively straightforward - method calls are -transparently converted to invoking the appropriate mooix function, field -assignment does the right thing, etc. Here's a very simple example of a -verb written in ruby: - - #!/usr/bin/ruby - - require "mooix" - require "mooix/thing" - - Mooix.run do - args = Hash[*@args] - j = args["do_preposition"] - self.msg("poke", "pressure" => j) - m = case j - when "hard" then "lots" - when "soft" then "little" - else "some" - end - jiggle("motion" => m) - self.poked_count += 1 - end - -The Mooix.run method should wrap any mooix method written in ruby. It -takes a block, which is evaluated in the context of a Thing representing the -object that owns the verb. - -Method calls are translated to mooix method calls transparently, with one -gotcha - to access a mooix variable, you have to use the form "self.variable" -instead of just "variable", as the latter will just try to reference a local -variable. Object references are converted into Thing objects, and field -values that are composed entirely of digits are converted into integers. To -turn off the latter behavior, set $autoconvert to false. - -Arguments are available in the instance variable "@args", which is by default -an array of the arguments passed to the command. If you want to use named -arguments, simply convert the array to a hash like so: - - args = Hash[*@args] - -To return a value, use Mooix.return instead of return; this lets the values -be properly passed back to mooix. The special exit codes documented at the -end of =verbs= are constants in the mooix module (Mooix::OK, etc.) and can -either be used directly in an exit() call or passed to Mooix.return_with. - -The Thing class, which is included by requiring "mooix/thing", is used -to represent mooix objects in ruby. Here's a brief list and -explanation for the methods Things offers: - -path - Returns a string containing the absolute path of this Thing. - -== - Compare two Things. This follows symlinks, so two Things might have - different paths but still be equal, or vice versa. - -to_s - Returns a string representation of this Thing that follows the mooix - object reference standard ("mooix:path"). Paths will always be absolute. - -super(...) - Invokes the method overridden by the current method, if any. This will only - work on self, which must be explicit, as in: self.super(@args). - -member_path(name) - Returns the full path of the given member. - -msg(name, ...) - Convenience wrapper for mooix's msg method, eliminating the need to - explicitly add the message's name to the hash of arguments. - -is_thing?(other) - Returns true if the given thing (can be a Thing object, or a string with - the path) is an ancestor of the receiver. - -has?(name) - Returns true if the Thing (or one of its parents) has a member "name". - -getlock(type = File::LOCK_EX) - Locks the object. See =locking= for the specifics of how this - works. By default, getlock locks the object such that nothing else can - read from or write to its fields. File::LOCK_SH can be used to prevent - other methods from writing to fields while allowing any to read from - them. - -The mooix module offers a few useful methods: - -Mooix.run { block } - The main mooix method. Use this to start all your methods. - -Mooix.background [{ block }] - A convenience wrapper for fork. Takes care of closing stdin/out. If a - block is given that block will be executed and then the child process - will terminate; otherwise, background will return the process ID of the - child process to the parent, and nil to the child. - -Mooix.return(...) - Formats the values given and returns them to mooix in the proper fashion. - -Mooix.return_with(val, code) - Does the same thing as Mooix.return for val (which can be an array or hash - if multiple values are needed), but exits with the specified code instead - of Mooix::OK. Index: obj/abstract/programmer/python.hlp =================================================================== --- obj/abstract/programmer/python.hlp (revision 23) +++ obj/abstract/programmer/python.hlp (working copy) @@ -1,103 +0,0 @@ -Writing mooix methods in Python. - -The Python binding for mooix will work with versions of Python 2.2.1 and -later. Earlier versions such as 2.1.x will *not* work, because the -binding uses iterators and 2.2.1 idioms extensively. Please send all -errors/feedback/improvements to nick@dd.revealed.net. - -The remainder of this topic assumes you've read the -=programmer-tutorial=, so you're familiar with mooix terminology and -writing methods in general. The =programmer-tutorial= also includes some -examples of the use of this language binding. - -Using the binding: - - The Python binding was written to provide an interface to mooix - objects in a way that should be language-transparent to programmers. - That means, object attribute and method accesses in the Python - interface do what they're supposed to do on the mooix side of things - without having to do anything special on the programmer's part. The - beginning of all mooix methods written in Python should look - something like this: - - #!/usr/bin/python - - from mooix import * - - This will import a number of objects and functions to the global name - space, the most important of which are "this" and "param." The "this" - object is a an instance of the Thing class that represents the mooix - object the method is acting on. The "args" object is a Result object - that contains the arguments passed to the method. Any argument that - looks like /^mooix:.*/ and is therefore a mooix object path is - automatically converted to a Thing object. - - Once you've got "this", you can operate on it just like you would in - the original perl binding but using Python language idioms. - Converting a Thing to a string by whatever your favorite method is - returns "mooix:/path" to aid in debugging. See =python-thing= for - complete documentation on the available methods. - - One big difference in the Python binding compared to the other - bindings is that your method is running in the global namespace, not - inside a called function. Therefore, using "return" won't work. - Instead, use the method this.Return() to return anything from your - method. - -Accessing Properties and Methods - - Python is more strongly typed than, for example, perl. However, mooix - itself is completely typeless (except for references). Therefore, in - Python all properties and methods of Thing objects return a Result - object, or a subclass thereof. To get the actual value from the - property or method Result, you need to access one of the following - properties of the Result object: int, float, number, string, list, - dict. Passing the Result object to int(), float(), long(), str(), - tuple() or list() will work, but dict() will not. For example: - - spring = this.spring.int - - or - - spring = int(this.spring) - - my_users = args['avatar'].users.list - - or - - my_users = list(args['avatar'].users) - - There are three kinds of Result objects: Arguments, Property and - Method. The "args" variable is an Arguments object, which by default - will behave like a dict, except that it is read only. Property - objects are returned from static object properties and behave like a - list by default. - - Method objects are slightly different and are returned by accessing an - attribute that is actually an executable method of an object. By - default it behaves like a callable bound method of the object. - However, if you access any of its properties *before* calling the - method, the method is instead called with no arguments, and it acts - like a regular Property object. The Method object also implements the - "status" property, which contains the value of the exit status of the - method once it's been called. Once a Method object has been "called," - it acts like a Property object. - -Other Functions - - There are a couple more functions available in the mooix module. - The background() function wraps fork() just as in the other language - bindings, taking care of closing stdin and stdout. The exit() - function, which takes as a parameter OK, FAIL, EXIT, SETIT and SETITREF, - as described in =verbs=, and optionally a Thing object in the case that - SETIT or SETITREF is the exit status, should always be used instead of - calling sys.exit(). - -Built-in Python Support - - If mooix has been built with an embedded Python interpreter, you - don't need to import mooix or any of its attributes; this is done - automatically by mooix before your method is run. All of the - module's attributes and methods will be imported into the global - namespace of your method as if "from mooix import *" had been - executed. - -For more help on writing methods using the Python binding, see the -=python-thing= help page for documentation for the mooix module. For -tips on using the binding, read =python-tips=. Index: obj/abstract/programmer/objects.hlp =================================================================== --- obj/abstract/programmer/objects.hlp (revision 23) +++ obj/abstract/programmer/objects.hlp (working copy) @@ -1,121 +0,0 @@ -Low level information about mooix objects. - -Mooix objects are pretty strange on at least two levels, for folks who are -more familiar with traditional object oriented systems. They are -persistently stored on disk, as regular directories full of files, and they -are not instantiations of classes. - -On-disk representation of objects: - - Mooix objects are essentially, just a directory with a .mooix file in it, - and some other files that represent fields and methods. The unix - permission system is used to control access to individual fields, - methods, and to objects as a whole (see =security-model= for details). - - So a simple object might look like this: - - joey@silk:/tmp/dog> ls -a - ./ ../ .mooix contents/ fetch* location@ name parent@ - joey@silk:/tmp/dog> cat name - spot - - As you can see, the data is stored in plain text format. (Most of the - time, feel free to embed images or whatever in an object if you like!) - The name field is a single value, by convention some fields hold a list - of values, one per line. - - Methods are just executable fields. - - This also shows how directories (and, more commonly, symlinks to - directories) are references to other objects. Most objects have a parent - link, that is a link to their parent object. Many have a location link, - that is a link to the object they are located in. - - Some few objects will use a sticky field with a list of lines starting - with "mooix:", and followed by absolute paths to objects, to contain - multiple object references. While field access code should support this, - it should be used as sparingly as possible. - - And it illustrates how objects can contain other objects -- in this case - the contents object -- inside them. When a new object is created, it has - to go somewhere, and it is typically placed inside some other object, as - a subdirectory of it. Subdirectories of an object are not owned by the - object, and unless they are mooix objects, are fairly useless. - - Notice that you don't see any fields and methods that might be inherited - from the parent object. They are implicitly there, but until someone - writes a cool new filesystem for this, you have to squint real hard, or - refer to them like parent/foo and parent/parent/bar. This is only a - problem if you're looking at objects in the raw; one job of the - =language-binding= is to take care of that kind of thing automatically. - - You can use any of the standard unix toolkit to operate on objects. - flock() a field, rm a method, whatever. - -Inheritance, classes, and all that jazz: - - Right now, mooix only supports single inheritance. This is mostly because - a single parent link can only point to one object, and it would be too - painful to manage multiple parent links (or, god forbid, a whole - directory full of them), and not out of any fundamental animosity to - multiple inheritance. Object composition is a good substitute for - multiple inheritance. A form of mixins are also available, see below. - - Mooix borrows from lambdamoo the concept of that is sometimes called - classless inheritance (nice ring to that, eh?). The idea is that there - are no virtual object classes, no templates, no prototypes. An object's - parent is another, real object. The root of the object tree, the - super-generic "thing" is another, real object. - - Objects overlay their parents, overriding some fields and methods, - and perhaps adding some more. A copy-on-write mechanism is used, so if a - field is read from an object's parent, then written back, the new field - is stored in the object, overlaying the parent's field. - - It's possible to run a parent's version of a method that is overridden by - the child. Just run parent/method. Most of the language bindings will - provide handy mechanisms to do that. - -Mixin objects: - - Mooix objects can be enhanced by special "mixin" objects, which can be - bound to them to add capabilities to the object. It's not entirely unlike - multiple inheritance: mixin objects add methods and fields to the objects - they are bound to. - - For example, look at the avatar class. Avatars have a parser field that - is a reference to a parser mixin object. It's an object reference like - any other. If you have an avatar, you can run its parser's parse method - like this: - - $avatar->parser_parse(); - - This actually runs the parse method of the parser object, and the method - is acting on the avatar. From a security point of view, the callstack does - not have the parser object added to it; it gets the avatar added to it - instead. - - Which can be very useful. In the case of the parse mixin, it lets an - avatar choose any parse mixin it wants to use (and trusts..), and run - its parse method at login, and the result is an callstack that just has - the avatar on it. This is a good thing because many verbs rely on just - such a minimal callstack. - - Mixins can also be useful to split up parts of an object when it is - getting too bulky and inheritance doesn't serve. Another place it is - used in the avatar class is to mixin the gender field. - -Locking: - - An object can be locked in position by flocking its .mooix file. An - exclusive lock of this file should be done anytime an object is moved, - while a shared lock of the field should be done anytime something needs - an object to stay in place. - - Similar flock locking can be done on other fields of the object, for - example a container or door can have its closed field shared flocked - by methods that are relying on that field remaining as-is, while its - methods that manipulate that field take exclusive locks before doing so. - - Locking should only be done on fields that an object has itself, not ones - derived from its parent. Index: obj/abstract/programmer/react.hlp =================================================================== --- obj/abstract/programmer/react.hlp (revision 23) +++ obj/abstract/programmer/react.hlp (working copy) @@ -1,56 +0,0 @@ -Making objects react to events in the moo. - -Eventually you will want to make an object that is able to react to other -events that take place near to it in the moo. Perhaps you want to create a -non player character (NPC), or something simpler, such as a telephone, -that can relay spoken messages elsewhere. There are many other -possibilities, and the way to do any of these things is by giving the -object a notice method, and setting the object's aware field to true. - -An object that is aware will have its notice method called whenever some -event happens nearby. For example, avatars in the moo are aware (when -they're logged in), and their notice method displays human-readable -messages to the avatar. - -Notice methods are passed a slew of parameters (see its =usage= for -details). The parameters include an originator parameter, which is the -object that originated the notice, and an event parameter, which is a -string naming the type of event, and a sense parameter, which tells which -of the 6 (or more) senses the event is noticeable via. There are many more. -Here is a simple wrapper for your own notice method that shows all the -parameters for everything you notice: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - $this->super(message => - join("\n", map { "$_ = $_{$_}" } sort keys %_). - "\n"); - - return $this->super(@_); - } - -If you install this and say "hi", it will print out something like this: - - notice: avatar = mooix:/home/user/mooix - event = say - message = You say, "hi" - originator = mooix:/home/user/mooix - quote = hi - sense = hear - session = mooix:/var/lib/mooix/system/sessionmanager/sessions/item1 - verb = say - You say, "hi" - -If you wanted to make a telephone, it could look for notices that have the -sense field set to "hear", and that originate with the avatar holding the -phone, and relay those across the telephone network. - -The event field is unfortunately not as useful. Suppose you want a NPC to -react whenever someone enters a room. If they arrive via an exit, the event -will be "arrive". On the other hand, if they teleport in, it is -"teleport_arrive", and there could be other possibilities that would all -have to be kept track of. Still, it can be done. Index: obj/abstract/programmer/methods.hlp =================================================================== --- obj/abstract/programmer/methods.hlp (revision 23) +++ obj/abstract/programmer/methods.hlp (working copy) @@ -1,58 +0,0 @@ -How to use and write methods. - -A method is a subroutine, or program that is part of an object and -implements some of that object's behavior. Methods have all the fields and -other methods of an object available to them to modify and examine and -call. In mooix, a method is always a complete, standalone program. In -another departure from other object oriented systems, methods can be -written in any programming language. The =programmer= help topic lists a -few. Every method in the moo is (or should) be documented, and this -documentation can be read with the =usage= command. - -To add a method to an object, you add a field to the object with the method -code in it, and then make the field executable. The method code is -generally put in the field with the =edit= command, and a field is made -executable with a command like: - - > the object's method is mode 0755 - -A method may be passed some parameters when it is run. Typically these will -be passed in named parameter style, which means that your method will get a -set of parameter names and their associated values. For example, in =perl=, -the parameters come in the @_ array and they can easily be transferred into -a hash for access by name: - - my $this=shift; - %_=@_; - my $avatar=$_{avatar} || die "no avatar parameter!"; - -Other languages will make them available in other ways. Occasionally, a -method will not use named parameters, but instead will simply take a list -of parameters. Either way, the parameters can be either strings or -reference to mooix objects. - -A method will typically have some way to access the object on which it is -running. In perl, that is accomplished by the "$this=shift;" line, which -takes the first element off of the @_ array; a reference to the object the -method is running on. - -A method can return some values to its caller. It may return one, or it may -return a list. Strings and references to mooix objects may be returned. In -perl, this is accomplished with the return command: - - return 1, "hello", $object; - -A method can return a numeric status code, but this is rarely used, -typically by verb =commands=. It does this by exiting with a nonzero value, -just like any unix shell command might do. - -Inside the body of the method code, it can access the fields and other -methods of its object. The mechanics of this very from language to -language. - -Note that all programmers can read your code. So can any =builder=, -unless you mark the method as opaque. You do so by setting a field -named .-opaque with a true value in it. - -For a more low-level description of how methods work, see -=methods-lowlevel=. Index: obj/abstract/programmer/eval_perl_verb =================================================================== --- obj/abstract/programmer/eval_perl_verb (revision 23) +++ obj/abstract/programmer/eval_perl_verb (working copy) @@ -6,8 +6,9 @@ # Don't let a builder spoof a programmer that they own to call this # method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # Variables available to the evaled code. Index: obj/abstract/programmer/eval_none.msg =================================================================== --- obj/abstract/programmer/eval_none.msg (revision 0) +++ obj/abstract/programmer/eval_none.msg (revision 0) @@ -0,0 +1 @@ +session: Eval failure: $verb does not exist. Index: obj/abstract/programmer/programmer.hlp =================================================================== --- obj/abstract/programmer/programmer.hlp (revision 23) +++ obj/abstract/programmer/programmer.hlp (working copy) @@ -1,19 +0,0 @@ -Introduction to programming the moo. - -As a programmer, you can do everything a =builder= can do. You can also -write programs, add methods to objects, and access the unix =shell=. - -In a mooix moo, a programmer has the same abilities as a regular unix -user. You might not have a traditional home directory or login shell, but -you can do everything a regular unix user can do. The administrator of the -moo, by making you a programmer, is showing a lot of trust in you. - -We assume that you know how to program already. You can get started on -learning about how to program the moo by reading the =programmer-tutorial= -and the available =languages=. - -Or check out the documentation on the moo's =objects=, =inheritance=, -=permissions= and how to write =methods=, =commands=, and =verbs=. Useful -commands for programmers include =edit=, =eval= and =shell=. - -See also: =basics=, =builder= Index: obj/abstract/programmer/programmer-tutorial.hlp =================================================================== --- obj/abstract/programmer/programmer-tutorial.hlp (revision 23) +++ obj/abstract/programmer/programmer-tutorial.hlp (working copy) @@ -1,1010 +0,0 @@ -A Mooix Programmer's Tutorial. - -So they went and made you a =programmer=. Now what? This tutorial assumes -that you are familiar with the basics of object oriented programming in -perl, python, or ruby. - -Note that the wind up duck developed in this tutorial is available in a -more polished form as mooix:contrib/wind_up_duck. -mooix:contrib/wind_up_duck/python and mooix:contrib/wind_up_duck/ruby are -also available as ruby and python implementations of the same object. - -You may want to =login= twice while you're working through this tutorial -and use one session for reading and one for experimenting. - -Mooix basics: - - It's very helpful for programmers to know a little bit of how mooix works - under the surface. Here are some key mooix concepts: - - - An object is a directory (with a .mooix file in it). - - A field is a file in an object directory. - - A link to another object is an object reference field. (So is an object - directory nested inside another object directory) - - A method is an executable file in an object directory. - - Methods run as individual processes, and when they call other methods, - a new process is forked off. - - A method can only write to world-writable files and to files in the - object on which it is run. - - For more details, see the =objects= and =security-model= documents. - - Mooix objects can have methods implemented in a variety of =languages=. - These methods can call each other, no matter what language they're - written in. While this tutorial uses mostly =perl= for its examples, it - also includes some examples of doing the same thing using =python= and - =ruby=. - -Building basics: - - All programmers are also builders, so you might want to read the - documentation for builders in the =builder-tutorial=. In particular, it's - useful to know how to =show= objects with the 'show' command, and =set= - fields of objects with the 'set' command. - -Editing basics: - - To program, you really need a decent text editor. You'll be using the - =edit= command frequently in this tutorial and later on to write programs - and other files. For example: - - > edit my description - - This command will pop up your editor (which probably defaults to rjoe, - a very limited editor), editing a file. You might find it useful to use a - more powerful editor, and as a programmer, you can set your editor to - anything that is available. - - > my editor is "vi" - > my editor is "emacs" - - You can edit methods too, for example, to add a new method to a dog - object, you might type this: - - > edit dog's fetch - - Which would give you an empty file in which you can write a program that - will be the dog's fetch method. - -Deleting fields: - - Deleting a field is pretty similar to editing one. Just use: - - > delete my field - - This is a more powerful version of the 'uset' command that is available - to builders and programmers; it can be used to remove methods and - references, not just fields. - -Reading usage documentation: - - The purpose, use, and interface of every field and method in the core of - the moo is documented. Programmers can view the documentation easily - with the usage command. For example, to examine a field: - - > usage of my home - home - - [From /usr/lib/mooix/abstract/avatar] - - This is the location that is an avatar's "home". Avatars can jump - there and stuff. - - It can also be used to examine methods (the usage will include the - parameters the methods expect and what they return), and to examine whole - objects (the output tends to be quite long). Some things to try: - - > usage of my notice - > usage of here - - We're discuss how to add usage documentation toward the end of this - tutorial. - -Beginning moo programming: - - Programmers can write moo programs in any available language. The =eval= - command can be used to run a fragment of code. By default, perl code: - - > eval {$me->description("A nice looking guy.")} - A nice looking guy. - > look at me. - A nice looking guy. - - This very simple example shows an alternate way to edit a field of an - object. Of course, much more interesting things can be done. Notice that - the return value of the evaled code will be displayed to you. - - The $me above is one of a number of special variables that are set by the - =eval= command. A shortcut for the eval command is just typing a - semicolon, and then the program code: - - > ;1+1 - 2 - - You can also use the =shell= command (abbreviated to '!'), which is similar - to eval, but runs the command in a shell. - - > !uptime - 01:30:27 up 12 days, 4:37, 6 users, load average: 0.25, 0.14, 0.10 - -Writing methods: - - To write =methods=, you add a field to an object with the method code in - it, and then make the field executable. For example, let's add a hello - world method to your avatar. - - > edit my hello - - Then paste in this program: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - return "Hello, world"; - } - - Let's look at this program for a minute. Most of it is boilerplate that - you will put in most of your perl methods. $this gets set to the object - that the method is being called on, and the %_ hash gets set to the named - parameters of the method. - - To run this method, you must first set its =permissions= to tell that it - is an executable method: - - > my hello is mode 0755 - hello is now mode 0755. - - One way of testing out the new method is with the =eval= command, which - will run the code you give it immediately and print its return value. - - > eval {$this->hello} - Hello, world - - Since this method is fairly boring as it is, you probably don't want to - keep it as part of your avatar. You can remove it with a single command: - - > delete my hello - -Overriding methods: - - It's more interesting to try overriding an existing method, and changing - its behavior in some way. Your avatar has a "notice" method, which is how - most of the text in the moo is sent to you. Let's change that method to - output text in pig latin. First though, a look at the usage of that - method to explain how it works: - - > usage of my notice - [...] - - It takes a single message parameter, and somehow sends it to the - "sessions" of the avatar, whatever they might be. You don't need to worry - about how the message is sent out to the sessions, because the new notice - method can turn the message into pig latin and then just call the - overridden notice method to go ahead and deliver the message. So, edit the - method: - - > edit my notice - - And put in this program, or an improved version: - - #!/usr/bin/perl - # Pig latin notice method. - #use Mooix::Thing - run sub { - my $this=shift; - %_=@_; - - sub pig { - my $flet=shift; - my $rest=shift; - my $ret=lc($rest.$flet."ay"); - if ($flet=~/[A-Z]/) { - $ret=ucfirst($ret); - } - return $ret - } - - $_{message} =~ s/(\w)(\w+)/pig($1,$2)/eg; - - return $this->super(%_); - } - - The key parts of this replacement notice method to note are that it - modifies the message parameter's value, and then passes all the - parameters into $this->super. "super" is a special method that always - runs the overloaded version of the currently running method, so it goes - off and takes care of doing whatever it is that notice usually does. - - Don't forget to tell the moo that this field you added is really a - method. - - > my notice is mode 0755 - notice is now mode 0755. - -Writing commands: - - Well, it's nice to be able to eval code on the fly and add methods to - an object, but programming the moo becomes much more interesting when you - use it to add =commands= to an object. You do this by writing a special - method, called a verb, and then letting the moo's parser know what parts - of speech the command requires. As an example, let's create a wind up toy - duck (with apologies to yduJ..) - - > derive a "toy duck" from mooix:thing - Object created. - > the toy duck's alias is "duck" - Set. - > its second alias is "toy - Set. - > its third alias is "wind up duck - Set. - > show duck's alias - Fields: - alias duck - toy - wind up duck - > describe the duck as "A small yellow plastic duck. It has a large key in its side for winding." - Description changed. - > wind up the duck - You can't do that. - - The duck doesn't know how to handle being wound up yet, so a wind command - must be added to it. Do this by adding a field to the duck called wind.cmd: - - > the duck's wind.cmd is "verb, direct_object(this)" - Set. - - Now the parser knows that when the duck is wound up, a method named - wind_verb should be run. Maybe someone will try to "windup duck" though, - and to allow for that, you can add a windup.cmd: - - > the duck's windup.cmd is "verb, direct_object(this) : wind" - Set. - - This will use the same verb as does the wind.cmd; that's what the ": wind" - is there for. So let's add the verb: - - > edit the duck's wind_verb - - Then paste in this program: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; - $avatar->notice(message => "You wind up the ".$this->name."."); - } - - Or, if you like, you can use this =python= program, which does the same - thing: - - #!/usr/bin/python - from mooix import * - avatar = args['avatar'] - avatar.notice(message = 'You wind up the %s.' % this.name) - - Or in =ruby=: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - args = Hash[*@args] - avatar = args["avatar"] - avatar.notice("message" => "You wind up the #{self.name}") - end - - Let the moo know that is a method: - - > the duck's wind_verb is mode 0755 - wind_verb is now mode 0755. - - And the duck can be wound up .. well, sorta. - - > wind up the duck - You wind up the toy duck. - - Let's look more closely at how this works. The wind.cmd, with a value - of "verb, direct_object(this)", tells the parser that there is a verb - called "wind". It also tells the parser that the verb requires a - direct object to know what to wind, and that the direct object must be - the same as the object that defines the command. This prevents the duck's - wind method from being called if you try to wind up some other object. - - Other parts of speech and limitations can be used in more complicated - commands; for full details about the format of the .cmd fields, and other - details, take a look at =commands=. - - The wind_verb is simple enough, it just uses the notice method (which you - should be familiar with from the previous section) to send a message to - the avatar who is winding up the duck. That avatar is always passed to - every verb in the parameter named "avatar". - - Really, it's too simple, since it does not let others in the room see that - the duck is being wound up, and it doesn't actually _do_ anything. And - should you be able to wind up the duck if it's on the floor? Probably not, - you should have to pick it up first. And what if you over-wind the duck; - will its little spring break? There is lots of room for improvement here, - and some of the following sections of this tutorial will work on improving - the behavior of the command. - -Using message fields for more flexible commands: - - The wind command that was added to the duck in the last section isn't - very flexible, since it always just outputs a simple message. What if - someone else (who is not necessarily a programmer) wants to make a duck - that displays different messages as it is wound up? As is, they can't do - it without reprogramming the wind_verb. The method as written also - doesn't let others in the room see what happens when you wind up the duck. - To make it easy to make more flexible messages, you can use the special - 'msg' method. For example: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - $this->msg('wind', %_); - } - - Or, using python: - - #!/usr/bin/python - from mooix import * - this.msg('wind') - - Or ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run { self.msg("wind") } - - Wow, that's shorter than the old wind method. Let's look at how it works. - - Instead of just returning a mostly static message to the caller, this - method dynamically generates its =messages= from one of the message - templates in the wind.msg field of the duck. It displays a message to - everyone in the location of the duck to let them know that the duck is - being wound up. Now the wind.msg field can be set easily with no programming - needed: - - > the duck's wind.msg is "see: $avatar $avatar->verb(winds) up $this." - Set. - > windup duck - You wind up the toy duck. - - The things in the wind.msg that look like variables are really - substitutions, and the hash passed into the $this->msg call - determines what things are available to be substituted. The substitution - for "$this" always is available, and the hash we passed in was the one - our method received its parameters in, so it has the avatar parameter - in it, which made the "$avatar" substitution available. - - The msg method took care of conjugating the sentence properly, so while - you see "You wind up the duck.", others in the room see something like - "Yourname winds up the duck.". For more details on how messages are - constructed and expanded, see =messages=. - -Setting fields in methods: - - So at this point you should have a duck that you can wind up, with easily - changed messages. But winding it up doesn't really do anything. It'd be - nice if the duck object had a field that told how much it was wound up. - Winding it up too much might damage the spring, or, if we're being nice, - might just make an ugly noise and reset the energy in the spring to zero. - Let's call the field "spring", and use a field called max_spring to tell - how far the spring can be wound. Each winding of the duck will increment - the value of the spring field by one. Creating these fields is easy - enough: - - > the duck's spring is "0" - Set. - > the duck's max_spring is "3" - Set. - - And a wind_verb that takes this into account isn't too hard either. - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - # Do the actual winding. - $this->spring($this->spring + 1); - if ($this->spring > $this->max_spring) { - $this->spring(0); - $this->msg('overwind', %_); - } - else { - $this->msg('wind', %_); - } - } - - Doing the same thing in python: - - #!/usr/bin/python - from mooix import * - - this.spring.int += 1 - if this.spring.int > this.max_spring.int: - this.spring = 0 - this.msg('overwind') - else: - this.msg('wind') - - And in ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - self.spring += 1 - if self.spring > self.max_spring - self.spring = 0 - self.message('overwind') - else - self.message('wind') - end - end - - Notice that this adds a new message, overwind, to be displayed if the - spring is overwound. Be sure to set it: - - > the duck's overwind.msg is "see,hear: $avatar $avatar->verb(winds) up $this -- too far. With a loud noise, its spring comes unwound!" - Set. - - Looks like the the new verb works ok ... - - > wind duck - You wind up the toy duck. - > wind duck - You wind up the toy duck. - > wind duck - You wind up the toy duck. - > wind duck - You wind up the toy duck -- too far. With a loud noise, the spring comes - unwound! - - ... or does it? Try logging in as a guest and winding up the duck to be - sure. - - guest> wind duck - ./spring: Permission denied - callstack: - mooix:/home/user/mooix/portfolio/wind_up_duck->wind_verb - mooix:/var/lib/mooix/system/guestmanager/guests/blue->parse - mooix:/var/lib/mooix/system/guestmanager/guests/blue->login - at wind_verb line 11 - - Not what you'd expected is it? What's going on is that the moo's - permissions system is not letting the wind_verb set the spring field - because it is called by someone who is not the duck's owner. This is a - useful security feature, but it's getting in the way of having a - wind_verb that can be used by everyone. - - There are two general ways to work around the security check. The spring - field could be made group writable, which would let any method of the - duck modify it. The only downside to that is that is that this might make - it easier for someone else to fiddle with its value. Or, the wind_verb - method could be made "stackless", which is similar to making a program - setuid in unix. This would let it modify any of the duck's fields at - will, no matter who called it or what their permissions were. That's a - mite dangerous, so let's go with the first solution, making the spring - field group writable. - - > the duck's spring is mode 0664 - - If you're not familiar with unix file permissions numbers, just take it - on faith that this makes the spring group-writable. With this change, - even guests can wind up the duck. Give it a try. The moral is that even - if a method works for you, it might not work for others, so use a - different account to test it. It's also a good idea to test methods with - an in Dependant observer in the room, so you can see what a third party - sees as well as what you see. - -Object initialization: - - Making the spring field group writable fixes the permissions problems - with that field, but there is another class of problems you should keep - in mind. What happens if someone derives an object from your duck? - The spring field in the derived object will start out inheriting from the - spring field of its parent. As soon as a method changes the child's - spring field, though, the new value will be written directly to the child - object. - - And here lies a big gotcha, because the "new" spring field will - not be group writable -- "new" fields always start out mode 644, even if - they override a field with some other permission. So after deriving a - child duck, and winding it up, you'll have a duck with a spring field - only you can write to. Other users will have the same problems they had - before. - - In cases like these, it's good practice to arrange for derived objects to - start out with such fields set to a sane default value and premissions. - You should do this whenever it does not make sense for a field to be - inherited. All it takes is an init method, which is run when a child - object is created. Here is such an init method for the wind up duck: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - $this=shift; - $this->spring(0); - chmod(0664, $this->fieldfile('spring')) || die "chmod: $!"; - return $this->super(@_); - } - - Or ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - self.spring = 0 - File.chmod(0664, self.member_path("spring")) - Mooix.return self.super(@args) - end - - The moral of the story is that after creating an object, you should - derive a child from it, log in as a guest, and make sure the child object - works when someone else tries to use it. - -More method overriding: - - Now you should have a duck that can really be wound up. Like any - mechanical toy, as soon as it's placed on a level surface, it should try - to scoot forward. To accomplish this, we'll need to override some existing - methods. - - To start with, if the duck is dropped, it will either land on its feet - and start walking forward, or it will land on its side and discharge the - spring. There is a method, called "drop" that is called whenever an - object is dropped from a height. Overloading this method with our own - will accomplish what we want. Let's take a look at the documentation for - the drop method. - - > usage of the duck's drop - [...] - - Rather than re-implement everything this method already does, we can - have the duck's new drop method call the overridden method using the special - super method. So "edit the duck's drop" and enter in the program below, - then remember to use "the duck's drop is mode 0755" to let the moo know - it's executable. - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - # Call super method to handle the drop, it returns true on success. - return unless $this->super(@_); - - if ($this->spring > 0) { - # The duck either lands on its side, or it lands on its feet. - if (rand > 0.5) { - # Side. - $this->msg('drop_discharge', %_); - # Unwind the spring (which is group writable..) - $this->spring(0); - } - else { - # Feet. Waddle off. - $this->waddle; - } - } - - # Indicate successful drop. - return $this; - } - - If you prefer that in python: - - #!/usr/bin/python - from mooix import * - import random - - # Call super method to handle the drop, it returns true on success. - if this.super(): - - if this.spring.int > 0: - # The duck either lands on its side, or it lands on its feet. - if random.random() > 0.5: - # Side. - this.msg('drop_discharge') - # Unwind the spring (which is group writable..) - this.spring = 0 - else: - # Feet. Waddle off. - this.waddle() - - this.Return(this) - - Or in ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - Mooix.return unless self.super(@args) - - if self.spring > 0 - if rand > 0.5 - self.message("drop_discharge") - self.spring = 0 - else - self.waddle - end - end - - Mooix.return self - end - - This introduces a new message, drop_discharge, which needs to be set: - - > the duck's drop_discharge.msg is "see: $this lands on its side, and kicks $this->gender_possessive_pronoun feet uselessly in the air." - Set. - - Note the use of "$this->gender_possessive_pronoun" where you would expect - to see "its". Parameterizing this based on the object's gender makes it - easy to create a male duck or a female duck (or some other type of - creature) without having to go through all the messages to change "its" - to "his" or "hers", and so forth. For details see the =pronoun= - documentation. - - Anyway, the new drop method calls $this->waddle if the duck lands on its - feet. That method should be something like this: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - if ($this->spring) { - # Waddle around a bit, depending on how tightly the spring - # is wound. - if ($this->spring >= $this->max_spring / 2) { - $this->msg('energetic_waddle', %_); - } - $this->msg('waddle', %_); - - # Unwind the spring (which is group writable..) - $this->spring(0); - - return $this; # success - } - else { - return; # failure - } - } - - Or in ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - if self.spring > 0 - self.message("energetic_waddle") if self.spring >= self.max_spring / 2 - self.message("waddle") - self.spring = 0 - Mooix.return self - else - Mooix.return - end - end - - Remember to let the moo know this is a method, and set both of the new - messages introduced by this method: - - > the duck's waddle is mode 0755 - > the duck's energetic_waddle.msg is "see: $this waddles around $this->location." - Set. - > the duck's waddle.msg is "see: $this takes a few waddling steps, and stops." - Set. - - That takes care of dropping the duck. What if it's just put down on the - floor? Recall that .cmd fields tell what parts of speech a verb will be - called with. Let's look at the duck's put.cmd: - - > show the duck's put.cmd - Commands: - * put.cmd verb, direct_object(tomove), io_preposition, indirect_object(this)(touchable) - verb, do_preposition(down), direct_object(this)(tomove) - - The second line is the form of "put" we want to override, while the - first is used when putting an object into a container. So what we need to - do is override the put_verb with one that checks to see if the - do_preposition field is set to "down", and if so, waddles. - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - # Remember where the duck currently is. - my $old_loc=$this->location; - - # Call super to actually handle the put. - my $ret = $this->super(@_); - - # Was it put down, and did it move? If so, make it waddle. - if ($_{do_preposition} == "down" && $old_loc != $this->location) { - $this->waddle; - } - - return $ret; - } - - Or in ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - args = Hash[*@args] - old_loc = self.location - ret = self.super(@args) - self.waddle if (args["do_preposition"] == "down") and (old_loc != self.location) - Mooix.return ret - end - - Now the duck has some nice waddling behavior. It could be improved by - letting the duck waddle around flat surfaces, like furniture, or making - it bump into things as it waddles around, or having it waddle around in - the background while the command returns. - -Backgrounding methods: - - Sometimes you will want a long-running method to not block the user from - doing other things. It needs to run in the background. - - Mooix methods can fork to the background just as any other unix process. - Since methods communicate using standard input and output, those channels - must be closed when a method "daemonizes" itself (much as a good unix - daemon would do). Other than that, there are no differences or - restrictions; it is very easy to make things happen in the background in - mooix. - - To make backgrounding methods even easier, the perl module Mooix::Thing - makes available a special method named "background". (The python and ruby - language bindings provid a similar method.) It will fork and return 1 to - the child process that is running in the background, and 0 to the parent - process, which is not. - - So, let's make the duck's waddle method background itself, and waddle the - duck around for a while, depending on how much it's wound up. - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - %_=@_; - - if ($this->spring) { - return $this unless $this->background; # success - - # Waddle around a bit, depending on how tightly the spring - # is wound. - my $spring=$this->spring; - my $max=$this->max_spring; - while ($this->spring - 1 > $max_spring / 2) { - $this->msg('energetic_waddle'); - $this->spring($this->spring - 1); - sleep 1; - } - $this->msg('waddle'); - - # Unwind the spring (which is group writable..) - $this->spring(0); - } - else { - return; # failure - } - } - - Or in ruby: - - #!/usr/bin/ruby - require 'mooix' - require 'mooix/thing' - Mooix.run do - if self.spring > 0 - Mooix.background do - spring = self.spring - max = self.max_spring - while spring - 1 > max_spring / 2 - self.message("energetic_waddle") - spring -= 1 - sleep(1) - end - self.message("waddle") - self.spring = 0 - end - end - end - - This form of backgrounding methods works fine for short delays and - methods that don't run too often. The downside of doing it this way is - that a method has to sit around in memory waiting to run, which does add - some overhead to the moo. An alternative is to use the =heartbeat= to - schedule a method to run later. - -Concurrency and locking issues: - - There is one big bug in the duck now. The waddle method is run when the - duck it put down, and that method goes into the background, and says the - duck is waddling around. What happens though, if someone else (or you) - picks up the duck when it's busy waddling around? Try it and you'll see - something very strange. You might be able, with some luck, to experience - a bug like this: - - > drop the duck then take it - You drop the duck. - You take the duck. - The duck waddles around you. - - By making that waddle method run in the background, we've opened a real - can of worms, haven't we? - - First though, consider for a minute what happens with the older version - of the waddle method, the one that does not background itself. Why can't - the same thing happen then? Perhaps you can't pick up the duck until your - "drop" command terminates, but couldn't someone else? - - It turns out that they couldn't, because the moo takes care of this issue - for you most of the time. The way it works is that when the moo runs a - verb, it does appropriate locking of _all_ the objects that the command - refers to. - - It can lock the objects in two ways. The default is to lock an object in - position, with a shared lock, to prevent it moving around or leaving the - room while the verb runs. But it can also lock an object for movement, - with an exclusive lock, preventing other commands that have to do with - the object from running until the object has moved. This latter form of - locking is enabled by putting a "(tomove)" directive in the .cmd file. - See =commands=. - - Anyway, that's why you don't normally need to worry about locking, much. - Get the .cmd files right, and it should happen transparently most of the - time. The problem with backgrounding commands that move objects, then, is - that when they go to the background, the lock is soon dropped by the - moo, which assumes that the command is complete. Backgrounded methods - thus have to do their own locking. And by the way, so do any methods that - are not run from a verb. - - To solve the locking issue, we can add another field to the duck. Call it - waddling. Like the spring field, it must be group writable, and should be - set to 0 by init. The field will be set to the pid of the process that is - making the duck waddle, and we will arrange for it to be unset when the - duck is moved. The waddle method will need to check the field before each - waddle, and stop if something has interrupted the waddling. - - The special onmove method is called right after an object is moved. For - the duck, add this onmove method: - - #!/usr/bin/perl - #use Mooix::Thing; - run sub { - my $this=shift; - $this->waddling(0); - } - - Here is a version of the waddle method that does careful locking and - checking of the waddling field: - - #!/usr/bin/perl - #use Mooix::Thing; - #use Fcntl q{:flock}; - run sub { - my $this=shift; - %_=@_; - - return unless $this->spring; - - # Set the duck to waddling. Note that this is done while - # the duck is still (presumably) locked by the caller. Use - # a unique id in the waddling field since this method might - # be called twice at the same time. - return if $this->waddling; - my $id=$$; - $this->waddling($id); - - # After forking to the background, the duck isn't locked - # for movement anymore (since the caller holds the lock - # only until this method returns). - return $this unless $this->background; - - # Waddle around a bit, depending on how tightly the spring - # is wound. - my $max=$this->max_spring; - while ($this->spring - 1 > $max_spring / 2) { - # Lock the duck for movement, then check to see if - # it's still supposed to be waddling, or if - # something stopped it. - my $lock=$this->getlock(LOCK_EX); - return unless $this->waddling eq $id; - - $this->msg('energetic_waddle'); - $this->spring($this->spring - 1); - close $lock; # allow someone to intercept it - sleep 1; # while it sleeps - } - # A final waddle, and stop waddling. - my $lock=$this->getlock(LOCK_EX); - return unless $this->waddling eq $id; - $this->msg('waddle'); - $this->waddling(0); - # Unwind the spring all the way. - $this->spring(0); - close $lock; - } - - Whew! That's fairly long and tricky. The moral is probably that you - should not bother with backgrounded methods unless you really need to. - - For more information and advice on locking, see =locking=. - -Debugging: - - Mooix has an integrated debugger, which can be useful when a method is - not doing what you expect. The debugger can trace every field a method - accesses, every method it calls and their return values, and more. You - can use it to set breakpoints in methods, and it will even let you - make some rudimentary manupulations of the state of running methods. - For details see =debugging= and the help of the mooix:abstract/debug - object. - -Documenting objects: - - Let's take a look at all the fields and methods and stuff that we added to - the duck. - - > show duck - Commands: - wind.cmd verb, direct_object(this) - windup.cmd verb, direct_object(this) : wind - Fields: - alias duck - toy - wind up duck - description A small yellow plastic duck. It has a large key in its side for winding. - ? max_spring 3 - name toy duck - ? spring 0 - Messages: - [...] - Methods: - drop 27 lines of perl - put_verb 21 lines of perl - ? waddle 28 lines of perl - wind_verb 23 lines of perl - - Notice the fields with question marks before them. These are new fields - that the moo does not have documentation for. It's a good idea to - document such fields so others can better understand what's going on. - - To add documentation to a field or method, you just add a field with the - name of what you're documenting and ".inf" on the end. So "spring.inf" - will document the spring field. The documentation can be displayed with - the =usage= command. - - The format is very free-form. For a field, just briefly describe what the - field is used for, and what it contains. For a method, describe the - interface of the method, including parameters and return values. Follow - the general styles used in the large body of existing .inf fields. - - Note that if you override a method, you should probably override its .inf - field as well, and document your changes. The =usage= command will - display both the original usage and your additions. - - Documentation for programmers and builders is nice, but you may want to - add help for users too. See =writing-help= for details. Index: obj/abstract/programmer/edit.hlp =================================================================== --- obj/abstract/programmer/edit.hlp (revision 23) +++ obj/abstract/programmer/edit.hlp (working copy) @@ -1,11 +0,0 @@ -Edit a field or method. - -The edit command can be used to edit a field or a method. Note that you may -use it to edit inherited fields; the new value will be written out to -override the inherited field. If you use it to override an existing method, -you will get a blank slate to write your new method in. - -The editing is done using the unix editor pointed to by your editor field. - - > edit my name - > edit my new_method Index: obj/abstract/programmer/eval.hlp =================================================================== --- obj/abstract/programmer/eval.hlp (revision 23) +++ obj/abstract/programmer/eval.hlp (working copy) @@ -1,33 +0,0 @@ -Evaluate code on the fly. - -The eval command lets a =programmer= run code on the fly. You pass it the -code to run in quotes and it will output the return value. - - > eval "1+1" - 2 - -There is a shortcut to eval. Just type a semicolon and then the code to -run. - - > ;1+1 - 2 - -The default language code is evaluated with is =perl=, but you can eval -code in other langagues including =ruby= and =python=. To do so, let the -moo know what language to use: - - > eval "1+1" with python - 2 - -To change the default language used for eval, set your avatar's defaultlang -field. - -The evaluated code has some variables available for it to use. Here they're -given as perl variables, but variables with the same names are available -for all languages: - -$session - your session object -$me - your avatar object -$here - the avatar's location - -The =shell= command is similar, but allows running of a shell command. Index: obj/abstract/programmer/heartbeat.hlp =================================================================== --- obj/abstract/programmer/heartbeat.hlp (revision 23) +++ obj/abstract/programmer/heartbeat.hlp (working copy) @@ -1,13 +0,0 @@ -Running methods periodically. - -The heartbeat is a way to schedule methods to run periodically. You do this -by registering a method with the heartbeat object (mooix:system/heartbeat) -via its add method. The add method must be told the object and method to -run, may optionally be given parameters to pass the the method when it is -run, and also must be given a specification of the when to run the method, -which might be a single time to run, or a interval between runs. Once the -specified time arrives, the method is run. - -Objects may register methods of themselves or of other objects with the -heartbeat; all the security details are taken care of and the methods the -heartbeat runs are run with an appropriate callstack. Index: obj/abstract/programmer/perl.hlp =================================================================== --- obj/abstract/programmer/perl.hlp (revision 23) +++ obj/abstract/programmer/perl.hlp (working copy) @@ -1,40 +0,0 @@ -Writing mooix methods in perl. - -Most of the core mooix objects are written in perl, and it's a good choice -for your own methods, if you can stomach the language. The main module used -by methods written in perl is Mooix::Thing, which provides an -object-oriented interface to mooix objects in a natural perl fashion. In -brief: - - #!/usr/bin/perl - use Mooix::Thing; - run sub { - my $this=shift; - # Named parameters are in @_, transfer them to a hash. - %_=@_; - - # Your code here. - $this->foo($_{bar}); - - return $whatever; - } - -Additional modules include: - -- Mooix::Conf (for accessing /etc/mooix.conf) -- Mooix::Root (for getting at the root of the mooix core object tree) -- Mooix::Verb (for verbs) -- Mooix::CallStack (for accessing the call stack) - -All of these modules have manual pages. - -Note that mooix has special support for methods written in perl that allows -them to be run on an embedded perl interpreter for speed. As a consequence -of that support, the Mooix::Thing, Mooix::Verb, and Mooix::Root modules -will be automatically preloaded before your method is loaded, and so need -not be "use"'d by your method explicitly. Also, perl will ignore any -switches after #!/usr/bin/perl, so if you want warnings enabled you should -"use warnings". - -The =programmer-tutorial= has examples of writing methods using -Mooix::Thing. Index: obj/abstract/programmer/init.hlp =================================================================== --- obj/abstract/programmer/init.hlp (revision 23) +++ obj/abstract/programmer/init.hlp (working copy) @@ -1,15 +0,0 @@ -The init system. - -Sometimes you will need to be able to run a method of an object when the -moo is shut down, or when the moo is started up. This can be accomplished -by registering with the init system, which is based around the -mooix:system/init object. - -That object implements two methods, register and unregister, that can be -used by an object to register itself so its startup method is run at -startup, and its shutdown method at shutdown. - -The methods will be run with an callstack that includes the -mooix:system/init object, so you generally will need to make them stackless -so they can do something useful. The mooix:system/sessionmanager object's -startup and shutdown methods are good examples. Index: obj/abstract/programmer/set_reference_verb =================================================================== --- obj/abstract/programmer/set_reference_verb (revision 23) +++ obj/abstract/programmer/set_reference_verb (working copy) @@ -12,8 +12,9 @@ # Don't let a builder spoof a programmer that they own to call this # method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if ($field eq 'parent') { @@ -25,7 +26,8 @@ # Prevent accidental overwrite of text field with reference. if ($object->defines($field) && ! -k $object->fieldfile($field) && ! ref $object->$field) { - fail "That field is a string value, not a reference."; + $this->msg( 'set_reference_not', %_ ); + fail(); } my @vals=$object->$field; @@ -41,9 +43,10 @@ eval { $object->$field(@vals) }; if (! length $@) { - $_{session}->write("Set."); + $this->msg( 'set_reference', %_ ); } else { - fail "You can't set that."; + $this->msg( 'set_reference_fail', %_ ); + fail(); } } Index: obj/abstract/programmer/languages.hlp =================================================================== --- obj/abstract/programmer/languages.hlp (revision 23) +++ obj/abstract/programmer/languages.hlp (working copy) @@ -1,19 +0,0 @@ -Available programming languages -- overview. - -In the moo, =methods= can be written in any language, but only a few -languages have their own object oriented =language-binding= to make -programming mooix =methods= in them easy. They are: - -=perl=, which has quite a nice Mooix::Thing interface and is used -extensively in the moo core. - -=C=, which has a very basic non object oriented interface, and is used -for time-critical methods in the core. - -=ruby=, which has a full featured OO interface that rivals perl's. - -=python=, also sporting a full featured OO interface. - -=shell-script=, which has a OO wrapper, believe it or not, but would only -be used by the insane. There is also a wrapper for the zsh shell, for those -who are not only insane, but already committed. Index: obj/abstract/programmer/shell-script.hlp =================================================================== --- obj/abstract/programmer/shell-script.hlp (revision 23) +++ obj/abstract/programmer/shell-script.hlp (working copy) @@ -1,148 +0,0 @@ -Writing mooix methods in shell script. - -It is possible to write mooix methods in shell script. It is even possible -to write them in object oriented shell script. A very few of the core moo -objects have methods written in shell script. It's not, generally, a good -idea. - -The object oriented shell interface to mooix is provided by the -/usr/share/mooix/mooix.sh shell library. Zsh fanatics can use -/usr/share/mooix/mooix.zsh instead; it's better. - -To use the shell interface in a method, source the file and then you will -have a object named 'this' available. - -To call a method or get the value of a field, use the following syntax: - - object . method param param param - object . field - -Both of these return their values to stdout, so you may use backticks or -$() to capture them: - - ret=$(object . method param) - -To set a field to a value, put an equals sign and the value after the field -name, like so: - - object . field = "hello" - object . counter = $(( $(object . counter) + 1)) - -A field can also be set to a list of values, like this: - - object . field = "one list item" "another" "and another" - -When a field is set, the new value of the field is also output to stdout, so -you might want to capture that or direct it to /dev/null. - -If a field has a list of values, the list will be output to stdout one -line per value. Similarly, a method that returns a list of values will do -so one value per line. - -To return something from your method, simply echo it. To return a reference -to an object, simply put the object's name on a line by itself, like a -command: - - object # returns a reference to this object - -It is possible for a field to have as a value a reference to an object, or -for a method to return a reference to an object. If they do you will get a -value starting with "mooix:". To turn this into an object reference, you -must manually use the get method described below. - -It is also possible to set a field to refer to an object (but not a list of -objects), or to pass an object reference into a method. Do it like this: - - object . friend = $(otherobj) - object . method $(obj) $(anotherobj) - -The shell library provides objects with some special built in functions -too. They are: - -- get - - Pass it a name to bind to an object and the directory an object is in - (optionally prefixed with "mooix:") and it will set up an object by that - name bound to that directory. - - this . get newobj /path/to-/object - - If you already have an object, and you want to bind it to another name - for some reason, you can do the following: - - obj . get newname $(this) - -- id - - Returns the id of an object, which is the full path to the directory it - is in. - -- fieldfile - - Pass it a field name, and it will return the filename that defines the - field, either in the object or one of its parents for inherited fields. - If there is no field, returns nothing. - -- super - - Call the parent's implementation of the currently running method. Be sure - to include any parameters that should be passed on to the super method. - -- namedparams - - This parses the parameters passed to the currently running method, and - sets up variables named $param_ to hold their values. If a - parameter has a value that is an object reference, an object named - param_ will also se set up. - - So, for example, if a method is called with the following parameters: - - this . move to $(destination) why "teleported" - - Then when the move method runs the following command: - - this . namedparams - - $param_why will be set to "teleported", and an object named param_to - will be available as well. - -Note that you should avoid changing directories while using this -=language-binding=, as it uses relative directories internally and -will get confused. - -Writing methods securely in shell script is pretty hard. This language -binding should _never_ be used in a method that is stackless, or a verb. - -There is a known, and probably unfixable hole that lets an attacker feed in -a named parameter that has a strange name like ";rm -r *" and that will be -run by the shell. The mooix =security-model= makes this not be a big deal -unless the method is stackless, or the attacker does not already have the -ability to run shell commands. - -We're pretty sure that the value of a named parameter is not subject to -this type of attack, in the language binding itself. But you must guard all -the code you write that uses this language binding from this sort of -attack. - -If you ignore all inputs, it is probably safe to write code using this -language binding. - -Here is a stupid example of a method using the shell library. The method can -be used to count stuff, and it takes two parameters; "counting" tells what -thing is being counted, and "who" is someone to tell the number of things -counted so far. - - #!/bin/sh -e - . /usr/share/mooix/mooix.sh - this . namedparams - if [ "$(this . lastcounted)" != "$param_counting" ]; then - this . lastcounted = $param_counting >/dev/null - counter=$(this . counter = 1) - else - counter=$(this . counter = $(( $(this . counter) + 1 ))) - fi - param_who . notice message "Counted $counter $param_counting" - -It might be called like this: - - object . count counting "sheep" who $(avatar) Index: obj/abstract/programmer/permissions.hlp =================================================================== --- obj/abstract/programmer/permissions.hlp (revision 23) +++ obj/abstract/programmer/permissions.hlp (working copy) @@ -1,10 +0,0 @@ -Setting field permissions. - -A =programmer= will most often need to change the permissions of a field -when he is writing a method. A method must be executable after all. To make -a field executable, type: - - > the ball's bounce is mode 755 - -Here "bounce" is the method, and it will be set to unix permissions mode -755. Index: obj/abstract/programmer/verbs.hlp =================================================================== --- obj/abstract/programmer/verbs.hlp (revision 23) +++ obj/abstract/programmer/verbs.hlp (working copy) @@ -1,33 +0,0 @@ -Writing verbs. - -Verbs are special =methods= whose names end in _verb, ad that are run by -the moo parser when =commands= are entered by users. - -When a verb is run, it is always passes a session parameter and an avatar -parameter. In addition, it is passes each part of speech that the user -entered (see =commands= for a list of parts of speech), and the value of -it. The direct_object will be a mooix object, if the user's command -included the name of an object, and likewise for the indirect_object. - -By default anything a verb might happen to return is ignored; a verb -communicates with its user mostly via the msg method. -However, the exit code of the method is examined, and if it is one of the -following special values, action is taken on what the verb returned: - - 10 FAIL Method handled the command, but the requested - action failed. Abort processing of this command, - and any others that are queued, and display return - value to user as an error message. - 20 SKIP Method cannot deal with command after all, - so try to find another one with a valid - prototype, and use it instead. - 30 EXIT Log the user out. - 40 SETIT Method handled the command, and needs to change the - object referred to by "it". The method will return - the object to be designated "it", or objects to be - designated "them". - 50 SETITREF Like SETIT, but the object returned should be - usable as if it were a reference. - -Language bindings can provide the listed symbolic values as well, if they -want to. Index: obj/abstract/programmer/C.hlp =================================================================== --- obj/abstract/programmer/C.hlp (revision 23) +++ obj/abstract/programmer/C.hlp (working copy) @@ -1,35 +0,0 @@ -Writing mooix methods in C. - -Writing a mooix method in C is a good idea if the method is time critical -or called frequently. Mooix comes with a libmoomethod.so library which -provides a basic interface for mooix methods written in C. - -The provided functions are documented to some degree in moomethod.h, and -won't be reiterated here. Here is a short example: - - #include - - #include - #include - - int main (int argc, char **argv) { - param *p; - char *blah; - char *foo; - - methinit(); - - while ((p = getparam())) { - if (strcmp(p->name, "blah") == 0) { - blah = p->value; - } - else { - freeparam(p); - } - } - - foo = getfield("foo"); - - printf("\"foo is %s, and blah is %s\"\n", foo, blah); - exit(0); - } Index: obj/abstract/programmer/eval_verb =================================================================== --- obj/abstract/programmer/eval_verb (revision 23) +++ obj/abstract/programmer/eval_verb (working copy) @@ -6,14 +6,18 @@ # Don't let a builder spoof a programmer that they own to call this # method. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # Eval using the defaultlang. my $verb="eval_".$this->defaultlang."_verb"; if (! $this->implements($verb)) { - fail "Eval failure: $verb does not exist"; + $this->msg( 'eval_none', + verb => $verb, + %_ ); + fail(); } $this->$verb(@_); } Index: obj/abstract/programmer/methods-lowlevel.hlp =================================================================== --- obj/abstract/programmer/methods-lowlevel.hlp (revision 23) +++ obj/abstract/programmer/methods-lowlevel.hlp (working copy) @@ -1,35 +0,0 @@ -Low level information about mooix methods. - -You should not need to read this unless you are writing a -=language-binding=. The =methods= documentation should be sufficient for -everyone else. - -Methods communicate via stdin and stdout (you're free to run them with -command-line parameters too, but since that shows up in ps(1) output, it's -not generally useful). On method startup, the method must read its stdin -and parse it for parameters. Parameters are generally passed in the form -"name\nvalue\nname\nvalue\n". String literals may be quoted in double -quotes, and if they contain a double quote, they _must_ be so quoted. Do -not escape double-quotes. - -Because sometimes a parameter does need a newline in it, newlines are -sometimes passed as \\n in a parameter value, with \ also being escaped to -\\. - -Using named parameters makes future expansion much easier. Methods -typically ignore parameters with unknown names. A few methods don't use -named parameters, and just read a value from stdin on startup. - -To return values to its invoker, a method just outputs them to stdout. -Here the convention is to output one value per line; which allows a method -to return a simple flat list. (It'd be nice to use SOAP or something that -would allow for more complex data types, but the overhead is quite large.) - -Since it is very frequently useful to pass references to objects in and out -of methods, there is a simple convention for doing this. Any parameter -value or return value that is not in quotes and that starts with "mooix:" -and has a directory name after it is a reference to a mooix object. - -Environment variables are not passed across method calls, signaling and -most other forms of unix IPC are much changed or not available in the mooix -environment. Index: obj/abstract/programmer/language-binding.hlp =================================================================== --- obj/abstract/programmer/language-binding.hlp (revision 23) +++ obj/abstract/programmer/language-binding.hlp (working copy) @@ -1,156 +0,0 @@ -Language binding overview. - -A language binding is some kind of library for a particular programming -language that makes it be able to work with mooix =objects= in whatever -way is most natural for that language. Several =languages= already have -language bindings, and it's probably possible to do some sort of language -binding in any given programming language. - -Writing language bindings is more of an art than a science at this point, -and unless you already understand how at least one existing language -binding is used, understand the low-level details of mooix =objects=, and -have a good grasp of object oriented programming in general, and a good -knowledge of your target language, you should not attempt to write a -language binding. - -With that said, existing language bindings typically weigh in at only a few -hundred lines of code. The infrastructure of mooix -- mood(8) and -libmooproxy -- take care of hard things like the security model. What is -left to the binding is translating from the level of calling an object's -=methods=, or accessing a field in whatever way is most natural in the -target language, to the level of calling exec(), open(), read(), and write(). - - -It may help to understand exactly how a mooix method call works. The method -call starts with an existing method (or the runmeth program) sending mood a -message asking it to exec the method and passing any parameters, plus the -stdio file descriptors, and a file descriptor open to the directory of the -object the method will run on. At this point mood looks at the method, and -does some security checks. Then it sets several environment variables: - -- LD_PRELOAD is always set, to make libmooproxy.so be loaded when the - method runs, and when any programs execed by the method runs. -- THIS is set to the path to the object the method will run on. -- MOOSOCK is set to the path to a unix socket libmooproxy will use to - communicate to the mood process for this method. -- METHOD is set to the full method name, which likely is something like - "parent/parent/method". This is in contrast to the argv[0] passed to your - program, which will probably be just "method". So you will need to use - METHOD when implementing super. -- MOOIX_DEBUG might be set if debugging is enabled. It will point to - a mooix debugger object that should get debugging logs. - -Mood also connects the stdio file descriptors to the method, does other -miscellaneous setup tasks (forking, setting uid, etc), and runs it, using a -standard exec call unless it is in an embedded language (perl, sometimes -python and ruby). For embedded languages, it just feeds the method into the -interpreter. - -Now the method begins to run. If it was execed then libmooproxy is -LD_PRELOADed in and its _init function runs, checks to see if it looks -like this method was run by mood, connects to mood, etc. If the method was -run in an embedded interpreter, libmooproxy is enabled manually by mood, -which links against it. In either case libmooproxy is now able to intercept -many libc calls from the method. - -Finally things get to the point where the actual code of the method is run. -This first probably involves starting a language binding. The first task of -the language binding is to chdir to the $THIS environment variable. Like -many libc calls, chdir() is intercepted by libmooproxy. In this special -case of a chdir to $THIS, it in fact does a special fchdir to a special -hard-coded file descriptor (currently file descriptor #42) which mood -passed into the method when it ran it. This is done for security reasons, -to avoid some races which let the wrong object be interposed, and make sure -that the method's current directory corresponds to the object it is running -on. Until this special chdir is done, libmooproxy will refuse to proxy -anything to mood. - -Things run along, and the language binding is asked to access a field or -run another method. When it uses a libc function like open(), this call is -intercepted by libmooproxy, which translates it into a message that is sent -over a unix socket (along with the parameters, and the stdio file -descriptors) to mood. Mood does a lot of security checks. For example, when -opening a file, it checks that the file is in fact a file of the object the -method is running on (by checking to make sure it is a relative filename -with no directory component; libmooproxy makes sure to convert filenames to -this form before passing them to mood). If all looks ok, mood, performs the -requested operation, returning the result code and errno (and a file -descriptor, if a file was opened) back to libmooproxy through the socket. -Libmooproxy then returns this to the program, to which it looks just like a -regular libc call. - - -Some gotchas and notes: - -- Each language binding should chdir to $THIS on startup, and use relative - paths thereafter when accessing fields and methods of the object it is - running on, for security reasons. If you don't do this, things won't - work, or will work, but at a reduced speed as the mooix system brings - some expensive sanity checks to bear on everything your language binding - does. - -- In mooix it is significant what object a given method is running on. The - =security-model= may allow the method to write to the object it is - running on. Sometimes though, you get into the situation where your - method is doing things with other objects: - - $this->otherobject->method(@params); - $this->otherobject->field($value); - - Both a method call on another object, and a writing to a field of another - object are tricky. To make the method call work, your method must chdir - to the directory of the other object before execing its method, using a - relative path (this is required by various security checks in mood). - - Writing to a field of some other object is decidedly dodgy from an OO - design standpoint, and is not allowed by the security model. However, - every mooix object does have a setfield method that will happily try to - set any of its fields. A language binding can call that method when asked - to set a field of some other object. There is also a deletefield for - deleting fields of other objects, and a setmode, for changing their - permissions. - -- Don't mess with $THIS, $MOOSOCK, and other internally used variables that - will be in the environment. It will break things. You can however set or - unset MOOIX_DEBUG to turn debugging on and off. - -- Handling =inheritance= and mixins is left to the language binding. This - includes providing a super method, or something like that to call - overridden functions. - -- A good language binding will take care of reading the method's parameters - from stdin on startup, demunging them, and presenting them to the method - in a natural way. It will support named parameters. It will provide the - method some way to return a value or values (including references) to its - caller, and will take care of the appropriate formatting and output to - stdout. - -- It's useful to have a way to, given an object, get its directory name, or - id. - -- It's useful to have a way to compare two objects and tell if they are the - same. Comparing their directory names is not a good approach. - -- Bear in mind that mooix supports overriding a field with a method that - imitates the behavior of the field, without the users of that field - having to change their behavior. So your language binding should support - this. - -- If MOOIX_DEBUG points to a debugging object, then the language binding - should arrange to call the debugging object's log method at appropriate - times. This includes when fields are accessed, and when methods are - called. You may also want to provide a debuglog method in the language - binding that code using the binding can use to log debugging information. - Make it only do anything if MOOIX_DEBUG is set. - -- Other useful, but not required extras include support for formatting - =messages=, access to the callstack, /etc/mooix.conf, support for the - symbolic verb return codes listed at the end of =commands=, etc. - -- While some consistency between language bindings is useful, in the naming - of similar methods, and so on, it is key that each language binding - partake of the philosophy of its language. - -That's about all the documentation it makes sense to write here. The source -to the existing language bindings, in the bindings/ directory of the mooix -source, is a useful reference. Index: obj/abstract/avatar/who_idle.msg =================================================================== --- obj/abstract/avatar/who_idle.msg (revision 23) +++ obj/abstract/avatar/who_idle.msg (working copy) @@ -1 +1 @@ -session: $this $this->verb(is,are) in $mylocation and $this->verb(has,have) been idle for $idletime. +session: $this $this->verb(is,are) in $mylocation and $this->verb(has,have) been idle for $duration. Index: obj/abstract/avatar/safechange =================================================================== --- obj/abstract/avatar/safechange (revision 23) +++ obj/abstract/avatar/safechange (working copy) @@ -58,7 +58,8 @@ my $params=shift; if ($obj != $this) { - return "You cannot modify other objects."; + return 'safechange_fail_other'; + } undef $this; # should not need it now, so avoid mistakes. @@ -67,14 +68,14 @@ delete $params->{mtime}; if (defined $params->{mode}) { - return "You cannot set file modes."; + return 'safechange_fail_mode'; } unless (ref $obj) { # Since this version of the method does not support # creating objects, using a string for one is # always an error. - return "You cannot create objects."; + return 'safechange_fail_create'; } my $file=$obj->fieldfile($field); @@ -82,10 +83,10 @@ if (defined $params->{unset}) { if ($obj->can($field) || (defined $file && -f $file && -x $file)) { - return "You cannot unset a method."; + return 'safechange_fail_unset_method'; } if (! $obj->defines($field)) { - return "That field is not set."; + return 'safechange_fail_not_set'; } } @@ -104,57 +105,57 @@ # Otherwise, go on with all checks of the field. if (ref $params->{value} && grep ref, @{$params->{value}}) { - return "You cannot set references."; + return 'safechange_fail_set_ref'; } if ($field =~ /^[_.]/) { - return "You cannot change private fields."; + return 'safechange_fail_private'; } if ($field =~ /\// || $field eq '..') { - return "Nothing doing!"; + return 'safechange_fail_dir_chars'; } if (! defined $file || ! -e $file) { - return "No such field."; + return 'safechange_fail_none'; } if (defined $file && (-d $file || -k $file)) { - return "You cannot change a reference."; + return 'safechange_fail_change_ref'; } my $safefield=".$field-safe"; if (defined $file && -f $file && -x $file) { # They're trying to set a method.. if (! $obj->$safefield) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } if (defined $params->{mode}) { - return "Cannot change the mode of a method."; + return 'safechange_fail_change_method_mode'; } if ($params->{noexec}) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } } else { # Notice if there's a .field-safe with a false value. my $safefile=$obj->fieldfile($safefield); if (defined $safefile && -e $safefile && ! $obj->$safefield) { - return "You cannot change that field."; + return 'safechange_fail_not_safe'; } } # Perl internal methods.. if ($obj->can($field)) { - return "Cannot change a method."; + return 'safechange_fail_change_method'; } if (-l $file) { - return "Cannot change a symlink."; + return 'safechange_fail_change_symlink'; } if (! -f $file) { - return "You cannot change that field, whatever it is."; + return 'safechange_fail_change_unknown'; } } @@ -184,7 +185,7 @@ my $file=$obj->id."/".$field; if (defined $field && -e $file) { $obj->deletefield($field) || - return 0, "Permission denied."; + return 0, 'safechange_fail_perm'; } $ret=""; } @@ -192,7 +193,7 @@ # Set. $ret=eval { $obj->$field(@{$params->{value}}) }; if ($@) { - return 0, "Permission denied."; + return 0, 'safechange_fail_perm'; } } Index: obj/abstract/avatar/password.msg =================================================================== --- obj/abstract/avatar/password.msg (revision 0) +++ obj/abstract/avatar/password.msg (revision 0) @@ -0,0 +1 @@ +session: Password changed. Index: obj/abstract/avatar/sshkey.hlp =================================================================== --- obj/abstract/avatar/sshkey.hlp (revision 23) +++ obj/abstract/avatar/sshkey.hlp (working copy) @@ -1,30 +0,0 @@ -Setting up ssh for passwordless login. - -If you log into the moo with ssh, you can set it up to allow a passwordless -login, by feeding the moo a public ssh key. Do this by telling the moo what -your ssh key is: - - > my sshkey is "1024 35 10992149494 me@host" - Set. - -You may find it easier to paste the key into an editor: - - > edit my sshkey - -The text of your ssh public key can generally be found in -~/.ssh/identity.pub or ~/.ssh/id_dsa.pub. Consult your ssh documentation. - -You can even set more than one key, if you need to: - - > my second sshkey is "..." - Set. - > my third sshkey is "..." - Set. - -To remove a key, or the whole thing, use the unset command. - - > unset my second sshkey - Unset. - - > unset my sshkey - Unset. Index: obj/abstract/avatar/set_unset.msg =================================================================== --- obj/abstract/avatar/set_unset.msg (revision 0) +++ obj/abstract/avatar/set_unset.msg (revision 0) @@ -0,0 +1 @@ +session: Unset successfully. Index: obj/abstract/avatar/whisper_verb =================================================================== --- obj/abstract/avatar/whisper_verb (revision 23) +++ obj/abstract/avatar/whisper_verb (working copy) @@ -66,8 +66,9 @@ my $recipient=$_{direct_object}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } $this->msg('whisperto', onlyto => $recipient, %_, Index: obj/abstract/avatar/logging_on_verb =================================================================== --- obj/abstract/avatar/logging_on_verb (revision 0) +++ obj/abstract/avatar/logging_on_verb (revision 0) @@ -0,0 +1,33 @@ +#!/usr/bin/perl +# Sets up a log session, which logs everything that goes on, even after +# the avatar logs out. +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + my $log=$this->log; + + if (! $log) { + # Make new log session. + $log = $this->create(owner => $this, id => "log", + parent => $Mooix::Root->sessions->log); + } + if (! grep { $_ == $log } $this->sessions->list) { + # Add to sessions list, which enables logging. + $this->sessions->add(object => $log); + $this->msg( 'logging_on', %_ ); + } + else { + $this->msg( 'logging_on_already', %_ ); + fail(); + } +} + Property changes on: obj/abstract/avatar/logging_on_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/avatar/language.msg =================================================================== --- obj/abstract/avatar/language.msg (revision 0) +++ obj/abstract/avatar/language.msg (revision 0) @@ -0,0 +1 @@ +session: Language set. Index: obj/abstract/avatar/who_verb =================================================================== --- obj/abstract/avatar/who_verb (revision 23) +++ obj/abstract/avatar/who_verb (working copy) @@ -1,73 +1,78 @@ #!/usr/bin/perl #use Mooix::Thing; -# I'd like to use Time::Duration, but I don't haveta. -eval "use Time::Duration"; -if ($@) { - *::duration = sub { return shift()." seconds" }; -} +run sub { + my $this=shift; + %_=@_; + my $recipient = $_{avatar}; -run sub { - my $this=shift; - %_=@_; - my %idletimes; - my %avatars; - # The owner of the session is the sessionmanager, which has a - # complete list of logged-in sessions. - foreach my $session ($_{session}->owner->sessions->list) { - if ($session->avatar) { - # Folks can log in more than once, so only display - # them once. - my $avatar=$session->avatar; - if (! exists $avatars{$avatar->index}) { - $avatars{$avatar->index}=$session->avatar; - } - # Current user is never idle.. - if ($avatar != $this) { - my $idle=$session->idle; - if (! exists $idletimes{$avatar->index} || - $idle < $idletimes{$avatar->index}) { - $idletimes{$avatar->index} = $idle; - } - } + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + my %idletimes; + my %avatars; + # The owner of the session is the sessionmanager, which has a + # complete list of logged-in sessions. + foreach my $session ($_{session}->owner->sessions->list) { + if ($session->avatar) { + # Folks can log in more than once, so only display + # them once. + my $avatar=$session->avatar; + if (! exists $avatars{$avatar->index}) { + $avatars{$avatar->index}=$session->avatar; + } + # Current user is never idle.. + if ($avatar != $this) { + my $idle=$session->idle; + if (! exists $idletimes{$avatar->index} || + $idle < $idletimes{$avatar->index}) { + $idletimes{$avatar->index} = $idle; } + } } + } - foreach my $avatar (values %avatars) { - my $hostname = $avatar->lastlogin; - my $location = $avatar->location; - - # Find the main room the avatar is in, ignoring subrooms, - # like furniture and stuff. - my $oldloc; - while (ref $location) { - $oldloc = $location; - $location = $location->location; - } - $location = $oldloc; - # Location can be unset if a new user is - # just loggin in (esp guests). - if (! ref $location) { - $location="limbo"; - } - # These uses of msg are a bit tricky -- the who.msg and - # who_idle.msg of each avatar are used (to allow - # customizability), but the message itself is delivered - # only to the avatar who is running this verb. - if ($idletimes{$avatar->index} > 0) { - $this->msg('who_idle', %_, - originator => $avatar, - onlyto => $this, - idletime => duration($idletimes{$avatar->index}), - mylocation => $location, - ); - } - else { - $this->msg('who', %_, - originator => $avatar, - onlyto => $this, - mylocation => $location, - ); - } + foreach my $avatar (values %avatars) { + my $hostname = $avatar->lastlogin; + my $location = $avatar->location; + + # Find the main room the avatar is in, ignoring subrooms, + # like furniture and stuff. + my $oldloc; + while (ref $location) { + $oldloc = $location; + $location = $location->location; } + $location = $oldloc; + # Location can be unset if a new user is + # just loggin in (esp guests). + if (! ref $location) { + $location="limbo"; + } + + my $duration = $recipient->language->duration( idletime => $idletimes{$avatar->index} ); + + # These uses of msg are a bit tricky -- the who.msg and + # who_idle.msg of each avatar are used, to allow + # customizability, but the message itself is delivered + # only to the avatar who is running this verb. + if ($idletimes{$avatar->index} > 0) { + # Send + $this->msg('who_idle', %_, + originator => $avatar, + onlyto => $this, + mylocation => $location, + duration => $duration, + ); + } else { + $this->msg('who', %_, + originator => $avatar, + onlyto => $this, + mylocation => $location, + ); + } + } } Index: obj/abstract/avatar/logout_time.msg =================================================================== --- obj/abstract/avatar/logout_time.msg (revision 0) +++ obj/abstract/avatar/logout_time.msg (revision 0) @@ -0,0 +1 @@ +session: You were logged in for $timespec. Index: obj/abstract/avatar/safechange_fail_change_method.msg =================================================================== --- obj/abstract/avatar/safechange_fail_change_method.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_change_method.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot change a method. Index: obj/abstract/avatar/offer_not_holding.msg =================================================================== --- obj/abstract/avatar/offer_not_holding.msg (revision 0) +++ obj/abstract/avatar/offer_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: You're not holding that. Index: obj/abstract/avatar/safechange_fail_dir_chars.msg =================================================================== --- obj/abstract/avatar/safechange_fail_dir_chars.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_dir_chars.msg (revision 0) @@ -0,0 +1 @@ +session: I see directory traversal characters in your command. We don't allow that around here. Index: obj/abstract/avatar/home_none.msg =================================================================== --- obj/abstract/avatar/home_none.msg (revision 0) +++ obj/abstract/avatar/home_none.msg (revision 0) @@ -0,0 +1 @@ +session: You have no home! Index: obj/abstract/avatar/safechange_fail_none.msg =================================================================== --- obj/abstract/avatar/safechange_fail_none.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_none.msg (revision 0) @@ -0,0 +1 @@ +session: No such field. Index: obj/abstract/avatar/languages_verb =================================================================== --- obj/abstract/avatar/languages_verb (revision 0) +++ obj/abstract/avatar/languages_verb (revision 0) @@ -0,0 +1,19 @@ +#!/usr/bin/perl +#use Mooix::Thing; +use Mooix::Root; + +run sub { + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; + + $this->msg( + 'languages', + languages => + $this->prettylist( + $this, + map { s/^mooix://; $this->get( $_ ) } $Mooix::Root->abstract->language->languages->list + ), + %_ + ); +} Property changes on: obj/abstract/avatar/languages_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/avatar/login_unconscious.msg =================================================================== --- obj/abstract/avatar/login_unconscious.msg (revision 0) +++ obj/abstract/avatar/login_unconscious.msg (revision 0) @@ -0,0 +1 @@ +session: You are unconscious. Index: obj/abstract/avatar/paste.hlp =================================================================== --- obj/abstract/avatar/paste.hlp (revision 23) +++ obj/abstract/avatar/paste.hlp (working copy) @@ -1,21 +0,0 @@ -Pasting text into the moo. - -Sometimes you need to paste some text into the moo. The paste command lets -you do it in two ways. If you only need to paste a single line, do this: - - > paste " 16:26:36 up 5:22, 4 users, load average: 0.07, 0.11, 0.09" - You | 16:26:36 up 5:22, 4 users, load average: 0.07, 0.11, 0.09 - -If you need to paste several lines, just use the paste command without any -parameters. It will then begin prompting you with "paste>" prompts. Enter a -line consisting of just a period to end the paste. - - > paste - paste> This is my little poem. - paste> There are better, and worse. - paste> And some that even rhyme. - paste> . - -If you decide to abort a paste, "abort!" on a line by itself will do so. - -Don't paste too much in public. Index: obj/abstract/avatar/language.inf =================================================================== --- obj/abstract/avatar/language.inf (revision 0) +++ obj/abstract/avatar/language.inf (revision 0) @@ -0,0 +1,3 @@ +A reference to the language object for this user, which defines the +language they see and interact with the MOO in. Generally a child +of mooix:abstract/language Index: obj/abstract/avatar/logging_on_already.msg =================================================================== --- obj/abstract/avatar/logging_on_already.msg (revision 0) +++ obj/abstract/avatar/logging_on_already.msg (revision 0) @@ -0,0 +1 @@ +session: Logging is already turned on. Index: obj/abstract/avatar/edit_finish.msg =================================================================== --- obj/abstract/avatar/edit_finish.msg (revision 0) +++ obj/abstract/avatar/edit_finish.msg (revision 0) @@ -0,0 +1 @@ +session: Saved changes to $field on $object. Index: obj/abstract/avatar/offer_verb =================================================================== --- obj/abstract/avatar/offer_verb (revision 23) +++ obj/abstract/avatar/offer_verb (working copy) @@ -8,8 +8,9 @@ my $object = $_{direct_object}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # This doesn't allow offering say, something from a box you're @@ -17,7 +18,8 @@ if ($object->location != $this) { my $object = $_{indirect_object}; if ($object->location != $this) { - fail "You're not holding that."; + $this->msg( 'offer_not_holding', %_ ); + fail(); } else { # So the direct object seems to be the avatar to Index: obj/abstract/avatar/password_fail.msg =================================================================== --- obj/abstract/avatar/password_fail.msg (revision 0) +++ obj/abstract/avatar/password_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Password change failed. Index: obj/abstract/avatar/directed_say.msg =================================================================== --- obj/abstract/avatar/directed_say.msg (revision 23) +++ obj/abstract/avatar/directed_say.msg (working copy) @@ -1,2 +1,2 @@ -hear: $this $this->verb(says), "$quote" $do_preposition $direct_object. +hear: $this $this->verb(says), "$quote" to $direct_object. see: $this $this->verb(speaks) to $direct_object. Index: obj/abstract/avatar/languages.msg =================================================================== --- obj/abstract/avatar/languages.msg (revision 0) +++ obj/abstract/avatar/languages.msg (revision 0) @@ -0,0 +1 @@ +session: The following languages are available: $languages. Index: obj/abstract/avatar/login_never.msg =================================================================== --- obj/abstract/avatar/login_never.msg (revision 0) +++ obj/abstract/avatar/login_never.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot log in! Index: obj/abstract/avatar/logging_off_verb =================================================================== --- obj/abstract/avatar/logging_off_verb (revision 0) +++ obj/abstract/avatar/logging_off_verb (revision 0) @@ -0,0 +1,29 @@ +#!/usr/bin/perl +# Sets up a log session, which logs everything that goes on, even after +# the avatar logs out. +#use Mooix::Thing; +#use Mooix::Root; +run sub { + my $this=shift; + %_=@_; + + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + my $log=$this->log; + + if ($log && grep { $_ == $log } $this->sessions->list) { + # Removing it from the sessions list disables + # logging. + $this->sessions->remove(object => $log); + $this->msg( 'logging_off', %_ ); + } + else { + $this->msg( 'logging_off_already', %_ ); + fail(); + } +} + Property changes on: obj/abstract/avatar/logging_off_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/avatar/safechange_fail_other.msg =================================================================== --- obj/abstract/avatar/safechange_fail_other.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_other.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot modify other objects. Index: obj/abstract/avatar/safechange_fail_change_ref.msg =================================================================== --- obj/abstract/avatar/safechange_fail_change_ref.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_change_ref.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change a reference. Index: obj/abstract/avatar/login_no_time.msg =================================================================== --- obj/abstract/avatar/login_no_time.msg (revision 0) +++ obj/abstract/avatar/login_no_time.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot log in for another $timespec. Index: obj/abstract/avatar/login =================================================================== --- obj/abstract/avatar/login (revision 23) +++ obj/abstract/avatar/login (working copy) @@ -7,102 +7,124 @@ # I'd like to use Time::Duration, but I don't haveta. eval "use Time::Duration"; if ($@) { - *::ago = sub { return shift()." seconds ago" }; - *::duration = sub { return shift()." seconds" }; + *::ago = sub { return shift()." seconds ago" }; + *::duration = sub { return shift()." seconds" }; } run sub { - my $this=shift; - %_=@_; - my $session = $_{session} or $this->usage("bad session"); - my $quiet = $_{quiet}; + my $this=shift; + %_=@_; + my $session = $_{session} or $this->usage("bad session"); + my $quiet = $_{quiet}; - # This method runs stackless, and it only allows the sessionmanager - # to ask it to log in, via its login method. - if (! Mooix::CallStack::calledby($Mooix::Root->system->sessionmanager, 'login', 1)) { - $this->croak("only sessionmanager->login can call this method"); + # Add the session to our list. We might remove it further + # down the line, but this way we can use msg(). + $this->sessions->add(object => $session); + + # This method runs stackless, and it only allows the sessionmanager + # to ask it to log in, via its login method. + if (! Mooix::CallStack::calledby($Mooix::Root->system->sessionmanager, 'login', 1)) { + $this->croak("only sessionmanager->login can call this method"); + } + + # The nologin field can prevent logins. + my ($nologin, $why)=$this->nologin; + if ($nologin > time) { + $this->msg( 'login_simple', + why => $why, + onlyto => $this, + ); + $this->msg( 'login_no_time', + timespec => duration($nologin - time, 1), # be vague, + onlyto => $this, + session => $session, + ); + $this->sessions->remove(object => $session); + return; + } + elsif ($nologin < 0) { + $this->msg( 'login_simple', + why => $why, + onlyto => $this, + session => $session, + ); + $this->msg( 'login_never', + onlyto => $this, + session => $session, + ); + $this->sessions->remove(object => $session); + return; + } + + # Print last login banner. + my $logintime=time(); + if (! $quiet && $this->lastlogin) { + my $logtime = (stat($this->fieldfile("lastlogin")))[9]; + $this->msg( 'login_last', + timespec => $this->language->duration( idletime => time - $logtime), + lastlogin => $this->lastlogin, + onlyto => $this, + session => $session, + ); + $session->write(""); # blank line + } + + # Put the hostname logged in from into the lastlogin file. + $this->lastlogin($_{hostname}) if length $_{hostname}; + + my $hp=$this->hitpoints; + if ($hp <= $this->minhitpoints) { + # The avatar is dead, but no longer locked out. + # Bring back to life. + $this->resurrect; + $this->sleeping(0); # don't show them waking up below + $hp = $this->hitpoints; + } + elsif ($hp <= 0) { + # Avatar may still be unconcious, or they may have healed + # in their "sleep". + $this->hp_regen; + $hp = $this->hitpoints; + if ($hp <= 0) { + $this->msg( 'login_unconscious', + onlyto => $this, + session => $session, + ); } - - # The nologin field can prevent logins. - my ($nologin, $why)=$this->nologin; - if ($nologin > time) { - $session->write($why) if length $why; - $session->write("You cannot log in for another ". - duration($nologin - time, 1). # be vague - "."); # be vague - return; + } + + # If there is no location, go home. + my $needlook=1; + if (! $this->location && $this->home) { + $this->physics->move(object => $this, to => $this->home); + $this->msg('login_arrive', skip => $this); + $this->sleeping(0); # don't show them waking up below + $needlook=0; + } + + if ($this->location) { + # If they are asleep, show them waking up. The sleeping + # flag is used, rather then just counting the sessions to + # see if someone is logged in, because session counting is + # prone to races: if two sessions are created at the same + # time, then both will see the other session, and not show + # the avatar coming awake. + # + # Of course, if they are unconcious, whether they are + # asleep or not doesn't matter, though the field is updated + # anyway. + my $lock=$this->getlock(LOCK_EX, "sleeping"); + if ($this->sleeping) { + $this->sleeping(0); + $this->msg('wake', avatar => $this) unless $quiet || $hp <= 0; } - elsif ($nologin < 0) { - $session->write($why) if length $why; - $session->write("You cannot log in!"); - return; + + if ($hp > 0 && ! $quiet && $needlook) { + # Autolook on login. + $this->location->look_verb(avatar => $this, + session => $session); } - - # Print last login banner. - my $logintime=time(); - if (! $quiet && $this->lastlogin) { - my $logtime = (stat($this->fieldfile("lastlogin")))[9]; - $session->write("Your last login was ".ago(time - $logtime). - " from ".$this->lastlogin."."); - $session->write(""); # blank line - } - - # Put the hostname logged in from into the lastlogin file. - $this->lastlogin($_{hostname}) if length $_{hostname}; - - # Add the session to our list. - $this->sessions->add(object => $session); - - my $hp=$this->hitpoints; - if ($hp <= $this->minhitpoints) { - # The avatar is dead, but no longer locked out. - # Bring back to life. - $this->resurrect; - $this->sleeping(0); # don't show them waking up below - $hp = $this->hitpoints; - } - elsif ($hp <= 0) { - # Avatar may still be unconcious, or they may have healed - # in their "sleep". - $this->hp_regen; - $hp = $this->hitpoints; - if ($hp <= 0) { - $session->write("You are unconscious."); - } - } - - # If there is no location, go home. - my $needlook=1; - if (! $this->location && $this->home) { - $this->physics->move(object => $this, to => $this->home); - $this->msg('arrive', skip => $this); - $this->sleeping(0); # don't show them waking up below - $needlook=0; - } - - if ($this->location) { - # If they are asleep, show them waking up. The sleeping - # flag is used, rather then just counting the sessions to - # see if someone is logged in, because session counting is - # prone to races: if two sessions are created at the same - # time, then both will see the other session, and not show - # the avatar coming awake. - # - # Of course, if they are unconcious, whether they are - # asleep or not doesn't matter, though the field is updated - # anyway. - my $lock=$this->getlock(LOCK_EX, "sleeping"); - if ($this->sleeping) { - $this->sleeping(0); - $this->msg('wake', avatar => $this) unless $quiet || $hp <= 0; - } - - if ($hp > 0 && ! $quiet && $needlook) { - # Autolook on login. - $this->location->look_verb(avatar => $this, - session => $session); - } - } - - return 1; + } + + return 1; } Index: obj/abstract/avatar/logout =================================================================== --- obj/abstract/avatar/logout (revision 23) +++ obj/abstract/avatar/logout (working copy) @@ -26,8 +26,15 @@ # Print logout banner. To get the duration of the login, look at the # creation time of the session's directory. my $logintime = (stat($session->id))[9]; # mtime - $session->write("You were logged in for ". duration(time - $logintime).".") - unless $quiet; + + if( ! $quiet ) + { + $this->msg( 'logout_time', + timespec => $this->language->duration( idletime => time - $logintime), + onlyto => $this, + session => $session, + ); + } $this->sessions->remove(object => $session); @@ -41,6 +48,6 @@ $this->sleeping(1); # Don't display the sleep message if the avatar is # unconcious or dead. - $this->msg('sleep', avatar => $this) unless $quiet || $this->hitpoints <= 0; + $this->msg('sleep') unless $quiet || $this->hitpoints <= 0; } } Index: obj/abstract/avatar/safechange_fail_set_ref.msg =================================================================== --- obj/abstract/avatar/safechange_fail_set_ref.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_set_ref.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot set references. Index: obj/abstract/avatar/home_already.msg =================================================================== --- obj/abstract/avatar/home_already.msg (revision 0) +++ obj/abstract/avatar/home_already.msg (revision 0) @@ -0,0 +1 @@ +session: You're already at home. Index: obj/abstract/avatar/basics.hlp =================================================================== --- obj/abstract/avatar/basics.hlp (revision 23) +++ obj/abstract/avatar/basics.hlp (working copy) @@ -1,19 +0,0 @@ -Moo basics, an introduction. - -This is a MOO, a virtual online world which you can interact with by typing -in commands. The interface to the moo is intended to be fairly intuitive. -Just type in what you want to do at the prompt, hit enter and watch it -happen. Some things to try: - -- To talk, use a command like: say "hello" -- To move from place to place, just type where you want to go: go north -- You can manipulate objects. To pick something up, try: pick up the object -- To put an object down: put down the object - -That should be enough to get you started. If you'd like to read more, -there are discussions about =communication=, =movement=, =personalization= -of your avatar, and a help =index=. - -To see any of the above help topics, type "help" at the prompt, followed by -the word in between the equals signs. For more =help= on the help system -itself, type "help on help". Index: obj/abstract/avatar/communication.hlp =================================================================== --- obj/abstract/avatar/communication.hlp (revision 23) +++ obj/abstract/avatar/communication.hlp (working copy) @@ -1,57 +0,0 @@ -Communication with others in the moo. - -To talk with others in the same area as yourself, use the say command: - - > say "hi" - You say, "hi" - -Since you'll frequently want to talk, this can be abbreviated to just a -single quote mark followed by what you want to say. - - > "hi - You say, "hi" - -If a lot of people are talking, you might want to direct your remarks to -one person in particular. Everyone else will still hear you though. - - > say "hi" to bob - You say, "hi" to Bob. - -This can be abbreviated, to the person's name, followed by a colon, and -then what you want to say to them. (Note that for complex reasons this only -works if there are no spaces in the person's name.) - - > bob: hi - You say, "hi" to Bob. - -The moo also has an emote command that you can use to display your -emotions. - - > emote "frowns angrily" - Fred frowns angrily. - -This can also be abbreviated, to just a colon followed by the text, or (for -IRC junkies) to /me: - - > :frowns angrily - Fred frowns angrily. - > /me frowns angrily - Fred frowns angrily. - -Occasionally, you might need to emote something like "Fred's shoulders -slump." If you use the normal emote though, there is an annoying space -between your name and the rest of the text. To remove that space, use the -double colon form of emote: - - > ::'s shoulders slump. - Fred's shoulders slump. - -If you want to, you can try to whisper to someone in the room with you. It -might be overheard by others though. - - > whisper "hey, let's blow this joint" to pretty lady - -The =paste= command is occasionally useful as well. - -Warning: Other users of the moo may try to =spoof= messages to make them -seem to come from you or someone else. Index: obj/abstract/avatar/safechange_fail_change_unknown.msg =================================================================== --- obj/abstract/avatar/safechange_fail_change_unknown.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_change_unknown.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change that field, whatever it is. Index: obj/abstract/avatar/inventory_wearing.msg =================================================================== --- obj/abstract/avatar/inventory_wearing.msg (revision 0) +++ obj/abstract/avatar/inventory_wearing.msg (revision 0) @@ -0,0 +1 @@ +session: $this $this->verb(is,are) holding $contents and wearing $wearing. Index: obj/abstract/avatar/edit_verb =================================================================== --- obj/abstract/avatar/edit_verb (revision 23) +++ obj/abstract/avatar/edit_verb (working copy) @@ -3,10 +3,12 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $object=$_{direct_object} || $this->usage("bad direct object"); @@ -23,8 +25,10 @@ (map {( value => $_ )} @contents), ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + fail(); } # Tell the session to start the edit. It will call edit_finish when @@ -36,9 +40,10 @@ ); if ($status) { - $session->write("Edit in progress."); + $this->msg( 'edit', %_ ); } else { - fail "Edit failed."; + $this->msg( 'edit_fail', %_ ); + fail(); } } Index: obj/abstract/avatar/login_simple.msg =================================================================== --- obj/abstract/avatar/login_simple.msg (revision 0) +++ obj/abstract/avatar/login_simple.msg (revision 0) @@ -0,0 +1 @@ +session: $why Index: obj/abstract/avatar/logging_on.msg =================================================================== --- obj/abstract/avatar/logging_on.msg (revision 0) +++ obj/abstract/avatar/logging_on.msg (revision 0) @@ -0,0 +1 @@ +session: Logging turned on. Index: obj/abstract/avatar/home.hlp =================================================================== --- obj/abstract/avatar/home.hlp (revision 23) +++ obj/abstract/avatar/home.hlp (working copy) @@ -1,22 +0,0 @@ -Deciding where home is, and quickly going home. - -It can be useful to tell the moo that some place is your home. Often you -will be able to return to your home with a single command, from anywhere -(this may not work if you're lost in a trackless desert..). So set your -home to wherever you currently are, use the sethome command. Then you can -just use "home" to return to your home. - - A messy bedroom. A bed is here. - > sethome - Set. - > go out and downstairs - An untidy livingroom. - > home - You tap your heels three times.. - A messy bedroom. A bed is here. - -The other reason to find a home for yourself is that, when you log out of -the moo, you go to sleep. After a while, if you're sleeping in certain -public spaces, you'll be carted off to someplace. If you set your home, -you'll be sent home, otherwise, the place you end up might not be very -appealing. Index: obj/abstract/avatar/arrive.msg =================================================================== --- obj/abstract/avatar/arrive.msg (revision 23) +++ obj/abstract/avatar/arrive.msg (working copy) @@ -1 +0,0 @@ -see: $this $this->verb(arrives). Index: obj/abstract/avatar/language_not_found.msg =================================================================== --- obj/abstract/avatar/language_not_found.msg (revision 0) +++ obj/abstract/avatar/language_not_found.msg (revision 0) @@ -0,0 +1 @@ +session: No such language. Index: obj/abstract/avatar/language.cmd =================================================================== --- obj/abstract/avatar/language.cmd (revision 0) +++ obj/abstract/avatar/language.cmd (revision 0) @@ -0,0 +1,2 @@ +verb(this), language : language +verb(this), language, preposition(for), quote : language Index: obj/abstract/avatar/edit_finish_bad_id.msg =================================================================== --- obj/abstract/avatar/edit_finish_bad_id.msg (revision 0) +++ obj/abstract/avatar/edit_finish_bad_id.msg (revision 0) @@ -0,0 +1 @@ +session: Ignoring request to save edit to unknown id: $id Index: obj/abstract/avatar/safechange_fail_private.msg =================================================================== --- obj/abstract/avatar/safechange_fail_private.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_private.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change private fields. Index: obj/abstract/avatar/unconcious_verb =================================================================== --- obj/abstract/avatar/unconcious_verb (revision 23) +++ obj/abstract/avatar/unconcious_verb (working copy) @@ -20,6 +20,7 @@ exit Mooix::Verb::SKIP; } else { - fail "You are unconscious."; + $this->msg( 'unconcious', %_ ); + fail(); } } Index: obj/abstract/avatar/edit_finish_fail.msg =================================================================== --- obj/abstract/avatar/edit_finish_fail.msg (revision 0) +++ obj/abstract/avatar/edit_finish_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Unable to save changes to $field on $object. Index: obj/abstract/avatar/edit.hlp =================================================================== --- obj/abstract/avatar/edit.hlp (revision 23) +++ obj/abstract/avatar/edit.hlp (working copy) @@ -1,11 +0,0 @@ -Edit a field. - -The edit command can be used to edit a field. Depending on the interface -you are using, the editing might even be done in a real unix text editor. - - > edit my name - > edit my new_method - -It you're logged into the moo using a moo client, and your client supports -MCP, you can use the MCP Simple Edit Package for offline file editing. -Consult your client's documentation, and Index: obj/abstract/avatar/yell_verb =================================================================== --- obj/abstract/avatar/yell_verb (revision 23) +++ obj/abstract/avatar/yell_verb (working copy) @@ -5,8 +5,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if ($_{direct_object}) { Index: obj/abstract/avatar/put_verb =================================================================== --- obj/abstract/avatar/put_verb (revision 23) +++ obj/abstract/avatar/put_verb (working copy) @@ -7,8 +7,8 @@ if ($_{avatar} != $this) { # Instead of forcing an object into (ahem) an # avatar with put, need to hand it to them instead. - fail "Perhaps you should hand the object to ". - $this->gender_object_pronoun." instead."; + $this->msg( 'put_fail_give', %_ ); + fail(); } else { # Moving to self is really a take, so do it that way.. Index: obj/abstract/avatar/reset_parse.inf =================================================================== --- obj/abstract/avatar/reset_parse.inf (revision 0) +++ obj/abstract/avatar/reset_parse.inf (revision 0) @@ -0,0 +1,2 @@ +Used by language_verb to tell the parser to reset itself because the +laguage has been changed. Index: obj/abstract/avatar/logging_not_on.msg =================================================================== --- obj/abstract/avatar/logging_not_on.msg (revision 0) +++ obj/abstract/avatar/logging_not_on.msg (revision 0) @@ -0,0 +1 @@ +session: Logging is off. Index: obj/abstract/avatar/paste_abort.msg =================================================================== --- obj/abstract/avatar/paste_abort.msg (revision 0) +++ obj/abstract/avatar/paste_abort.msg (revision 0) @@ -0,0 +1 @@ +session: Aborting... Index: obj/abstract/avatar/mooinfo.hlp =================================================================== --- obj/abstract/avatar/mooinfo.hlp (revision 23) +++ obj/abstract/avatar/mooinfo.hlp (working copy) @@ -1,9 +0,0 @@ -Information about the moo. - -There are a number of useful commands that look up information about the -moo itself, rather than interacting with your environment. You can find -out who else is logged into the moo right now with the "who" command. The -"lastlog" command will display people who have recently logged in to the -moo. And the "load" command will tell you how busy the system is, -displaying number of logged in people and a unix load average (if the -first number is greater than one, then system is a bit busy). Index: obj/abstract/avatar/home_verb =================================================================== --- obj/abstract/avatar/home_verb (revision 23) +++ obj/abstract/avatar/home_verb (working copy) @@ -2,31 +2,41 @@ #use Fcntl q{:flock}; #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; - # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; - } - - if (! $this->home) { - fail "You have no home!"; - } - if ($this->home == $this->location) { - fail "You're already at home."; - } - - $this->msg('gohome', %_); - my $oldloc=$this->location; - # The home.cmd can't tell the parser that this avatar needs locking, - # so do the locking here. - my $lock=$this->getlock(LOCK_EX); - if ($this->physics->move(object => $this, to => $this->home)) { - $oldloc->msg('home', %_) if ref $oldloc; - $this->msg('teleport_arrive', %_, skip => $this); - } - else { - fail "For some reason, that doesn't work."; - } + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + if (! $this->home) { + $this->msg( 'home_none', %_ ); + fail(); + } + if ($this->home == $this->location) { + $this->msg( 'home_already', %_ ); + fail(); + } + + $this->msg('gohome', %_); + my $oldloc=$this->location; + # The home.cmd can't tell the parser that this avatar needs locking, + # so do the locking here. + my $lock=$this->getlock(LOCK_EX); + if( + $this->physics->move( + object => $this, + to => $this->home, + force => 1 + ) + ) { + $oldloc->msg('home', %_) if ref $oldloc; + $this->msg('teleport_arrive', %_, skip => $this); + } + else { + $this->msg( 'home_fail', %_ ); + fail(); + } } Index: obj/abstract/avatar/inventory_nothing.msg =================================================================== --- obj/abstract/avatar/inventory_nothing.msg (revision 0) +++ obj/abstract/avatar/inventory_nothing.msg (revision 0) @@ -0,0 +1 @@ +session: $this $this->verb(is,are) holding nothing. Index: obj/abstract/avatar/spoof.hlp =================================================================== --- obj/abstract/avatar/spoof.hlp (revision 23) +++ obj/abstract/avatar/spoof.hlp (working copy) @@ -1,28 +0,0 @@ -Detecting spoofed messages. - -Unsavoury characters in the MOO might try to spoof a message -- make it -look like the message came from someone else. In a textual world like a -MOO, this is fairly easy to do. This MOO tries to make it easy to detect -such spoofed messages. - -If you see messages like these: - - Bob grows a third arm. - Bob hits you! - -How can you tell if one of these event was spoofed? Well, for each action -that occurs in the moo, the MOO will mark the name of the object that does -the action. How this mark is displayed to you depends on the interface -you're using, but it will tend to be either putting the name in curley -braces "{Bob}", or highlighting it in some way. So the difference between -these two messages: - - Bob grows a third arm. - {Bob} hits you! - -Is that in the first message, Bob didn't really do anything -- his name is -not marked, and someone might be trying to spoof him. In the second -message, his name is marked, and so he really did hit you. - -With luck you will quickly get used to seeing the highlighting, and only -notice when it's gone -- when someone might be spoofing. Index: obj/abstract/avatar/edit.msg =================================================================== --- obj/abstract/avatar/edit.msg (revision 0) +++ obj/abstract/avatar/edit.msg (revision 0) @@ -0,0 +1 @@ +session: Edit in progress. Index: obj/abstract/avatar/sethome_limbo.msg =================================================================== --- obj/abstract/avatar/sethome_limbo.msg (revision 0) +++ obj/abstract/avatar/sethome_limbo.msg (revision 0) @@ -0,0 +1 @@ +session: Um, you're currently in limbo. Index: obj/abstract/avatar/shortcuts.hlp =================================================================== --- obj/abstract/avatar/shortcuts.hlp (revision 23) +++ obj/abstract/avatar/shortcuts.hlp (working copy) @@ -1,30 +0,0 @@ -Typing less. - -While the moo understands plain English commands, there are several things -you can do to abbreviate your commands. The =communication= help topic -explains how to abbreviate the "say" command to a single quote mark -followed by what you want to say. It doesn't mention that that can be -either a single or a double quote (single quotes are often easier to type). - -Also, anytime you need to put something in quotes, you can leave off the -trailing quote: - - > my name is "Bob - -You can sometimes get away with leaving off both quotes as well. It may not -always work though, since the result may be too ambiguous for the moo to -figure out. - -You can abbreviate "look" to just "l". - -As is mentioned in =movement=, the names of compass directions can be -abbreviated to n, s, e, w; and you need only type the name of an exit to -go there. - -You can leave off unimportant parts of speech, and punctuation, so rather -than typing "Pick up the yellow rock.", just "take rock" will suffice. - -If you want to do several commands in sequence, you can chain them -together with semicolons. So, "say 'goodbye';n;l;home" will say "goodbye", -move north, look around, and then go home -- just as if you'd typed "move -north, look around, and then go home". Index: obj/abstract/avatar/safechange_fail_unset_method.msg =================================================================== --- obj/abstract/avatar/safechange_fail_unset_method.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_unset_method.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot unset a method. Index: obj/abstract/avatar/directed_yell.msg =================================================================== --- obj/abstract/avatar/directed_yell.msg (revision 23) +++ obj/abstract/avatar/directed_yell.msg (working copy) @@ -1,2 +1,2 @@ -hear(80): $this $this->verb(yells), "$quote" $do_preposition $direct_object. +hear(80): $this $this->verb(yells), "$quote" to $direct_object. see: $this $this->verb(yells) at $direct_object. Index: obj/abstract/avatar/password_multi.msg =================================================================== --- obj/abstract/avatar/password_multi.msg (revision 0) +++ obj/abstract/avatar/password_multi.msg (revision 0) @@ -0,0 +1 @@ +session: More than one unix user can use your avatar; changing the password of the first. Index: obj/abstract/avatar/logging_verb =================================================================== --- obj/abstract/avatar/logging_verb (revision 23) +++ obj/abstract/avatar/logging_verb (working copy) @@ -4,49 +4,22 @@ #use Mooix::Thing; #use Mooix::Root; run sub { - my $this=shift; - %_=@_; + my $this=shift; + %_=@_; - # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; - } - - my $state = $_{preposition}; - my $log=$this->log; + # Make sure that this command is not spoofed, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } - if ($state eq 'on') { - if (! $log) { - # Make new log session. - $log = $this->create(owner => $this, id => "log", - parent => $Mooix::Root->sessions->log); - } - if (! grep { $_ == $log } $this->sessions->list) { - # Add to sessions list, which enables logging. - $this->sessions->add(object => $log); - $_{session}->write("Logging turned on."); - } - else { - fail "Logging is already turned on."; - } - } - elsif ($state eq 'off') { - if ($log && grep { $_ == $log } $this->sessions->list) { - # Removing it from the sessions list disables - # logging. - $this->sessions->remove(object => $log); - $_{session}->write("Logging turned off."); - } - else { - fail "Logging is already turned off."; - } - } - else { - # Display log. - if (! $log || ! grep { $_ == $log } $this->sessions->list) { - fail "Logging is off."; - } - $_{session}->page($log->display(reset => 1)); - } + my $log=$this->log; + + # Display log. + if (! $log || ! grep { $_ == $log } $this->sessions->list) { + $this->msg( 'logging_not_on', %_ ); + fail(); + } + $_{session}->page($log->display(reset => 1)); } Index: obj/abstract/avatar/clear_verb =================================================================== --- obj/abstract/avatar/clear_verb (revision 23) +++ obj/abstract/avatar/clear_verb (working copy) @@ -5,8 +5,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } $_{session}->clear; Index: obj/abstract/avatar/lastlog_empty.msg =================================================================== --- obj/abstract/avatar/lastlog_empty.msg (revision 0) +++ obj/abstract/avatar/lastlog_empty.msg (revision 0) @@ -0,0 +1 @@ +session: (none) Index: obj/abstract/avatar/home_fail.msg =================================================================== --- obj/abstract/avatar/home_fail.msg (revision 0) +++ obj/abstract/avatar/home_fail.msg (revision 0) @@ -0,0 +1 @@ +session: For some reason, that doesn't work. Index: obj/abstract/avatar/logging.hlp =================================================================== --- obj/abstract/avatar/logging.hlp (revision 23) +++ obj/abstract/avatar/logging.hlp (working copy) @@ -1,7 +0,0 @@ -Logging what goes on when you're not around. - -It's possible to log what goes on in the same room as you in the moo, even -when you're not logged in. This is controlled via the "logging" command. To -turn on logging, use "logging on", and use "logging off" to turn it off. To -see the log, just type "log" (note that after the log is displayed it will -be erased). Index: obj/abstract/avatar/unconcious.msg =================================================================== --- obj/abstract/avatar/unconcious.msg (revision 0) +++ obj/abstract/avatar/unconcious.msg (revision 0) @@ -0,0 +1 @@ +session: You are unconscious. Index: obj/abstract/avatar/sshkey_perm.msg =================================================================== --- obj/abstract/avatar/sshkey_perm.msg (revision 0) +++ obj/abstract/avatar/sshkey_perm.msg (revision 0) @@ -0,0 +1 @@ +session: Permission denied. Index: obj/abstract/avatar/safechange_fail_change_symlink.msg =================================================================== --- obj/abstract/avatar/safechange_fail_change_symlink.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_change_symlink.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot change a symlink. Index: obj/abstract/avatar/sshkey_validate =================================================================== --- obj/abstract/avatar/sshkey_validate (revision 23) +++ obj/abstract/avatar/sshkey_validate (working copy) @@ -9,11 +9,15 @@ if (! @_) { # Unsetting key. if (ref $this->_ssh) { - unlink "sshkey" || fail "Permission denied."; + if( ! unlink "sshkey" ) { + $this->msg( 'sshkey_perm', %_ ); + fail(); + } if ($this->_ssh->setkey) { return; # success } - fail "You can't do that."; + $this->msg( 'sshkey_fail', %_ ); + fail(); } else { return; # success, since there is none @@ -36,6 +40,7 @@ } else { $this->sshkey(@oldkey ? @oldkey : ""); - fail "Sorry, the key was rejected. Check the format and try again."; + $this->msg( 'sshkey_bad_key', %_ ); + fail(); } } Index: obj/abstract/avatar/password_no_user.msg =================================================================== --- obj/abstract/avatar/password_no_user.msg (revision 0) +++ obj/abstract/avatar/password_no_user.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot determine unix user for your avatar, so cannot change the password. Index: obj/abstract/avatar/sethome_verb =================================================================== --- obj/abstract/avatar/sethome_verb (revision 23) +++ obj/abstract/avatar/sethome_verb (working copy) @@ -5,11 +5,25 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } - fail "Um, you're currently in limbo." unless $this->location; - $this->home($this->location); - $_{session}->write("There's no place like home!"); + # If there is a direct object, we set home to that, else we + # set it to the current location + if( exists $_{direct_object} ) + { + $this->home( $_{direct_object} ); + $this->msg( 'sethome', %_ ); + } else { + if( ! $this->location ) + { + $this->msg( 'sethome_limbo', %_ ); + fail(); + } + + $this->home($this->location); + $this->msg( 'sethome', %_ ); + } } Index: obj/abstract/avatar/unset.msg =================================================================== --- obj/abstract/avatar/unset.msg (revision 0) +++ obj/abstract/avatar/unset.msg (revision 0) @@ -0,0 +1 @@ +session: Unset successfully. Index: obj/abstract/avatar/edit_finish =================================================================== --- obj/abstract/avatar/edit_finish (revision 23) +++ obj/abstract/avatar/edit_finish (working copy) @@ -7,6 +7,7 @@ my $session=$_{session} || $this->croak("bad session"); my @contents = map { split("\n", $_, -1) } $_{value}; my $id=$_{id}; + my $avatar = $_{avatar}; # Check that the session in question is one of the avatar's. if ((! grep { $_ == $session } $this->sessions->list) || @@ -27,22 +28,39 @@ my ($objid, $field) = $id =~ /(.*)->(.*)/; my $object=$this->get($objid); if (! ref $object || ! length $field) { - $session->write("Ignoring request to save edit to unknown id: $id"); + $this->msg( 'edit_finish_bad_id', id => $id, avatar => $avatar ); return; } - my $prettyid=$object->prettyname."'s ".$field; - + my ($stat, $msg) = $this->safechange( object => $object, field => $field, (map {( value => $_ )} @contents), ); - if (! $stat) { - $session->write("Unable to save changes to ${prettyid}: $msg."); + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $this->msg( 'edit_finish_fail', + object => $object, + field => $field, + session => $session, + onlyto => $avatar, + avatar => $avatar + ); + + $this->msg( $msg, avatar => $avatar, + session => $session, + onlyto => $avatar, + ); return } else { - $session->write("Saved changes to ${prettyid}."); + $this->msg( 'edit_finish', + object => $object, + field => $field, + onlyto => $avatar, + avatar => $avatar, + session => $session, + ); return 1; } } Index: obj/abstract/avatar/sshkey_fail.msg =================================================================== --- obj/abstract/avatar/sshkey_fail.msg (revision 0) +++ obj/abstract/avatar/sshkey_fail.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that. Index: obj/abstract/avatar/safechange_fail_perm.msg =================================================================== --- obj/abstract/avatar/safechange_fail_perm.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_perm.msg (revision 0) @@ -0,0 +1 @@ +session: Permission denied. Index: obj/abstract/avatar/paste_verb =================================================================== --- obj/abstract/avatar/paste_verb (revision 23) +++ obj/abstract/avatar/paste_verb (working copy) @@ -5,8 +5,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my @lines; @@ -19,7 +20,11 @@ my $line=$session->prompt(prompt => "paste> "); exit unless defined $line; # client exited chomp $line; - fail "Aborting.." if $line eq 'abort!'; + if( $line eq 'abort!' ) + { + $this->msg( 'paste_abort', %_ ); + fail(); + } last if $line eq '.'; push @lines, $line; } Index: obj/abstract/avatar/not_builder.msg =================================================================== --- obj/abstract/avatar/not_builder.msg (revision 0) +++ obj/abstract/avatar/not_builder.msg (revision 0) @@ -0,0 +1 @@ +session: You can't do that; you're not a builder. Index: obj/abstract/avatar/set_set.msg =================================================================== --- obj/abstract/avatar/set_set.msg (revision 0) +++ obj/abstract/avatar/set_set.msg (revision 0) @@ -0,0 +1 @@ +session: Set successfully. Index: obj/abstract/avatar/safechange.inf =================================================================== --- obj/abstract/avatar/safechange.inf (revision 23) +++ obj/abstract/avatar/safechange.inf (working copy) @@ -5,9 +5,10 @@ Returns a list of pairs, one for each stanza in the parameters. The first value in each pair is true if the modification succeeded. The second value -is a human readable error message if the modification failed. If it -succeeded, it is instead the new value of the field (if a field was set), -or the newly created object (if an object was created). +is the name of a .msg field on the avatar that contains a human +readable error message if the modification failed. If it succeeded, +it is instead the new value of the field (if a field was set), or +the newly created object (if an object was created). By default, the following constraints are placed on what an avatar can do with this method: Index: obj/abstract/avatar/logging_off_already.msg =================================================================== --- obj/abstract/avatar/logging_off_already.msg (revision 0) +++ obj/abstract/avatar/logging_off_already.msg (revision 0) @@ -0,0 +1 @@ +session: Logging is already turned off. Index: obj/abstract/avatar/language.lnk =================================================================== --- obj/abstract/avatar/language.lnk (revision 0) +++ obj/abstract/avatar/language.lnk (revision 0) @@ -0,0 +1 @@ +../language/English Index: obj/abstract/avatar/safechange_fail_mode.msg =================================================================== --- obj/abstract/avatar/safechange_fail_mode.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_mode.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot set file modes. Index: obj/abstract/avatar/languages.cmd =================================================================== --- obj/abstract/avatar/languages.cmd (revision 0) +++ obj/abstract/avatar/languages.cmd (revision 0) @@ -0,0 +1 @@ +verb(this) : languages Index: obj/abstract/avatar/spoofing_bad.msg =================================================================== --- obj/abstract/avatar/spoofing_bad.msg (revision 0) +++ obj/abstract/avatar/spoofing_bad.msg (revision 0) @@ -0,0 +1 @@ +session: Spoofing forbidden! Index: obj/abstract/avatar/login_last.msg =================================================================== --- obj/abstract/avatar/login_last.msg (revision 0) +++ obj/abstract/avatar/login_last.msg (revision 0) @@ -0,0 +1 @@ +session: Your last login was $timespec ago from $lastlogin. Index: obj/abstract/avatar/emote_verb =================================================================== --- obj/abstract/avatar/emote_verb (revision 23) +++ obj/abstract/avatar/emote_verb (working copy) @@ -5,8 +5,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # A slight hack to support "::" emoting which does not include a Index: obj/abstract/avatar/login.hlp =================================================================== --- obj/abstract/avatar/login.hlp (revision 23) +++ obj/abstract/avatar/login.hlp (working copy) @@ -1,29 +0,0 @@ -Logging into the moo. - -The details of exactly how you log into the moo depend on what software -you're using, and how the moo is set up. In general, mooix moo's will -offer access by telnet, and by ssh. You'll telnet to the system and log in -as some user, or ssh to the system as some user to log in. - -Mooix can be used without any special client on your computer; it presents -a usable interface to regular telnet and ssh clients. If you prefer, you -can also use mooix with dedicated moo clients such as tinyfugue, which -offers special features useful on moos, and may be more usable on very slow -or lagged connections. To use such clients, connect to mooix on the -appropriate port, which defaults to 7777, but may be different on different -mooix systems. Some mooix systems may not allow logins in this way, then -you're stuck with telnet or ssh (oh, the pain!). - -At first on a new moo, you can log in as a guest user, just to take a -look around. Generally you log in as a guest user by logging in as user -"moo", but see the documentation for the moo you're using to know for -sure. It won't require a password for guest access. Guests are restricted -in what they can do on the moo, so you'll probably want to sign up for a -real user account. Do this by logging in as a guest and using the -"register" command. - -Once you have a user account, note that you can log in more than once as -the same user at the same time. Also, registered users can set their -=sshkey= to feed the moo a ssh public key. You can set up -passwordless logins via ssh this way. Use the =password= command to change -your login password. Index: obj/abstract/avatar/load_verb =================================================================== --- obj/abstract/avatar/load_verb (revision 23) +++ obj/abstract/avatar/load_verb (working copy) @@ -6,8 +6,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } # count avatars and sessions Index: obj/abstract/avatar/edit_fail.msg =================================================================== --- obj/abstract/avatar/edit_fail.msg (revision 0) +++ obj/abstract/avatar/edit_fail.msg (revision 0) @@ -0,0 +1 @@ +session: Edit failed. Index: obj/abstract/avatar/.preposition-safe =================================================================== --- obj/abstract/avatar/.preposition-safe (revision 23) +++ obj/abstract/avatar/.preposition-safe (working copy) @@ -1 +0,0 @@ -0 Index: obj/abstract/avatar/lastlog_none.msg =================================================================== --- obj/abstract/avatar/lastlog_none.msg (revision 0) +++ obj/abstract/avatar/lastlog_none.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, the lastlog is not available. Index: obj/abstract/avatar/inventory_verb =================================================================== --- obj/abstract/avatar/inventory_verb (revision 23) +++ obj/abstract/avatar/inventory_verb (working copy) @@ -1,31 +1,42 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; - # Separate contents into what is worn and what is held. - my @holding, @wearing; - my @contents=grep { ! $_->hidden } $this->contents->list; - foreach (@contents) { - if ($_->worn) { - push @wearing, $_; - } - else { - push @holding, $_; - # The contents of some containers are visible to just plain - # look. - my @visi = $_->visiblecontents; - if (@visi) { - push @holding, @visi; - } - } + # Separate contents into what is worn and what is held. + my @holding, @wearing; + my @contents=grep { ! $_->hidden } $this->contents->list; + foreach (@contents) { + if ($_->worn) { + push @wearing, $_; } - - $_{contents}=$avatar->prettylist(grep { $_ != $avatar } @holding); - if (@wearing) { - $_{contents} .= " and wearing ".$avatar->prettylist(@wearing); + else { + push @holding, $_; + # The contents of some containers are visible to just plain + # look. + my @visi = $_->visiblecontents; + if (@visi) { + push @holding, @visi; + } } - $this->msg('inventory', %_); + } + + $_{contents}=$avatar->prettylist($avatar, grep { $_ != $avatar } @holding); + + if( @wearing ) { + $_{wearing} = $avatar->prettylist($avatar, @wearing); + if( @holding ) { + $this->msg('inventory_wearing', %_); + } else { + $this->msg('inventory_wearing_not_holding', %_); + } + } else { + if( @holding ) { + $this->msg('inventory', %_); + } else { + $this->msg('inventory_nothing', %_); + } + } } Index: obj/abstract/avatar/password_verb =================================================================== --- obj/abstract/avatar/password_verb (revision 23) +++ obj/abstract/avatar/password_verb (working copy) @@ -8,21 +8,26 @@ my $session = $_{session} || $this->croak("bad session"); # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my @users = $this->users; if (@users > 1) { - $session->write("More than one unix user can use your avatar; changing the password of the first."); + $this->msg( 'password_multi', %_ ); + fail(); } if (@users == 0) { - fail "Cannot determine unix user for your avatar, so cannot change the password."; + $this->msg( 'password_no_user', %_ ); + fail(); } my $user=$users[0]; if ($user !~ /^\Q$Mooix::Conf::field{moouserprefix}\E/) { - fail "Unix user $user is not a moo-only user, so not changing the password."; + $this->msg( 'password_bad_user', + user => $user, %_ ); + fail(); } # So moopasswd can be found. @@ -52,9 +57,10 @@ } waitpid $pid, 0; if ($?) { - fail "Password change failed."; + $this->msg( 'password_fail', %_ ); + fail(); } else { - $session->write("Password changed."); + $this->msg( 'password', %_ ); } } Index: obj/abstract/avatar/safechange_fail_not_set.msg =================================================================== --- obj/abstract/avatar/safechange_fail_not_set.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_not_set.msg (revision 0) @@ -0,0 +1 @@ +session: That field is not set. Index: obj/abstract/avatar/logging_off.msg =================================================================== --- obj/abstract/avatar/logging_off.msg (revision 0) +++ obj/abstract/avatar/logging_off.msg (revision 0) @@ -0,0 +1 @@ +session: Logging turned off. Index: obj/abstract/avatar/set_verb =================================================================== --- obj/abstract/avatar/set_verb (revision 23) +++ obj/abstract/avatar/set_verb (working copy) @@ -5,17 +5,19 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Antispoofing, just in case. if ($_{avatar} != $this) { - fail "No!"; + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $object=$_{direct_object} or $this->usage("bad direct object"); my $field=$_{field} or $this->usage("bad field"); my $index=$_{number} || 1; # index is 1-based - my $setstr="Set."; + my $setstr="set"; my $val; if (exists $_{quote}) { @@ -27,7 +29,7 @@ # translates into setting the field to a true or false # value. $val=exists $_{negated_verb} ? 0 : 1; - $setstr ="Unset." if ! $val; + $setstr ="unset" if ! $val; } my @vals; @@ -48,10 +50,17 @@ (map { (value => $_) } @vals), ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + fail(); } else { - $_{session}->write($setstr); + if( $setstr eq "set" ) + { + $this->msg( 'set_set', %_ ); + } else { + $this->msg( 'set_unset', %_ ); + } } } Index: obj/abstract/avatar/lastlog_verb =================================================================== --- obj/abstract/avatar/lastlog_verb (revision 23) +++ obj/abstract/avatar/lastlog_verb (working copy) @@ -6,13 +6,15 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $lastlog = $Mooix::Root->system->lastlog; if (! ref $lastlog) { - fail "Sorry, the lastlog is not available." + $this->msg( 'lastlog_none', %_ ); + fail(); } my @log = $lastlog->format(reverse => 1); @@ -26,6 +28,6 @@ $_{session}->page(@log); } else { - $_{session}->write("(none)"); + $this->msg( 'lastlog_empty', %_ ); } } Index: obj/abstract/avatar/attack_verb =================================================================== --- obj/abstract/avatar/attack_verb (revision 23) +++ obj/abstract/avatar/attack_verb (working copy) @@ -8,12 +8,14 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if (! $this->combat_ok) { - fail "You decide not to hurt anything after all."; + $this->msg( 'attack_no', %_ ); + fail(); } my $weapon = $this->weapon; Index: obj/abstract/avatar/sethome.msg =================================================================== --- obj/abstract/avatar/sethome.msg (revision 0) +++ obj/abstract/avatar/sethome.msg (revision 0) @@ -0,0 +1 @@ +session: There's no place like home! Index: obj/abstract/avatar/language_verb =================================================================== --- obj/abstract/avatar/language_verb (revision 0) +++ obj/abstract/avatar/language_verb (revision 0) @@ -0,0 +1,58 @@ +#!/usr/bin/perl +# This verb works for both the is and the set command, since they both +# parse out to the same form. +#use Mooix::Thing; +run sub { + my $this=shift; + %_=@_; + my $avatar = $_{avatar}; + my $language = $_{language}; + + # The quote, if any, is a single command to run in the language + # in question. + my $quote = $_{quote}; + + # Antispoofing, just in case. + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); + } + + my $orig_langobj = $avatar->language; + my $langobj; + + # Find the referenced language + foreach( + map { s/^mooix://; $this->get( $_ ) } + $Mooix::Root->abstract->language->languages->list + ) + { + if( $language eq $this->dexml( avatar => $this, text => $_->name ) ) + { + $langobj = $_; + last; + } + } + + if( ! $langobj ) + { + $this->msg( 'language_not_found', %_ ); + fail(); + } + + $this->setfield( "language", $langobj ); + + # If a single command has been given, run that and then + # switch the language back. Else, let the running parser + # know to reset itself. + if( $quote ) + { + $avatar->parser_parse( %_, command => $quote ); + + $this->setfield( "language", $orig_langobj ); + } else { + # Let the parser know it needs to reset itself. + $avatar->reset_parse( 1 ); + $this->msg( 'language', %_ ); + } +} Property changes on: obj/abstract/avatar/language_verb ___________________________________________________________________ Name: svn:executable + * Index: obj/abstract/avatar/sshkey_bad_key.msg =================================================================== --- obj/abstract/avatar/sshkey_bad_key.msg (revision 0) +++ obj/abstract/avatar/sshkey_bad_key.msg (revision 0) @@ -0,0 +1 @@ +session: Sorry, the key was rejected. Check the format and try again. Index: obj/abstract/avatar/say_verb =================================================================== --- obj/abstract/avatar/say_verb (revision 23) +++ obj/abstract/avatar/say_verb (working copy) @@ -5,8 +5,9 @@ %_=@_; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } if ($_{direct_object}) { Index: obj/abstract/avatar/valid_prepositions =================================================================== --- obj/abstract/avatar/valid_prepositions (revision 23) +++ obj/abstract/avatar/valid_prepositions (working copy) @@ -1,9 +0,0 @@ -carried by -by -carried -held -of -on -from -in -to Index: obj/abstract/avatar/inventory_wearing_not_holding.msg =================================================================== --- obj/abstract/avatar/inventory_wearing_not_holding.msg (revision 0) +++ obj/abstract/avatar/inventory_wearing_not_holding.msg (revision 0) @@ -0,0 +1 @@ +session: $this $this->verb(is,are) wearing $wearing. Index: obj/abstract/avatar/rename_verb =================================================================== --- obj/abstract/avatar/rename_verb (revision 23) +++ obj/abstract/avatar/rename_verb (working copy) @@ -3,6 +3,7 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; my ($stat, $msg) = $this->safechange( object => $_{direct_object}, @@ -10,10 +11,12 @@ value => $_{quote}, ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + fail(); } else { - $_{session}->write("Name changed."); + $this->msg( 'rename', %_ ); } } Index: obj/abstract/avatar/safechange_fail_create.msg =================================================================== --- obj/abstract/avatar/safechange_fail_create.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_create.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot create objects. Index: obj/abstract/avatar/rename.msg =================================================================== --- obj/abstract/avatar/rename.msg (revision 0) +++ obj/abstract/avatar/rename.msg (revision 0) @@ -0,0 +1 @@ +session: Name changed. Index: obj/abstract/avatar/say.cmd =================================================================== --- obj/abstract/avatar/say.cmd (revision 23) +++ obj/abstract/avatar/say.cmd (working copy) @@ -1,2 +1,2 @@ verb(this), quote -verb(this), quote, direct_object(single) +verb(this), quote, do_preposition(at|to), direct_object(single) Index: obj/abstract/avatar/quit_verb =================================================================== --- obj/abstract/avatar/quit_verb (revision 23) +++ obj/abstract/avatar/quit_verb (working copy) @@ -6,7 +6,8 @@ %_=@_; if ($_{avatar} != $this) { - fail "No!"; + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } exit Mooix::Verb::EXIT; Index: obj/abstract/avatar/put_fail_give.msg =================================================================== --- obj/abstract/avatar/put_fail_give.msg (revision 0) +++ obj/abstract/avatar/put_fail_give.msg (revision 0) @@ -0,0 +1 @@ +session: Perhaps you should hand the object to $this->gender_object_pronoun instead. Index: obj/abstract/avatar/notice.c =================================================================== --- obj/abstract/avatar/notice.c (revision 23) +++ obj/abstract/avatar/notice.c (working copy) @@ -1,53 +1,75 @@ #include #include #include +#include +#include +#include +#include +#include +#include int main (int argc, char **argv) { - FILE *list; - char *key, *val; - char *listfile; - char *params[2]; - object *session, *onlyto_session = NULL; - - methinit(); + FILE *list; + char *key, *val; + char *listfile; + char *params[2]; + object *session, *onlyto_session = NULL; + //FILE *log; + object *this; - /* This argument processing is not exactly robust, but - * maybe it's a little bit faster this way? */ - while ((key = mooix_getline(stdin, 1)) && - (val = mooix_getline(stdin, 0))) { - if (strcmp(key, "session") == 0) { - onlyto_session=derefobj(val); + methinit(); + + this = getobj(getenv("THIS")); /* needs to be an abs path */ + + //fprintf( stderr, "Notice Started.\n" ); + + /* This argument processing is not exactly robust, but + * maybe it's a little bit faster this way? */ + while ((key = mooix_getline(stdin, 1)) && + (val = mooix_getline(stdin, 0))) { + if (strcmp(key, "session") == 0) { + onlyto_session=derefobj(val); + } else if (strcmp(key, "message") == 0) { + //fprintf( stderr, "notice val pre2: %s.\n", val ); + + // This is just to send an error message + dexml( "notice", this, "" ); + + val = strdup( dexml( val, this, "" ) ); + + //fprintf( stderr, "notice val post: %s.\n", val ); + //chmod( "/tmp/notice.log", S_IROTH|S_IWOTH|S_IXOTH); + //printf( "Final val; %s.\n", val ); + + params[0] = val; /* raw, already escaped value */ + params[1] = NULL; + + if (! onlyto_session) { + listfile = fieldfile(getobj("sessions"), "list"); + if (listfile && (list = fopen(listfile, "r"))) { + while ((session = derefobj(fgetvalue(list)))) { + /* The only reason to get + * the values is that that + * makes this method pause + * until the write method + * exits. Thus, it doesn't + * fork off a ton of them + * if there are meny + * sessions, which might + * cause more contention. + * This also makes it more + * predictable when + * benchmarking. */ + fgetallvals(runmethod(session, "write", params)); + } } - else if (strcmp(key, "message") == 0) { - params[0] = val; /* raw, already escaped value */ - params[1] = NULL; - - if (! onlyto_session) { - listfile = fieldfile(getobj("sessions"), "list"); - if (listfile && (list = fopen(listfile, "r"))) { - while ((session = derefobj(fgetvalue(list)))) { - /* The only reason to get - * the values is that that - * makes this method pause - * until the write method - * exits. Thus, it doesn't - * fork off a ton of them - * if there are meny - * sessions, which might - * cause more contention. - * This also makes it more - * predictable when - * benchmarking. */ - fgetallvals(runmethod(session, "write", params)); - } - } - } - else { - fgetallvals(runmethod(onlyto_session, "write", params)); - } - - exit(0); - } + } + else { + fgetallvals(runmethod(onlyto_session, "write", params)); + } + + exit(0); } - exit(0); + } + exit(0); } Index: obj/abstract/avatar/password_bad_user.msg =================================================================== --- obj/abstract/avatar/password_bad_user.msg (revision 0) +++ obj/abstract/avatar/password_bad_user.msg (revision 0) @@ -0,0 +1 @@ +session: Unix user $user is not a moo-only user, so not changing the password. Index: obj/abstract/avatar/yell.cmd =================================================================== --- obj/abstract/avatar/yell.cmd (revision 23) +++ obj/abstract/avatar/yell.cmd (working copy) @@ -1,2 +1,2 @@ verb(this), quote : yell -verb(this), quote, direct_object(single) : yell +verb(this), quote, do_preposition(at|to), direct_object(single) : yell Index: obj/abstract/avatar/movement.hlp =================================================================== --- obj/abstract/avatar/movement.hlp (revision 23) +++ obj/abstract/avatar/movement.hlp (working copy) @@ -1,30 +0,0 @@ -Movement and exploration. - -You can move from place to place in the moo by telling it where you want -to go. If in doubt, try the compass points. Hints about places you can go -may be included in the descriptions of some places. - - A trackless desert stretches as far as you can see. - A spiny cactus is here. - > go north - Desert all around, with some rolling dunes to the south. - > go dunes - You walk for half an hour.. - You stand atop a sand dune in the midst of a desert. Far off in the - distance, is that a smudge of green? - > go oasis - You trudge up and down dunes for an hour, but lose sights of the oasis, if - it was ever there. - -To avoid typing "go" all the time, you can abbreviate and just type where -you want to go. Compass points can generally be abbreviated to n, s, e, -and w. Thus, both of these commands mean the same thing: - - > go north - You stumble northward through the desert. - > n - Northward, ever northward you go. - -Other ways to move around include using the =home= command, and -=teleport= (for builders). The "exits" command can help you find -exits. Index: obj/abstract/avatar/safechange_fail_not_safe.msg =================================================================== --- obj/abstract/avatar/safechange_fail_not_safe.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_not_safe.msg (revision 0) @@ -0,0 +1 @@ +session: You cannot change that field. Index: obj/abstract/avatar/password.hlp =================================================================== --- obj/abstract/avatar/password.hlp (revision 23) +++ obj/abstract/avatar/password.hlp (working copy) @@ -1,10 +0,0 @@ -Changing your password. - -If you have a moo-only account (you cannot get a unix shell) you can use -the password command to change your login password. It will prompt for your -current password, and then a new one. Some passwords may be rejected if -they are too easy to guess. - -If you are accessing the moo from within a normal unix account, you cannot -change your password in the moo; use the unix 'passwd' command from outside -the moo. Index: obj/abstract/avatar/logging.cmd =================================================================== --- obj/abstract/avatar/logging.cmd (revision 23) +++ obj/abstract/avatar/logging.cmd (working copy) @@ -1 +1,2 @@ -verb(this), preposition(on|off) +verb(this), preposition(on) : logging_on +verb(this), preposition(off) : logging_off Index: obj/abstract/avatar/logout.msg =================================================================== --- obj/abstract/avatar/logout.msg (revision 0) +++ obj/abstract/avatar/logout.msg (revision 0) @@ -0,0 +1 @@ +session: Logging out. Index: obj/abstract/avatar/personalization.hlp =================================================================== --- obj/abstract/avatar/personalization.hlp (revision 23) +++ obj/abstract/avatar/personalization.hlp (working copy) @@ -1,52 +0,0 @@ -Personalizing your moo account. - -Once you have an account on the moo, you can log in and then personalize -it in various ways. That's why a user account is nicer to have than a -guest account. - -First, you can change your password with the =password= command. Pick a -good one! - -The second thing you will probably want to do is tell the moo what your -name is. There are a variety of ways to do this, just use whatever feels -natural. The quotes are required though. - - > my name is "Bob" - > call me "Ishmael" - > rename me to "Fred" - -Next you should tell it what your gender is (new users default to a neutral -gender). - - > my gender is "male" - > my gender is "female" - -Then you should describe yourself. This is what people will see when they -look at you. Again there are several ways to do it, and again the quotes -are mandatory. - - > describe me as "Five foot two, eyes of blue." - > my description is "Just some guy, you know?" - -If your description is long or you want to edit it later, you might be -able to use the =edit= command to bring it up in a multi-line text editor: - - > edit my description - -You might also find it useful to set one or more aliases for your name. -These can be shorter or longer forms that people might prefer to call you -by, or that are easier to type, or nicknames, etc. You can set the first -alias like this: - - > my alias is "Mr. Ed" - -Additional aliases can be set by telling it a number to go with the -alias: - - > my second alias is "horse" - > my third alias is "Ed" - -You can even customise the prompt displayed by every command: - - > my prompt is "What is your wish? " - What is your wish? Index: obj/abstract/avatar/unset_verb =================================================================== --- obj/abstract/avatar/unset_verb (revision 23) +++ obj/abstract/avatar/unset_verb (working copy) @@ -3,10 +3,12 @@ run sub { my $this=shift; %_=@_; + my $avatar = $_{avatar}; # Make sure that this command is not spoofed, just in case. - if ($_{avatar} != $this) { - fail "No!"; + if ($_{avatar} != $this) { + $_{avatar}->msg( "spoofing_bad", %_ ); + fail(); } my $object=$_{direct_object} or $this->usage("bad direct object"); @@ -36,10 +38,12 @@ ); - if (! $stat) { - fail $msg; + # $stat should *only* be 0 or 1; anything else is an error + if( $stat == 0 || $stat != 1 ) { + $avatar->msg( $msg, %_ ); + fail(); } else { - $_{session}->write("Unset."); + $this->msg( 'unset', %_ ); } } Index: obj/abstract/avatar/safechange_fail_change_method_mode.msg =================================================================== --- obj/abstract/avatar/safechange_fail_change_method_mode.msg (revision 0) +++ obj/abstract/avatar/safechange_fail_change_method_mode.msg (revision 0) @@ -0,0 +1 @@ +session: Cannot change the mode of a method. Index: obj/abstract/animate/look_nothing.msg =================================================================== --- obj/abstract/animate/look_nothing.msg (revision 0) +++ obj/abstract/animate/look_nothing.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: $this->description +session: You cannot see $this. Index: obj/abstract/animate/look_verb =================================================================== --- obj/abstract/animate/look_verb (revision 23) +++ obj/abstract/animate/look_verb (working copy) @@ -1,77 +1,82 @@ #!/usr/bin/perl #use Mooix::Thing; run sub { - my $this=shift; - %_=@_; - my $avatar=$_{avatar}; - - # Separate contents into what is worn and what is held. - my @holding, @wearing; - my @contents=grep { ! $_->hidden } $this->contents->list; - foreach (@contents) { - if ($_->worn) { - push @wearing, $_; - } - else { - push @holding, $_; - # The contents of some containers are visible - # to just plain look. - my @visi = $_->visiblecontents; - if (@visi) { - push @holding, @visi; - } - } - } - - $_{contents}=$avatar->prettylist(grep { $_ != $avatar} @holding); - # The reason I do it this way is so if the avatar has a description - # that says they are wearing something, this doesn't contradict it - # with a "wearing nothing". - if (@wearing) { - $_{contents} .= " and wearing ".$avatar->prettylist(@wearing); - } - $this->msg('look', %_); - # If the object is injured, display an appropriate message. - my $hp = $this->hitpoints; - my $max = $this->maxhitpoints; - if ($hp < $max) { - $this->hp_regen; - $hp = $this->hitpoints; - # Still injured? - if ($hp < $max) { - my $injured; + my $this=shift; + %_=@_; + my $avatar=$_{avatar}; - my $min=$this->minhitpoints; - if ($hp <= $min) { - $injured = "dead"; - } - elsif ($hp <= ($min / 2) - 1) { - $injured = "unconscious and near death"; - } - elsif ($hp <= 0) { - $injured = "unconscious"; - } - elsif (($max - $hp) >= ($max / 1.5)) { - $injured = "quite badly hurt"; - } - elsif (($max - $hp) >= ($max / 2)) { - $injured = "badly hurt"; - } - elsif (($max - $hp) >= ($max / 3)) { - $injured = "hurt"; - } - elsif (($max - $hp) >= ($max / 4)) { - $injured = "beat up"; - } - elsif (($max - $hp) >= ($max / 5)) { - $injured = "bruised"; - } - else { - $injured = "scratched"; - } - - $this->msg('injured', %_, injured => $injured); - } - } - $this->msg('sleeping', %_) if $this->sleeping && $hp > 0; -} + # Separate contents into what is worn and what is held. + my @holding, @wearing; + my @contents=grep { ! $_->hidden } $this->contents->list; + foreach (@contents) { + if ($_->worn) { + push @wearing, $_; + } + else { + push @holding, $_; + # The contents of some containers are visible + # to just plain look. + my @visi = $_->visiblecontents; + if (@visi) { + push @holding, @visi; + } + } + } + + $_{contents}=$avatar->prettylist($avatar, grep { $_ != $avatar} @holding); + + if( @wearing ) { + $_{wearing} = $avatar->prettylist($avatar, @wearing); + if( @holding ) { + $this->msg('look_wearing', %_); + } else { + $this->msg('look_wearing_not_holding', %_); + } + } else { + if( @holding ) { + $this->msg('look', %_); + } else { + $this->msg('look_nothing', %_); + } + } + + # If the object is injured, display an appropriate message. + my $hp = $this->hitpoints; + my $max = $this->maxhitpoints; + if ($hp < $max) { + $this->hp_regen; + $hp = $this->hitpoints; + # Still injured? + if ($hp < $max) { + my $min=$this->minhitpoints; + if ($hp <= $min) { + $this->msg('look_injured_dead', %_); + } + elsif ($hp <= ($min / 2) - 1) { + $this->msg('look_injured_near_death', %_); + } + elsif ($hp <= 0) { + $this->msg('look_injured_unconscious', %_); + } + elsif (($max - $hp) >= ($max / 1.5)) { + $this->msg('look_injured_quite_badly_hurt', %_); + } + elsif (($max - $hp) >= ($max / 2)) { + $this->msg('look_injured_badly_hurt', %_); + } + elsif (($max - $hp) >= ($max / 3)) { + $this->msg('look_injured_hurt', %_); + } + elsif (($max - $hp) >= ($max / 4)) { + $this->msg('look_injured_beat_up', %_); + } + elsif (($max - $hp) >= ($max / 5)) { + $this->msg('look_injured_bruised', %_); + } + else { + $this->msg('look_injured_scratched', %_); + } + } + } + $this->msg('sleeping', %_) if $this->sleeping && $hp > 0; +} \ No newline at end of file Index: obj/abstract/animate/look_injured_near_death.msg =================================================================== --- obj/abstract/animate/look_injured_near_death.msg (revision 0) +++ obj/abstract/animate/look_injured_near_death.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) unconscious and near death. \ No newline at end of file Index: obj/abstract/animate/injured.msg =================================================================== --- obj/abstract/animate/injured.msg (revision 23) +++ obj/abstract/animate/injured.msg (working copy) @@ -1 +0,0 @@ -$avatar: $this->gender_subject_pronoun $this->verb(is,are) $injured. Index: obj/abstract/animate/look_injured_bruised.msg =================================================================== --- obj/abstract/animate/look_injured_bruised.msg (revision 0) +++ obj/abstract/animate/look_injured_bruised.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) bruised. \ No newline at end of file Index: obj/abstract/animate/look_injured_dead.msg =================================================================== --- obj/abstract/animate/look_injured_dead.msg (revision 0) +++ obj/abstract/animate/look_injured_dead.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) dead. \ No newline at end of file Index: obj/abstract/animate/look_injured_scratched.msg =================================================================== --- obj/abstract/animate/look_injured_scratched.msg (revision 0) +++ obj/abstract/animate/look_injured_scratched.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) scratched. \ No newline at end of file Index: obj/abstract/animate/look_injured_quite_badly_hurt.msg =================================================================== --- obj/abstract/animate/look_injured_quite_badly_hurt.msg (revision 0) +++ obj/abstract/animate/look_injured_quite_badly_hurt.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) quite badly hurt. \ No newline at end of file Index: obj/abstract/animate/look_injured_unconscious.msg =================================================================== --- obj/abstract/animate/look_injured_unconscious.msg (revision 0) +++ obj/abstract/animate/look_injured_unconscious.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) unconscious. \ No newline at end of file Index: obj/abstract/animate/look_injured_hurt.msg =================================================================== --- obj/abstract/animate/look_injured_hurt.msg (revision 0) +++ obj/abstract/animate/look_injured_hurt.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) hurt. \ No newline at end of file Index: obj/abstract/animate/look_injured_badly_hurt.msg =================================================================== --- obj/abstract/animate/look_injured_badly_hurt.msg (revision 0) +++ obj/abstract/animate/look_injured_badly_hurt.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) badly hurt. \ No newline at end of file Index: obj/abstract/animate/look_wearing_not_holding.msg =================================================================== --- obj/abstract/animate/look_wearing_not_holding.msg (revision 0) +++ obj/abstract/animate/look_wearing_not_holding.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: $this->description\n$this->gender_subject_pronoun $this->verb(is,are) wearing $wearing. +session: You cannot see $this. Index: obj/abstract/animate/look_wearing.msg =================================================================== --- obj/abstract/animate/look_wearing.msg (revision 0) +++ obj/abstract/animate/look_wearing.msg (revision 0) @@ -0,0 +1,2 @@ +see,session: $this->description\n$this->gender_subject_pronoun $this->verb(is,are) holding $contents and wearing $wearing. +session: You cannot see $this. Index: obj/abstract/animate/look_injured_beat_up.msg =================================================================== --- obj/abstract/animate/look_injured_beat_up.msg (revision 0) +++ obj/abstract/animate/look_injured_beat_up.msg (revision 0) @@ -0,0 +1 @@ +$avatar: $this->gender_subject_pronoun $this->verb(is,are) beat up. \ No newline at end of file Index: obj/sessions/tty/edit =================================================================== --- obj/sessions/tty/edit (revision 23) +++ obj/sessions/tty/edit (working copy) @@ -60,7 +60,7 @@ open(STDOUT, '>&OLDOUT'); if ($ret != 0) { - $this->write("Your editor is misconfigured."); + $this->msg( 'edit_bad_editor', %_ ); return; } @@ -73,5 +73,6 @@ unlink $tmpfile; return $this->avatar->edit_finish(session => $this, id => $_{id}, - value => $contents); + value => $contents, + avatar => $this->avatar); } Index: obj/sessions/tty/edit_bad_editor.msg =================================================================== --- obj/sessions/tty/edit_bad_editor.msg (revision 0) +++ obj/sessions/tty/edit_bad_editor.msg (revision 0) @@ -0,0 +1 @@ +session: Your editor is misconfigured. Index: obj/sessions/tty/write.c =================================================================== --- obj/sessions/tty/write.c (revision 23) +++ obj/sessions/tty/write.c (working copy) @@ -16,7 +16,7 @@ /* Remove xml tags from the text. is supported; marked up * in bold, all else are ignored. Also handle entities. */ -char *dexml (char *text) { +char *write_dexml (char *text) { char *ret, *s, *e, *a = NULL; int senderunterm=0; int len = strlen(text); @@ -41,11 +41,16 @@ else { e[0] = '\0'; if (strcmp(a, "lt") == 0) - strcat(ret, "<"); - else if (strcmp(a, "gt") == 0) - strcat(ret, ">"); - else if (strcmp(a, "amp") == 0) - strcat(ret, "&"); + { + strcat(ret, "<"); + } else if (strcmp(a, "gt") == 0) { + strcat(ret, ">"); + } else { + strcat(ret, "&"); + strcat(ret, a); + strcat(ret, ";"); + } + text=e+1; } @@ -92,7 +97,7 @@ FILE *f = fdopen(fd, "w"); for (c = 0; lines[c] != NULL; c++) { - line = dexml(safen(lines[c])); + line = write_dexml(safen(lines[c])); /* The string might consist of multiple lines. So split it * at newlines and work on each piece. */ Index: obj/sessions/log/write.c =================================================================== --- obj/sessions/log/write.c (revision 23) +++ obj/sessions/log/write.c (working copy) @@ -11,7 +11,7 @@ #include /* Remove xml tags from the text. Also handle entities. */ -char *dexml (char *text) { +char *write_dexml (char *text) { char *ret, *s, *e, *a = NULL; int len = strlen(text); @@ -35,11 +35,15 @@ else { e[0] = '\0'; if (strcmp(a, "lt") == 0) - strcat(ret, "<"); - else if (strcmp(a, "gt") == 0) - strcat(ret, ">"); - else if (strcmp(a, "amp") == 0) - strcat(ret, "&"); + { + strcat(ret, "<"); + } else if (strcmp(a, "gt") == 0) { + strcat(ret, ">"); + } else { + strcat(ret, "&"); + strcat(ret, a); + strcat(ret, ";"); + } text=e+1; } @@ -98,7 +102,7 @@ newline++; } fprintf(log, "%li.%06li %s\n", - t.tv_sec, (long int) t.tv_usec, dexml(line)); + t.tv_sec, (long int) t.tv_usec, write_dexml(line)); line = newline; } while (line); } Index: obj/sessions/socket/edit_bad_mcp.msg =================================================================== --- obj/sessions/socket/edit_bad_mcp.msg (revision 0) +++ obj/sessions/socket/edit_bad_mcp.msg (revision 0) @@ -0,0 +1 @@ +session: Your client supports MCP, but does not support the dns-org-mud-moo-simpleedit package, so you cannot edit files. Index: obj/sessions/socket/edit =================================================================== --- obj/sessions/socket/edit (revision 23) +++ obj/sessions/socket/edit (working copy) @@ -5,11 +5,11 @@ %_=@_; if (! $this->mcpsession_enabled) { - $this->write("Your client does not support MCP, so you cannot edit files."); + $this->msg( 'edit_no_mcp', %_ ); return; } elsif (! $this->simpleedit_enabled) { - $this->write("Your client supports MCP, but does not support the dns-org-mud-moo-simpleedit package, so you cannot edit files."); + $this->msg( 'edit_bad_mcp', %_ ); return; } Index: obj/sessions/socket/edit_no_mcp.msg =================================================================== --- obj/sessions/socket/edit_no_mcp.msg (revision 0) +++ obj/sessions/socket/edit_no_mcp.msg (revision 0) @@ -0,0 +1 @@ +session: Your client does not support MCP, so you cannot edit files. Index: obj/sessions/socket/write.c =================================================================== --- obj/sessions/socket/write.c (revision 23) +++ obj/sessions/socket/write.c (working copy) @@ -17,7 +17,7 @@ /* Remove xml tags from the text. is supported; marked up * in bold, all else are ignored. Also handle entities. */ -char *dexml (char *text) { +char *write_dexml (char *text) { char *ret, *s, *e, *a = NULL; int senderunterm=0; int len = strlen(text); @@ -42,11 +42,15 @@ else { e[0] = '\0'; if (strcmp(a, "lt") == 0) - strcat(ret, "<"); - else if (strcmp(a, "gt") == 0) - strcat(ret, ">"); - else if (strcmp(a, "amp") == 0) - strcat(ret, "&"); + { + strcat(ret, "<"); + } else if (strcmp(a, "gt") == 0) { + strcat(ret, ">"); + } else { + strcat(ret, "&"); + strcat(ret, a); + strcat(ret, ";"); + } text=e+1; } @@ -97,7 +101,7 @@ f = setupsocket(); fprintf(f, "o\n"); for (i = 0; lines[i] != NULL; i++) { - fprintf(f, "%s\n", dexml(uncurly(lines[i]))); + fprintf(f, "%s\n", write_dexml(uncurly(lines[i]))); } fflush(f); exit(0); Index: obj/sessions/base/edit =================================================================== --- obj/sessions/base/edit (revision 23) +++ obj/sessions/base/edit (working copy) @@ -3,6 +3,6 @@ run sub { my $this=shift; %_=@_; - $this->write("This session does not support interactive editing."); + $this->msg( 'edit_fail', %_ ); return } Index: obj/sessions/base/edit_fail.msg =================================================================== --- obj/sessions/base/edit_fail.msg (revision 0) +++ obj/sessions/base/edit_fail.msg (revision 0) @@ -0,0 +1 @@ +session: This session does not support interactive editing. Index: obj/Makefile =================================================================== --- obj/Makefile (revision 23) +++ obj/Makefile (working copy) @@ -8,7 +8,9 @@ SUBDIRS=$(shell find . -name Makefile -mindepth 2 -exec dirname {} \;) -include ../makeinfo +-include ../mooix.conf .PHONY: ../makeinfo +.PHONY: ../mooix.conf build: links # Set perms to non-group-writable by default. @@ -54,17 +56,19 @@ realclean: install: - $(INSTALL) -d $(PREFIX)/$(libdir) $(PREFIX)/$(localstatedir)/lib + echo "mooadmin: $(MOOADMIN)" + $(INSTALL) -o $(MOOADMIN) -d $(PREFIX)/$(libdir) $(PREFIX)/$(localstatedir)/lib # cp can get confused about hard links on reinstalls, # so remove the whole old tree first rm -rf $(PREFIX)/$(libdir)/mooix mkdir $(PREFIX)/$(libdir)/mooix - tar cf - . --exclude t -X Excludes | \ - (cd $(PREFIX)/$(libdir)/mooix; tar xpf -) + tar --exclude t -X Excludes -cf - . | \ + (cd $(PREFIX)/$(libdir)/mooix; tar -xpf -) + if [ `id -u` -eq 0 ] ; then chown -R $(MOOADMIN) $(PREFIX)/$(libdir)/mooix ; fi PERL5LIB=../bindings/perl/ \ sh -ex ../utils/splittree $(PREFIX)/$(libdir)/mooix \ $(PREFIX)/$(localstatedir)/lib/mooix \ - $(libdir)/mooix $(localstatedir)/lib/mooix 2>tmp-log || \ + $(libdir)/mooix $(localstatedir)/lib/mooix $(MOOADMIN) 2>tmp-log || \ ( echo splittree failed; cat tmp-log; false ) >&2 uninstall: