"{ Package: 'stx:libbasic2' }"

"{ NameSpace: Smalltalk }"

Object subclass:#PrintfScanf

	instanceVariableNames:''

	classVariableNames:'Singleton'

	poolDictionaries:''

	category:'System-Support'

!

!PrintfScanf class methodsFor:'documentation'!

documentation

"   

    Contributed by Jan Steinman donated to the community in 1989.

    Provided AS-IS - no warranty, use at your own risk.

    Original comment:

        NAME            printf-scanf

        AUTHOR          Jan Steinman <jans@tekgvs.labs.tek.com>

        FUNCTION        printf and scanf for Smalltalk

        ST-VERSIONS     Tek 2.2.2a 4.0

        PREREQUISITES   CharacterComparing

        CONFLICTS       

        DISTRIBUTION    world

        VERSION         1.1

        DATE            Apr 1989?

        SUMMARY 

    The following methods implement printf and scanf functionality.  They

    are intended to be used to ease porting between Smalltalk and C, and

    for facilitating machine-machine communication.  They are not at all

    intended as replacements for Smalltalk's printOn: functionality.

    Jan Steinman - N7JDB

    Tektronix Electronic Systems Laboratory

    Box 500, MS 50-370, Beaverton, OR 97077

    (w)503/627-5881 (h)503/657-7703

    changes:

        slight changes to make it work with higher precision real numbers

        (i.e. asking for the precision instead of hard-coding it)

        no need for the singleton - classes are already singletons ready to use exactly for that.

        (no need to use C++/Java patterns here in Smalltalk)

    Caveat:

        the behavior when the format-width is less than the preferred default precision is suboptimal;

        it leads to problems when trying to format tables into columns...

        For now: always use with width.precision formats to enforce the width.

        The current behavior (generating longer strings like printf does) may change in the future.

"

!

examples

"

    self printf:'%#x %#X %03o%*.*s' arguments: #(16rABCD 16rEF 5 9 5 'ghijklmn')

            -> '0xabcd 0xEF 005    ghijk'

    self printf:'%- 10.4s%.2e' arguments: { 'abcdefghijkl' . Float pi }  

            -> ' abcd      3.14e0'

    self printf:'%8.3f' arguments: { 200 sqrt negated }

            -> ' -14.142'

    self printf:'%8.3f' on:Transcript arguments: { 200 sqrt negated }

    self printf:'%10.4f' on:Transcript arguments: { 200 sqrt negated }

    self printf:'%20.10f' on:Transcript arguments: { 200 sqrt negated }

    self printf:'%20.10f' on:Transcript arguments: { 1.234567890123456789f  }

    self printf:'%20.10f' on:Transcript arguments: { 1.234567890123456789q  }

    self printf:'%x' arguments: #(16r41)        -> '41' 

    self printf:'%#x' arguments: #(16r41)       -> '0x41'

    self printf:'%d' arguments: #(16r41)        -> '65'

    self printf:'%b' arguments: #(16r41)        -> '1000001'

    self printf:'%c' arguments: #(16r41)        -> 'A'

    self printf:'%c' arguments: #( $A )         -> 'A'

    self printf:'%s' arguments: #( $A )         -> 'A'

    self printf:'%s' arguments: #( 'hello' )    -> 'hello'

    self printf:'%4s' arguments: #( 'hello' )   -> 'hello'

    self printf:'%7s' arguments: #( 'hello' )   -> '  hello'

    self sscanf:'%f%2s%s%s%s' fromString: '237.0 this is a test' 

            -> OrderedCollection(237.0 'th' 'is' 'is' 'a')

    self sscanf:'%d%f%s' fromString: '25 54.32e-01 monday'

            -> OrderedCollection(25 5.432 'monday')

    self sscanf:'%f%*f %8[A-F0-9]%c%d 0x%x%f' fromString: '12.45 1048.73 AE40Z527 0x75BCD15 34' 

            -> OrderedCollection(12.45 'AE40' 'Z' 527 123456789 34.0)

    '%#x %#X %03o%*.*s' printf: #(16rABCD 16rEF 5 9 5 'ghijklmn') 

            -> '0xabcd 0xEF 005    ghijk'

    '%- 10.4s%.2e' printf: { 'abcdefghijkl' . Float pi }  

            -> ' abcd      3.14e0'

    '%8.3f' printf: { 200 sqrt negated }

            -> ' -14.142'

    '%c' printf: #(16r41)

            -> 'A'

    '%f%2s%s%s%s' sscanf: '237.0 this is a test' 

            -> OrderedCollection(237.0 'th' 'is' 'is' 'a')

    '%d%f%s' sscanf: '25 54.32e-01 monday'

            -> OrderedCollection(25 5.432 'monday')

    '%f%*f %8[A-F0-9]%c%d 0x%x%f' sscanf: '12.45 1048.73 AE40Z527 0x75BCD15 34'

            -> OrderedCollection(12.45 'AE40' 'Z' 527 123456789 34.0)

    '%d\n' printf:{ 1234 } on:Transcript    

    '%f\n' printf:{ 1234.0 } on:Transcript        

    '%f\n' printf:{ 1234.0 asShortFloat } on:Transcript        

    '%f\n' printf:{ 1234.0 asLongFloat } on:Transcript        

    '%f\n' printf:{ 1234.0 asQDouble } on:Transcript        

    '%p\n' printf:{ 10@20 } on:Transcript        

    '%P\n' printf:{ 10@20 } on:Transcript        

    '%S\n' printf:{ 10@20 } on:Transcript        

"

!

format_printf

"

    Printf Format specifier:

    required: leading '%'

        optional: '-' (POSIX refers to this as the <<flags>>)

        optional: positive number or '*' (POSIX: <<width>>)

        optional: period followed by positive number or * (POSIX: <<precision>>)

        optional: an h or l to indicate size of data (POSIX: <<length>>)

        required: character describing output behavior (POSIX: <<conversion specifier>>)

    Various implementations of printf have added different functionality.

    ANSI standards up through C99:

        more flags '+' ' ' '0' '#'

        more lengths 'L' 'hh' 'll' 'j' 'z' 't'

        more conversions 'F' 'a' 'A' 'n'

    The POSIX specification of printf added:

        positional parameters to identify argument indices

        more flags ''' (single quote)

        more conversions 'C' 'S'

        clarifications regarding corner cases and 'undefined behavior'

    BSD implementations added:

        more lengths 'q'

        more conversions 'D' 'U' 'O'

    glibc (GNU) added:

        more lengths 'Z'

        more conversions 'm'

    Windows C Runtime (CRT) added:

        more lengths 'I' 'I32' 'I64' 'w'

    glibc and CRT both added length 'Z'. 

        glibc uses 'Z' for the length size_t. 

        CRT uses Z as a conversion for length-prefixed strings. 

    This implementation takes the former approach, handling 'Z' in the same way as 'z'.

    BSD and IBM C library both added 'D'. 

        BSD uses D as a conversion, namely as an alias of 'ld'. 

        IBM uses 'D' for the length for _Decimal64, a decimal floating point type, 

        in accordance with ISO/IEC TR 24732. 

    This implementation takes the former approach.

    ================================================================

    This implementation also adds new conversions:

        'b' and 'B' for binary (base-2) integer renderings

        'y' and 'Y' for true/false and yes/no Boolean conversions

        'J' for JSON

        'T' and 'V' for JS typeof and valueOf inspection

        'S' for store-string

        'P' for print-string

    Conversions (upper case same as lower case, except for xX):

        'a'     (not implemented) hex floating point exp form

        'b'     binary (base 2)

        'c'     character or (first char of string)

        'd'     integer

        'e'     base-10 floating point exp form (scientific)

        'f'     base-10 floating point decimal form (non-scientific)

        'g'     'e' or 'f', whichever looks more appropriate (based on value)

        'i'     integer (alias for 'd')

        'j'     (not implemented) JSON format

        'n'     (not implemented) stores number of characters written so far into arg 

        'o'     base-8 octal

        'p'     (not implemented) pointer 

        's'     string

        't'     type (i.e. class name)

        'u'     (not implemented) unsigned (negative values are converted)

        'v'     (not implemented) store string

        'x'     base-16 hex

        'X'     base-16 hex upper case

    Parameter selection (not implemented):

        <n>$    take n'th parameter

    Dynamic width/precision (consumed in order as presented):

        *       take width/parameter from next argument

    Examples:

        PrintfScanf printf:'|%d|'  arguments:{ 123 }         -> '|123|'

        PrintfScanf printf:'|%5d|' arguments:{ 123 }         -> '|  123|'

        PrintfScanf printf:'|%-5d|' arguments:{ 123 }        -> '|123  |'

        PrintfScanf printf:'|%s|'  arguments:{ 'abc' }        -> '|abc|'

        PrintfScanf printf:'|%5s|'  arguments:{ 'abc' }       -> '|  abc|'

        PrintfScanf printf:'|%*s|'  arguments:{ 5 . 'abc' }   -> '|  abc|'

        PrintfScanf printf:'|%8f|'  arguments:{ 1.234 }       -> '|   1.234|'

        PrintfScanf printf:'|%*f|'  arguments:{ 8 . 1.234 }   -> '|   1.234|'

    Negative width will fill at the right:

        PrintfScanf printf:'|%5s|'  arguments:{ 'abc' }      -> '|  abc|'

        PrintfScanf printf:'|%-5s|' arguments:{ 'abc' }      -> '|abc  |'

        PrintfScanf printf:'|%-*s|' arguments:{ 5 . 'abc' }  -> '|abc  |'

        PrintfScanf printf:'|%*s|'  arguments:{ -5 . 'abc' } -> '|abc  |'

        PrintfScanf printf:'|%*f|'  arguments:{ -8 . 1.234 }  -> '|1.234   |'

        PrintfScanf printf:'|%-8f|'  arguments:{ 1.234 }      -> '|1.234   |'

        PrintfScanf printf:'|%-*f|'  arguments:{ 8 . 1.234 }  -> '|1.234   |'

        PrintfScanf printf:'|%-*f|'  arguments:{ -8 . 1.234 } -> '|1.234   |'

    A Zero as fill character:

        PrintfScanf printf:'|%05s|'  arguments:{ 'abc' }     -> '|00abc|'

        PrintfScanf printf:'|%-05s|' arguments:{ 'abc' }     -> '|abc00|'

        PrintfScanf printf:'|%0*f|'  arguments:{ -8 . 1.234 }  -> '|1.234   |'

        PrintfScanf printf:'|%-8f|'  arguments:{ 1.234 }      -> '|1.234   |'

        PrintfScanf printf:'|%-*f|'  arguments:{ 8 . 1.234 }  -> '|1.234   |'

        PrintfScanf printf:'|%-*f|'  arguments:{ -8 . 1.234 } -> '|1.234   |'

    Case of float-format character only affects printing of Nan and infinity:

        PrintfScanf printf:'%f' argument:1.234    

        PrintfScanf printf:'%F' argument:1.234    

        PrintfScanf printf:'%f' argument:(Float NaN)    

        PrintfScanf printf:'%F' argument:(Float NaN)    

        PrintfScanf printf:'%f' argument:(Float infinity)    

        PrintfScanf printf:'%F' argument:(Float infinity)    

        PrintfScanf printf:'%f' argument:(Float negativeInfinity)    

        PrintfScanf printf:'%F' argument:(Float negativeInfinity)    

"

!

format_scanf

"

    Scanf format specifier:

        required: leading '%'

    ================================================================

    This implementation also adds new conversions:

    Conversions (upper case same as lower case):

        'b'     binary (base 2)

        'c'     character or (first char of string)

        'd'     decimal

        'e'     float

        'f'     float

        'g'     float

        'i'     integer (alias for 'd')

        'o'     base-8 octal

        's'     string

        'u'     integer

        'x'     base-16 hex

        'n'     any number

    Length prefix:

        'h'     with float formats: reads as ShortFloat

        'L'     with float formats: reads as LongFloat

        'LL'    with float formats: reads as QDouble

     '%d %x' sscanf:'1234 ff00'         -> OrderedCollection(1234 65280)

     '%d %s' sscanf:'1234 ff00'         -> OrderedCollection(1234 'ff00')

     '%d %x %b' sscanf:'1234 ff00 1001' -> OrderedCollection(1234 65280 9)

     ('%f' sscanf:'1234') first         -> 1234.0 (Float i.e. an IEEE double)

     ('%lf' sscanf:'1234') first        -> 1234.0 (Float i.e. an IEEE double)

     ('%llf' sscanf:'1234') first       -> 1234.0 (Float i.e. an IEEE double)

     ('%hf' sscanf:'1234') first        -> 1234.0 (ShortFloat i.e. an IEEE double)

     ('%Lf' sscanf:'1234') first        -> 1234.0 (LongFloat i.e. an IEEE quad)

     ('%LLf' sscanf:'1234') first       -> 1234.0 (QDouble)

"

! !

!PrintfScanf class methodsFor:'instance creation'!

new

    Singleton isNil ifTrue:[

        Singleton := self basicNew

    ].    

    ^ Singleton

! !

!PrintfScanf class methodsFor:'printing'!

printArgFrom:formatStream to:outStream arguments:argStream

    "Interpret the required number of arguments from <argStream>

     according to the formatting information in <formatStream>.  

     Place the interpretation on <outStream>.  

     The interpretation is C printf(3) style, as described in the UTek manual page for printf(3).  

     <formatStream> is assumed to be positioned just past

     $%, and a complete control string is assumed available.     

     Return when the conversion control string is consumed.  

     Leave <formatStream> pointing past the last character in the conversion control string.

     This code assumes that <formatStream> is formatted according to

     specification, and error checking is minimal.  

     Unexpected results will be obtained by illegal control strings, or when

     argument types do not match conversion codes, but it probably ;-)

     won't dump core, like C does in such cases!!!!"    

    |nextArg ljust plus pound width precision spaceIfPositive thousands

     pad char arg argString more precisionisMin

     spaceOrSignChar "space or sign character at left"

     intVal poundPrefix|

    nextArg := 

        [

            argStream atEnd ifTrue:[

                ArgumentError raiseErrorString:'not enough arguments for format string'

            ].

            argStream next

        ].

    ljust := plus := pound := spaceIfPositive := thousands := precisionisMin := false.

    poundPrefix := nil.

    width := 0.

    precision := nil.

    pad := Character space.

    char := formatStream peek.

    char isNil ifTrue:[

        ^ nil

    ].

    char == $% ifTrue:[ 

        ^ outStream nextPut: formatStream next

    ].

    "/ flag(s):

    [

        more := false.

        char == $- ifTrue:[

            ljust := true.

            pad := Character space.         "/ see unix manual: if 0 AND - appear, o is ignored

            more := true.

        ].

        char == $  ifTrue:[

            spaceIfPositive := true.

            more := true.

        ].

        char == $+ ifTrue:[

            plus := true.  

            more := true.

        ].

        char == $# ifTrue:[

            pound := true.  

            more := true.

        ].

        char == $0 ifTrue: [

            ljust ifFalse:[ pad := $0 ].    "/ see unix manual: if 0 AND - appear, o is ignored

            more := true.

        ].

        char == $' ifTrue: [

            thousands := true.

            more := true.

        ].

        "/ char == $I ifTrue: [

        "/     "/ ignored (new in glibc2.2)

        "/     more := true.

        "/ ].

        more ifTrue:[

            formatStream next.  

            char := formatStream peek.

        ].

    ] doWhile:[more].

    "/ possibly a width

    char == $* ifTrue:[

        width := nextArg value. 

        width isInteger ifFalse:[

            self error:'non integer width argument in printf'

        ].

        width < 0 ifTrue:[

            ljust := true.

            width := width negated

        ].    

        formatStream next.  

        char := formatStream peek

    ].

    char isDigit ifTrue:[

        char == $0 ifTrue: [

            ljust ifFalse:[pad := $0].  "/ see unix manual: if 0 AND - appear, o is ignored

        ].

        width := Integer readFrom:formatStream allowRadix:false onError:0.  

        char := formatStream peek

    ].

    "/ precision separator

    char == $. ifTrue:[

        formatStream next.  char := formatStream peek.

        char == $* ifTrue: [

            precision := nextArg value.  

            precision isInteger ifFalse:[

                self error:'non integer precision argument in printf'

            ].    

            formatStream next.

        ] ifFalse: [

            precision := Integer readFrom: formatStream.

        ].

        char := formatStream peek

    ].

    "/ length modifier(s)

    [

        more := false.

        ((char == $l) or:[char == $L]) ifTrue:[

            "Ignore long specifiers"

            more := true.

        ].

        char == $h ifTrue:[

            "Ignore half-length (short) specifier."

            more := true.

        ].

        char == $j ifTrue:[

            "Ignore intmax-length specifier."

            more := true.

        ].

        char == $t ifTrue:[

            "Ignore ptrdiff-length specifier."

            more := true.

        ].

        char == $z ifTrue:[

            "Ignore size_t-length specifier."

            more := true.

        ].

        more ifTrue:[

            formatStream next.  

            char := formatStream peek.

        ].

    ] doWhile:[more].

    ('fegFEG' includes: char) ifTrue:[

        arg := nextArg value.

        (arg isNaN or:[arg isFinite not]) ifTrue:[

            argString := arg printString.

            (char isUppercase) 

                ifTrue:[ argString := argString asUppercase ] 

                ifFalse:[ argString := argString asLowercase ].

            arg positive ifTrue:[

                plus ifTrue: [

                    argString := '+', argString

                ] ifFalse:[

                    spaceIfPositive ifTrue: [

                        argString := ' ', argString

                    ].

                ].

            ].

        ] ifFalse:[

            arg isLimitedPrecisionReal ifTrue:[

                precision := precision ? (arg class defaultPrintPrecision).

            ] ifFalse:[ 

                arg := arg asFloat.

                precision := precision ? (Float defaultPrintPrecision).

            ].    

            argString := WriteStream on:''.