/* --- Copyright University of Sussex 1990.	 All rights reserved. ---------
 > File:		C.sun/lib/sun/suniconfile.p
 > Purpose:		Read or write rasters in format used by Sun's icontool
 > Author:		Ben Rubinstein, Mar 23 1987 (see revisions)
 > Documentation:	HELP *PWMRASTERS
 > Related Files:	LIB * SUNRASTERFILE
 */
compile_mode :pop11 +strict;

/*
	suniconfile(<string>) -> <array>
	<array> -> suniconfile(<string>)

Saves or loads a raster array in the format used by icontool.
*/

;;; poppwmlib needed for pwm_make_rasterarray
uses-now poppwmlib;

section $-library => suniconfile;

define suniconfile(filename) -> picarr;
	lvars filename, file, rep, x, width, height, len, bytec, picarr, pic;

	;;; data in this format comes in the form "0xAABB" where AA and BB are
	;;; two bytes each in two hex digits.
	define lconstant twohexbytes(word) -> b1 -> b2;
		lvars word, b1, b2;

		define lconstant hex_atoi(char) -> val;
			lvars char, val;
			checkinteger(char, `0`, `F`);
			char fi_- `0` -> val;
			if val fi_> 9 then val fi_- #_< `A` - `9` - 1 >_# -> val endif;
		enddefine;

		unless word.isword and word.datalength == 6
		and subscrw(1, word) == `0` and subscrw(2, word) == `x`
		then	mishap(filename, word, 2, 'bad data format')
		endunless;
		hex_atoi(subscrw(3, word)) * 16 + hex_atoi(subscrw(4, word)) -> b1;
		hex_atoi(subscrw(5, word)) * 16 + hex_atoi(subscrw(6, word)) -> b2;
	enddefine;

	define lconstant needitem(rep,item);
	lvars rep, item, res;
		unless (rep()->>res) == item then
			mishap(res, 1, 'Unexpected item found reading to ' sys_>< item)
		endunless
	enddefine;

	unless (discin(filename) ->> file) then
		mishap(filename, 1, 'No such file');
	endunless;

	incharitem(file) -> rep;

	;;;modify the item type of / an * to get the comment and 0
	;;;so it binds to 0x????
	1 -> item_chartype(`/`,rep);
	1 -> item_chartype(`*`,rep);
	1 -> item_chartype(`0`,rep);

	;;; prevent apostrophes in comments causing trouble
	1 -> item_chartype(`'`,rep);
	1 -> item_chartype(`\``,rep);

	;;;read to the start of the Format spec
	repeat
		;;; Changed by A.S.12/07/90 to ignore everything up to Format spec
		rep() -> x;
		if x == termin then
			mishap(filename,1,'File does not contain "Format_version"');
		endif;
	quitif(x == "Format_version");
	endrepeat;

	;;; Now get format data
	needitem(rep,"=");
	needitem(rep,1);
	needitem(rep,",");
	needitem(rep,"Width");
	needitem(rep,"=");
	rep() -> width; checkinteger(width,1,false);
	needitem(rep,",");
	needitem(rep,"Height");
	needitem(rep,"=");
	rep() -> height; checkinteger(height,1,false);
	needitem(rep,",");
	needitem(rep,"Depth");
	needitem(rep,"=");
	needitem(rep,1);
	needitem(rep,",");
	needitem(rep,"Valid_bits_per_item");
	needitem(rep,"=");
	needitem(rep,16);

	;;;read the rest of the comment
	until (rep() ->> x ) == "*/" or x == termin do enduntil;

	pwm_make_rasterarray([%1, width, 1, height%], 1) -> picarr;
	picarr.arrayvector -> pic;
	0 -> bytec;
	datalength(pic) div 8 -> len;		;;;assumes no padding
	until (rep() ->> x) == termin or bytec >= len do

			twohexbytes(x) -> fast_subscrs(bytec fi_+ 1 ->> bytec, pic),
							-> fast_subscrs(bytec fi_+ 1 ->> bytec, pic);

			quitif((rep() ->> x) == termin);
			unless x == "," then mishap(filename, x, 2, 'bad format'); endunless;
	enduntil;

	;;;SUN seem to assume that images are padded by nulls
	;;; cf /usr/include/images/off.pr

enddefine;

define updaterof suniconfile(raster, filename);
	lvars raster, filename, i, x, l, x1, x2, y1, y2;
	dlocal cucharout;

	unless raster.arrayvector.datakey.class_spec == 1 then
		mishap(raster, 1, 'RASTER ARRAY MUST BE OF DEPTH 1');
	endunless;

	raster.boundslist.explode -> y2 -> y1 -> x2 -> x1;

	discout(filename) -> cucharout;

	raster.arrayvector -> raster;
	raster.datalength / 8 -> l;
	unless l.isinteger then mishap(0, 'badly formatted raster array') endunless;

	;;; should be changed to use printf?
	syspr(('/* Format_version=1, Width=' sys_>< (x2 - x1 + 1))
			sys_>< ', Height=' sys_><
			((y2 -y1 + 1) sys_>< ', Depth=1, Valid_bits_per_item=16\n */\n\t'));

	0 -> x;
	for i from 1 by 2 to (l - 3) do
		format_print('0x~2,`0X~2,`0X,',
				[% fast_subscrs(i, raster), fast_subscrs(i + 1, raster) %]);
		x + 2 -> x;
		if x = 16 then 0 -> x; pr('\n\t'); endif;
	endfor;
	format_print('0x~2,`0X~2,`0X', [% (raster(l - 1)), (raster(l)) %]);
	cucharout(`\n`);
	cucharout(termin);
enddefine;

endsection;


/* --- Revision History ---------------------------------------------------
--- Aaron Sloman, Jul 12 1990
	Anthony Worrall totally reorganised the selector procedure,
	including making it cope with blank lines and avoiding reading
	the whole file as a list of strings.

	Aaron Sloman slightly generalised it and replaced "pr" with
	"syspr", "><" with "sys_><" etc.

	Added "uses poppwmlib" Changed to use -pwm_make_rasterarray-
 */
