Esempio n. 1
0
File: ascmenu.c Progetto: E-LLP/QuIP
static COMMAND_FUNC( do_disp_obj )
{
	Data_Obj *dp;
	FILE *fp;

	dp=PICK_OBJ("");
	if( dp==NO_OBJ ) return;

	// We used to insist that the object be in RAM,
	// but we make life easier by automatically creating
	// a temporary object...

	dp = insure_ram_obj(QSP_ARG  dp);
	if( dp == NO_OBJ ) return;

	fp = tell_msgfile(SINGLE_QSP_ARG);
	if( fp == stdout ){
		if( IS_IMAGE(dp) || IS_SEQUENCE(dp) )
			if( !CONFIRM(
		"are you sure you want to display an image/sequence in ascii") )
				return;
		list_dobj(QSP_ARG  dp);
	}
	pntvec(QSP_ARG  dp,fp);
	fflush(fp);

	DELETE_IF_COPY(dp)
}
Esempio n. 2
0
LOCAL void*
cl_mem_map_auto(cl_mem mem)
{
  if (IS_IMAGE(mem) && cl_mem_image(mem)->tiling != CL_NO_TILE)
    return cl_mem_map_gtt(mem);
  else
    return cl_mem_map(mem);
}
Esempio n. 3
0
LOCAL cl_int
cl_mem_unmap_auto(cl_mem mem)
{
  if (IS_IMAGE(mem) && cl_mem_image(mem)->tiling != CL_NO_TILE)
    cl_buffer_unmap_gtt(mem->bo);
  else
    cl_buffer_unmap(mem->bo);
  return CL_SUCCESS;
}
Esempio n. 4
0
File: ascmenu.c Progetto: E-LLP/QuIP
static COMMAND_FUNC( do_wrt_obj )
{
	Data_Obj *dp;
	FILE *fp;
	/* BUG what if pathname is longer than 256??? */
	const char *filename;

	dp=PICK_OBJ("");
	filename = NAMEOF("output file");

	if( dp==NO_OBJ ) return;

	if( strcmp(filename,"-") && strcmp(filename,"stdout") ){
		// BUG? we don't check append flag here,
		// but there is a separate append command...

		fp=TRYNICE( filename, "w" );
		if( !fp ) return;
	} else {
		// If the invoking script has redirected stdout,
		// then use that
		if( QS_MSG_FILE(THIS_QSP)!=NULL )
			fp = QS_MSG_FILE(THIS_QSP);
		else
			fp = stdout;
	}

	if( IS_IMAGE(dp) || IS_SEQUENCE(dp) )
		if( !CONFIRM(
		"are you sure you want to write an image/sequence in ascii") ){
			fclose(fp);
			return;
		}

	dp = insure_ram_obj(QSP_ARG  dp);
	if( dp == NO_OBJ ) return;

	pntvec(QSP_ARG  dp,fp);
	if( fp != stdout && QS_MSG_FILE(THIS_QSP)!=NULL && fp != QS_MSG_FILE(THIS_QSP) ) {
		if( verbose ){
			sprintf(MSG_STR,"closing file %s",filename);
			prt_msg(MSG_STR);
		}
		fclose(fp);
	}

	DELETE_IF_COPY(dp)
}
Esempio n. 5
0
*/	REBINT Compare_Binary_Vals(REBVAL *v1, REBVAL *v2)
/*
**		Compare two binary values.
**
**		Compares bytes, not chars. Return the difference.
**
**		Used for: Binary comparision function
**
***********************************************************************/
{
	REBCNT l1 = VAL_LEN(v1);
	REBCNT l2 = VAL_LEN(v2);
	REBCNT len = MIN(l1, l2);
	REBINT n;

	if (IS_IMAGE(v1)) len *= 4;

	n = memcmp(VAL_BIN_DATA(v1), VAL_BIN_DATA(v2), len);

	if (n != 0) return n;

	return l1 - l2;
}
Esempio n. 6
0
File: ascmenu.c Progetto: E-LLP/QuIP
static COMMAND_FUNC( do_append )
{
	Data_Obj *dp;
	FILE *fp;

	dp=PICK_OBJ("");
	if( dp==NO_OBJ ) return;

	if( IS_IMAGE(dp) || IS_SEQUENCE(dp) )
		if( !CONFIRM(
		"are you sure you want to write an image/sequence in ascii") )
			return;
	fp=TRYNICE( NAMEOF("output file"), "a" );
	if( !fp ) return;

	dp = insure_ram_obj(QSP_ARG  dp);
	if( dp == NO_OBJ ) return;

	pntvec(QSP_ARG  dp,fp);
	fclose(fp);

	DELETE_IF_COPY(dp)
}
Esempio n. 7
0
File: t-gob.c Progetto: xqlab/r3
*/	static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
    switch (VAL_WORD_CANON(word)) {
    case SYM_OFFSET:
        return Set_Pair(&(gob->offset), val);

    case SYM_SIZE:
        return Set_Pair(&gob->size, val);

    case SYM_IMAGE:
        CLR_GOB_OPAQUE(gob);
        if (IS_IMAGE(val)) {
            SET_GOB_TYPE(gob, GOBT_IMAGE);
            GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
            GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
            GOB_CONTENT(gob) = VAL_SERIES(val);
//			if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
        }
        else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
        else return FALSE;
        break;

    case SYM_DRAW:
        CLR_GOB_OPAQUE(gob);
        if (IS_BLOCK(val)) {
            SET_GOB_TYPE(gob, GOBT_DRAW);
            GOB_CONTENT(gob) = VAL_SERIES(val);
        }
        else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
        else return FALSE;
        break;

    case SYM_TEXT:
        CLR_GOB_OPAQUE(gob);
        if (IS_BLOCK(val)) {
            SET_GOB_TYPE(gob, GOBT_TEXT);
            GOB_CONTENT(gob) = VAL_SERIES(val);
        }
        else if (IS_STRING(val)) {
            SET_GOB_TYPE(gob, GOBT_STRING);
            GOB_CONTENT(gob) = VAL_SERIES(val);
        }
        else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
        else return FALSE;
        break;

    case SYM_EFFECT:
        CLR_GOB_OPAQUE(gob);
        if (IS_BLOCK(val)) {
            SET_GOB_TYPE(gob, GOBT_EFFECT);
            GOB_CONTENT(gob) = VAL_SERIES(val);
        }
        else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
        else return FALSE;
        break;

    case SYM_COLOR:
        CLR_GOB_OPAQUE(gob);
        if (IS_TUPLE(val)) {
            SET_GOB_TYPE(gob, GOBT_COLOR);
            Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
            if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 0)
                SET_GOB_OPAQUE(gob);
        }
        else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
        break;

    case SYM_PANE:
        if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
        if (IS_BLOCK(val))
            Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
        else if (IS_GOB(val))
            Insert_Gobs(gob, val, 0, 1, 0);
        else if (IS_NONE(val))
            gob->pane = 0;
        else
            return FALSE;
        break;

    case SYM_ALPHA:
        GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
        break;

    case SYM_DATA:
        SET_GOB_DTYPE(gob, GOBD_NONE);
        if (IS_OBJECT(val)) {
            SET_GOB_DTYPE(gob, GOBD_OBJECT);
            SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
        }
        else if (IS_BLOCK(val)) {
            SET_GOB_DTYPE(gob, GOBD_BLOCK);
            SET_GOB_DATA(gob, VAL_SERIES(val));
        }
        else if (IS_STRING(val)) {
            SET_GOB_DTYPE(gob, GOBD_STRING);
            SET_GOB_DATA(gob, VAL_SERIES(val));
        }
        else if (IS_BINARY(val)) {
            SET_GOB_DTYPE(gob, GOBD_BINARY);
            SET_GOB_DATA(gob, VAL_SERIES(val));
        }
        else if (IS_INTEGER(val)) {
            SET_GOB_DTYPE(gob, GOBD_INTEGER);
            SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
        }
        else if (IS_NONE(val))
            SET_GOB_TYPE(gob, GOBT_NONE);
        else return FALSE;
        break;

    case SYM_FLAGS:
        if (IS_WORD(val)) Set_Gob_Flag(gob, val);
        else if (IS_BLOCK(val)) {
            gob->flags = 0;
            for (val = VAL_BLK(val); NOT_END(val); val++) {
                if (IS_WORD(val)) Set_Gob_Flag(gob, val);
            }
        }
        break;

    case SYM_OWNER:
        if (IS_GOB(val))
            GOB_TMP_OWNER(gob) = VAL_GOB(val);
        else
            return FALSE;
        break;

    default:
        return FALSE;
    }
    return TRUE;
}
Esempio n. 8
0
File: t-gob.c Progetto: Oldes/r3
*/	static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *hndl;

	switch (VAL_WORD_CANON(word)) {
	case SYM_OFFSET:
		return Set_Pair(&(gob->offset), val);

	case SYM_SIZE:
		return Set_Pair(&gob->size, val);

	case SYM_IMAGE:
		CLR_GOB_OPAQUE(gob);
		if (IS_IMAGE(val)) {
			SET_GOB_TYPE(gob, GOBT_IMAGE);
			GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
			GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
			GOB_CONTENT(gob) = VAL_SERIES(val);
//			if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;
#ifdef HAS_WIDGET_GOB
	case SYM_WIDGET:
		//printf("WIDGET GOB\n");
		SET_GOB_TYPE(gob, GOBT_WIDGET);
		SET_GOB_OPAQUE(gob);

		GOB_CONTENT(gob) = Make_Block(4);      // [handle type spec data]
		hndl = Append_Value(GOB_CONTENT(gob));
		       Append_Value(GOB_CONTENT(gob)); // used to cache type on host's side
		spec = Append_Value(GOB_CONTENT(gob));
		       Append_Value(GOB_CONTENT(gob)); // used to cache result data

		SET_HANDLE(hndl, 0, SYM_WIDGET, 0);
		
		if (IS_WORD(val) || IS_LIT_WORD(val)) {
			Set_Block(spec, Make_Block(1));
			Append_Val(VAL_SERIES(spec), val);
		}
		else if (IS_BLOCK(val)) {
			Set_Block(spec, VAL_SERIES(val));
		}
		else return FALSE;
		break;
#endif // HAS_WIDGET_GOB

	case SYM_DRAW:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_DRAW);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_TEXT:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_TEXT);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_STRING(val)) {
			SET_GOB_TYPE(gob, GOBT_STRING);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_EFFECT:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_EFFECT);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_COLOR:
		CLR_GOB_OPAQUE(gob);
		if (IS_TUPLE(val)) {
			SET_GOB_TYPE(gob, GOBT_COLOR);
			Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
			if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 255)
				SET_GOB_OPAQUE(gob);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		break;

	case SYM_PANE:
		if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
		if (IS_BLOCK(val))
			Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
		else if (IS_GOB(val))
			Insert_Gobs(gob, val, 0, 1, 0);
		else if (IS_NONE(val))
			gob->pane = 0;
		else
			return FALSE;
		break;

	case SYM_ALPHA:
		GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
		break;

	case SYM_DATA:
#ifdef HAS_WIDGET_GOB
		if (GOB_TYPE(gob) == GOBT_WIDGET) {
			OS_SET_WIDGET_DATA(gob, val);
		} else {
#endif
		SET_GOB_DTYPE(gob, GOBD_NONE);
		if (IS_OBJECT(val)) {
			SET_GOB_DTYPE(gob, GOBD_OBJECT);
			SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
		}
		else if (IS_BLOCK(val)) {
			SET_GOB_DTYPE(gob, GOBD_BLOCK);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_STRING(val)) {
			SET_GOB_DTYPE(gob, GOBD_STRING);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_BINARY(val)) {
			SET_GOB_DTYPE(gob, GOBD_BINARY);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_INTEGER(val)) {
			SET_GOB_DTYPE(gob, GOBD_INTEGER);
			SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
		}
		else if (IS_NONE(val))
			SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
#ifdef HAS_WIDGET_GOB
		}
#endif
		break;

	case SYM_FLAGS:
		if (IS_WORD(val)) Set_Gob_Flag(gob, val);
		else if (IS_BLOCK(val)) {
			gob->flags = 0;
			for (val = VAL_BLK(val); NOT_END(val); val++) {
				if (IS_WORD(val)) Set_Gob_Flag(gob, val);
			}
		}
		break;

	case SYM_OWNER:
		if (IS_GOB(val))
			GOB_TMP_OWNER(gob) = VAL_GOB(val);
		else
			return FALSE;
		break;

	default:
			return FALSE;
	}
	return TRUE;
}
Esempio n. 9
0
int xform_chk(Data_Obj *dpto,Data_Obj *dpfr,Data_Obj *xform)
{
	if( dpto==NO_OBJ || dpfr==NO_OBJ || xform==NO_OBJ )
		return(-1);

	if( !IS_IMAGE(xform) ){
		sprintf(DEFAULT_ERROR_STRING,
	"xform_chk:  transformation %s must be a matrix (image)",
			OBJ_NAME(xform));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( OBJ_COMPS(xform) != 1 ){
		sprintf(DEFAULT_ERROR_STRING,
	"xform_chk:  transform matrix %s must have single-component elements",OBJ_NAME(xform));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( OBJ_COMPS(dpto) != OBJ_ROWS(xform) ){
		sprintf(DEFAULT_ERROR_STRING,
	"xform_chk:  target %s component dimension (%d) must match # rows of xform %s (%d)",
			OBJ_NAME(dpto),OBJ_COMPS(dpto),OBJ_NAME(xform),OBJ_ROWS(xform));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( OBJ_COMPS(dpfr) != OBJ_COLS(xform) ){
		sprintf(DEFAULT_ERROR_STRING,
	"xform_chk:  source %s component dimension (%d) must match # columns of xform %s (%d)",
			OBJ_NAME(dpto),OBJ_COMPS(dpto),OBJ_NAME(xform),OBJ_ROWS(xform));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( OBJ_N_TYPE_ELTS(dpto)/OBJ_COMPS(dpto) != OBJ_N_TYPE_ELTS(dpfr)/OBJ_COMPS(dpfr) ){
		sprintf(DEFAULT_ERROR_STRING,
	"xform_chk:  target %s (%d/%d) and source %s (%d/%d) must have same # of elements",
			OBJ_NAME(dpto),OBJ_N_TYPE_ELTS(dpto),OBJ_COMPS(dpto),
			OBJ_NAME(dpfr),OBJ_N_TYPE_ELTS(dpfr),OBJ_COMPS(dpfr));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}

	/* BUG these contiguity requirements may no longer be necessary... */

	if( !is_contiguous(DEFAULT_QSP_ARG  dpto) ){
		sprintf(DEFAULT_ERROR_STRING,
			"xform_chk:  xform target %s must be contiguous",OBJ_NAME(dpto));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( !is_contiguous(DEFAULT_QSP_ARG  dpfr) ){
		sprintf(DEFAULT_ERROR_STRING,
			"xform_chk:  xform source %s must be contiguous",OBJ_NAME(dpfr));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	if( !is_contiguous(DEFAULT_QSP_ARG  xform) ){
		sprintf(DEFAULT_ERROR_STRING,
			"xform_chk:  xform %s must be contiguous",OBJ_NAME(xform));
		NWARN(DEFAULT_ERROR_STRING);
		return(-1);
	}
	return(0);
} // end xform_chk
Esempio n. 10
0
File: n-loop.c Progetto: mbk/ren-c
*/	static REB_R Loop_Each(struct Reb_Call *call_, REBINT mode)
/*
**		Supports these natives (modes):
**			0: foreach
**			1: remove-each
**			2: map
**
***********************************************************************/
{
	REBSER *body;
	REBVAL *vars;
	REBVAL *words;
	REBSER *frame;
	REBVAL *value;
	REBSER *series;
	REBSER *out;	// output block (for MAP, mode = 2)

	REBINT index;	// !!!! should these be REBCNT?
	REBINT tail;
	REBINT windex;	// write
	REBINT rindex;	// read
	REBINT err;
	REBCNT i;
	REBCNT j;
	REBVAL *ds;

	assert(mode >= 0 && mode < 3);

	value = D_ARG(2); // series
	if (IS_NONE(value)) return R_NONE;

	body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
	SET_OBJECT(D_ARG(1), frame); // keep GC safe
	Set_Block(D_ARG(3), body);	 // keep GC safe

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

	// If it's MAP, create result block:
	if (mode == 2) {
		out = Make_Block(VAL_LEN(value));
		SAVE_SERIES(out);
	}

	// Get series info:
	if (ANY_OBJECT(value)) {
		series = VAL_OBJ_FRAME(value);
		out = FRM_WORD_SERIES(series); // words (the out local reused)
		index = 1;
		//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
	}
	else if (IS_MAP(value)) {
		series = VAL_SERIES(value);
		index = 0;
		//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
	}
	else {
		series = VAL_SERIES(value);
		index  = VAL_INDEX(value);
		if (index >= cast(REBINT, SERIES_TAIL(series))) {
			if (mode == 1) {
				SET_INTEGER(D_OUT, 0);
			} else if (mode == 2) {
				Set_Block(D_OUT, out);
				UNSAVE_SERIES(out);
			}
			return R_OUT;
		}
	}

	windex = index;

	// Iterate over each value in the series block:
	while (index < (tail = SERIES_TAIL(series))) {

		rindex = index;  // remember starting spot
		j = 0;

		// Set the FOREACH loop variables from the series:
		for (i = 1; i < frame->tail; i++) {

			vars = FRM_VALUE(frame, i);
			words = FRM_WORD(frame, i);

			// var spec is WORD
			if (IS_WORD(words)) {

				if (index < tail) {

					if (ANY_BLOCK(value)) {
						*vars = *BLK_SKIP(series, index);
					}

					else if (ANY_OBJECT(value)) {
						if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) {
							// Alternate between word and value parts of object:
							if (j == 0) {
								Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
								if (NOT_END(vars+1)) index--; // reset index for the value part
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg_DEAD_END(words);
							j++;
						}
						else {
							// Do not evaluate this iteration
							index++;
							goto skip_hidden;
						}
					}

					else if (IS_VECTOR(value)) {
						Set_Vector_Value(vars, series, index);
					}

					else if (IS_MAP(value)) {
						REBVAL *val = BLK_SKIP(series, index | 1);
						if (!IS_NONE(val)) {
							if (j == 0) {
								*vars = *BLK_SKIP(series, index & ~1);
								if (IS_END(vars+1)) index++; // only words
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg_DEAD_END(words);
							j++;
						}
						else {
							index += 2;
							goto skip_hidden;
						}
					}

					else { // A string or binary
						if (IS_BINARY(value)) {
							SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
						}
						else if (IS_IMAGE(value)) {
							Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
						}
						else {
							VAL_SET(vars, REB_CHAR);
							VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
						}
					}
					index++;
				}
				else SET_NONE(vars);
			}

			// var spec is SET_WORD:
			else if (IS_SET_WORD(words)) {
				if (ANY_OBJECT(value) || IS_MAP(value)) {
					*vars = *value;
				} else {
					VAL_SET(vars, REB_BLOCK);
					VAL_SERIES(vars) = series;
					VAL_INDEX(vars) = index;
				}
				//if (index < tail) index++; // do not increment block.
			}
			else Trap_Arg_DEAD_END(words);
		}
		if (index == rindex) index++; //the word block has only set-words: foreach [a:] [1 2 3][]

		if (!DO_BLOCK(D_OUT, body, 0)) {
			if ((err = Check_Error(D_OUT)) >= 0) {
				index = rindex;
				break;
			}
			// else CONTINUE:
			if (mode == 1) SET_FALSE(D_OUT); // keep the value (for mode == 1)
		} else {
			err = 0; // prevent later test against uninitialized value
		}

		if (mode > 0) {
			//if (ANY_OBJECT(value)) Trap_Types_DEAD_END(words, REB_BLOCK, VAL_TYPE(value)); //check not needed

			// If FALSE return, copy values to the write location:
			if (mode == 1) {  // remove-each
				if (IS_CONDITIONAL_FALSE(D_OUT)) {
					REBCNT wide = SERIES_WIDE(series);
					// memory areas may overlap, so use memmove and not memcpy!
					memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide);
					windex += index - rindex;
					// old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++);
				}
			}
			else
				if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT); // (mode == 2)
		}
skip_hidden: ;
	}

	// Finish up:
	if (mode == 1) {
		// Remove hole (updates tail):
		if (windex < index) Remove_Series(series, windex, index - windex);
		SET_INTEGER(D_OUT, index - windex);

		return R_OUT;
	}

	// If MAP...
	if (mode == 2) {
		UNSAVE_SERIES(out);
		if (err != 2) {
			// ...and not BREAK/RETURN:
			Set_Block(D_OUT, out);
			return R_OUT;
		}
	}

	return R_OUT;
}
Esempio n. 11
0
*/	REBINT Effect_Gob(void *effects, REBSER *block)
/*
**		Handles all commands for the EFFECT dialect as specified
**		in the system/dialects/effect object.
**
**		This function calls the REBOL_Dialect interpreter to
**		parse the dialect and build and return the command number
**		(the index offset in the draw object above) and a block
**		of arguments. (For now, just a REBOL block, but this could
**		be changed to isolate it from changes in REBOL's internals).
**
**		Each arg will be of the specified datatype (given in the
**		dialect) or NONE when no argument of that type was given
**		and this code must determine the proper default value.
**
**		If the cmd result is zero, then it is either the end of
**		the block, or an error has occurred. If the error value
**		is non-zero, then it was an error.
**
***********************************************************************/
{
//	REBSER *block;
	REBCNT index = 0;
	REBINT cmd;
	REBSER *args = 0;
	REBVAL *arg;
	REBCNT nargs;

	//default values
	REBYTE def_color1[4] = {0,0,0,0};
	REBYTE def_color2[4] = {255,255,255,0};
	REBPAR def_pair = {1,0};

	do {
		cmd = Reb_Dialect(DIALECTS_EFFECT, block, &index, &args);

		if (cmd == 0) return 0;
		if (cmd < 0) {
//			Reb_Print("ERROR: %d, Index %d", -cmd, index);
			return -((REBINT)index+1);
		}
//		else
//			Reb_Print("EFFECT: Cmd %d, Index %d, Args %m", cmd, index, args);

		arg = BLK_HEAD(args);
		nargs = SERIES_TAIL(args);
//		Reb_Print("Number of args: %d", nargs);

		switch (cmd) {

		case EW_ADD:
			FX_Add(effects, ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1));
			break;
		case EW_ALPHAMUL:
			if (IS_IMAGE(arg))
				FX_Alphamul(effects, ARG_IMAGE(0), IS_NONE(arg+1) ? 127 : ARG_INTEGER(1));
			break;
		case EW_ASPECT:
			{
				REBINT type = 1, mode = 2;

				if (ARG_WORD(0) == EW_RESAMPLE){
						type = 2;
						mode = 1;
				}

				FX_Fit(effects,ARG_OPT_IMAGE(0), ARG_WORDS(type,EW_NEAREST,EW_GAUSSIAN), ARG_WORD(mode) == EW_RESAMPLE, IS_NONE(arg+3) ? 1.0 : ARG_DECIMAL(3), TRUE);
			}
			break;
		case EW_BLUR:
//			FX_Blur(effects, ARG_OPT_IMAGE(0));
			{
				REBDEC filter[9] = {0, 1, 0, 1, 1, 1, 0, 1, 0};
				FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 5.0, 0, FALSE);
			}
			break;
		case EW_COLORIFY:
			FX_Colorify(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1) , IS_NONE(arg+2) ? 255 : max(0, min(255,ARG_INTEGER(2))), ARG_OPT_IMAGE(0));
			break;
		case EW_COLORIZE:
			FX_Colorize(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1) , ARG_OPT_IMAGE(0));
			break;
		case EW_CONTRAST:
			FX_Contrast(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1), ARG_OPT_IMAGE(0));
			break;
		case EW_CONVOLVE:
			//[image! block! decimal! decimal! logic!]
			if (IS_BLOCK(arg+1)) {
				REBDEC filter[9];
				REBSER* mtx = (REBSER*)ARG_BLOCK(1);
				REBVAL* slot = BLK_HEAD(mtx);
				REBCNT len = SERIES_TAIL(mtx) ,i, num = 0;

				for (i = 0;i<len;i++){
					if (IS_DECIMAL(slot+i))
						filter[i] = VAL_DECIMAL(slot+i);
					else if (IS_INTEGER(slot+i))
						filter[i] = VAL_INT32(slot+i);
					else
						return -cmd;
					num++;
				}

				if (num != 9) return -cmd;

				FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , ARG_DECIMAL(2), ARG_INTEGER(3), ARG_LOGIC(4));
			}
			break;
		case EW_CROP:
			FX_Crop(effects,ARG_OPT_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2));
			break;
		case EW_DIFFERENCE:
			FX_Difference(effects, IS_NONE(arg+2) ? def_color2 : ARG_TUPLE(2), ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1), (IS_NONE(arg+2)) ? 1 : 0);
			break;

		case EW_EMBOSS:
			{
				REBDEC filter[9] = {-1, 0, 1, -2, 0, 2, -1, 0, 1};
				FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 6.0, 127, FALSE);
			}
			break;

		case EW_EXTEND:
			FX_Extend(effects,ARG_OPT_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2));
			break;

		case EW_FIT:
			if (IS_IMAGE(arg)){
				REBINT type = 1, mode = 2;
				if (ARG_WORD(0) == EW_RESAMPLE){
					type = 2;
					mode = 1;
				}

				FX_Fit(effects,ARG_IMAGE(0), ARG_WORDS(type,EW_NEAREST,EW_GAUSSIAN), ARG_WORD(mode) == EW_RESAMPLE, IS_NONE(arg+3) ? 1.0 : ARG_DECIMAL(3), FALSE);
			}
			break;

		case EW_FLIP:
			FX_Flip(effects, IS_NONE(arg+1) ? &def_pair : &ARG_PAIR(1), ARG_OPT_IMAGE(0));
			break;

		case EW_GRADCOL:
			FX_Gradcol(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3),ARG_OPT_IMAGE(0));
			break;

		case EW_GRADIENT:
			FX_Gradient(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3), ARG_OPT_IMAGE(0));
			break;

		case EW_GRADMUL:
			FX_Gradmul(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3), ARG_OPT_IMAGE(0));
			break;

		case EW_GRAYSCALE:
			FX_Grayscale(effects,ARG_OPT_IMAGE(0));
			break;

		case EW_HSV:
			FX_HSV(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1), ARG_OPT_IMAGE(0));
			break;

		case EW_INVERT:
			FX_Invert(effects,ARG_OPT_IMAGE(0));
			break;
		case EW_KEY:
			if (IS_IMAGE(arg))
				FX_Key(effects, IS_NONE(arg+1) ? def_color1 : ARG_TUPLE(1), ARG_IMAGE(0));
			break;
		case EW_LUMA:
			FX_Luma(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1),ARG_OPT_IMAGE(0));
			break;

		case EW_MIX:
			FX_Mix(effects, ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1));
			break;

		case EW_MULTIPLY:
			{
				REBINT i = 0x00FFFFFF;
				REBYTE* color = (REBYTE*)&i;
				if (IS_INTEGER(arg+3)) {
					i = ARG_INTEGER(3);
					i = i + (i << 8) + (i << 16);
				} else if (IS_TUPLE(arg+2))
					color = ARG_TUPLE(2);
				FX_Multiply(effects, color ,ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1), (IS_NONE(arg+2) &&  IS_NONE(arg+3)) ? 1 : 0);
			}
			break;

		case EW_REFLECT:
			FX_Reflect(effects, IS_NONE(arg+1) ? &def_pair : &ARG_PAIR(1), ARG_OPT_IMAGE(0));
			break;

		case EW_ROTATE:
			FX_Rotate(effects, IS_NONE(arg+1) ? 90 : ARG_INTEGER(1), ARG_OPT_IMAGE(0));
			break;
		case EW_SHADOW:
			if (IS_IMAGE(arg))
				FX_Shadow(effects, ARG_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2), IS_NONE(arg+3) ? 0 : ARG_TUPLE(3), IS_NONE(arg+4) ? 0 : ARG_DECIMAL(4), IS_NONE(arg+5) ? 0 : ARG_WORD(5) == EW_ONLY);
			break;
		case EW_SHARPEN:
//			FX_Sharpen(effects, ARG_OPT_IMAGE(0));
			{
				REBDEC filter[9] = {0, -1, 0, -1, 8, -1, 0, -1, 0};
				FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 4.0, 0, FALSE);
			}
			break;
		case EW_TILE:
			if (IS_IMAGE(arg))
				FX_Tile(effects, ARG_IMAGE(0), &ARG_PAIR(1));
			break;
		case EW_TILE_VIEW:
			if (IS_IMAGE(arg)) {
				REBPAR p;
				Effect_Offset(effects, &p);
				FX_Tile(effects, ARG_IMAGE(0), &p);
			}
			break;
		case EW_TINT:
			FX_Tint(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1),ARG_OPT_IMAGE(0));
			break;
		}
	} while (TRUE);
}
Esempio n. 12
0
*/	static REB_R Loop_Each(struct Reb_Call *call_, LOOP_MODE mode)
/*
**		Common implementation code of FOR-EACH, REMOVE-EACH, MAP-EACH,
**		and EVERY.
**
***********************************************************************/
{
	REBSER *body;
	REBVAL *vars;
	REBVAL *words;
	REBSER *frame;

	// `data` is the series/object/map/etc. being iterated over
	// Note: `data_is_object` flag is optimized out, but hints static analyzer
	REBVAL *data = D_ARG(2);
	REBSER *series;
	const REBOOL data_is_object = ANY_OBJECT(data);

	REBSER *out;	// output block (needed for MAP-EACH)

	REBINT index;	// !!!! should these be REBCNT?
	REBINT tail;
	REBINT windex;	// write
	REBINT rindex;	// read
	REBOOL break_with = FALSE;
	REBOOL every_true = TRUE;
	REBCNT i;
	REBCNT j;
	REBVAL *ds;

	if (IS_NONE(data)) return R_NONE;

	body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
	Val_Init_Object(D_ARG(1), frame); // keep GC safe
	Val_Init_Block(D_ARG(3), body); // keep GC safe

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

	if (mode == LOOP_MAP_EACH) {
		// Must be managed *and* saved...because we are accumulating results
		// into it, and those results must be protected from GC

		// !!! This means we cannot Free_Series in case of a BREAK, we
		// have to leave it to the GC.  Should there be a variant which
		// lets a series be a GC root for a temporary time even if it is
		// not SER_KEEP?

		out = Make_Array(VAL_LEN(data));
		MANAGE_SERIES(out);
		SAVE_SERIES(out);
	}

	// Get series info:
	if (data_is_object) {
		series = VAL_OBJ_FRAME(data);
		out = FRM_WORD_SERIES(series); // words (the out local reused)
		index = 1;
		//if (frame->tail > 3) raise Error_Invalid_Arg(FRM_WORD(frame, 3));
	}
	else if (IS_MAP(data)) {
		series = VAL_SERIES(data);
		index = 0;
		//if (frame->tail > 3) raise Error_Invalid_Arg(FRM_WORD(frame, 3));
	}
	else {
		series = VAL_SERIES(data);
		index  = VAL_INDEX(data);
		if (index >= cast(REBINT, SERIES_TAIL(series))) {
			if (mode == LOOP_REMOVE_EACH) {
				SET_INTEGER(D_OUT, 0);
			}
			else if (mode == LOOP_MAP_EACH) {
				UNSAVE_SERIES(out);
				Val_Init_Block(D_OUT, out);
			}
			return R_OUT;
		}
	}

	windex = index;

	// Iterate over each value in the data series block:
	while (index < (tail = SERIES_TAIL(series))) {

		rindex = index;  // remember starting spot
		j = 0;

		// Set the FOREACH loop variables from the series:
		for (i = 1; i < frame->tail; i++) {

			vars = FRM_VALUE(frame, i);
			words = FRM_WORD(frame, i);

			// var spec is WORD
			if (IS_WORD(words)) {

				if (index < tail) {

					if (ANY_BLOCK(data)) {
						*vars = *BLK_SKIP(series, index);
					}
					else if (data_is_object) {
						if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) {
							// Alternate between word and value parts of object:
							if (j == 0) {
								Val_Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
								if (NOT_END(vars+1)) index--; // reset index for the value part
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								raise Error_Invalid_Arg(words);
							j++;
						}
						else {
							// Do not evaluate this iteration
							index++;
							goto skip_hidden;
						}
					}
					else if (IS_VECTOR(data)) {
						Set_Vector_Value(vars, series, index);
					}
					else if (IS_MAP(data)) {
						REBVAL *val = BLK_SKIP(series, index | 1);
						if (!IS_NONE(val)) {
							if (j == 0) {
								*vars = *BLK_SKIP(series, index & ~1);
								if (IS_END(vars+1)) index++; // only words
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								raise Error_Invalid_Arg(words);
							j++;
						}
						else {
							index += 2;
							goto skip_hidden;
						}
					}
					else { // A string or binary
						if (IS_BINARY(data)) {
							SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
						}
						else if (IS_IMAGE(data)) {
							Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
						}
						else {
							VAL_SET(vars, REB_CHAR);
							VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
						}
					}
					index++;
				}
				else SET_NONE(vars);
			}
			// var spec is SET_WORD:
			else if (IS_SET_WORD(words)) {
				if (ANY_OBJECT(data) || IS_MAP(data))
					*vars = *data;
				else
					Val_Init_Block_Index(vars, series, index);

				//if (index < tail) index++; // do not increment block.
			}
			else
				raise Error_Invalid_Arg(words);
		}

		if (index == rindex) {
			// the word block has only set-words: for-each [a:] [1 2 3][]
			index++;
		}

		if (Do_Block_Throws(D_OUT, body, 0)) {
			if (IS_WORD(D_OUT) && VAL_WORD_SYM(D_OUT) == SYM_CONTINUE) {
				if (mode == LOOP_REMOVE_EACH) {
					// signal the post-body-execution processing that we
					// *do not* want to remove the element on a CONTINUE
					SET_FALSE(D_OUT);
				}
				else {
					// CONTINUE otherwise acts "as if" the loop body execution
					// returned an UNSET!
					SET_UNSET(D_OUT);
				}
			}
			else if (IS_WORD(D_OUT) && VAL_WORD_SYM(D_OUT) == SYM_BREAK) {
				// If it's a BREAK, get the /WITH value (UNSET! if no /WITH)
				// Though technically this doesn't really tell us if a
				// BREAK/WITH happened, as you can BREAK/WITH an UNSET!
				TAKE_THROWN_ARG(D_OUT, D_OUT);
				if (!IS_UNSET(D_OUT))
					break_with = TRUE;
				index = rindex;
				break;
			}
			else {
				// Any other kind of throw, with a WORD! name or otherwise...
				index = rindex;
				break;
			}
		}

		switch (mode) {
		case LOOP_FOR_EACH:
			// no action needed after body is run
			break;
		case LOOP_REMOVE_EACH:
			// If FALSE return, copy values to the write location
			// !!! Should UNSET! also act as conditional false here?  Error?
			if (IS_CONDITIONAL_FALSE(D_OUT)) {
				REBYTE wide = SERIES_WIDE(series);
				// memory areas may overlap, so use memmove and not memcpy!

				// !!! This seems a slow way to do it, but there's probably
				// not a lot that can be done as the series is expected to
				// be in a good state for the next iteration of the body. :-/
				memmove(
					series->data + (windex * wide),
					series->data + (rindex * wide),
					(index - rindex) * wide
				);
				windex += index - rindex;
			}
			break;
		case LOOP_MAP_EACH:
			// anything that's not an UNSET! will be added to the result
			if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT);
			break;
		case LOOP_EVERY:
			if (every_true) {
				// !!! This currently treats UNSET! as true, which ALL
				// effectively does right now.  That's likely a bad idea.
				// When ALL changes, so should this.
				//
				every_true = IS_CONDITIONAL_TRUE(D_OUT);
			}
			break;
		default:
			assert(FALSE);
		}
skip_hidden: ;
	}

	switch (mode) {
	case LOOP_FOR_EACH:
		// Nothing to do but return last result (will be UNSET! if an
		// ordinary BREAK was used, the /WITH if a BREAK/WITH was used,
		// and an UNSET! if the last loop iteration did a CONTINUE.)
		return R_OUT;

	case LOOP_REMOVE_EACH:
		// Remove hole (updates tail):
		if (windex < index) Remove_Series(series, windex, index - windex);
		SET_INTEGER(D_OUT, index - windex);

		return R_OUT;

	case LOOP_MAP_EACH:
		UNSAVE_SERIES(out);
		if (break_with) {
			// If BREAK is given a /WITH parameter that is not an UNSET!, it
			// is assumed that you want to override the accumulated mapped
			// data so far and return the /WITH value. (which will be in
			// D_OUT when the loop above is `break`-ed)

			// !!! Would be nice if we could Free_Series(out), but it is owned
			// by GC (we had to make it that way to use SAVE_SERIES on it)
			return R_OUT;
		}

		// If you BREAK/WITH an UNSET! (or just use a BREAK that has no
		// /WITH, which is indistinguishable in the thrown value) then it
		// returns the accumulated results so far up to the break.

		Val_Init_Block(D_OUT, out);
		return R_OUT;

	case LOOP_EVERY:
		// Result is the cumulative TRUE? state of all the input (with any
		// unsets taken out of the consideration).  The last TRUE? input
		// if all valid and NONE! otherwise.  (Like ALL.)  If the loop
		// never runs, `every_true` will be TRUE *but* D_OUT will be NONE!
		if (!every_true)
			SET_NONE(D_OUT);
		return R_OUT;
	}

	DEAD_END;
}