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