C++ VAL_SET函数代码示例

*/	REBSER *Gob_To_Block(REBGOB *gob)
/*
**		Used by MOLD to create a block.
**
***********************************************************************/
{
    REBSER *ser = Make_Block(10);
    REBVAL *val;
    REBINT words[6] = {SYM_OFFSET, SYM_SIZE, SYM_ALPHA, 0};
    REBVAL *vals[6];
    REBINT n = 0;
    REBVAL *val1;
    REBCNT sym;

    for (n = 0; words[n]; n++) {
        val = Append_Value(ser);
        Init_Word(val, words[n]);
        VAL_SET(val, REB_SET_WORD);
        vals[n] = Append_Value(ser);
    }

    SET_PAIR(vals[0], GOB_X(gob), GOB_Y(gob));
    SET_PAIR(vals[1], GOB_W(gob), GOB_H(gob));
    SET_INTEGER(vals[2], GOB_ALPHA(gob));

    if (!GOB_TYPE(gob)) return ser;

    if (GOB_CONTENT(gob)) {
        val1 = Append_Value(ser);
        val = Append_Value(ser);
        switch (GOB_TYPE(gob)) {
        case GOBT_COLOR:
            sym = SYM_COLOR;
            break;
        case GOBT_IMAGE:
            sym = SYM_IMAGE;
            break;
        case GOBT_STRING:
        case GOBT_TEXT:
            sym = SYM_TEXT;
            break;
        case GOBT_DRAW:
            sym = SYM_DRAW;
            break;
        case GOBT_EFFECT:
            sym = SYM_EFFECT;
            break;
        }
        Init_Word(val1, sym);
        VAL_SET(val1, REB_SET_WORD);
        Get_GOB_Var(gob, val1, val);
    }

    return ser;
}

*/	REBSER *List_Func_Types(REBVAL *func)
/*
**		Return a block of function arg types.
**		Note: skips 0th entry.
**
***********************************************************************/
{
	REBSER *block;
	REBSER *words = VAL_FUNC_WORDS(func);
	REBCNT n;
	REBVAL *value;
	REBVAL *word;

	block = Make_Block(SERIES_TAIL(words));
	word = BLK_SKIP(words, 1);

	for (n = 1; n < SERIES_TAIL(words); word++, n++) {
		value = Alloc_Tail_Blk(block);
		VAL_SET(value, VAL_TYPE(word));
		VAL_WORD_SYM(value) = VAL_BIND_SYM(word);
		UNBIND(value);
	}

	return block;
}

*/  REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
**      Create a child frame from two parent frames. Merge common fields.
**      Values from the second parent take precedence.
**
**		Deep copy and rebind the child.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *child;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;
	REBINT *binds = WORDS_HEAD(Bind_Table);

	// Merge parent1 and parent2 words.
	// Keep the binding table.
	Collect_Start(BIND_ALL);
	// Setup binding table and BUF_WORDS with parent1 words:
	if (parent1) Collect_Object(parent1);
	// Add parent2 words to binding table and BUF_WORDS:
	Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);

	// Allocate child (now that we know the correct size):
	wrds = Copy_Series(BUF_WORDS);
	child = Make_Block(SERIES_TAIL(wrds));
	value = Append_Value(child);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent1 values:
	COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);

	// Copy parent2 values:
	words = FRM_WORDS(parent2)+1;
	value = FRM_VALUES(parent2)+1;
	for (; NOT_END(words); words++, value++) {
		// no need to search when the binding table is available
		n = binds[VAL_WORD_CANON(words)];
		BLK_HEAD(child)[n] = *value;
	}

	// Terminate the child frame:
	SERIES_TAIL(child) = SERIES_TAIL(wrds);
	BLK_TERM(child);

	// Deep copy the child
	Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);

	// Rebind the child
	Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
	Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);

	// release the bind table 
	Collect_End(wrds);

	return child;
}

*/	REBFLG MT_None(REBVAL *out, REBVAL *data, enum Reb_Kind type)
/*
***********************************************************************/
{
	VAL_SET(out, type);
	return TRUE;
}

*/	REBFLG MT_None(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	VAL_SET(out, type);
	return TRUE;
}

*/	static void Loop_Number(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
	REBDEC s;
	REBDEC e;
	REBDEC i;

	if (IS_INTEGER(start)) s = cast(REBDEC, VAL_INT64(start));
	else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
	else { Trap_Arg(start); DEAD_END_VOID; }

	if (IS_INTEGER(end)) e = cast(REBDEC, VAL_INT64(end));
	else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
	else { Trap_Arg(end); DEAD_END_VOID; }

	if (IS_INTEGER(incr)) i = cast(REBDEC, VAL_INT64(incr));
	else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
	else { Trap_Arg(incr); DEAD_END_VOID; }

	VAL_SET(var, REB_DECIMAL);

	SET_NONE(out); // Default result to NONE if the loop does not run

	for (; (i > 0.0) ? s <= e : s >= e; s += i) {
		VAL_DECIMAL(var) = s;

		if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;

		if (!IS_DECIMAL(var)) Trap_Type(var);
		s = VAL_DECIMAL(var);
	}
}

*/	static void Loop_Number(REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
	REBVAL *result;
	REBDEC s;
	REBDEC e;
	REBDEC i;

	if (IS_INTEGER(start)) s = (REBDEC)VAL_INT64(start);
	else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
	else Trap_Arg(start);

	if (IS_INTEGER(end)) e = (REBDEC)VAL_INT64(end);
	else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
	else Trap_Arg(end);

	if (IS_INTEGER(incr)) i = (REBDEC)VAL_INT64(incr);
	else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
	else Trap_Arg(incr);

	VAL_SET(var, REB_DECIMAL);

	for (; (i > 0.0) ? s <= e : s >= e; s += i) {
		VAL_DECIMAL(var) = s;
		result = Do_Blk(body, 0);
		if (THROWN(result) && Check_Error(result) >= 0) break;
		if (!IS_DECIMAL(var)) Trap_Type(var);
		s = VAL_DECIMAL(var);
	}
}

*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
////		|| type < REB_CLOSURE // for now
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	//	Print("Make_Func"); //: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec));
	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}

*/	REBFLG MT_Tuple(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	REBYTE	*vp;
	REBINT len = 0;
	REBINT n;

	vp = VAL_TUPLE(out);
	for (; NOT_END(data); data++, vp++, len++) {
		if (len >= 10) return FALSE;
		if (IS_INTEGER(data)) {
			n = Int32(data);
		}
		else if (IS_CHAR(data)) {
			n = VAL_CHAR(data);
		}
		else return FALSE;
		if (n > 255 || n < 0) return FALSE;
		*vp = n;
	}

	VAL_TUPLE_LEN(out) = len;

	for (; len < 10; len++) *vp++ = 0;

	VAL_SET(out, type);
	return TRUE;
}

*/	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;
}

*/	void Set_Object(REBVAL *value, REBSER *series)
/*
***********************************************************************/
{
	VAL_SET(value, REB_OBJECT);
	VAL_OBJ_FRAME(value) = series;
}

*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION || type == REB_CLOSURE)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));

	return TRUE;
}

*/	RL_API int RL_Event(REBEVT *evt)
/*
**	Appends an application event (e.g. GUI) to the event port.
**
**	Returns:
**		Returns TRUE if queued, or FALSE if event queue is full.
**	Arguments:
**		evt - A properly initialized event structure. The
**			contents of this structure are copied as part of
**			the function, allowing use of locals.
**	Notes:
**		Sets a signal to get REBOL attention for WAIT and awake.
**		To avoid environment problems, this function only appends
**		to the event queue (no auto-expand). So if the queue is full
**
***********************************************************************/
{
	REBVAL *event = Append_Event();		// sets signal

	if (event) {						// null if no room left in series
		VAL_SET(event, REB_EVENT);		// (has more space, if we need it)
		event->data.event = *evt;
		return 1;
	}

	return 0;
}

//
//  Scan_Time: C
// 
// Scan string and convert to time.  Return zero if error.
//
const REBYTE *Scan_Time(const REBYTE *cp, REBCNT len, REBVAL *value)
{
    const REBYTE  *sp;
    REBYTE  merid = FALSE;
    REBOOL  neg = FALSE;
    REBINT  part1, part2, part3 = -1;
    REBINT  part4 = -1;

    if (*cp == '-') cp++, neg = TRUE;
    else if (*cp == '+') cp++;

    if (*cp == '-' || *cp == '+') return 0; // small hole: --1:23

    // Can be:
    //    HH:MM       as part1:part2
    //    HH:MM:SS    as part1:part2:part3
    //    HH:MM:SS.DD as part1:part2:part3.part4
    //    MM:SS.DD    as part1:part2.part4
    cp = Grab_Int(cp, &part1);
    if (part1 > MAX_HOUR) return 0;
    if (*cp++ != ':') return 0;
    sp = Grab_Int(cp, &part2);
    if (part2 < 0 || sp == cp) return 0;
    cp = sp;
    if (*cp == ':') {   // optional seconds
        sp = cp + 1;
        cp = Grab_Int(sp, &part3);
        if (part3 < 0 || cp == sp) return 0;  //part3 = -1;
    }
    if (*cp == '.' || *cp == ',') {
        sp = ++cp;
        cp = Grab_Int_Scale(sp, &part4, 9);
        if (part4 == 0) part4 = -1;
    }
    if ((UP_CASE(*cp) == 'A' || UP_CASE(*cp) == 'P') && (UP_CASE(cp[1]) == 'M')) {
        merid = (REBYTE)UP_CASE(*cp);
        cp += 2;
    }

    if (part3 >= 0 || part4 < 0) {  // HH:MM mode
        if (merid) {
            if (part1 > 12) return 0;
            if (part1 == 12) part1 = 0;
            if (merid == 'P') part1 += 12;
        }
        if (part3 < 0) part3 = 0;
        VAL_TIME(value) = HOUR_TIME(part1) + MIN_TIME(part2) + SEC_TIME(part3);
    } else {                        // MM:SS mode
        if (merid) return 0;        // no AM/PM for minutes
        VAL_TIME(value) = MIN_TIME(part1) + SEC_TIME(part2);
    }

    if (part4 > 0) VAL_TIME(value) += part4;

    if (neg) VAL_TIME(value) = -VAL_TIME(value);
    VAL_SET(value, REB_TIME);

    return cp;
}

*/	void Set_Word(REBVAL *value, REBINT sym, REBSER *frame, REBCNT index)
/*
***********************************************************************/
{
	VAL_SET(value, REB_WORD);
	VAL_WORD_SYM(value) = sym;
	VAL_WORD_FRAME(value) = frame;
	VAL_WORD_INDEX(value) = index;
}