/*  --- Copyright University of Sussex 1986.  All rights reserved. ---------
 > File:    C.all/lib/sun/pwmsungraph.p
 > Purpose: Obsolete (pre 12.3) PWM graphic functions
 > Author:  Ben Rubinstein, Apr  1 1986 (see revisions)
 > Documentation:   HELP * PWMGRAPHICS
 */

#_TERMIN_IF DEF POPC_COMPILING

uses poppwmlib;

section $-library => pwmsungraph
				pwm_grafselected pwm_grafselect pwm_grafwipe pwm_grafline
				pwm_grafparams pwm_grafcopyraster pwm_graftext pwm_grafpixel
				pwm_grafsaveraster pwm_grafloadraster pwm_grafsetmapentry
				pwm_grafgetmapentry pwmsun_grafnewcms pwmsun_grafusecms
				pwmsun_grafkillcms pwm_grafdumpraster pwm_grafreadraster;

section $-library$-pwmlib =>
				pwm_grafselected pwm_grafselect pwm_grafwipe pwm_grafline
				pwm_grafparams pwm_grafcopyraster pwm_graftext pwm_grafpixel
				pwm_grafsaveraster pwm_grafloadraster pwm_grafsetmapentry
				pwm_grafgetmapentry pwmsun_grafnewcms pwmsun_grafusecms
				pwmsun_grafkillcms pwm_grafdumpraster pwm_grafreadraster;

global vars pwm_grafselected = 0;
;;;
define global pwm_grafselect(win);
	lvars win;
	win -> pwmgfxsurface;
	win -> pwm_grafselected;
enddefine;

global vars pwm_grafwipe = pwm_gfxwipearea;

global vars pwm_grafline = pwm_gfxdrawline;

define global pwm_grafparams(op, val);
	lvars op, val;
	op  -> pwmgfxrasterop;
	val -> pwmgfxpaintnum;
enddefine;

global vars pwm_grafcopyraster = pwm_gfxcopyraster;

global vars pwm_graftext = pwm_gfxtext;

global vars pwm_grafpixel = pwm_gfxpixel;

global vars pwm_grafsaveraster = pwm_gfxwriterasterfile;

global vars pwm_grafloadraster = pwm_gfxreadrasterfile;

define global pwm_grafsetmapentry(entry, vals);
	lvars entry vals;
	if vals.islist then
		pwm_gfxsetmapentry(entry, vals.destlist.erase)
	else
		pwm_gfxsetmapentry(entry, vals)
	endif;
enddefine;

define global pwm_grafgetmapentry(entry) -> list;
	lvars entry list;
	if (pwm_gfxgetmapentry(entry) ->> list) then
		[% list.destvector.erase %] -> list
	endif;
enddefine;

global vars pwmsun_grafnewcms = pwmsun_gfxnewcms;
global vars pwmsun_grafusecms = pwmsun_gfxusecms;
global vars pwmsun_grafkillcms = pwmsun_gfxkillcms;

define global pwm_grafdumpraster(height, depth, str);
	lvars len left top width height depth str hdr;
	vars cucharout;
	if str.isarray then
		pwm_gfxdumpraster(height, depth, str);	;;; actually left and top
	elseif str.isstring then
		-> width -> top -> left;
		pwm_gfxdumpraster(left, top,
				newpwmrasterarray([% 1, width, 1, height %], depth, str));
	else
		mishap(str, 1, 'BAD ARGUMENT: use a string or an array');
	endif;
enddefine;

define global pwm_grafreadraster(left, top, width, height, depth) -> s;
	lvars left top width height depth a s i j ppb bpl;
	if (lmember(depth, [1 8 2 4 4 2 8 1]) ->> ppb) then
		ppb.tl.hd -> ppb
	else
		mishap(depth, 1, 'depth must be power of two')
	endif;
	if (pwm_gfxloadraster(left, top, width, height) ->> a)
	and a.arrayvector.datakey.class_spec == depth then
		if (width * ppb // 8 -> bpl) > 0 then bpl + 1 -> bpl endif;
		inits(bpl + erase(bpl // 2)) -> s;
		0 ->> i -> j;
		a.arrayvector -> a;
		repeat height times
			repeat bpl times
				fast_subscrv(i fi_+ 1 ->> i, a)
					-> fast_subscrv(j fi_+ 1 ->> j, s);
			endrepeat;
			j fi_+ erase(bpl // 2) -> j;
		endrepeat;
	else
		false -> s;
	endif;
enddefine;

endsection;

global vars pwmsungraph = true; ;;; for loading with "uses"

endsection;


/* --- Revision History ---------------------------------------------------
--- Ben Rubinstein, Mar 27 1987 - fixed readraster for arrays and strings
--- Ben Rubinstein, Mar 17 1987 - fixed dumpraster for arrays and strings
--- Ben Rubinstein, Mar  9 1987 - fixed bug in getmapentry
--- Ben Rubinstein, Dec  7 1986 - redefined in terms of new (12.3) functions
--- Ben Rubinstein, Oct  7 1986 - pwmpr takes delimiter; also fixed fix to
						pwm_grafline
--- Ben Rubinstein, Sep 21 1986 - added colour and filing functions, and
						revised pwm_grafdumpraster to allow pwmrasters.
--- Ben Rubinstein, Jun 12 1986 - revised for new escape sequences; also
						fixed grafline to handle large numbers
--- Ben Rubinstein, May  8 1986 - added operation macros, copyraster
*/
