"{ Package: 'stx:libbasic2' }"

"{ NameSpace: Smalltalk }"

Object subclass:#PrintfScanf

	instanceVariableNames:''

	classVariableNames:'Singleton'

	poolDictionaries:''

	category:'System-Support'

!

!PrintfScanf class methodsFor:'documentation'!

documentation

"   

    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

"

!

examples

"

    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  }

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

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

    '%c' printf: #(16r41)

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

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

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

"

! !

!PrintfScanf class methodsFor:'instance creation'!

new

    Singleton isNil ifTrue:[

        Singleton := self basicNew

    ].    

    ^ Singleton

! !

absDecimalPrintFloat:aFloat on:aStream digits:digits 

    "Place a string representation of the receiver on <aStream>,

     using <digits> significant digits, using decimal notation."

    |absVal exp x fuzz i|

    absVal := aFloat abs.

    "x is myself normalized to (1.0, 10.0), exp is my exponent"

    exp := absVal < 1.0 

            ifTrue:[ 

            ifFalse:[

    x := absVal / (10.0 raisedTo:exp).

    fuzz := 10.0 raisedTo:1 - digits.

    x := 0.5 * fuzz + x.

    x >= 10.0 ifTrue:[ 

        "check if rounding has unnormalized x" 

        x := x / 10.0.

        exp := exp + 1

    ].

    exp < 0 ifTrue:[

        1 to:(1 - exp) do:[:j | 

            "/ cg: huh - what sort of code is that????

            "/ aStream nextPut:('0.000000000000' at:j)

            aStream nextPut:(j == 2 ifTrue:[$.] ifFalse:[$0])

        ].

    ].

    [ x >= fuzz ] whileTrue:[ 

        "use fuzz to track significance" 

        i := x truncated asInteger.

        aStream nextPut:(48 + i) asCharacter.

        x := (x - i) * 10.0.

        fuzz := fuzz * 10.0.

        exp := exp - 1.

        exp = -1 ifTrue:[

            aStream nextPut:$.

        ]

    ].

    [ exp >= -1 ] whileTrue:[

        aStream nextPut:$0.

        exp := exp - 1.

        exp = -1 ifTrue:[

            aStream nextPut:$.

        ]

    ]

!

absPrintFloat:aFloat on:aStream digits:digits 

    "Place a string representation of the receiver on <aStream>,

     using <digits> significant digits."

    (aFloat < 1.0e6 and:[ aFloat > 1.0e-4 ]) ifTrue:[

    ] ifFalse:[

    ]

!

absScientificPrintFloat:aFloat on:aStream digits:digits 

    "Place a string representation of the receiver on <aStream>,

     using <digits> significant digits, using scientific notation."

    |absVal exp fuzz x q i|

    absVal := aFloat abs.

    "x is myself normalized to [1.0, 10.0), exp is my exponent"

    exp := absVal < 1.0 

                ifTrue:[

                ifFalse:[

    x := absVal / (10.0 raisedTo:exp).

    fuzz := 10.0 raisedTo:1 - digits.

    x := 0.5 * fuzz + x.

    x >= 10.0 ifTrue:[ "check if rounding has unnormalized x" 

        x := x / 10.0.

        exp := exp + 1

    ].

    q := exp.

    exp := 0.

    [ x >= fuzz ] whileTrue:[

        "use fuzz to track significance" 

        i := x truncated.

        aStream nextPut:(48 + i) asCharacter.

        x := (x - i) * 10.0.

        fuzz := fuzz * 10.0.

        exp := exp - 1.

        exp = -1 ifTrue:[

            aStream nextPut:$.

        ]

    ].

    [ exp >= -1 ] whileTrue:[

        aStream nextPut:$0.

        exp := exp - 1.

        exp = -1 ifTrue:[

            aStream nextPut:$.

        ]

    ].

    aStream nextPut:$e.

    q printOn:aStream

!

formatArgCountFor:aFormatString

    "Return the number of arguments required/produced,

     if the argument is interpreted as a printf/scanf format control string."

    |nonConsecutive count|

    nonConsecutive := true.

    count := 0.

    aFormatString do:[:c |

        c == $% ifTrue:[

            nonConsecutive ifTrue:[

                count := count + 1. 

                nonConsecutive := false

            ] ifFalse:[

                count := count - 1. 

                nonConsecutive := true

            ]

        ] ifFalse:[

            nonConsecutive := true

        ]

    ].

    ^ count

! !

    "Interpret the required number of arguments from <argStream>

     the interpretation on <outStream>.  The interpretation is C

     printf(3) style, as described in the UTek manual page for

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

     Return when the conversion control string is consumed.  

     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!!!!"    

    | ljust plus pound width precision pad char arg argString |

    ljust := plus := pound := false.

    width := 0.

    "/ precision := SmallInteger maxVal.

    precision := nil.

    pad := $ .

    char == $% ifTrue:[ 

    ].

    char == $- ifTrue:[

        ljust := true.  

    ].

    char == $  ifTrue:[

        outStream space.  

    ].

    char == $+ ifTrue:[

        plus := true.  

    ].

    char == $# ifTrue:[

        pound := true.  

    ].

    char == $* ifTrue:[

        width := argStream next.  

    ].

    char isDigit ifTrue:[

        char == $0 ifTrue: [pad := $0].

    ].

    char == $. ifTrue:[

        char == $*

    ].

    char == $l ifTrue:[

        "Ignore long specifier."

    ].

    ('feg' includes: char) ifTrue:[

        arg := argStream next.

        arg isLimitedPrecisionReal ifTrue:[

            precision := precision ? (arg class defaultPrintPrecision).

        ] ifFalse:[ 

            arg := arg asFloat.

            precision := precision ? (Float defaultPrintPrecision).

        ].    

        argString := WriteStream on:''.

        char == $g ifTrue: [ 

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

        char == $f ifTrue: [ 

        char == $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].

    ].

    char == $c ifTrue:[

        arg := argStream next asCharacter asString

    ].

    char == $s ifTrue:[

        "Assume the arg is a String or Symbol."

        arg := argStream next asString

    ].

    char == $d ifTrue:[

        arg := argStream next asInteger printString.

        plus ifTrue: [arg := '+', arg]

    ].

    char == $u ifTrue:[

        arg := argStream next asInteger abs printString

    ].

    char == $o ifTrue:[

        arg := argStream next asInteger abs printStringRadix: 8.

        pound ifTrue: [arg := '0', arg]

    ].

    ('xX' includes: char) ifTrue:[

        arg := argStream next asInteger abs printStringRadix: 16.

        pound ifTrue: [arg := '0x', arg]

    ].

    ('bB' includes: char) ifTrue:[

        arg := argStream next asInteger abs printStringRadix: 2.

        pound ifTrue: [arg := '0b', arg]

    ].

    char == $x ifTrue:[

        1 to: arg size do: [:i |

            ('ABCDEF' includes: (arg at: i)) ifTrue:[

                arg at: i put: (arg at: i) asLowercase

            ]

        ]

    ].

    precision := precision ? arg size.

    ljust ifTrue: [outStream nextPutAll: (arg copyFrom: 1 to: precision)].

    width - precision timesRepeat: [outStream nextPut: pad].

    ljust ifFalse: [outStream nextPutAll: (arg copyFrom: 1 to: precision)].

!

    "Format and print the receiver with <args> formatted in C style, 

    |aStream|

    ^ aStream contents

    "