1/*
2 * xx_print - demo print object routines
3 *
4 * Copyright (C) 1999  Ernest Bowen
5 *
6 * Calc is open software; you can redistribute it and/or modify it under
7 * the terms of the version 2.1 of the GNU Lesser General Public License
8 * as published by the Free Software Foundation.
9 *
10 * Calc is distributed in the hope that it will be useful, but WITHOUT
11 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12 * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
13 * Public License for more details.
14 *
15 * A copy of version 2.1 of the GNU Lesser General Public License is
16 * distributed with calc under the filename COPYING-LGPL.  You should have
17 * received a copy with calc; if not, write to Free Software Foundation, Inc.
18 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
19 *
20 * Under source code control:	1997/04/17 00:08:50
21 * File existed as early as:	1997
22 *
23 * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
24 */
25
26
27global listmax = 3;
28global matrowmax = 3;
29global matcolmax = 3;
30print "globals listmax, matrowmax, matcolmax defined; all assigned value 3";
31print;
32
33global blkmax = 8;
34print "global blkmax defined, assigned value 8";
35print;
36
37B = blk();
38define is_octet(a) = istype(a, B[0]);
39
40define list_print(a) {
41	local i;
42	print "(":;
43	for (i = 0; i < size(a); i++) {
44		if (i > 0)
45			print ",":;
46		if (i >= listmax) {
47			print "...":;
48			break;
49		}
50		print a[[i]]:;
51	}
52	print ")":;
53}
54
55define mat_print (a) {
56	local i, j;
57
58	if (matdim(a) == 1) {
59		for (i = 0; i < size(a); i++) {
60			if (i >= matrowmax) {
61				printf("  ...");
62				break;
63			}
64			printf("%8d", a[i]);
65		}
66		return;
67	}
68	if (matdim(a) > 2)
69		quit "Dimension for mat_print greater than 2";
70
71	for (i = matmin(a,1); i <= matmax(a,1); i++) {
72		if (i >= matmin(a,1) + matcolmax) {
73			print "	    ...";
74			break;
75		}
76		for (j = matmin(a,2); j <= matmax(a,2); j++) {
77			if (j >= matmin(a,2) + matrowmax) {
78				printf("   ...");
79				break;
80			}
81			printf("%8d", a[i,j]);
82		}
83		print;
84	}
85}
86
87define octet_print(a) {
88	switch(a) {
89		case 8: print "BS":;
90			return;
91		case 9: print "HT":;
92			return;
93		case 10: print "NL":;
94			return;
95		case 12: print "FF":;
96			return;
97		case 13: print "CR":;
98			return;
99		case 27: print "ESC":;
100			return;
101	}
102	if (a > 31 && a < 127)
103		print char(a):;
104	else
105		print "Non-print":;
106}
107
108
109define blk_print(a) {
110	local i, n;
111
112	n = size(a);
113
114	printf("Unnamed block with %d bytes of data\n", n);
115	print "First few characters: ":;
116	for (i = 0; i < n; i++) {
117		if (i >= blkmax) {
118			print "...",;
119			break;
120		}
121		print a[i],;
122	}
123}
124
125
126define nblk_print (a) {
127	local n, i;
128
129	n = size(a);
130
131	printf("Block named \"%s\" with %d bytes of data\n", name(a), n);
132	print "First few characters: ":;
133	for (i = 0; i < n; i++) {
134		if (i >= blkmax) {
135			print "...",;
136			break;
137		}
138		print a[i],;
139	}
140}
141
142
143define strchar(a) {
144
145	if (isstr(a))
146		a = ord(a);
147
148	else if (is_octet(a))
149		a = a;		/* This converts octet to number */
150
151	else if (!isint(a) || a < 0 || a > 255)
152		quit "Bad argument for strchar";
153
154	switch (a) {
155		case 7: print "\\a":;
156			return;
157		case 8: print "\\b":;
158			return;
159		case 9: print "\\t":;
160			return;
161		case 10: print "\\n":;
162			return;
163		case 11: print "\\v":;
164			return;
165		case 12: print "\\f":;
166			return;
167		case 13: print "\\r":;
168			return;
169		case 27: print "\\e":;
170			return;
171		case 34: print "\\\"":;
172			return;
173		case 39: print "\\\'":;
174			return;
175		case 92: print "\\\\":;
176			return;
177	}
178	if (a > 31 && a < 127) {
179		print char(a):;
180		return;
181	}
182	print "\\":;
183	if (a >= 64) print a // 64:;
184	a = a % 64;
185	if (a >= 8) print a // 8:;
186	a = a % 8;
187	print a:;
188}
189
190
191define file_print(a) {
192	local c;
193
194	rewind(a);
195	for (;;) {
196		c = fgetc(a);
197		if (iserror(c))
198			quit "Failure when reading from file";
199		if (isnull(c))
200			break;
201		strchar(c);
202	}
203	print;
204}
205
206
207define error_print(a) {
208	local n = iserror(a);
209
210	if (n == 10001) {
211		print "1/0":;
212		return;
213	}
214	if (n == 10002) {
215		print "0/0":;
216		return;
217	}
218	print strerror(a):;
219}
220
221
222L = list(1,2,3,4,5);
223
224mat M1[5] = {1,2,3,4,5};
225
226mat M2[4,4] = {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16};
227
228B1 = blk() = {"A", "B", "C", "D"};
229B2 = blk("sample") = {77, 102, 29, 13, 126, 8, 100, 27, 0, 1};
230
231dummy = rm("-f", "xx_print.foo");
232f = fopen("xx_print.foo", "w+");
233
234fputstr(f, "alpha\nbeta\f\"gamma\"");
235fputstr(f, "\x09delta\n");
236fputstr(f, "\1\2\3");
237fflush(f);
238
239print "Here is a list:";
240print L;
241print;
242
243print "A one-dimensional matrix:";
244print M1;
245print;
246
247print "A two-dimensional matrix:";
248print M2;
249print;
250
251print "An unnamed block:";
252print B1;
253print;
254
255print "A named block with some special octets:";
256print B2;
257print;
258
259print "A file:";
260print f;
261print;
262
263undefine mat_print;
264
265fclose(f);
266print "f closed";
267print;
268dummy = rm("-f", "xx_print.foo");
269
270mat M[7] = {1, 2, 3/0, 0/0, eval(2+3), fgetc(f), 7};
271print "Here is a matrix with some \"errors\" as elements":
272print M;
273print;
274
275define octet_print(a) {
276	local b, x;
277	x = a;
278
279	for (b = 128; b; b >>= 1)
280		print (x >= b ? (x -= b, 1) : 0):;
281}
282
283print "Here is the earlier block with a new octet_print()";
284print B1;
285print;
286