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/