Previous Page Next Page

Chapter 14
SMALLTALK/V CLASSES

This section describes the major Smalltalk/V classes. These classes serve as the basic building blocks for your applications.

Magnitudes

The magnitude classes are the easiest to understand and the most frequently used. They define objects that can be compared, measured, ordered, and counted. These include characters, numbers, dates, and times. Many useful messages for comparing, testing, and ordering these objects are defined. The arithmetic operators and many useful numerical functions are also defined as messages understood by the numerical magnitude objects.

This chapter presents a quick overview of each of the magnitude classes provided
in Smalltalk/V. Examples demonstrate some of the functionality provided.

The Magnitude class hierarchy shown below lists all of the magnitude classes.

Magnitude
Association
Character
Date
Number
Float
Fraction
Integer
LargeNegativeInteger
LargePositiveInteger
SmallInteger
   Time

Magnitude

All of the magnitude classes are subclasses of the abstract class Magnitude. Class Magnitude provides the comparing and ordering protocol inherited by its subclasses. All magnitudes support comparing, ordering, and interval testing. Magnitude assumes its subclasses implement the ordering relation and comparison methods: =, <=, >=, <, >,~=. Based on these methods, Magnitude provides generic methods for interval testing and max/min computation inherited by all Magnitude classes. Some numerical examples are:

Expression Answer

46 > 33 true

46 min: 33 33

46 max: 33 46

5/4 between: 0.5 and: 1 false

Character

The instances of class Character are the extended ASCII character set from ASCII value 0 to ASCII value 255. Characters are pre-existing objects in Smalltalk, hence they do not have to be created. References to characters are made in two ways: as literals or by converting integers into the corresponding ASCII character. There are two conversion messages. The message asCharacter can be sent to an integer, or the message value: with an integer argument can be sent to class Character. For example:

Character Literal Equivalent Expression

A $A 65 asCharacter

B $B 66 asCharacter

C $C Character value: 67

space $ 32 asCharacter

line feed 10 asCharacter

tab Character value: 9

Like all subclasses of Magnitude, the class Character must define how characters are compared and ordered. The methods <, <-, =, >=, > and ~= compare characters by comparing their ASCII values. For example:

Expression Answer

$a = $A false

$A < $B true

The interval testing and min/max methods are inherited from class Magnitude automatically:

Expression Answer

69 asCharacter max: $A $E

$x between: $a and: $t false

Class Character has many testing and conversion methods. Some examples follow:

Expression Answer

$a isUpperCase false

$a isLowerCase true

$a asUpperCase $A

$? asLowerCase $?

$e isVowel true

Expression Answer

$+ isLetter false

$9 isDigit true

$A asciiValue 65

Date and Time

Instances of class Date represent specific dates such as January 1, 1980 or September 15, 1876. Instances of class Time represent specific times of the day such as 10 am or 12:15 pm.

Dates and Times are created by evaluating expressions. The detailed descriptions of classes Date and Time in the Encyclopedia of Classes give a complete list of the messages supported by Date and Time. Some examples are:

Time now
Date today
'14 August 1976' asDate
Date newDay: 14 month: #Aug year: 1976.

The following code makes an instance of class Date and puts it in the global variable Birthday:

Smalltalk at: #Birthday put: '4 August 1976' asDate

Ordering and comparing of dates and times are supported. Some examples of messages supported by Date are:

Expression Answer

Birthday year 1976

Birthday dayName Wednesday

Birthday > Date today false

Birthday min: Date today 'Aug 4, 1976'

Birthday 'Jul 31, 1976'

previousWeekday: #Saturday

Birthday

daysLeftInYear 149

Birthday daysInYear 366

You can add new ways of creating objects by defining new methods. If you add the following method as a class method in class Time:

hour: hours minute: minutes second: secs
"Answer an instance of class Time as specified"
   ^ self fromSeconds: ((( hours * 60) + minutes) * 60) + secs

then you can create instances of class Time using expressions like the following:

Smalltalk at: #LunchTime 
put: (Time hour: 12 minute: 0 second: 0).
Smalltalk at: #DinnerTime
put: (Time hour: 18 minute: 45 second: 0).
Smalltalk at: #BreakfastTime
      put: (Time hour: 7 minute: 30 second: 0).

Some examples using these new global variables are:

Expression Answer

LunchTime true

between: BreakfastTime

and: DinnerTime

LunchTime min: 12:00:00

DinnerTime

DinnerTime hours 18

LunchTime < false

BreakfastTime

Number

Smalltalk supports three kinds of numbers: floating point (class Float), rational (class Fraction), and integer (class Integer and its subclasses). The methods of class Number define the general behavior of its subclasses, support mixed mode arithmetic, and provide many useful numeric, testing, and iteration functions.

Number defines the arithmetic protocol that its subclasses must implement. These are the usual binary arithmetic operators: +, -, *, /. There is equal precedence between all binary operators, so evaluation is left to right. Some examples:

Expression Answer

3 + 4 7

3 + 4 * 2 14

2 + 4 / 12 1/2

Number implements many numerical methods that its subclasses can inherit such as: exp, cos, arcSin, tan, ln, sqrt, floor, reciprocal. Some examples:

Expression Answer

7.5 floor 7

4 reciprocal 1/4

2.3 abs 2.3

Number implements many testing methods inherited by its subclasses such as: even, positive, strictlyPositive. Some examples:

Expression Answer

4 even true

0.1 positive true

0 strictlyPositive false

Number implements methods for creating other kinds of objects, such as:

Expression Answer

2 @ 7 Point with x coordinate = 2 and y coordinate =7

1/4 to: 3/4 by: 1/8 An Interval containing the fractions 1/4, 3/8, 1/2,

5/8, 3/4

Number also implements iteration methods, such as:

1/4 to: 1.5 by: 1 do: [:i |
   Transcript space; nextPutAll: i printString; cr] 

which prints the numbers 1/4 and 5/4 in the Transcript window.

Smalltalk/V supports mixed mode arithmetic so that arithmetic expressions can be composed of different kinds of numbers. Executing sample expressions is the best way to understand the conversion rules.

Expression Answer Comment

1 + 2 3

5.1 - 3 2.1 Note space between - and 3

2 * -4.0 -8.0 Mixed mode gives a Float

2/4 1/2 A fraction

1/2 + 1 3/2 Mixed mode gives a Fraction

1/2 + 1.0 1.5 Mixed mode gives a Float

4/2 2 Fraction reduces to an integer

The following examples explain many of the messages that can be used with Number.

Expression Answer Comment

4 // 3 1 Integer quotient

-4 // 3 -2 Truncate toward minus infinity

4 \\ 3 1 Integer remainder

-4 \\ 3 2 Integer remainder, truncates as //

-4 quo: 3 -1 Integer quotient, truncate toward zero

-4 rem: 3 -1 Integer remainder, truncate toward zero

-2.3 abs 2.3 Absolute value

Expression Answer Comment

10 negated -10 Negation

11 reciprocal 1/11 A fraction

2 + 3 * 4 20 Evaluation is left to right

3 - (2 * 2) -1 Parentheses change evaluation order

2 + 3 negated -1 Unary operator (negated) done first

6 quo: 2 + 1 2 Keyword operator (quo:) done last

2 sqrt 1.4142135 Square root

4 sqrt 2.0 Answer always float

2.1 squared 4.41 Receiver times itself

2.3 even true

2 odd false

10 negative false

0 positive true True if >= 0

0 strictlyPositive false True if > 0

-0.1 sign -1

0 sign 0

100 sign 1

5.1 ceiling 6 Nearest integer greater than or equal

-5.1 ceiling -5

5.1 floor 5 Nearest integer less than or equal

-5.1 floor -6

5.1 truncated 5 Nearest integer toward zero

-5.1 truncated -5

5.1 rounded 5 Nearest integer

5.1 truncateTo: 2 4 Nearest argument multiple toward zero

5.1 truncateTo: 2.3 4.6

5.1 roundTo: 2 6 Nearest argument multiple

5.1 roundTo: 2.3 4.6

5 exp 148.41315 Exponential

2.7182819 ln 1.0 Natural logarithm

4 log: 2 2.0 The logarithm in the base of the argument

3 raisedTo: 1.1 3.3483695 The receiver to the power of the argument

4 raisedToInteger: 3 64 Receiver to the power of the integer argument

30 degreesToRadians 5.2359877e-1 Convert degrees to radians

2 radiansToDegrees 114.59155 Convert radians to degrees

0.52359878 sin 0.5 Angle in radians

0.72273425 cos 7.4999999e-1

0.24497866 tan 2.4999999e-1

0.5 arcSin 5.2359877e-1 Angle in radians

0.75 arcCos 7.2273424e-1

0.25 arcTan 2.4497866e-1

Float

An 8-byte IEEE format is used for instances of class Float to approximate real numbers. This gives approximately 18 digits of precision and represents values in the range (+/-)4.19e-307 to (+/-) 1.67e308. If your computer has an 80287, 80387 or compatible math co-processor, Smalltalk/V will access it with the full speed and precision offered by these optional arithmetic chips.

Fraction

Instances of class Fraction are exact representations of rational numbers. A pair of integers (instance variables numerator and denominator) describes the fraction. Fractions are created by sending the slash (/) message to an integer with an integer argument (provided that the answer does not reduce to an integer).

Integer

Integers are frequently used in counting and indexing. Three subclasses of class Integer are defined: LargeNegativelnteger, LargePositivelnteger and SmallInteger. Instances of class SmallInteger are in the range -32,767 to 32,767. These are highly efficient in both computing speed and memory occupation. Small integers are encoded in the reference to the object (the object pointer); they are not represented as objects in memory. The large integer classes can represent numbers with unlimited bytes of precision. Conversion between integer classes is automatic.

Streams

The Stream classes are used for accessing files, devices, and internal objects as sequences of characters or other objects. Streams have an internal record of their current position. Streams also have access messages which get or put the next object at the current position and advance the Stream's position by one. Messages are defined for changing the Stream position so that random access is possible.

This chapter presents the purposes of and the protocol shared among the Stream hierarchy classes. For a complete specification of each class, refer to the Encyclopedia of Classes.

The Stream class hierarchy is as follows:

Stream
ReadStream
WriteStream
ReadWriteStream
         FileStream

Streams are frequently used for scanning input and writing edited output. The example which follows sends the message printString to an instance of class String. The answer to this message is a new string composed of the initial string (the receiver of printString) surrounded by quotes with any internal quotes doubled. For example:

Expression Answer

'hello' printString ' ' 'hello' ' '

'hello' printString printString ' ' ' ' ' ' 'hello' ' ' ' ' ' '

The key to the following sample implementation of printString, for class String, is that an instance of class WriteStream automatically grows to contain all the characters written to it and responds to the message contents by returning a string containing all of its characters.

printString
| inputStream outputStream |
inputStream:= ReadStream on: self.
outputStream:= WriteStream on:
(String new: self size + 2).
outputStream nextPut: $'.
[inputStream atEnd]
whileFalse: [
character:= inputStream next.
outputStream nextPut: character.  
character == $'
ifTrue: [outputStream nextPut: $'] ].  
outputStream nextPut: $'.
   ^outputStream contents

This example illustrates several Stream messages. Instances of classes ReadStream and WriteStream are created with the on: message with a string as the argument. Both streams are positioned at the first character. Note that in creating the WriteStream instance, space is provided for the containing quotes but not for interior paired quotes. If interior quotes exist, the String object affected by the WriteStream will automatically be enlarged.

Characters are written to the WriteStream with the message nextPut:. The character to write is the argument.

The end of a ReadStream is detected with the atEnd message. If there is a character at the current position, atEnd answers false; otherwise it answers true.

A character is read from the ReadStream with the message next. Note that sending the message next to a ReadStream that is positioned at the end will result in a walkback.

All characters in a WriteStream are returned as a string in answer to the contents message.

Accessing Protocol

The above information is summarized in the following protocol:

Protocol Explanation

atEnd Answer true if stream is at the end else answer false.

contents Answer the collection of objects that is being streamed over.

next Answer the next object in the receiver stream and advance the position by one.

nextPut: anObject Write anObject at the current position. Answer anObject.

Positioning and Reading Protocol

Some of the Stream positioning protocol is as follows:

Protocol Explanation

position Answer an integer representing the stream's position. The position at the beginning of the stream is zero.

position: anInteger Set the stream position to anlnteger. Report an error if anlnteger is beyond the end of the stream.

reset Set the stream's position to zero.

skip: anInteger Add anInteger (which may be negative) to the stream's position.

Some Stream reading protocol follows:

Protocol Explanation

do: aBlock Proceed through the stream from the current position to the end evaluating aBlock with each element of the stream as the block argument.

isEmpty Answer true if the stream contains no elements; otherwise answer false.

next: anInteger Answer a collection of the next anInteger elements of the stream. Advance the stream position by anInteger.

peek Answer the next element in the stream without advancing the stream position. Answer nil if at end of stream.

peekFor: anObject Answer true and advance the stream position if the next object in the stream equals anObject. Otherwise, answer false and leave the stream position unchanged.

Protocol Explanation

skipTo: anObject Set the stream position beyond the next occurrence of anObject in the stream or, if none, at the end of the stream. Answer true if there was an occurrence; otherwise answer false.

upTo: anObject Answer a collection of objects starting at the current stream position and up to but not including the next object that equals anObject and advance the stream position beyond the object that equals anObject. If anObject is not in the stream, answer up to the end of the stream and set the stream position to the end.

The following example illustrates positioning and reading protocol using a stream on an array of symbols. First the stream is created and assigned to the variable Colors. Then a series of messages are sent to the stream Colors. The result of each message is shown below.

Colors:= ReadStream on:
   #(red blue green yellow pink cyan magenta brown).

Expression Answer

Colors isEmpty false

Colors next red

Colors next: 3 (blue green yellow)

Colors peek pink

Colors peekFor: #blue false

Colors upTo: #magenta (pink cyan)

Colors skip: -4 a ReadStream

Colors position 3

Colors skipTo: #pink true

Colors upTo: #red (cyan magenta brown)

Writing Protocol

Some additional Stream writing protocol follows.

Protocol Explanation

nextPutAll: Write the elements of aCollection to the stream.

aCollection Answer aCollection.

next: anInteger Write anObject to the stream anInteger times.

put: anObject Answer anObject.

cr Write a line-terminating character to the stream.

tab Write a tab character to the stream.

space Write a space character to the stream.

All objects understand the message print0n: with a stream as the argument. This message produces a character description of the receiver object on the argument stream. For example, the implementation of print0n: for class Rectangle is:

printOn: aStream
" Print the origin and corner points "
origin printOn: aStream.
aStream nextPutAll: ' corner: '.
   corner printOn: aStream

where the print0n: message is sent to the origin and comer points and the message nextPutAll: to its stream argument. The implementation for class Point is:

printOn: aStream
" Print the x and y coordinates"
x printOn: aStream.
aStream nextPutAll: '@'.
   y printOn: aStream

An example of printing a Rectangle is:

Display boundingBox printOn: Transcript

which writes the following in the Transcript window if you are running on a VGA screen:

0 @ 0 corner: 640 @ 480

Interface to the Host File System

Class FileStream, a subclass of ReadWriteStream, provides the primary high-level interface to the host file system. File streams respond to all of the stream protocol presented earlier. File streams use an instance of class File to provide random page access to files. Class File uses calls to the host file system to do the actual I/O. The class Directory provides access to storage devices and their hierarchical directories used to store files.

Most file access is handled at the high level supplied by the Stream class protocols of Smalltalk/V. So you will not likely have to concern yourself with implementation details of low-level access to disk files.

In this section we present an overview of the file system classes. For detailed information on all of the messages that they provide, please see the descriptions in the Encyclopedia of Classes and Appendix 2: Windows Classes and API Calls.

File Streams

File streams are usually created with either a message to class File specifying a partial or complete path name or a message to an instance of class Directory specifying a particular file to access in that directory. Here are some examples of messages to class File.

File pathName: 'C: \ Dir\ Subdir\ FileName.ext'
File pathName: 'chapter.1' 
File pathName: '\tutorial\chapter.1'

The first expression above has a complete path name. You will access a file named FileName.ext in a subdirectory named Subdir, in a directory named Dir, on a storage device C:. The second example above is a partial path name. The directory object Disk, a global variable, is used to complete the path name. In this case the file 'chapter.1' in the directory Disk is accessed. The final example is a complete path name without a disk drive specifier. The drive specifier used is the same as that used by the directory Disk.

Sending pathName: to File always opens a file with both read and write privileges. To open a read-only file, use:

File pathNameReadOnly: 'aFile' 

Another message, pathName:attribute:mode:, allows you to open a file with all possible attributes.

The other way to create a file stream is by sending one of the following messages to a Directory object.

Disk file: 'chapter.1'
Disk newFile: 'JunkFile' 

The above two messages cannot have path names as arguments, only a file name. The difference between the two messages is that the second message will erase an existing file of the same name if one exists. They both will create the file if it does not already exist.

A word of caution about disk files. The host operating system does not always update the directory entry on disk as you write to a file. There are two messages that you can send to file streams to cause the directory entry to be updated on the disk. These are:

stream close
stream flush

The difference between the two messages is that the first closes the file stream making further access to the file using this object impossible. The second message also causes the directory entry to be updated but keeps the file stream object open for further access to the file. For consistency, all other streams support these two messages as well, but they have no effect.

File streams are buffered for efficiency. In addition, file streams recognize two different formats for end of line, the standard carriage return and line feed pair (Cr-Lf), and the UNIX single line feed (Lf). When a file stream is opened, the beginning of the file is scanned to determine which format applies. New files are created using the Cr-Lf format. The following three messages let you test and change the line ending format for a file.

stream lineDelimiter   "Answers Cr or Lf"
stream lineDelimiter: Lf   "Change to Unix format"
stream lineDelimiter: Cr   "Change to Cr-Lf pair format" 

The fastest way to read a file stream is with the upTo: or the nextLine message. The fast way to write a file stream is with the nextPutAll: message.

Putting all of the above together, here is a efficient program which converts text files from Cr-Lf to single Lf format.

"Convert a file from standard format to Unix format."  
| input output |
input := Disk file: 'crfile.in'. 
output := Disk newFile: 'lffile.out'. 
output lineDelimiter: Lf.
[input atEnd]
whileFalse: [output nextPutAll: input nextLine; cr].  
output close

Directories

The class Directory provides access to the host file system directories. Smalltalk/V has the following global variable which contains a directory pathname and a device reference:

Disk

The global variable Disk contains the directory in which you started Smalltalk/V. You can create new directory objects using the following messages:

SampleDir := Directory pathName: 'C:\DirName' 
DiskC := Directory new drive: $C; pathName: '\' 

Note that creating a Directory object is not the same as creating a directory on the disk drive itself. To create a new directory on the disk, send the message create to a Directory object with the proper drive and path name, as in:

SampleDir create

Directories understand messages for listing their subdirectories and files, for creating new files and subdirectories, and more. See the Encyclopedia of Classes for more details.

Files and FileHandles

Class File provides the logical support to file streams necessary for random page access to host operating system files. The Encyclopedia of Classes provides a detailed list of the messages implemented by class File. Function- based access to files is further handled by the class FileHandle, a subclass of ByteArray. Unless you are building some sort of new file access protocol separate from file streams, you will rarely have to deal with these classes. A few of the messages for File are important, however: the ones for copying, renaming, and removing files.

Collections

A collection is a group of related objects. The Smalltalk collection classes define several data structures which serve as containers for arbitrary objects. For example, a String is a sequence of characters while a Set is an unordered collection of non-duplicated objects of any kind. The collection classes are useful because they provide similar protocol for:

The following are the primary members of the Collection class hierarchy:

Collection
Bag
IndexedCollection
FixedSizeCollection
Array
ByteArray
Interval
String
Symbol
OrderedCollection
SortedCollection
Set
Dictionary
         IdentityDictionary

The attributes, conversions, and common protocol among various collections are discussed next with a description of each kind of collection following.

Attributes of the Collection Class

In general, each kind of collection can be characterized by four attributes:

In the table that follows, the only collections that have the same attribute values are the String-Symbol pair and Dictionary-IdentityDictionary pair. The difference between a String and a Symbol is that a Symbol is guaranteed to be unique while a String can have many copies. The difference between a Dictionary and an IdentityDictionary is that during the key lookup comparison, the former uses the = message while the latter uses ==.

The following table shows the attributes of each class:

Fixed Element

Ordered Size Dup's Keys Class Bag No No Yes None any

IndexedCollection* Yes N.A. N.A. Integer N.A.

FixedSizeCollection* Yes Yes N.A. Integer N.A.

Array Yes Yes Yes Integer any

ByteArray Yes Yes Yes Integer SmallInteger

Interval Internal Yes No Integer Number

String Yes Yes Yes Integer Character

Symbol Yes Yes Yes Integer Character

OrderedCollection Yes No Yes Integer any

SortedCollection Internal No Yes Integer any

Set No No No None any

Dictionary No No No Lookup any

IdentityDictionary No No No Lookup any

Notes:   * -- abstract classes, there are no instances
Internal -- ordered by the internal contents of the collection 
         N.A.  -- not applicable (determined by subclasses)

Conversions

Because the various collection classes have different attributes, being able to convert from one kind of collection to another is useful. Smalltalk/V provides the following conversion protocol in class Collection.

Methods Comments

asArray Ordering is possibly arbitrary.

asBag Duplicates are kept.

asSet Duplicates are eliminated.

asOrderedCollection Ordering is possibly arbitrary.

asSortedCollection Each element is <= its successor.

asSortedCollection: sortBlock Ordering is specified by sortBlock

Thus any collection can be converted into an Array, a Bag, a Set, an OrderedCollection, or a SortedCollection.

Instance Creation

Like other classes, message new can be used to create an instance of any collection. Message new: can be used to create a fixed-size collection with a specified size and a variable size collection with a specified initial allocation size.

Some collections may be expressed in literal form:

Class Instance in literalForm

String 'John Mary'

Symbol #John

Array #($J 'John' John (John 3) )

A literal string is enclosed in a pair of quotes, a literal symbol is preceded by a number sign (#), and a literal array is enclosed in paired parentheses and preceded by a number sign. The Array example contains four elements: a character, a string, a symbol, and another array which has two elements--a symbol and a small integer. Notice that within a literal array, a symbol or another array element must not be prefixed with a number sign.

In addition, there is protocol in every collection class to create instances with one, two, three, or four elements which are not necessarily constants. For example,

Array with: 'Daughters of John'
      with: #('Ann' 'Mary')

creates an array with two elements, a string and another array of two elements.

Common Protocol

Smalltalk/V provides common protocol to manipulate collections in a uniform way. These can be categorized as adding new elements, removing elements, testing the occurrences of elements, and enumerating elements. These are all described in the Encyclopedia of Classes under class Collection.

Suppose you have two global variables, Customer and Supplier, initialized as:

Customer:= Bag with: #John. 
Supplier:= #(John Peter).

Then you send adding, removing, and testing messages to Customer:

Expression Answer Customer value if changed

Customer add: #Bob Bob Bag(John Bob)

Customer addAll: Supplier John Peter) Bag(John John Peter Bob)

Customer removeAll: Supplier (John Peter) Bag(John Bob)

Customer removeAll: Supplier error Bag(Bob)

Customer remove: #Bob Bob Bag( )

Customer isEmpty true

Customer occurrencesOf: #John 0

Customer includes: #John false

Customer addAll: #(John John) John John) Bag(John John)

Customer addAll: Supplier (John Peter) Bag(John John John Peter)

Customer occurrencesOf: #John 3

Enumerating messages allow you to process all the elements of a collection. Enumerating messages usually take a one-argument block as an argument and evaluate it with each element in the receiver collection. Assume Customer and Supplier have the same values as at the end of the last example.

| count |
count:= 0.
Customer do: [:aName | count:= count + aName size].
^ count

produces 17.

Customer select: [:aName | aName == #John]

produces Bag (John John John ).

Customer reject: [:aName | aName == #John]

produces Bag ( Peter ).

Customer collect: [ :aName | aName asArray]

produces Bag ( ($J $o $h $n ) ($J $o $h $n ) ($J $o $h $n) ($P $e $t $e $r) )

Customer detect:
   [ :aName | aName includes: $P]

produces Peter.

Customer detect:
   [ :aName | aName = #Mary] ifNone: ['Not found']

produces 'Not found'.

Customer inject: 0 into:
   [ :count :aName | count + aName size]

produces 17.

Class Bag

A Bag contains a collection of arbitrary objects. Duplicates are allowed and ordering is arbitrary. A Bag does not have external keys; therefore it cannot respond to the messages at: and at:put:. In addition to the common protocol, it has a message, add:withOccurrences: to add an element a specified number of times. Bags are hashed for efficient lookup.

As an example, here is an expression that computes the frequency of occurrence of words in a file.

| input frequency output word |
input := File pathName:'in.fil'. 
output := File pathName:'out.fil'. 
frequency := Bag new.
[(word := input nextWord) isNil ] 
whileFalse: [frequency add: word asLowerCase ].
frequency asSet asSortedCollection do: [ :word |
output
nextPutAll: word;
tab;
nextPutAll: (frequency occurrencesOf: word) printString; 
cr].
output close.

Class Set

A Set is like a Bag except that it cannot have duplicate elements. Sets are hashed for efficient lookup.

As an example, here is an expression that computes a sorted list of words in a file.

| input words word |
input := File pathName:'in.fil'. 
words := Set new. 
[(word := input nextWord) IsNil ] 
whileFalse: [words add: word asLowerCase]. 
input close 
^ words asSortedCollection. 

Class Dictionary

Class Dictionary represents a set of objects with external lookup keys. Dictionaries are hashed for efficient lookup. A Dictionary's elements are instances of class Association which contain a lookup key and its corresponding value. Because the key is only for lookup purposes, the messages includes:, do:, and other inherited enumeration messages are applied to the values rather than to the keys or to the associations themselves. Class Dictionary provides other messages to deal with keys and associations. Refer to the Encyclopedia of Classes for all the messages implemented by class Dictionary.

Class IdentityDictionary

Class IdentityDictionary is similar to Dictionary except that it uses equivalence (==) instead of equality (=) during a key lookup. Its implementation also makes better storage utilization than a Dictionary. Because its key lookup matches object pointers instead of object contents, the only sensible classes for its keys (except for special situations) are Symbol and SmallInteger.

Class IndexedCollection

Class IndexedCollection represents collections with elements ordered externally by integer indices. It is an abstract class to contain common protocol for its subclasses and therefore should not have any instance of its own created.

Because of its well-defined ordering, all of its subclasses implement the equality message in such a way that the answer is true if two IndexedCollections have the same class and size, and their corresponding elements answer true for the equality message.

Class FixedSizeCollection

Class FixedSizeCollection is a subclass of class IndexedCollection. It is an abstract class to provide common protocol for its subclasses which include: Array, ByteArray, Interval, String, and Symbol. These subclasses represent collections with a fixed range of integer indices as external keys. Because these subclasses have fixed sizes, they cannot respond to the add: message.

The instance creation message new: is subtly different when applied to a fixed size collection than to a variable one. The following message:

(Array new: 5) size

evaluates to 5, while

(OrderedCollection new: 5) size

evaluates to 0. When message new: is sent to class Array, the new instance is created with elements initialized to nil. When the message is sent to a variable size collection like OrderedCollection, the new instance is created with space allocated, but is logically empty.

The elements of an Array can be any objects. An element of a ByteArray must be a SmallInteger in the range of 0 to 255. The elements of a String or Symbol are characters. Symbols are guaranteed to be unique.

An Interval represents a finite arithmetic progression. Its elements can be any kind of number: integer, float, or fraction. Although Interval contains all the numbers within a specified range and with a specified increment between each number, it is represented concisely with only three instance variables: beginning, end, and increment. Its elements are regenerated upon access rather than stored in the instance. To create an instance, the two Interval class messages, from:to: and from:to:by:, are used. Class Number also provides some shorthand messages, to: and to:by:, to create new Intervals.

Class OrderedCollection

OrderedCollections are ordered by the sequence in which objects are added to and removed from them. They are like dynamic arrays, except that they can be expanded on both ends. To facilitate this feature, messages are provided to add, remove, and access both the beginning and end.

The add: message defined in class Collection is implemented to be like addLast:. Other messages enable you to access, add, or remove an object in the middle by specifying its preceding or succeeding object.

OrderedCollections can act as stacks or queues. Operations to a stack are typically LIFO, "last-in, first-out." Following is a comparison of terminology:

Typical Stack Vocabulary OrderedCollection Message

push newElement addLast: newObject

pop removeLast

top last

empty isEmpty

Operations to a queue are typically "first-in, first-out":

Typical Queue Vocabulary OrderedCollection Message

add newElement addLast: newObject

delete removeFirst

front first

empty isEmpty

Queues grow on one end and shrink on the other. When space is exhausted on the growing end, an OrderedCollection always checks the shrinking end. If there is enough space, it shifts the entire collection toward the shrinking end to make room for growing at the other end. If there is not enough space, it will allocate a larger space and copy the original collection to the new space.

Class SortedCollection

SortedCollections are ordered according to a two-argument block called the sort block. The sort block is used to determine whether two elements are correctly sorted relative to each other. Because the position of each element is dictated by the sort block, messages such as addLast: are disallowed. Message add: newObject, however, will insert the newObject into the sorted position according to the sort block.

There are five ways to create a new instance:

SortedCollection new
SortedCollection new: 10
SortedCollection sortBlock: [ :a :b | a > b ]
anyCollection asSortedCollection
anyCollection asSortedCollection: [ :a :b | a > b]

A sort block can be as complex as desired, but the last expression in the block must evaluate to either true or false, For example, the following sort block assumes that strings are being compared. it sorts the strings based on the number of unique vowels.

[ :a:b |
(a asLowerCase select: [ :c | c isVowel ] ) asSet size
<=
   (b asLowerCase select: [ :c | c isVowel ] ) asSet size ]

When the sort block is not specified at creation time, the following default sort block is used:

[:a:b | a<= b]

The sort block can also be changed any time by sending message sortBlock: newBlock to a SortedCollection which automatically resorts the whole collection according to the newBlock.

Window Classes

To write an interactive application in Smalltalk/V, you need to understand Smalltalk/V window technology. Smalltalk/V handles the interface with the operating system level Window Manager. Prior to the widespread availability of graphical user interfaces on Intel-processor based personal computers, Smalltalk/V had to implement its user interface entirely within the Smalltalk/V development environment.

With the Microsoft Windows 3.0 user interface, Smalltalk/V is able to take direct and powerful advantage of this graphical interface capability, allowing you to program Windows applications within an entirely object-oriented framework.

Of all the objects which populate the Windows world, the most visible, and perhaps most important, are windows. Windows are the "access points" between users and applications. While your application creates a window for user interaction, its behavior and control is a cooperative effort between your application and the host system.

Much of the generic behavior of a window--its position on your display, its scroll bar action, resizing, etc.--is automatically handled by the host Window Manager. Your main concern as a developer is "polishing the diamond in the rough," making a generic window come to life for some special purpose by providing the information and interaction unique to your application design.

In Smalltalk/V, an application with a graphical user interface typically involves three kinds of window classes:

ä ViewManager and its subclasses (such as ClassBrowser) which synchronize panes

ä TopPane, which is the top level window containing all the subpanes

A fourth category of application-related classes are those classes that describe the objects specific to your application which are manipulated and managed by the interface provided by your application's windows. For instance, in an extension of the telephone database in the tutorials, you might create a Person class to provide a more elaborate instance variable data structure to record additional inforination about people in your phone book. This separation of objects manipulated within an application window from the class of the window itself can be extremely helpful in partitioning your application development project into logical and manageable parts.

Whether your application is sufficiently complex to require additional application classes to create objects to be manipulated by your application, a new ViewManager subclass is almost always written for each new application. The task is often eased by using an existing ViewManager subclass as a template.

The TopPane and SubPane classes are complete building blocks in the system. You rarely need to modify them. Used in combination, these classes make it easy to design and implement elaborate application windows running under Smalltalk/V Windows.

The relationship between a ViewManager class and the TopPane and SubPane classes is depicted in Figure 14.1 using the ClassBrowser window as an example.

Figure 14.1

Notifier, Pane

and ViewManager

Relationships

The ViewManager subclass creates and organizes the window panes in the application and is responsible for communication and synchronization among the panes.

The TopPane class handles top level window interfaces like resizing the windows and menu bar events.

The SubPane class comprises GraphPane, TextPane, AnimationPane, GroupPane, and ControlPane and their subclasses.

ä A GraphPane instance contains graphics.

ä An instance of class TextPane lets you view and edit the text that it contains. When you save the text you modified, the ViewManager instance is again notified to act according to your request.

ä An AnimationPane instance contains AnimatedObject instances that can move about the pane.

ä A GroupPane instance allows other subpanes to be grouped together into one SubPane, for example to group several related Button instances.

ä ControlPane and its subclasses implement all the controls supported by the Windows-like features: buttons, static controls, list boxes, scroll boxes and combo-boxes.

For an application composed of panes from the standard SubPane classes, you only need to know about your ViewManager subclass. If you want to define new kinds of panes, then you also need to know more about how panes display their contents and process user input. For these more advanced functions, refer to the Smalltalk source code and the Encyclopedia of Classes.

ViewManager

An ViewManager subclass has five major functions:

ä remember the current state

ä create panes

ä provide the contents of panes

ä carry out communication and synchronization

Remember the Current State

This is normally accomplished by assigning application states to instance variables in the ViewManager subclass. For example, ClassBrowser has the following instance variables:

browsedClass

The class object you are currently browsing.

selectedDictionary

The current message dictionary (either class or instance) of the class you are browsing.

selectedMethod

The currently selected method within the currently selected message dictionary.

The contents of these variables are normally initialized during pane creation and changed from time to time by the methods mentioned below.

Create Panes

The creation of an application window is usually accomplished by sending the message open0n: or open to a new instance of the ViewManager subclass. The choice between open0n: and open depends largely on whether an argument is needed to pass relevant objects to the window opening method, such as passing a Dictionary of Person objects to a new PhoneBook window to be opened. The window opening method initializes the label for the window and creates the window's panes, providing the following items for each pane:

On the following page, you see the pane-creating function of the open0n: method defined in ClassBrowser:

openOn: aClass
"Create a class browser window on aClass. 
Define the type, behavior and relative 
size of each pane and schedule the window."
| twoLineHeight |
(aClass isKindOf: Class)
IfFalse: [^nil].
browsedClass:= aClass.
self
label: aClass name, ' | Class Browser'.
twoLineHeight := ] ListFont height * 2 + 8. 
self addSubpane:
(ListBox new
owner: self;
when: #getContents perform: #dictionaries: ; 
when: #select perform: #dictionary: ;  
selection: 2;
framingBlock: [:box | 
box leftTop extentFromLeftTop:
  box width // 3 @ twoLineHeight] ).
selectedDictionary := browsedClass. 
self addSubpane: 
(ListBox new
owner: self;
when: #getContents perform: #selectors: ; 
when: #select perform: #selector: ; 
when: #getMenu perform: #selectorMenu: ; 
framingBlock: [:box |
box leftBottom extentFromLeftBottom:
  box width // 3 @ (box height - twoLineHeight) ] ).
self addSubpane:
(TextPane new
owner: self;
when: #getContents perform: #text: ;
when: #save perform: #accept: ;
framingBlock: [:box |
(box leftTop right: (boxwidth // 3) ) 
  rightBottom: box rightBottom] ). 
   self openWindow

Invoking this method will create a window with three subpanes:

dictionaries: (a ListBox) 
selectors:(a ListBox)
text:(a TextPane)

In order for the window to work properly, the messages dictionaries:, dictionary:, selectors:, selector:, selectorMenu:, text:, and accept: must be defined as instance methods in the ClassBrowser application.

Notice that TopPane was not mentioned in this method. For a single window application, there is only one TopPane and it is implicitly managed by Smalltalk/V. If your ViewManager manages multiple windows then you need to create TopPanes explicitly.

Provide the Contents of Panes

The application must provide for each subpane a method which fills in the contents of the pane. For example, the ClassBrowser has three methods to initialize its three subpanes:

dictionaries: dictionaryPane
"Fill the dictionaries pane with 
the array of dictionaries."
   dictionaryPane contents: #(class instance)
selectors: listPane
"Fill the selectors pane with a sorted list 
of selectors for the selected dictionary."
   listPane contents: selectedDictionary selectors asSortedCollection
text: sourcePane
"Fill the source pane with the source text 
for the selected method."
   sourcePane contents: (selectedDictionary sourceCodeAt:  selectedMethod)

Note that the content of a ListBox is an instance of a subclass of IndexedCollection whose elements must be printable such as instances of String or Symbol. The content of a TextPane is a String instance (lines within the string are separated by line feeds). In case there is more data than a string can hold, the method fileInFrom: in TextPane can be used to initialize its data from an external file (refer to the source code of the file method in the DiskBrowser class).

Carry Out Communication and Synchronization

When you make a selection or change the contents of pane data, the effect can be either local or global. Global affects the application or other panes. Everything else is local. For example, in ClassBrowser, when you make a selection in the dictionaries: pane, both the selectors: pane and the text: pane need to be synchronized. Thus the effect is global. If you make editing changes in a ClassBrowser instance's text: pane, the change is local because it does not effect other panes or the application. When you save these changes, however, the text needs to be compiled into the selected class and logged to the change log file. This can only be done by the application, so the effect of saving the text is global.

Specifying when:perform: in the open or open0n: method provides each pane with a message to send when these global effects occur. For example, the selectors: ListBox in ClassBrowser is sent when: #select perform: #selector: in the open0n: method. This tells the ListBox to send the selector: message to the ClassBrowser instance whenever the user selects an item in the pane. The method you supply for the perform: argument always takes one argument, the pane itself. You can then send messages to the pane to get and change its state. For example, when you select a method in the selectors: pane, the following method in ClassBrowser is invoked by the pane:

selector: selectorPane
"Display the selected method in the text pane."
selectedMethod:=selectorPane selectedItem.
   self changed: #text:

The first statement gets the selected item from the selectors: pane and changes the application state by assigning the selected item to the instance variable selectedMethod. The second statement informs the text: pane that its state has changed and the text: pane needs to update its contents.

When the global effect calls for one or more updates in another pane, the changed: or changed:with: method defined in class ViewManager can be used to broadcast the effect to the appropriate subpanes of the application. In the previous example, selecting a method in the selectors: pane displays the source of the method in the text: pane. The changed: message is used to notify the text: pane that selectedMethod has been changed. The other message, changed:with:, in addition to notifying subpanes, also passes an object as the argument of the with: keyword to provide communication from the application to the panes.

When the subpane receives the update message (sent by method changed:), it sends a message to the application to retrieve the new pane contents. The message it sends to the application is the one supplied as the second argument to the when: #getContents perform: #message sent to the pane during open0n:. To continue the previous example, after the text: pane receives the update message, it updates its own data by sending the text: message to the ClassBrowser instance to perform the text: method which in turn sets the contents of the text: pane by sending it the message contents:, passing a string containing the source of the selected method. This concludes the update.

Define Menus for Panes

If when: #getMenu perform: is sent during the creation of a pane, a method with the same name as the second argument must be defined in the application. This method sets the menu for the pane by creating an instance of class Menu which contains the desired menu items. In the openOn: method of ClassBrowser, the message when: #getMenu perform: #selectorMenu: is sent to the selectors: pane. Thus a corresponding method is defined in ClassBrowser:

selectorMenu: aPane
"Private - Set the selector pane menu." 
aPane setMenu: ((Menu
labels: '~Senders\~Implementors\~Remove' withCrs
lines: Array new
selectors: #( senders implementors removeSelector))
title: '~Methods' ; 
owner: self;
      yourself)

The string argument to labels: contains the items to be shown in the menu. Characters with the tilde (~) before them appear underlined in the menu. Message withCrs replaces backslashes (\) with carriage returns in its receiver string. The argument to selectors: is an array of messages to send to the owner when you select the corresponding item in the menu. The argument to title: assigns a name to the menu in the menu bar of the window.

The methods carrying out selector: messages are defined in the ViewManager subclass of the application. If they are not defined, an error results when a menu item is selected which has no associated action method. ClassBrowser defines the three methods needed by the menu to take action when any of its items is selected:

removeSelector
"Private - Remove the selected method."
selectedMethod isNil
ifTrue: [^nil].
selectedDictionary
removeSelector: selectedMethod.
Smalltalk logEvaluate:
selectedDictionary name,
'removeSelector: #',
selectedMethod.
selectedMethod:= nil.
self
changed: #selectors: with: #restore;
      changed: #text:
senders
"Private - Pop-up a window with the 
senders of the selected method."
selectedMethod isNil
      ifFalse: [Smalltalk sendersOf: selectedMethod]
implementors
"Private - Pop-up a window with the 
implementors of the selectedMethod."
selectedMethod isNil
      ifFalse: [Smalltalk implementorsOf: selectedMethod]

The removeSelector method provides an example of changing the window's current state and using messages changed:with: and changed: to inform the selectors: and text: panes to update.

Note that the method that sets the menu for a pane must create a new instance of a Menu object. Menus will not work properly if a method creates one Menu object, saves it in a class or global variable, and then attempts to use it to set the menus for several different panes.

SubPane

Every SubPane has the following characteristics:

ä An owner, usually a subclass of ViewManager.

ä A collection of events that it notifies its owner about. If the owner wants to be notified of a particular event, it sends when:perform: to the pane, supplying the event (a Symbol) as the first argument and a method name (a Symbol) as the second argument. The pane sends this second argument as a message to the owner when the event occurs, passing the pane itself as the single argument to the method.

All panes notify the #getContents event which is a request to the owner to set the contents of the pane. The owner¡s method for the #getContents event also serves as the name of the pane when sending changed: messages. Another event that is common to many sub panes is #getMenu, which is a request to the owner to set the menu for the pane. other events specific to each kind of SubPane are given below. Each kind of SubPane has a class method, supportedEvents that answers a collection of the events the pane notifies.

ä The following methods for getting and changing the state of the pane:

contents - Answer the contents of the pane.
contents: - Set the contents of the pane.
selection - Answer the current selection.
selection: - Set the selection.
setMenu: - Set the menu for the pane.

ä One or more update methods, e.g update, update: update:with:, which are invoked when the owner sends itself a changed: message with the pane's name and zero or more arguments.

ä A framingBlock which defines the area of the subpane relative to its application window.

Each subclass of SubPane treats its events, its common methods, and its update methods in a particular way described below and each subclass has additional characteristics unique to it.

ControlPane

ControlPane is an abstract class with subclasses that implement the controls supported by Windows. ListBox and RadioButton are discussed below, but code for all of these can be browsed.

ListBox

The contents: method for a ListBox instance expects an IndexedCollection of Strings or Symbols. The #select event is notified when an item is selected. The selection method answers the index of the selected item, selectedItem answers the String or Symbol of the selected item. A changed: #paneName message causes the ListBox to refresh its list of strings (from its owner via the #getContents event) and display the pane from the top. A changed: #paneName with: #restore message causes the list to be refreshed and the pane is displayed staying at its current scrolled position. A changed: #paneName with: #restoreSelected: with: anObject message causes the item anObject to be selected.

RadioButton

The contents: method for a RadioButton instance expects the argument to be a String, the label of the button. A RadioButton instance never notifies a #getContents event. The selection: method expects the argument to be a Boolean. The #clicked event is notified whenever the user clicks the button to the "on" setting. RadioButton instances that are inside of a GroupPane need not have an explicit owner nor a #clicked event method. Rather, the entire GroupPane can have the owner and notify the owner of child button clicks. (See more details below under GroupPane). A changed: #paneName with: aBoolean message causes the button's value to be changed to aBoolean. A changed: #paneName message triggers the #getContents event which gives you an opportunity to change the button label.

TextPane

The contents: method for a TextPane instance expects a String. The #save event is notified when the user saves the contents of the pane. A changed: #paneName message causes the pane to refresh its contents and display from the top. A changed: #paneName with: aTextSelection causes the pane to select aTextSelection.

GraphPane

The #getContents event for a GraphPane instance expects the owner to draw the contents of the pane using the GraphicsTool for the pane obtained by sending pen to the pane. (Compatibility note: In other Smalltalk/V products, the argument to a GraphPane name method is a rectangle indicating which part of the screen to display into. This is not meaningful in Presentation Manager where Smalltalk/V does not "own" the entire screen.) A GraphPane notifies many events, one for each mouse event that the pane can receive. The current mouse position in the pane can be obtained by sending mouseLocation to the pane. A changed: #paneName message causes the pane to be refreshed.

AnimationPane

The contents: method for an AnimationPane instance expects a collection of instances of AnimatedObject. To animate the objects, you send messages to the animated objects themselves rather than sending messages to the animation pane.

GroupPane

The primary purpose of a GroupPane instance is to neatly contain other SubPane instances. Note that the framingBlocks for the subpanes of a GroupPane are relative to the GroupPane, not to the entire window containing the GroupPane. The #childClicked event is notified if the pane contains ButtonPane instances that do not have their own owner.

Prompter

Class Prompter gives an application writer a simple mechanism to pose a question and solicit an answer. A Prompter is a modal dialog box, that is the type of interaction which requires a response before you can activate the window that invoked the dialog box. The dialog presents a prompt, usually in the form of a question, and a single text pane is displayed for editing the answer.

To open a Prompter, you can send one of the following two messages to class Prompter:

Prompter prompt: question default: answer
Prompter prompt: question defaultExpression: answer

where both question and answer are strings. After the Prompter window is opened, the answer string will be shown in its text pane as a default. The first message returns a string object as answered by the application user, while the second message returns an object resulting from evaluating the answer. For instance,

Prompter prompt: 'Give me a string please' default: '2 + 3'

returns '2 + 3', and

Prompter prompt:'Give me an expression please 'defaultExpression:'2 + 3'

returns 5 after the default answer is accepted. If you cancel the Prompter, an answer of nil will be returned by both messages.

Notice that when a Prompter is accepted or canceled, the program flow control is given back to the caller of the Prompter. When most other kinds of windows are closed, control is given to the Notifier to cause another window to become active.

MessageBox

Class MessageBox is useful for getting quick yes/no or confirm/cancel information from the user. MessageBox has class messages such as:

confirm: aString 

Display a message box with aString as the title and 'Yes' and 'No' for the choices. Answer a Boolean.

message: aString

Display a message box with aString as the content and "OK" as the choice.

See the method removeFile in class DiskBrowser for an example.

Writing Your Own SubPane

If you write you own subclass of SubPane, you will probably want to process input events such as mouse clicks and typing. Every input event causes one of the following messages to be sent to the pane. If you want to handle one of these events, simply add a method to your subclass of SubPane. You do not need to worry about the events you are not interested in; they are caught in class Window.

activate
button1DoubleClick: aPoint
button1Down: aPoint
button1DownShift: aPoint
button1Move: aPoint - mouse move while button 1 is down 
button1Up: aPoint
button2DoubleClick: aPoint 
button2Down: aPoint
button2Move: aPoint - mouse move while button 2 is down 
button2Up: aPoint
characterInput: aCharacter
close
controlKeyInput: aCharacter 
deactivate
display - the pane should display its contents 
gettingFocus
losingFocus
mouseMove: aPoint - no buttons are down
resize: aRectangle - the pane should resize itself to aRectangle 
scrollVertical: anInteger - the pane should scroll its contents vertically 
scrollHorizontal: anInteger - the pane should scroll its contents horizontally 
scrollTopCornerTo: aPoint - the pane should scroll its top corner to aPoint
virtualKeyInput: anInt - non-alphanumeric keyboard input

Note that use of characterInput: and virtualKeyInput: messages provides a means to program window-specific function key and other keyboard commands. See these methods' source code as well as the host programmer's reference manual for additional information on this topic.

Saving the Image and Exiting

While Smalltalk/V is running, the state of an object can be in a Smalltalk object, in a Windows object, or in both. For example, an Array of Strings is completely a Smalltalk object. The title bar and other standard parts of a window are objects. The on/off state of a radio button is both in Windows and in Smalltalk/V. For those objects which are in Windows, the objects themselves cannot be saved in the Smalltalk image. Rather, sufficient information about how to recreate them must be saved in the image. For windows, this is accomplished as follows:

ä When creating an application window, all the information necessary to create the window is first collected in Smalltalk objects without creating any Windows objects. (This is done during the openOn: method.) Then one method in class TopPane, validate, is performed and it invokes buildWindow which causes all the various objects associated with the window to be created.

ä When you save the image and exit Smalltalk, the Windows objects disappear, but the information necessary to recreate them is in the image. Then when you restart the image, validate is performed again (without the preceding openOn:) and the objects are re-created just as they were when the image was saved. You will find buildWindow methods in various places such as SubPane, MenuWindow, and Menu.

This image-rebuilding procedure leads to a particular style of programming when creating window-related objects. First, you should only create Windows objects inside of a buildWindow method. Otherwise, you will probably not get things back just the way they were when you save, exit, and restart. Second, every window is sent the aboutToSavelmage message just before the image is saved, giving the window an opportunity to query Windows and save the object's state in instance variables.

Animation Classes

AnimationPane is a subclass of GraphPane. An AnimationPane contains one or more instances of AnimatedObject. An AnimatedObject contains a collection of Bitmap instances called frames. An AnimatedObject can be manipulated directly by sending it these messages:

go: anInteger

Move the receiver anlnteger units in its current direction.

turn: degrees

Change the direction of the receiver by degrees. If degrees is positive, the change is counterclockwise. If negative, clockwise.

direction: degrees

Set the direction of the receiver to degrees. 0 is East, 90 South.

speed: anInteger

Change the speed of the receiver to anlnteger.

Each time an AnimatedObject moves, it displays its next frame, cycling around to the first frame after the last one. An AnimatedObject can also move around continuously within the pane:

animate

Start the receiver moving continously in its current direction and at its current speed.

animateFor: anInteger

Animate the receiver for anInteger steps.

bouncer

Make the receiver bounce when it hits an edge of its pane. This is the default behavior for an animated object.

chaser

Make the receiver chase the mouse cursor.

endBlock: aBlock

Set the endBlock to aBlock which is evaluated when the receiver finishes (or catches the cursor if it is a chaser object). aBlock takes one argument which is the animated object.

stop

Stop the receiver from continuously animating.

While an object is moving, its speed and direction can be changed via speed:, direction: and turn:. See the AnimationDemo class and tutorials in Chapters 9 and 10 for examples.

Graphic Classes

The Smalltalk/V Windows graphics model is similar to using a pen to draw on a piece of paper. In Smalltalk/V Windows, a "graphics tool" is analogous to the pen and a "graphics medium" is analogous to the paper. Other Smalltalk/V graphics models (except Smalltalk/V PM) are more restricted. It was based on using a BitBIt class (which has CharacterScanner and Pen as the subclasses) to write or draw on an instance of class Form (which either contains a Bitmap or represents the screen). A new model has been adopted for graphic host interfaces (Smalltalk/V PM and Smalltalk/V Windows) for two reasons. First, with the incorporation of vector graphics, emphasis on bitmaps is diminishing. Second, in order to support a variety of output devices uniformly, the emphasis on device independence is increasing,

In Smalltalk/V, a graphics medium can be anything that is capable of displaying or storing graphics. It can be a monitor screen, a printer, a plotter, a file, or a portion of computer memory. In addition, each window object is treated as a separate medium.

Graphics tools are grouped under class GraphicsTool. It has several subclasses, each of which extends the functionality of its superclass:

ä A TextTool works like a typewriter and only displays characters.

ä A Pen is capable of not only typing but also drawing graphics.

ä A RecordingPen has all the capabilities of a TextTool and Pen and, in addition, is capable of recording graphics operations as subpictures and replaying them later to form the whole picture.

RecordingPen instances are among the most prevalent graphics tools in the Smalltalk/V system as this class encompass all the capabilities of its superclasses and adds a powerful "instant replay" facility. During replay, a subpicture can be transformed by translating its location or scaling its dimension.

Multiple graphics tools can be associated with a single medium. A graphics tool can also be disassociated from its current medium and reassociated with a different medium. Therefore you can first associate a graphics tool with a window, compose your picture interactively and later reassociate it with a graphics printer to get a final hard copy of the picture.

Each graphics tool has an instance variable called deviceContext which serves as a bridge to the operating system's graphics interface. In Microsoft Windows, this graphics interface is called Graphics Device Interface (GDI). All GDI output functions require a device context. The device contains many current attributes about the graphics medium. For example, to display text, Smalltalk/V calls the GDI TextOut function with the device context, starting location, and the length of the text as arguments. Notice that font, text color, background color, and text alignment are not specified in the call, because these and other attributes are part of the device context.

In order for the graphics tool to address the pixels on the device, there must be a coordinate system imposed on the device. The coordinate system used by Smalltalk/V is shown in Figure 14.2.

Figure 14.2

Coordinate

System

The origin (0 @ 0) , can be mapped to anywhere on the device medium. By default, it is aligned at the upper left corner of the device medium. The upper left corner of a window has coordinate (0 @ 0), and so does the upper left corner of the paper on a printer. When you specify coordinates in GDI functions, you are actually specifying "logical" coordinates. Microsoft Windows takes logical coordinates and translates them to device or pixels coordinates. This translation is dependent on the current mapping mode. The available GDI mapping modes are as follows:

MmAnisotropic Logical units mapped to arbitrary units with arbitrary scaled axes. Allows x and y coordinates to be adjusted independently.

MmHienglish Units of 0.001 in.

MmHimetric Units of 0.01 mm.

MmIsotropic Logical units are mapped to arbitrary units with equally scaled axes. Ensures 1:1 aspect ratio.

MmLoenglish Units of 0.01 in.

MmLometric Units of 0.1 mm.

MmText Each logical unit is mapped to one device pixel, regardless of size differences across devices.

MmTwips Each logical unit is mapped to one-twentieth of a printer's point (1/1440 in.).

The default mapping mode is MmText. Note that the above names, like MmText and MmAnisotropic are constants in the pool dictionary WinConstants. The method setMapMode: in GraphicsTool can be used to change the mapping mode. For a more detailed discussion of mapping modes, see Microsoft Windows Software Development Kit Reference Volume 1.

Classes for Addressing Coordinates

The following classes are defined to describe locations and areas in the selected units of the coordinate system.

Point

A Point object is used to address a single position in the coordinate system. It is represented by a pair of x (horizontal axis) and y coordinates (vertical axis).

The most efficient way to create a Point is by sending the @ message to an Integer. For example, the top left comer of a Form can be addressed by the Point:

0 @ 0

where the first integer (receiver) is the x coordinate and the second integer (argument) the y coordinate. The x: and y: messages alter the coordinates of a Point, while the x and y messages retrieve these coordinates. A Point can also be compared with another Point. Following are some examples:

Expression Result

(1 @ 100) x 1

(1 @ 100) y 100

(1 @ 100) x: 50 50 @ 100

(1 @ 100) y: 50 1 @ 50

(-2 @ 10) < (-l @ 11) true

(-2 @ 10) < (-l @ 10) false

(-2 @ 10) > (-3 @ 11) false

(-2 @ 10) max: (-3 @ 11) -2 @ 11

(-2 @ 10) min: (-3 @ 11) -3 @ 10

1 @ 2 between: 0 @ 2 and: 2 @ 2 true

Arithmetic can be performed on a Point with either a Point or a Number (as a scalar) argument. The message transpose creates a new Point by swapping the two coordinates of the receiver Point, while dotProduct gives the sum of the x product and y product of two Points:

Expression Result

(1 @ 10) rightAndDown: (2@12) 3 @ 22

(3 @ 22) leftAndUp: 10 -7 @ 12

(1 @ 10) * (3 @ 2) 3 @ 20

(1 @ 10) // 2 0 @ 5

(-2 @ -3) abs 2 @ 3

(2 @ 3) negated -2 @ -3

(2 @ 4) dotProduct: (5 @ 6) 34

(2 @ 4) transpose 4 @ 2

Rectangle

A Rectangle object is used to address a rectangular area in the coordinate system. It is represented by two points, origin and corner. Origin is the upper left point and corner is the lower right point of the rectangular area. (Compatibility Note: this is different from the Smalltalk/V for Presentation Manager where origin is the lower left point and corner is the upper right point.)

Notice that the point at origin is included in the rectangle while the point at corner is not. (In Microsoft Windows, a rectangle sometimes includes its corner and sometimes does not, depending on the operation that uses it.) In Smalltalk/V, the corner is always excluded from the rectangle.

A Rectangle's width and height can then be calculated by:

width := corner x - origin x 
height := corner y - origin y 

which represent the number of horizontal units and the number of vertical units contained in the Rectangle. The Point represented by width @ height is called the extent of the Rectangle.

A simpler way to calculate the extent is:

extent := corner - origin. 

A Rectangle is usually created by sending the corner: or extent: message to a Point. For example, the following two expressions create two Rectangles covering the same area:

1 @ 1 corner: 100 @ 100
1 @ 1 extent: 99 @ 99

To illustrate the Rectangle instance messages, consider these rectangles, Box1 and Box2:

Box1 := 20 @ 0 corner: 150 @100.
Box2 := 70 @ 80 corner: 170 @ 120. 

Expression Result

Box1 top 100

Box1 bottom 0

Box2 left 70

Box2 right 170

Box1 center 85 @ 50

Box1 width 130

Box1 height 100

Box1 leftTop 20 @ 0

Box1 rightBottom 150 @ 100

Box1 containsPoint: 50 @ 50 true

Box1 expandBy: 10 10 @ -10 corner: 160 @ 110

Box2 insetBy: 10 80 @ 90 corner: 160 @ 110

Box1 intersect: Box2 true

Box1 intersect: Box2 70 @ 80 corner: 150 @ 100

Box1 merge: Box2 20 @ 0 corner: 170 @ 120

Box1 translateBy: 10 @ 10 30 @ 10 corner: 160 @ 110

Box1 moveBy: 10 @ 10 30 @ 10 corner: 160 @ 110

Box2 moveTo: Box1 origin 30 @ 10 corner: 130 @ 50

Notice that the last two expressions modify Box1 and Box2 themselves, while others create new rectangles.

GraphicsMedium Classes

As mentioned in the introduction, a graphics medium in Smalltalk/V is like a piece of paper used to display or store drawings created by graphics tools. In this category, GraphicsMedium is the top class, an abstract class which should never have any instances. Classes StoredPicture, Printer and Screen should have one instance for each physical device. For example, Printer can have instances for LPT1, LPT2, etc. Global variable Display is the instance for your primary monitor screen. Class Bitmap, however, can have as many instances as needed.

Class Window and its subclasses are also graphics media. Even though they are not implemented as subclasses of GraphicsMedium, they do support the same common protocol.

GraphicsMedium

GraphicsMedium is an abstract class which contains the common code for all its subclasses. It has two instance variables: graphicsTool contains the graphics tool associated with the medium; and deviceContext contains the device context of the medium. Every medium has a device context which contains device-specific information about the medium.

Bitmap

Each bitmap is a rectangular area within memory. It has three instance variables:

archive

Used as a buffer to save the bits of a bitmap when an image is saved.

bitmapHandle

Contains a handle for the bitmap when an image is active and the bitmap bits are in memory.

bitmapInfo

Contains a structure that describes the bitmap width, height, bit count, and bit planes.

For a monochrome bitmap, each bit in the bitmap corresponds to a pixel when displayed on the screen.

For a multi-colored bitmap, more than one bit is needed to represent a colored pixel on the screen. There are two ways to implement color bitmaps.

One way to represent color in your bitmaps is to have multiple planes. Each plane consists of consecutive bits in memory. The bits in the same position of each plane are taken together to form the color for the pixel in that position. In this way, a sixteen color bitmap needs four planes.

The other way to implement a color bitmap is to have a consecutive number of bits represent one pixel. For a sixteen color bitmap, each pixel is represented by four consecutive bits.

To make a new (100 by 100) monochrome bitmap, use

Bitmap width: 100 height: 100

or

Bitmap extent: 100 @ 100

To make a multi-color bitmap, you usually use

Bitmap screenWidth: 100 height: 100
or
Bitmap screenExtent: 100 @ 100

These last two expressions allocate a bitmap that is compatible with the screen format, either with planes or consecutive bit counts. All four expressions above automatically create a Pen associated with the Bitmap instance. This Pen is stored in the instance variable graphicsTool and can be accessed by the message pen. For example,

| aBitmap |
aBitmap:= (Bitmap screenWidth: 100 height: 100).
aBitmap pen
erase;
place: 20 @ 20;
box: 80 @ 80.
aBitmap displayAt: 0 @ 0 with: Display pen.
aBitmap release

will draw a box on a 100 by 100 bitmap and display it in the upper left corner of the screen. Note that the last line releases the memory associated with the bitmap.

StoredPicture

StoredPicture is used to store a sequence of graphics operations in an object called a metaFile. After creating the metaFile, graphics drawn with the StoredPicture's pen will be recorded in the metaFile. The metaFile can be saved in a file and later reloaded to replay or placed on the clipboard for other tasks to replay on the same workstation. The following sequence shows how a metaFile can be used:

| meta |
meta := StoredPicture new.
meta create: nil.   "Create a memory metaFile."
meta
pen place: 100 @ 100;   "Draw to the metaFile."
box: 200 @ 200.
meta close.
"At this point, you can place the metaFile handle 
 on the clipboard for other tasks to use."
meta  save: 'test.met'.   "Save the metaFile to disk."
meta load: 'test.met'.   "Load the metaFile from disk."
Window turtleWindow: 'test'.
meta play: Turtle   "Play the metaFile through the Turtle pen."
meta release        "release the memory associated with the meta file"

Printer

Unlike the outputToPrinter method in class String (which prints strings in strictly character mode), class Printer allows graphics to be printed on paper in a manner consistent with the host environment's handling of display media. Thus you can use a RecordingPen to draw graphics in a window and then reassociate the pen with a printer to replay its graphics on the printer with a "what you saw (in the window) is what you get (on paper)" output.

Printer output can be done in either landscape or portrait mode depending on the selection made through the system control panel. When you draw graphics, keep in mind that the coordinate origin (0, 0) is at the upper left corner of the page. Under Microsoft Windows, when you output hard copies you normally output them to a printer spooler queue. The connection between the spooler queue and the physical printer is managed by Windows. You can reconfigure this spooling queue and printer connection through the system control panel.

The following is an example of using your default printer, as specified in the control panel, to print graphics:

| printer |
printer:= Printer new.   "create a printer medium  using default  printer"
printer startPrintJob.   "connect the default graphics tool to the printer
   and initialize it" 
printer pen   "use the default graphics tool to draw"
place: 100 @ 100;   "set initial pen position"
box: 300 @ 300.   "draw a box"
printer endPrintJob   "finish the job and release printer"

If you have a RecordingPen which has recorded some graphics drawings on some other device, such as in a Turtle graphics window, you can print the recorded graphics on your default printer simply by:

Printer printWith: aPenRecorder

Screen

Class Screen makes the monitor screen available for graphics drawing. The global variable Display is an instance of the primary screen and it is always connected to a default graphics tool throughout the Smalltalk/V session. For example, if you want to blank out the whole screen and draw a box, simply execute:

Display pen   "use the default graphics tool of Display"
erase;   "paint the screen in default background color"
place: 200 @ 200;
   box: 300 @ 300.

Under Windows, you rarely draw anything using Display since all drawing should be done inside windows. However, Display can be used as a convenient "scratch pad" to test uncertain graphics operations. Another use of Display pen is when you want to drag a figure from one window to another. Display is needed in this case because drawing to a window guarantees that you won't be able to draw outside of the window whereas Display pen allows you to draw anywhere on the screen.

Window

An instance of Window is physically a subdivision of Screen in the Microsoft Windows system model. Due to its importance and complexity, the Window class is implemented as a subclass directly under Object instead of under GraphicsMedium. Although it is not implemented as a subclass of GraphicsMedium, it possesses the same information as other media; namely, a deviceContext and a graphicsTool. All the common protocol in class GraphicsMedium is also supported by Window and its subclasses. Notice that, unlike bitmaps, each window has its own device context. The complete description of Window is presented in the Window Classes section of this chapter and in the Chapter 10 tutorial.

Graphics Tool Classes

Graphics tools are instruments used to draw graphics on various graphics media. Therefore, before you can use a GraphicsTool instance you have to first associate it with an instance of GraphicsMedium. For convenience, every time you create a new instance of a medium, a default graphics tool is created and associated with it. This default graphics tool, is accessed by sending the message pen to the GraphicsMedium instance. For example:

(Bitmap width: 100 height: 100) pen 
Printer new pen
Display pen

When you use one of these pens to draw, the result is displayed on the associated medium. Of course you can always reassociate a pen with a different medium as long as the same graphics capabilities are supported.

A graphics tool always has its instance variable graphicsMedium pointing to the associated medium. Conversely, the medium always has its instance variable graphicsTool pointing back to the associated graphics tool.

GraphicsTool

GraphicsTool is an abstract class which contains the common data and methods for its subclasses. It also contains the methods that implement BitBIt-like operations (bit block transfer from one device to another). Following are the instance variables:

deviceContext

A handle to the device context of the associated graphics medium..

graphicsMedium

Contains the GraphicsMedium that is associated with the tool.

width

The width of the page medium. For a window, this is the width of the window. For a printer, this is the paper width.

height

The height of the page medium. For a window, this is the height of the window. For a printer, this is the paper height.

foreColor

The foreground color used by the graphics tool to draw.

backColor

The background color used to fill the background of the display medium.

location

The current location of the tool.

logicalTool

A handle to the window's drawing tool.

Protocol for querying dimensions of the page medium associated with the graphics tool are:

boundingBox

A rectangle with origin (0, 0) and extent of the page medium.

extent

A point whose x is the width and y the height of the page medium.

width

The width of the page medium.

height

The height of the page medium.

GDI uses the current brush to fill the interior of drawn figures such as ellipses, rectangles, chords, etc. There are seven predefined brushes that can be selected into the device context. The following example selects the gray brush to fill the interior of an ellipse:

aPen selectStockObject: GrayBrush.
aPen
place: 100 @ 100;
ellipseFilled: 100 minor: 50

The selectStockObject: method selects one of the predefined stock pens, brushes, or fonts. GrayBrush is one of many stock objects that can be selected. See selectStockObject: method for a list of stock objects that you can use.

You can also create your own solid or hatched brush patterns. The following example creates a red cross pattern hatched brush:

aPen 
setHatchBrush: HsCross color: ClrRed; 
place: 100 @ 100;
ellipseFilled: 100 minor: 50

The setHatchBrush: color: method creates a red cross-hatched pattern brush. It then selects the newly created brush into the device context of the graphics tool. The brush remains in effect until another brush is selected. In addition to HsCross you can use the following hatch styles: HsHorizontal, HsBdiagonal, HsFdiagonal, HsVertical, and HsDiagcross. These constants are defined in WinConstants pool dictionary.

When you draw graphics, you can specify a mixing rule that tells the graphics interface how to combine the source pels with the pattern pels and the destination pels. For graphics other then BitBlt, set the mixing rule by:

aPen setRop2: R2Constants

R2Constants can be one of the following:

Mix mode Result

R2Black Pixel is always black

R2White Pixel is always white

R2Nop Pixel remains unchanged

R2Not Pixel is the inverse of the destination

R2Copypen Pixel is the pen color

R2Notcopypen Pixel is the inverse of the pen color

R2Mergepennot Pixel is the combination of the pen color

and the inverse of the destination

R2Maskpennot Pixel is combination of colors common to both

pen and inverse of destination

R2Mergenotpen Pixel is combination of destination and

inverse of pen color

R2Masknotpen Pixel is combination of colors common to both

destination and inverse of pen

R2Mergepen Pixel is combination of pen and destination color

R2Notmergepen Pixel is inverse of R2Mergepen

R2Maskpen Pixel is combination of colors common to

pen and destination

R2Notmaskpen Pixel is inverse of R2Maskpen

R2Xorpen Pixel is combination of colors in pen and in

destination, but not both

R2Notxorpen Pixel is the inverse of R2Xorpen

Note that setting the mix rule does not affect the BitBlt operations which have their own ways of specifying the mix rules. There are 256 mixing rules that you can use. For more information on raster operations, refer to the Microsoft Windows Software Development Kit Reference Volume 1.

When you want to copy graphics from one place to another, either on the same device or on different ones, BitBlt functions are the most efficient to use. In class GraphicsTool, BitBlt functions are encapsulated in the copy and fill methods so that you do not need to worry about the details. For example,

Display pen
copy: Display pen
from: ( 0@ 0 extent: 100 @ 100)
   to: (0 @ 0 extent: 200 @ 200)

copies from screen to screen via a BitBlt operation. Since the destination rectangle is larger than the source in this example, the result is magnified from the source.

The foreground and background color of a GraphicsTool can be set by

foreColor: aColor

and

backColor: aColor

The argument to these methods is normally one of the color name (Clr-prefixed) constants from the ColorConstants pool dictionary:

ClrDefault   ClrRed   ClrNeutral   ClrDarkgreen
ClrWhite   ClrPink   ClrDarkgray   ClrDarkcyan
ClrBlack   ClrGreen   ClrDarkblue   ClrBrown
ClrBackground   ClrCyan   ClrDarkred   ClrPalegray
ClrBlue   ClrYellow   ClrDarkpink

The foreColor: and backColor: methods require an integer which can be an index to the color palette or an explicit Red-Green-Blue value. The color constants such as ClrRed and ClrGreen are indices to the color palette. If you want to pass an explicit RGB value, the red:green:blue: class method in GraphicsTool constructs a proper RGB value from the three components. Also, the paletteIndex: class method in GraphicsTool can be used be construct a proper palette index value from an integer.

Font

Smalltalk/V represents characters in strings using their ASCII codes. In order to display them on the output medium, these ASCII values must be converted into bitmapped or outlined images. Class TextTool performs the conversion by calling Windows graphics functions while class Font provides information about which font to use to do the conversion.

Following are the useful class messages of Font:

allFonts

Answer an array of all available fonts.

chooseAFont: aTitleString

Open a dialog that lets the user choose a font. Answer an instance of Font. Argument aTitleString displays as the title of the dialog.

face: aString size: aPoint fixedWidth: bFixedWidth

Answer a font instance whose characteristics most closely match the arguments.

Argument Setting

aString is the face name of the font

aPoint is the maximum width and height of the font

bFixedWidth sets a fixed width font when true

face: aString size: aPoint fixedWidth: bFixedWidth bold: bBold hollow: bHollow italic: bItalic negative: bNegative strikeOut: bStrikeOut underscore: bUnderscore

Answer a font instance whose characteristics most closely match the arguments. This method is similar to the face:size:fixedWidth: method but offers a finer degree of selection.

Argument Setting

aString the face name of the font

aPoint the maximum width and height of the font

bFixedWidth sets a fixed width font when true

bBold sets a bolded font when true

bHollow sets a hollowed font when true

bItalic sets an italic font is when true

bNegative sets a negative font when true

bStrikeOut sets a strike-out font is when true

bUnderscore sets an underscored font when true

Following are the useful instance messages of Font:

deleteFont

Deletes the Windows font handle associated with the instance of Font. Use this method when the instance of Font is no longer needed or when all references to it are about to be removed. Not calling this method for unwanted fonts will leave system resources tied up.

fontHandle

Answer a Windows font handle associated with the instance of Font. Use this method to obtain system font handles needed in Microsoft Windows API calls.

TextTool

TextTool is used to draw characters. It works like a typewriter except that it inherits methods from GraphicsTool so that it can do region filling and block moves. A TextTool is normally used with windows which contain instances of TextPane where general graphics drawing is disallowed. TextTool contains the instance variable font, which is the current font used for character drawing.

TextTool also maintains a position which is aligned with the base point of the first character in a string to be drawn. This position is kept by Windows, but you can send messages to move and query a TextTool's position.

Following are some examples of using a TextTool:

| TextTools textTool |
aWindow := TextWindow windowLabeled: 'TextTool Examples' 
frame: (100 @ 100 extent: 400 @ 200).
aWindow nextPutAll: 'Hi!'; cr.            "open a text window"
textTool := aWindow pane pen.         "access the TextTool"
textTool place: 10 @ 10;            "Set position"
displayText: 'Welcome'.            "display string at position"
textTool displayText: 'to' at: textTool location + (50 @ 30)
   "display a string at one line below its position."
textTool centerText: 'Smalltalk/V': textTool extent // 2
   "display a string at center"
textTool lineDisplay: 'Windows' at: 
          (textTool width - 40) @ (textTool height - 20) 
"display a string at the beginning of the center row & erase the rest of the line"

Pen

Class Pen inherits all the capabilities of TextTool. In addition, it provides a drawing interface similar to turtle graphics. In other words, you can position the pen to a desired place and then tell it to draw a line, a box, or some other graphical figure. Besides position, a Pen instance also maintains its direction, down state, pen width, and pen style.

Direction is an integer and goes from 0 to 359 degrees clockwise. (Compatibility note: The Smalltalk/V Presentation Manager Pen direction degrees are counted counterclockwise). Direction only applies to the go: message. For example:

aPen
direction: 0;
   go: 100

draws a line from the current position towards east for 100 units. A direction of 90 degrees goes towards "south" and 270 degrees towards "north."

Down state tells the pen whether or not to draw a line as it moves. When its down state is false, the pen does not draw the line. However, its position gets updated as if the drawing were performed as it moves.

aPen down   "sets down state to true"
aPen up   "sets down state to false"

Pen width is the width of the pen tip or the width of the line it draws. You can use the setLineWidth: message to change the pen width.

Pen operations are summarized in the following collection of simple examples.

Line drawing is the most basic drawing performed with a pen:

Display pen
place: 0 @ 0;
defaultNib: 8;   "set line width to 8 units"
north;
turn: -45;
go: 100;   "draw a diagonal line for 100 units"
goto: Display extent // 2;   "draw another line from the end of the
   previous line to the center of the screen" 
box: Display extent // 4    "draw a box"
   defaultNib:1   "set line width to 1 unit"

Figure drawing allows you to draw recangles, ellipses, circles, chords, pies. The following demonstrates how each is used:

Display pen
place: Display extent // 2;
boxOfSize: 100 @ 100;      "Draw a box of size 100 @100"
circle: 100;       "Draw a circle with radius of 100 units."
ellipse: 100 minor: 50;      "Draw an ellipse. 100 is half the horizontal 
         axis and 50 is half the vertical axis."
chord: 200 minor: 100 angles: 0 @ 90   "Draw a chord."
   pie: 150 minor: 150 angles 0 @ 135   "Draw a pie."

The above example draws outline figures. There are corresponding methods for drawing filled figures. The ellipseFilled:minor: method draws an ellipse that is filled with the current brush pattern.

RecordingPen

RecordingPen supports all the capabilities of GraphicsTool, TextTool, and Pen. In addition, it can record the drawings in a graphics segment and later replay the segment. A graphics segment contains a collection of GDI functions encoded in binary form and recorded in memory. There are three ways to draw a segment:

Each of these expressions will execute aBlock which typically includes graphics operations to be recorded. A segment id is returned by each expression so that you can replay the segments selectively later on. The retainPicture: method records the picture without actually drawing it. The drawPicture: method draws the picture without recording it, therefore, it cannot be replayed. The drawRetainPicture: method both draws the picture and records it. The following is an example that draws four boxes and then replays it one hundred times to make a checkerboard:

| id |
Window turtleWindow: 'test'.
id := Turtle drawRetainPicture: [ "Draw the four boxes."
Turtle place: 0 @ 0;
setBrushColor: ClrBlack;
boxFilled: 50  @ 50;
place: 50 @ 50;
boxFilled: 100 @ 100;
setBrushColor: ClrRed;
place: 0 @ 50;
boxFilled: 50 @ 100;
place: 50 @ 0;
boxFilled: 100 @ 50].
"Set the mapping mode for scaling."
Turtle setMapMode: MmAnisotropic;
setWindowExt: 1000 @ 1000;
setViewportExt: Turtle extent.
"Replay the segment each time changing the window origin."
0 to: 10 do: [: i |
0 to: 10 do: [: j |
Turtle setWindowOrg: (-100 * i) @ (-100 * j).
Turtle drawSegment: id]]

Another way to record graphics is to open a graphics segment, draw into the segment, and close the segment. A chain of these segments can be created and the entire segment chain can be replayed. The following example demonstrates creating segments and replaying the all the segments:

aRecordingPen openSegment.   "Start a new segment."
aRecordingPen 
place: 0 @ 0;    "Draw into the segment."
box: 100 @ 100.
aRecordingPen closeSegment    "Close the segment."
aRecordingPen openSegment.   "Start a new segment."
aRecordingPen 
place: 100 @ 100;      "Draw into the segment."
circle: 50;
aRecordingPen closeSegment.   "Close the segment." 
. . .       "... more segments..."
aRecordingPen drawChain    "Draw all segments in aRecordingPen."

Each segment has an identifier. You can use this identifier to draw a selected segment. The drawSegment: method draws the segment specified in the argument.

The recording pen is implemented using Windows's metafile facility. To record graphics, a memory metafile is created. When a GDI function is performed, the device context of the metafile is used as the device context argument in the GDI function. Thus, the GDI function is recorded (in binary form) in the memory metafile. The openSegment method creates a memory metafile and closeSegment closes the metafile. Graphics drawn between openSegment and closeSegment are recorded.

Only GDI calls that take a handle to a device context as the first argument can be recorded. Not all GDI functions are recorded in metafiles. Functions that retrieve device context information (they usually begin with the word Get, such as GetCurrentPosition) are not recorded metafiles. Check the programmer's reference manual for a list of all GDI functions that can be recorded.

A recording pen is normally associated with a graph pane. Ann application can record graphics so that whenever the graph pane needs to repaint itself (when it receives WmPaint messages) the recorded graphics can replay to display the contents of the graph pane. When the graph pane is first opened, its recording pen creates an initial graphics segment and performs the selector associated with the getContents event. Graphics drawn by this selector are recorded in the initial segment, while the application can add more segments later. When the graph pane receives WmPaint messages, it then replays all segments belonging to the recording pen.

Another method for displaying the contents of a graph pane is to respond to the display event. This method does not use recorded graphics; the selector associated with the display event is performed whenever the graph pane needs to repaint itself. An application can respond to display event by adding the when: #display perform: #draw: line to the open method of the application class. See GraphicsDemo, Dashboard, Puzzle15 and FreeDrawing for examples.

Commander

Commander is a subclass of Pen. An instance of Commander contains an Array of Pens. Many messages implemented by Pen are reimplemented in Commander so that every Pen in the Commander receives the same message. This creates the illusion that all pens are moving at the same time. To create a Commander, evaluate the following expression:

Commander new: numberOfPens.

A Commander has the following unique message:

fanOut

Turn each Pen's direction by an increment of 360 / (number of Pens).

For examples of Commander graphics, see the tutorial example in Chapter 9 as well as source code in the GraphicsDemo class.

Multiprocessing Classes

Object-oriented computing in Smalltalk involves communicating objects which send messages to each other to perform useful work. Although this suggests parallel computation, it actually is not. An object always waits to receive a response after sending a message. The situation corresponds to that of using a procedural language, where at any point in time there is a stack of incomplete procedure calls, and there is a single procedure which is active. In Smalltalk, there is a stack of incomplete message sends, and there is a single method which is active.

Smalltalk/V provides parallel processing by defining multiple stacks of incomplete message sends, where each stack is represented by a separate object of class Process. Since there is a single processor, the parallelism is simulated. At any time, only a single process is executing. However there may be many processes ready to execute and there are well defined conditions under which Smalltalk/V switches to a new current process. Semaphore objects are provided for synchronization among processes.

A new process is created by sending the message fork: to the global variable Processor. For example:

Processor fork: [Transcript show: 'Hello'; cr].
Transcript show: 'Goodbye'; cr

This example creates a separate process to execute the code within the block and continues execution of the current process in the code following the block. The result displayed in the System Transcript is:

Hello
Goodbye

The output shows that the new process is initiated before the current process is continued, although both processes operate at the same priority. Processes can be given different priorities by sending the fork:at: message to Processor. For example:

Processor fork: [Processor fork:
[Transcript show: ' world! '; cr] at: 2. 
            Transcript show: 'Hello '] at: 3

The example above creates two new processes, one at priority two and the other at priority three. Since higher priority processes are scheduled first, the output on the Transcript is:

Hello world !

Multiprocessing is especially useful in discrete event simulation because it allows each simulation object to carry out its behavior as a separate process, using semaphores to synchronize processes. Multiprocessing is implemented in Smalltalk/V by classes Process, ProcessScheduler and Semaphore.

For some interesting examples of multiprocessing applications in Smalltalk, see the following publications:

Process

Process is a subclass of OrderedCollection. A process is a sequence of computations in Smalltalk carried out by objects sending messages to other objects and waiting for the results. An object of class Process describes such a computation sequence. A process has a name and a priority. A process exists in one of several states. Figure 14.3 shows the state transitions a process can make.

Figure 14.3

Process State

Transitions

The process state transitions occur for the following reasons:

ù A new process is created and becomes ready as a result of sending the fork and fork:at: messages to a block.

ù A ready process becomes active if it is the longest waiting at its priority and there are no higher priority ready processes and: (1) the active process becomes blocked or dead, (2) the ready process has higher priority than the active process, or (3) the ready process has the same priority as the active process and the following expression is executed:

ù The active process becomes ready when it is replaced by a ready process under the conditions described above for transition 2.

ù An active process becomes blocked when the message wait is sent to a semaphore which has no excess signals.

ù A blocked process becomes ready when it is the first in the waiting queue of a semaphore and the message signal is sent to the semaphore.

The User Interface Process

The Smalltalk/V user interface is driven by a single process which responds to all keyboard and mouse input events for all windows. The user interface process alternates between (1) responding to an input event, and (2) waiting for the next input by sending the message wait to global variable KeyboardSemaphore. When there is no input activity, other lower priority processes can run. The process scheduler guarantees that there is always a lowest priority idle process to run when there is no other system activity.

Errors are handled by a debugger running under the user interface process whether or not the error occurs in the user interface process. If the error: message is sent under the user interface process, the current process is suspended and a new user interface process is created. This allows the process with the error to be debugged with the debugger. If error: is sent by a non-user-interface process, an entry describing the error is placed in the PendingEvents queue (a global variable). PendingEvents is polled for activity by the user interface process when there is no other input activity.

ProcessScheduler

Class ProcessScheduler is a subclass of Object. A ProcessScheduler controls process execution. There is a single instance of class ProcessScheduler maintained in global variable Processor. The process scheduler determines which ready process is the active process and maintains a queue of ready but inactive processes. The highest priority ready process is selected as the active process. If there is more than one process at the highest priority, the process that has been ready the longest is chosen.

Process priorities may range between 1 and Processor topPriority.

Semaphore

Semaphore is a subclass of Object. A Semaphore is an object used to synchronize multiple processes. A process waits for an event to occur by sending the message wait to a semaphore. A process signals that an event has occurred by sending the message signal to a semaphore.

A semaphore has two instance variables:

signalCount

Contains an Integer representing the number of signal messages minus the number of wait messages sent to the semaphore during its entire lifetime.

waitingProcesses

Contains an OrderedCollection of processes that have sent the message wait to the semaphore without a corresponding signal message. New waiting processes are added at the end of the collection.

An example of the use of semaphores is the following:

| sem |
sem := Semaphore new.
Processor fork: [Transcript show: '1 ' ].
Processor fork: [Transcript show: '2 '. sem wait. 
   Transcript show: '3 ' ] at: 3. 
Processor fork: [Transcript show: '4 '. sem signal.
   Transcript show: '5' ; cr] at: 2

This example creates three new processes. The output displayed on the Transcript is:

1 2 4 3 5

This output is created as follows: The fork: message creates a process which shows '1'. The fork:at: 3 message creates a process which shows '2' and then is blocked waiting on the semaphore. The fork:at: 2 message creates a process which shows '4' and signals the semaphore. This allows the higher priority process to resume, show '3' and terminate. Then the process at priority 2 resumes, shows '5' and terminates. The initiating process, the user interface, is running concurrently with these processes.

Interrupts

Interrupts are the mechanism used for communicating asynchronous external events to Smalltalk/V Examples of external events are keyboard inputs, mouse movements and clock ticks. You can extend the set of interrupt events.

The Smalltalk/V interrupt model corresponds to typical computer hardware interrupt architectures. Interrupts may be explicitly enabled and disabled. When an interrupt event occurs and interrupts are enabled, interrupts are disabled and a vmlnterrupt- message is sent to the object at the top of the execution stack for the current process. The argument to vmInterrupt: is the selector of the method defined in Process class which services the interrupt. An interrupt routine concludes by enabling interrupts and returning to vmInterrupt:, which answers self, leaving the execution stack exactly as before the interrupt.

When an interrupt event occurs and interrupts are disabled, Smalltalk/V places the interrupt event in a pending interrupts queue. Each time interrupts are enabled, the pending interrupts queue is examined to see if there are queued interrupts to be serviced.

The typical interrupt processing method merely signals a semaphore to resume a process to handle the event. For example, the keyboard interrupt handier in class Process is as follows:

keyboardInterrupt
"Handle keyboard interrupt."
   KeyboardSemaphore signal

Note that the semaphore signal message enables interrupts if they are disabled. Interrupts are explicitly enabled and disabled by sending the message enablelnterrupts: to Process class. Disabling interrupts should be used with extreme caution, because Smalltalk/V cannot respond to external events while interrupts are disabled. The interrupt state may be preserved around a critical code section as follows:

| oldState |
oldState:= Process enableInterrupts: false.      "disable and save state"
" ...  critical code  ..."
Process enableInterrupts: oldState            "restore interrupt state"

Global variable InterruptSelectors contains an array of selectors corresponding to interrupt events defined as follows (missing numbers are not used):

Interrupt

Number Selector Event

1 unknownInterrupt Interrupt number outside array bounds

2 controlBreakInterrupt Control + Break struck

5 stepInterrupt Debugger hop and skip completion

6 overrunInterrupt Interrupts lost because queue full

7 gcCompactInterrupt Memory compaction event

8 keyboardInterrupt A mouse or keyboard event is pending

9 breakpointInterrupt Debugger breakpoint reached

11 gcFlipInterrupt Memory scavenge event

13 exitCallback Return to Microsoft Windows

Interrupts to Smalltalk/V can be generated from device drivers (see Appendix 4, Primitive Methods). Add the selectors for the new interrupt handling methods to the end of the InterruptSelectors array.

Previous Page Next Page