#include <stdio.h>
#include <signal.h>
#include <ctype.h>
#include "squid.h"
#include "thread.h"
#include <X11/Xatom.h>
#include <sys/types.h>
#include <sys/time.h>
/* #define DEBUG*/

Squid the_program;
extern FILE *yyin;
Display *dpy;
int screen;
Window root_win;
unsigned long foreground, background;
int depth;
Object dirty_list = NULL;
Object objects = NULL;
int abort_flag = False;

long eval_internal();
Thread thread_create();
void bind_formals ();
void thread_wait ();
Window *default_window;
long *tick_speed;
int now = 0;				/* Current tick number */
Object mouse;
char **bitmap_path;




void delay(msec)
     int msec;
{
  struct timeval timeout;
  timeout.tv_sec =  msec / 1000;
  timeout.tv_usec = (msec % 1000) * 1000;
  select (0,0,0,0,&timeout);
}


void fatal_error (thread, ctrl_string, va_alist) va_dcl
     Thread thread;
     char *ctrl_string;
{
  va_list list;
  
  fprintf (stderr, "Fatal error: ");
  va_begin(list, ctrl_string);
  _doprnt (ctrl_string, list, stderr);
  va_end(list);
  fprintf (stderr, "\n");
  fprintf (stderr, "(interpreting near line %d)\n",
	   thread->statement->lineno);
  exit(1);
}


Bitmap read_bitmap_data_from_file(f)	/* If "f" is null, returns the default bitmap */
     FILE *f;
{
  static Bitmap default_bitmap = NULL;
  char buf[4096], *c;
  int n;
  int ch, ch2;
  Bitmap newb;
# include "default_bitmap.xbm"
  
  if (!default_bitmap) {
    default_bitmap = (Bitmap) malloc(sizeof(struct bitmap));
    default_bitmap->width = default_bitmap_width;
    default_bitmap->height = default_bitmap_height;
    default_bitmap->x_hot = default_bitmap_x_hot;
    default_bitmap->y_hot = default_bitmap_y_hot;
    default_bitmap->bits = default_bitmap_bits;
    default_bitmap->pixmap = NULL;
  }
  if (!f) 
    return default_bitmap;
  newb = (Bitmap) malloc(sizeof(struct bitmap));
  bzero (newb, sizeof(struct bitmap));
  while (fgets(buf, sizeof(buf), f) &&
	 strncmp(buf, "static", 6)) {
    c = (char *) index(buf, 0);
    while (c > buf && !isdigit(*c)) c--;
    while (isdigit(*--c) || *c=='-');
    n = atoi(c+1);
    if (!strncmp(c - 5, "width", 5))
      newb->width = n;
    else if (!strncmp(c - 6, "height", 6))
      newb->height = n;
    else if (!strncmp(c - 5, "x_hot", 5))
      newb->x_hot = n;
    else if (!strncmp(c - 5, "y_hot", 5))
      newb->y_hot = n;
    else 
      fprintf (stderr, "syntax error in bitmap: %s", buf);
  }
  n = 0;
  while ((ch = fgetc(f)) != EOF && ch != ';')
    if (ch == 'x') {
      ch = fgetc(f);
      ch = (ch > '9' ? ch - 'a' + 10 : ch - '0');
      ch2 = fgetc(f);
      ch2 = (ch2 > '9' ? ch2 - 'a' + 10 : ch2 - '0');
      buf[n++] = (ch << 4) + ch2;
    }  
  newb->bits = (char *) malloc(n);
  bcopy (buf, newb->bits, n);
  return newb;
}


Bitmap read_bitmap_data_from_filename (name)
     char *name;
{
  FILE *f;
  char *c, *nc;
  Bitmap b;
  char namebuf[1024];
  
  f = fopen(name, "r");
  if (!f) {
    for (c = *bitmap_path; *c; ) {
      nc = namebuf;
      while (*c && *c != ':')
	*nc++ = *c++;
      if (*c) c++;
      *nc++ = '/';
      strcpy (nc, name);
      if (f = fopen(namebuf, "r"))
	break;
    }
    if (!f) {
      perror(name);
      return read_bitmap_data_from_file(NULL);
    }
  }
  b = read_bitmap_data_from_file(f);
  fclose(f);
  return b;
}



Binding add_binding (thread, name, type, value)
     Thread thread;
     char *name;
     enum b_type type;
     long value;
{
  Binding b;
  for (b = thread->bindings; b; b = b->next)
    if (!strcmp(name, b->name))
      break;
  if (!b) {
    b = (Binding) malloc(sizeof(struct binding));
    b->next = thread->bindings;
    thread->bindings = b;
  }
  b->type = type;
  b->name = name;
  b->value = value;
  return b;
}


Binding lookup_binding (thread, name)
     Thread thread;
     char *name;
{
  Binding b;
  
  for (; thread; thread = thread->parent)
    for (b = thread->bindings; b; b = b->next) 
      if (!strcmp(name, b->name)) 
	return b;
  return NULL;
}


void destroy_bindings (bindings)
     Binding bindings;
{
  Binding next;
  
  for (; bindings; bindings = next) {
    next = bindings->next;
    if (bindings->type == b_zombie)
      free(bindings->value);
    free(bindings);
  }
}
  
Arglist build_arglist (thread, actuals)
     Thread thread;
     Squid actuals;		   
{
  Squid list;
  Arglist args;
  int n = 0;

  args = (Arglist) malloc(sizeof(struct arglist));
  args->nargs = 0;
  if (!actuals)	
    return args;
  for (list = actuals->arg1; list; list = list->next) {
    args->values[args->nargs] = eval_internal (thread, list, &args->types[args->nargs]);
    args->nargs++;
  }
  return args;
}

void object_locate (obj)
     Object obj;
{
  Window root_ret, child_ret;
  int win_x, win_y;
  unsigned int mask;
  XWindowAttributes war;

  if (!obj->loc_known) {
    switch (obj->type) {
    case o_mouse:
      XQueryPointer(dpy, root_win, &root_ret, &child_ret,
		    &obj->x, &obj->y, &win_x, &win_y, &mask);
      obj->width = 8;
      obj->height = 8;
      break;
    case o_window:
      XGetWindowAttributes (dpy, obj->win, &war);
      obj->x = war.x;
      obj->y = war.y;
      obj->width = war.width;
      obj->height = war.height;
      break;
    }	
    obj->loc_known = 1;
    obj->newx = obj->x;
    obj->newy = obj->y;
    obj->newwidth = obj->width;
    obj->newheight = obj->height;
  }
}


Object object_create (thread, type)
     Thread thread;
     enum o_type type;
{
  static int oid = 0;
  Object obj = (Object) malloc(sizeof(struct object));

  obj->type = type;
  obj->x = 0;
  obj->y = 0;
  obj->width = 0;
  obj->height = 0;
  obj->bitmap = NULL;
  obj->newx = 0;
  obj->newy = 0;
  obj->newwidth = 0;
  obj->newheight = 0;
  obj->newbitmap = NULL;
  obj->dirty = 0;
  obj->loc_known = (type == o_bitmap);
  obj->oid = ++oid;
  if (type == o_bitmap) {
    obj->win = *default_window;
    obj->newwin = obj->win;
  } else {
    obj->win = NULL;
    obj->newwin = NULL;
  }
  obj->refcnt = 0;
  obj->gc = NULL;
  obj->prev = NULL;
  obj->next = objects;
  if (objects) objects->prev = obj;
  objects = obj;
  return obj;
}	

void object_draw (obj)
     Object obj;
{
  Bitmap b = obj->bitmap;
  XGCValues xgcv;
  
  if (!b) return;
  if (!b->pixmap)
    b->pixmap = XCreatePixmapFromBitmapData (dpy, obj->win, b->bits, b->width, b->height, 
					     foreground, background, depth);
  if (!obj->gc) {
    xgcv.foreground = foreground;
    xgcv.background = background;
    xgcv.function = GXcopy;
    obj->gc = XCreateGC (dpy, obj->win, GCForeground | GCBackground | GCFunction, &xgcv);
  }
  XCopyArea (dpy, b->pixmap, obj->win, obj->gc, 0, 0, b->width, b->height, obj->x, obj->y);
}


void object_erase (obj)
     Object obj;
{
  Bitmap b = obj->bitmap;
  if (!b) return;
  XClearArea (dpy, obj->win, obj->x, obj->y,
	      b->width, b->height, False);
}

int object_collide (o1, o2)
     Object o1, o2;
{
  object_locate(o1);
  object_locate(o2);
  return (o1 != o2 &&
	  o1->newx < o2->newx + o2->newwidth &&
	  o2->newx < o1->newx + o1->newwidth &&
	  o1->newy < o2->newy + o2->newheight &&
	  o2->newy < o1->newy + o1->newheight);
}



void object_dirty (obj)			/* Put object in dirty list if not already there */
     Object obj;
{
  if (!obj->dirty) {
    obj->dirty = 1;
    obj->next_dirty = dirty_list;
    dirty_list = obj;
  }
}

void clean_objects ()
{
  Object o, next;
  
  for (o = dirty_list; o; o = o->next_dirty) 
    if (o->type == o_bitmap)
      object_erase(o);
  for (o = dirty_list; o; o = next) {
    next = o->next_dirty;
    o->dirty = 0;
    if (o->refcnt) {
      o->x = o->newx;
      o->y = o->newy;
      o->width = o->newwidth;
      o->height = o->newheight;
      o->bitmap = o->newbitmap;
      if (o->win != o->newwin) {
	if (o->gc) XFreeGC(dpy, o->gc);
	o->gc = NULL;
	o->win = o->newwin;
      }
      switch (o->type) {
      case o_bitmap: object_draw(o); break;
      case o_window: XMoveResizeWindow (dpy, o->win, o->x, o->y, o->width, o->height); break;
      case o_mouse: XWarpPointer (dpy, None, root_win, 0, 0, 0, 0, o->x, o->y); break;
      }
    } else {				/* No more references.  go poof! */
      if (o->prev)
	o->prev->next = o->next;
      else
	objects = o->next;
      if (o->next) o->next->prev = o->prev;
      free(o);
    }
  }
  dirty_list = NULL;
}


void object_move (obj, x, y)
     Object obj;
     int x, y;
{
  Bitmap b;
  
  if (obj->type == o_bitmap && (b = obj->newbitmap)) {
    x = x - b->x_hot;
    y = y - b->y_hot;
  }
  obj->newx = x;
  obj->newy = y;
  object_dirty(obj);
}


void object_show (obj, b)
     Object obj;
     Bitmap b;
{
  if (obj->newbitmap) {
    obj->newx = obj->newx + obj->newbitmap->x_hot - b->x_hot;
    obj->newy = obj->newy + obj->newbitmap->y_hot - b->y_hot;
  }
  obj->newbitmap = b;
  obj->newwidth = b->width;
  obj->newheight = b->height;
  object_dirty(obj);
}


void object_set_window (obj, win)
     Object obj;
     Window win;
{
  obj->newwin = win;
  object_dirty(obj);
}


long do_start_or_call (thread, squid, ret_type)
     Thread thread;
     Squid squid;		/* Start or call squid */
     enum b_type *ret_type;
{
  Arglist arglist;
  Binding b;
  Cfunc f;
  Squid seq;
  Thread newt;
  long ret_val;
  
  b = lookup_binding (thread, (char *) squid->arg1);
  arglist = build_arglist(thread, squid->arg2);
  switch (b->type) {
  case b_sequence:
    seq = (Squid) b->value;
    newt = thread_create(thread, seq->arg1);
    newt->sequence = seq;
    bind_formals (newt, seq->arg2, arglist);
    if (squid->type == sq_call)
      thread_wait(newt, squid);
    free(arglist);
    interpret(newt);
    *ret_type = b_thread;
    return (long) newt;
  case b_cfunc:
    f = (Cfunc) b->value;
    ret_val = (*f->func)(thread, arglist, ret_type);
    free(arglist);
    return ret_val;
  default:
    fatal_error (thread, "You can't call that!");
  }
}


long eval_internal (thread, exp, ret_type)
     Thread thread;
     Squid exp;
     enum b_type *ret_type;
{
  long val1, val2, ret_val = 0;
  enum b_type type1, type2;
  Binding b;
  
  switch (exp->type) {
  case sq_start:
  case sq_call:
    return (long) do_start_or_call(thread, exp, ret_type);
    
  case sq_sequence:
    *ret_type = b_sequence;
    ret_val = (long) exp;
    break;
    
  case sq_bitmap:
    if (!exp->arg2)
      exp->arg2 = (Squid) read_bitmap_data_from_filename(exp->arg1);
    *ret_type = b_bitmap;
    ret_val = (long) exp->arg2;
    break;
	
  case sq_int_const:
    *ret_type = b_integer;
    ret_val = (long) exp->arg1;
    break;

  case sq_str_const:
    *ret_type = b_string;
    ret_val = (long) exp->arg1;
    break;
      
  case sq_iden:
    b = lookup_binding (thread, (char *) exp->arg1);
    if (!b)
      fatal_error (thread, "unbound variable: %s", exp->arg1);
    *ret_type = b->type;
    ret_val = b->value;
    break;

  case sq_bind:
    ret_val = eval_internal (thread, exp->arg2, &type1);
    *ret_type = type1;
    add_binding (thread, (char *) exp->arg1, type1, ret_val);
    break;

  case sq_not:
    val1 = eval_internal (thread, exp->arg1, &type1);
    *ret_type = b_integer;
    ret_val = (val1 == 0);
    break;
    
  case sq_plus:
  case sq_minus:
  case sq_times:
  case sq_divby:
  case sq_eq:
  case sq_noteq:
  case sq_lt:
  case sq_gt:
  case sq_lteq:
  case sq_gteq:
  case sq_or:
  case sq_and:
    val1 = eval_internal(thread, exp->arg1, &type1);
    val2 = eval_internal(thread, exp->arg2, &type2);
    if (type1 != type2)
      fatal_error (thread, "type mismatch");
    *ret_type = type1;
    switch (exp->type) {
    case sq_plus:      ret_val = val1 + val2;                                break;
    case sq_minus:     ret_val = val1 - val2;                                break;
    case sq_times:     ret_val = val1 * val2;                                break;
    case sq_divby:     ret_val = val1 / val2;                                break;
    case sq_eq:        ret_val = (val1 == val2);   *ret_type = b_integer;    break;
    case sq_noteq:     ret_val = (val1 != val2);   *ret_type = b_integer;    break;
    case sq_lt:        ret_val = (val1 <  val2);   *ret_type = b_integer;    break;
    case sq_gt:        ret_val = (val1 >  val2);   *ret_type = b_integer;    break;
    case sq_lteq:      ret_val = (val1 <= val2);   *ret_type = b_integer;    break;
    case sq_gteq:      ret_val = (val1 >= val2);   *ret_type = b_integer;    break;
    case sq_or:        ret_val = (val1 || val2);   *ret_type = b_integer;    break;
    case sq_and:       ret_val = (val1 && val2);   *ret_type = b_integer;    break;
    default:
      abort();
    }
    break;
    
  default:
    abort();
  }
  return ret_val;
}
 
long eval (thread, exp, want_type)
     Thread thread;
     Squid exp;
     enum b_type want_type;
{
  long result;
  enum b_type ret_type;
  
  result = eval_internal (thread, exp, &ret_type);
  if (want_type != b_unknown &&
      want_type != ret_type)
    fatal_error (thread, "Type mismatch");
  return result;
}


void thread_set_object (thread, object)
     Thread thread;
     Object object;
{
  if (thread->object == object) return;
  if (thread->object)
    if (!(--thread->object->refcnt)) 
      object_dirty(thread->object);
  thread->object = object;
  if (object)
    ++thread->object->refcnt;
}

Thread thread_create (parent, squid)
     Thread parent;
     Squid squid;
{
  static int cur_tid = 0;
  Thread newt = (Thread) malloc(sizeof(struct thread));

  newt->sequence = NULL;
  newt->statement = squid;
  newt->bindings = NULL;
  newt->parent = parent;
  newt->children = NULL;
  newt->prev = NULL;
  newt->next = NULL;
  newt->stack_pointer = 0;
  newt->object = NULL;
  newt->ticks_left = 0;
  newt->parent_waiting = 0;
  newt->waiting = NULL;
  newt->tid = ++cur_tid;
  if (parent) {
    thread_set_object (newt, parent->object);
    newt->next = parent->children;
    if (parent->children)
      parent->children->prev = newt;
    parent->children = newt;
  }
#ifdef DEBUG
  if (parent)
    printf ("Thread %d creating child thread %d\n", parent->tid, newt->tid);
  else
    printf ("Creating main thread %d\n", newt->tid);
#endif
  return newt;
}

void thread_destroy (th)		/* destroys and unlinks thread from its sibling list */
     Thread th;				/* may also destroy its object */
{
  Thread t, next;
  Binding b;
  Zombie z;
  Squid wait;

#ifdef DEBUG
  printf ("Thread %d dying", th->tid);
  if (th->parent_waiting)
    printf (", unblocking parent %d", th->parent->tid);
  printf ("\n");
#endif
  if (th->parent_waiting) {		/* Is the parent blocking for this thread? */
    wait = th->parent->waiting;
    if (wait->type == sq_wait && wait->arg1)
      add_binding (th->parent, (char *) wait->arg1, th->ret_type, th->ret_val);
    th->parent->waiting = NULL;
  }
  if (th->next) th->next->prev = th->prev;
  if (th->prev) 
    th->prev->next = th->next;
  else
    if (th->parent)
      th->parent->children = th->next;
  thread_set_object (th, NULL);
  for (t = th->children; t; t = next) {
    next = t->next;
    thread_destroy(t);
  }
  if (th->parent)
    for (b = th->parent->bindings; b; b = b->next)
      if (b->type == b_thread && b->value == (long) th) {
      z = (Zombie) malloc(sizeof(struct zombie));
      z->ret_val = th->ret_val;
      z->ret_type = th->ret_type;
      b->type = b_zombie;
      b->value = (long) z;
    }
  destroy_bindings(th->bindings);
  free(th);
}


void thread_wait (child, squid)		/* Make parent of this thread wait for it */
     Thread child;
     Squid squid;
{
  if (!child->parent_waiting) {
    child->parent_waiting = 1;
    child->parent->waiting = squid;
  }
}

void bind_formals (thread, formals, arglist)
     Thread thread;
     Squid formals;
     Arglist arglist;
{
  Squid list;
  long *values = arglist->values;
  enum b_type *types = arglist->types;

  if (!formals) return;
  for (list = formals->arg1; list; list = list->next)
    add_binding (thread, (char *) list->arg1, *types++, *values++);
}


int interpret (thread)			/* Interpret a thread and its children (not its siblings...) */
     Thread thread;			/* Return 0 if the thread died. */
{
  Thread ch, next;
  Squid st;
  enum b_type rtype;
  long rval;
  int n;
  
  for (ch = thread->children; ch; ch = next) {
    next = ch->next;
    interpret (ch);
  }
  while (1) {
    if (thread->ticks_left) {		/* Are we spinning? */
      thread->ticks_left--;		/*   duhh.. guess so... */
      return 1;				/*   (or is it blocking?  I give up.) */
    }
    if (thread->waiting)		/* Are we blocking waiting for a child? */
      return 1;				/*   yip. */
    st = thread->statement;
    if (!st)				/* Oops, walked off end */
      if (thread->stack_pointer) {	/* anywhere to go from here? */
	thread->statement = thread->stack[--thread->stack_pointer];
      } else {
	thread_destroy(thread);		/* Nope... Exited off bottom */
	return 0;		
      }
    else {
      thread->statement = st->next;	/* By default, go down */
      switch (st->type) {

      case sq_statements:
	thread->stack[thread->stack_pointer++] = st->next;
	thread->statement = st->arg1;
	break;
	
      case sq_if:
	rval = eval(thread, st->arg1, b_unknown);
	thread->stack[thread->stack_pointer++] = st->next;
	thread->statement = rval ? st->arg2 : st->arg3;
	break;
	
      case sq_return:
	thread->ret_val = eval_internal (thread, st->arg1, &thread->ret_type);
	thread_destroy (thread);
	return 0;
	
      case sq_tick:
	return 1;
	
      case sq_ticks:
	n = (int) eval(thread, st->arg1, b_integer);
	if (n > 0) {
	  thread->ticks_left = n - 1;
	  return 1;
	}
	break;

      case sq_wait:
	rval = eval_internal(thread, st->arg2, &rtype);
	if (rtype != b_zombie)
	  if (rtype == b_thread) {
	    thread_wait ((Thread) rval, st);
	    return 1;
	  } else
	    fatal_error(thread, "wait: expecting thread");
	break;
	
      case sq_kill:
	rval = eval_internal(thread, st->arg1, &rtype);
	if (rtype != b_zombie)
	  if (rtype == b_thread)
	    thread_destroy ((Thread) rval);
	  else
	    fatal_error(thread, "kill: expecting thread");
	break;

      case sq_show:
	if (thread->object->type != o_bitmap)
	  fatal_error(thread, "show: object not a bitmap object");
	object_show (thread->object, (Bitmap) eval(thread, st->arg1, b_bitmap));
	break;
	
      case sq_while:
	if (eval(thread, st->arg1, b_unknown)) {
	  thread->stack[thread->stack_pointer++] = st;
	  thread->statement = st->arg2;
	}
	break;

      case sq_call:
	do_start_or_call(thread, st, &rtype);
	if (thread->waiting) return 1;
	break;
	
      default:
	eval (thread, st, b_unknown);
      }
    }
  } 
}


void squid_abort()
{
  static int abort_count = 0;
  
  if (++abort_count > 3) {
    fprintf(stderr, "squid: hung, giving up.\n");
    exit(1);
  }
  fprintf(stderr, "squid: aborting...\n");
  abort_flag = True;
}


long getarg (thread, arglist, num, type)
     Thread thread;
     Arglist arglist;
     int num;
     enum b_type type;
{
  if (arglist->nargs <= num)
    fatal_error (thread, "Not enough arguments");
  if (type != b_unknown && arglist->types[num] != type)
    fatal_error (thread, "Type mismatch");
  return arglist->values[num];
}
  


long SQ_move (thread, arglist, ret_type) /* move (delta_x, delta_y) */
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  object_locate(thread->object);
  object_move (thread->object,
	       thread->object->newx + getarg (thread, arglist, 0, b_integer),
	       thread->object->newy + getarg (thread, arglist, 1, b_integer));
  *ret_type = b_void;
  return 0;
}	


long SQ_moveto (thread, arglist, ret_type) /* moveto (x, y) */
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  object_move (thread->object,
	       getarg (thread, arglist, 0, b_integer),
	       getarg (thread, arglist, 1, b_integer));
  *ret_type = b_void;
  return 0;
}	

long SQ_on_screen (thread, arglist, ret_type) /* No arguments */
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object o;

  *ret_type = b_integer;
  o = thread->object;
  if (!o) return 1;
  return (o->newx + o->newwidth >= 0 && o->newx <= DisplayWidth (dpy, screen) &&
	  o->newy + o->newheight >= 0 && o->newy <= DisplayHeight (dpy, screen));
}    


long SQ_set_window (thread, arglist, ret_type) /* set_window(window) */
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object obj = thread->object;
  Window win = getarg(thread, arglist, 0, b_window);

  object_set_window (obj, win);
  *ret_type = b_void;
  return 0;
}


/*
 * collide can be used two ways.  collide(obj) returns 1
 * if the current object intersects obj.  collide()
 * returns an object that the current object collides with,
 * or NULL.  
 */

long SQ_collide (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object obj, myobj;

  myobj = thread->object;
  switch (arglist->nargs) {
  case 0:
    for (obj = objects; obj; obj = obj->next)
      if (object_collide(obj, myobj)) {
	*ret_type = b_object;
	return (long) obj;
      }
    *ret_type = b_integer;
    return 0;

  case 1:
    obj = (Object) getarg(thread, arglist, 0, b_object);
    *ret_type = b_integer;
    return object_collide(obj, myobj);
    
  default:
    fatal_error (thread, "collide: pass 0 or 1 arguments");
  }
}


long SQ_use (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object obj = (Object) getarg(thread, arglist, 0, b_object);

  thread_set_object (thread, obj);
  *ret_type = b_void;
  return 0;
}
  


long SQ_create (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object obj = object_create(thread, o_bitmap);

  thread_set_object (thread, obj);
  *ret_type = b_object;
  return (long) obj;
}


Window _find_window (parent, criteria, criteria_arg)
     Window parent;
     int (*criteria)();
     long criteria_arg;
{
  Window rootret;
  Window parentret;
  Window *children, *ch;
  unsigned int numchildren;
  Window win;
  
  XQueryTree (dpy, parent, &rootret, &parentret, &children, &numchildren);
  for (ch = children; numchildren; ch++, numchildren--) 
    if (win = _find_window(*ch, criteria, criteria_arg))
      return win;
  XFree((char *) children);
  if ((*criteria)(parent, criteria_arg))
    return parent;
  else
    return NULL;
}


int size_criteria (win, unused) /*ARGSUSED*/
     Window win;
     int unused;
{
  XWindowAttributes attr;

  if (win == root_win) return 0;
  XGetWindowAttributes(dpy, win, &attr);
  return (attr.x == 0 && attr.y == 0 &&
	  attr.width >= DisplayWidth(dpy, screen) &&
	  attr.height >= DisplayHeight(dpy, screen));
}


int name_criteria (win, name)
     Window win;
     char *name;
{
  Atom type;
  int format;
  unsigned long items;
  unsigned long left;
  unsigned char *prop;
  int match;
  
  XGetWindowProperty(dpy, win, XA_WM_NAME, 0, 1000, False,
		     AnyPropertyType, &type, &format, &items, &left, &prop);
  if (format) {
    match = !strcmp(prop, name);
    XFree (prop);
  }
  return match;
}


long SQ_find_big_window (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Window win = _find_window(root_win, size_criteria, 0);
  *ret_type = win ? b_window : b_integer;
  return (long) win;
}


long SQ_find_window (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Window win = _find_window(root_win, name_criteria, getarg (thread, arglist, 0, b_string));
  *ret_type = win ? b_window : b_integer;
  return (long) win;
}
  

long SQ_grab (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Object obj = object_create(thread, o_window);

  obj->newwin = obj->win = (Window) getarg(thread, arglist, 0, b_window);
  thread_set_object (thread, obj);
  *ret_type = b_object;
  return (long) obj;
}


long SQ_mouse_x (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  object_locate(mouse);
  *ret_type = b_integer;
  return mouse->x;
}

long SQ_mouse_y (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  object_locate(mouse);
  *ret_type = b_integer;
  return mouse->y;
}

long SQ_random (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  long arg = getarg(thread, arglist, 0, b_integer);
  long rnd = random() % abs(arg);
  *ret_type = b_integer;
  return (arg > 0) ? abs(rnd) : rnd;
}     

long SQ_sleep (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  long arg = getarg(thread, arglist, 0, b_integer);
  if (!abort_flag) delay(arg * 1000);
  *ret_type = b_void;
  return 0;
}

long SQ_my_x (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  *ret_type = b_integer;
  return thread->object->newx;
}

long SQ_my_y (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  *ret_type = b_integer;
  return thread->object->newy;
}

long SQ_running (thread, arglist, ret_type)
     Thread thread;
     Arglist arglist;
     enum b_type *ret_type;
{
  Thread the_arg = (Thread) getarg(thread, arglist, 0, b_unknown);
  *ret_type = b_integer;
  switch (arglist->types[0]) {
  case b_thread:
    return 1;
  case b_zombie:
    return 0;
  default:
    fatal_error (thread, "type mismatch");
  }
}     

static struct cfunc funcs[] = {
  "move", SQ_move,
  "moveto", SQ_moveto,
  "create", SQ_create,
  "use", SQ_use,
  "on_screen", SQ_on_screen,
  "set_window", SQ_set_window,
  "collide", SQ_collide,
  "grab", SQ_grab,
  "find_window", SQ_find_window,
  "find_big_window", SQ_find_big_window,
  "mouse_x", SQ_mouse_x,
  "mouse_y", SQ_mouse_y,
  "random", SQ_random,
  "sleep", SQ_sleep,
  "my_x", SQ_my_x,
  "my_y", SQ_my_y,
  "running", SQ_running,
  NULL, NULL,
};


bind_cfunctions (thread)
     Thread thread;
{
  Cfunc f;

  for (f = funcs; f->name; ++f)
    add_binding (thread, f->name, b_cfunc, (long) f);
}

bind_globals (thread)
     Thread thread;
{
  Binding b;
  static char bitmap_path_buffer[1024];
  
  b = add_binding (thread, "default_window", b_window, root_win);
  default_window = (Window *) &b->value;
  b = add_binding (thread, "tick_speed", b_integer, 500);
  tick_speed = (long *) &b->value;
  b = add_binding (thread, "bitmap_path", b_string, bitmap_path_buffer);
  bitmap_path = (char **) &b->value;
  add_binding (thread, "root_window", b_window, root_win);
  add_binding (thread, "screen_width", b_integer, DisplayWidth (dpy, screen));
  add_binding (thread, "screen_height", b_integer, DisplayHeight (dpy, screen));
  add_binding (thread, "mouse", b_object, mouse);
}  


main(argc, argv)
     int argc;
     char **argv;
{
  int msec = 500, still_lives;
  Thread main;
  char *progname = NULL;
  char *sqbm;
  
  while (++argv, --argc) {
    if (argv[0][0] == '-') 
      switch (argv[0][1]) {
      case 's':
	if (!(--argc)) usage();
	msec = atoi(*(++argv));
	break;
      default:
	usage();
      }
    else
      if (progname)
	usage();
      else
	progname = *argv;
  }
  if (!progname) progname = "example.squid";
  if (!(yyin = (FILE *) fopen(progname, "r"))) {
    perror(progname);
    exit(1);
  }
  yyparse();
  if (!(dpy = XOpenDisplay(""))) {
    fprintf (stderr, "can't open display\n");
    exit(1);
  }
  screen = DefaultScreen(dpy);
  root_win = RootWindow (dpy, screen);
  depth = DefaultDepth(dpy, screen);
  foreground = WhitePixel (dpy, screen);
  background = BlackPixel (dpy, screen);
  main = thread_create(NULL, the_program);
  mouse = object_create (main, o_mouse);
  mouse->refcnt++;			/* Never forget this one */
  objects = NULL;			/* Take mouse out of objects list forcefully and kludgily */
  bind_cfunctions(main);
  bind_globals(main);
  *tick_speed = msec;
  sqbm = (char *) getenv("SQUIDBITMAPS");
  strcpy(*bitmap_path, sqbm ? sqbm : "");
  signal (SIGINT, squid_abort);
  signal (SIGTERM, squid_abort);
  signal (SIGHUP, squid_abort);
  signal (SIGQUIT, squid_abort);
  while ((still_lives = interpret(main)) && !abort_flag) {
    now++;
    clean_objects();
    XSync(dpy, True);
    if (!abort_flag) delay(*tick_speed);
    mouse->loc_known = 0;		/* Recheck this constantly */
  }
  if (still_lives) thread_destroy(main);
  clean_objects();
  printf ("I'm done.\n");
  XCloseDisplay(dpy);
}

usage()
{
  fprintf (stderr, "usage: squid [-s speed-in-msecs]\n");
}