"{ Encoding: utf8 }"

"{ 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 '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):

        'a'     (not implemented) base-2 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 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

    Parameter selection (not implemented):

        <n>$    take n'th parameter

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

        *       take width/parameter from next argument

        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

    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 pad char arg argString |

    nextArg := [

                    argStream atEnd ifTrue:[

                        self error:'not enough arguments for format string'

                    ].

                    argStream next

               ].

    ljust := plus := pound := false.

    width := 0.

    "/ precision := SmallInteger maxVal.

    precision := nil.

    pad := $ .

    char := formatStream peek.

    char == $% ifTrue:[ 

        ^ outStream nextPut: formatStream next

    ].

    "/ flags:

    char == $- ifTrue:[

        ljust := true.  

        formatStream next.  

        char := formatStream peek

    ].

    char == $  ifTrue:[

        outStream space.  

        formatStream next.  

        char := formatStream peek

    ].

    char == $+ ifTrue:[

        plus := true.  

        formatStream next. 

        char := formatStream peek

    ].

    char == $# ifTrue:[

        pound := true.  

        formatStream next.  

        char := formatStream peek

    ].

    "/ 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: [pad := $0].

        width := Integer readFrom: formatStream 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

    ].

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

        "Ignore long specifier (l, L and ll)."

        formatStream next.  

        char := formatStream peek.

        char == $l ifTrue:[

            "Ignore long long specifier."

            formatStream next.  

            char := formatStream peek

        ].

    ].

    char == $h ifTrue:[

        "Ignore half-length (short) specifier."

        formatStream next.  

        char := formatStream peek.

    ].

    ('fegFEG' includes: char) ifTrue:[

        arg := nextArg value.

        arg isLimitedPrecisionReal ifTrue:[

            precision := precision ? (arg class defaultPrintPrecision).

        ] ifFalse:[ 

            arg := arg asFloat.

            precision := precision ? (Float defaultPrintPrecision).

        ].    

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

            argString := arg printString.

            (char isUppercase) 

                ifTrue:[ argString := argString asUppercase ] 

                ifFalse:[ argString := argString asLowercase ].

        ] ifFalse:[

            argString := WriteStream on:''.

            char asLowercase == $g ifTrue: [ 

                self absPrintFloat:arg on:argString digits:(precision + 1) ].

            char asLowercase == $f ifTrue: [

                |absArg nDigits|

                absArg := arg asFloat abs.

                nDigits := absArg = 0 ifTrue:[1] ifFalse:[absArg log10 ceiling asInteger].

                self absDecimalPrintFloat:arg on:argString digits:(precision + nDigits "+ 1")].

            char asLowercase == $e ifTrue: [

                self absScientificPrintFloat:arg on:argString digits:(precision + 1)].

            argString := argString contents.

            arg < 0

                ifTrue: [argString := '-', argString]

                ifFalse: [plus ifTrue: [argString := '+', argString]].

            (precision = 0 and: [pound not]) ifTrue:[

                (argString includes: $e)

                    ifTrue: ["self halt"]

                    ifFalse: [ argString := arg truncated printString]

            ].

            pound ifTrue:[

                (argString includes: $e)

                    ifTrue: ["self halt"]

                    ifFalse:[

                        precision - (argString size - (argString indexOf: $.)) 

                            timesRepeat:[ argString := argString, '0']

                    ]

            ].

        ].

        ljust ifTrue: [outStream nextPutAll: argString].

        width - argString size timesRepeat: [outStream nextPut: pad].

        ljust ifFalse: [outStream nextPutAll: argString].

        ^ formatStream next

    ].

    char == $c ifTrue:[

        arg := nextArg value.

        arg isString ifTrue:[

            arg := arg first

        ] ifFalse:[