6.3. More Features

The quick tour covered most of Smalltalk's structure, but touched only the surface of object oriented programming in Smalltalk and the existing class libraries.

6.3.1. An Object-Oriented Example

After what we've seen, Smalltalk seems like an interesting alternative to other programming languages with message passing as a unique consistent approach. But is it really better for larger projects? What does is feel like to program more complex tasks in Smalltalk? The example presented in this section tries to give a glimpse at object oriented programming in Smalltalk. If you are interested in more, I recommend Total Telecommunication's billing system in Martin Fowler's "Analysis Patterns" [FOWLER97]>. The example is taken from the GNU Smalltalk tutorial and models bank accounts. We start with the class main Account class which has just the one attribute every account has: the balance.

Object subclass: #Account
        instanceVariableNames: 'balance'
        classVariableNames: ''
        poolDictionaries: '' !

!Account class methodsFor: 'obtaining instances'!
new
	|result|
	result := super new.
	result initialize.
	^result
!!

!Account methodsFor: 'initialization'!
initialize
	balance := 0
!!

This sequence of definitions is typical for a Smalltalk class. The constructor (class method "new") creates a new account object and initializes it by sending the "initialize" message. This allows derived class to easily extend the initialization. Next we add a few simple methods.

!Account methodsFor: 'printing'!
printOn: stream
	super printOn: stream.
	stream nextPutAll: ' with balance: '.
	balance printOn: stream.
!!

!Account methodsFor: 'moving money'!
spend: amount
	balance := balance - amount
!
deposit: amount
	balance := balance + amount
!!

This is enough functionality to run a few tests.

Smalltalk at: #a put: (Account new) !
a printNl !
a deposit: 125!
a deposit: 20!
a printNl!
a spend: 10!
a printNl!

In reality, there are different kinds of accounts. First, we consider a savings account. Its 'interest' attribute contains the total interest of this account (starting with zero).

Account subclass: #Savings
	instanceVariableNames: 'interest'
	classVariableNames: ''
	poolDictionaries: ''
	category: nil!

!Savings methodsFor: 'initialization'!
initialize
	interest := 0.
	^ super initialize
!!

!Savings methodsFor: 'printing'!
printOn: stream
	super printOn: stream.
	stream nextPutAll: ' and interest: '.
	interest printOn: stream.
!!

!Savings methodsFor: 'interest'!
interest: amount
	interest := interest + amount.
	self deposit: amount
!

clearInterest
	|oldInterest|
	oldInterest := interest.
	interest := 0.
	^oldInterest
!!

In the initialization method we see the application of the special variable "super" which allows us to call the method of the parent class Account after doing our own initialization of the interest. The second account is a checkings account maintaining the number of used and remaining checks (they still use checks in some parts of the world - and it is not old Europe). When writing a check (using the 'writeCheck' method), the amount is spend and the check numbers updated.

Account subclass: #Checking
	instanceVariableNames: 'checkCount checksLeft history'
	classVariableNames: ''
	poolDictionaries: ''
	category: nil !

!Checking methodsFor: 'initialization'!
init
	checksLeft := 0.
	history := Dictionary new.
	^super init
! !

!Checking methodsFor: 'printing'!
printOn: stream
	super printOn: stream.
	stream nextPutAll: ' and checkCount: '.
	checkCount printOn: stream.
	stream nextPutAll: ' and checksLeft: '.
	checksLeft printOn: stream.

	"Print the history of checks"
	history associationsDo: [ :each |
		stream nextPutAll: '\ncheck no '.
		(each key) printOn: stream.
		stream nextPutAll: ': '.
		(each value) printOn: stream.
	]
! !

!Checking methodsFor: 'spending'!
newChecks: number count: checkcount
	checkCount := number.
	checksLeft := checkcount
!

writeCheck: amount
	| num |

	"Check that we have checks left"
	(checksLeft < 1)
		ifTrue: [ ^self error: 'Out of checks' ].

	"Make sure we've never used this check number before"
	num := checkCount.
	(history includesKey: num)
		ifTrue: [ ^self error: 'Duplicate check number'].

	"Record the check number and amount"
	history at: num put: amount.

	"Update check numbers and balance"
	checkCount := checkCount + 1.
	checksLeft := checksLeft - 1.
	self spend: amount.
	^num
!!

!Checking methodsFor: 'scanning'!
checksOver: amount do: aBlock
	history associationsDo: [ :each |
		((each value) > amount)
			ifTrue: [aBlock value: each ]
	]
!!
Smalltalk at: #c put: (Checking new) !
c printNl !
c deposit: 250 !
c printNl !
c newChecks: 100 count: 50 !
c printNl !
(c writeCheck: 32) printNl !
c printNl !



c checksOver: 250 do: [:x | x printNl ] !