calc/cal/xx_print.cal

/*
 * xx_print - demo print object routines
 *
 * Copyright (C) 1999  Ernest Bowen
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:	1997/04/17 00:08:50
 * File existed as early as:	1997
 *
 * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
 */


global listmax = 3;
global matrowmax = 3;
global matcolmax = 3;
print "globals listmax, matrowmax, matcolmax defined; all assigned value 3";
print;

global blkmax = 8;
print "global blkmax defined, assigned value 8";
print;

B = blk();
define is_octet(a) = istype(a, B[0]);

define list_print(a) {
	local i;
	print "(":;
	for (i = 0; i < size(a); i++) {
		if (i > 0)
			print ",":;
		if (i >= listmax) {
			print "...":;
			break;
		}
		print a[[i]]:;
	}
	print ")":;
}

define mat_print (a) {
	local i, j;

	if (matdim(a) == 1) {
		for (i = 0; i < size(a); i++) {
			if (i >= matrowmax) {
				printf("  ...");
				break;
			}
			printf("%8d", a[i]);
		}
		return;
	}
	if (matdim(a) > 2)
		quit "Dimension for mat_print greater than 2";

	for (i = matmin(a,1); i <= matmax(a,1); i++) {
		if (i >= matmin(a,1) + matcolmax) {
			print "	    ...";
			break;
		}
		for (j = matmin(a,2); j <= matmax(a,2); j++) {
			if (j >= matmin(a,2) + matrowmax) {
				printf("   ...");
				break;
			}
			printf("%8d", a[i,j]);
		}
		print;
	}
}

define octet_print(a) {
	switch(a) {
		case 8: print "BS":;
			return;
		case 9: print "HT":;
			return;
		case 10: print "NL":;
			return;
		case 12: print "FF":;
			return;
		case 13: print "CR":;
			return;
		case 27: print "ESC":;
			return;
	}
	if (a > 31 && a < 127)
		print char(a):;
	else
		print "Non-print":;
}


define blk_print(a) {
	local i, n;

	n = size(a);

	printf("Unnamed block with %d bytes of data\n", n);
	print "First few characters: ":;
	for (i = 0; i < n; i++) {
		if (i >= blkmax) {
			print "...",;
			break;
		}
		print a[i],;
	}
}


define nblk_print (a) {
	local n, i;

	n = size(a);

	printf("Block named \"%s\" with %d bytes of data\n", name(a), n);
	print "First few characters: ":;
	for (i = 0; i < n; i++) {
		if (i >= blkmax) {
			print "...",;
			break;
		}
		print a[i],;
	}
}


define strchar(a) {

	if (isstr(a))
		a = ord(a);

	else if (is_octet(a))
		a = a;		/* This converts octet to number */

	else if (!isint(a) || a < 0 || a > 255)
		quit "Bad argument for strchar";

	switch (a) {
		case 7: print "\\a":;
			return;
		case 8: print "\\b":;
			return;
		case 9: print "\\t":;
			return;
		case 10: print "\\n":;
			return;
		case 11: print "\\v":;
			return;
		case 12: print "\\f":;
			return;
		case 13: print "\\r":;
			return;
		case 27: print "\\e":;
			return;
		case 34: print "\\\"":;
			return;
		case 39: print "\\\'":;
			return;
		case 92: print "\\\\":;
			return;
	}
	if (a > 31 && a < 127) {
		print char(a):;
		return;
	}
	print "\\":;
	if (a >= 64) print a // 64:;
	a = a % 64;
	if (a >= 8) print a // 8:;
	a = a % 8;
	print a:;
}


define file_print(a) {
	local c;

	rewind(a);
	for (;;) {
		c = fgetc(a);
		if (iserror(c))
			quit "Failure when reading from file";
		if (isnull(c))
			break;
		strchar(c);
	}
	print;
}


define error_print(a) {
	local n = iserror(a);

	if (n == 10001) {
		print "1/0":;
		return;
	}
	if (n == 10002) {
		print "0/0":;
		return;
	}
	print strerror(a):;
}


L = list(1,2,3,4,5);

mat M1[5] = {1,2,3,4,5};

mat M2[4,4] = {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16};

B1 = blk() = {"A", "B", "C", "D"};
B2 = blk("sample") = {77, 102, 29, 13, 126, 8, 100, 27, 0, 1};

dummy = rm("-f", "xx_print.foo");
f = fopen("xx_print.foo", "w+");

fputstr(f, "alpha\nbeta\f\"gamma\"");
fputstr(f, "\x09delta\n");
fputstr(f, "\1\2\3");
fflush(f);

print "Here is a list:";
print L;
print;

print "A one-dimensional matrix:";
print M1;
print;

print "A two-dimensional matrix:";
print M2;
print;

print "An unnamed block:";
print B1;
print;

print "A named block with some special octets:";
print B2;
print;

print "A file:";
print f;
print;

undefine mat_print;

fclose(f);
print "f closed";
print;
dummy = rm("-f", "xx_print.foo");

mat M[7] = {1, 2, 3/0, 0/0, eval(2+3), fgetc(f), 7};
print "Here is a matrix with some \"errors\" as elements":
print M;
print;

define octet_print(a) {
	local b, x;
	x = a;

	for (b = 128; b; b >>= 1)
		print (x >= b ? (x -= b, 1) : 0):;
}

print "Here is the earlier block with a new octet_print()";
print B1;
print;