Object subclass: #Quantity
instanceVariableNames: 'amount unit '
classVariableNames: ''
poolDictionaries: ''!
!Quantity class publicMethods !
amount: aValue unit: aUnit
^(self new)
amount: aValue;
unit: aUnit;
yourself
!
amount: aValue unitNamed: aUnitName
^self amount: aValue unit: (self unitFromName: aUnitName asSymbol)
!
roundingValue
^0.00005
!
unitFromName: aUnitName
^UnitSystem unitFromName: aUnitName
! !
!Quantity publicMethods !
= aQuantity
^aQuantity species = self species
and: [aQuantity amount = self amount and: [aQuantity unit = self unit]]
!
amount
^amount!
amount: aNumber
amount := aNumber
!
amountExpressedOnUnit: aUnitName
| factor |
factor := self unit conversionFactorTo: aUnitName.
^self amount * factor!
create
self isValid ifFalse: [^self].
self assignUniqueKey.
super create!
displayOnUnit: aUnitName
| outStream |
outStream := WriteStream with: String new.
(self expressOnUnit: aUnitName) displayOn: outStream.
^outStream contents
!
displayOnUnits: unitNames
| outStream |
outStream := WriteStream with: String new.
(self expressOnUnits: unitNames) printOn: outStream.
^outStream contents
!
expressOnUnit: aUnitName
| factor |
factor := self unit conversionFactorTo: aUnitName.
^self class amount: self amount * factor unitNamed: aUnitName!
expressOnUnits: aUnitNameCollection
| unitsDecorator |
unitsDecorator := MultiUnitsQuantityDecorator with: self.
^self expressOnUnits: aUnitNameCollection using: unitsDecorator!
expressOnUnits: aUnitNameCollection using: unitsDecorator
| conversionAmount factorCollection |
conversionAmount := self amount.
factorCollection := self unit conversionFactorsTo: aUnitNameCollection.
1 to: factorCollection size - 1
do:
[:index |
| currentFactor |
currentFactor := factorCollection at: index.
conversionAmount := conversionAmount * currentFactor
roundTo: self class roundingValue.
unitsDecorator addUnitNamed: (aUnitNameCollection at: index)
withValue: (conversionAmount truncateTo: 1).
conversionAmount := conversionAmount rem: 1].
unitsDecorator addUnitNamed: aUnitNameCollection last
withValue: (conversionAmount * factorCollection last
roundTo: self class roundingValue).
^unitsDecorator!
isValid
^true!
printOn: aStream
self amount printOn: aStream.
aStream space.
self unit printOn: aStream
!
unit
^unit!
unit: aUnit
unit := aUnit
!
unitSystem
^self unit unitSystem
!
Quantity initializeAfterLoad!
Object subclass: #SiblingUnit
instanceVariableNames: 'subject conversionFactor '
classVariableNames: ''
poolDictionaries: ''!
!SiblingUnit class publicMethods !
unit: anUnit targetUnitSystem: targetUnitSystem
| unitFamily |
unitFamily := targetUnitSystem unitFamily.
^(self new)
subject: anUnit;
computeConversionFactor: (unitFamily factorForSystem: anUnit unitSystem)
/ (unitFamily factorForSystem: targetUnitSystem);
yourself
! !
!SiblingUnit publicMethods !
computeConversionFactor: conversionFactorBetweenSystems
conversionFactor := conversionFactorBetweenSystems
* self subject baseFactor!
conversionFactor
^conversionFactor
!
subject
^subject!
subject: anObject
subject := anObject! !
SiblingUnit initializeAfterLoad!
Object subclass: #Unit
instanceVariableNames: 'name unitSystem '
classVariableNames: ''
poolDictionaries: ''!
!Unit publicMethods !
= anObject
^anObject species = self species and: [anObject name = self name]
!
baseFactor
^self unitSystem baseFactorFor: self
!
conversionFactorsTo: unitNames
| lastUnit |
lastUnit := self.
^unitNames collect:
[:each |
| factor |
factor := lastUnit conversionFactorTo: each.
lastUnit := lastUnit unitFromName: each.
factor]
!
conversionFactorTo: aUnitName
^self unitSystem conversionFactorFrom: self
to: (self unitSystem unitFromName: aUnitName)
!
name
^name!
name: aString
name := aString
!
printOn: aStream
aStream
nextPutAll: self name asString;
space
!
unitFromName: aUnitName
^self unitSystem unitFromName: aUnitName!
unitSystem
^unitSystem!
unitSystem: aUnitSystem
unitSystem := aUnitSystem
! !
Unit initializeAfterLoad!
Object subclass: #UnitFamily
instanceVariableNames: 'name factors baseSystem '
classVariableNames: ''
poolDictionaries: ''!
!UnitFamily class publicMethods !
dimensionUnitFamily
| aUnitFamily |
aUnitFamily := self new.
aUnitFamily name: #dimensionUnitFamily.
aUnitFamily addBaseSystem: UnitSystem dimensionMetric.
aUnitFamily addSystem: UnitSystem dimensionUS factor: 1.094.
^aUnitFamily
!
initializeAfterLoad
super initializeAfterLoad.
UnitSystem resetUnitSystems.
self dimensionUnitFamily.
self massUnitFamily.
self timeUnitFamily.
!
massUnitFamily
| aUnitFamily |
aUnitFamily := self new.
aUnitFamily name: #massUnitFamily.
aUnitFamily addBaseSystem: UnitSystem massMetric.
aUnitFamily addSystem: UnitSystem massUS factor: 0.0022046226.
^aUnitFamily
!
timeUnitFamily
| aUnitFamily |
aUnitFamily := self new.
aUnitFamily name: #timeUnitFamily.
aUnitFamily addBaseSystem: UnitSystem time.
^aUnitFamily
! !
!UnitFamily publicMethods !
addBaseSystem: aSystem
self addSystem: aSystem factor: 1.
self baseSystem: aSystem
!
addSystem: aSystem factor: aNumber
aSystem unitFamily: self.
self factors at: aSystem put: aNumber
!
baseSystem
^baseSystem!
baseSystem: anObject
baseSystem := anObject!
factorForSystem: aUnitSystem
^self factors at: aUnitSystem
!
factors
^factors isNil ifTrue: [factors := Dictionary new] ifFalse: [factors]
!
includedSystems
^factors keys!
name
^name!
name: aSymbol
name := aSymbol
!
printOn: aStream
aStream nextPutAll: self name asString
!
siblingSystemsFor: aUnitSystem
| siblings |
siblings := self factors keys.
siblings remove: aUnitSystem.
^siblings!
siblingUnitNamed: aUnitName for: aUnitSystem
| originUnitSystem |
originUnitSystem := self factors keys
detect: [:each | each definesUnitNamed: aUnitName].
^SiblingUnit unit: (originUnitSystem unitFromName: aUnitName)
targetUnitSystem: aUnitSystem
!
unitSystemFromName: aSystemName
^self factors keys detect: [:each | each name = aSystemName]
! !
UnitFamily initializeAfterLoad!
Object subclass: #UnitSystem
instanceVariableNames: 'name unitFamily factors baseUnit '
classVariableNames: 'UnitSystems '
poolDictionaries: ''!
!UnitSystem class publicMethods !
dimensionMetric
| aSystem |
aSystem := self unitSystemNamed: #dimensionMetric.
aSystem defineBaseUnit: #meters.
aSystem defineUnit: #decimeters factor: 10.
aSystem defineUnit: #centimeters factor: 100.
aSystem defineUnit: #millimeters factor: 1000.
aSystem defineUnit: #micrometers factor: 10000.
aSystem defineUnit: #nanometers factor: 100000.
aSystem defineUnit: #picometers factor: 1000000.
aSystem defineUnit: #dekameters factor: 0.1.
aSystem defineUnit: #hectometers factor: 0.01.
aSystem defineUnit: #kilometers factor: 0.001.
aSystem defineUnit: #megameters factor: 0.0001.
aSystem defineUnit: #gigameters factor: 0.00001.
^aSystem
!
dimensionUS
| aSystem |
aSystem := self unitSystemNamed: #dimensionUS.
aSystem defineBaseUnit: #yards.
aSystem defineUnit: #miles factor: 1 / 1760.
aSystem defineUnit: #fathoms factor: 0.5.
aSystem defineUnit: #feet factor: 3.
aSystem defineUnit: #inches factor: 36.
aSystem defineUnit: #mils factor: 36000.
^aSystem
!
massMetric
| aSystem |
aSystem := self unitSystemNamed: #massMetric.
aSystem defineBaseUnit: #grams.
aSystem defineUnit: #decigrams factor: 10.
aSystem defineUnit: #centigrams factor: 100.
aSystem defineUnit: #milligrams factor: 1000.
aSystem defineUnit: #micrograms factor: 10000.
aSystem defineUnit: #nanograms factor: 100000.
aSystem defineUnit: #picograms factor: 1000000.
aSystem defineUnit: #dekagrams factor: 0.1.
aSystem defineUnit: #hectograms factor: 0.01.
aSystem defineUnit: #kilograms factor: 0.001.
^aSystem
!
massUS
| aSystem |
aSystem := self unitSystemNamed: #massUS.
aSystem defineBaseUnit: #lbs.
aSystem defineUnit: #oz factor: 16.
aSystem defineUnit: #drams factor: 256.
^aSystem
!
resetUnitSystems
UnitSystems := OrderedCollection new!
time
| aSystem |
aSystem := self unitSystemNamed: #time.
aSystem defineBaseUnit: #Weeks.
aSystem defineUnit: #Days factor: 7.
aSystem defineUnit: #Hours factor: 168.
aSystem defineUnit: #Minutes factor: 10080.
aSystem defineUnit: #Seconds factor: 604800.
^aSystem
!
unitFromName: aUnitName
| aUnitSystem |
(aUnitName isNil or:[aUnitName isEmpty]) ifTrue:[^nil].
aUnitSystem := UnitSystems
detect: [:each | each includesUnitNamed: aUnitName].
^aUnitSystem unitFromName: aUnitName
!
unitSystemNamed: aSymbol
| instance |
^UnitSystems detect: [:each | each name = aSymbol]
ifNone:
[instance := super new.
instance name: aSymbol.
UnitSystems add: instance.
instance]
! !
!UnitSystem publicMethods !
baseFactorFor: aUnit
^self factors at: aUnit
!
baseUnit
^baseUnit!
baseUnit: anUnit
baseUnit := anUnit
!
conversionFactorFrom: aUnit to: anotherUnit
| fromFactor toFactor |
fromFactor := self factors at: aUnit
ifAbsent:
[self error: 'Unable to find the unit definition into its UnitSystem'].
toFactor := self factors at: anotherUnit
ifAbsent:
[self
error: 'Unable to find the external unit definition into the UnitSystem'].
^toFactor / fromFactor
!
defineBaseUnit: aUnitName
self baseUnit: (self defineUnit: aUnitName factor: 1).
^self baseUnit
!
definedUnits
^((self factors keys select: [:each | each unitSystem = self])
asSortedCollection: [:a :b | (self baseFactorFor: a) > (self baseFactorFor: b)])
asOrderedCollection!
definesUnitNamed: aSymbol
^self definedUnits contains: [:each | each name = aSymbol asSymbol]
!
defineUnit: aUnitName factor: aNumber
| aUnit |
aUnit := (Unit new)
name: aUnitName;
unitSystem: self;
yourself.
self factors at: aUnit put: aNumber.
^aUnit
!
factors
^factors isNil ifTrue: [factors := Dictionary new] ifFalse: [factors]
!
includesUnitNamed: aSymbol
^self factors keys contains: [:each | each name = aSymbol asSymbol]
!
name
^name!
name: aSymbol
name := aSymbol
!
printOn: aStream
aStream nextPutAll: self name asString
!
siblingUnitSystems
^self unitFamily siblingSystemsFor: self!
unitFamily
^unitFamily!
unitFamily: anUnitFamily
unitFamily := anUnitFamily
!
unitFromName: aUnitName
^self factors keys detect: [:each | each name = aUnitName asSymbol]
ifNone:
[| siblingUnit |
siblingUnit := self unitFamily siblingUnitNamed: aUnitName for: self.
self factors at: siblingUnit subject put: siblingUnit conversionFactor.
siblingUnit subject]! !
UnitSystem initializeAfterLoad!
Adaptive Object Model
Anything you can do, I can do meta…
