13.8 Formatio Interface

ORIGIN 'betaenv';
LIB_DEF 'formatio' '../lib';
BODY 'private/formatioBody'
(*
 * COPYRIGHT
 *       Copyright (C) Mjolner Informatics, 1984-96
 *       All rights reserved.
 *
 *)
--- streamLib: attributes ---
getFormat: formatter
  (* getFormat accepts the following syntax for markers:
   * 
   *      %[width][.[precision]]{dioxXrRbBfeEgGcsn%}
   * 
   * where width is a (unsigned) decimal number (or '*'), and
   *   precision is a (unsigned) decimal number (or '*'),
   * 
   * and where
   *     [ ... ] means that the enclodes is optional,
   * and { ... } means one if the enclosed characters.
   * 
   * Width is only interpreted in conjunction with the 's' marker.
   * Precision is only interpreted in conjunction with the
   * 'r' and 'R' markers.
   * 
   * For all but the 'c' marker, leading white space are skipped.
   * 
   * The '%' marker means that a '%' is expected on the input stream.
   * 
   * Actually, getFormat accepts the same syntax as putFormat (see
   * later):
   * 
   *      %{-+ }[[0]width][.[[0]precision]]{dioxXrRbBfeEgGcsn%}
   * 
   * but only the above part of that syntax is actually interpreted by
   * getFormat.  The reason for accepting the same syntax is to allow
   * a format string to be used both for getFormat and putFormat.
   *)
  (# width:
       (* sets the default precision to be used in future '*' width
        * specifications
        *)
       (# w: @integer enter w ... #);
     precision:
       (* sets the default precision to be used in future '*'
        * precision specifications
        *)
       (# p: @integer enter p ... #);
     marker: scanForMarker
       (# formatEOS:: (# do mark->missingMarker #)
       ...
       #);
     d: marker (* read a decimal number *)
       (# mark:: (# do 'd'->value #);
          value: @integer
       ...    
       exit value
       #);
     i: marker
       (* read a number, either decimal, octal or hexadecimal using C
        * conventions: 0nnn implies octal, 0xnnn implies hexadecimal,
        * decimal otherwise.
        *)
       (# mark:: (# do 'i'->value #);
          value: @integer
       ...    
       exit value
       #);
     o: marker (* read an octal number *)
       (# mark:: (# do 'o'->value #);
          value: @integer
       ...    
       exit value
       #);
     x: marker (* read a hexadecimal number *)
       (# mark:: (# do 'x'->value #);
          value: @integer
       ...   
       exit value
       #);
     uX: marker (* read a hexadecimal number.  Identical to 'x' *)
       (# mark:: (# do 'X'->value #);
          value: @integer
       ...    
       exit value
       #);
     r: marker
       (* read a number in radix given by precision *)
       (# mark:: (# do 'r'->value #);
          value: @integer
       ...  
       exit value
       #);
     uR: marker
       (* read a number in radix given by precision.  Identical to
        * 'r'
        *)
       (# mark:: (# do 'R'->value #);
          value: @integer
       ...  
       exit value
       #);
     b: marker
       (* read a number as based number (i.e. in the bbxnnn format) *)
       (# mark:: (# do 'b'->value #);
          base, value: @integer
       ...  
       exit (base,value)
       #);
     uB: marker
       (* read a number as based number (i.e. in the bbxnnn format).
        * Identical to 'b'
        *)
       (# mark:: (# do 'B'->value #);
          base, value: @integer
       ...  
       exit (base,value)
       #);
     f: marker (* read a real *)
       (# mark:: (# do 'f'->value #);
          value: @real
       ...    
       exit value
       #);
     e: marker (* read a real.  Identical to 'f' *)
       (# mark:: (# do 'e'->value #);
          value: @real
       ...    
       exit value
       #);
     uE: marker (* read a real.  Identical to 'f' *)
       (# mark:: (# do 'E'->value #);
          value: @real
       ...    
       exit value
       #);
     g: marker (* read a real.  Identical to 'f' *)
       (# mark:: (# do 'g'->value #);
          value: @real
       ...    
       exit value
       #);
     uG: marker (* read a real.  Identical to 'f' *)
       (# mark:: (# do 'G'->value #);
          value: @real
       ...    
       exit value
       #);
     c: marker (* read a single character *)
       (# mark:: (# do 'c'->value #);
          value: @char
       ...    
       exit value
       #);
     s: marker 
       (* read a text atom (i.e. a sequence of non-white space
        * characters, terminated by a white space character - similar
        * to getAtom).  If width is non-zero, at most width characters
        * are read.  Otherwise, characters are read until next
        * whitespace character
        *)
       (# mark:: (# do 's'->value #);
          value: ^text
       ...  
       exit value[]
       #);
     n: marker
       (* return the number of characters read until this point *)
       (# mark:: (# do 'n'->value #);
          value: @integer
       ...  
       exit value
       #);
     match:: (* private *)
       (# ... #)
  do INNER getFormat
  #);

putFormat: formatter
  (* putFormat accepts the following syntax for markers:
   * 
   *      %{-+ }[[0]width][.[[0]precision]]{dioxXrRbBfeEgGcsnt%}
   * 
   * where width is a (unsigned) decimal number (or '*'), and
   *   precision is a (unsigned) decimal number (or '*') and where
   * 
   *     [ ... ] means that the enclodes is optional,
   * and { ... } means one if the enclosed characters.
   * 
   * '-' implies output leftjustified in field
   * '+' implies output numbers signed (always with leading '+' or
   *                                    '-')
   * ' ' implies output numbers with blank sign (i.e. leading ' ' if
   *                                             positive)
   * '0' in front of either width or precision implies zero padding
   * width specifies the minimun width of the output field.
   * precision is interpreted for various things in the 'rRbBfeEgG'
   *     markers.
   * 
   * The '%' marker means that a '%' is put on the output stream.
   * 
   * The '%t' marker prints booleans, use it with tv.
   *)
  (# width:
       (* sets the default precision to be used in future '*' width
        * specifications
        *)
       (# w: @integer enter w ... #);
     precision:
       (* sets the default precision to be used in future '*'
        * precision specifications
        *)
       (# p: @integer enter p ... #);
     marker: scanForMarker
       (# formatEOS:: (# do mark->missingMarker #)
       ...
       #);
     d: marker (* insert the integer *)
       (# mark:: (# do 'd'->value #);
          value: @integer
       enter value
       ...  
       #);
     i: marker (* insert the integer. Identical to 'd' *)
       (# mark:: (# do 'i'->value #);
          value: @integer
       enter value
       ...  
       #);
     y: marker (* insert the integer in binary *)
       (# mark:: (# do 'y'->value #);
          value: @integer
       enter value
       ...
       #);
     o: marker (* insert the integer in octal, at least 10 ciffers *)
       (# mark:: (# do 'o'->value #);
          value: @integer
       enter value
       ...  
       #);
     x: marker (* insert the integer in hexadecimal, at least 8 ciffers *)
       (# mark:: (# do 'x'->value #);
          value: @integer
       enter value
       ...  
       #);
     uX: marker
       (* insert the integer in hexadecimal, using uppercase letters
        *)
       (# mark:: (# do 'X'->value #);
          value: @integer
       enter value
       ...  
       #);
     r: marker
       (* insert the integer in radix given by precision *)
       (# mark:: (# do 'r'->value #);
          value: @integer
       enter value
       ...  
       #);
     uR: marker
       (* insert the integer in radix given by precision, using
        * uppercase letters if radix>10
        *)
       (# mark:: (# do 'R'->value #);
          value: @integer
       enter value
       ...  
       #);
     b: marker
       (* insert the integer as based number (i.e. in the bbxnnn
        * format) with base given by precision
        *)
       (# mark:: (# do 'b'->value #);
          value: @integer
       enter value
       ...  
       #);
     uB: marker
       (* insert the integer as based number (i.e. in the bbxnnn
        * format) with base given by precision, using uppercase
        * letters if base>10
        *)
       (# mark:: (# do 'B'->value #);
          value: @integer
       enter value
       ...  
       #);
     f: marker (* insert the real in noexp style *)
       (# mark:: (# do 'f'->value #);
          value: @real
       enter value
       ...  
       #);
     e: marker (* insert the real in exp style *)
       (# mark:: (# do 'e'->value #);
          value: @real
       enter value
       ...  
       #);
     uE: marker (* insert the real in exp style and upcase 'E' *)
       (# mark:: (# do 'E'->value #);
          value: @real
       enter value
       ...  
       #);
     g: marker (* insert the real in plain style *)
       (# mark:: (# do 'g'->value #);
          value: @real
       enter value
       ...  
       #);
     uG: marker (* insert the real in plain style and upcase 'E' *)
       (# mark:: (# do 'G'->value #);
          value: @real
       enter value
       ...  
       #);
     c: marker (* insert the char *)
       (# mark:: (# do 'c'->value #);
          value: @char;
          putc: @(* Private *)...  
       enter value
       do putc
       #);
     s: marker (* insert the text *)
       (# mark:: (# do 's'->value #);
          value: ^text;
          puts: @(* Private *)...
       enter value[]
       do puts
       #);
     n: marker
       (* return the length of the result string until this point *)
       (# mark:: (# do 'n'->value #);
          value: @integer
       ...  
       exit value
       #);
     trueText:<(# t:^text; do 'true'->t[]; INNER exit t[] #);
     falseText:<(# t:^text; do 'false'->t[]; INNER exit t[] #);     
     tv: marker (* Truth-value, prints trueText of falseText *)
       (# mark:: (# do 't'->value #);
          localTrueText:<(# t:^text; enter t[] do INNER exit t[] #);   
          localFalseText:<(# t:^text; enter t[] do INNER exit t[] #);   
          value:@boolean
       enter value
       ...
       #);
     match:: (* private *)
       (# ... #)
  do INNER putFormat
  #);

formatter: (* superpattern for putFormat and getFormat *)
  (# illegalFormat:< exception
       (# mark: @char
       enter mark
       ...
       #);
     missingMarker:< exception
       (# mark: @char
       enter mark
       ...
       #);
     missingField:< exception
       (# ... #);
     inputError:< exception
       (# chFound, chExpected: @char
       enter (chFound, chExpected)
       ...
       #);
     scanForMarker: (* Private *)
       (# mark:< charValue;
          formatEOS:< exception;
          fieldWidth, precisionSpec: @integer;
          leftFlag, signedFlag, blankFlag,
          alternativeFlag, zeroFlag, longFlag: @boolean
       ...
       #);
     match:< (* private *)
       (# ch: @char
       enter ch
       do INNER match
       #);
     private: @...;
     formatStr: ^text
  enter formatStr[]
  ...
  exit this(stream)[]
  #);

--- lib: attributes ---
   
getFormat: keyboard.getFormat(# do INNER getFormat #);

putFormat: screen.putFormat(# do INNER putFormat #)