home *** CD-ROM | disk | FTP | other *** search
/ Stone Design / Stone Design.iso / Stone_Friends / Wave / WavesWorld / Source / IBPalettes / WW3DKit / WWInterp.m < prev    next >
Encoding:
Text File  |  1995-05-17  |  43.2 KB  |  1,319 lines
  1. // copyright 1993 Michael B. Johnson; some portions copyright 1994, MIT
  2. // see COPYRIGHT for reuse legalities
  3. //
  4.  
  5.  
  6. #import "WWInterp.h"
  7. #import "EveVarTypeInfo.h"
  8.  
  9. #define PI    (3.1415926535897932384626433)
  10. #define DtoR  (PI/180.0)
  11. #define RtoD  (180.0/PI)
  12.  
  13.  
  14. // for the routines I'm using written by Darwyn Peachey
  15. // from the book:
  16. // "Texturing and Modeling: A Procedural Approach"
  17. //   by Ebert, Musgrave, Peachey, Perlin, and Worley
  18. //   ISBN 0-12-228761-4
  19. #import "proctext.h"
  20.  
  21.  
  22. @implementation WWInterp
  23.  
  24.  
  25. + initialize { return [WWInterp setVersion:1], self; }
  26.  
  27. // need to get rid of this!
  28. static char errBuf[1024];
  29.  
  30. ///////////////////////////////
  31. ///// math functions //////////
  32. ///////////////////////////////
  33.  
  34.  
  35.  
  36. static int 
  37. exprCmd_pi(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  38. {
  39.   // pi takes no arguments; returns 
  40.   // it returns a double corresponding to the converted value in radians
  41.   resultPtr->type = TCL_DOUBLE;
  42.   resultPtr->doubleValue = (double)3.1415926535897932384626433;
  43.   return TCL_OK;
  44. }
  45.  
  46. static int 
  47. exprCmd_radians(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  48. {
  49.   // radians takes one argument; a value expressed in degrees
  50.   // it returns a double corresponding to the converted value in radians
  51.   resultPtr->type = TCL_DOUBLE;
  52.   if (args->type == TCL_INT)
  53.   {  resultPtr->doubleValue = (double)(args->intValue) * DtoR;
  54.   }
  55.   else
  56.   {  resultPtr->doubleValue = args->doubleValue * DtoR;
  57.   }
  58.   return TCL_OK;
  59. }
  60.  
  61. static int 
  62. exprCmd_degrees(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  63. {
  64.   // degrees takes one argument; a value expressed in radians
  65.   // it returns a double corresponding to the converted value in degrees
  66.   resultPtr->type = TCL_DOUBLE;
  67.   if (args->type == TCL_INT)
  68.   {  resultPtr->doubleValue = (double)(args->intValue) * RtoD;
  69.   }
  70.   else
  71.   {  resultPtr->doubleValue = args->doubleValue * RtoD;
  72.   }
  73.   return TCL_OK;
  74. }
  75.  
  76. static int 
  77. exprCmd_sign(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  78. {
  79.   // sign takes one argument
  80.   // it returns a double : -1 if the value is negative, 0 if zero, and +1 is the value is positive
  81.   resultPtr->type = TCL_INT;
  82.   if (args->type == TCL_INT)
  83.   {  if (args->intValue == 0)
  84.      {  resultPtr->intValue = 0;
  85.      }
  86.      else
  87.      {  if (args->intValue < 0)
  88.         {  resultPtr->intValue = -1;
  89.         }
  90.         else
  91.         {  resultPtr->intValue = 1;
  92.         }
  93.      }
  94.   }
  95.   else
  96.   {  if (args->doubleValue == 0.0)
  97.      {  resultPtr->intValue = 0;
  98.      }
  99.      else
  100.      {  if (args->doubleValue < 0.0)
  101.         {  resultPtr->intValue = -1;
  102.         }
  103.         else
  104.         {  resultPtr->intValue = 1;
  105.         }
  106.      }
  107.   }
  108.   return TCL_OK;
  109. }
  110.  
  111. static int 
  112. exprCmd_min(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  113. {
  114.   // min takes two arguments
  115.   // it returns a value corresponding to minimum of the two
  116.   if (args[0].type == TCL_INT)
  117.   {  if (args[1].type == TCL_INT)  // both args are ints
  118.      {  resultPtr->type = TCL_INT;
  119.         if (args[0].intValue < args[1].intValue)
  120.         {  resultPtr->intValue = args[0].intValue;
  121.         }
  122.         else
  123.         {  resultPtr->intValue = args[1].intValue;
  124.         }
  125.      }
  126.      else  // the first arg is an int, the second is a double
  127.      {  resultPtr->type = TCL_DOUBLE;
  128.         if (args[0].intValue < args[1].doubleValue)
  129.         {  resultPtr->doubleValue = (double)(args[0].intValue);
  130.         }
  131.         else
  132.         {  resultPtr->doubleValue = args[1].doubleValue;
  133.         }
  134.      }
  135.   }
  136.   else  // the first arg is a double
  137.   {  if (args[1].type == TCL_DOUBLE)  // both args are doubles
  138.      {  resultPtr->type = TCL_DOUBLE;
  139.         if (args[0].doubleValue < args[1].doubleValue)
  140.         {  resultPtr->doubleValue = args[0].doubleValue;
  141.         }
  142.         else
  143.         {  resultPtr->doubleValue = args[1].doubleValue;
  144.         }
  145.      }
  146.      else  // the first arg is a double, the second is an int
  147.      {  resultPtr->type = TCL_DOUBLE;
  148.         if (args[0].doubleValue < args[1].intValue)
  149.         {  resultPtr->doubleValue = args[0].doubleValue;
  150.         }
  151.         else
  152.         {  resultPtr->intValue = (double)(args[1].intValue);
  153.         }
  154.      }
  155.   }
  156.  
  157.   return TCL_OK;
  158. }
  159.  
  160. static int 
  161. exprCmd_max(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  162. {
  163.   // max takes two arguments
  164.   // it returns a value corresponding to maximum of the two
  165.   if (args[0].type == TCL_INT)
  166.   {  if (args[1].type == TCL_INT)  // both args are ints
  167.      {  resultPtr->type = TCL_INT;
  168.         if (args[0].intValue > args[1].intValue)
  169.         {  resultPtr->intValue = args[0].intValue;
  170.         }
  171.         else
  172.         {  resultPtr->intValue = args[1].intValue;
  173.         }
  174.      }
  175.      else  // the first arg is an int, the second is a double
  176.      {  resultPtr->type = TCL_DOUBLE;
  177.         if (args[0].intValue > args[1].doubleValue)
  178.         {  resultPtr->doubleValue = (double)(args[0].intValue);
  179.         }
  180.         else
  181.         {  resultPtr->doubleValue = args[1].doubleValue;
  182.         }
  183.      }
  184.   }
  185.   else  // the first arg is a double
  186.   {  if (args[1].type == TCL_DOUBLE)  // both args are doubles
  187.      {  resultPtr->type = TCL_DOUBLE;
  188.         if (args[0].doubleValue > args[1].doubleValue)
  189.         {  resultPtr->doubleValue = args[0].doubleValue;
  190.         }
  191.         else
  192.         {  resultPtr->doubleValue = args[1].doubleValue;
  193.         }
  194.      }
  195.      else  // the first arg is a double, the second is an int
  196.      {  resultPtr->type = TCL_DOUBLE;
  197.         if (args[0].doubleValue > args[1].intValue)
  198.         {  resultPtr->doubleValue = args[0].doubleValue;
  199.         }
  200.         else
  201.         {  resultPtr->intValue = (double)(args[1].intValue);
  202.         }
  203.      }
  204.   }
  205.  
  206.   return TCL_OK;
  207. }
  208.  
  209.  
  210. static int 
  211. exprCmd_clamp(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  212. {
  213.   // clamp takes three float arguments, a, min, max
  214.   // it returns a value clamped between min and max
  215.   resultPtr->type = TCL_DOUBLE;
  216.   if (args[0].doubleValue < args[1].doubleValue)
  217.   {  resultPtr->doubleValue = args[1].doubleValue;
  218.   }
  219.   else
  220.   {  if (args[0].doubleValue > args[2].doubleValue)
  221.      {  resultPtr->doubleValue = args[2].doubleValue;
  222.      }
  223.      else
  224.      {  resultPtr->doubleValue = args[0].doubleValue;
  225.      }
  226.   }
  227.   return TCL_OK;
  228. }
  229.  
  230. static int 
  231. exprCmd_step(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  232. {
  233.   // clamp takes two float arguments: min, value
  234.   // if value is less than min, it returns 0, otherwise it returns 1
  235.   resultPtr->type = TCL_DOUBLE;
  236.   if (args[1].doubleValue < args[0].doubleValue)
  237.   {  resultPtr->doubleValue = 0.0;
  238.   }
  239.   else
  240.   {  resultPtr->doubleValue = 1.0;
  241.   }
  242.   return TCL_OK;
  243. }
  244.  
  245.  
  246. static int 
  247. exprCmd_spline(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  248. {
  249.   float  vec[4];
  250.  
  251.  
  252.   // spline takes 5 arguments; the first is the point along u (0 -> 1) and the 
  253.   // other 4 are control points
  254.   // it smoothly interpolates between them
  255.   resultPtr->type = TCL_DOUBLE;
  256.   vec[0] = args[1].doubleValue;
  257.   vec[1] = args[2].doubleValue;
  258.   vec[2] = args[3].doubleValue;
  259.   vec[3] = args[4].doubleValue;
  260.   resultPtr->doubleValue = spline(args[0].doubleValue, 4, vec);
  261.   return TCL_OK;
  262. }
  263.  
  264.  
  265. static int 
  266. exprCmd_smoothstep(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  267. {
  268.   // smoothstep takes three float arguments: min, max, value
  269.   // if value is less than min, it returns min, if it's above max, it returns max, otherwise
  270.   // it smoothly interpolates between them
  271.   resultPtr->type = TCL_DOUBLE;
  272.   resultPtr->doubleValue = smoothstep(args[0].doubleValue, args[1].doubleValue, args[2].doubleValue);
  273.   return TCL_OK;
  274. }
  275.  
  276.  
  277. static int 
  278. exprCmd_lerpDown(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  279. {
  280.   // lerpDown takes three float arguments: u, min, max
  281.   // if u is less than or equal 0, it returns max, if it's above or equal 1, it returns min, otherwise
  282.   // it smoothly interpolates between them, downwards
  283.   resultPtr->type = TCL_DOUBLE;
  284.   if (args[0].doubleValue <= 0.0)
  285.   {  resultPtr->doubleValue = args[2].doubleValue;
  286.   }
  287.   else
  288.   {  if (args[0].doubleValue >= 1.0)
  289.      {  resultPtr->doubleValue = args[1].doubleValue;
  290.      }
  291.      else
  292.      {  resultPtr->doubleValue = args[2].doubleValue; // give it a base
  293.         resultPtr->doubleValue -= args[0].doubleValue * (args[2].doubleValue - args[1].doubleValue);
  294.      }
  295.   }
  296.   return TCL_OK;
  297. }
  298.  
  299.  
  300. static int 
  301. exprCmd_lerpUp(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  302. {
  303.   // lerpUp takes three float arguments: u, min, max
  304.   // if u is less than 0, it returns min, if it's above 1, it returns max, otherwise
  305.   // it smoothly interpolates between them
  306.   resultPtr->type = TCL_DOUBLE;
  307.   if (args[0].doubleValue <= 0.0)
  308.   {  resultPtr->doubleValue = args[1].doubleValue;
  309.   }
  310.   else
  311.   {  if (args[0].doubleValue >= 1.0)
  312.      {  resultPtr->doubleValue = args[2].doubleValue;
  313.      }
  314.      else
  315.      {  resultPtr->doubleValue = args[1].doubleValue; // give it a base
  316.         resultPtr->doubleValue += args[0].doubleValue * (args[2].doubleValue - args[1].doubleValue);
  317.      }
  318.   }
  319.   return TCL_OK;
  320. }
  321.  
  322.  
  323. static int 
  324. exprCmd_noise(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  325. {
  326.   // noise takes three float arguments: x, y, and z
  327.   // it returns some value between 0 and 1 which is a random function of its argument
  328.   resultPtr->type = TCL_DOUBLE;
  329.   resultPtr->doubleValue = (double)gnoise((float)(args[0].doubleValue), (float)(args[1].doubleValue), (float)(args[2].doubleValue));
  330.  
  331.   return TCL_OK;
  332. }
  333.  
  334. static int 
  335. exprCmd_gvnoise(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  336. {
  337.   // gvnoise takes three float arguments: x, y, and z
  338.   // it returns some value between 0 and 1 which is a random function of its argument
  339.   resultPtr->type = TCL_DOUBLE;
  340.   resultPtr->doubleValue = (double)gvnoise((float)(args[0].doubleValue), (float)(args[1].doubleValue), (float)(args[2].doubleValue));
  341.  
  342.   return TCL_OK;
  343. }
  344.  
  345.  
  346. static int 
  347. exprCmd_scnoise(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  348. {
  349.   // scoise takes three float arguments: x, y, and z
  350.   // it returns some value between 0 and 1 which is a random function of its argument
  351.   resultPtr->type = TCL_DOUBLE;
  352.   resultPtr->doubleValue = (double)scnoise((float)(args[0].doubleValue), (float)(args[1].doubleValue), (float)(args[2].doubleValue));
  353.  
  354.   return TCL_OK;
  355. }
  356.  
  357.  
  358. static int 
  359. exprCmd_vnoise(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  360. {
  361.   // scoise takes three float arguments: x, y, and z
  362.   // it returns some value between 0 and 1 which is a random function of its argument
  363.   resultPtr->type = TCL_DOUBLE;
  364.   resultPtr->doubleValue = (double)vnoise((float)(args[0].doubleValue), (float)(args[1].doubleValue), (float)(args[2].doubleValue));
  365.  
  366.   return TCL_OK;
  367. }
  368.  
  369.  
  370. static int 
  371. exprCmd_vcnoise(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
  372. {
  373.   // scoise takes three float arguments: x, y, and z
  374.   // it returns some value between 0 and 1 which is a random function of its argument
  375.   resultPtr->type = TCL_DOUBLE;
  376.   resultPtr->doubleValue = (double)vcnoise((float)(args[0].doubleValue), (float)(args[1].doubleValue), (float)(args[2].doubleValue));
  377.  
  378.   return TCL_OK;
  379. }
  380.  
  381.  
  382. ///////////////////////////////
  383. ///// math commands ///////////
  384. ///////////////////////////////
  385.  
  386.  
  387. // the following routines are more flexible versions of some of the above math functions
  388. static int
  389. cmd_spline(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  390. {
  391.   char    *my_args = "u rank {knot0 knot1 knot2 ... knotN}";
  392.   char    **argv2;
  393.   int     argc2, i, j, rank, nKnots, knotArgIndex;
  394.   float   u, *knots, *retVector, *knotPtr;
  395.   double  dU, dKnot;
  396.  
  397.  
  398.   if (argc != 4) // need to allow non-list knots...
  399.   {  sprintf(errBuf, "USAGE: %s %s (not right number of args: need at least 4 knots (remember the knots should be a single arg - enclose them in quotes)", argv[0], my_args);
  400.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  401.      return TCL_ERROR;
  402.   }
  403.  
  404.   if (Tcl_GetDouble(interp, argv[1], &dU) != TCL_OK)
  405.   {  sprintf(errBuf, "USAGE: %s %s (1st arg not a valid float)", argv[0], my_args);
  406.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  407.      return TCL_ERROR;
  408.   }
  409.   u = (float)dU;
  410.  
  411.   if (Tcl_GetInt(interp, argv[2], &rank) != TCL_OK)
  412.   {  sprintf(errBuf, "USAGE: %s %s (2nd arg not a valid integer)", argv[0], my_args);
  413.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  414.      return TCL_ERROR;
  415.   }
  416.  
  417.   if (argc == 4) // assuming second arg is actually a list; need to split it
  418.   {  Tcl_SplitList(interp, argv[3], &argc2, &argv2);
  419.      // the knot vector must be at least (rank * 4)
  420.      if (argc2 < (rank * 4))
  421.      {  sprintf(errBuf, 
  422.         "USAGE: %s %s (after splitting 3rd arg still not enough args: need at least 4 knots)", 
  423.         argv[0], my_args);
  424.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  425.         return TCL_ERROR;
  426.      }
  427.      if (argc2 % rank)
  428.      {  sprintf(errBuf, 
  429.         "USAGE: %s %s (after splitting 3rd arg, number of elements wasn't evenly divisible by %d)", 
  430.         argv[0], my_args, rank);
  431.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  432.         return TCL_ERROR;
  433.      }
  434.  
  435.      // okay, the number of elements in the list is correct.
  436.      // now we need to malloc up memory for the float vector to hand spline()
  437.      // we only need enough memory for a rank==1 vector, since we'll spline
  438.      // each component separately.
  439.  
  440.      nKnots = argc2 / rank;
  441.      knots = (float *)malloc(sizeof(float) * nKnots);
  442.      retVector = (float *)malloc(sizeof(float) * rank);
  443.      for (i = 0; i < rank; i++)
  444.      {  knotPtr = knots;
  445.         for (j = 0; j < nKnots; j++)
  446.         {  knotArgIndex = (j * rank) + i;
  447.            if (Tcl_GetDouble(interp, argv2[knotArgIndex], &dKnot) != TCL_OK)
  448.           {  sprintf(errBuf, 
  449.                       "USAGE: %s %s (vector component (%d, %d) not a valid float)", 
  450.                       argv[0], my_args, j, i);
  451.               Tcl_AppendResult(interp, errBuf, (char *)NULL);
  452.               free(knots);
  453.               free(retVector); 
  454.              return TCL_ERROR;
  455.            }
  456.            *knotPtr++ = (float)dKnot;
  457.         }
  458.         retVector[i] = spline(u, nKnots, knots);
  459.      }
  460.  
  461.      for (i = 0; i < rank; i++)
  462.      {  sprintf(errBuf, "%f ", retVector[i]);
  463.         Tcl_AppendElement(interp, errBuf);
  464.      }
  465.   }
  466.   else  // should also allow non-list version...
  467.   {}
  468.  
  469.   return TCL_OK;
  470. }
  471.  
  472.  
  473.  
  474. // registerSampleGenerator
  475. static int
  476. cmd_registerSampleGenerator(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  477. {
  478.   char    *my_args = "sampleGeneratorName weight";
  479.  
  480.  
  481.   if (argc != 3)
  482.   {  sprintf(errBuf, "USAGE: %s %s", argv[0], my_args);
  483.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  484.      return TCL_ERROR;
  485.   }
  486.  
  487.   if (![me registerCurrentSampleGeneratorName:(const char *)argv[1] weight:(float)atof(argv[2])])
  488.   {  sprintf(errBuf, "unable to register sample generator %s with a weight of %f", argv[1], (float)atof(argv[2]));
  489.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  490.      return TCL_ERROR;
  491.   }
  492.  
  493.   return TCL_OK;
  494. }
  495.  
  496.  
  497. // sampleSet
  498. static int
  499. cmd_setSample(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  500. {
  501.   char    *my_args = "varName [newValue sampleGeneratorName]";
  502.   char    *varValue;
  503.  
  504.  
  505.   if ((argc != 2) && (argc != 4))
  506.   {  sprintf(errBuf, "USAGE: %s %s", argv[0], my_args);
  507.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  508.      return TCL_ERROR;
  509.   }
  510.  
  511.   if (argc == 2)
  512.   {  varValue = [me getVar:argv[1]];
  513.      if (!varValue)
  514.      {  sprintf(errBuf, "can't read \"%s\": no such variable", argv[1]);
  515.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  516.         return TCL_ERROR;
  517.      }     
  518.      Tcl_AppendResult(interp, varValue, (char *)NULL);
  519.      return TCL_OK;
  520.   }
  521.  
  522.   [me setCurrentSampleGeneratorName:argv[3]];
  523.   varValue = [me setVar:argv[1] toValue:argv[2]];
  524.   if (!varValue)
  525.   {  sprintf(errBuf, "couldn't set \"%s\" to \"%s\"", argv[1], argv[2]);
  526.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  527.      [me setCurrentSampleGeneratorName:NULL];
  528.      return TCL_ERROR;
  529.   }     
  530.   Tcl_AppendResult(interp, varValue, (char *)NULL);
  531.  
  532.   [me setCurrentSampleGeneratorName:NULL];
  533.   return TCL_OK;
  534. }
  535.  
  536.  
  537.  
  538. ///////////////////////////////
  539. ///// type functions //////////
  540. ///////////////////////////////
  541. static char 
  542. *WriteProcForPI(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
  543. {
  544.   return "PI is an eve-specific read-only variable";
  545. }
  546.  
  547.  
  548. #if 0
  549. static char 
  550. *WriteProcForEnumVariable(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
  551. {
  552.   char  *varString;
  553.  
  554.  
  555.   // at this point, the new value of the variable has been written.  We need to make
  556.   // sure that the new value is okay.  If it is, great, we write the new value into
  557.   // the varTypeInfo object as the value.  If it isn't okay, we need to grab the old
  558.   // value from the varTypeInfo object and reset the value of the variable.
  559.  
  560.   varString = [[(WWTCLVarTrace *)clientData tclInterp] getVar2:name1 :name2];
  561.   if ([[(WWTCLVarTrace *)clientData datum] isThisAValidEnumValue:varString])
  562.   {  // this is a valid value; update varTypeInfo object and get out
  563.      [[(WWTCLVarTrace *)clientData datum] setValue:varString];
  564.      return NULL;
  565.   }
  566.   else
  567.   {  // value isn't valid; reset to old value and return error
  568.      [[(WWTCLVarTrace *)clientData tclInterp] setVar2:name1 :name2 toValue:(char *)[[(WWTCLVarTrace *)clientData datum] value]];
  569.      return "invalid value for enumerated string variable";
  570.   }
  571.   return NULL;
  572. }
  573.  
  574.  
  575. // the following routines extend tcl with some rudimentary typing, which is used in eve
  576. static int
  577. cmd_setEnum(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  578. {
  579.   char  *my_args = "varName [initialValue] [list-of-possible-values]";
  580.   id    varTypeInfo;
  581.   char  **argv2;
  582.   int   argc2, i;
  583.  
  584.  
  585.   if ((argc != 2) && (argc != 4))
  586.   {  sprintf(errBuf, "USAGE: %s %s", argv[0], my_args);
  587.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  588.      return TCL_ERROR;
  589.   }
  590.  
  591.   // if there is only two arguments, return the enumeration list of the arg
  592.   // if it doesn't already exist, we need to return an error
  593.   // probably should have a hash Table of the various variables, right?
  594.   if (argc == 2)
  595.   {  // they just want to know the value, not set it
  596.      if (![me enumExists:argv[1]]) 
  597.      {  sprintf(errBuf, "can't read \"%s\": no such enumerated variable", argv[0]);
  598.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  599.         return TCL_ERROR;
  600.      }
  601.  
  602.      // okay, the variable does exist as an enumerated value
  603.      // we want to return 
  604.  
  605.      return TCL_OK;
  606.   }
  607.  
  608.  
  609.   // the first thing to do is unset this variable so that if any unset 
  610.   // traces need to be run, they will be.
  611.   [me unsetVar:argv[1]];
  612.   
  613.   // otherwise, check to see if there is an enum for this named variable
  614.   // already, throw it away, and generate a new one.
  615.  
  616.   // this routine is pretty cool.  It constrains the values of the
  617.   // named variable to be ones matching the list of list.  What's neat is
  618.   // that any given element of that list can be a "regular expression".
  619.   // All writes to this variable will checked against this new value.
  620.  
  621.  
  622.   // actually, it shouldn't just alloc one up, it should ask the interp
  623.   // for it, so the interp can see if it already has one...
  624.  
  625.   varTypeInfo = [[EveVarTypeInfo alloc] initForVar:argv[1] withInterp:me];
  626.   [me addVarTypeInfo:varTypeInfo];
  627.   [varTypeInfo setTypeEnum];
  628.   Tcl_SplitList(interp, argv[2], &argc2, &argv2);
  629.   for (i = 0; i < argc2; i++)
  630.   {  [varTypeInfo addEnum:argv2[i]];
  631.   }
  632.  
  633.   // need to set up a write trace for this variable, handing in the id
  634.   // of the varTypeInfo object.  In this routine, a message needs to get
  635.   // sent to the varTypeInfo with the value of the new value.  If it's
  636.   // okay, the varTypeInfo object will return YES.  If it's not, it will
  637.   // return NO.  At this point, if the new value is okay, the varTypeInfo
  638.   // object should get sent a message setting the value to be that; otherwise
  639.   // the old value should be gotten from there and the new value should be
  640.   // set.
  641.   [me traceWritesOn:argv[1] andCall:(Tcl_VarTraceProc *)WriteProcForEnumVariable usingData:(ClientData)varTypeInfo];
  642.  
  643.   return TCL_OK;
  644. }
  645.  
  646.  
  647. static char 
  648. *WriteProcForFloatVariable(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
  649. {
  650.   char  *varString;
  651.  
  652.  
  653.   // at this point, the new value of the variable has been written.  We need to make
  654.   // sure that the new value is okay.  If it is, great, we write the new value into
  655.   // the varTypeInfo object as the value.  If it isn't okay, we need to grab the old
  656.   // value from the varTypeInfo object and reset the value of the variable.
  657.  
  658.   varString = [[(WWTCLVarTrace *)clientData tclInterp] getVar2:name1 :name2];
  659.   if ([[(WWTCLVarTrace *)clientData datum] isThisAValidEnumValue:varString])
  660.   {  // this is a valid value; update varTypeInfo object and get out
  661.      [[(WWTCLVarTrace *)clientData datum] setValue:varString];
  662.      return NULL;
  663.   }
  664.   else
  665.   {  // value isn't valid; reset to old value and return error
  666.      [[(WWTCLVarTrace *)clientData tclInterp] setVar2:name1 :name2 toValue:(char *)[[(WWTCLVarTrace *)clientData datum] value]];
  667.      return "invalid value for enumerated string variable";
  668.   }
  669.   return NULL;
  670. }
  671.  
  672. // the following routines extend tcl with some rudimentary typing, which is used in eve
  673. static int
  674. cmd_setFloatMinMax(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  675. {
  676.   char  *my_args = "varName [initialFloatValue] [floatMinValue floatMaxValue]";
  677.   id    varTypeInfo;
  678.   char  **argv2;
  679.   int   argc2, i;
  680.  
  681.  
  682.   if ((argc != 2) && (argc != 3) && (argc != 5))
  683.   {  sprintf(errBuf, "USAGE: %s %s", argv[0], my_args);
  684.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  685.      return TCL_ERROR;
  686.   }
  687.   // if there is only two arguments, return the value, min, and max of the variable
  688.   // if it doesn't already exist, we need to return an error
  689.   // probably should have a hash Table of the various variables, right?
  690.   if (argc == 2)
  691.   {  // they just want to know the value, not set it
  692.      if (![me floatMinMaxExists:argv[1]]) 
  693.      {  sprintf(errBuf, "can't read \"%s\": no such minMax constrained float variable", argv[0]);
  694.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  695.         return TCL_ERROR;
  696.      }
  697.  
  698.      // okay, the variable does exist as a min/max float
  699.      // we want to return cons up the current value, min, and max
  700.  
  701.      return TCL_OK;
  702.   }
  703.  
  704.  
  705.   if (argc == 3)  // new value
  706.   {  // they just want to set a new value, not define a new one
  707.      if (![me floatMinMaxExists:argv[1]]) 
  708.      {  sprintf(errBuf, "can't read \"%s\": no such minMax constrained float variable", argv[0]);
  709.         Tcl_AppendResult(interp, errBuf, (char *)NULL);
  710.         return TCL_ERROR;
  711.      }
  712.  
  713.      // okay, the variable does exist as a min/max float
  714.      // we want to just set the new value and then return it.
  715.      // we let the variable tracing routines check the bounds
  716.      return [me setVar:argv[1] toValue:argv[2]];
  717.   }
  718.  
  719.  
  720.   // the first thing to do is unset this variable so that if any unset 
  721.   // traces need to be run, they will be.
  722.   [me unsetVar:argv[1]];
  723.   
  724.   // otherwise, check to see if there is an enum for this named variable
  725.   // already, throw it away, and generate a new one.
  726.  
  727.  
  728.   return TCL_OK;
  729. }
  730. #endif
  731.  
  732. static char 
  733. *WriteProcForReadOnly(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
  734. {
  735.   return "this is a read-only variable";
  736. }
  737.  
  738.  
  739. // the following routines extend tcl with some rudimentary typing, which is used in eve
  740. static int
  741. cmd_setReadOnly(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  742. {
  743.   char  *my_args = "readOnlyVarName value";
  744.  
  745.  
  746.   if (argc != 3)
  747.   {  sprintf(errBuf, "USAGE: %s %s", argv[0], my_args);
  748.      Tcl_AppendResult(interp, errBuf, (char *)NULL);
  749.      return TCL_ERROR;
  750.   }
  751.  
  752.   // the first thing to do is unset this variable so that if any unset 
  753.   // traces need to be run, they will be.
  754.   [me unsetVar:argv[1]];
  755.   [me setVar:argv[1] toValue:argv[2]];
  756.   [me traceWritesOn:argv[1] andCall:(Tcl_VarTraceProc *)WriteProcForReadOnly usingData:(ClientData)me];
  757.  
  758.   // need to add it to the wwVarList, so we know that it's special...
  759.  
  760.  
  761.   return TCL_OK;
  762. }
  763.  
  764. static int
  765. cmd_noop(WWInterp *me, Tcl_Interp *interp, int argc, char **argv)
  766. {
  767.   return TCL_OK;
  768. }
  769.  
  770.  
  771.  
  772. - (char *)setVar:(char *)variableName toReadOnlyValue:(char *)newValue
  773. {
  774.   char  *ret;
  775.  
  776.  
  777.   [self unsetVar:variableName];
  778.   ret = [self setVar:variableName toValue:newValue];
  779.   [self traceWritesOn:variableName andCall:(Tcl_VarTraceProc *)WriteProcForReadOnly usingData:(ClientData)nil];
  780.   return ret;
  781. }
  782.  
  783.  
  784.  
  785. - (char *)setVar2:(char *)variableName1 :(char *)variableName2 toReadOnlyValue:(char *)newValue
  786. {
  787.   char  *ret;
  788.  
  789.  
  790.   [self unsetVar2:variableName1 :variableName2];
  791.   ret = [self setVar2:variableName1 :variableName2 toValue:newValue];
  792.   [self traceWritesOn2:variableName1 :variableName2 andCall:(Tcl_VarTraceProc *)WriteProcForReadOnly usingData:(ClientData)nil];
  793.   return ret;
  794. }
  795.  
  796.  
  797. //////////////////////////////////////////////
  798. ////// okay, on to the instance methods //////
  799. //////////////////////////////////////////////
  800.  
  801. - setupInterp
  802. {
  803.   int            i, howMany, numArgs;
  804.   Tcl_ValueType  argTypes[10];
  805.   char           *valAsString, *varName;
  806.  
  807.  
  808.   if (interpSetup)
  809.   {  return self;
  810.   }
  811.  
  812.   valAsString = (char *)NXZoneCalloc([self zone], 256, sizeof(char));
  813.   varName = (char *)NXZoneCalloc([self zone], 256, sizeof(char));
  814.  
  815.   // add the new functions to do variable typing, including their trace functions
  816.   //[self addCommand:"setEnum" :(Tcl_CmdProc *)cmd_setEnum :self];
  817.  
  818.   [self addCommand:"setReadOnly" :(Tcl_CmdProc *)cmd_setReadOnly :self];
  819.   [self addCommand:"spline" :(Tcl_CmdProc *)cmd_spline :self];
  820.   [self addCommand:"setSample" :(Tcl_CmdProc *)cmd_setSample :self];
  821.   [self addCommand:"sSet" :(Tcl_CmdProc *)cmd_setSample :self];
  822.   [self addCommand:"setS" :(Tcl_CmdProc *)cmd_setSample :self];
  823.   [self addCommand:"sS" :(Tcl_CmdProc *)cmd_setSample :self];
  824.   [self addCommand:"registerSampleGenerator" :(Tcl_CmdProc *)cmd_registerSampleGenerator :self];
  825.   [self addCommand:"sampleGeneratorIsExecuting" :(Tcl_CmdProc *)cmd_noop :self]; // need to make this do something, pal!
  826.  
  827.   // now add in the new expr math functions
  828.   // pi()
  829.   numArgs = 0;
  830.   [self createMathFunc:"pi" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  831.         proc:(Tcl_MathProc *)exprCmd_pi clientData:(ClientData)self]; 
  832.   // radians(a)
  833.   numArgs = 1;
  834.   argTypes[0] = TCL_DOUBLE;
  835.   [self createMathFunc:"radians" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  836.         proc:(Tcl_MathProc *)exprCmd_radians clientData:(ClientData)self]; 
  837.   // degrees(a)
  838.   numArgs = 1;
  839.   argTypes[0] = TCL_DOUBLE;
  840.   [self createMathFunc:"degrees" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  841.         proc:(Tcl_MathProc *)exprCmd_degrees clientData:(ClientData)self]; 
  842.   // sign(a)
  843.   numArgs = 1;
  844.   argTypes[0] = TCL_EITHER;
  845.   [self createMathFunc:"sign" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  846.         proc:(Tcl_MathProc *)exprCmd_sign clientData:(ClientData)self]; 
  847.   // min(a, b)
  848.   numArgs = 2;
  849.   argTypes[0] = TCL_EITHER;
  850.   argTypes[1] = TCL_EITHER;
  851.   [self createMathFunc:"min" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  852.         proc:(Tcl_MathProc *)exprCmd_min clientData:(ClientData)self]; 
  853.   // max(a, b)
  854.   numArgs = 2;
  855.   argTypes[0] = TCL_EITHER;
  856.   argTypes[1] = TCL_EITHER;
  857.   [self createMathFunc:"max" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  858.         proc:(Tcl_MathProc *)exprCmd_max clientData:(ClientData)self]; 
  859.   // clamp(a, min, max)
  860.   numArgs = 3;
  861.   argTypes[0] = TCL_DOUBLE;
  862.   argTypes[1] = TCL_DOUBLE;
  863.   argTypes[2] = TCL_DOUBLE;
  864.   [self createMathFunc:"clamp" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  865.         proc:(Tcl_MathProc *)exprCmd_clamp clientData:(ClientData)self]; 
  866.   // step(min, value)
  867.   numArgs = 2;
  868.   argTypes[0] = TCL_DOUBLE;
  869.   argTypes[1] = TCL_DOUBLE;
  870.   [self createMathFunc:"step" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  871.         proc:(Tcl_MathProc *)exprCmd_step clientData:(ClientData)self]; 
  872.  
  873.   // spline(u, pt0, pt1, pt2, pt3)
  874.   numArgs = 5;
  875.   argTypes[0] = TCL_DOUBLE;
  876.   argTypes[1] = TCL_DOUBLE;
  877.   argTypes[2] = TCL_DOUBLE;
  878.   argTypes[3] = TCL_DOUBLE;
  879.   argTypes[4] = TCL_DOUBLE;
  880.   [self createMathFunc:"spline" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  881.         proc:(Tcl_MathProc *)exprCmd_spline clientData:(ClientData)self]; 
  882.   // smoothstep(min, max, value)
  883.   numArgs = 3;
  884.   argTypes[0] = TCL_DOUBLE;
  885.   argTypes[1] = TCL_DOUBLE;
  886.   argTypes[2] = TCL_DOUBLE;
  887.   [self createMathFunc:"smoothstep" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  888.         proc:(Tcl_MathProc *)exprCmd_smoothstep clientData:(ClientData)self]; 
  889.  
  890.   // lerpDown(u, min, max)
  891.   numArgs = 3;
  892.   argTypes[0] = TCL_DOUBLE;
  893.   argTypes[1] = TCL_DOUBLE;
  894.   argTypes[2] = TCL_DOUBLE;
  895.   [self createMathFunc:"lerpDown" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  896.         proc:(Tcl_MathProc *)exprCmd_lerpDown clientData:(ClientData)self]; 
  897.  
  898.   // lerpUp(u, min, max)
  899.   numArgs = 3;
  900.   argTypes[0] = TCL_DOUBLE;
  901.   argTypes[1] = TCL_DOUBLE;
  902.   argTypes[2] = TCL_DOUBLE;
  903.   [self createMathFunc:"lerpUp" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  904.         proc:(Tcl_MathProc *)exprCmd_lerpUp clientData:(ClientData)self]; 
  905.  
  906.   // noise(x, y, z)
  907.   numArgs = 3;
  908.   argTypes[0] = TCL_DOUBLE;
  909.   argTypes[1] = TCL_DOUBLE;
  910.   argTypes[2] = TCL_DOUBLE;
  911.   [self createMathFunc:"noise" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  912.         proc:(Tcl_MathProc *)exprCmd_noise clientData:(ClientData)self]; 
  913.  
  914.   // gvnoise(x, y, z)
  915.   numArgs = 3;
  916.   argTypes[0] = TCL_DOUBLE;
  917.   argTypes[1] = TCL_DOUBLE;
  918.   argTypes[2] = TCL_DOUBLE;
  919.   [self createMathFunc:"gvnoise" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  920.         proc:(Tcl_MathProc *)exprCmd_gvnoise clientData:(ClientData)self]; 
  921.  
  922.   // scnoise(x, y, z)
  923.   numArgs = 3;
  924.   argTypes[0] = TCL_DOUBLE;
  925.   argTypes[1] = TCL_DOUBLE;
  926.   argTypes[2] = TCL_DOUBLE;
  927.   [self createMathFunc:"scnoise" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  928.         proc:(Tcl_MathProc *)exprCmd_scnoise clientData:(ClientData)self]; 
  929.  
  930.   // vnoise(x, y, z)
  931.   numArgs = 3;
  932.   argTypes[0] = TCL_DOUBLE;
  933.   argTypes[1] = TCL_DOUBLE;
  934.   argTypes[2] = TCL_DOUBLE;
  935.   [self createMathFunc:"vnoise" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  936.         proc:(Tcl_MathProc *)exprCmd_vnoise clientData:(ClientData)self]; 
  937.  
  938.   // vcnoise(x, y, z)
  939.   numArgs = 3;
  940.   argTypes[0] = TCL_DOUBLE;
  941.   argTypes[1] = TCL_DOUBLE;
  942.   argTypes[2] = TCL_DOUBLE;
  943.   [self createMathFunc:"vcnoise" numArgs:numArgs argTypes:(Tcl_ValueType *)argTypes 
  944.         proc:(Tcl_MathProc *)exprCmd_vcnoise clientData:(ClientData)self]; 
  945.  
  946.   // now put any read only constants into the environment (like PI)
  947.   strcpy(varName, "PI");
  948.   sprintf(valAsString, "%f", PI); // turn the value into its tcl equivalent
  949.   [self setVar:varName toValue:valAsString];
  950.   [self traceWritesOn:varName andCall:(Tcl_VarTraceProc *)WriteProcForPI usingData:(ClientData)self];
  951.   // wave NOTE: need to make this un-unsettable with an unset trace...
  952.  
  953.  
  954.   // need to grovel over the typed variables and reset the traces.
  955.   howMany = [wwVarList count];
  956.   for (i = 0; i < howMany; i++)
  957.   {  // for each variable, reset the traces appropriately
  958.      // I really should have probably done this in read:
  959.      NXLogError("wave is lame\n");
  960.   }
  961.  
  962.   interpSetup = YES;
  963.  
  964.   NXZoneFree([self zone], valAsString);
  965.   NXZoneFree([self zone], varName);
  966.  
  967.   return self;
  968. }
  969.  
  970.  
  971. - init
  972. {
  973.   [super init];
  974.  
  975.   wwVarList = [[List alloc] init];
  976.   interpSetup = NO;
  977.  
  978.   [self setupInterp];
  979.  
  980.   return self;
  981. }
  982.  
  983.  
  984. - awake
  985. {
  986.   [super awake];
  987.  
  988.   interpSetup = NO;
  989.  
  990.   [self setupInterp];
  991.  
  992.   return self;
  993. }
  994.  
  995.  
  996. - setRunTime:obj { runTime = obj; return self; }
  997.  
  998. - registerCurrentSampleGeneratorName:(const char *)newCurrentSampleGeneratorName weight:(float)weight  
  999. { 
  1000.    return [runTime registerCurrentSampleGeneratorName:newCurrentSampleGeneratorName weight:weight];
  1001. }  
  1002.  
  1003.  
  1004. - setCurrentSampleGeneratorName:(const char *)newCurrentSampleGeneratorName
  1005. {
  1006.    return [runTime setCurrentSampleGeneratorName:newCurrentSampleGeneratorName];
  1007. }
  1008.  
  1009. - addVarTypeInfo:newVarTypeInfo
  1010. {
  1011.   [wwVarList addObject:newVarTypeInfo];
  1012.   return self;
  1013. }
  1014.  
  1015. - (BOOL)enumExists:(const char *)enumVarName
  1016. {
  1017.   // this method gets called when defining a new enumerated string value
  1018.   // the idea is to check and see if an enumerated variable for this
  1019.   // guy already exists.  Note this routine doesn't check to see if
  1020.   // there is any other type of variable already defined that has
  1021.   // this name
  1022.  
  1023.   return YES;
  1024. }
  1025.  
  1026. - (int)unsetVar:(char *)variableName 
  1027. {
  1028.   // first need to check and see if this variable is "special".  
  1029.   // If so, do the appropriate activity to get rid of it.
  1030.  
  1031.   return [super unsetVar:variableName];
  1032. }
  1033.  
  1034.  
  1035. // we need to deal with a few extra things here...
  1036. // need to think about "sets" that happened in the context of a EveCmd
  1037. // need to deal with typed variables (which, in a sense, a set inside an EveCmd is)
  1038.  
  1039. - writeState:(NXStream *)stream 
  1040. {
  1041.    int          i, j, argc, argc2, ret, cnt;
  1042.    char         **argv, **argv2, *varNameList, *procNameList, *aCmd, *varValue, *arrayElementList, *arrayName;
  1043.    Tcl_DString  setCmd, infoCmd, procCmd, arrayElementCmd;
  1044.    BOOL         skip;
  1045.  
  1046.  
  1047.    // at this point, we need to suck out the names and values of all
  1048.    // the global variables in the tcl interp.  Then we need to get 
  1049.    // the names, args, and bodies of all the procs that have been 
  1050.    // defined.  We write these out, and then when we do a read:, 
  1051.    // we shove those back into the interp.
  1052.  
  1053.    // okay, so first we send "info globals" to the interp.  
  1054.    // We'll get back a string which we'll do a Tcl_SplitList on.
  1055.    // we'll write out the argc of that list to the stream.
  1056.    // for each element in the string, we'll stick "set " in front of it 
  1057.    // and evaluate it.  We'll then save the string "set <variable> <value>"
  1058.    // out to the stream.
  1059.  
  1060.    // we'll then send "info procs" to the interp.
  1061.    // We'll get back a string which we'll do a Tcl_SplitList on.
  1062.    // we'll write out the argc of that list to the stream.
  1063.    // for each element in the string, we'll call that element "procName"
  1064.    // for each procName, we'll then send "info args <procName>" and call the
  1065.    // result "procArgs",  we'll then send "info body <procName>" and call the
  1066.    // the result "procBody",
  1067.    // we'll then sprintf into a string variable: 
  1068.    // sprintf(procDef, "proc %s {%s} {%s}", procName, procArgs, procBody);
  1069.    // and save "procDef" out to the stream
  1070.  
  1071.    ret = Tcl_GlobalEval(interp, "info globals"); 
  1072.    if (ret != TCL_OK)
  1073.    {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <info globals> yielded <%s>)\n", 
  1074.              interp->result);
  1075.       [self showError:interp->result];
  1076.       varNameList = NXCopyStringBuffer("");
  1077.    }
  1078.    else
  1079.    {  varNameList = NXCopyStringBuffer(interp->result); 
  1080.    }
  1081.    Tcl_ResetResult(interp); 
  1082.  
  1083.    argc = 0;
  1084.    argv = NULL;
  1085.    Tcl_SplitList(interp, varNameList, &argc, &argv);
  1086.    Tcl_ResetResult(interp); 
  1087.  
  1088.    cnt = 0;
  1089.    for (i = 0; i < argc; i++)
  1090.    {  skip = NO;
  1091.       if (!strcmp(argv[i], "env")) {  skip = YES;  }
  1092.       if (!strcmp(argv[i], "PI")) {  skip = YES;  }
  1093.       if (!strcmp(argv[i], "ticksPerSecond")) {  skip = YES;  }
  1094.       if (!strcmp(argv[i], "errorInfo")) {  skip = YES;  }
  1095.       if (!strcmp(argv[i], "scene")) {  skip = YES;  }
  1096.       if (!skip)
  1097.       {  varValue = Tcl_GetVar(interp, argv[i], TCL_GLOBAL_ONLY);
  1098.          if (varValue)
  1099.          {  cnt++; 
  1100.          }
  1101.          else
  1102.          {  Tcl_DStringInit(&arrayElementCmd);
  1103.             Tcl_DStringAppend(&arrayElementCmd, "array names ", -1);
  1104.             aCmd = Tcl_DStringAppend(&arrayElementCmd, argv[i], -1);
  1105.             ret = Tcl_GlobalEval(interp, aCmd);
  1106.             if (ret != TCL_OK)
  1107.             {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <%s> yielded <%s>)\n", 
  1108.                       aCmd, interp->result);
  1109.                [self showError:interp->result];
  1110.                arrayElementList = NXCopyStringBuffer("");
  1111.             }
  1112.             else
  1113.             {  arrayElementList = NXCopyStringBuffer(interp->result); 
  1114.             }
  1115.             Tcl_ResetResult(interp); 
  1116.             argc2 = 0;
  1117.             argv2 = NULL;
  1118.             Tcl_SplitList(interp, arrayElementList, &argc2, &argv2);
  1119.             for (j = 0; j < argc2; j++)
  1120.             {  cnt++;
  1121.             }
  1122.             Tcl_ResetResult(interp); 
  1123.             if (argv2) {  free(argv2); }
  1124.             free(arrayElementList);  // it was malloc'ed either way
  1125.          }
  1126.       }
  1127.    }
  1128.    free(varNameList);
  1129.    varNameList = NULL;
  1130.  
  1131.    // we now check to see if these strings are going to put us over the limit
  1132.    // on our tmp string array.  If they will, realloc.
  1133.    while ((tmpStringIndex + cnt) > tmpStringc)
  1134.    {  tmpStringc *= 2;
  1135.       tmpStringv = (char **)NXZoneRealloc([self zone], tmpStringv, (sizeof(char *) * tmpStringc));
  1136.    }
  1137.  
  1138.    NXPrintf(stream, "# Writing out all the current values of the global variables:\n");
  1139.    for (i = 0; i < argc; i++)
  1140.    {  skip = NO;
  1141.       if (!strcmp(argv[i], "env")) {  skip = YES;  }
  1142.       if (!strcmp(argv[i], "PI")) {  skip = YES;  }
  1143.       if (!strcmp(argv[i], "ticksPerSecond")) {  skip = YES;  }
  1144.       if (!strcmp(argv[i], "errorInfo")) {  skip = YES;  }
  1145.       if (!strcmp(argv[i], "scene")) {  skip = YES;  }
  1146.       if (!skip)
  1147.       {  Tcl_DStringInit(&setCmd);
  1148.          Tcl_DStringAppend(&setCmd, "set ", -1);
  1149.          Tcl_DStringAppend(&setCmd, argv[i], -1);
  1150.          varValue = Tcl_GetVar(interp, argv[i], TCL_GLOBAL_ONLY);
  1151.          if (varValue)
  1152.          {  Tcl_DStringAppend(&setCmd, " {", -1);
  1153.             Tcl_DStringAppend(&setCmd, varValue, -1);
  1154.             aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer(Tcl_DStringAppend(&setCmd, "}", -1));
  1155.             NXPrintf(stream, "%s;\n", aCmd);
  1156.             Tcl_DStringFree(&setCmd);
  1157.          }
  1158.          else
  1159.          {  // if we failed to get a value for the var, it must be an array.
  1160.             // need to find out how many elements there are and save out each one.
  1161.             // eval "array names <var>", do a split list on it, etc.
  1162.    
  1163.             Tcl_DStringInit(&arrayElementCmd);
  1164.             Tcl_DStringAppend(&arrayElementCmd, "array names ", -1);
  1165.             aCmd = Tcl_DStringAppend(&arrayElementCmd, argv[i], -1);
  1166.             ret = Tcl_GlobalEval(interp, aCmd);
  1167.             if (ret != TCL_OK)
  1168.             {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <%s> yielded <%s>)\n", 
  1169.                       aCmd, interp->result);
  1170.                [self showError:interp->result];
  1171.                arrayElementList = NXCopyStringBuffer(""); 
  1172.             }
  1173.             else
  1174.             {   arrayElementList = NXCopyStringBuffer(interp->result); 
  1175.             }
  1176.             Tcl_ResetResult(interp); 
  1177.    
  1178.             arrayName = NXCopyStringBuffer(Tcl_DStringAppend(&setCmd, "", 0));
  1179.             argc2 = 0;
  1180.             argv2 = NULL;
  1181.             Tcl_SplitList(interp, arrayElementList, &argc2, &argv2);
  1182.             for (j = 0; j < argc2; j++)
  1183.             {  // need to join the current 
  1184.                Tcl_DStringInit(&setCmd);
  1185.                Tcl_DStringAppend(&setCmd, arrayName, -1);
  1186.                Tcl_DStringAppend(&setCmd, "(", -1);
  1187.                Tcl_DStringAppend(&setCmd, argv2[j], -1);
  1188.                aCmd = Tcl_DStringAppend(&setCmd, ")", -1);
  1189.                ret = Tcl_GlobalEval(interp, aCmd);
  1190.                if (ret != TCL_OK)
  1191.                {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <%s> yielded <%s>)\n", 
  1192.                          aCmd, interp->result);
  1193.                   [self showError:interp->result];
  1194.                   aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer("BAD VALUE");
  1195.                }
  1196.                else
  1197.                {  Tcl_DStringAppend(&setCmd, " {", -1);
  1198.                   Tcl_DStringAppend(&setCmd, interp->result, -1);
  1199.                   aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer(Tcl_DStringAppend(&setCmd, "}", -1));
  1200.                }
  1201.                Tcl_ResetResult(interp); 
  1202.    
  1203.                NXPrintf(stream, "%s;\n", aCmd);
  1204.                Tcl_DStringFree(&setCmd);
  1205.             }
  1206.             if (arrayName)  {  free(arrayName); }
  1207.          }
  1208.       }
  1209.    }
  1210.    if (argv) {  free(argv); }
  1211.    NXPrintf(stream, "# end of globals\n");
  1212.  
  1213.    NXPrintf(stream, "# Writing out all the current definitions of all the non built-in procs:\n");
  1214.    ret = Tcl_GlobalEval(interp, "info procs"); 
  1215.    if (ret != TCL_OK)
  1216.    {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <info procs> yielded <%s>)\n", 
  1217.              interp->result);
  1218.       [self showError:interp->result];
  1219.    }
  1220.    procNameList = NXCopyStringBuffer(interp->result); 
  1221.    Tcl_ResetResult(interp); 
  1222.  
  1223.    Tcl_SplitList(interp, procNameList, &argc, &argv);
  1224.  
  1225.    // we now check to see if these strings are going to put us over the limit
  1226.    // on our tmp string array.  If they will, realloc.
  1227.    while ((tmpStringIndex + cnt) > tmpStringc)
  1228.    {  tmpStringc *= 2;
  1229.       tmpStringv = (char **)NXZoneRealloc([self zone], tmpStringv, (sizeof(char *) * tmpStringc));
  1230.    }
  1231.  
  1232.    for (i = 0; i < argc; i++)
  1233.    {  Tcl_DStringInit(&procCmd);
  1234.       Tcl_DStringAppend(&procCmd, "proc ", -1);
  1235.       Tcl_DStringAppend(&procCmd, argv[i], -1);
  1236.       Tcl_DStringAppend(&procCmd, " { ", -1);
  1237.  
  1238.       Tcl_DStringInit(&infoCmd);
  1239.       Tcl_DStringAppend(&infoCmd, "info args ", -1);
  1240.       aCmd = Tcl_DStringAppend(&infoCmd, argv[i], -1);
  1241.       ret = Tcl_GlobalEval(interp, aCmd);
  1242.       if (ret != TCL_OK)
  1243.       {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <%s> yielded <%s>)\n", 
  1244.                 aCmd, interp->result);
  1245.          [self showError:interp->result];
  1246.          Tcl_ResetResult(interp); 
  1247.          aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer(Tcl_DStringAppend(&procCmd, 
  1248.                                                                                     "} {echo {this proc had bad args\\n} }", -1));
  1249.       }
  1250.       else
  1251.       {  Tcl_DStringAppend(&procCmd, interp->result, -1);
  1252.          Tcl_DStringAppend(&procCmd, " } { ", -1);
  1253.          Tcl_ResetResult(interp); 
  1254.          Tcl_DStringFree(&infoCmd);
  1255.  
  1256.          Tcl_DStringInit(&infoCmd);
  1257.          Tcl_DStringAppend(&infoCmd, "info body ", -1);
  1258.          aCmd = Tcl_DStringAppend(&infoCmd, argv[i], -1);
  1259.          ret = Tcl_GlobalEval(interp, aCmd);
  1260.          if (ret != TCL_OK)
  1261.          {  NXLogError("Yikes! problem in WWTCLInterp's write: (evaluating <%s> yielded <%s>)\n", 
  1262.                       aCmd, interp->result);
  1263.             [self showError:interp->result];
  1264.             aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer(Tcl_DStringAppend(&procCmd, 
  1265.                                                                                     "echo {this proc had a bad body\\n} }", -1));
  1266.          }
  1267.          else
  1268.          {  Tcl_DStringAppend(&procCmd, interp->result, -1);
  1269.             Tcl_DStringFree(&infoCmd);
  1270.  
  1271.             aCmd = tmpStringv[tmpStringIndex++] = NXCopyStringBuffer(Tcl_DStringAppend(&procCmd, " }", -1));
  1272.          }
  1273.          Tcl_ResetResult(interp); 
  1274.       }
  1275.       //NXLogError("writing out: <%s> at address %d\n", aCmd, aCmd);
  1276.       NXPrintf(stream, "%s;\n", aCmd);
  1277.       Tcl_DStringFree(&procCmd);
  1278.  
  1279.    }
  1280.    NXPrintf(stream, "# end of procs\n");
  1281.    if (argv) {  free(argv); }
  1282.    if (procNameList) {  free(procNameList); }
  1283.  
  1284.    return self;
  1285. }
  1286.  
  1287. #define typeVector "@"
  1288. #define typeValues &wwVarList
  1289.  
  1290. - read:(NXTypedStream*)stream 
  1291. {
  1292.     int version;
  1293.     [super read:stream];
  1294. NX_DURING
  1295.     version = NXTypedStreamClassVersion(stream,"WWInterp");
  1296.     if (version == 0) NXReadTypes(stream,"i",&version), version=1;
  1297.     if (version == 1)
  1298.     {  NXReadTypes(stream, typeVector, typeValues);
  1299.     } 
  1300. NX_HANDLER
  1301.    NXLogError("in read: %s, exception [%d] raised.\n", 
  1302.                  [[self class] name], NXLocalHandler.code);
  1303.    return nil;
  1304. NX_ENDHANDLER
  1305.     return self;
  1306. }
  1307.  
  1308. - write:(NXTypedStream*)stream 
  1309. {
  1310.     [super write:stream];
  1311.  
  1312.     NXWriteTypes(stream, typeVector, typeValues);
  1313.  
  1314.     return self;
  1315. }
  1316.  
  1317.  
  1318. @end
  1319.