Пример #1
0
//
//  Min_Max_Pair: C
//
void Min_Max_Pair(REBVAL *out, const REBVAL *a, const REBVAL *b, REBOOL maxed)
{
    REBXYF aa;
    if (IS_PAIR(a)) {
        aa.x = VAL_PAIR_X(a);
        aa.y = VAL_PAIR_Y(a);
    }
    else if (IS_INTEGER(a))
        aa.x = aa.y = cast(REBDEC, VAL_INT64(a));
    else
        fail (Error_Invalid_Arg(a));

    REBXYF bb;
    if (IS_PAIR(b)) {
        bb.x = VAL_PAIR_X(b);
        bb.y = VAL_PAIR_Y(b);
    }
    else if (IS_INTEGER(b))
        bb.x = bb.y = cast(REBDEC, VAL_INT64(b));
    else
        fail (Error_Invalid_Arg(b));

    if (maxed)
        SET_PAIR(out, MAX(aa.x, bb.x), MAX(aa.y, bb.y));
    else
        SET_PAIR(out, MIN(aa.x, bb.x), MIN(aa.y, bb.y));
}
Пример #2
0
Файл: t-pair.c Проект: Oldes/r3
*/	REBINT PD_Pair(REBPVS *pvs)
/*
***********************************************************************/
{
	REBVAL *sel;
	REBVAL *val;
	REBINT n = 0;
	REBD32 dec;

	if (IS_WORD(sel = pvs->select)) {
		if (VAL_WORD_CANON(sel) == SYM_X) n = 1;
		else if (VAL_WORD_CANON(sel) == SYM_Y) n = 2;
		else return PE_BAD_SELECT;
	}
	else if (IS_INTEGER(sel)) {
		n = Int32(sel);
		if (n != 1 && n !=2) return PE_BAD_SELECT;
	}
	else
		return PE_BAD_SELECT;

	if (NZ(val = pvs->setval)) {
		if (IS_INTEGER(val)) dec = (REBD32)VAL_INT64(val);
		else if (IS_DECIMAL(val)) dec = (REBD32)VAL_DECIMAL(val);
		else return PE_BAD_SET;
		if (n == 1) VAL_PAIR_X(pvs->value) = dec;
		else VAL_PAIR_Y(pvs->value) = dec;
	} else {
		dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
		SET_DECIMAL(pvs->store, dec);
		return PE_USE;
	}

	return PE_OK;
}
Пример #3
0
//
//  Cmp_Pair: C
// 
// Given two pairs, compare them.
//
REBINT Cmp_Pair(const REBVAL *t1, const REBVAL *t2)
{
    REBD32  diff;

    if ((diff = VAL_PAIR_Y(t1) - VAL_PAIR_Y(t2)) == 0)
        diff = VAL_PAIR_X(t1) - VAL_PAIR_X(t2);
    return (diff > 0.0) ? 1 : ((diff < 0.0) ? -1 : 0);
}
Пример #4
0
//
//  CT_Pair: C
//
REBINT CT_Pair(REBVAL *a, REBVAL *b, REBINT mode)
{
    if (mode >= 0) return Cmp_Pair(a, b) == 0; // works for INTEGER=0 too (spans x y)
    if (IS_PAIR(b) && 0 == VAL_INT64(b)) { // for negative? and positive?
        if (mode == -1)
            return (VAL_PAIR_X(a) >= 0 || VAL_PAIR_Y(a) >= 0); // not LT
        return (VAL_PAIR_X(a) > 0 && VAL_PAIR_Y(a) > 0); // NOT LTE
    }
    return -1;
}
Пример #5
0
Файл: t-pair.c Проект: Oldes/r3
*/	REBINT Cmp_Pair(REBVAL *t1, REBVAL *t2)
/*
**	Given two pairs, compare them.
**
***********************************************************************/
{
	REBD32	diff;

	if ((diff = VAL_PAIR_Y(t1) - VAL_PAIR_Y(t2)) == 0)
		diff = VAL_PAIR_X(t1) - VAL_PAIR_X(t2);
	return (diff > 0.0) ? 1 : ((diff < 0.0) ? -1 : 0);
}
Пример #6
0
Файл: t-pair.c Проект: Oldes/r3
*/	REBFLG MT_Pair(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	REBD32 x;
	REBD32 y;

	if (IS_PAIR(data)) {
		*out = *data;
		return TRUE;
	}

	if (!IS_BLOCK(data)) return FALSE;

	data = VAL_BLK_DATA(data);

	if (IS_INTEGER(data)) x = (REBD32)VAL_INT64(data);
	else if (IS_DECIMAL(data)) x = (REBD32)VAL_DECIMAL(data);
	else return FALSE;

	data++;
	if (IS_INTEGER(data)) y = (REBD32)VAL_INT64(data);
	else if (IS_DECIMAL(data)) y = (REBD32)VAL_DECIMAL(data);
	else return FALSE;

	VAL_SET(out, REB_PAIR);
	VAL_PAIR_X(out) = x;
	VAL_PAIR_Y(out) = y;
	return TRUE;
}
Пример #7
0
static void Get_Math_Arg_For_Pair(
    REBDEC *x_out,
    REBDEC *y_out,
    REBVAL *arg,
    REBSYM action
){
    switch (VAL_TYPE(arg)) {
    case REB_PAIR:
        *x_out = VAL_PAIR_X(arg);
        *y_out = VAL_PAIR_Y(arg);
        break;

    case REB_INTEGER:
        *x_out = *y_out = cast(REBDEC, VAL_INT64(arg));
        break;

    case REB_DECIMAL:
    case REB_PERCENT:
        *x_out = *y_out = cast(REBDEC, VAL_DECIMAL(arg));
        break;

    default:
        fail (Error_Math_Args(REB_PAIR, action));
    }

}
Пример #8
0
//
//  MT_Pair: C
//
REBFLG MT_Pair(REBVAL *out, REBVAL *data, enum Reb_Kind type)
{
    REBD32 x;
    REBD32 y;

    if (IS_PAIR(data)) {
        *out = *data;
        return TRUE;
    }

    if (!IS_BLOCK(data)) return FALSE;

    data = VAL_ARRAY_AT(data);

    if (IS_INTEGER(data)) x = (REBD32)VAL_INT64(data);
    else if (IS_DECIMAL(data)) x = (REBD32)VAL_DECIMAL(data);
    else return FALSE;

    data++;
    if (IS_END(data))
        return FALSE;

    if (IS_INTEGER(data)) y = (REBD32)VAL_INT64(data);
    else if (IS_DECIMAL(data)) y = (REBD32)VAL_DECIMAL(data);
    else return FALSE;

    VAL_RESET_HEADER(out, REB_PAIR);
    VAL_PAIR_X(out) = x;
    VAL_PAIR_Y(out) = y;
    return TRUE;
}
Пример #9
0
//
//  PD_Pair: C
//
REBINT PD_Pair(REBPVS *pvs)
{
    const REBVAL *sel = pvs->selector;
    REBINT n = 0;
    REBDEC dec;

    if (IS_WORD(sel)) {
        if (VAL_WORD_SYM(sel) == SYM_X)
            n = 1;
        else if (VAL_WORD_SYM(sel) == SYM_Y)
            n = 2;
        else
            fail (Error_Bad_Path_Select(pvs));
    }
    else if (IS_INTEGER(sel)) {
        n = Int32(sel);
        if (n != 1 && n != 2)
            fail (Error_Bad_Path_Select(pvs));
    }
    else fail (Error_Bad_Path_Select(pvs));

    if (pvs->opt_setval) {
        const REBVAL *setval = pvs->opt_setval;

        if (IS_INTEGER(setval))
            dec = cast(REBDEC, VAL_INT64(setval));
        else if (IS_DECIMAL(setval))
            dec = VAL_DECIMAL(setval);
        else
            fail (Error_Bad_Path_Set(pvs));

        if (n == 1)
            VAL_PAIR_X(pvs->value) = dec;
        else
            VAL_PAIR_Y(pvs->value) = dec;
    }
    else {
        dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
        SET_DECIMAL(pvs->store, dec);
        return PE_USE_STORE;
    }

    return PE_OK;
}
Пример #10
0
*/	static void Return_Gob_Pair(REBVAL *ds, REBGOB *gob, REBD32 x, REBD32 y)
/*
***********************************************************************/
{
	REBSER *blk;
	REBVAL *val;

	blk = Make_Block(2);
	Set_Series(REB_BLOCK, ds, blk);
	val = Append_Value(blk);
	SET_GOB(val, gob);
	val = Append_Value(blk);
	VAL_SET(val, REB_PAIR);
	VAL_PAIR_X(val) = x;
	VAL_PAIR_Y(val) = y;
}
Пример #11
0
Файл: t-gob.c Проект: xqlab/r3
*/	static REBFLG Set_Pair(REBXYF *pair, REBVAL *val)
/*
***********************************************************************/
{
    if (IS_PAIR(val)) {
        pair->x = VAL_PAIR_X(val);
        pair->y = VAL_PAIR_Y(val);
    }
    else if (IS_INTEGER(val)) {
        pair->x = pair->y = (REBD32)VAL_INT64(val);
    }
    else if (IS_DECIMAL(val)) {
        pair->x = pair->y = (REBD32)VAL_DECIMAL(val);
    }
    else
        return FALSE;

    return TRUE;
}
Пример #12
0
*/  void Mold_Value(REB_MOLD *mold, REBVAL *value, REBFLG molded)
/*
**		Mold or form any value to string series tail.
**
***********************************************************************/
{
	REBYTE buf[60];
	REBINT len;
	REBSER *ser = mold->series;

	CHECK_STACK(&len);

	ASSERT2(SERIES_WIDE(mold->series) == sizeof(REBUNI), RP_BAD_SIZE);
	ASSERT2(ser, RP_NO_BUFFER);

	// Special handling of string series: {
	if (ANY_STR(value) && !IS_TAG(value)) {

		// Forming a string:
		if (!molded) {
			Insert_String(ser, -1, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
			return;
		}

		// Special format for ALL string series when not at head:
		if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
			Mold_All_String(value, mold);
			return;
		}
	}

	switch (VAL_TYPE(value)) {
	case REB_NONE:
		Emit(mold, "+N", SYM_NONE);
		break;

	case REB_LOGIC:
//		if (!molded || !VAL_LOGIC_WORDS(value) || !GET_MOPT(mold, MOPT_MOLD_ALL))
			Emit(mold, "+N", VAL_LOGIC(value) ? SYM_TRUE : SYM_FALSE);
//		else
//			Mold_Logic(mold, value);
		break;

	case REB_INTEGER:
		len = Emit_Integer(buf, VAL_INT64(value));
		goto append;

	case REB_DECIMAL:
	case REB_PERCENT:
		len = Emit_Decimal(buf, VAL_DECIMAL(value), IS_PERCENT(value)?DEC_MOLD_PERCENT:0,
			Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT], mold->digits);
		goto append;

	case REB_MONEY:
		len = Emit_Money(value, buf, mold->opts);
		goto append;

	case REB_CHAR:
		Mold_Uni_Char(ser, VAL_CHAR(value), (REBOOL)molded, (REBOOL)GET_MOPT(mold, MOPT_MOLD_ALL));
		break;

	case REB_PAIR:
		len = Emit_Decimal(buf, VAL_PAIR_X(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
		Append_Bytes_Len(ser, buf, len);
		Append_Byte(ser, 'x');
		len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
		Append_Bytes_Len(ser, buf, len);
		//Emit(mold, "IxI", VAL_PAIR_X(value), VAL_PAIR_Y(value));
		break;

	case REB_TUPLE:
		len = Emit_Tuple(value, buf);
		goto append;

	case REB_TIME:
		//len = Emit_Time(value, buf, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]);
		Emit_Time(mold, value);
		break;

	case REB_DATE:
		Emit_Date(mold, value);
		break;

	case REB_STRING:
		// FORM happens in top section.
		Mold_String_Series(value, mold);
		break;

	case REB_BINARY:
		if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
			Mold_All_String(value, mold);
			return;
		}
		Mold_Binary(value, mold);
		break;

	case REB_FILE:
		if (VAL_LEN(value) == 0) {
			Append_Bytes(ser, "%\"\"");
			break;
		}
		Mold_File(value, mold);
		break;

	case REB_EMAIL:
	case REB_URL:
		Mold_Url(value, mold);
		break;

	case REB_TAG:
		if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
			Mold_All_String(value, mold);
			return;
		}
		Mold_Tag(value, mold);
		break;

//		Mold_Issue(value, mold);
//		break;

	case REB_BITSET:
		Pre_Mold(value, mold); // #[bitset! or make bitset!
		Mold_Bitset(value, mold);
		End_Mold(mold);
		break;

	case REB_IMAGE:
		Pre_Mold(value, mold);
		if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
			Append_Byte(ser, '[');
			Mold_Image_Data(value, mold);
			Append_Byte(ser, ']');
			End_Mold(mold);
		}
		else {
			REBVAL val = *value;
			VAL_INDEX(&val) = 0; // mold all of it
			Mold_Image_Data(&val, mold);
			Post_Mold(value, mold);
		}
		break;

	case REB_BLOCK:
	case REB_PAREN:
		if (!molded)
			Form_Block_Series(VAL_SERIES(value), VAL_INDEX(value), mold, 0);
		else
			Mold_Block(value, mold);
		break;

	case REB_PATH:
	case REB_SET_PATH:
	case REB_GET_PATH:
	case REB_LIT_PATH:
		Mold_Block(value, mold);
		break;

	case REB_VECTOR:
		Mold_Vector(value, mold, molded);
		break;

	case REB_DATATYPE:
		if (!molded)
			Emit(mold, "N", VAL_DATATYPE(value) + 1);
		else
			Emit(mold, "+DN", SYM_DATATYPE_TYPE, VAL_DATATYPE(value) + 1);
		break;

	case REB_TYPESET:
		Mold_Typeset(value, mold, molded);
		break;

	case REB_WORD:
		// This is a high frequency function, so it is optimized.
		Append_UTF8(ser, Get_Sym_Name(VAL_WORD_SYM(value)), -1);
		break;

	case REB_SET_WORD:
		Emit(mold, "W:", value);
		break;

	case REB_GET_WORD:
		Emit(mold, ":W", value);
		break;

	case REB_LIT_WORD:
		Emit(mold, "\'W", value);
		break;

	case REB_REFINEMENT:
		Emit(mold, "/W", value);
		break;

	case REB_ISSUE:
		Emit(mold, "#W", value);
		break;

	case REB_CLOSURE:
	case REB_FUNCTION:
	case REB_NATIVE:
	case REB_ACTION:
	case REB_COMMAND:
		Mold_Function(value, mold);
		break;

	case REB_OBJECT:
	case REB_MODULE:
	case REB_PORT:
		if (!molded) Form_Object(value, mold);
		else Mold_Object(value, mold);
		break;

	case REB_TASK:
		Mold_Object(value, mold); //// | (1<<MOPT_NO_NONE));
		break;

	case REB_ERROR:
		Mold_Error(value, mold, molded);
		break;

	case REB_MAP:
		Mold_Map(value, mold, molded);
		break;

	case REB_GOB:
	{
		REBSER *blk;
		Pre_Mold(value, mold);
		blk = Gob_To_Block(VAL_GOB(value));
		Mold_Block_Series(mold, blk, 0, 0);
		End_Mold(mold);
	}
		break;

	
	case REB_EVENT:
		Mold_Event(value, mold);
		break;

	case REB_REBCODE:
	case REB_OP:
	case REB_FRAME:
	case REB_HANDLE:
	case REB_STRUCT:
	case REB_LIBRARY:
	case REB_UTYPE:
		// Value has no printable form, so just print its name.
		if (!molded) Emit(mold, "?T?", value);
		else Emit(mold, "+T", value);
		break;

	case REB_END:
	case REB_UNSET:
		if (molded) Emit(mold, "+T", value);
		break;

	default:
		Crash(RP_DATATYPE+5, VAL_TYPE(value));
	}
	return;

append:
	Append_Bytes_Len(ser, buf, len);

}