From: Panayotis Skordos Date: Wed, 10 Aug 1988 05:26:54 +0000 (+0000) Subject: added halftoning routines: psam, ht-od, ht-bn, ht-ibn X-Git-Tag: 20090517-FFI~12625 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f061cd2d7db17eafff36e406c76699046cb92749;p=mit-scheme.git added halftoning routines: psam, ht-od, ht-bn, ht-ibn added image-laplacian, image-double-by-interpolation, write-image-2bint --- diff --git a/v7/src/microcode/image.c b/v7/src/microcode/image.c index 478feaba0..add9958e1 100644 --- a/v7/src/microcode/image.c +++ b/v7/src/microcode/image.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.25 1987/10/21 03:44:33 pas Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.26 1988/08/10 05:26:54 pas Exp $ */ #include "scheme.h" #include "primitive.h" @@ -166,7 +166,6 @@ Define_Primitive(Prim_Read_Image_From_2bint_File, 1, "READ-IMAGE-FROM-2BINT-FILE int Error_Number; long allocated_cells; Boolean Open_File(); - float x_origin, y_origin; int foo1,foo2; Primitive_1_Args(); @@ -207,6 +206,47 @@ Define_Primitive(Prim_Read_Image_From_2bint_File, 1, "READ-IMAGE-FROM-2BINT-FILE return Result; } +Define_Primitive(Prim_Write_Image_2bint, 2, "WRITE-IMAGE-2BINT") +{ long Length, i,j; + Pointer Pnrows, Pncols, Prest, Parray; + REAL *Array; + int nrows, ncols, number,foo1,foo2; + FILE *fopen(), *fp; + char *file_string; int Error_Number; Boolean Open_File(); + + Primitive_2_Args(); + Arg_1_Type(TC_LIST); /* image = (nrows ncols array) */ + Arg_2_Type(TC_CHARACTER_STRING); + if (!(Open_File(Arg2, "w", &fp))) Primitive_Error(ERR_ARG_2_BAD_RANGE); + + Pnrows = Vector_Ref(Arg1, CONS_CAR); + Prest = Vector_Ref(Arg1, CONS_CDR); + Pncols = Vector_Ref(Prest, CONS_CAR); + Prest = Vector_Ref(Prest, CONS_CDR); + Parray = Vector_Ref(Prest, CONS_CAR); + if (Vector_Ref(Prest, CONS_CDR) != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE); + if (Type_Code(Parray) != TC_ARRAY) Primitive_Error(ERR_ARG_1_WRONG_TYPE); + /* */ + Range_Check(nrows, Pnrows, 0, 1024, ERR_ARG_1_BAD_RANGE); /* arbitrary size bound on images */ + Range_Check(ncols, Pncols, 0, 1024, ERR_ARG_1_BAD_RANGE); + Length = nrows * ncols; + Array = Scheme_Array_To_C_Array(Parray); + + /*_________________________________*/ + putw(nrows, fp); /* putw is 4 bytes on bobcats */ + putw(ncols, fp); /* so below use putc */ + for (i=0;i>8); /* high order byte */ + putc(foo1, fp); + putc(foo2, fp); /* low order byte */ + } + Close_File(fp); + /*_________________________________*/ + PRIMITIVE_RETURN(TRUTH); +} + Define_Primitive(Prim_Read_Image_From_CTSCAN_File, 1, "READ-IMAGE-FROM-CTSCAN-FILE") { long Length, i,j; long nrows, ncols, array_index; @@ -305,7 +345,6 @@ Define_Primitive(Prim_Subimage, 5, "SUBIMAGE") Pointer Pnrows, Pncols, Prest, Parray; long lrow, hrow, lcol, hcol; long nrows, ncols, new_nrows, new_ncols; - REAL *Array, *To_Here; Pointer Result, Array_Data_Result, *Orig_Free; int Error_Number; @@ -321,8 +360,8 @@ Define_Primitive(Prim_Subimage, 5, "SUBIMAGE") if (Vector_Ref(Prest, CONS_CDR) != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE); if (Type_Code(Parray) != TC_ARRAY) Primitive_Error(ERR_ARG_1_WRONG_TYPE); - Range_Check(nrows, Pnrows, 0, 512, ERR_ARG_1_BAD_RANGE); - Range_Check(ncols, Pncols, 0, 512, ERR_ARG_1_BAD_RANGE); + Range_Check(nrows, Pnrows, 0, 1024, ERR_ARG_1_BAD_RANGE); + Range_Check(ncols, Pncols, 0, 1024, ERR_ARG_1_BAD_RANGE); Range_Check(lrow, Arg2, 0, nrows, ERR_ARG_2_BAD_RANGE); Range_Check(hrow, Arg3, lrow, nrows, ERR_ARG_3_BAD_RANGE); @@ -423,8 +462,8 @@ Define_Primitive(Prim_Image_Set_Row, 3, "IMAGE-SET-ROW!") if (Vector_Ref(Prest, CONS_CDR) != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE); if (Type_Code(Parray) != TC_ARRAY) Primitive_Error(ERR_ARG_1_WRONG_TYPE); - Range_Check(nrows, Pnrows, 0, 512, ERR_ARG_1_BAD_RANGE); - Range_Check(ncols, Pncols, 0, 512, ERR_ARG_1_BAD_RANGE); + Range_Check(nrows, Pnrows, 0, 1024, ERR_ARG_1_BAD_RANGE); + Range_Check(ncols, Pncols, 0, 1024, ERR_ARG_1_BAD_RANGE); Arg_2_Type(TC_FIXNUM); Range_Check(row_to_set, Arg2, 0, (nrows-1), ERR_ARG_2_BAD_RANGE); @@ -453,8 +492,8 @@ Define_Primitive(Prim_Image_Set_Column, 3, "IMAGE-SET-COLUMN!") if (Vector_Ref(Prest, CONS_CDR) != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE); if (Type_Code(Parray) != TC_ARRAY) Primitive_Error(ERR_ARG_1_WRONG_TYPE); - Range_Check(nrows, Pnrows, 0, 512, ERR_ARG_1_BAD_RANGE); - Range_Check(ncols, Pncols, 0, 512, ERR_ARG_1_BAD_RANGE); + Range_Check(nrows, Pnrows, 0, 1024, ERR_ARG_1_BAD_RANGE); + Range_Check(ncols, Pncols, 0, 1024, ERR_ARG_1_BAD_RANGE); Arg_2_Type(TC_FIXNUM); Range_Check(col_to_set, Arg2, 0, (nrows-1), ERR_ARG_2_BAD_RANGE); @@ -490,7 +529,158 @@ long nrows, ncols, col_to_set; To_Here += nrows; } } - + +Define_Primitive(Prim_Image_Laplacian, 1, "IMAGE-LAPLACIAN") +{ long nrows, ncols, Length; + Pointer Pnrows, Pncols, Prest, Parray; + REAL *Array, *To_Here; + Pointer Result, Array_Data_Result, *Orig_Free; + long allocated_cells; + /* */ + Primitive_1_Args(); + Arg_1_Type(TC_LIST); /* image = (nrows ncols array) */ + Pnrows = Vector_Ref(Arg1, CONS_CAR); + Prest = Vector_Ref(Arg1, CONS_CDR); + Pncols = Vector_Ref(Prest, CONS_CAR); + Prest = Vector_Ref(Prest, CONS_CDR); + Parray = Vector_Ref(Prest, CONS_CAR); + if (Vector_Ref(Prest, CONS_CDR) != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE); + if (Type_Code(Parray) != TC_ARRAY) Primitive_Error(ERR_ARG_1_WRONG_TYPE); + /* */ + Range_Check(nrows, Pnrows, 0, 1024, ERR_ARG_1_BAD_RANGE); + Range_Check(ncols, Pncols, 0, 1024, ERR_ARG_1_BAD_RANGE); + Length=nrows*ncols; + /* */ + /* ALLOCATE SPACE */ + Primitive_GC_If_Needed(6); + Orig_Free = Free; + Free += 6; + Result = Make_Pointer(TC_LIST, Orig_Free); + *Orig_Free++ = Make_Non_Pointer(TC_FIXNUM, nrows); + *Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1); + Orig_Free++; + *Orig_Free++ = Make_Non_Pointer(TC_FIXNUM, ncols); + *Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1); + Orig_Free++; + Allocate_Array(Array_Data_Result, Length, allocated_cells); + *Orig_Free++ = Array_Data_Result; + *Orig_Free = NIL; + /* END ALLOCATION */ + /* */ + Array = Scheme_Array_To_C_Array(Parray); + C_image_laplacian(Array, (Scheme_Array_To_C_Array(Array_Data_Result)), nrows, ncols); + PRIMITIVE_RETURN(Result); +} + +/* Laplacian form [4,-1,-1,-1,-1]/4 + A(i,j) --> Array[i*ncols + j] + With no knowledge outside boundary, assume laplace(edge-point)=0.0 (no wrap-around, no artificial bndry) + */ +C_image_laplacian(array, new_array, nrows, ncols) + REAL *array, *new_array; + long nrows, ncols; +{ long i,j, nrows1, ncols1; + nrows1=nrows-1; ncols1=ncols-1; + if ((nrows<2)||(ncols<2)) return(1); /* no need todo anything for 1-point image */ + /* */ + i=0;j=0; new_array[i*ncols+j] = 0.0; /* NE corner */ + i=0;j=ncols1; new_array[i*ncols+j] = 0.0; /* NW corner */ + i=nrows1;j=0; new_array[i*ncols+j] = 0.0; /* SE corner */ + i=nrows1;j=ncols1; new_array[i*ncols+j] = 0.0; /* SW corner */ + i=0; for (j=1;j Array[i*ncols + j] + magnification in a south-east direction (i.e. replication of pixels in South-East corner) + */ +C_image_double_by_interpolation(array, new_array, nrows, ncols) + REAL *array, *new_array; + long nrows, ncols; +{ long i,j, nrows1, ncols1, nrows2, ncols2; + nrows1=nrows-1; ncols1=ncols-1; + nrows2=2*nrows; ncols2=2*ncols; + if ((nrows<2)||(ncols<2)) return(1); /* no need todo anything for 1-point image */ + /* */ + i=nrows1; for (j=0;j