Artifact 9d8e9e0a4ef550452d6eb546cd3eb0be0b400531:
- File srfi/tests/print-ascii.sps — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 2112)
0000: 0a 3b 3b 3b 20 54 65 73 74 20 66 6f 72 6d 61 74 .;;; Test format 0010: 20 69 6d 70 6f 72 74 20 6f 66 20 69 6d 70 6c 65 import of imple 0020: 6d 65 6e 74 61 74 69 6f 6e 0a 3b 3b 3b 20 73 70 mentation.;;; sp 0030: 65 63 69 66 69 63 20 72 6f 75 74 69 6e 65 3a 20 ecific routine: 0040: 70 72 65 74 74 79 2d 70 72 69 6e 74 0a 0a 23 7c pretty-print..#| 0050: 0a 4c 41 52 43 45 4e 59 20 55 53 41 47 45 3a 0a .LARCENY USAGE:. 0060: 3d 3d 3e 20 6c 61 72 63 65 6e 79 20 2d 72 36 72 ==> larceny -r6r 0070: 73 20 2d 70 72 6f 67 72 61 6d 20 70 72 69 6e 74 s -program print 0080: 2d 61 73 63 69 69 2e 73 73 0a 0a 49 4b 41 52 55 -ascii.ss..IKARU 0090: 53 20 55 53 41 47 45 0a 3d 3d 3e 20 69 6b 61 72 S USAGE.==> ikar 00a0: 75 73 20 2d 2d 72 36 72 73 2d 73 63 72 69 70 74 us --r6rs-script 00b0: 20 70 72 69 6e 74 2d 61 73 63 69 69 2e 73 73 0a print-ascii.ss. 00c0: 0a 7c 23 0a 0a 28 69 6d 70 6f 72 74 20 28 72 6e .|#..(import (rn 00d0: 72 73 20 28 36 29 29 0a 20 20 20 20 20 20 20 20 rs (6)). 00e0: 28 73 75 72 66 61 67 65 20 73 34 38 20 69 6e 74 (surfage s48 int 00f0: 65 72 6d 65 64 69 61 74 65 2d 66 6f 72 6d 61 74 ermediate-format 0100: 2d 73 74 72 69 6e 67 73 29 29 0a 20 20 20 20 20 -strings)). 0110: 20 20 20 0a 28 64 65 66 69 6e 65 20 70 61 0a 20 .(define pa. 0120: 27 28 64 65 66 69 6e 65 20 28 70 72 69 6e 74 2d '(define (print- 0130: 61 73 63 69 69 2d 63 68 61 72 74 20 2e 20 72 61 ascii-chart . ra 0140: 64 69 78 2b 70 6f 72 74 29 20 20 0a 20 20 28 6c dix+port) . (l 0150: 65 74 20 28 20 28 72 61 64 69 78 20 28 69 66 20 et ( (radix (if 0160: 28 6e 75 6c 6c 3f 20 72 61 64 69 78 2b 70 6f 72 (null? radix+por 0170: 74 29 20 31 36 20 28 63 61 72 20 72 61 64 69 78 t) 16 (car radix 0180: 2b 70 6f 72 74 29 29 29 20 20 20 20 20 20 20 20 +port))) 0190: 20 0a 20 20 20 20 20 20 20 20 20 28 70 6f 72 74 . (port 01a0: 20 20 28 69 66 20 28 6f 72 20 28 6e 75 6c 6c 3f (if (or (null? 01b0: 20 72 61 64 69 78 2b 70 6f 72 74 29 20 28 6e 75 radix+port) (nu 01c0: 6c 6c 3f 20 28 63 64 72 20 72 61 64 69 78 2b 70 ll? (cdr radix+p 01d0: 6f 72 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 ort))). 01e0: 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 6e (curren 01f0: 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 0a 20 t-output-port). 0200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0210: 20 28 63 61 64 72 20 72 61 64 69 78 2b 70 6f 72 (cadr radix+por 0220: 74 29 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 t))) . 0230: 28 6d 61 78 2d 72 6f 77 20 20 20 20 31 35 29 20 (max-row 15) 0240: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 . 0250: 20 20 28 6d 61 78 2d 63 6f 6c 20 20 20 20 20 37 (max-col 7 0260: 29 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 ) . 0270: 20 20 20 20 28 6d 61 78 2d 61 73 63 69 69 20 31 (max-ascii 1 0280: 32 37 29 20 20 20 20 20 20 20 20 20 0a 20 20 20 27) . 0290: 20 20 20 20 20 20 28 6d 61 78 2d 63 6f 6e 74 72 (max-contr 02a0: 6f 6c 20 33 31 29 20 20 3b 20 5b 30 2e 2e 33 31 ol 31) ; [0..31 02b0: 5d 20 61 72 65 20 63 6f 6e 74 72 6f 6c 20 63 6f ] are control co 02c0: 64 65 73 0a 20 20 20 20 20 20 20 29 20 20 20 0a des. ) . 02d0: 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 70 72 . (define (pr 02e0: 69 6e 74 61 62 6c 65 3f 20 4e 29 20 3b 20 4e 2e intable? N) ; N. 02f0: 42 2e 3a 20 69 6e 74 65 67 65 72 20 69 6e 70 75 B.: integer inpu 0300: 74 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 t . ( 0310: 3c 20 6d 61 78 2d 63 6f 6e 74 72 6f 6c 20 4e 20 < max-control N 0320: 6d 61 78 2d 61 73 63 69 69 29 29 20 3b 20 63 6f max-ascii)) ; co 0330: 6e 74 72 6f 6c 20 6f 72 20 44 45 4c 20 20 0a 0a ntrol or DEL .. 0340: 20 20 20 20 28 64 65 66 69 6e 65 20 28 70 72 69 (define (pri 0350: 6e 74 2d 61 2d 63 68 61 72 20 4e 29 20 0a 20 20 nt-a-char N) . 0360: 20 20 20 20 28 69 66 20 28 70 72 69 6e 74 61 62 (if (printab 0370: 6c 65 3f 20 4e 29 20 0a 20 20 20 20 20 20 20 20 le? N) . 0380: 28 62 65 67 69 6e 20 20 20 20 20 20 20 20 0a 20 (begin . 0390: 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 (displa 03a0: 79 20 23 5c 27 20 20 20 20 20 20 20 20 20 20 20 y #\' 03b0: 20 20 20 20 70 6f 72 74 29 0a 20 20 20 20 20 20 port). 03c0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 69 6e (display (in 03d0: 74 65 67 65 72 2d 3e 63 68 61 72 20 4e 29 20 70 teger->char N) p 03e0: 6f 72 74 29 20 0a 20 20 20 20 20 20 20 20 20 20 ort) . 03f0: 28 64 69 73 70 6c 61 79 20 23 5c 27 20 20 20 20 (display #\' 0400: 20 20 20 20 20 20 20 20 20 20 20 70 6f 72 74 29 port) 0410: 20 0a 20 20 20 20 20 20 20 20 20 20 29 20 20 20 . ) 0420: 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 28 63 . (c 0430: 6f 6e 64 20 3b 20 70 72 69 6e 74 20 61 20 63 6f ond ; print a co 0440: 6e 74 72 6f 6c 20 63 68 61 72 61 63 74 65 72 20 ntrol character 0450: 20 0a 20 20 20 20 20 20 20 20 20 28 28 3d 20 4e . ((= N 0460: 20 6d 61 78 2d 61 73 63 69 69 29 20 28 64 69 73 max-ascii) (dis 0470: 70 6c 61 79 20 22 44 45 4c 22 20 70 6f 72 74 29 play "DEL" port) 0480: 29 20 20 0a 20 20 20 20 20 20 20 20 20 28 65 6c ) . (el 0490: 73 65 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 se . 04a0: 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 (displa 04b0: 79 20 23 5c 5e 20 20 20 70 6f 72 74 29 20 20 20 y #\^ port) 04c0: 20 0a 20 20 20 20 20 20 20 20 20 20 28 64 69 73 . (dis 04d0: 70 6c 61 79 20 28 69 6e 74 65 67 65 72 2d 3e 63 play (integer->c 04e0: 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e har (+ (char->in 04f0: 74 65 67 65 72 20 23 5c 40 29 20 4e 29 29 20 70 teger #\@) N)) p 0500: 6f 72 74 29 20 0a 20 20 20 20 20 20 20 20 20 20 ort) . 0510: 29 20 29 20 20 20 20 20 29 20 20 20 20 20 20 0a ) ) ) . 0520: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 (display " 0530: 20 3d 20 22 20 20 20 20 20 20 20 20 20 20 20 20 = " 0540: 20 20 20 20 20 20 20 20 70 6f 72 74 29 20 20 0a port) . 0550: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 (display ( 0560: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 4e number->string N 0570: 20 72 61 64 69 78 29 20 70 6f 72 74 29 20 0a 20 radix) port) . 0580: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 23 5c (display #\ 0590: 73 70 61 63 65 20 20 20 20 20 20 20 20 20 20 20 space 05a0: 20 20 20 20 20 20 20 70 6f 72 74 29 20 20 0a 20 port) . 05b0: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 23 5c (display #\ 05c0: 73 70 61 63 65 20 20 20 20 20 20 20 20 20 20 20 space 05d0: 20 20 20 20 20 20 20 70 6f 72 74 29 20 0a 20 20 port) . 05e0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 23 5c 73 (display #\s 05f0: 70 61 63 65 20 20 20 20 20 20 20 20 20 20 20 20 pace 0600: 20 20 20 20 20 20 70 6f 72 74 29 20 20 20 0a 20 port) . 0610: 20 20 20 20 20 29 20 20 20 0a 0a 20 20 20 20 3b ) .. ; 0620: 20 6f 75 74 70 75 74 20 74 68 65 20 63 68 61 72 output the char 0630: 74 2e 2e 2e 20 20 0a 20 20 20 20 28 6e 65 77 6c t... . (newl 0640: 69 6e 65 20 70 6f 72 74 29 20 20 20 0a 20 20 20 ine port) . 0650: 20 28 6c 65 74 20 72 6f 77 2d 6c 6f 6f 70 20 28 (let row-loop ( 0660: 20 28 72 6f 77 20 30 29 20 29 20 20 0a 20 20 20 (row 0) ) . 0670: 20 20 20 28 69 66 20 28 3e 20 72 6f 77 20 6d 61 (if (> row ma 0680: 78 2d 72 6f 77 29 20 20 20 20 20 20 20 20 0a 20 x-row) . 0690: 20 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 20 (newline 06a0: 70 6f 72 74 29 20 20 3b 20 64 6f 6e 65 20 20 20 port) ; done 06b0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 . 06c0: 28 6c 65 74 20 63 6f 6c 75 6d 6e 2d 6c 6f 6f 70 (let column-loop 06d0: 20 28 20 28 63 6f 6c 20 30 29 20 29 20 20 20 0a ( (col 0) ) . 06e0: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print 06f0: 2d 61 2d 63 68 61 72 20 28 2b 20 72 6f 77 20 28 -a-char (+ row ( 0700: 2a 20 63 6f 6c 20 28 2b 20 6d 61 78 2d 72 6f 77 * col (+ max-row 0710: 20 31 29 29 29 29 20 0a 20 20 20 20 20 20 20 20 1)))) . 0720: 20 20 28 69 66 20 28 3c 20 63 6f 6c 20 6d 61 78 (if (< col max 0730: 2d 63 6f 6c 29 20 20 20 20 20 20 20 20 0a 20 20 -col) . 0740: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6c 75 6d (colum 0750: 6e 2d 6c 6f 6f 70 20 28 2b 20 63 6f 6c 20 31 29 n-loop (+ col 1) 0760: 29 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 ) . 0770: 20 28 62 65 67 69 6e 20 20 20 20 20 20 20 20 20 (begin 0780: 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 . 0790: 20 20 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 (newline 07a0: 20 20 70 6f 72 74 29 20 20 20 20 20 20 0a 20 20 port) . 07b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 6f 77 (row 07c0: 2d 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 31 29 29 -loop (+ row 1)) 07d0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 . 07e0: 20 29 20 20 20 29 20 20 20 20 20 20 20 20 20 20 ) ) 07f0: 0a 20 20 20 20 20 20 20 20 20 20 29 20 20 20 29 . ) ) 0800: 20 20 20 20 0a 20 20 20 20 20 20 29 29 20 29 0a . )) ). 0810: 29 0a 0a 28 66 6f 72 6d 61 74 20 23 74 20 22 7e )..(format #t "~ 0820: 59 7e 25 22 20 70 61 29 0a 0a 3b 3b 09 09 2d 2d Y~%" pa)..;;..-- 0830: 2d 20 45 20 4f 20 46 20 2d 2d 2d 09 09 3b 3b 0a - E O F ---..;;.