48 lines
1.2 KiB
Plaintext
48 lines
1.2 KiB
Plaintext
/* BITMAP FILE: write out a file in PPM format, P6 (binary). 14/5/2010 */
|
|
test: procedure options (main);
|
|
declare image (0:19,0:19) bit (24);
|
|
declare 1 pixel union,
|
|
2 color bit (24) aligned,
|
|
2 primaries,
|
|
3 R character (1),
|
|
3 G character (1),
|
|
3 B character (1);
|
|
declare ch character (1);
|
|
declare (i, j) fixed binary;
|
|
declare out file record;
|
|
|
|
open file (out) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) OUTPUT;
|
|
|
|
ch = 'P'; write file (out) from (ch);
|
|
ch = '6'; write file (out) from (ch);
|
|
|
|
call put_integer (hbound(image, 1));
|
|
call put_integer (hbound(image, 2));
|
|
call put_integer (255);
|
|
|
|
do i = 0 to hbound(image,1);
|
|
do j = 0 to hbound(image, 2);
|
|
color = image(i,j);
|
|
write file (out) from (R);
|
|
write file (out) from (G);
|
|
write file (out) from (B);
|
|
end;
|
|
end;
|
|
|
|
put_integer: procedure (k);
|
|
declare k fixed binary;
|
|
declare s character (30) varying;
|
|
declare i fixed binary;
|
|
declare ch character (1);
|
|
|
|
s = k;
|
|
s = trim(s);
|
|
do i = 1 to length(s);
|
|
ch = substr(s, i, 1);
|
|
write file (out) from (ch);
|
|
end;
|
|
ch = '09'x;
|
|
write file (out) from (ch);
|
|
end put_integer;
|
|
end test;
|