Previous
10.3.5.1. Formatted output
a)
PROC putf = (REF FILE f, [ ] UNION (OUTTYPE, FORMAT) x) VOID:
IF opened OF f THEN
FOR k TO UPB x
DO CASE set write mood (f); set char mood (f); x[k] IN
( FORMAT format): associate format (f, format),
( OUTTYPE ot):
BEGIN INT j := 0;
PICTURE picture, [ ] SIMPLOUT y = STRAIGHTOUT ot;
WHILE (j +:= 1) <= UPB y
DO BOOL incomp := FALSE;
get next picture (f, FALSE, picture);
set write mood(f);
[ 1 : UPB ( i OF picture) ] SINSERT sinsert;
CASE p OF picture IN
( PATTERN pattern):
BEGIN INT rep, sfp := 1;
[ 1 : UPB ( frames OF pattern) ] SFRAME sframes;
staticize frames ( frames OF pattern, sframes),
staticize insertion ( i OF picture, sinsert));
STRING s;
OP ? = (STRING s) BOOL:
¢ true if the next marker is one of the elements of 's' and false otherwise ¢
IF sfp > UPB sframes
THEN FALSE
ELSE SFRAME sf = sframes [sfp];
rep := rep OF sf:
IF char in string( marker OF sf, LOC INT, s)
THEN sfp +:= 1; TRUE
ELSE FALSE
FI
FI;
op ? = (CHAR c) BOOL: ? STRING (c);
PROC int pattern (REF BOOL sign mould) INT:
( INT l := 0;
WHILE ? "zuv" DO ( rep >= 0 | l +:= rep) OD;
sign mould OF := ? "+-";
WHILE ? "zd" DO (rep >= 0 | l +:= rep) OD; l);
«PROC edit {l} int ({L} INT i) VOID:
( BOOL sign mould; INT l := int pattern (sign mould),
STRING t = subwhole(ABS i, l);
IF char in string( errorchar, LOC INT, t) {|}OR l = 0
{|}OR ~ sign mould & i < {L} 0
THEN incomp := TRUE
ELSE t PLUSTO s;
( l UPB t) * "0" PLUSTO s;
( sign mould | (i < {L} 0 | "-" | "+") PLUSTO s)
FI)»;
«PROC edit {l} real ({L} REAL r) VOID:
( INT b := 0, a := 0, c := 0, exp := 0, {L} REAL y := ABS r,
BOOL sign1, STRING point := "";
b := int pattern(sign1);
( ? "." | a := int pattern( LOC BOOL); point := ".");
IF ? "c"
THEN standardize( y, b, a, exp);
edit int (exp);
"\io" PLUSTO s
FI;
STRING t = subfixed(y, b + a + (a /= 0 | 1 | 0 ), a );
IF char in string (errorchar, LOC INT, t) {|}OR a + b = 0
{|}OR ~ sign1 & r < {L} 0
THEN incomp := TRUE
ELSE t[: b] + point + t[b+2: ] PLUSTO s;
( b + a + (a /= 0 | 1 | 0) - UPB t) * "0" PLUSTO s;
( sign1 | (r < {L} 0 | "-" | "+") PLUSTO s)
FI)»;
« PROC edit {l} compl =({L} COMPL z) VOID:
( WHILE ~ ? "i" DO sfp +:= 1 OD; edit {l} real (IM z);
"I" PLUSTO s; sfp := 1; edit {l} real (RE z))»;
« PROC edit {l} bits ({L} BITS lb, INT radix) VOID:
( {L} INT n := ABS lb; ? "r"; INT l := intpattern (LOC BOOL);
WHILE dig char ({S} (n MOD {K} radix)) PLUSTO s;
n %:= {K} radix; n /= {L} 0
DO SKIP OD;
IF UPB s <= l
THEN (l - UPB s) * "0" PLUSTO s
ELSE incomp := TRUE
FI)»;
PROC charcount = INT: (INT l := 0; WHILE ?"a" DO (rep >= 0 | l +:= rep) OD; l);
CASE type OF pattern IN
¢ integral ¢
( y[j] |
«({L} INT i): edit {l} int (i)»
| incomp := TRUE),
¢ real ¢
( y[j] |
« ({L} REAL r): edit {l} real (r)»
«({L} INT i): edit {l} real (i)»
| incomp := TRUE),
¢ boolean ¢
( y[j] |
( BOOL b): s := (b | flip | flop)
| incomp := TRUE),
¢ complex ¢
( y[j] |
« ( {L} COMPLEX z): edit {l} complex (z)»
« ({L} REAL r): edit {l} complex (r)»
« ({L} INT i): edit {l} complex (i) »
| incomp := TRUE),
¢ string ¢
( y[j] |
( CHAR c): (charcount = 1 | s := c | incomp := TRUE),
( [ ] CHAR t):
( charcount = UPB t - LWB t + 1
| s := t[@1]
| incomp := TRUE)
| incomp := TRUE)
OUT
¢ bits ¢
( y[j] |
« ({L} BITS lb): edit {l} bits (lb, type OF pattern - 4)»
| incomp := TRUE)
ESAC;
IF ~ incomp
THEN edit string (f, S, sframes)
FI
END,
( CPATTERN choice):
BEGIN
[ 1: UPB (i OF choice)j SINSERT si;
staticize insertion (i OF choice, si):
put insertion (f, ci);
INT l =
CASE type OF choice IN
¢ boolean ¢
( y [j] |
( BOOL b): (b | 1 | 2)
| incomp := TRUE; SKIP),
¢ integral ¢
( y [j] |
( INT i): i
| incomp := TRUE; SKIP)
ESAC;
IF ~ incomp
THEN
IF l > UPB (c OF choice) {|}OR l <= 0
THEN incomp := TRUE
ELSE
[ 1: UPB ((c OF choice) [l])) SINSERT ci:
staticize insertion ((c OF choice)[l], ci);
put insertion (f, ci)
FI
FI;
staticize insertion (i OF picture, sinsert)
END,
( FPATTERN fpattern:
BEGIN
do fpattern (f, fpattern, FALSE);
FOR TO UPB sinsert DO sinsert [i] := (0, "" ) OD;
END,
( GPATTERN gpattern):
BEGIN
[ 1 : UPB (i OF gpattern) ] SINSERT si;
[ ] PROC INT spec = spec OF gpattern; INT n = UPB spec;
[ 1: n] INT s;
( staticize insertion (i OF gpattern, si),
staticize insertion (i OF picture, sinsert),
s := ( n | spec[1], (spec[1], spec[2]),
( spec [1], spec [2], spec [3]) | ()));
put insertion (f, si);
IF n = 0 THEN put(f, y[j])
ELSE
NUMBER yj =
( y[j] | «({L} INT i): i», «({L} REAL r): r»
| incomp := TRUE; SKIP);
IF ~ incomp
THEN CASE n IN
put (f, whole (yj, s[1])),
put (f, fixed (yj, [1], s[2 ])),
put (f, float(yj, s[1], s[2], s[3]))
ESAC
FI
END,
( VOID):
( j -:= 1; staticize insertion (i OF picture, sinsert))
ESAC;
IF ~ incomp
THEN set write mood (f);
( ~ (value error mended OF f) (f) | put (f, y [j]):
| undefined)
FI;
put insertion (f, sinsert)
OD
END
ESAC OD
ELSE undefined
FI;
b)
PROC {?} edit string (REF FILE f, STRING s, [ ] SFRAME sf) VOID:
BEGIN BOOL supp, zs := TRUE, signput := FALSE, again, INT j := 0, sign;
PROC copy (CHAR c) VOID:
( ~ supp | check pos (f): put char (f, c));
FOR k TO UPB sf
DO SFRAME sfk = sf[k]; supp := supp OF sfk:
put insertion (f, si OF sfk);
TO rep OF sfk
DO again := TRUE;
WHILE again
DO j+:= 1; again := FALSE;
CHAR sj = s[j], marker = marker OF sfk;
IF marker = "d"
THEN copy (sj); zs := TRUE
ELIF marker = "z" THEN
( sj = "0" | copy((zs | " " | sj))
|: sj = "+" | again := TRUE
| zs := FALSE; copy (sj))
ELIF marker = "u" {|}OR marker = "v" THEN
( sj = "+" | sign := 1; again := TRUE
|: sj = "-" | sign := 2; again := TRUE
|: sj = "0" | copy((zs | " " | sj))
| ( ~ signput |
copy ((sign | (marker = "u" | "+" | " "), "-"));
signput := TRUE);
copy (sj); zs := FALSE)
ELIF marker = "+" then
( sj = "+" {|}OR sj = "-" | copy (sj)
| (~ signput | copy ((sign | "+", "-")));
j -:= 1)
ELIF marker = "-" THEN
( sj = "+" | copy (" ")
|: sj = "-" | copy (sj)
| (~ signput | copy ((sign | " ", "-")));
j -:= 1)
ELIF marker = "." THEN copy(".")
ELIF marker = "e" {|}OR marker = "i"
{|}OR marker = "a" {|}OR marker = "b"
THEN copy (sj); zs := TRUE; signput := FALSE
ELIF marker = "r"
THEN j -:= 1
FI
OD
OD
OD
END;
Next