Logo Search packages:      
Sourcecode: deal version File versions  Download package

dist.c

/*
 * Copyright (C) 1996-2001, Thomas Andrews
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

/*
 * This set of routines implements the 'shapeclass' and
 * 'shapefunc' methods.
 */

#include <string.h>
#include "deal.h"
#include "dist.h"
#include "dealtypes.h"

#ifndef lint
static char rcsid [] = "$Header: /home/thomaso/deal30/RCS/dist.c,v 1.3 1999/07/09 00:32:32 thomaso Exp $";
#endif
#include <stdlib.h>

HandDist dist_table[DIST_COUNT];
static Tcl_Obj *shapeObjs[DIST_COUNT];

static Tcl_Obj *shapeParams=NULL; /* Will contain constant list "s h d c" */

static Tcl_Obj* lengthObjs[14];

static void  InitializeLengths() {
  int i;
  for (i=0; i<=13; i++) {
    Tcl_IncrRefCount(lengthObjs[i]=Tcl_NewIntObj(i));
  }
}

/*
 * The set of distributions for a hand are in 1-1 correspondence
 * with the set of of 3-subsets of the numbers {0,1,...,15}; if
 * our distribution is S-H-D-C, then we choose as our 3-subset
 * S,S+H+1,S+H+D+2.
 *
 * I have chosen to use the "squashed order" for the 3-subsets
 * as the basis for numbering the distributions because it is
 * easy to compute the index of the 3-subset from it's elements.
 *
 * For information about the squashed order, see:
 *    Anderson, "Combinatorics of Finite Sets", pp 112-119.
 *
 * I'm sure there is an easier way, but my brain is too tired, and this
 * should work well enough.
 */

/*
 * This method, while sound, isn't as quick as just using
 * pointers to pointers.  I've left it in as a reminder
 *
static int distTableIndex(s,h,d)
int s,h,d;
{
  *
  * 
  * int f1=s, f2=s+h+1, f3=s+h+d+2;
  *            (f3 choose 3) + (f2 choose 2) + (f1 choose 1)
  * return f3*(f3-1)*(f3-2)/6+f2*(f2-1)/2+f1; 

  * I've pretabulated the (x choose 2) and (x choose 3) functions
     for even easier lookup; this function is suitable for inlining. 
  static choose2tab[]={0, 1, 3,  6, 10, 15, 21, 28,  36,  45,  55,  66,  78,
                                          91};
  static choose3tab[]={0, 1, 4, 10, 20, 35, 56, 84, 120, 165, 220, 286, 364,
                                          455};
  return choose3tab[s+h+d]+choose2tab[s+h]+s;
}
*/

void computeDistTable()
{
  int s,h,d;
  int entry=0;
  Tcl_Obj *lengths[4];
  Tcl_Obj *shapeObj;

  for (s=0;s<=13; s++) {
    lengths[0]=lengthObjs[s];
    for (h=0; h<=13-s; h++) {
      lengths[1]=lengthObjs[h];
      for (d=0; d<=13-s-h; d++) {
        int c=13-s-h-d;
        lengths[2]=lengthObjs[d];
        lengths[3]=lengthObjs[c];

      dist_table[entry][SPADES]=s;
      dist_table[entry][HEARTS]=h;
      dist_table[entry][DIAMONDS]=d;
      dist_table[entry][CLUBS]=13-s-h-d;
        shapeObj=Tcl_NewListObj(4,lengths);
        Tcl_IncrRefCount(shapeObjs[entry]=shapeObj);
      entry++;
      }
    }
  }
}

void printDistTable()
{
  int i;
  for (i=0; i<DIST_COUNT; i++) {
    printf("%3d : %2d %2d %2d %2d\n",i,
         dist_table[i][SPADES],dist_table[i][HEARTS],
         dist_table[i][DIAMONDS],dist_table[i][CLUBS]);
  }
}


static void deleteDistFunc(ClientData data)
{
  int i;
  DistFunc d=(DistFunc) data;
  
  for (i=0; i<DIST_COUNT; i++) {
    Tcl_Obj *obj=d->array2[i];
    if (obj != (Tcl_Obj*) NULL) {
      Tcl_DecrRefCount(obj);
    }
  }
  Tcl_Free(data);
}

DistFunc newDistFunc(n)
     int n;
{
  int s,h,d;
  int index1=0,index2=0;
  DistFunc func=(DistFunc)Tcl_Alloc(n*sizeof(struct distfunc));
  for (s=0; s<=13; s++) {
    func->array[s] = index1+(func->array1);
    for (h=0; h<=13-s; h++,index1++) {
      func->array1[index1]= index2 + (func->array2);
      for (d=0; d<=13-s-h; d++, index2++) {
      func->array2[index2] = 0;
      }
    }
  }
  return func;
}
    
DistSet newDistSet(n)
     int n;
{
  int s,h,d;
  int index1=0,index2=0;
  DistSet set=(DistSet)Tcl_Alloc(n*sizeof(struct distset));
  for (s=0; s<=13; s++) {
    set->array[s] = index1+(set->array1);
    for (h=0; h<=13-s; h++,index1++) {
      set->array1[index1]= index2 + (set->array2);
      for (d=0; d<=13-s-h; d++, index2++) {
        set->array2[index2] = NULL;
      }
    } 
  } 
  set->shapesList=NULL;
  return set;
}

void deleteDistSet(ClientData cd) {
  DistSet set=(DistSet)cd;
  int i;
  for (i=0; i<DIST_COUNT; i++) {
    if (set->array2[i]!=NULL) {
      Tcl_DecrRefCount(set->array2[i]);
    }
  }
  Tcl_Free((char*)set);
}

int tcl_shapefunc_eval ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  static int handSubCmd=-1,compileSubCmd=-1, evalSubCmd=-1, shapeSubCmd, subCmdInit=1;
  int hand;
  char *result,*rptr;
  int i;
  int s,h,d,c;
  DistFunc set=(DistFunc) cd;

  if (subCmdInit) {
    handSubCmd=Keyword_addKey("hand");
    compileSubCmd=Keyword_addKey("compile");
    evalSubCmd=Keyword_addKey("eval");
    shapeSubCmd=Keyword_addKey("shape");
    subCmdInit=0;
  }

  if (objc==1) {
    Tcl_WrongNumArgs(interp,1,objv,"handname");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"hand <hand>");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"hand eval <s> <h> <d> <c>");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"hand shape {<s> <h> <d> <c>}");
    return TCL_ERROR;
  }

  if (NOSEAT==(hand=getHandNumFromObj(interp,objv[1]))) {

    int subCmd=Keyword_getIdFromObj(interp,objv[1]);

    if (subCmd==compileSubCmd) {
      int len;
      char *command=Tcl_GetString(objv[0]);
      result=(char *)Tcl_Alloc(8*DIST_COUNT+strlen(command)+50);
      sprintf(result,"shapeclass.binary %s {\n",command);
      rptr=result+strlen(result);

      for (i=1;i<=DIST_COUNT; i++) {
      if (i%8==1) {
        *(rptr++)='\t';
      }
      sprintf(rptr,"%s",Tcl_GetStringFromObj(DFVal(set,i-1),&len));
      rptr += len;
      if (i%8==0) {
        *(rptr++)='\n';
      } else {
        *(rptr++)=' ';
      }
      }
      strcpy(rptr,"\n}\n");
      Tcl_SetResult(interp,result,TCL_DYNAMIC);
      return TCL_OK;
    }

    if (subCmd==handSubCmd) {
        
      int retval,suit,holding[4],lengths[4];

      if (objc!=3) {
        Tcl_WrongNumArgs(interp,2,objv,"<hand>");
        return TCL_ERROR;
      }

      retval=getHandHoldingsFromObj(interp,objv[2],holding);
      if (retval!=TCL_OK) { 
      Tcl_SetResult(interp,"Argument was not a list of four holdings",
                  TCL_STATIC);
      return TCL_ERROR;
      }
      for (suit=0; suit<4; suit++) {
      lengths[suit]=(counttable[holding[suit]&8191]);
      }
      s=lengths[0]; h=lengths[1]; d=lengths[2]; c=lengths[3];
    } else  if (subCmd==evalSubCmd) {
      if (objc!=6) {
        Tcl_WrongNumArgs(interp,2,objv,"slen hlen dlen clen");
        return TCL_ERROR;
      }

      Tcl_GetIntFromObj(interp,objv[2],&s);
      Tcl_GetIntFromObj(interp,objv[3],&h);
      Tcl_GetIntFromObj(interp,objv[4],&d);
      Tcl_GetIntFromObj(interp,objv[5],&c);
    } else if (subCmd==shapeSubCmd) {
      int retval;
      Tcl_Obj **objv2=NULL;
      int objc2=0;
      if (objc!=3) {
      Tcl_WrongNumArgs(interp,2,objv,"{slen hlen dlen clen}");
      return TCL_ERROR;
      }
      retval=Tcl_ListObjGetElements(interp,objv[2],&objc2,&objv2);
      if (retval==TCL_ERROR || objc2!=4) {
      Tcl_SetResult(interp,"Shape must be a list of four suit lengths",
                  TCL_STATIC);
      return TCL_ERROR;
      }
      Tcl_GetIntFromObj(interp,objv2[0],&s);
      Tcl_GetIntFromObj(interp,objv2[1],&h);
      Tcl_GetIntFromObj(interp,objv2[2],&d);
      Tcl_GetIntFromObj(interp,objv2[3],&c);

    } else {
      char *command=Tcl_GetString(objv[0]);
      Tcl_AppendResult(interp,Tcl_GetString(objv[1]),
                   " is not a legitimate subcommand for the shapefunc ",
                   command,
                   NULL);
      return TCL_ERROR;
    }
  } else {
    if (objc!=2) {
      Tcl_WrongNumArgs(interp,2,objv,0);
      return TCL_ERROR;
    }
    FINISH(hand);
    s=count_suit(hand,SPADES);
    h=count_suit(hand,HEARTS);
    d=count_suit(hand,DIAMONDS);
    c=count_suit(hand,CLUBS);
  }
  if (s+h+d+c!=13) {
    Tcl_SetResult(interp,"Suit lengths did not add to 13",TCL_STATIC);
    return TCL_ERROR;
  }

  Tcl_SetObjResult(interp,set->array[s][h][d]);
  return TCL_OK;
}

int tcl_shapeclass_eval ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  static int subCmdInit=1,
    compileSubCmd=-1,
    handSubCmd=-1,
    evalSubCmd=-1,
    listSubCmd=-1,
    shapeSubCmd=-1;

  int hand;
  char *result,*rptr;
  int i;
  int s,h,d,c;

  DistSet set=(DistSet) cd;

  if (subCmdInit) {
    handSubCmd=Keyword_addKey("hand");
    compileSubCmd=Keyword_addKey("compile");
    evalSubCmd=Keyword_addKey("eval");
    listSubCmd=Keyword_addKey("list");
    shapeSubCmd=Keyword_addKey("shape");
    subCmdInit=0;
  }

  if (objc==1) {
    Tcl_WrongNumArgs(interp,1,objv,"list");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"<handname>");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"hand <hand>");
    Tcl_AppendResult(interp,"\tor\n",0);
    Tcl_WrongNumArgs(interp,1,objv,"hand eval <s> <h> <d> <c>");
    Tcl_AppendResult(interp,"\tor\n",0);
    return TCL_ERROR;
  }

  if (NOSEAT==(hand=getHandNumFromObj(interp,objv[1]))) {
    int subCmdId=Keyword_getIdFromObj(interp,objv[1]);

    if (subCmdId==listSubCmd) {

      if (objc!=2) {
      Tcl_WrongNumArgs(interp,2,objv,0);
      return TCL_ERROR;
      }

      if (set->shapesList==NULL) {
      Tcl_Obj *explicit[DIST_COUNT],*current;
      int ret,value,count=0;
      for (i=0; i<DIST_COUNT; i++) {
        current=DSElt(set,i);
        ret=Tcl_GetBooleanFromObj(interp,current,&value);
        if (ret!=TCL_OK) {
          return ret;
        }
        if (value) {
          explicit[count++]=shapeObjs[i];
        }
      }
      Tcl_IncrRefCount(set->shapesList=Tcl_NewListObj(count,explicit));
      }
      Tcl_SetObjResult(interp,set->shapesList);
      return TCL_OK;
    }

    if (subCmdId==compileSubCmd) {
      char *name=Tcl_GetString(objv[0]);

      result=(char *)Tcl_Alloc(1+DIST_COUNT+strlen(name)+1024);
      sprintf(result,"shapeclass.binary %s {\n",name);
      rptr=result+strlen(result);

      for (i=1;i<=DIST_COUNT; i++) {
      Tcl_Obj *obj=DSElt(set,i-1);
      int isElt;
      int ret=Tcl_GetBooleanFromObj(interp,obj,&isElt);
        
      if (ret!=TCL_OK) {
        Tcl_Free(result);
        return ret;
      }

      if (i%32==1) {
        *(rptr++)='\t';
      }
      
      *(rptr++)=(isElt ? '1' : '0');
      if (i%32==0) {
        *(rptr++)='\n';
      } else {
        if (i%8==0) {
          *(rptr++)=' ';
        }
      } 
      } 

      strcpy(rptr,"\n}\n");
      Tcl_SetResult(interp,result,TCL_DYNAMIC);
      return TCL_OK;
    } 

    if (subCmdId==handSubCmd) {
      int retval,suit,hnum[4],lengths[4];

      if (objc!=3) {
      Tcl_WrongNumArgs(interp,2,objv,"<hand>");
      return TCL_ERROR;
      }

      retval=getHandHoldingsFromObj(interp,objv[2],hnum);
      if (retval!=TCL_OK) { 
      Tcl_AddErrorInfo(interp,"Argument was not a valid hand");
      return TCL_ERROR;
      }

      for (suit=0; suit<4; suit++) {
      lengths[suit]=counttable[hnum[suit]&8191];
      }

      s=lengths[0]; h=lengths[1]; d=lengths[2]; c=lengths[3];
    } else if (subCmdId==evalSubCmd) {
      if (objc!=6) {
      Tcl_WrongNumArgs(interp,2,objv,"<slen> <hlen> <dlen> <clen>");
      return TCL_ERROR;
      }

      Tcl_GetIntFromObj(interp,objv[2],&s);
      Tcl_GetIntFromObj(interp,objv[3],&h);
      Tcl_GetIntFromObj(interp,objv[4],&d);
      Tcl_GetIntFromObj(interp,objv[5],&c);

    } else if (subCmdId==shapeSubCmd) {
      int retval;
      Tcl_Obj **objv2=NULL;
      int objc2=0;
      if (objc!=3) {
      Tcl_WrongNumArgs(interp,2,objv,"{<slen> <hlen> <dlen> <clen>}");
      return TCL_ERROR;
      }

      retval=Tcl_ListObjGetElements(interp,objv[2],&objc2,&objv2);
      if (retval==TCL_ERROR || objc2!=4) {
      Tcl_SetResult(interp,"Error trying to parse shape ",TCL_STATIC);
      Tcl_AppendResult(interp,Tcl_GetString(objv[2]),NULL);
      return TCL_ERROR;
      }

      Tcl_GetIntFromObj(interp,objv2[0],&s);
      Tcl_GetIntFromObj(interp,objv2[1],&h);
      Tcl_GetIntFromObj(interp,objv2[2],&d);
      Tcl_GetIntFromObj(interp,objv2[3],&c);

    } else {

      char *command=Tcl_GetString(objv[0]);
      Tcl_AppendResult(interp,Tcl_GetString(objv[1]),
                   " is not a legitimate subcommand for the shapeclass ",
                   command,
                   NULL);
      return TCL_ERROR;
    }
  } else {
    FINISH(hand);
    s=count_suit(hand,SPADES);
    h=count_suit(hand,HEARTS);
    d=count_suit(hand,DIAMONDS);
    c=count_suit(hand,CLUBS);
  }
  
  if (s+h+d+c!=13) {
    Tcl_SetResult(interp,"Shape did not have 13 cards.",TCL_STATIC);
    return TCL_ERROR;
  }

  Tcl_SetObjResult(interp,set->array[s][h][d]);
  return TCL_OK;
}


static int ShapeProcDefine(interp,name,procBody)
     Tcl_Interp *interp;
     Tcl_Obj *name;
     Tcl_Obj *procBody;
{
  static Tcl_Obj *procCmd=NULL;
  Tcl_Obj *code[4];

  if (procCmd==NULL) {
    Tcl_IncrRefCount(procCmd=Tcl_NewStringObj("proc",4));
  }
  code[0]=procCmd;
  code[1]=name;
  code[2]=shapeParams;
  code[3]=procBody;

  return Tcl_EvalObjv(interp,4,code,TCL_EVAL_GLOBAL);
}

DistFunc shapefunc_compile(interp,name,procBody)
     Tcl_Interp *interp;
     Tcl_Obj *name;
     Tcl_Obj *procBody;
{
  int result;
  DistFunc func;
  char *nameStr;
  int spades,hearts,diamonds,clubs;
  Tcl_Obj *array[5],*value;

  func=newDistFunc(1);
  if (func==0) {
    return 0;
  }

  result=ShapeProcDefine(interp,name,procBody);

  nameStr=Tcl_GetString(name);
  if (result==TCL_ERROR) { 
    deleteDistFunc(func); 
    Tcl_AppendResult(interp,"\nCould not compile function ",nameStr,"\n",NULL);
    return 0;
  }

  array[0]=name;

  for (spades=0; spades<=13; spades++) {
    array[1]=lengthObjs[spades];
    for (hearts=0; hearts<=13-spades; hearts++) {
      array[2]=lengthObjs[hearts];
      for (diamonds=0; diamonds<=13-spades-hearts; diamonds++) {
      array[3]=lengthObjs[diamonds];
      clubs=13-spades-hearts-diamonds;
      array[4]=lengthObjs[clubs];
      result=Tcl_EvalObjv(interp,5,array,TCL_EVAL_GLOBAL);
      
      if (result==TCL_ERROR) { 
        deleteDistFunc(func);
        Tcl_AppendResult(interp,"\nCould not compile function ",nameStr,"\n",
                     NULL);
        return 0;
      }
      
      value=Tcl_GetObjResult(interp);
      func->array[spades][hearts][diamonds]=value;
      Tcl_IncrRefCount(value);
      }
    }
  }
  Tcl_ResetResult(interp); /* Clear interp results... */
  return func;
}

DistSet shapeclass_compile(interp,name,procBody)
     Tcl_Interp *interp;
     Tcl_Obj *name;
     Tcl_Obj *procBody;
{

  int result;
   DistSet set;
  int spades,hearts,diamonds,clubs;
  Tcl_Obj *callCmd[5],*value;
  char *nameStr;
  set=newDistSet(1);

  result=ShapeProcDefine(interp,name,procBody);

  nameStr=Tcl_GetString(name);
  if (result==TCL_ERROR) { 
    deleteDistSet((ClientData)set); 

    Tcl_AppendResult(interp,"\nCould not compile function ",
                 nameStr,
                 NULL);
    return 0;
  }

  callCmd[0]=name;
  for (spades=0; spades<=13; spades++) {
    callCmd[1]=lengthObjs[spades];
    for (hearts=0; hearts<=13-spades; hearts++) {
      callCmd[2]=lengthObjs[hearts];
      for (diamonds=0; diamonds<=13-spades-hearts; diamonds++) {
      callCmd[3]=lengthObjs[diamonds];
      clubs=13-spades-hearts-diamonds;
      callCmd[4]=lengthObjs[clubs];
      result=Tcl_EvalObjv(interp,5,callCmd,TCL_EVAL_GLOBAL);

      if (result==TCL_ERROR) {
        deleteDistSet((ClientData)set);
        Tcl_AppendResult(interp,"\nCould not compile function ",
                     nameStr,
                     NULL);
        return 0;
      }
      value=Tcl_GetObjResult(interp);
      set->array[spades][hearts][diamonds]=value;
      Tcl_IncrRefCount(value);
      }
    }
  }
  Tcl_ResetResult(interp);
  return set;
}

int tcl_shapefunc_lazy ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  Tcl_Obj *procBody=(Tcl_Obj *)cd;
  char *name=Tcl_GetString(objv[0]);
  DistFunc func=shapefunc_compile(interp,objv[0],procBody);

  if (func==(DistFunc)NULL) {
    Tcl_AppendResult(interp,"Error compiling\n",NULL);
    return TCL_ERROR;
  }
  Tcl_CreateObjCommand(interp,name,tcl_shapefunc_eval,(ClientData)func,
                   deleteDistFunc);
  return tcl_shapefunc_eval((ClientData) func,interp,objc,objv);
}

DistSet shapeclass_lazy_compile (interp,nameObj,procBody)
     Tcl_Interp *interp;
     Tcl_Obj *nameObj;
     Tcl_Obj *procBody;
{
  DistSet set=shapeclass_compile(interp,nameObj,procBody);
  char *name;

  if (set==(DistSet)NULL) {
    return 0;
  }

  name=Tcl_GetString(nameObj);
  Tcl_CreateObjCommand(interp,name,tcl_shapeclass_eval,(ClientData)set,
                   deleteDistSet);
  return set;
}
    
int tcl_shapeclass_lazy ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  Tcl_Obj *procBody=(Tcl_Obj *)cd;
  DistSet set=shapeclass_lazy_compile(interp,objv[0],procBody);

  if (set==(DistSet)0) {
    Tcl_AddErrorInfo(interp,"Error compiling shape class ");
    Tcl_AddErrorInfo(interp,Tcl_GetString(objv[0]));
    return TCL_ERROR;
  }
  return tcl_shapeclass_eval((ClientData) set,interp,objc,objv);

}

int tcl_shapeexpr_define ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  static Tcl_Obj *exprCmd=NULL;

  int isClass=(int)cd;
  Tcl_Obj *cmdElts[2];
  Tcl_Obj *command;
  char *name;

  if (exprCmd==NULL) {
    Tcl_IncrRefCount(exprCmd=Tcl_NewStringObj("expr",4));
  }

  if (objc!=3) { 
    Tcl_WrongNumArgs(interp,1,objv,"<name> <expr>");
    return TCL_ERROR;
  }
  name=Tcl_GetString(objv[1]);

  cmdElts[0]=exprCmd;
  cmdElts[1]=objv[2];
  Tcl_IncrRefCount(command=Tcl_NewListObj(2,cmdElts));

  if (isClass) {
    Tcl_CreateObjCommand(interp,name,tcl_shapeclass_lazy,(ClientData)command,&Tcl_ObjDelete);
  } else {
    Tcl_CreateObjCommand(interp,name,tcl_shapefunc_lazy,(ClientData)command,&Tcl_ObjDelete);    
  }
  return TCL_OK;
}

int tcl_shapefunc_define ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  char *name;
  if (objc!=3) { 
    Tcl_WrongNumArgs(interp,1,objv,"<name> <expr>");
    return TCL_ERROR;
  }

  name=Tcl_GetString(objv[1]);
  Tcl_IncrRefCount(objv[2]);

  Tcl_CreateObjCommand(interp,name,tcl_shapefunc_lazy,(ClientData)objv[2],Tcl_ObjDelete);
  return TCL_OK;
}

int tcl_shapeclass_define ( TCLOBJ_PARAMS ) TCLOBJ_DECL
{
  char *name;
  if (objc!=3) { 
    Tcl_WrongNumArgs(interp,1,objv,"<name> <expr>");
    return TCL_ERROR;
  }

  name=Tcl_GetString(objv[1]);
  Tcl_IncrRefCount(objv[2]);
  Tcl_CreateObjCommand(interp,name,tcl_shapeclass_lazy,(ClientData)objv[2],Tcl_ObjDelete);
  return TCL_OK;
}

int tcl_shapeclass_define_binary ( TCL_PARAMS ) TCL_DECL
{
  DistSet set;
  char *s;
  int i;
  if (argc!=3) { return TCL_ERROR; }

  set=newDistSet(1);
  for (i=0; i<DIST_COUNT; i++) {
    Tcl_IncrRefCount(set->array2[i]=Tcl_NewBooleanObj(0));
  }

  for (i=0,s=argv[2]; (*s) && (i<DIST_COUNT); s++) {
    switch (*s) {
    case '0':
      DSDelete(set,i++);
      break;
    case '1':
      DSAdd(set,i++);
      break;
    default:
      break;
    }
  }
  Tcl_CreateObjCommand(interp,argv[1],tcl_shapeclass_eval,(ClientData)set,Tcl_AllocDelete);
  return TCL_OK;
}

int Dist_Init(interp)
     Tcl_Interp *interp;
{
  InitializeLengths();
  Tcl_IncrRefCount(shapeParams=Tcl_NewStringObj("s h d c",7));

  Tcl_CreateObjCommand(interp,"shapefunc",tcl_shapefunc_define,NULL,NULL);
  Tcl_CreateObjCommand(interp,"shapeclass",tcl_shapeclass_define,NULL,NULL);
  Tcl_CreateObjCommand(interp,"shapecond",tcl_shapeexpr_define,(ClientData)1,NULL);
  Tcl_CreateObjCommand(interp,"shapeexpr",tcl_shapeexpr_define,(ClientData)0,NULL);
  Tcl_CreateCommand(interp,"shapeclass.binary",
                tcl_shapeclass_define_binary,NULL,NULL);

  computeDistTable();
  return TCL_OK;
}

Generated by  Doxygen 1.6.0   Back to index