h48089

s 00237/00000/00000

d D 1.1 91/03/08 04:48:42 hopkins 1 0

c date and time created 91/03/08 04:48:42 by hopkins

e

u

U

f e 0

t

T

I 1
#include <hn.h>

/*********************************************************************
 * Operations on matrices
 */

matrixtype mtranslate(matrixtype m, float x, float y)
{
	m = (matrixtype)copy(m,matrix);
	m[4] = x;
	m[5] = y;
	return m;
}

/*********************************************************************
 * set XOR raster opcode, do it so that on a background color bg
 * the xor operation produces the fg color.
 */

void setxorop(colortype bg, colortype fg)
{
	int cp;

	setcolor(fg);
	cp = currentpixel();
	setcolor(bg);
	setpixel(cp ^ currentpixel);
	setrasteropcode(6);
}

/*********************************************************************
 * operations on rectangles
 */

boolean rectinrect(rectangle big, rectangle small)
{
	return pointinrect(big,small[0],small[1]) &&
	       pointinrect(big,small[0] + small[2],small[1] + small[3]);
}

rectangle insetstroke(float n, rectangle r)
{
	float m = n*2 + 1;
	return [r[0] + n, r[1] + n + 1, r[2] - m, r[3] - m];
}

/*********************************************************************
 * Get the true type of an object. Same as truetype but may also
 * return /tnttype for a TNT object and /hntype for a HN object.
 */

name truedicttype(any thing)
{
	name t = truetype(thing);
	dicttype *p;
	int len;

	if (t != /dicttype) 
		return t;
	if (!known((dicttype)thing,/ParentDictArray)) 
		return /dicttype;
	p = (dicttype *)((dicttype)thing)[/ParentDictArray];
	if (type(p) != /arraytype)
		return /tnttype;
	if (len = length(p))
		return known(p[len-1],/superclass) ? /hntype : /tnttype;
	else
		return /tnttype;
}

/*********************************************************************
 * Compare two objects. A deep compare.
 * NOTE: dictionaries are never equal to anything but themselves.
 */

boolean cmp(any p1, any p2)
{
	name t;
	any *a1, *a2;
	int i;

	if (p1 == p2)
		return true;
	if ((t = truedicttype(p1)) != truedicttype(p2))
		return false;
	switch (t) {
	case /arraytype:
	case /packedarraytype:
		if (length(a1 = (any *)p1) != length(a2 = (any *)p2))
			return false;
		for (i = length(a1) ; i-- ;)
			if (!cmp(a1[i],a2[i]))
				return false;
		return true;
	default:
		return false;
	}
}

/*********************************************************************
 * Literal character. Does the same as "cvis lisstring" but 4 time faster.
 */

char *lit_char(int n)
{
	char *str;

	switch (n) {
	case '\n':	return "\\n";
	case '\t':	return "\\t";
	case '\r':	return "\\r";
	case '\f':	return "\\f";
	case '\\':	return "\\\\";
	case '(':	return "\\(";
	case ')':	return "\\)";
	default:
		if ((n < ' ') || (n > '~')) {
			str = "\\000";
			str[1] = '0' + ((n >> 6) & 003);
			str[2] = '0' + ((n >> 3) & 007);
			str[3] = '0' + (n & 007);
		} else {
			str = " ";
			str[0] = n;
		}
		return str;
	}
}

/*********************************************************************
 * Check if a name is ok. A name is not ok when it contains
 * special PostScript characters.
 */

char *name_ok_str = string(256);

#postscript
( ) 0 get 1 add 1 (~)  0 get {name_ok_str exch 1 put} for
(\(\)\<\>\[\]\{\}\/\%\\) {name_ok_str exch 0 put} forall
#end

boolean name_ok(name nm)
{
	char *str = cvns(nm);
	int n;

	forall (; n ; str)
		if (!name_ok_str[n])
			return false;
	return true;
}

/*********************************************************************
 * Given an x position compute a character offset in a string.
 * Use binary search to minimize the number of stringwidth operations.
 */

int stringpos_bin(char *str, float x)
{
	int len, mid;
	char *s;
	float w;

	if ((len = length(str)) == 0)
		return 0;
	if (len == 1)
		return (x > (stringwidthonly(str)/2)) ? 1 : 0;

	if (x < (w = stringwidthonly(s = getinterval(str,0,mid = len/2))))
		return stringpos_bin(s,x);
	else
		return mid + stringpos_bin(getinterval(str,mid,len-mid),x-w);
}

int stringpos(fonttype f, char *str, float x)
{
	int pos;
	fonttype tmp = currentfont;
	setfont(f);
	pos = stringpos_bin(str,x);
	setfont(tmp);
	return pos;
}

/*********************************************************************
 * save getinterval
 */

any *GetInterval(any *p, int n, int m)
{
	int len = length(p);

	n = min(n,len);
	m = min(m,len-n);

	return getinterval(p,n,m);
}

/*********************************************************************
 * debugging
 */

#postscript
systemdict /dbf known not {
	systemdict /dbf (/dev/console) (w) file put
	systemdict /DEBUG {	% any --
		dbf (DEBUG: ) writestring
		dbf exch 100 string cvs writestring
		dbf (\n) writestring
		dbf flushfile
	} put

	systemdict /STACK {
		10 dict begin
		/tf currentprocess /Stdout get def
		currentprocess /Stdout dbf put
		dbf (STACK: ) writestring
		stack
		dbf flushfile
		currentprocess /Stdout tf put
		end
	} put
} if
#end

/*********************************************************************
 * screen dimensions
 */

#postscript
gsave
framebuffer
clippath pathbbox points2rect
/screenheight exch def
/screenwidth exch def
grestore
#end

E 1