Adapter

"Tailored Adapter"
Shape subclass: #TextShape
 instanceVariableNames: 'textView'
 classVariableNames: ''
 poolDictionaries: ''

TextShape class>>new
 "Return a new instance of me pointing
 to an instance of TextView."
 ^self basicNew textView: TextView new

TextShape>>textView
 "Return my Adaptee"
 ^textView

TextShape>>textView: aTextView
 "Set my Adaptee"
 textView := aTextView

TextShape>>boundingBox
"Translate and delegate this to my TextView object."
^self textView getExtent

TextShape>>isEmpty
^self textView isEmpty

"Message-based Pluggable Adapter"
Object subclass: #MessageAdapter
instanceVariableNames: 'adaptee getSelector setSelector'
classVariableNames: ''
poolDictionaries: ''

MessageAdapter class>>on: anAdaptee
"Instance creation"
^self new adaptee: anAdaptee

MessageAdapter>>adaptee: anObject
adaptee := anObject

MessageAdapter>>adaptee
^adaptee

MessageAdapter>>getSelector: aSymbol
"Setup my getter message translation.
aSymbol is the selector to send to my Adaptee
when I receive the #value message"
getSelector:= aSymbol

MessageAdapter>>setSelector: aSymbol
"Setup my setter message translation.
aSymbol is the selector to send to my Adaptee
when I receive the #value: message"
setSelector:= aSymbol

MessageAdapter>>onAspect: aspectSymbol
"A handy method to set both setter and getter
messages in one shot; assumes both have the same name,
differing only by the ':' suffix for the setter."
self
getSelector: aspectSymbol;
setSelector: (aspectSymbol, ':') asSymbol

MessageAdapter>>value
"Return the aspect of my Adaptee specified by
my getSelector"
^adaptee perform: getSelector

MessageAdapter>>value: anObject
"Set the aspect of my Adaptee specified by
my setSelector"
^adaptee perform: setSelector with: anObject

"adapter := MessageAdapter on: myApplicationModel.
adapter
getSelector: #socialSecurity;
setSelector: #socialSecurity:."
"adapter onAspect: #socialSecurity."

Bridge

"The bridge pattern code is directly taken from the VisualWorks image"

Composite

Object subclass: #Asset
instanceVariables: ''
classVariables: ''
poolVariables: ''

Asset>>value
"Return the value of this Asset."
^self subclassResponsibility

Asset>>containsSecurity: aSecurity
"Answer whether this Asset contains aSecurity."
^self subclassResponsibility

Asset subclass: #Security
instanceVariables: 'value'
classVariables: ''
poolVariables: ''

Security>>value
"See superimplementor."
^value

Security>>containsSecurity: aSecurity
"See superimplementor."
"For a Leaf, we'll say it includes aSecurity
if it is aSecurity."
^self = aSecurity

Asset subclass: #CompositeAsset
instanceVariables: 'assets'
classVariables: ''
poolVariables: ''

CompositeAsset>>assets
"Return the list of assets."
^assets

CompositeAsset>>value
"See superimplementor."
"Return the sum of the assets."
^self assets
inject: 0
into: [ :sum :asset | sum + asset value]

CompositeAsset>>containsSecurity: aSecurity
"See superimplementor."
"See if one of the assets is aSecutiry."
^self assets includes: aSecurity

CompositeAsset>>containsSecurity: aSecurity
"See superimplementor."
"See if one of the assets is aSecutiry."
self assets
detect: [ :asset | asset containsSecurity: aSecurity]
ifNone: [^false].
^true

Decorator

Object subclass: #AbstractPolicy
instanceVariables: ''
classVariables: ''
poolVariables: ''

AbstractPolicy>>reimbursementForClaim: aClaim
"Calculate and return how much money
the policy will pay for aClaim."
^self subclassResponsibility

AbstractPolicy subclass: #Policy
instanceVariables: '' "reimbursement variables"
classVariables: ''
poolVariables: ''

Policy>>reimbursementForClaim: aClaim
"See superimplementor."
"... code to calculate the reimbursement ..."

AbstractPolicy subclass: #PolicyCap
instanceVariables: 'policy capAmount'
classVariables: ''
poolVariables: ''

PolicyCap>>reimbursementForClaim: aClaim
"See superimplementor."
| uncappedAmount cappedAmount |
uncappedAmount := self policy reimbursementForClaim: aClaim.
cappedAmount := uncappedAmount min: self capAmount.
^cappedAmount

The remainder of the code in Decorator is taken from the KSC File Reader.

Facade

DatabaseBroker>>save: anObject
"Save this object into the database."
|columnMap statement|
columnMap := anObject class columnMap.
statement := (anObject isPersistent)
ifTrue: [SQLUpdate new
fromObject: anObject
columnMap: columnMap]
ifFalse: [SQLInsert new
fromObject: anObject
columnMap: columnMap].
self databaseConnection execute: statement

SQLInsert>>fromObject:object columnMap:columnMap
"Create an insert statement from this object
and its column map."
| stream |
stream := WriteStream on: String new.
stream
nextPutAll: 'INSERT INTO ';
nextPutAll: columnMap tableName;
nextPut: $(.
columnMap columnNames do:
[:name |
stream
nextPutAll: name;
nextPut: $,].
"Eliminate the last comma:"
stream position: stream position - 1.
stream nextPutAll: ') VALUES ('.
(columnMap valuesFrom: anObject) do:
[:value |
stream
nextPutAll: value;
nextPut: $,].
stream position: stream position - 1.
stream nextPut: $).
^stream contents

ColumnMap>>columnNames
"Return the column names for my mapping."
^columnMappings keys

ColumnMap>>valuesFrom: anObject
"Return a collection of the values of the
instance variables that correspond to my columns."
^self columnNames collect:
[:key | anObject perform: (columnMappings at: key)]

Flyweight

Image class>>initialize
"Set the class' initial state."
"[Image initialize]"
Smalltalk
at: #ImagePool
put: IdentityDictionary new.
^self

Image class>>release
"Prepare the class to be deleted."
"[Image release]"
Smalltalk at: #ImagePool put: nil.
Smalltalk removeKey: #ImagePool.
^self

Image class>>imageCache
"Return the Image caching dictionary."
^ImagePool

Image class>>createSaveIcon
"Create and return the Image for the Save icon."
^MainMenUI createSaveIcon

Image class>>helpIcon
"Return the Image for the Help icon."
| cacheDictionary |
cacheDictionary := self imageCache.
^cacheDictionary
at: #help
ifAbsent:
[cacheDictionary
at: #help
put: self createHelpIcon]

Image class>>saveIcon
"Return the Image for the Save icon."
| cacheDictionary |
cacheDictionary := self imageCache.
^cacheDictionary
at: #save
ifAbsent:
[cacheDictionary
at: #save
put: self createSaveIcon]

Object subclass: #ImageFactory
instanceVariableNames: 'imagePool '
classVariableNames: 'Singleton '
poolDictionaries: ''

ImageFactory class>>initialize
"Set the class' initial state."
"[ImageFactory initialize]"
Singleton := self new.
^self

ImageFactory class>>release
"Prepare the class to be deleted."
"[ImageFactory release]"
Singleton := nil.
^self

ImageFactory class>>default
"Return the class' primary instance."
^Singleton

ImageFactory>>initialize
"Set the instance's initial state."
imagePool := IdentityDictionary new.
^self

ImageFactory class>>new
"Create and return an instance of the class."
^self basicNew initialize