Abstract Factory

CarPartFactory>>makeCar
 self subclassResponsibility

CarPartFactory>>makeEngine
 self subclassResponsibility

CarPartFactory>>makeBody
  self subclassResponsibility

FordFactory>>makeCar
  ^FordCar new

FordFactory>>makeEngine
  ^FordEngine new

FordFactory>>makeBody
 ^FordBody new

ToyotaFactory>>makeCar
 ^ToyotaCar new

ToyotaFactory>>makeEngine
 ^ToyotaEngine new

ToyotaFactory>>makeBody
 ^ToyotaBody new

Object subclass: #CarAssembler
 instanceVariableNames: 'factory'
 classVariableNames: ''
 poolDictionaries: ''

CarAssembler>>factory: aCarPartFactory
 "Setter method"
 factory := aCarPartFactory

CarAssembler class>>using: aCarPartFactory
 "Instance creation method"
 ^self new factory: aCarPartFactory

CarAssembler>>assembleCar
| car |
"Create the top-level part, the car object which
starts out having no subcomponents, and add an
engine, body, etc."
 car := factory makeCar.
 car
  addEngine: factory makeEngine;
  addBody: factory makeBody.
 ^car

CarPartFactory>>makeCar
 ^self carClass new

CarPartFactory>>makeEngine
 ^self engineClass new

CarPartFactory>>makeBody
 ^self bodyClass new

FordFactory>>carClass
 ^FordCar

FordFactory>>engineClass
 ^FordEngine

FordFactory>>bodyClass
  ^FordBody

PorscheFactory>>carClass
  ^PorscheCar

PorscheFactory>>engineClass
 ^PorscheEngine

PorscheFactory>>bodyClass
 ^PorscheBody

Object subclass: #CarPartFactory
 instanceVariableNames: 'partCatalog'
 classVariableNames: ''
 poolDictionaries: ''

CarPartFactory class>>new
 ^self basicNew initialize

CarPartFactory>>initialize
 partCatalog := Dictionary new

FordFactory>>initialize
 super initialize.
 partCatalog
  at: #car put: FordCar;
  at: #body put: FordBody;
  at: #engine put: FordEngine.
^self

PorscheFactory>>initialize
 super initialize.
 partCatalog
  at: #car put: PorscheCar;
  at: #body put: PorscheBody;
  at: #engine put: PorscheEngine.
^self

CarPartFactory>>make: partType
 "Create a new part based on partType."
 | partClass |
 partClass := partCatalog at: partName ifAbsent: [^nil].
 ^partClass new

“anAutoFactory make: #engine.
anAutoFactory make: #body.”

“anAutoFactory makeEngine.
anAutoFactory makeBody.”

Object subclass: #CarPartFactory
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''

CarPartFactory class
 instanceVariableNames: 'partCatalog'

CarPartFactory class>>make: partType
 "We moved this method; it's a class method now."
 | partClass |
 partClass := partCatalog at: partType ifAbsent: [^nil].
 ^partClass new

CarPartFactory class>>new
  partCatalog isNil ifTrue: [self initialize].
 ^self basicNew

CarPartFactory class>>initialize
 "Initialize the part catalog. This is now a class method."
  partCatalog := Dictionary new

FordFactory class>>initialize
 "Initialize the *local* part catalog."
 super initialize.
 partCatalog
  at: #car put: FordCar;
  at: #body put: FordBody;
  at: #engine put: FordEngine.

CarPartFactory>>make: partType
 "Create a new part based on partType."
 ^self class make: partType

CarPartFactory class>>fordFactory
 "Create and return a new Ford factory."
 | catalog |
 catalog := Dictionary new.
 catalog
  at: #car put: FordCar;
  at: #engine put: FordEngine.
 ^self new partCatalog: catalog

CarPartFactory class>>porscheFactory
 "Create and return a new Porsche factory."
 | catalog |
 catalog := Dictionary new.
 catalog
   at: #car put: PorscheCar;
  at: #engine put: PorscheEngine.
 ^self new partCatalog: catalog

“carFactory := CarPartFactory fordFactory.
carFactory make: #engine.”

CarPartFactory>>makeCar: manufacturersName
"manufacturersName is a Symbol, such as #Ford, #Toyota,
or #Porsche."
 | carClass |
 carClass := Smalltalk
  at: (manufacturersName, #Car) asSymbol
  ifAbsent: [^nil].
^carClass new

CarPartFactory>>makeEngine: manufacturersName
| engineClass |
engineClass := Smalltalk
  at: (manufacturersName, #Engine) asSymbol
  ifAbsent: [^nil].
^engineClass new

“carFactory := CarPartFactory new.
car := carFactory makeCar: carCompany.
car addEngine: (carFactory makeEngine: carCompany);”

Builder

Object subclass: #CarBuilder
 instanceVariableNames: 'car'
 classVariableNames: ''
 poolDictionaries: ''

CarBuilder class>>new
 ^self basicNew initialize

CarBuilder>>car
 "getter method"
 ^car

CarBuilder>>car: aCar
 "setter method"
 car := aCar

CarBuilder subclass: #FordBuilder
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''

CarBuilder subclass: #ToyotaBuilder
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''

CarBuilder subclass: #PorscheBuilder
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''

FordBuilder>>initialize
 self car: FordCar new

ToyotaBuilder>>initialize
 self car: ToyotaCar new

PorscheBuilder>>initialize
 self car: PorscheCar new

CarBuilder>>add4CylinderEngine
  "Do nothing. Subclasses will override."

FordBuilder>>add4CylinderEngine
 self car addEngine: Ford4CylinderEngine new

ToyotaBuilder>>add4CylinderEngine
 self car addEngine: Toyota4CylinderEngine new

PorscheBuilder>>add4CylinderEngine
 self car addEngine: Porsche4CylinderEngine new

CarBuilder>>addStandard6CylinderEngine
 "Do nothing. Subclasses will override."

FordBuilder>>addStandard6CylinderEngine
 self car addEngine: FordStandard6CylinderEngine new

ToyotaBuilder>>addStandard6CylinderEngine
 self car addEngine: ToyotaStandard6CylinderEngine new

PorscheBuilder>>addStandard6CylinderEngine
 self car addEngine: PorscheStandard6CylinderEngine new

ViewManager subclass: #CarAssemblerUI
 instanceVariableNames: 'builder'
 classVariableNames: ''
 poolDictionaries: ''

CarAssemblerUI>>carMenu
"Build the car-manufacturers menu."
 | menu |
 menu := Menu new
  title: 'Car';
  owner: self.
 CarBuilder subclasses do: [:aClass |
  menu
   appendItem: aClass manufacturer "the label"
   selector: (Message "the action"
   receiver: self
   selector: #userChoseBuilder:
   arguments: (Array with: aClass))].
 ^menu

CarAssemblerUI>>userChoseBuilder: builderClass
 builder := builderClass new.

CarBuilder class>>manufacturer
 self implementedBySubclass

FordBuilder class>>manufacturer
 ^'Ford'

ToyotaBuilder class>>manufacturer
 ^'Toyota'

PorscheBuilder class>>manufacturer
 ^'Porsche'

CarAssemblerUI>>engineMenu
  ^Menu new
    title: 'Engine';
    owner: self;
    appendItem: '4-Cylinder'
    selector: #engineIs4Cylinder;
    appendItem: '6-Cylinder Standard'
    selector: #engineIsStandard6Cylinder;
    appendItem: '6-Cylinder Turbocharged'
    selector: #engineIsTurbocharged6Cylinder;
  yourself

CarAssemblerUI>>engineIs4Cylinder
"The user has selected the '4-cylinder' menu item
from the 'Engine' pulldown menu. Tell my Builder."
  self builder add4CylinderEngine

CarAssemblerUI>>engineIsStandard6Cylinder
"The user has selected the 'Standard 6-cylinder'
menu item from the 'Engine' pulldown menu."
 self builder addStandard6CylinderEngine

CarAssemblerUI>>engineIsTurbocharged6Cylinder
"The user has selected the 'Turbocharged 6-cylinder'
menu item from the 'Engine' pulldown menu."
 self builder addTurbocharged6CylinderEngine

CarAssemblerUI>>orderCar
"The user has selected the 'Order' menu item, signaling
all car/components selections have been made."
 | completeCar |
 "Get the assembled car from my Builder:"
  completeCar:= builder assembledCar.
 completeCar isNil ifTrue: [^MessageBox message:
  'You haven''t finished assembling a complete car yet!'].
 "Assemble and print an invoice for the assembled car:"
  CarInvoiceMaker new printInvoiceFor: completeCar.

CarBuilder>>assembledCar
 "Return my final Product after verifying there's
a completed Product to return."
 car isNil ifTrue: [^nil].
 car engine isNil ifTrue: [^nil].
 ^car

Factory Method

FordBuilder>>add4CylinderEngine
"Add a 4-cylinder engine; it is created by
invoking a factory method."
 self car addEngine: self fourCylinderEngine

ToyotaBuilder>>add4CylinderEngine
 self car addEngine: self fourCylinderEngine

FordBuilder>>fourCylinderEngine
"The Ford 4-cylinder engine factory method."
 ^Ford4CylinderEngine new

ToyotaBuilder>>fourCylinderEngine
 ^Toyota4CylinderEngine new

Prototype

“Prototype Version”

Object subclass: #Policy
instanceVariableNames: 'policyNumber coverageStartDate
lengthOfCoverage organization procedureRules'
classVariableNames: ''
poolDictionaries: ''

Policy>>postCopy
 "See general comments in superimplementor."
 "Make an independent copy of this Policy's attributes"
 | newDictionary |
 newDictionary := Dictionary new.
 procedureRules keysAndValuesDo:[:key :value |
  newDictionary at: key put: value copy].
 procedureRules := newDictionary.
 organization:= organization copy

“Decorator Version”


Policy>>ruleAt: aProcedureCode
 ^self procedureRules
   at: aProcedureCode
   ifAbsent: [self defaultRule]

Policy>>setRuleFor: aProcedureCode rule: aProcedureRule
 self procedureRules
   at: aProcedureCode
   put: aProcedureRule

DecoratingPolicy>>ruleAt: aProcedureCode
 ^self
   at: aProcedureCode
   ifAbsent: [self basePolicy ruleAt: aProcedureCode]

Policy>>lengthOfCoverage
 "Return the length of time, in years, this Policy
 is in effect."
 ^lengthOfCoverage

DecoratingPolicy>>lengthOfCoverage
 "See superimplementor."
 "If the value has not yet been set, return the
 base policy's value."
 ^lengthOfCoverage isNil
   ifTrue: [self basePolicy lengthOfCoverage]
   ifFalse: [lengthOfCoverage]

Policy>>derivedPolicy
 "Return a new Policy derived from this one."
 ^DecoratingPolicy new basePolicy: self

Singleton

Object subclass: #DatabaseAccessor
instanceVariableNames: 'lock'
classVariableNames: 'Instance'
poolDictionaries: ''

DatabaseAccessor class>>singleton
 Instance isNil
  ifTrue: [Instance := self basicNew initialize].
 ^Instance

DatabaseAccessor class>>new
 ^self error: 'DatabaseAccessor has only one instance. ','To retrieve it, send "DatabaseAccessor singleton".'

DatabaseAccessor>>initialize
 lock := false.
"Open the file"

DatabaseAccessor>>write: aDatabaseRecord
 "Set the lock and fork the 'real' write method."
 lock := true.
 [self writePrim: aDatabaseRecord] fork

DatabaseAccessor>>writePrim: aDatabaseRecord
 "Write the record in aDatabaseRecord to the file."
  "Now that the write is complete, unlock:"
 lock := false.

DatabaseAccessor>>read: aKey
 "Return the DatabaseRecord keyed by aKey."
 | record |
 "Don't read while a write is in progress."
 [lock] whileTrue: [Processor yield].
 "Now, read the record:"
 record := DatabaseRecord new.
 "Modify the Record"
 ^record

“DatabaseAccessor singleton read: aKey”

“DatabaseAccessor default.”