C++ SetpValue函数代码示例

/*********************************************************
  NAME         : SlotDefaultValue
  DESCRIPTION  : Determines the default value for
                 the specified slot of the specified class
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : TRUE if slot default value is set,
                 FALSE otherwise
  SIDE EFFECTS : Slot default value evaluated - dynamic
                 defaults will cause any side effects
  NOTES        : None
 *********************************************************/
globle intBool EnvSlotDefaultValue(
  void *theEnv,
  void *theDefclass,
  char *slotName,
  DATA_OBJECT_PTR theValue)
  {
   SLOT_DESC *sd;

   SetpType(theValue,SYMBOL);
   SetpValue(theValue,EnvFalseSymbol(theEnv));
   if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL)
     return(FALSE);
   
   if (sd->noDefault)
     {
      SetpType(theValue,SYMBOL);
      SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));
      return(TRUE); 
     }
     
   if (sd->dynamicDefault)
     return(EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,
                                         (EXPRESSION *) sd->defaultValue,
                                         theValue,TRUE));
   GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
   return(TRUE);
  }

	dataObject * value_to_data_object( const Environment& env, const Value & value )
	{
    void *p;
		dataObject* clipsdo = new dataObject;

    SetpType(clipsdo, value.type() );
    switch ( value.type() ) {
      case TYPE_SYMBOL:
      case TYPE_STRING:
      case TYPE_INSTANCE_NAME:
        p = EnvAddSymbol( env.cobj(),
                          const_cast<char*>( value.as_string().c_str())
                        );
        SetpValue(clipsdo, p);
        return clipsdo;
      case TYPE_INTEGER:
        p = EnvAddLong( env.cobj(), value.as_integer() );
        SetpValue(clipsdo, p);
        return clipsdo;
      case TYPE_FLOAT:
        p = EnvAddDouble( env.cobj(), value.as_float() );
        SetpValue(clipsdo, p);
        return clipsdo;
      case TYPE_EXTERNAL_ADDRESS:
        p = EnvAddExternalAddress( env.cobj(), value.as_address(), EXTERNAL_ADDRESS );
        SetpValue(clipsdo, p);
        return clipsdo;
      default:
        throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" );
    }

		return NULL;
	}

/**********************************************************************
  NAME         : SlotDefaultValueCommand
  DESCRIPTION  : Determines the default avlue for the specified slot
                 of the specified class
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (slot-default-value <class> <slot>)
 **********************************************************************/
globle void SlotDefaultValueCommand(
  void *theEnv,
  DATA_OBJECT_PTR theValue)
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;

   SetpType(theValue,SYMBOL);
   SetpValue(theValue,EnvFalseSymbol(theEnv));
   sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE);
   if (sd == NULL)
     return;
   
   if (sd->noDefault)
     {
      SetpType(theValue,SYMBOL);
      SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));
      return; 
     }
     
   if (sd->dynamicDefault)
     EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,
                                  (EXPRESSION *) sd->defaultValue,
                                  theValue,TRUE);
   else
     GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
  }

globle void EvalFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT theArg;

   /*=============================================*/
   /* Function eval expects exactly one argument. */
   /*=============================================*/

   if (EnvArgCountCheck(theEnv,"eval",EXACTLY,1) == -1)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      return;
     }

   /*==================================================*/
   /* The argument should be of type SYMBOL or STRING. */
   /*==================================================*/

   if (EnvArgTypeCheck(theEnv,"eval",1,SYMBOL_OR_STRING,&theArg) == FALSE)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      return;
     }

   /*======================*/
   /* Evaluate the string. */
   /*======================*/

   EnvEval(theEnv,DOToString(theArg),returnValue);
  }

globle void EnvFactSlotNames(
  void *theEnv,
  void *vTheFact,
  DATA_OBJECT *returnValue)
  {
   struct fact *theFact = (struct fact *) vTheFact;
   struct multifield *theList;
   struct templateSlot *theSlot;
   unsigned long count;

   /*===============================================*/
   /* If we're dealing with an implied deftemplate, */
   /* then the only slot names is "implied."        */
   /*===============================================*/

   if (theFact->whichDeftemplate->implied)
     {
      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,1);
      theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1);
      SetMFType(theList,1,SYMBOL);
      SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied"));
      SetpValue(returnValue,(void *) theList);
      return;
     }

   /*=================================*/
   /* Count the number of slot names. */
   /*=================================*/

   for (count = 0, theSlot = theFact->whichDeftemplate->slotList;
        theSlot != NULL;
        count++, theSlot = theSlot->next)
     { /* Do Nothing */ }

   /*=============================================================*/
   /* Create a multifield value in which to store the slot names. */
   /*=============================================================*/

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,(long) count);
   theList = (struct multifield *) EnvCreateMultifield(theEnv,count);
   SetpValue(returnValue,(void *) theList);

   /*===============================================*/
   /* Store the slot names in the multifield value. */
   /*===============================================*/

   for (count = 1, theSlot = theFact->whichDeftemplate->slotList;
        theSlot != NULL;
        count++, theSlot = theSlot->next)
     {
      SetMFType(theList,count,SYMBOL);
      SetMFValue(theList,count,theSlot->slotName);
     }
  }

globle void LowcaseFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT theArg;
   unsigned i;
   size_t slen;
   char *osptr, *nsptr;

   /*================================================*/
   /* Function lowcase expects exactly one argument. */
   /*================================================*/

   if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1)
     {
      SetpType(returnValue,STRING);
      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
      return;
     }

   /*==================================================*/
   /* The argument should be of type symbol or string. */
   /*==================================================*/

   if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE)
     {
      SetpType(returnValue,STRING);
      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
      return;
     }

   /*======================================================*/
   /* Allocate temporary memory and then copy the original */
   /* string or symbol to that memory, while lowercasing   */
   /* upper case alphabetic characters.                    */
   /*======================================================*/

   osptr = DOToString(theArg);
   slen = strlen(osptr) + 1;
   nsptr = (char *) gm2(theEnv,slen);

   for (i = 0  ; i < slen ; i++)
     {
      if (isupper(osptr[i]))
        { nsptr[i] = (char) tolower(osptr[i]); }
      else
        { nsptr[i] = osptr[i]; }
     }

   /*========================================*/
   /* Return the lowercased string and clean */
   /* up the temporary memory used.          */
   /*========================================*/

   SetpType(returnValue,GetType(theArg));
   SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr));
   rm(theEnv,nsptr,slen);
  }

globle void EnvGetFocusStack(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   struct focus *theFocus;
   struct multifield *theList;
   unsigned long count = 0;

   /*===========================================*/
   /* If there is no current focus, then return */
   /* a multifield value of length zero.        */
   /*===========================================*/

   if (EngineData(theEnv)->CurrentFocus == NULL)
     {
      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,0);
      SetpValue(returnValue,(void *) EnvCreateMultifield(theEnv,0L));
      return;
     }

   /*=====================================================*/
   /* Determine the number of modules on the focus stack. */
   /*=====================================================*/

   for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next)
     { count++; }

   /*=============================================*/
   /* Create a multifield of the appropriate size */
   /* in which to store the module names.         */
   /*=============================================*/

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,(long) count);
   theList = (struct multifield *) EnvCreateMultifield(theEnv,count);
   SetpValue(returnValue,(void *) theList);

   /*=================================================*/
   /* Store the module names in the multifield value. */
   /*=================================================*/

   for (theFocus = EngineData(theEnv)->CurrentFocus, count = 1;
        theFocus != NULL;
        theFocus = theFocus->next, count++)
     {
      SetMFType(theList,count,SYMBOL);
      SetMFValue(theList,count,theFocus->theModule->name);
     }
  }

static void SetErrorCaptureValues(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   struct multifield *theMultifield;

   theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,2L);

   if (ParseFunctionData(theEnv)->ErrorString != NULL)
     {
      SetMFType(theMultifield,1,STRING);
      SetMFValue(theMultifield,1,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->ErrorString));
     }
   else
     {
      SetMFType(theMultifield,1,SYMBOL);
      SetMFValue(theMultifield,1,EnvFalseSymbol(theEnv));
     }

   if (ParseFunctionData(theEnv)->WarningString != NULL)
     {
      SetMFType(theMultifield,2,STRING);
      SetMFValue(theMultifield,2,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->WarningString));
     }
   else
     {
      SetMFType(theMultifield,2,SYMBOL);
      SetMFValue(theMultifield,2,EnvFalseSymbol(theEnv));
     }

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,2);
   SetpValue(returnValue,(void *) theMultifield);
  }

static void SetErrorCaptureValues(
  DATA_OBJECT_PTR returnValue)
  {
   struct multifield *theMultifield;

   theMultifield = (struct multifield *) CreateMultifield(2L);

   if (ErrorString != NULL)
     {
      SetMFType(theMultifield,1,STRING);
      SetMFValue(theMultifield,1,AddSymbol(ErrorString));
     }
   else
     {
      SetMFType(theMultifield,1,SYMBOL);
      SetMFValue(theMultifield,1,FalseSymbol);
     }

   if (WarningString != NULL)
     {
      SetMFType(theMultifield,2,STRING);
      SetMFValue(theMultifield,2,AddSymbol(WarningString));
     }
   else
     {
      SetMFType(theMultifield,2,SYMBOL);
      SetMFValue(theMultifield,2,FalseSymbol);
     }

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,2);
   SetpValue(returnValue,(void *) theMultifield);
  }

globle void GetFunctionListFunction(
    void *theEnv,
    DATA_OBJECT *returnValue)
{
    struct FunctionDefinition *theFunction;
    struct multifield *theList;
    unsigned long functionCount = 0;

    if (EnvArgCountCheck(theEnv,"get-function-list",EXACTLY,0) == -1)
    {
        EnvSetMultifieldErrorValue(theEnv,returnValue);
        return;
    }

    for (theFunction = GetFunctionList(theEnv);
            theFunction != NULL;
            theFunction = theFunction->next)
    {
        functionCount++;
    }

    SetpType(returnValue,MULTIFIELD);
    SetpDOBegin(returnValue,1);
    SetpDOEnd(returnValue,functionCount);
    theList = (struct multifield *) EnvCreateMultifield(theEnv,functionCount);
    SetpValue(returnValue,(void *) theList);

    for (theFunction = GetFunctionList(theEnv), functionCount = 1;
            theFunction != NULL;
            theFunction = theFunction->next, functionCount++)
    {
        SetMFType(theList,functionCount,SYMBOL);
        SetMFValue(theList,functionCount,theFunction->callFunctionName);
    }
}

globle void CheckSyntaxFunction(
  DATA_OBJECT *returnValue)
  {
   DATA_OBJECT theArg;

   /*===============================*/
   /* Set up a default return value */
   /* (TRUE for problems found).    */
   /*===============================*/

   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,TrueSymbol);

   /*=====================================================*/
   /* Function check-syntax expects exactly one argument. */
   /*=====================================================*/

   if (ArgCountCheck("check-syntax",EXACTLY,1) == -1) return;

   /*========================================*/
   /* The argument should be of type STRING. */
   /*========================================*/

   if (ArgTypeCheck("check-syntax",1,STRING,&theArg) == FALSE)
     { return; }

   /*===================*/
   /* Check the syntax. */
   /*===================*/

   CheckSyntax(DOToString(theArg),returnValue);
  }

globle void EvalFunction(
  DATA_OBJECT_PTR returnValue)
  {
   PrintErrorID("STRNGFUN",1,FALSE);
   PrintRouter(WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,FalseSymbol);
  }

globle void CheckSyntaxFunction(
  void *theEnv,
  DATA_OBJECT *returnValue)
  {
   PrintErrorID(theEnv,"PARSEFUN",1,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Function check-syntax does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,EnvTrueSymbol(theEnv));
  }

/***********************************************************
  NAME         : DynamicHandlerPutSlot
  DESCRIPTION  : Directly puts a slot's value
                 (uses dynamic binding to lookup slot)
  INPUTS       : Data obejct buffer for holding slot value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Slot modified - and caller's buffer set
                 to value (or symbol FALSE on errors)
  NOTES        : H/L Syntax: (put <slot> <value>*)
 ***********************************************************/
globle void DynamicHandlerPutSlot(
  DATA_OBJECT *theResult)
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   theResult->type = SYMBOL;
   theResult->value = FalseSymbol;
   if (CheckCurrentMessage("dynamic-put",TRUE) == FALSE)
     return;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("dynamic-put",1,"symbol");
      SetEvaluationError(TRUE);
      return;
     }
   ins = GetActiveInstance();
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"dynamic-put");
      return;
     }
   if ((sp->desc->noWrite == 0) ? FALSE :
       ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress)))
     {
      SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
                               TRUE,(void *) ins);
      SetEvaluationError(TRUE);
      return;
     }
   if ((sp->desc->publicVisibility == 0) &&
       (CurrentCore->hnd->cls != sp->desc->cls))
     {
      SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
      SetEvaluationError(TRUE);
      return;
     }
   if (GetFirstArgument()->nextArg)
     {
      if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
                        GetFirstArgument()->nextArg,&temp) == FALSE)
        return;
     }
   else
     {
      SetpDOBegin(&temp,1);
      SetpDOEnd(&temp,0);
      SetpType(&temp,MULTIFIELD);
      SetpValue(&temp,NoParamValue);
     }
   PutSlotValue(ins,sp,&temp,theResult,NULL);
  }

extern "C" void GetCurrentlyPressedKeys(void* theEnv, DATA_OBJECT_PTR returnValue) {
   void* multifield;
   AdventureEngine::AdventureEngineEngine* engine = PullOutEngine(theEnv);
   Common::EventManager* _eventMan = engine->getEventManager();
   Common::Event keyEvent;
   //this function does generate side effects if we assert facts
   //However, if we return a multifield with all the contents then we need to
   //parse it....hmmmmmm, doing the multifield is easier
   //only check for a single key at this point
   while(_eventMan->pollEvent(keyEvent)) 
   {
      //let's do a simple test
      switch(keyEvent.type) {
         case Common::EVENT_KEYDOWN:
            switch(keyEvent.kbd.keycode) {
               case Common::KEYCODE_ESCAPE:
                  multifield = EnvCreateMultifield(theEnv, 1);
                  SetMFType(multifield, 1, SYMBOL);
                  SetMFValue(multifield, 1, EnvAddSymbol(theEnv, (char*)"escape"));
                  SetpType(returnValue, MULTIFIELD);
                  SetpValue(returnValue, multifield);
                  SetpDOBegin(returnValue, 1);
                  SetpDOEnd(returnValue, 1);
                  return;
               default:
                  multifield = EnvCreateMultifield(theEnv, 1);
                  SetMFType(multifield, 1, INTEGER);
                  SetMFValue(multifield, 1, EnvAddLong(theEnv, keyEvent.kbd.keycode));
                  SetpType(returnValue, MULTIFIELD);
                  SetpValue(returnValue, multifield);
                  SetpDOBegin(returnValue, 1);
                  SetpDOEnd(returnValue, 1);
                  return;
            }
         default:
            NullMultifield(theEnv, returnValue);
            return;
      }
   }
   NullMultifield(theEnv, returnValue);
}