" Module : AKG-STRING.ST Date: 1-Nov-1990 Version: 3.01-01 Modified: 7-Aug-1991 Index: asNumber Answer the value represented by the receiver. Currently asNumber tries to convert to a floating point number, or an integer. If both of these fail, return self. asStrictFloat Answer the floating point number represented by the receiver. If the conversion fails, return an error. asStrictFloatElse: aBlock Answer the floating point number represented by the receiver. If the conversion fails, return the result of evaluating aBlock. asStrictInteger Answer the integer represented by the receiver. If the conversion fails, return an error. asStrictIntegerElse: aBlock Answer the integer represented by the receiver. If the conversion fails, return the value of evaluatin aBlock. asciiObjects Answer an OrderedCollection of objects from self. The expected format of the receiver is the same as a line from a DEC ASCII file. between: firstSubstring and: secondSubstring Answer the string between firstSubstring and secondSubstring, return an error if either substrings don't exist. positionOf: subString Answer an integer indicating the index of subString. If subString is not present, answer 0. trim: aNumber pad: aString Answer the receiver lengthened/shortened to aNumber. If the receiver needs to be lengthened, pad with aString. trim: aNumber padLeft: aString Answer the receiver lengthened/shortened to aNumber. If the receiver needs to be lengthened, pad with aString at the start of the receiver. trimPadLeft: anInteger trimPadRight: anInteger Answer the receiver lengthened/shortened to anInteger. If the receiver needs to be lengthed, spaces are used. " " | Change Log | ============================================================================ | Author Date Change | ALISTAIR 7 Aug 91 3.01-01 | Changed incorrect reference to asBestGuess. Fixed bug | in asNumber. Added asNumberElse: | | ALISTAIR 30 Jul 91 3.01-00 | Changed asBestGuess to asNumber. | | ALISTAIR 20 Jan 91 2.00-00 | Added trimPadLeft:, trimPadRight: methods. | | ALISTAIR 1 Dec 90 1.03-02 | Tidied up comments (but not enough). | | ALISTAIR 22 Nov 90 1.03-01 | Rename asObjects to asciiObjects. | | ALISTAIR 20 Nov 90 1.03-01 | Removed debugging code. | | ALISTAIR 20 Nov 90 1.03-00 | Added asObjects method. | | ALISTAIR 7 Nov 90 1.02-00 | Fixed asStrictInteger to handle long numbers | properly. The previous method resulted in an integer | overflow. | " !String methodsFor: 'converting'! asStrictIntegerElse: aBlock "Answer the integer represented by self. If the conversion fails, return the value of evaluating aBlock." | power intValue tmpString negative | intValue _ 0. power _ 1. tmpString _ self. negative _ 1. ((self at: 1) = $-) ifTrue: [ (self size = 1) ifTrue: [^aBlock value]. negative _ -1. tmpString _ self copyFrom: 2 to: (self size) ]. tmpString reverseDo: [ :digit | ((digit < $0) or: [digit > $9]) ifTrue: [^aBlock value]. intValue _ intValue + ((digit digitValue) * power). power _ power * 10 ]. ^(intValue * negative) ! asStrictInteger ^self asStrictIntegerElse: [self error: 'Not in Integer format.'] ! asStrictFloatElse: aBlock "Return the floating point number represented by the receiver. Don't try and read the code, this has got completely out of hand !!" | value1 value2 tmpString negative tmp tmp1 power | negative := 1.0. tmp := 1. ((self at: 1) = $-) ifTrue: [ (self size = 1) ifTrue: [^aBlock value]. negative _ -1.0. tmp _ 2 ]. "Get end point of whole number" tmp1 := self indexOf: $.. (tmp1 = 0) ifTrue: "Try for exponential component" [tmp1 _ (self asUppercase) indexOf: $E]. (tmp1 = 0) ifTrue: "Must be in integer format" [tmp1 := self size + 1]. value1 := 0.0. power := 1.0. (self copyFrom: tmp to: (tmp1 - 1)) reverseDo: [ :char | ((char < $0) or: [char > $9]) ifTrue: [^aBlock value]. value1 := power * (char digitValue) + value1. power := 10.0 * power ]. "Get start and end of decimal part of number" tmp _ self indexOf: $.. (tmp = 0) ifFalse: [ tmp1 := (self asUppercase) indexOf: $E. (tmp1 = 0) ifTrue: [tmp1 := self size + 1]. tmpString := self copyFrom: (tmp + 1) to: (tmp1 - 1). power := 10.0. tmpString do: [ :char | value1 := (char digitValue) / power + value1. power := 10.0 * power. ] ]. "Get exponent" tmp _ (self asUppercase) indexOf: $E. (tmp = 0) ifFalse: [tmpString _ self copyFrom: (tmp + 1) to: self size. value1 _ (10.0 raisedTo: (tmpString asStrictIntegerElse: [^(aBlock value)])) * value1]. ^(value1 * negative) ! asStrictFloat ^self asStrictFloatElse: [self error: 'Not in Float format.'] ! asNumber "Convert string to integer or floating point, return an error on failure." ^self asNumberElse: [self error: 'Not in number format.'] ! asNumberElse: aBlock "Convert string to integer or floating point type if possible." | anObject | ^(self asStrictIntegerElse: [self asStrictFloatElse: aBlock]) ! trim: aNumber pad: aString "Make the string length aNumber, pad with aString" | newSelf | newSelf := self asString. [newSelf size < aNumber] whileTrue: [ newSelf := newSelf, aString ]. (newSelf size > aNumber) ifTrue: [ newSelf := newSelf copyFrom: 1 to: aNumber ]. ^newSelf ! trim: aNumber padLeft: aString "Make ourself length aNumber, pad with aString from the start of ourself" | newSelf | newSelf := self asString. [newSelf size < aNumber] whileTrue: [ newSelf := aString, newSelf ]. (newSelf size > aNumber) ifTrue: [ newSelf := newSelf copyFrom: 1 to: aNumber ]. ^newSelf ! trimPadLeft: anInteger | newSelf | newSelf := self trimPad: (self asString) left: anInteger. ^newSelf ! trimPadRight: anInteger | newSelf | newSelf := self trimPad: (self asString) right: anInteger. ^newSelf ! asciiObjects | state whiteSpace curString fileLine rowCollection | " state nil - not in obj. 'atom' - in a simple object 'string' - in a quoted string." state := nil. whiteSpace := Array new: 2. whiteSpace at: 1 put: (Character value: 32). whiteSpace at: 2 put: (Character value: 9). state = nil. rowCollection := OrderedCollection new. fileLine := (self asString) copyWith: (Character value: 32). fileLine do: [ :char | (state isNil) ifTrue: "Not inside next object" [ (whiteSpace includes: char) ifFalse: "At the start of an object" [ curString := String new: 0. (char = $") ifTrue: "This is a quoted string" [ state := 'string'. ] ifFalse: "This is an atom" [ state := 'atom'. curString := curString copyWith: char. ]. ]. ] ifFalse: "Currently inside an object" [ (state = 'atom') ifTrue: [ (whiteSpace includes: char) ifFalse: "Add character to object" [ curString := curString copyWith: char. ] ifTrue: "At end of object, save it" [ rowCollection addLast: (curString asNumberElse: [curString]). state := nil. ]. ]. (state = 'string') ifTrue: [ (char = $") ifFalse: "Inside object still" [ curString := curString copyWith: char. ] ifTrue: "At end of object, save it" [ rowCollection addLast: curString. state := nil. ]. ]. ]. ]. ^rowCollection !! !String methodsFor: 'editing'! positionOf: aSubstring | lastPos subSize | subSize := aSubstring size. lastPos := self size - subSize. (lastPos <= 0) ifTrue: [self error: 'SubString larger than string.']. 1 to: (lastPos + 1) do: [ :cPos | (aSubstring = (self copyFrom: cPos to: (cPos + subSize - 1))) ifTrue: [ ^cPos ] ]. ^0 ! between: firstSubstring and: secondSubstring | p1 p2 | p1 := self positionOf: firstSubstring. (p1 = 0) ifTrue: [self error: 'First substring not found']. p1 := p1 + firstSubstring size. p2 := self positionOf: secondSubstring. (p2 = 0) ifTrue: [self error: 'Second substring not found']. p2 := p2 - 1. (p1 >= p2) ifTrue: [self error: 'First substring after or equal to second']. ^self copyFrom: p1 to: p2 !! | dynfun | dynfun := VmsDynamicFunction new. dynfun addLibrary: 'AKG_VMSFILE'. dynfun defineExternFunc: 'trimPadLeft' withSelectorArgs: 'trimPad: aString left: anInt' forClass: String returning: #string args: #(string int). dynfun defineExternFunc: 'trimPadRight' withSelectorArgs: 'trimPad: aString right: anInt' forClass: String returning: #string args: #(string int). !