Index: class.c ================================================================== --- class.c +++ class.c @@ -1183,10 +1183,13 @@ if(Tokenf(TF_EQUAL)) ParseError("Improper token in pattern\n"); cl->codes[ptr++]=x; break; default: ParseError("Improper token in pattern\n"); } + } else if(Tokenf(TF_FUNCTION)) { + cl->codes[ptr++]=OP_FUNCTION; + cl->codes[ptr++]=tokenv&0x3FFF; } else if(tokent==TF_OPEN) { nxttok(); if(Tokenf(TF_MACRO) || !Tokenf(TF_NAME)) ParseError("Improper token in pattern\n"); switch(tokenv) { case OP_HEIGHT: case OP_CLIMB: Index: class.doc ================================================================== --- class.doc +++ class.doc @@ -2347,10 +2347,18 @@ Move in the specified direction. (This does not move any objects; it only moves the cursor for pattern matching.) The direction can be relative to the current direction (initially the Dir variable of the origin object) or absolute. + + Call a user-defined function, which should be ( obj dir -- result ), + and Self is the position from which the current matching started. + The obj is the currently matched object (which may be zero), and the + dir is the current direction. If the result is a number, then it sets + the direction; if a object, sets the current object and the current + location at that object's location; if a mark, the match fails. + Send the message to all objects at the current location. From is the position from which pattern matching started. Arg1 is the direction. Arg2 is the currently matched object (which may be zero). If the return value is zero, it continues normally; if one, the match fails; Index: exec.c ================================================================== --- exec.c +++ exec.c @@ -67,10 +67,11 @@ // For arrival/departure masks #define Xbit(a) ((a)%5-2) #define Ybit(a) (2-(a)/5) +static void execute_program(Uint16*code,int ptr,Uint32 obj); static Value send_message(Uint32 from,Uint32 to,Uint16 msg,Value arg1,Value arg2,Value arg3); static Uint32 broadcast(Uint32 from,int c,Uint16 msg,Value arg1,Value arg2,Value arg3,Uint8 s); static Value destroy(Uint32 from,Uint32 to,Uint32 why); static const Sint8 x_delta[8]={1,1,0,-1,-1,-1,0,1}; @@ -1856,10 +1857,29 @@ objects[n]->dir=d; break; case OP_ELSE: ptr--; while(code[ptr]==OP_ELSE) ptr=code[ptr+2]; + break; + case OP_FUNCTION: + StackReq(0,2); + Push(OVALUE(n)); + Push(NVALUE(d)); + execute_program(classes[0]->codes,functions[code[ptr++]],obj); + StackReq(1,0); + v=Pop(); + if(v.t==TY_NUMBER) { + d=v.u&7; + } else if(v.t==TY_MARK) { + goto fail; + } else if(v.t>TY_MAXTYPE) { + n=v_object(v); + x=objects[n]->x; + y=objects[n]->y; + } else { + Throw("Type mismatch"); + } break; case OP_HEIGHT: if(playfield[x+y*64-65]==VOIDLINK || height_at(x,y)<=objects[obj]->climb) goto fail; break; case OP_HEIGHT_C: