Example #1
0
/*********************************************************
  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);
  }
Example #2
0
	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;
	}
Example #3
0
/**********************************************************************
  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);
  }
Example #4
0
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);
  }
Example #5
0
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);
     }
  }
Example #6
0
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);
  }
Example #7
0
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);
     }
  }
Example #8
0
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);
  }
Example #9
0
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);
  }
Example #10
0
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);
    }
}
Example #11
0
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);
  }
Example #12
0
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);
  }
Example #13
0
globle void CheckSyntaxFunction(
  DATA_OBJECT *returnValue)
  {
   PrintErrorID("PARSEFUN",1,FALSE);
   PrintRouter(WERROR,"Function check-syntax does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,TrueSymbol);
  }
Example #14
0
globle void EvalFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   PrintErrorID(theEnv,"STRNGFUN",1,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,EnvFalseSymbol(theEnv));
  }
Example #15
0
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));
  }
Example #16
0
/***********************************************************
  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);
}
Example #18
0
globle int CheckSyntax(
  void *theEnv,
  const char *theString,
  DATA_OBJECT_PTR 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));
   return(TRUE);
  }
Example #19
0
globle void AssertStringFunction(
    void *theEnv,
    DATA_OBJECT_PTR returnValue)
{
    DATA_OBJECT argPtr;
    struct fact *theFact;

    /*===================================================*/
    /* Set the default return value to the symbol FALSE. */
    /*===================================================*/

    SetpType(returnValue,SYMBOL);
    SetpValue(returnValue,EnvFalseSymbol(theEnv));

    /*=====================================================*/
    /* Check for the correct number and type of arguments. */
    /*=====================================================*/

    if (EnvArgCountCheck(theEnv,"assert-string",EXACTLY,1) == -1) return;

    if (EnvArgTypeCheck(theEnv,"assert-string",1,STRING,&argPtr) == FALSE)
    {
        return;
    }

    /*==========================================*/
    /* Call the driver routine for converting a */
    /* string to a fact and then assert it.     */
    /*==========================================*/

    theFact = (struct fact *) EnvAssertString(theEnv,DOToString(argPtr));
    if (theFact != NULL)
    {
        SetpType(returnValue,FACT_ADDRESS);
        SetpValue(returnValue,(void *) theFact);
    }

    return;
}
Example #20
0
globle int Eval(
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theString)
#endif

   PrintErrorID("STRNGFUN",1,FALSE);
   PrintRouter(WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,FalseSymbol);
   return(FALSE);
  }
Example #21
0
globle void OldGetConstructList(
  void *theEnv,
  EXEC_STATUS,
  DATA_OBJECT_PTR returnValue,
  void *(*nextFunction)(void *,EXEC_STATUS,void *),
  char *(*nameFunction)(void *,EXEC_STATUS,void *))
  {
   void *theConstruct;
   unsigned long count = 0;
   struct multifield *theList;

   /*====================================*/
   /* Determine the number of constructs */
   /* of the specified type.             */
   /*====================================*/

   for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL);
        theConstruct != NULL;
        theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct))
     { count++; }

   /*===========================*/
   /* Create a multifield large */
   /* enough to store the list. */
   /*===========================*/

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

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

   for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL), count = 1;
        theConstruct != NULL;
        theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct), count++)
     {
      if (execStatus->HaltExecution == TRUE)
        {
         EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue);
         return;
        }
      SetMFType(theList,count,SYMBOL);
      SetMFValue(theList,count,EnvAddSymbol(theEnv,execStatus,(*nameFunction)(theEnv,execStatus,theConstruct)));
     }
  }
Example #22
0
globle int CheckSyntax(
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theString)
#pragma unused(returnValue)
#endif

   PrintErrorID("PARSEFUN",1,FALSE);
   PrintRouter(WERROR,"Function check-syntax does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,TrueSymbol);
   return(TRUE);
  }
extern "C" void GetMouseLocation(void* theEnv, DATA_OBJECT_PTR returnValue) {
    void* multifield;
    AdventureEngine::AdventureEngineEngine* engine = PullOutEngine(theEnv);
    multifield = EnvCreateMultifield(theEnv, 2);
    Common::EventManager* _eventMan = engine->getEventManager();
    Common::Point pos = _eventMan->getMousePos();
    SetMFType(multifield, 1, INTEGER);
    SetMFValue(multifield, 1, EnvAddLong(theEnv, pos.x));
    SetMFType(multifield, 2, INTEGER);
    SetMFValue(multifield, 2, EnvAddLong(theEnv, pos.y));
    SetpType(returnValue, MULTIFIELD);
    SetpValue(returnValue, multifield);
    SetpDOBegin(returnValue, 1);
    SetpDOEnd(returnValue, 2);
}
Example #24
0
  dataObject * value_to_data_object( const Environment& env, const Values & values )
  {
    void *p, *p2;

    if (values.size() == 0 )
      return NULL;

    if ( values.size() == 1 )
      return value_to_data_object( env, values[0] );

    dataObject* clipsdo = new dataObject;

    p = EnvCreateMultifield( env.cobj(), values.size() );
    for (unsigned int iter = 0; iter < values.size(); iter++) {
      unsigned int mfi = iter + 1; // mfptr indices start at 1
      SetMFType(p, mfi, values[iter].type());
      switch ( values[iter].type() ) {
        case TYPE_SYMBOL:
        case TYPE_STRING:
        case TYPE_INSTANCE_NAME:
          p2 = EnvAddSymbol( env.cobj(),
                             const_cast<char*>(values[iter].as_string().c_str())
                           );
          SetMFValue(p, mfi, p2);
          break;
        case TYPE_INTEGER:
          p2 = EnvAddLong( env.cobj(), values[iter].as_integer() );
          SetMFValue(p, mfi, p2);
          break;
        case TYPE_FLOAT:
          p2 = EnvAddDouble( env.cobj(), values[iter].as_float() );
          SetMFValue(p, mfi, p2);
          break;
      case TYPE_EXTERNAL_ADDRESS:
        p2 = EnvAddExternalAddress( env.cobj(), values[iter].as_address(), EXTERNAL_ADDRESS );
	SetMFValue(p, mfi, p2);
	break;
        default:
          throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" );
      }
    }
    SetpType(clipsdo, MULTIFIELD);
    SetpValue(clipsdo, p);
    SetpDOBegin(clipsdo, 1);
    SetpDOEnd(clipsdo, values.size());
    return clipsdo;
  }
Example #25
0
void EnvGetDefmoduleList(
  void *theEnv,
  CLIPSValue *returnValue)
  {
   void *theConstruct;
   unsigned long count = 0;
   struct multifield *theList;

   /*====================================*/
   /* Determine the number of constructs */
   /* of the specified type.             */
   /*====================================*/

   for (theConstruct = EnvGetNextDefmodule(theEnv,NULL);
        theConstruct != NULL;
        theConstruct = EnvGetNextDefmodule(theEnv,theConstruct))
     { count++; }

   /*===========================*/
   /* Create a multifield large */
   /* enough to store the list. */
   /*===========================*/

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

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

   for (theConstruct = EnvGetNextDefmodule(theEnv,NULL), count = 1;
        theConstruct != NULL;
        theConstruct = EnvGetNextDefmodule(theEnv,theConstruct), count++)
     {
      if (EvaluationData(theEnv)->HaltExecution == true)
        {
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         return;
        }
      SetMFType(theList,count,SYMBOL);
      SetMFValue(theList,count,EnvAddSymbol(theEnv,EnvGetDefmoduleName(theEnv,theConstruct)));
     }
  }
Example #26
0
static void NewCAddress(
  void *theEnv,
  DATA_OBJECT *rv)
  {
   int numberOfArguments;

   numberOfArguments = EnvRtnArgCount(theEnv);
      
   if (numberOfArguments != 1)
     {
      PrintErrorID(theEnv,"NEW",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Function new expected no additional arguments for the C external language type.\n");
      SetEvaluationError(theEnv,TRUE);
      return;
     }

   SetpType(rv,EXTERNAL_ADDRESS);
   SetpValue(rv,EnvAddExternalAddress(theEnv,NULL,0));
  }
Example #27
0
globle void AssertCommand(
  void *theEnv,
  DATA_OBJECT_PTR rv)
  {
   struct deftemplate *theDeftemplate;
   struct field *theField;
   DATA_OBJECT theValue;
   struct expr *theExpression;
   struct templateSlot *slotPtr;
   struct fact *newFact;
   int error = FALSE;
   int i;
   struct fact *theFact;
   
   /*===================================================*/
   /* Set the default return value to the symbol FALSE. */
   /*===================================================*/

   SetpType(rv,SYMBOL);
   SetpValue(rv,EnvFalseSymbol(theEnv));

   /*================================*/
   /* Get the deftemplate associated */
   /* with the fact being asserted.  */
   /*================================*/

   theExpression = GetFirstArgument();
   theDeftemplate = (struct deftemplate *) theExpression->value;

   /*=======================================*/
   /* Create the fact and store the name of */
   /* the deftemplate as the 1st field.     */
   /*=======================================*/

   if (theDeftemplate->implied == FALSE)
     {
      newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots);
      slotPtr = theDeftemplate->slotList;
     }
   else
     {
      newFact = CreateFactBySize(theEnv,1);
      if (theExpression->nextArg == NULL)
        {
         newFact->theProposition.theFields[0].type = MULTIFIELD;
         newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L);
        }
      slotPtr = NULL;
     }

   newFact->whichDeftemplate = theDeftemplate;

   /*===================================================*/
   /* Evaluate the expression associated with each slot */
   /* and store the result in the appropriate slot of   */
   /* the newly created fact.                           */
   /*===================================================*/

   theField = newFact->theProposition.theFields;

   for (theExpression = theExpression->nextArg, i = 0;
        theExpression != NULL;
        theExpression = theExpression->nextArg, i++)
     {
      /*===================================================*/
      /* Evaluate the expression to be stored in the slot. */
      /*===================================================*/

      EvaluateExpression(theEnv,theExpression,&theValue);

      /*============================================================*/
      /* A multifield value can't be stored in a single field slot. */
      /*============================================================*/

      if ((slotPtr != NULL) ?
          (slotPtr->multislot == FALSE) && (theValue.type == MULTIFIELD) :
          FALSE)
        {
         MultiIntoSingleFieldSlotError(theEnv,slotPtr,theDeftemplate);
         theValue.type = SYMBOL;
         theValue.value = EnvFalseSymbol(theEnv);
         error = TRUE;
        }

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

      theField[i].type = theValue.type;
      theField[i].value = theValue.value;

      /*========================================*/
      /* Get the information for the next slot. */
      /*========================================*/

      if (slotPtr != NULL) slotPtr = slotPtr->next;
     }

   /*============================================*/
   /* If an error occured while generating the   */
   /* fact's slot values, then abort the assert. */
   /*============================================*/

   if (error)
     {
      ReturnFact(theEnv,newFact);
      return;
     }

   /*================================*/
   /* Add the fact to the fact-list. */
   /*================================*/

   theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact);

   /*========================================*/
   /* The asserted fact is the return value. */
   /*========================================*/

   if (theFact != NULL)
     {
      SetpType(rv,FACT_ADDRESS);
      SetpValue(rv,(void *) theFact);
     }

   return;
  }
Example #28
0
globle int CheckSyntax(
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
   char *name;
   struct token theToken;
   struct expr *top;
   short rv;

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

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

   /*===========================================*/
   /* Create a string source router so that the */
   /* string can be used as an input source.    */
   /*===========================================*/

   if (OpenStringSource("check-syntax",theString,0) == 0)
     { return(TRUE); }

   /*=================================*/
   /* Only expressions and constructs */
   /* can have their syntax checked.  */
   /*=================================*/

   GetToken("check-syntax",&theToken);

   if (theToken.type != LPAREN)
     {
      CloseStringSource("check-syntax");
      SetpValue(returnValue,AddSymbol("MISSING-LEFT-PARENTHESIS"));
      return(TRUE);
     }

   /*========================================*/
   /* The next token should be the construct */
   /* type or function name.                 */
   /*========================================*/

   GetToken("check-syntax",&theToken);
   if (theToken.type != SYMBOL)
     {
      CloseStringSource("check-syntax");
      SetpValue(returnValue,AddSymbol("EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS"));
      return(TRUE);
     }

   name = ValueToString(theToken.value);

   /*==============================================*/
   /* Set up a router to capture the error output. */
   /*==============================================*/

   AddRouter("error-capture",40,
              FindErrorCapture, PrintErrorCapture,
              NULL, NULL, NULL);

   /*================================*/
   /* Determine if it's a construct. */
   /*================================*/

   if (FindConstruct(name))
     {
      CheckSyntaxMode = TRUE;
      rv = (short) ParseConstruct(name,"check-syntax");
      GetToken("check-syntax",&theToken);
      CheckSyntaxMode = FALSE;

      if (rv)
        {
         PrintRouter(WERROR,"\nERROR:\n");
         PrintInChunks(WERROR,GetPPBuffer());
         PrintRouter(WERROR,"\n");
        }

      DestroyPPBuffer();

      CloseStringSource("check-syntax");

      if ((rv != FALSE) || (WarningString != NULL))
        {
         SetErrorCaptureValues(returnValue);
         DeactivateErrorCapture();
         return(TRUE);
        }

      if (theToken.type != STOP)
        {
         SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
         DeactivateErrorCapture();
         return(TRUE);
        }

      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,FalseSymbol);
      DeactivateErrorCapture();
      return(FALSE);
     }

   /*=======================*/
   /* Parse the expression. */
   /*=======================*/

   top = Function2Parse("check-syntax",name);
   GetToken("check-syntax",&theToken);
   ClearParsedBindNames();
   CloseStringSource("check-syntax");

   if (top == NULL)
     {
      SetErrorCaptureValues(returnValue);
      DeactivateErrorCapture();
      return(TRUE);
     }

   if (theToken.type != STOP)
     {
      SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
      DeactivateErrorCapture();
      ReturnExpression(top);
      return(TRUE);
     }

   DeactivateErrorCapture();

   ReturnExpression(top);
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,FalseSymbol);
   return(FALSE);
  }
Example #29
0
globle int EnvEval(
  void *theEnv,
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
   struct expr *top;
   int ov;
   static int depth = 0;
   char logicalNameBuffer[20];
   struct BindInfo *oldBinds;

   /*======================================================*/
   /* Evaluate the string. Create a different logical name */
   /* for use each time the eval function is called.       */
   /*======================================================*/

   depth++;
   sprintf(logicalNameBuffer,"Eval-%d",depth);
   if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      depth--;
      return(FALSE);
     }

   /*================================================*/
   /* Save the current parsing state before routines */
   /* are called to parse the eval string.           */
   /*================================================*/

   ov = GetPPBufferStatus(theEnv);
   SetPPBufferStatus(theEnv,FALSE);
   oldBinds = GetParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,NULL);

   /*========================================================*/
   /* Parse the string argument passed to the eval function. */
   /*========================================================*/

   top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL);

   /*============================*/
   /* Restore the parsing state. */
   /*============================*/

   SetPPBufferStatus(theEnv,ov);
   ClearParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,oldBinds);

   /*===========================================*/
   /* Return if an error occured while parsing. */
   /*===========================================*/

   if (top == NULL)
     {
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      depth--;
      return(FALSE);
     }

   /*==============================================*/
   /* The sequence expansion operator must be used */
   /* within the argument list of a function call. */
   /*==============================================*/

   if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE))
     {
      PrintErrorID(theEnv,"MISCFUN",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n");
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      ReturnExpression(theEnv,top);
      depth--;
      return(FALSE);
     }

   /*=======================================*/
   /* The expression to be evaluated cannot */
   /* contain any local variables.          */
   /*=======================================*/

   if (ExpressionContainsVariables(top,FALSE))
     {
      PrintErrorID(theEnv,"STRNGFUN",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n");
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      ReturnExpression(theEnv,top);
      depth--;
      return(FALSE);
     }

   /*====================================*/
   /* Evaluate the expression and return */
   /* the memory used to parse it.       */
   /*====================================*/

   ExpressionInstall(theEnv,top);
   EvaluateExpression(theEnv,top,returnValue);
   ExpressionDeinstall(theEnv,top);

   depth--;
   ReturnExpression(theEnv,top);
   CloseStringSource(theEnv,logicalNameBuffer);

   if (GetEvaluationError(theEnv)) return(FALSE);
   return(TRUE);
  }
Example #30
0
globle void EnvGetFactList(
  void *theEnv,
  DATA_OBJECT_PTR returnValue,
  void *vTheModule)
  {
   struct fact *theFact;
   unsigned long count;
   struct multifield *theList;
   struct defmodule *theModule = (struct defmodule *) vTheModule;

   /*==========================*/
   /* Save the current module. */
   /*==========================*/

   SaveCurrentModule(theEnv);

   /*============================================*/
   /* Count the number of facts to be retrieved. */
   /*============================================*/

   if (theModule == NULL)
     {
      for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 0;
           theFact != NULL;
           theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++)
        { /* Do Nothing */ }
     }
   else
     {
      EnvSetCurrentModule(theEnv,(void *) theModule);
      UpdateDeftemplateScope(theEnv);
      for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 0;
           theFact != NULL;
           theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++)
        { /* Do Nothing */ }
     }

   /*===========================================================*/
   /* Create the multifield value to store the construct names. */
   /*===========================================================*/

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

   /*==================================================*/
   /* Store the fact pointers in the multifield value. */
   /*==================================================*/

   if (theModule == NULL)
     {
      for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 1;
           theFact != NULL;
           theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++)
        {
         SetMFType(theList,count,FACT_ADDRESS);
         SetMFValue(theList,count,(void *) theFact);
        }
     }
   else
     {
      for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 1;
           theFact != NULL;
           theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++)
        {
         SetMFType(theList,count,FACT_ADDRESS);
         SetMFValue(theList,count,(void *) theFact);
        }
     }

   /*=============================*/
   /* Restore the current module. */
   /*=============================*/

   RestoreCurrentModule(theEnv);
   UpdateDeftemplateScope(theEnv);
  }