
!"Pocket Smalltalk fileout - 8:18:25 PM, Friday, March 19, 1999"!


!Object constantsFor: 'Comments'!

baseComment 'This package contains the base Smalltalk class library, including collections, streams, numbers, models, and system classes.  It is required by all other add-on packages.  This package should always be the first to be installed in your projects.'! !

nil subclass: #Object
	instanceVariableNames: ''
	classVariableNames: 'ErrorInProgress PadBuffer'!

Object subclass: #Bitmap
	instanceVariableNames: 'handle'
	classVariableNames: ''!

Collection subclass: #Bag
	instanceVariableNames: 'contents'
	classVariableNames: ''!

ArrayedCollection subclass: #Interval
	instanceVariableNames: 'start stop step'
	classVariableNames: ''!

List variableSubclass: #IdentityList
	instanceVariableNames: ''
	classVariableNames: ''!

List variableSubclass: #OrderedCollection
	instanceVariableNames: ''
	classVariableNames: ''!

OrderedCollection variableSubclass: #SortedCollection
	instanceVariableNames: 'sortBlock'
	classVariableNames: ''!

KeyedCollection variableSubclass: #Dictionary
	instanceVariableNames: 'tally'
	classVariableNames: ''!

Dictionary variableSubclass: #IdentityDictionary
	instanceVariableNames: ''
	classVariableNames: ''!

Collection variableSubclass: #Set
	instanceVariableNames: 'tally'
	classVariableNames: ''!

Object subclass: #Context
	instanceVariableNames: 'stackIndex receiverClass selector'
	classVariableNames: ''!

Object subclass: #CStructure
	instanceVariableNames: 'pointer'
	classVariableNames: ''!

CStructure subclass: #CRectangle
	instanceVariableNames: ''
	classVariableNames: 'RectBuffer'!

Object subclass: #Model
	instanceVariableNames: 'dependents'
	classVariableNames: ''!

Model subclass: #ListModel
	instanceVariableNames: 'list selectionIndex'
	classVariableNames: ''!

Model subclass: #ValueHolder
	instanceVariableNames: 'value'
	classVariableNames: ''!

Number subclass: #Fraction
	instanceVariableNames: 'numerator denominator'
	classVariableNames: ''!

Number subclass: #Point
	instanceVariableNames: 'x y'
	classVariableNames: ''!

Object subclass: #PalmOS
	instanceVariableNames: ''
	classVariableNames: ''!

Object subclass: #Rectangle
	instanceVariableNames: 'origin corner'
	classVariableNames: ''!

Object subclass: #Stream
	instanceVariableNames: 'collection position limit'
	classVariableNames: ''!

Stream subclass: #ReadStream
	instanceVariableNames: ''
	classVariableNames: ''!

Stream subclass: #WriteStream
	instanceVariableNames: ''
	classVariableNames: ''!

WriteStream subclass: #ByteArrayWriteStream
	instanceVariableNames: ''
	classVariableNames: ''!

WriteStream subclass: #StringWriteStream
	instanceVariableNames: ''
	classVariableNames: ''!

Object subclass: #Transcript
	instanceVariableNames: 'x'
	classVariableNames: 'Current'!

Object subclass: #Window
	instanceVariableNames: ''
	classVariableNames: ''!

!Object comment!
Object is the superclass of all (non-root) classes.  It implements operations common to all types of objects.  If you create a new root class, you should reimplement many of the selectors implemented here.  However, the only selector that is absolutely required to be implemented is #doesNotUnderstand: (this requirement is enforced by the compiler).

Note that many messages here, such as #==, are implemented only for the benefit of #perform:, since they are inlined by the compiler.! !


!Object methodsFor: 'printing'!

displayOn: stream
	self printOn: stream.!

displayString
	| stream |
	stream := String new writeStream.
	self displayOn: stream.
	^stream contents.!

printOn: stream
	stream 
		nextPut: $a;
		space;
		nextPutAll: self class name.!

printString
	| stream |
	stream := String new writeStream.
	self printOn: stream.
	^stream contents.! !


!Object methodsFor: 'predicates'!

isKindOf: class
	<primitive: 22>

"Implemented as follows:
	| probe |
	probe := self class.
	[probe isNil] whileFalse: [
		probe == class ifTrue: [^true].
		probe := probe superclass].
	^false."!

isMemberOf: class
	^self class == class.!

isNil
	"Usually inlined by the compiler."
	^false.!

notNil
	^true.!

isBytes
	^(self class layout bitAnd: 8192) ~~ 0.!

respondsTo: selector
	^self class canUnderstand: selector.! !


!Object methodsFor: 'copying'!

postCopy
	^self.!

shallowCopy
	<primitive: 18>!

copy
	^self shallowCopy postCopy.! !


!Object methodsFor: 'dependents'!

update: aspect
	^self.!

update: aspect with: parameter
	^self update: aspect.!

update: aspect with: parameter from: object
	^self
		update: aspect
		with: parameter.! !


!Object methodsFor: 'system operations'!

become: other
	<primitive: 20>
	^self primitiveFailed.!

orIfNil: block
	^self.!

perform: selector
	<primitive: 13>
	^self primitiveFailed.!

perform: selector with: argument
	<primitive: 14>
	^self primitiveFailed.!

perform: selector with: argument with: argument2
	<primitive: 15>
	^self primitiveFailed.!

perform: selector with: argument with: argument2 with: argument3
	<primitive: 16>
	^self primitiveFailed.!

basicChangeClassTo: newClass
	<primitive: 49>!

asOOP
	<primitive: 30>!

perform: selector withArguments: array
	<primitive: 17>
	^self primitiveFailed.! !


!Object methodsFor: 'comparing'!

~~ object
	^self ~~ object.!

~= object
	^(self = object) not.!

= object
	^self == object.!

== object
	^self == object.!

hash
	<primitive: 19>!

identityHash
	"It's just the object table entry of the receiver converted to a SmallInteger."
	"Do not override in any subclass."
	<primitive: 19>! !


!Object methodsFor: 'accessing'!

at: index
	<primitive: 5>
	^self error: #outOfBounds.!

basicAt: index
	<primitive: 5>
	^self error: #outOfBounds.!

basicAt: index put: value
	<primitive: 6>
	^self primitiveFailed.!

basicSize
	"Answer the number of indexed slots in the receiver. "
	"Non-indexed objects answer 0."
	"Do not override in any subclass."
	<primitive: 4>!

class
	<primitive: 21>!

instVarAt: index
	<primitive: 23>
	^self primitiveFailed.!

instVarAt: index put: value
	<primitive: 24>
	^self primitiveFailed.!

size
	"Answer the number of slots in the receiver."
	<primitive: 4>!

yourself
	^self.!

at: index put: value
	<primitive: 6>
	^self error: #outOfBounds.! !


!Object methodsFor: 'error handling'!

error
	self error: #error.!

mustBeBoolean
	^self error: #mustBeBoolean.!

primitiveFailed
	^self error: #primitiveFailed.!

subclassResponsibility
	^self error: #subclassResponsibility.!

shouldNotImplement
	^self error: #shouldNotImplement.!

basicError: message
	<primitive: 1>!

halt
	^self error: #haltEncountered.!

doesNotUnderstand: message
	| text |
	text := Context textOfSymbol: message selector.
	self error: self printString, ' does not understand #', text.!

badTrapArgument: systrapNumber
	^self error: 'Bad args to trap ', systrapNumber printString.! !


!Behavior comment!
Behaviors are objects which can be the class of other objects.  Many of the informational fields present in the IDE are stripped out at runtime, leaving only the following two instance variables:

	superclass - the superclass of this behavior, or nil
	layout - an integer encoding the layout of instances of this behavior

These instance variables may be modified at runtime but can have unpredictable effects if you are not careful.! !


!Behavior methodsFor: 'printing'!

printOn: stream
	stream nextPutAll: self name.! !


!Behavior methodsFor: 'predicates'!

canUnderstand: selector
	| cls |
	cls := self.
	[cls isNil] whileFalse: [
		(cls implements: selector)
			ifTrue: [^true].
		cls := cls superclass].
	^false.!

implements: selector
	"Does the receiver implement this selector directly (i.e., inherited implementations don't count)?"
	<primitive: 53>
	^self primitiveFailed.! !


!Behavior methodsFor: 'accessing'!

superclass
	^superclass.!

name
	"Overridden by subclasses."
	^'Behavior', self asOOP printString.!

layout
	^layout.! !


!Behavior methodsFor: 'instance creation'!

basicNew
	<primitive: 10>
	^self primitiveFailed.!

basicNew: size
	<primitive: 11>
	^self primitiveFailed.!

new
	<primitive: 10>
	^self primitiveFailed.!

new: size
	<primitive: 11>
	^self primitiveFailed.! !


!Behavior class methodsFor: 'utility'!

nameOfClass: class
	<primitive: 33>
	^nil.! !


!Class comment!
Classes are the sole instances of their metaclasses.! !


!Class methodsFor: 'accessing'!

name
	| string |
	string := Behavior nameOfClass: self.
	^string
		ifNil: ['Class', self asOOP printString]
		ifNotNil: [string].! !


!Metaclass comment!
Metaclasses are the classes of Classes.  They provide "class-side" behavior.! !


!Metaclass methodsFor: 'accessing'!

uniqueInstance
	^uniqueInstance.!

name
	| name |
	name := Behavior nameOfClass: uniqueInstance.
	^name
		ifNil: ['Metaclass', self asOOP printString]
		ifNotNil: [name, ' class'].! !


!Bitmap methodsFor: 'initialization'!

handle: newHandle
	handle := newHandle.!

release
	handle ifNotNil: [SYSTRAP DmReleaseResource: handle].
	handle := nil.! !


!Bitmap methodsFor: 'drawing'!

drawAtX: x y: y
	| ptr |
	ptr := SYSTRAP MemHandleLock: handle.
	SYSTRAP WinDrawBitmap: ptr x: x y: y.
	SYSTRAP MemHandleUnlock: handle.!

drawAt: point
	^self drawAtX: point x y: point y.! !


!Bitmap class methodsFor: 'instance creation'!

id: bitmapID
	| handle |
	handle := SYSTRAP 
		DmGet1Resource: (Integer fromBytes: 'Tbmp')
		id: bitmapID.
	handle == 0 ifTrue: [^self error: #noSuchBItmap].
	^self new handle: handle.! !


!BlockClosure comment!
BlockClosures are "clean" block closures which do not refer to outer variables or execute nonlocal returns.  They are statically allocated at compile time.! !


!BlockClosure methodsFor: 'error handling'!

contextAlreadyReturned
	"Sent by the VM when a block tries to return from, or access a variable from, a context that has already returned."
	^self error: #contextAlreadyReturned.! !


!BlockClosure methodsFor: 'flow control'!

repeat
	[self value] repeat.!

whileFalse: block
	[self value]
		whileFalse: [block value].!

whileTrue: block
	[self value]
		whileTrue: [block value].! !


!BlockClosure methodsFor: 'accessing'!

argumentCount
	"Perhaps move this into the block instructions instead."
	^argumentCount.! !


!BlockClosure methodsFor: 'evaluating'!

value
	<primitive: 7>
	^self error: #wrongArgumentCount.!

value: arg1
	<primitive: 8>
	^self error: #wrongArgumentCount.!

value: arg1 value: arg2
	<primitive: 9>
	^self error: #wrongArgumentCount.!

valueWithArguments: array
	<primitive: 51>
	^array class == Array
		ifTrue: [self error: #wrongArgumentCount]
		ifFalse: [self error: #argumentsNotArray].! !


!BlockClosure class methodsFor: 'instance creation'!

new
	^self shouldNotImplement.! !


!FullBlockClosure comment!
FullBlockClosures may contain references to outer scopes, or hard returns, and are allocated at runtime.! !


!FullBlockClosure methodsFor: 'accessing'!

nextOuter
	^nextOuter.! !


!Boolean comment!
To save space, most control flow messages are not implemented in class Boolean---instead, True and False implement them directly.! !


!Boolean methodsFor: 'error handling'!

mustBeBoolean
	"Sent by the VM if the receiver to an #ifTrue: or related message is not true or false."
	^self.! !


!Boolean methodsFor: 'copying'!

shallowCopy
	"Copying Boolean values is not allowed."
	^self.! !


!False comment!
False is the class of the pseudo-variable 'false', representing falsehood and deceit.! !


!False methodsFor: 'printing'!

printOn: stream
	stream nextPutAll: 'false'.! !


!False methodsFor: 'logic'!

&  boolean
	^self.!

| boolean
	^boolean mustBeBoolean.!

not
	^true.!

xor: boolean
	"Note that the argument is a direct value, not a block as with other logical messages."
	^boolean.! !


!False methodsFor: 'flow control'!

and: block
	^self.!

ifFalse: falseBlock
	^falseBlock value.!

ifFalse: falseBlock ifTrue: trueBlock
	^falseBlock value.!

ifTrue: trueBlock
	^nil.!

ifTrue: trueBlock ifFalse: falseBlock
	^falseBlock value.!

or: block
	^block value mustBeBoolean.! !


!False methodsFor: 'converting'!

asInteger
	^0.! !


!True comment!
True is the class of the pseudo-variable 'true', representing truth and justice.! !


!True methodsFor: 'printing'!

printOn: stream
	stream nextPutAll: 'true'.! !


!True methodsFor: 'logic'!

& boolean
	^boolean mustBeBoolean.!

| boolean
	^self.!

not
	^false!

xor: boolean
	"Note that the argument is a direct value, not a block as with other logical messages."
	^boolean not.! !


!True methodsFor: 'flow control'!

and: block
	^block value mustBeBoolean.!

ifFalse: falseBlock
	^nil.!

ifFalse: falseBlock ifTrue: trueBlock
	^trueBlock value.!

ifTrue: trueBlock
	^trueBlock value.!

ifTrue: trueBlock ifFalse: falseBlock
	^trueBlock value.!

or: block
	^self.! !


!True methodsFor: 'converting'!

asInteger
	^1.! !


!Character comment!
Characters are single extended ASCII characters in the range 0..255.

Character predicate methods (isLetter, etc.) use the PalmOS character functions, so they will work with "extended" characters (characters with value greater than 127).

Characters are not immediate values, but are stored in a special way to save space.  See the Pocket Smalltalk whitepaper for details.
! !


!Character methodsFor: 'converting'!

asInteger
	<primitive: 25>!

asLowercase
	"Doesn't work for accented (non-ASCII) characters yet."
	^(self asInteger between: 65 and: 90)
		ifTrue: [(self asInteger + 32) asCharacter]
		ifFalse: [self].!

asUppercase
	"Doesn't work for accented (non-ASCII) characters yet."
	^(self asInteger between: 97 and: 122)
		ifTrue: [(self asInteger - 32) asCharacter]
		ifFalse: [self].! !


!Character methodsFor: 'printing'!

printOn: stream
	stream nextPut: $$.
	self isPrintable
		ifTrue: [stream nextPut: self]
		ifFalse: [
			stream
				nextPut: $\backslash;
				print: self asInteger].! !


!Character methodsFor: 'predicates'!

isAlphanumeric
	^self testAttributeBit: 562.!

isControl
	^self testAttributeBit: 192.!

isDigit
	^self testAttributeBit: 32.!

isLetter
	^self testAttributeBit: 530.!

isLowercase
	^self testAttributeBit: 16.!

isPrintable
	^self testAttributeBit: 574.!

isPunctuation
	^self testAttributeBit: 8.!

isWhitespace
	^self testAttributeBit: 324.!

isVowel
	^'aeiouAEIOU' identityIncludes: self.! !


!Character methodsFor: 'accessing'!

digitValue
	"Doesn't work for hex values, yet."
	| val |
	val := self asInteger.
	^(val between: 48 and: 57)
		ifTrue: [val - 48]
		ifFalse: [self error: #notDigit].!

value
	<primitive: 25>! !


!Character methodsFor: 'private'!

testAttributeBit: bit
	"Used for the various isFoo methods."
	<primitive: 41>
	^self primitiveFailed.! !


!Character class methodsFor: 'instance creation'!

new
	^self shouldNotImplement.!

value: asciiValue
	^asciiValue asCharacter.! !


!Collection comment!
Collections are general purpose data structures.  Growable collections are implemented using #become:.

Of interest are a few methods implemented here that are not part of some other Smalltalks:

#accumulate:into:
	This is useful for concatenating several collections (usually Strings).

#allSatisfy: and #anySatisfy:
	These work as generalized AND or OR statements.  Some other Smalltalks call these #conform: and #contains: (respectively).

#do:separatedBy:
	Like #do:, but evaluates the 'separatedBy' block between every evaluation of the 'do' block.

#select:do:
	Like #select: followed by #do:, but avoids creating an intermediate collection.! !


!Collection methodsFor: 'predicates'!

identityIncludes: object
	self do: [:each |
		each == object ifTrue: [^true]].
	^false.!

includes: object
	self do: [:each |
		each = object ifTrue: [^true]].
	^false.!

isArrayed
	^false.!

isEmpty
	^self size == 0.!

notEmpty
	^self isEmpty not.! !


!Collection methodsFor: 'copying'!

copyEmpty: capacity
	^self species new: capacity.!

copyEmpty
	^self species new.! !


!Collection methodsFor: 'streaming'!

readStream
	^self error: #cannotStream.!

writeStream
	^self error: #cannotStream.! !


!Collection methodsFor: 'accessing'!

capacity
	^self size.!

species
	^self class.!

size
	"Everyone reimplements this, so this implementation was removed to save space."
	^self subclassResponsibility.
	"| tally |
	tally := 0.
	self do: [:each | tally := tally + 1].
	^tally."! !


!Collection methodsFor: 'enumerating'!

accumulate: block into: collection
	"Evaluate block---which must return a collection---for each element of the receiver.  Accumulate all results into the given collection."
	"Example:
		#(123 456 789)
			accumulate: [:each | each printString]
			into: String new.
	gives: '123456789'"
	| stream |
	stream := collection writeStream.
	self do: [:each |
		stream nextPutAll: (block value: each)].
	^stream contents.!

allSatisfy: block
	"#conform: in non-ANSI"
	self do: [:each |
		(block value: each)
			ifFalse: [^false]].
	^true.!

anySatisfy: block
	"#contains: in non-ANSI"
	self do: [:each |
		(block value: each)
			ifTrue: [^true]].
	^false.!

collect: block
	| result |
	result := self species new: self size.
	self do: [:each | result add: (block value: each)].
	^result.!

detect: block
	^self
		detect: block
		ifNone: [self error: #elementNotFound].!

detect: block ifNone: exceptionBlock
	self do: [:each |
		(block value: each)
			ifTrue: [^each]].
	^exceptionBlock value.!

do: block separatedBy: betweenBlock
	| first |
	first := true.
	self do: [:each |
		first ifFalse: [betweenBlock value].
		first := false.
		block value: each].!

reject: block
	"#reject: is used much less frequently than #select:, so it is defined once here, in terms of #select:."
	^self select: [:each | (block value: each) not].!

select: block do: action
	"Like select: then do:, but avoids creating an intermediate collection."
	self do: [:each |
		(block value: each)
			ifTrue: [action value: each]].!

select: block
	"This is implemented too differently in different subclasses to bother defining a default implementation here."
	^self subclassResponsibility.
"But here it is anyways:
	| result |
	result := self copyEmpty.
	self
		select: block
		do: [:each | result add: each].
	^result."!

do: block
	^self subclassResponsibility.!

inject: initial into: block
	"Answer the last value of #scan:into:"
	| value |
	value := initial.
	self do: [:each | value := block value: value value: each].
	^value.  "but I don't like value!!"! !


!Collection methodsFor: 'comparing'!

= collection
	^self species == collection species
		and: [self size = collection size
		and: [self shallowEquals: collection]].!

shallowEquals: collection
	^self allSatisfy: [:each | collection includes: each].!

hash
	^self class identityHash + self size.! !


!Collection methodsFor: 'adding/removing'!

addAll: collection
	collection do: [:each | self add: each].!

remove: object
	^self
		remove: object
		ifAbsent: [self error: #elementNotFound].!

removeAll: collection
	collection do: [:each | self remove: each].
	^collection.!

add: collection
	"By default, collections do not support #add:."
	^self error: #cannotAdd.!

remove: object ifAbsent: exceptionBlock
	^self error: #cannotRemove.! !


!Collection methodsFor: 'converting'!

asArray
	^Array withAll: self.!

asByteArray
	^ByteArray withAll: self.!

asList
	^List withAll: self.!

asSet
	^Set withAll: self.!

asString
	^String withAll: self.! !


!Collection class methodsFor: 'instance creation'!

new
	^self new: 0.!

new: capacity
	^self subclassResponsibility.!

with: elt1
	^(self new: 1)
		add: elt1;
		yourself.!

with: elt1 with: elt2
	^(self new: 2)
		add: elt1;
		add: elt2;
		yourself.!

with: elt1 with: elt2 with: elt3
	^(self new: 3)
		add: elt1;
		add: elt2;
		add: elt3;
		yourself.!

with: elt1 with: elt2 with: elt3 with: elt4
	^(self new: 4)
		add: elt1;
		add: elt2;
		add: elt3;
		add: elt4;
		yourself.!

withAll: contents
	^(self new: contents size)
		addAll: contents;
		yourself.! !


!Bag comment!
A Bag is an unordered, unkeyed collection of arbitrary objects.! !


!Bag methodsFor: 'copying'!

postCopy
	contents := contents copy.! !


!Bag methodsFor: 'predicates'!

includes: object
	^contents includesKey: object.! !


!Bag methodsFor: 'accessing'!

add: object withOccurrences: occurrences
	contents
		at: object
		put: occurrences +
			(self occurrencesOf: object).
	^object.!

add: object
	^self add: object withOccurrences: 1.!

occurrencesOf: object
	^contents at: object ifAbsent: [0].!

remove: object ifAbsent: block
	| occurrences |
	occurrences := self occurrencesOf: object.
	occurrences == 0 ifTrue: [^block value].
	occurrences == 1
		ifTrue: [contents removeKey: object]
		ifFalse: [self add: object withOccurrences: -1].
	^object.!

size
	^contents inject: 0 into: [:total :occurrences | total + occurrences].!

at: key
	^self shouldNotImplement.!

at: key put: value
	^self shouldNotImplement.! !


!Bag methodsFor: 'enumerating'!

do: block
	contents keysAndValuesDo: [:object :occurrences |
		occurrences timesRepeat: [block value: object]].! !


!Bag methodsFor: 'initialization'!

initContents: dictionary
	contents := dictionary.! !


!Bag class methodsFor: 'instance creation'!

new
	^self new: 4.!

new: capacity
	^self basicNew initContents: 
		(Dictionary new: capacity).!

identityNew: capacity
	^self basicNew initContents: 
		(IdentityDictionary new: capacity).!

identityNew
	^self identityNew: 4.! !


!KeyedCollection comment!
KeyedCollections map keys (which may or may not be integers) to values.
! !


!KeyedCollection methodsFor: 'accessing'!

atAll: keys put: value
	keys do: [:key | self at: key put: value].
	^keys.!

atAllPut: value
	self keysDo: [:key | self at: key put: value].
	^value.!

keyAtValue: searchValue
	self keysAndValuesDo: [:key :value |
		value = searchValue
			ifTrue: [^key]].
	^nil.!

values
	| result |
	result := (Array new: self size) writeStream.
	self valuesDo: [:each | result nextPut: each].
	^result contents.!

keys
	| result |
	result := (Array new: self size) writeStream.
	self keysDo: [:each | result nextPut: each].
	^result contents.! !


!KeyedCollection methodsFor: 'enumerating'!

keysDo: block
	^self keysAndValuesDo: 
		[:key :value | block value: key].!

valuesDo: block
	^self do: block.!

keysAndValuesDo: block
	^self subclassResponsibility.! !


!ArrayedCollection comment!
ArrayedCollections have keys which are integers in the range 1..size.! !


!ArrayedCollection methodsFor: 'printing'!

printOn: stream
	super printOn: stream.
	stream
		space;
		nextPut: $(.
	self
		do: [:each | each printOn: stream]
		separatedBy: [
			stream
				nextPut: $,;
				space].
	stream nextPut: $).! !


!ArrayedCollection methodsFor: 'predicates'!

identityIncludes: object
	1 to: self size do: [:index |
		(self at: index) == object
			ifTrue: [^true]].
	^false.!

includes: object
	1 to: self size do: [:index |
		(self at: index) = object
			ifTrue: [^true]].
	^false.!

isArrayed
	^true.!

includesKey: key
	^key between: 1 and: self size.! !


!ArrayedCollection methodsFor: 'copying'!

, collection
	"Concatenation.  The result is always the same species as the receiver."
	"The argument must be an arrayed collection, or at least a keyed collection with integer keys 1..size."
	| result start |
	result := self expandedBy: collection size.
	start := self size.
	start + 1 to: result size do: [:index |
		result
			at: index
			put: (collection at: index - start)].
	^result.!

copyFrom: start to: stop
	| result index |
	start > stop ifTrue: [^self copyEmpty].
	result := self species new: stop - start + 1.
	index := 1.
	start to: stop do: [:offset |
		result
			at: index
			put: (self at: offset).
		index := index + 1].
	^result.!

expandedBy: amount
	"Answer a copy of the receiver with 'amount' additional slots."
	"This is a good message to reimplement in subclasses for speed."
	| result |
	result := self species new: self size + amount.
	1 to: self size do: [:index |
		result
			at: index
			put: (self at: index)].
	^result.!

copyWith: element
	| copied |
	copied := self expandedBy: 1.
	copied at: copied size put: element.
	^copied.! !


!ArrayedCollection methodsFor: 'streaming'!

readStream
	^ReadStream reallyOn: self.!

writeStream
	^WriteStream reallyOn: self.! !


!ArrayedCollection methodsFor: 'accessing'!

atAllPut: value
	1 to: self size do: [:n |
		self at: n put: value].
	^value.!

first
	^self at: 1.!

indexOf: value
	^self
		indexOf: value
		ifAbsent: [0].!

indexOf: value ifAbsent: exceptionBlock
	1 to: self size do: [:index |
		(self at: index) = value
			ifTrue: [^index]].
	^exceptionBlock value.!

keys
	^1 to: self size.!

last
	^self at: self size.!

reversed
	| result size |
	result := self copy.
	size := self size + 1.
	1 to: size - 1 do: [:index |
		result 
			at: size - index
			put: (self at: index)].
	^result.

!

size
	<primitive: 4>!

values
	^self.! !


!ArrayedCollection methodsFor: 'comparing'!

shallowEquals: collection
	1 to: self size do: [:index |
		(self at: index) = (collection at: index)
			ifFalse: [^false]].
	^true.! !


!ArrayedCollection methodsFor: 'enumerating'!

collect: block
	| result |
	result := self species new: self size.
	1 to: self size do: [:index |
		result
			at: index
			put: (block value: (self at: index))].
	^result.!

detect: block ifNone: exceptionBlock
	1 to: self size do: [:index |
		(block value: (self at: index))
			ifTrue: [^self at: index]].
	^exceptionBlock value.!

do: block
	1 to: self size do: [:index |
		block value: (self at: index)].!

do: block separatedBy: betweenBlock
	1 to: self size do: [:index |
		index == 1 ifFalse: [betweenBlock value].
		block value: (self at: index)].!

inject: initial into: block
	| value |
	value := initial.
	1 to: self size do: [:index |
		value := block
			value: value
			value: (self at: index)].
	^value.
!

keysAndValuesDo: block
	1 to: self size do: [:index |
		block
			value: index
			value: (self at: index)].!

keysDo: block
	^1 
		to: self size 
		do: [:index | block value: index].!

reverseDo: block
	self size to: 1 by: -1 do: [:index |
		block value: (self at: index)].!

select: block
	| result resultIndex |
	result := self species new: self size.
	resultIndex := 0.
	1 to: self size do: [:index |
		(block value: (self at: index)) ifTrue: [
			resultIndex := resultIndex + 1.
			result at: resultIndex put: (self at: index)]].
	"^result copyFrom: 1 to: resultIndex."
	^resultIndex == self size
		ifTrue: [result]
		ifFalse: [result copyFrom: 1 to: resultIndex].!

select: block do: action
	1 to: self size do: [:index |
		(block value: (self at: index))
			ifTrue: [action value: (self at: index)]].!

with: collection do: block
	(collection isArrayed
			and: [collection size == self size])
		ifFalse: [^self error: #collectionsNotConformable].
	1 to: self size do: [:index |
		block
			value: (self at: index)
			value: (collection at: index)].!

anySatisfy: block
	1 to: self size do: [:index |
		(block value: (self at: index))
			ifTrue: [^true]].
	^false.!

allSatisfy: block
	1 to: self size do: [:index |
		(block value: (self at: index))
			ifFalse: [^false]].
	^true.! !


!ArrayedCollection methodsFor: 'error handling'!

outOfBounds: index
	^self error: #subscriptOutOfBounds.! !


!ArrayedCollection class methodsFor: 'instance creation'!

new: size
	<primitive: 11>
	self error.
!

with: elt1
	^(self new: 1)
		at: 1 put: elt1;
		yourself.!

with: elt1 with: elt2
	^(self new: 2)
		at: 1 put: elt1;
		at: 2 put: elt2;
		yourself.!

with: elt1 with: elt2 with: elt3
	^(self new: 3)
		at: 1 put: elt1;
		at: 2 put: elt2;
		at: 3 put: elt3;
		yourself.!

with: elt1 with: elt2 with: elt3 with: elt4
	^(self new: 4)
		at: 1 put: elt1;
		at: 2 put: elt2;
		at: 3 put: elt3;
		at: 4 put: elt4;
		yourself.!

withAll: collection
	| result |
	result := self new: collection size.
	collection
		inject: 1
		into: [:index :elt |
			result at: index put: elt.
			index + 1].
	^result.! !


!Array comment!
Arrays can contain arbitrary objects.  Though defined as fixed-size, this implementation allows you to expand Arrays by sending #expandedBy:.
! !


!Array methodsFor: 'enumerating'!

do: block
	1 to: self basicSize do: [:index |
		block value: (self basicAt: index)].! !


!Array methodsFor: 'converting'!

asArray
	^self.! !


!Array methodsFor: 'copying'!

expandedBy: amount
	"Answer a copy of the receiver with 'amount' more slots."
	<primitive: 60>
	^self primitiveFailed.!

copyFrom: start to: stop
	<primitive: 64>
	^super copyFrom: start to: stop.! !


!Array class methodsFor: 'instance creation'!

new: size
	<primitive: 11>
	self primitiveFailed.! !


!ByteArray comment!
ByteArrays can contain only integers in the range 0..255.
! !


!ByteArray methodsFor: 'copying'!

, collection
	<primitive: 27>
	^super, collection.!

expandedBy: amount
	<primitive: 61>
	^self primitiveFailed.!

copyFrom: start to: stop
	<primitive: 65>
	^super copyFrom: start to: stop.!

copyToHeap: pointer
	SYSTRAP MemMove: pointer from: self length: self basicSize.
	^pointer.!

copyToHeap
	| ptr |
	ptr := CPointer memPtrNew: self basicSize.
	SYSTRAP MemMove: ptr from: self length: self basicSize.
	^ptr.! !


!ByteArray methodsFor: 'accessing'!

species
	^Array.! !


!ByteArray methodsFor: 'streaming'!

writeStream
	^ByteArrayWriteStream reallyOn: self.! !


!ByteArray methodsFor: 'comparing'!

= byteArray
	<primitive: 40>
	^super = byteArray.!

hash
	<primitive: 50>! !


!ByteArray methodsFor: 'converting'!

asByteArray
	^self.! !


!Interval comment!
Intervals are immutable collections which contain all numbers between two given numbers, at fixed increments between.
! !


!Interval methodsFor: 'printing'!

printOn: stream
	stream
		print: start;
		nextPutAll: ' to: ';
		print: stop.
	step ~= 1 ifTrue: [
		stream
			nextPutAll: ' by: ';
			print: step].! !


!Interval methodsFor: 'predicates'!

isEmpty
	^step negative
		ifTrue: [start < stop]
		ifFalse: [stop < start].! !


!Interval methodsFor: 'accessing'!

at: index
	^(index between: 1 and: self size)
		ifTrue: [start + (step * (index - 1))]
		ifFalse: [self outOfBounds: index].!

at: index put: value
	^self shouldNotImplement.!

reversed
	^self last to: self first by: self step negated.!

size
	^self isEmpty
		ifTrue: [0]
		ifFalse: [stop - start // step + 1].!

species
	^Array.!

start
	^start.!

step
	^step.!

stop
	^stop.! !


!Interval methodsFor: 'comparing'!

= interval
	^self class == interval class
		ifTrue: [
			start = interval start
				and: [stop = interval stop
				and: [step = interval step]]]
		ifFalse: [super = interval].!

hash
	^(start hash
		bitXor: stop hash)
			bitXor: step hash.! !


!Interval methodsFor: 'initialization'!

initStart: myStart
stop: myStop
step: myStep
	start := myStart.
	stop := myStop.
	step := myStep.! !


!Interval class methodsFor: 'instance creation'!

from: start to: stop
	^self basicNew
		initStart: start
		stop: stop
		step: 1.!

from: start to: stop by: step
	^self basicNew
		initStart: start
		stop: stop
		step: step.!

new
	^self shouldNotImplement.! !


!List comment!
List (also known as OrderedCollection) is a flexible kind of array which allows insertions and removals at any index.  It grows and shrinks as required to accomodate its elements.
! !


!List methodsFor: 'converting'!

asList
	^self.! !


!List methodsFor: 'accessing'!

at: index
	| position |
	position := first + index - 1.
	^(index < 1 or: [position > last])
		ifTrue: [self outOfBounds: index]
		ifFalse: [self basicAt: index].!

size
	"Possibly performance could be improved by keeping an extra size variable."
	^last - first + 1.!

at: index put: object
	| position |
	position := first + index - 1.
	^(index < 1 or: [position > last])
		ifTrue: [
			"Special case: allow #at:put: to the position just after the last element.  Treat it the same as an #addLast:."
			position == (last + 1)
				ifTrue: [self add: object]
				ifFalse: [self outOfBounds: index]]
		ifFalse: [self basicAt: position put: object].! !


!List methodsFor: 'enumerating'!

do: block
	first to: last do: [:index |
		block value: (self basicAt: index)].!

collect: block
	"Copied from Collection>>#collect:"
	| result |
	result := self species new: self size.
	self do: [:each | result add: (block value: each)].
	^result.!

select: block
	| result |
	result := self copyEmpty.
	self
		select: block
		do: [:each | result add: each].
	^result.! !


!List methodsFor: 'initialization'!

initialize
	first := 1.
	last := 0.! !


!List methodsFor: 'adding/removing'!

add: object after: anotherObject
	^self 
		add: object
		afterIndex: (self indexOf: anotherObject).!

add: object before: anotherObject
	^self 
		add: object
		beforeIndex: (self indexOf: anotherObject).!

add: object beforeIndex: index
	^self add: object afterIndex: index - 1.!

addFirst: object
	first == 1 ifTrue: [self expandAtBeginning].
	first := first - 1.
	^self basicAt: first put: object.!

addLast: object
	^self add: object.!

remove: object ifAbsent: exceptionBlock
	^self removeAtIndex:
		(self 
			indexOf: object
			ifAbsent: [^exceptionBlock value]).
!

removeAtIndex: index
	| position object |
	object := self at: index.
	position := first + index - 1.
	position == first ifTrue: [
		"Removing at beginning"
		self basicAt: first put: nil.  "allow GC"
		first := first + 1.
		^object].
	"Slide everything up"
	position + 1 to: last do: [:n |
		self
			basicAt: n - 1
			put: (self basicAt: n)].
	self basicAt: last put: nil.
	last := last - 1.
	^object.
		!

removeFirst
	^self removeAtIndex: 1.!

removeLast
	^self removeAtIndex: self size.!

add: object
	last >= self basicSize
		ifTrue: [self expandAtEnd].
	last := last + 1.
	^self basicAt: last put: object.!

add: object afterIndex: index
	| position |
	position := first + index.
	position > (last + 1)
		ifTrue: [^self outOfBounds: index].
	self basicSize == last ifTrue: [
		self expandAtEnd.
		position := first + index].
	last to: position by: -1 do: [:index |
		self
			basicAt: index + 1
			put: (self basicAt: index)].
	^self
		basicAt: position
		put: object.! !


!List methodsFor: 'private'!

expandAtBeginning
	self expandAtBeginningBy: self expansionAmount.!

expandAtBeginningBy: amount
	| expanded oldFirst oldLast |
	expanded := self class new: 
		self basicSize + amount.
	first to: last do: [:index |
		expanded
			basicAt: index + amount
			put: (self basicAt: index)].
	oldFirst := first.
	oldLast := last.
	self become: expanded.
	"Now self refers to expanded"
	first := amount + oldFirst.
	last := amount + oldLast.!

expandAtEnd
	self expandAtEndBy: self expansionAmount.!

expandAtEndBy: amount
	self basicSize - self size < amount
		ifTrue: [self reallyExpandAtEndBy: amount]
		ifFalse: [self slideToBeginning].!

expansionAmount
	^self size // 2 + 2.!

slideToBeginning
	| distance |
	distance := 1 - first.
	first to: last do: [:index |
		self
			basicAt: index + distance
			put: (self basicAt: index)].
	last + distance + 1 to: last do: [:index |
		self basicAt: index put: nil].
	first := 1.
	last := last + distance.!

reallyExpandAtEndBy: amount
	| expanded oldFirst oldLast |
	expanded := self primExpand: amount.
	oldFirst := first.
	oldLast := last.
	self become: expanded.
	first := oldFirst.
	last := oldLast.!

primExpand: amount
	"Expand at end by amount---answers a new copy."
	<primitive: 60>
	^self subclassResponsibility.! !


!List class methodsFor: 'instance creation'!

new
	^self new: 3.!

new: capacity
	^(self basicNew: capacity) initialize.!

with: elt1
	^(self new: 1)
		add: elt1;
		yourself.!

with: elt1 with: elt2
	^(self new: 2)
		add: elt1;
		add: elt2;
		yourself.!

with: elt1 with: elt2 with: elt3
	^(self new: 3)
		add: elt1;
		add: elt2;
		add: elt3;
		yourself.!

with: elt1 with: elt2 with: elt3 with: elt4
	^(self new: 4)
		add: elt1;
		add: elt2;
		add: elt3;
		add: elt4;
		yourself.!

withAll: contents
	^(self new: contents size)
		addAll: contents;
		yourself.! !


!IdentityList comment!
IdentityLists use identity comparisons (==) for certain operations such as #indexOf: and #remove:.
! !


!IdentityList methodsFor: 'accessing'!

indexOf: value ifAbsent: exceptionBlock
	"needs to be implemented as a primitive"
	first to: last do: [:index |
		(self basicAt: index) == value
			ifTrue: [^index - first + 1]].
	^exceptionBlock value.! !


!OrderedCollection comment!
OrderedCollection is the same as List, but is here for backwards compatibility.! !


!SortedCollection comment!
SortedCollections maintain their elements in a sorted order as specified by the sortBlock.! !


!SortedCollection methodsFor: 'private'!

sortFrom: i to: j 
	"as is required by law, here is the usual inscrutable sort algorithm"
	| di dij dj tt ij k l n |
	(n := j + 1 - i) <= 1 ifTrue: [^self].
	di := self basicAt: i.
	dj := self basicAt: j.
	(sortBlock value: di value: dj) ifFalse: [
		self basicAt: i put: dj.
		self basicAt: j put: di.
		tt := di.
		di := dj.
		dj := tt].
	n > 2 ifTrue: [
		ij := (i + j) // 2.
		dij := self basicAt: ij.
		(sortBlock value: di value: dij)
			ifTrue: [
				(sortBlock value: dij value: dj) ifFalse: [
					self basicAt: j put: dij.
					self basicAt: ij put: dj.
					dij := dj]]
			ifFalse: [
				self basicAt: i put: dij.
				self basicAt: ij put: di.
				dij := di].
		n > 3 ifTrue: [
			k := i.
			l := j.
			[[l := l - 1.  
				k <= l and: [sortBlock value: dij value: (self basicAt: l)]]
					whileTrue.
				[k := k + 1.  
					k <= l and: [sortBlock value: (self basicAt: k) value: dij]]
					whileTrue.
			k <= l] whileTrue: [
				tt := self basicAt: k.
				self basicAt: k put: (self basicAt: l).
				self basicAt: l put: tt].
			self sortFrom: i to: l.
			self sortFrom: k to: j]].
! !


!SortedCollection methodsFor: 'utility'!

resort
	self sortFrom: first to: last.! !


!SortedCollection methodsFor: 'copying'!

copyEmpty
	^super copyEmpty initSortBlock: sortBlock.! !


!SortedCollection methodsFor: 'accessing'!

at: index put: value
	^self shouldNotImplement.!

sortBlock
	^sortBlock.!

sortBlock: block
	sortBlock := block.
	self resort.!

species
	^List.! !


!SortedCollection methodsFor: 'adding/removing'!

add: object afterIndex: index
	^self shouldNotImplement.!

add: object
	| position scratch |
	last == self basicSize
		ifTrue: [self expandAtEndBy: 3].
	position := last.
	last := last + 1.
	[position < first] whileFalse: [
		scratch := self basicAt: position.
		(sortBlock value: object value: scratch)
			ifFalse: [
				position := position + 1.
				self basicAt: position put: object.
				^object].
		self basicAt: position + 1 put: scratch.
		position := position - 1].
	position := position + 1.
	self basicAt: position put: object.
	^object.	!

addAll: collection
	"More efficient than repeated #add:'s for large numbers of additions."
	| count freeSlots |
	count := collection size.
	count <= 3 ifTrue: [^super addAll: collection].
	freeSlots := self basicSize - last.
	freeSlots < count ifTrue: [self expandAtEndBy: count - freeSlots].
	collection do: [:each |
		self basicAt: (last := last + 1) put: each].
	self resort.
	^collection.
	! !


!SortedCollection methodsFor: 'initialization'!

initSortBlock: block
	sortBlock := block.! !


!SortedCollection methodsFor: 'converting'!

asSortedCollection
	^self.! !


!SortedCollection class methodsFor: 'instance creation'!

new: capacity
	^(super new: capacity)
		initSortBlock: [:left :right | left <= right].!

sortBlock: block
	^self new initSortBlock: block.!

withAll: contents sortBlock: sortBlock
	^(self new: contents size)
		initSortBlock: sortBlock;
		addAll: contents;
		yourself.! !


!String comment!
Strings can contain only Characters.  The printOn: representation surrounds the string with single-quotes.  When printing a string for display, you should use #nextPutAll: or #displayString instead.

Many special string methods are missing---#asLowercase, comparisons, #substrings, etc.
! !


!String methodsFor: 'printing'!

displayOn: stream
	stream nextPutAll: self.!

displayString
	^self.!

printOn: stream
	stream
		nextPut: $';
		nextPutAll: self;
		nextPut: $'.! !


!String methodsFor: 'copying'!

, collection
	<primitive: 27>
	^super, collection.!

copyToHeap
	| ptr |
	ptr := CPointer memPtrNew: self basicSize + 1.
	SYSTRAP MemMove: ptr from: self length: self basicSize.
	ptr byteAt: self basicSize put: 0.
	^ptr.!

copyToHeap: pointer
	SYSTRAP MemMove: pointer from: self length: self basicSize.
	pointer byteAt: self basicSize put: 0.
	^pointer.!

expandedBy: amount
	<primitive: 61>
	^self primitiveFailed.!

copyFrom: start to: stop
	<primitive: 65>
	^super copyFrom: start to: stop.! !


!String methodsFor: 'accessing'!

at: index
	^(self basicAt: index) asCharacter.!

at: index put: value
	self basicAt: index put: value asInteger.
	^value.! !


!String methodsFor: 'streaming'!

writeStream
	^StringWriteStream reallyOn: self.! !


!String methodsFor: 'comparing'!

= string
	<primitive: 40>
	^super = string.!

hash
	<primitive: 50>! !


!String methodsFor: 'converting'!

asUppercase
	^self collect: [:each | each asUppercase].!

asLowercase
	^self collect: [:each | each asLowercase].! !


!Dictionary comment!
Dictionaries map arbitrary keys onto arbitrary values.  Dictionary uses equality (=) and hashing (hash) to arrange keys.! !


!Dictionary methodsFor: 'printing'!

printOn: stream
	| first |
	super printOn: stream.
	stream
		space;
		nextPut: $(.
	first := true.
	self keysAndValuesDo: [:key :value |
		first ifFalse: [
			stream
				nextPut: $,;
				space].
		first := false.
		stream 
			print: key;
			nextPutAll: ' -> ';
			print: value].
	stream nextPut: $).! !


!Dictionary methodsFor: 'utility'!

rehash
	"Be sure to send this if a key changes its hash value."
	self expandBy: 0.! !


!Dictionary methodsFor: 'predicates'!

includesKey: key
	^(self at: key ifAbsent: [nil]) notNil.! !


!Dictionary methodsFor: 'copying'!

expand
	^self expandBy: (self capacity // 2 max: 3).!

expandBy: amount
	| expanded |
	expanded := self class new: self capacity + amount.
	self keysAndValuesDo: [:key :value |
		expanded at: key put: value].
	self become: expanded.! !


!Dictionary methodsFor: 'accessing'!

at: key
	^self
		at: key
		ifAbsent: [self error: #keyNotFound].!

at: key ifAbsent: block
	| value |
	^(value := self basicAt: (self findKeyOrNil: key) + 1)
		ifNil: [block value]
		ifNotNil: [value].!

at: key put: value
	| index |
	index := self findKeyOrNil: key.
	(self basicAt: index) ifNil: [tally := tally + 1].
	self basicAt: index put: key.
	^self basicAt: index + 1 put: value.!

capacity
	^self basicSize // 2.!

size
	^tally.!

species
	^Array.! !


!Dictionary methodsFor: 'adding/removing'!

removeKey: key
	^self
		removeKey: key
		ifAbsent: [self error: #keyNotFound].!

removeKey: key ifAbsent: exceptionBlock
	| index probe |
	index := self findKeyOrNil: key.
	probe := self basicAt: index.
	^probe
		ifNil: [exceptionBlock value]
		ifNotNil: [
			self basicAt: index put: nil.
			tally := tally - 1.
			self fixupAt: index.
			key].! !


!Dictionary methodsFor: 'enumerating'!

keysAndValuesDo: block
	1 to: self basicSize by: 2 do: [:index |
		(self basicAt: index) ifNotNil: [
			block
				value: (self basicAt: index)
				value: (self basicAt: index + 1)]].!

valuesDo: block
	1 to: self basicSize by: 2 do: [:index |
		(self basicAt: index) ifNotNil: [
			block value: (self basicAt: index + 1)]].!

do: block
	^self valuesDo: block.! !


!Dictionary methodsFor: 'initialization'!

initialize
	tally := 0.! !


!Dictionary methodsFor: 'private'!

findKeyOrNil: key
	| length size probe index start |
	size := self basicSize.
	length := size // 2.
	start := index := key hash \\ length * 2 + 1.
	[probe := self basicAt: index.
	  (probe isNil or: [probe = key]) ifTrue: [^index].
	  "The following is more efficient than the technique based on \\ because +, - and > are inlined by the compiler."
	  index := index + 2.
	  index > size ifTrue: [index := index - size].
	  index == start ifTrue: [
		self expand.
		"Tail recursive call"
		^self findKeyOrNil: key]]
	repeat.!

fixupAt: index
	"Copy-up objects which hashed to the given slot, now that the slot is empty."
	| probeIndex probe probeDesiredIndex size |
	size := self basicSize.
	probeIndex := index.
	[probeIndex := probeIndex + 2.
	  probeIndex > size 
		ifTrue: [probeIndex := probeIndex - size].
	  probe := self basicAt: probeIndex.
	  probe isNil] whileFalse: [
		"Rehash probe if needed."
		probeDesiredIndex := self findKeyOrNil: probe.
		(self basicAt: probeDesiredIndex) ifNil: [
			"Move from current index (probeIndex) to desiredIndex."
		self 
			basicAt: probeDesiredIndex
			put: (self basicAt: probeIndex).
		self
			basicAt: probeDesiredIndex + 1
			put: (self basicAt: probeIndex + 1).
		self basicAt: probeIndex put: nil.
		self basicAt: probeIndex + 1 put: nil]].! !


!Dictionary class methodsFor: 'instance creation'!

new
	^self new: 3.!

new: capacity
	^(self basicNew: capacity * 2) initialize.! !


!IdentityDictionary comment!
IdentityDictionaries use identity (==) and identity hashing (identityHash) to arrange keys.

IdentityDictionaries should be used in preference to Dictionaries whenever possible because many IdentityDictionary methods are implemented as fast primitive operations (Note: not yet).
! !


!IdentityDictionary methodsFor: 'private'!

findKeyOrNil: key
	| length size probe index start |
	size := self basicSize.
	length := size // 2.
	start := index := key hash \\ length * 2 + 1.
	[probe := self basicAt: index.
	  (probe isNil or: [probe == key]) ifTrue: [^index].
	  index := index + 2.
	  index > size ifTrue: [index := index - size].
	  index == start ifTrue: [
		self expand.
		"Tail recursive call"
		^self findKeyOrNil: key]]
	repeat.! !


!Set comment!
Sets are unordered collections of arbitrary objects.  Keys are arranged by equality (=) and hashing (hash).
! !


!Set methodsFor: 'utility'!

rehash
	self expandBy: 0.! !


!Set methodsFor: 'predicates'!

includes: object
	^(self basicAt: (self findElementOrNil: object))
		notNil.! !


!Set methodsFor: 'accessing'!

capacity
	^self basicSize.!

size
	^tally.!

at: key put: value
	^self shouldNotImplement.!

at: key
	^self shouldNotImplement.! !


!Set methodsFor: 'adding/removing'!

add: object
	| index |
	object ifNil: [self error: #cannotHoldNil].
	index := self findElementOrNil: object.
	(self basicAt: index)
		ifNil: [tally := tally + 1].
	^self basicAt: index put: object.!

remove: object ifAbsent: exceptionBlock
	| index probe |
	index := self findElementOrNil: object.
	probe := self basicAt: index.
	^probe
		ifNil: [exceptionBlock value]
		ifNotNil: [
			self basicAt: index put: nil.
			tally := tally - 1.
			self fixupAt: index.
			object].! !


!Set methodsFor: 'enumerating'!

do: block
	1 to: self basicSize do: [:n |
		(self basicAt: n) isNil
			ifFalse: [block value: (self basicAt: n)]].! !


!Set methodsFor: 'initialization'!

initialize
	tally := 0.! !


!Set methodsFor: 'private'!

expand
	^self expandBy: self capacity // 2 + 3.!

expandBy: amount
	| expanded |
	expanded := self class new: self capacity + amount.
	expanded addAll: self.
	self become: expanded.!

find: object ifAbsent: exceptionBlock
	| element |
	element := self basicAt: 
		(self findElementOrNil: object).
	^element
		ifNil: [exceptionBlock value]
		ifNotNil: [element].
	"^element orIfNil: [exceptionBlock value]"!

findElementOrNil: object
	| length size probe index start |
	size := self basicSize.
	start := index := object hash \\ size + 1.
	[probe := self basicAt: index.
	  (probe isNil or: [probe = object]) ifTrue: [^index].
	  "The following is more efficient than the technique based on \\ because +, - and > are inlined by the compiler."
	  index := index + 1.
	  index > size ifTrue: [index := index - size].
	  index == start ifTrue: [
		self expand.
		"Tail recursive call"
		^self findElementOrNil: object]]
	repeat.
!

fixupAt: index
	"Copy-up objects which hashed to the given slot, now that the slot is empty."
	| probeIndex probe probeDesiredIndex size |
	size := self basicSize.
	probeIndex := index.
	[probeIndex := probeIndex + 1.
	  probeIndex > size 
		ifTrue: [probeIndex := probeIndex - size].
	  probe := self basicAt: probeIndex.
	  probe isNil] whileFalse: [
		"Rehash probe if needed."
		probeDesiredIndex := self findElementOrNil: probe.
		(self basicAt: probeDesiredIndex) ifNil: [
			"Move from current index (probeIndex) to desiredIndex."
		self 
			basicAt: probeDesiredIndex
			put: (self basicAt: probeIndex).
		self basicAt: probeIndex put: nil]].
! !


!Set class methodsFor: 'instance creation'!

new
	^self new: 3.!

new: capacity
	^(self basicNew: (capacity max: 1))
		initialize.! !


!Context comment!
Context objects are used mainly for debugging.  They are not true Contexts as in other Smalltalks, but instead simply encapsulate a stack frame index and provide some useful utility methods.

The method Context class>>#textOfSelector: provides the only way to get the text of a symbol at runtime.  It is only available, however, if the virtual machine has been compiled with debugging support, and if debugging information has been generated by the IDE.
! !


!Context methodsFor: 'initialization'!

stackIndex: index
receiverClass: mclass
selector: string
	stackIndex := index.
	receiverClass := mclass.
	selector := string.! !


!Context methodsFor: 'printing'!

displayOn: stream
	(self receiver isKindOf: BlockClosure)
		ifTrue: [stream nextPutAll: '[] in '].
	stream
		nextPutAll: receiverClass name;
		nextPutAll: '>>';
		nextPutAll: selector.! !


!Context methodsFor: 'accessing'!

localVariableDescriptions
	| array slots stream |
	slots := self slotCount.
	array := Array new: slots + 1.
	array 
		at: 1 
		put: 'self: ', (self class receiverForContext: stackIndex) printString.
	0 to: slots - 1 do: [:offset |
		stream := String new writeStream.
		stream
			nextPutAll: 'local_';
			print: offset;
			nextPutAll: ': ';
			print: (self class
				stackSlotAt: offset
				forContext: stackIndex).
		array
			at: offset + 2
			put: stream contents].
	^array.!

receiver
	^self class receiverForContext: stackIndex.!

slotCount
	^self class stackSlotsForContext: stackIndex.! !


!Context class methodsFor: 'instance creation'!

forStackIndex: index
	^self new
		stackIndex: index
		receiverClass: (self classForContext: index)
		selector: (self textOfSymbol:
			(self selectorForContext: index)).! !


!Context class methodsFor: 'utility'!

allContextsFrom: startingContext
	^(startingContext to: 1 by: -1) 
		collect: [:n | self forStackIndex: n].!

receiverForContext: index
	<primitive: 35>
	^self primitiveFailed.!

stackSlotAt: slotIndex forContext: contextID
	<primitive: 38>
	^self primitiveFailed.!

stackSlotsForContext: contextID
	<primitive: 34>
	^self primitiveFailed.!

textOfSymbol: symbol
	<primitive: 32>
	^symbol printString.  "print as integer..."!

selectorForContext: index
	<primitive: 36>
	^self primitiveFailed.!

classForContext: index
	<primitive: 37>
	^self primitiveFailed.

	"| receiver |
	index == 0 ifTrue: [^nil].
	receiver := self receiverForContext: index.
	^(receiver class == FullBlockClosure
			and: [receiver nextOuter notNil
			and: [receiver nextOuter > 0]])
		ifTrue: [self classForContext: receiver nextOuter]
		ifFalse: [receiver class]."! !


!CPointer comment!
CPointer is a "boxed" 32-bit pointer.  Pointers are used extensively in PalmOS as arguments to or return values from SYSTRAP calls.  C structures and heap-allocated strings can also be accessed through CPointers.

Class-side methods give ways to allocate dynamic memory from PalmOS.  You must be careful to free such memory when you are finished, as Pocket Smalltalk does NOT automatically free such memory!!

If you need a small buffer of aligned heap memory you can use the global variable PadBuffer.  This is a CPointer to a 100-byte region of dynamic memory allocated on startup.! !


!CPointer methodsFor: 'memory management'!

freeHandle
	SYSTRAP MemHandleFree: self.!

free
	"Don't use this for handles---use #freeHandle instead."
	SYSTRAP MemChunkFree: self.!

lock
	^SYSTRAP MemHandleLock: self.!

unlock
	^SYSTRAP MemHandleUnlock: self.!

handleSize
	"Answer the number of bytes allocated to the handle."
	^SYSTRAP MemHandleSize: self.! !


!CPointer methodsFor: 'printing'!

printOn: stream
	super printOn: stream.
	stream
		nextPut: $\space;
		nextPut: $(;
		print: self asInteger;
		nextPut: $).! !


!CPointer methodsFor: 'predicates'!

isNull
	<primitive: 52>
	"^self asInteger == 0"! !


!CPointer methodsFor: 'accessing'!

byteAt: index
	<primitive: 42>
	^self primitiveFailed.!

byteAt: index put: value
	<primitive: 43>
	^self primitiveFailed.!

wordAt: index
	<primitive: 44>
	^self primitiveFailed.!

wordAt: index put: value
	<primitive: 45>
	^self primitiveFailed.!

dwordAt: index
	<primitive: 46>
	^self primitiveFailed.!

dwordAt: index put: value
	<primitive: 47>
	^self primitiveFailed.!

offsetBy: bytes
	<primitive: 48>
	^self primitiveFailed.! !


!CPointer methodsFor: 'comparing'!

= pointer
	<primitive: 40>
	^self == pointer.!

hash
	<primitive: 50>! !


!CPointer methodsFor: 'converting'!

asInteger
	| integer |
	integer := LongInteger basicNew: 4.
	1 to: 4 do: [:n |
		integer basicAt: n put: (self basicAt: n)].
	^integer.!

extractCString
	"Assumes the receiver is pointing at a 0-terminated (C style) string.  Answer a Smalltalk String object."
	"This is somewhat inefficient."
	| len string |
	len := 0.
	[(self byteAt: len) == 0] whileFalse: [len := len + 1].
	string := String new: len.
	SYSTRAP MemMove: string from: self bytes: len.
	^string.! !


!CPointer class methodsFor: 'initialization'!

initialize
	PadBuffer := self memPtrNew: 100.! !


!CPointer class methodsFor: 'handles'!

allocateMovableChunk: bytes
	"Answers a handle (an integer)."
	^SYSTRAP MemHandleNew: bytes.!

handleSize: handle
	"Answer the number of bytes allocated to the handle."
	^SYSTRAP MemHandleSize: handle.! !


!CPointer class methodsFor: 'instance creation'!

new
	^self basicNew: 4.!

new: size
	^self shouldNotImplement.!

null
	^self new.!

memPtrNew: bytes
	^SYSTRAP MemPtrNew: bytes.!

newPad
	"Answer a pointer to 4 bytes of dynamic memory.  This can be used as a 'pad' for SYSTRAP calls that require a pointer to a variable (pass by reference)."
	"When finished with the pad, you must send it #free."
	"If you only need one pad at a time, it is preferable to use PadBuffer."
	^self memPtrNew: 4.! !


!CStructure methodsFor: 'accessing'!

pointer
	^pointer.!

pointer: newCPointer
	pointer := newCPointer.! !


!CStructure class methodsFor: 'accessing'!

sizeInBytes
	^self subclassResponsibility.! !


!CStructure class methodsFor: 'instance creation'!

forPointer: ptr
	^self basicNew pointer: ptr.!

new
	| ptr |
	ptr := CPointer memPtrNew: self sizeInBytes.
	^self forPointer: ptr.
	! !


!CRectangle methodsFor: 'accessing'!

height
	^pointer wordAt: 6.!

height: newHeight
	pointer wordAt: 6 put: newHeight.!

left
	^pointer wordAt: 0.!

left: newLeft
	pointer wordAt: 0 put: newLeft.!

top
	^pointer wordAt: 2.!

top: newTop
	pointer wordAt: 2 put: newTop.!

width
	^pointer wordAt: 4.!

width: newWidth
	pointer wordAt: 4 put: newWidth.! !


!CRectangle methodsFor: 'utility'!

copyFromRectangle: rectangle
	"Copy from a Smalltalk rectangle object."
	self 
		left: rectangle left;
		top: rectangle top;
		width: rectangle width;
		height: rectangle height.!

asSmalltalkRectangle
	^self left @ self top extent: self width @ self height.! !


!CRectangle class methodsFor: 'accessing'!

sizeInBytes
	^8.!

buffer
	RectBuffer ifNil: [RectBuffer := self new].
	^RectBuffer.! !


!Message comment!
Messages are created when an object cannot interpret a selector.  #doesNotUnderstand: is sent to the object with a Message as the argument.! !


!Message methodsFor: 'accessing'!

arguments
	^arguments.!

selector
	^selector.! !


!Model comment!
Models can broadcast dependency events via #changed: and #changed:with:.

Note that "ordinary" objects cannot do this, as they can in some other Smalltalks.
! !


!Model methodsFor: 'dependents'!

changed: aspect
	^self changed: aspect with: nil.!

removeDependent: object
	^dependents remove: object.!

addDependent: object
	self initDependents.
	^dependents add: object.!

initDependents
	dependents ifNil: [dependents := IdentityList new].!

changed: aspect with: parameter
	dependents ifNil: [^self].
	dependents do: [:each |
		each 
			update: aspect
			with: parameter
			from: self].! !


!ListModel comment!
ListModels trigger these dependency events:
	#list - when the entire list is replaced
	#element: - when a single element is changed (the index is passed as an argument)

Note that ListModels do not support the full Collection protocol - to do more than #at:, #at:put: and #size, you must access the list directly (by sending #list) then replace it when finished.! !


!ListModel methodsFor: 'accessing'!

setList: newList
	list := newList.!

list: newList
	self setList: newList.
	self changed: #list.!

selectionIndex
	^selectionIndex.!

selection: object
	^self selectionIndex: (list indexOf: object).!

setSelectionIndex: newIndex
	selectionIndex := newIndex.!

selection
	^(selectionIndex isNil or: [selectionIndex <= 0
			or: [selectionIndex > list size]])
		ifTrue: [nil]
		ifFalse: [list at: selectionIndex].!

list
	^list.!

selectionIndex: newIndex
	selectionIndex == newIndex ifFalse: [
		selectionIndex := newIndex.
		self changed: #selection].! !


!ListModel methodsFor: 'collection accessing'!

size
	^list size.!

at: index
	^list at: index.!

at: index put: value
	list at: index put: value.
	self update: #element with: index.
	^value.! !


!ListModel class methodsFor: 'instance creation'!

list: list
	^self new
		setList: list;
		setSelectionIndex: 1.  "PalmOS defaults to 1..."! !


!ValueHolder comment!
ValueHolders hold a single value, and trigger a #value update when the value is set.

The #value update may be overridden by sending #setValue: instead of #value.! !


!ValueHolder methodsFor: 'accessing'!

setValue: newValue
	"Set without triggering an update."
	value := newValue.!

value
	^value.!

value: newValue
	value == newValue ifFalse: [
		value := newValue.
		self changed: #value].! !


!ValueHolder class methodsFor: 'instance creation'!

with: object
	^self new setValue: object.! !


!Number comment!
Numbers are numeric values of various kinds.

Number has the protocol normally found in class Magnitude (there is no separate Magnitude class).  In addition, the usual Number methods are implemented here.

! !


!Number methodsFor: 'math functions'!

abs
	^self negative
		ifTrue: [self negated]
		ifFalse: [self].
	"or: self * self sign"!

max: value
	^self > value
		ifTrue: [self]
		ifFalse: [value].!

min: value
	^self < value
		ifTrue: [self]
		ifFalse: [value].!

negated
	^0 - self.!

reciprocal
	^1 / self.!

squared
	^self * self.!

sign
	^self isZero
		ifTrue: [0]
		ifFalse: [
			self negative
				ifTrue: [-1]
				ifFalse: [1]].!

raisedToInteger: integer
	| scratch answer |
	integer negative ifTrue: [
		^(self raisedToInteger: integer negated) 
			reciprocal].
	integer == 0 ifTrue: [^1].
	integer == 1 ifTrue: [^self].
	scratch := 2.
	[scratch < integer] whileTrue: [scratch := scratch + scratch].
	answer := 1.
	[scratch > 0] whileTrue: [
		answer := answer * answer.
		(integer bitAnd: scratch) == 0 
			ifFalse: [answer := answer * self].
		scratch := scratch bitShift: -1].
	^answer.! !


!Number methodsFor: 'predicates'!

isInteger
	^false.!

isZero
	^self = 0.!

negative
	^self < 0.!

positive
	"arrgh, I hate this definition, but it's what we're stuck with."
	^self negative not.! !


!Number methodsFor: 'comparing'!

< number
	^self subclassResponsibility.!

<= number
	^(number < self) not.!

= number
	^self subclassResponsibility.!

> number
	^number < self.!

>= number
	^(self < number) not.!

between: lower and: upper
	^self >= lower and: [self <= upper].!

hash
	self subclassResponsibility.! !


!Number methodsFor: 'double dispatching'!

addToFraction: fraction
	^fraction retry: #+ coercing: self.!

addToInteger: integer
	^integer retry: #+ coercing: self.!

addToPoint: point
	^point retry: #+ coercing: self.!

coerce: number
	"Coerce a lower-generality number to the same generality as the receiver (if possible)."
	^self subclassResponsibility.!

divideIntoFraction: fraction
	^fraction retry: #/ coercing: self.!

divideIntoInteger: integer
	^integer retry: #/ coercing: self.!

divideIntoPoint: point
	^point retry: #/ coercing: self.!

equalToFraction: fraction
	^fraction retry: #= coercing: self.!

equalToInteger: integer
	^integer retry: #= coercing: self.!

equalToPoint: point
	^point retry: #= coercing: self.!

generality
	^self subclassResponsibility.!

greaterThanFraction: fraction
	^fraction retry: #< coercing: self.!

greaterThanInteger: integer
	^integer retry: #< coercing: self.!

greaterThanPoint: point
	^point retry: #< coercing: self.!

multiplyByFraction: fraction
	^fraction retry: #* coercing: self.!

multiplyByInteger: integer
	^integer retry: #* coercing: self.!

multiplyByPoint: point
	^point retry: #* coercing: self.!

retry: selector coercing: number
	| leftGenerality rightGenerality |
	leftGenerality := self generality.
	rightGenerality := number generality.
	leftGenerality > rightGenerality ifTrue: [
		^self
			perform: selector
			with: (self coerce: number)].
	leftGenerality < rightGenerality ifTrue: [
		^(number coerce: self)
			perform: selector
			with: number].
	^self error: #coerce.  "same generality"!

subtractFromFraction: fraction
	^fraction retry: #- coercing: self.!

subtractFromInteger: integer
	^integer retry: #- coercing: self.!

subtractFromPoint: point
	^point retry: #- coercing: self.!

addToDouble: double
	^double retry: #+ coercing: self.!

divideIntoDouble: double
	^double retry: #/ coercing: self.!

equalToDouble: double
	^double retry: #= coercing: self.!

greaterThanDouble: double
	^double retry: #< coercing: self.!

multiplyByDouble: double
	^double retry: #* coercing: self.!

subtractFromDouble: double
	^double retry: #- coercing: self.! !


!Number methodsFor: 'instance creation'!

@ y
	^Point x: self y: y.!

to: stop
	^Interval from: self to: stop.!

to: stop by: step
	^Interval from: self to: stop by: step.! !


!Number class methodsFor: 'parsing'!

fromString: string
	^self readFrom: string readStream.!

readFrom: stream
	"These readFrom methods are being 'borrowed' from Dolphin until I can implement them better."
	| neg integerPart value |
	stream skipWhitespace.
	neg := stream peekFor: $-.
	integerPart := Integer readFrom: stream.
	stream peek == $/ ifTrue: [
		^Fraction
			readFrom: stream
			initialInteger: integerPart
			negated: neg].
	^neg
		ifTrue: [integerPart negated]
		ifFalse: [integerPart].! !


!Number class methodsFor: 'instance creation'!

new
	"Numbers should only be created by sending messages to other numbers."
	^self shouldNotImplement.!

new: size
	"Numbers should only be created by sending messages to other numbers."
	^self shouldNotImplement.! !


!Double methodsFor: 'printing'!

inScientificNotation
	"Use the crappy PalmOS formatting routine."
	<primitive: 90>!

printOn: stream
	^self 
		printOn: stream
		decimalPlaces: 4.!

printOn: stream decimalPlaces: decimalPlaces
	| value ipart fpart limit str |
	value := self.
	value < 0.0 ifTrue: [
		value := value negated.
		stream nextPut: $-].
	ipart := value asInteger.
	value := value - ipart asDouble.
	limit := 1.0.
	decimalPlaces timesRepeat: [
		value := value * 10.0.
		limit := limit * 10.0].
	value >= limit 
		ifTrue: [
			fpart := 0.
			ipart := ipart + 1]
		ifFalse: [fpart := value asInteger].
	stream nextPutAll: ipart printString.
	decimalPlaces > 0 ifTrue: [
		stream nextPut: $..
		str := fpart printString.
		decimalPlaces - str size timesRepeat: [
			stream nextPut: $0].
		stream nextPutAll: str].! !


!Double methodsFor: 'math functions'!

acos
	^self unary: 0.!

asin
	^self unary: 1.!

atan
	^self unary: 2.!

cos
	^self unary: 3.!

sin
	^self unary: 4.!

tan
	^self unary: 5.!

cosh
	^self unary: 6.!

sinh
	^self unary: 7.!

tanh
	^self unary: 8.!

acosh
	^self unary: 9.!

asinh
	^self unary: 10.!

atanh
	^self unary: 11.!

exp
	^self unary: 12.!

ln
	^self unary: 13.!

log10
	^self unary: 14.!

expM1
	^self unary: 15.!

ln1P
	^self unary: 16.!

logB
	^self unary: 17.!

log2
	^self unary: 18.!

sqrt
	^self unary: 19.!

cubeRoot
	^self unary: 20.!

ceil
	^self unary: 21.!

abs
	^self unary: 22.!

floor
	^self unary: 23.!

significand
	^self unary: 24.!

rint
	^self unary: 25.!

rounded
	^self unary: 26.!

truncated
	^self unary: 27.!

negated
	^0.0 - self.!

unary: op
	"Quick dispatch for simple unary double functions."
	<primitive: 98>
	^self primitiveFailed.! !


!Double methodsFor: 'arithmetic'!

- number
	<primitive: 94>
	^number subtractFromDouble: self.!

* number
	<primitive: 95>
	^number multiplyByDouble: self.!

/ number
	<primitive: 96>
	^number divideIntoDouble: self.!

+ number
	<primitive: 93>
	^number addToDouble: self.!

\\ number
	"Remainder."
	<primitive: 99>
	^self - ((self // number) * number).! !


!Double methodsFor: 'comparing'!

< number
	<primitive: 97>
	^number greaterThanDouble: self.!

= number
	<primitive: 40>
	^number equalToDouble: self.! !


!Double methodsFor: 'double dispatching'!

generality
	^9.!

coerce: number
	^number asDouble.! !


!Double methodsFor: 'converting'!

asDouble
	^self.!

asInteger
	<primitive: 91>! !


!Double class methodsFor: 'parsing'!

readFrom: stream
	| neg ipart fpart result str |
	stream skipWhitespace.
	neg := stream peekFor: $-.
	neg ifFalse: [stream peekFor: $+].
	ipart := Integer readFrom: stream radix: 10.
	(stream peekFor: $.)
		ifTrue: [
			fpart := Integer readFrom: stream radix: 10.
			result := fpart asDouble.
			str := fpart printString.
			str size timesRepeat: [
				result := result / 10.0].
			result := result + ipart asDouble]
		ifFalse: [result := ipart asDouble].
	^neg ifTrue: [result negated] ifFalse: [result].! !


!Fraction comment!
Fractions are rational numbers.

The numerator and denominator of a Fraction are assumed to be Integers---and are therefore affected by the same restrictions imposed on Integers (see the comment of Integer for explanation).! !


!Fraction methodsFor: 'printing'!

printOn: stream
	stream
		print: numerator;
		nextPut: $/;
		print: denominator.! !


!Fraction methodsFor: 'math functions'!

negated
	^self class
		basicNumerator: numerator negated
		denominator: denominator.!

reciprocal
	^self class
		numerator: denominator
		denominator: numerator.!

truncated
	^numerator quo: denominator.! !


!Fraction methodsFor: 'arithmetic'!

- number
	^number subtractFromFraction: self.!

* number
	^number multiplyByFraction: self.!

/ number
	^number divideIntoFraction: self.!

// number
	^(numerator * number denominator)
		// (denominator * number numerator).!

+ number
	^number addToFraction: self.! !


!Fraction methodsFor: 'predicates'!

isZero
	^numerator == 0.! !


!Fraction methodsFor: 'accessing'!

denominator
	^denominator.!

numerator
	^numerator.! !


!Fraction methodsFor: 'comparing'!

< number
	^number greaterThanFraction: self.!

= number
	^number equalToFraction: self.!

hash
	^numerator hash bitXor: denominator hash.! !


!Fraction methodsFor: 'initialization'!

numerator: n denominator: d
	numerator := n.
	denominator := d.! !


!Fraction methodsFor: 'double dispatching'!

addToFraction: fraction
	denominator = fraction denominator ifTrue: [
		^self class
			numerator: numerator + fraction numerator
			denominator: denominator].
	^self class
		numerator: numerator * fraction denominator + 
			(fraction numerator * denominator)
		denominator: denominator * fraction denominator.!

addToInteger: integer
	^self class
		numerator: integer * denominator + numerator
		denominator: denominator.!

coerce: number
	^self class
		basicNumerator: number numerator
		denominator: number denominator.!

divideIntoFraction: fraction
	^self class
		numerator: denominator * fraction numerator
		denominator: numerator * fraction denominator.!

divideIntoInteger: integer
	^self class
		numerator: denominator * integer
		denominator: numerator.!

equalToFraction: fraction
	^numerator = fraction numerator
		and: [denominator = fraction denominator].!

equalToInteger: integer
	"Always false, since Fractions are assumed to be non-integer rationals."
	^false.!

generality
	^6.!

greaterThanFraction: fraction
	fraction negative == self negative
		ifTrue: [self negative].
	^(fraction numerator * denominator)
		< (numerator * fraction denominator).!

greaterThanInteger: integer
	^integer * denominator < numerator.!

multiplyByFraction: fraction
	^self class
		numerator: numerator * fraction numerator
		denominator: denominator * fraction denominator.!

multiplyByInteger: integer
	^self class
		numerator: integer * numerator
		denominator: denominator.!

subtractFromFraction: fraction
	^self class
		numerator: fraction numerator * denominator
			- (numerator * fraction denominator)
		denominator: denominator * fraction denominator.!

subtractFromInteger: integer
	^self class
		basicNumerator: integer * denominator - numerator
		denominator: denominator.! !


!Fraction methodsFor: 'converting'!

asFraction
	^self.!

asInteger
	^self truncated.!

asDouble
	^numerator asDouble / denominator asDouble.! !


!Fraction class methodsFor: 'uncategorized'!

readFrom: stream
initialInteger: numerator
negated: neg
	| denominator |
	denominator := (stream peekFor: $/)
		ifTrue: [Integer readFrom: stream radix: 10]
		ifFalse: [1].
	neg ifTrue: [denominator := denominator negated].
	^self
		numerator: numerator
		denominator: denominator.! !


!Fraction class methodsFor: 'parsing'!

readFrom: stream
	| numerator neg |
	neg := stream peekFor: $-.
	numerator := Integer
		readFrom: stream
		radix: 10.
	^self
		readFrom: stream
		initialInteger: numerator
		negated: neg.! !


!Fraction class methodsFor: 'instance creation'!

basicNumerator: n denominator: d
	^self basicNew
		numerator: n
		denominator: d.!

numerator: n denominator: d
	| numerator denominator factor |
	d isZero ifTrue: [self error: #divisionByZero].
	numerator := n.
	denominator := d.
	"Make sure the denominator is not negative."
	denominator < 0 ifTrue: [
		denominator := 0 - denominator.
		numerator := 0 - numerator].
	"Extract common factors."
	factor := numerator gcd: denominator.
	"Integer result?"
	factor = denominator 
		ifTrue: [^numerator // factor].
	^self
		basicNumerator: numerator // factor
		denominator: denominator // factor.! !


!Integer comment!
Integers are the subset of real numbers that can be obtained by successively adding 1 or -1 to 0.

The VM operates with essentially two kinds of integers: SmallIntegers, which can range from -16384 to 16383, and LongIntegers, which can range from approx -2.1 billion to 2.1 billion.

SmallIntegers are encoded directly as immediate values and therefore take no space in heap memory.

LongIntegers are encoded as byte-indexable objects with 4 bytes each.

Arithmetic operations will automatically convert between SmallIntegers and LongIntegers as necessary, but overflowing the range of LongIntegers will cause "wrapping" of results---the same as in C and other languages.  

In other words, it is not possible to have integers of a magnitude larger than about 2.1 billion without implementing some kind of LargeInteger class.
! !


!Integer methodsFor: 'printing'!

printOn: stream
	stream nextPutAll: self printString.!

printString
	<primitive: 88>
	^self primitiveFailed.! !


!Integer methodsFor: 'math functions'!

ceiling
	^self.!

floor
	^self.!

gcd: integer
	<primitive: 78>
	^self primitiveFailed.! !


!Integer methodsFor: 'arithmetic'!

/ number
	^number divideIntoInteger: self.!

- number
	<primitive: 71>
	^number subtractFromInteger: self.!

* number
	<primitive: 72>
	^number multiplyByInteger: self.!

// number
	<primitive: 76>
	^number isZero
		ifTrue: [self error: #divisionByZero]
		ifFalse: [self primitiveFailed].!

\\ number
	<primitive: 86>
	^self primitiveFailed.!

+ number
	<primitive: 70>
	^number addToInteger: self.!

quo: number
	<primitive: 77>
	^self primitiveFailed.!

rem: number
	<primitive: 85>
	^self primitiveFailed.! !


!Integer methodsFor: 'predicates'!

even
	^(self bitAnd: 1) == 0.!

isInteger
	^true.!

odd
	^(self bitAnd: 1) == 1.! !


!Integer methodsFor: 'accessing'!

denominator
	^1.!

numerator
	^self.! !


!Integer methodsFor: 'flow control'!

timesRepeat: block
	self timesRepeat: [block value].! !


!Integer methodsFor: 'bit manipulation'!

bitAt: index
	^((self bitAnd: (1 bitShift: index - 1)) ~~ 0) asInteger.!

bitAnd: number
	<primitive: 73>
	^self primitiveFailed.!

bitOr: number
	<primitive: 74>
	^self primitiveFailed.!

bitShift: amount
	<primitive: 87>
	^self primitiveFailed.!

bitXor: number
	<primitive: 75>
	^self primitiveFailed.! !


!Integer methodsFor: 'comparing'!

~= number
	<primitive: 84>
	^super ~= number.!

< number
	<primitive: 79>
	^number greaterThanInteger: self.!

<= number
	<primitive: 80>
	^super <= number.!

= number
	<primitive: 83>
	^number equalToInteger: self.!

> number
	<primitive: 81>
	^super > number.!

>= number
	<primitive: 82>
	^super >= number.! !


!Integer methodsFor: 'double dispatching'!

addToFraction: fraction
	^fraction addToInteger: self.!

coerce: number
	"probably never used, since integers are the lowest generality."
	^number asInteger.!

divideIntoFraction: fraction
	^Fraction
		numerator: fraction numerator
		denominator: self * fraction denominator.!

divideIntoInteger: integer
	^Fraction
		numerator: integer
		denominator: self.!

generality
	^3.!

greaterThanFraction: fraction
	^fraction numerator < (self * fraction denominator).!

multiplyByFraction: fraction
	^fraction multiplyByInteger: self.!

subtractFromFraction: fraction
	^Fraction
		numerator: fraction numerator -
			(self * fraction denominator)
		denominator: fraction denominator.! !


!Integer methodsFor: 'converting'!

asFraction
	^Fraction
		basicNumerator: self
		denominator: 1.!

asInteger
	^self.!

reduced
	^self + 0.!

asBoolean
	^self ~~ 0.!

asDouble
	<primitive: 92>! !


!Integer class methodsFor: 'parsing'!

readFrom: stream radix: radix
	| value char |
	value := 0.
	[(char := stream peek) notNil
			and: [char isDigit]]
		whileTrue: [
			char digitValue >= radix
				ifTrue: [^value].
			value := value * radix + char digitValue.
			stream next].
	^value.!

readFrom: stream
	| neg value |
	stream skipWhitespace.
	neg := stream peekFor: $-.
	value := self readFrom: stream radix: 10.
	^neg
		ifTrue: [value negated]
		ifFalse: [value].
	! !


!Integer class methodsFor: 'instance creation'!

fromBytes: byteArray
	(byteArray isBytes and: [byteArray basicSize == 4])
		ifFalse: [^self error: #badByteArray].
	^(byteArray shallowCopy basicChangeClassTo: LongInteger)
		reduced.! !


!LongInteger comment!
LongIntegers are "boxed" 32-bit signed integers.

Note that many primitives can handle SmallIntegers and LongIntegers polymorphically.  When writing your own primitives you should use the C functions is_integer(), as_c_integer(), and as_smalltalk_integer() to operate with integers.

LongIntegers can also be used as boxed C pointers.
! !


!LongInteger methodsFor: 'comparing'!

hash
	^self bitAnd: 16383.! !


!SmallInteger comment!
SmallIntegers are immediate values in the range: -16384..16383.

Internally, SmallIntegers are represented as 15-bit two's-complement integers with the low bit set to 1 (it is set to 0 for object references).! !


!SmallInteger methodsFor: 'converting'!

asCharacter
	<primitive: 26>
	^self primitiveFailed.! !


!SmallInteger methodsFor: 'comparing'!

= number
	^self == number.!

hash
	^self.! !


!Point comment!
A Point is a x,y value pair, usually used for representing the positions of graphics objects.! !


!Point methodsFor: 'printing'!

printOn: stream
	stream
		print: self x;
		nextPut: $@;
		print: self y.! !


!Point methodsFor: 'math functions'!

abs
	"Not sqrt(x^2 + y^2)"
	^x abs @ y abs.! !


!Point methodsFor: 'arithmetic'!

- number
	^number subtractFromPoint: self.!

* number
	^number multiplyByPoint: self.!

/ number
	^number divideIntoPoint: self.!

// number
	"punt on the double dispatching stuff..."
	^number class == self class
		ifTrue: [(self x // number x) @ (self y // number y)]
		ifFalse: [(self x // number) @ (self y // number)].!

+ number
	^number addToPoint: self.! !


!Point methodsFor: 'accessing'!

x
	^x.!

x: newX
	x := newX.!

x: newX y: newY
	x := newX.
	y := newY.!

y
	^y.!

y: newY
	y := newY.! !


!Point methodsFor: 'comparing'!

< number
	^number greaterThanPoint: self.!

= number
	^number equalToPoint: self.!

hash
	^x hash bitXor: y hash.! !


!Point methodsFor: 'double dispatching'!

addToPoint: point
	^(x + point x) @ (y + point y).!

coerce: number
	^number @ number.!

divideIntoPoint: point
	^(point x / x) @ (point y / y).!

equalToPoint: point
	^point x = x and: [point y = y].!

generality
	^10.!

greaterThanPoint: point
	^x > point x and: [y > point y].!

multiplyByPoint: point
	^(point x * x) @ (point y * y).!

subtractFromPoint: point
	^(point x - x) @ (point y - y).! !


!Point methodsFor: 'instance creation'!

@ y
	^self shouldNotImplement.!

extent: extent
	^Rectangle
		origin: self
		extent: extent.! !


!Point class methodsFor: 'instance creation'!

x: x y: y
	^self basicNew x: x y: y.! !


!PalmOS class methodsFor: 'uncategorized'!

delay: ticks
	SYSTRAP SysTaskDelay: ticks.!

random
	^SYSTRAP SysRandom: 0.!

freeMemory
	"Number of bytes in the PalmOS dynamic heap."
	| heaps heapID bytes bytesHere maxChunk |
	heaps := SYSTRAP MemNumHeaps: 0.
	bytesHere := PadBuffer.
	maxChunk := CPointer newPad.
	bytes := 0.
	0 to: heaps - 1 do: [:heapIndex |
		heapID := SYSTRAP MemHeapID: 0 index: heapIndex.
		(SYSTRAP MemHeapDynamic: heapID) asBoolean ifTrue: [
			SYSTRAP
				MemHeapFreeBytes: heapID
				bytesPtr: bytesHere
				maxChunkPtr: maxChunk.
			bytes := bytes + (bytesHere dwordAt: 0)]].
	maxChunk free.
	^bytes.!

dynamicMemory
	| heaps heapID bytes |
	heaps := SYSTRAP MemNumHeaps: 0.
	bytes := 0.
	0 to: heaps - 1 do: [:heapIndex |
		heapID := SYSTRAP MemHeapID: 0 index: heapIndex.
		(SYSTRAP MemHeapDynamic: heapID) asBoolean ifTrue: [
			bytes := bytes + (SYSTRAP
				MemHeapSize: heapID)]].
	^bytes.! !


!Rectangle methodsFor: 'printing'!

printOn: stream
	stream
		print: origin;
		nextPutAll: ' corner: ';
		print: corner.! !


!Rectangle methodsFor: 'predicates'!

contains: rectangle
	^rectangle origin >= origin
		and: [rectangle corner <= corner].!

intersects: rectangle
	^origin < rectangle corner
		and: [rectangle origin < corner
		and: [origin < corner
		and: [rectangle origin < rectangle corner]]].!

containsPoint: point
	^(point x between: origin x and: corner x)
		and: [point y between: origin y and: corner y].! !


!Rectangle methodsFor: 'copying'!

postCopy
	origin := origin copy.
	corner := corner copy.! !


!Rectangle methodsFor: 'accessing'!

bottom
	^corner y.!

center
	^origin + (self extent // 2).!

corner
	^corner.!

corner: point
	corner := point.!

extent
	^corner - origin.!

extent: extent
	corner := origin + extent.!

height
	^corner y - origin y.!

left
	^origin x.!

origin
	^origin.!

origin: point
	origin := point.!

right
	^corner x.!

top
	^origin y.!

width
	^corner x - origin x.! !


!Rectangle methodsFor: 'rectangle functions'!

intersect: rectangle
	^(origin max: rectangle origin)
		corner: (corner min: rectangle corner).!

merge: rectangle
	^(origin min: rectangle origin)
		corner: (corner max: rectangle corner).!

outsetBy: amount
	^self class
		origin: origin - amount
		corner: corner + amount.!

insetBy: amount
	^self class
		origin: origin + amount
		corner: corner - amount.! !


!Rectangle methodsFor: 'comparing'!

= object
	^self class == object class
		and: [corner = object corner
		and: [origin = object origin]].!

hash
	^origin hash bitXor: corner hash.! !


!Rectangle class methodsFor: 'instance creation'!

center: center extent: extent
	^self
		origin: center - (extent // 2)
		extent: extent.!

left: left top: top right: right bottom: bottom
	^self
		origin: left @ top
		corner: right @ bottom.!

origin: origin corner: corner
	^self new
		origin: origin;
		corner: corner.!

origin: origin extent: extent
	^self new
		origin: origin;
		extent: extent.! !


!Smalltalk comment!
Smalltalk provides some methods for interfacing with the virtual machine.  The message Smalltalk class>>#start is sent when the virtual machine begins execution.! !


!Smalltalk class methodsFor: 'startup'!

basicStart
	"Sent by the virtual machine upon startup.  This is the first Smalltalk method that executes."
	CPointer initialize.  "create PadBuffer"
	self start.
	^self exit.!

start
	"Put your startup code here!!"! !


!Smalltalk class methodsFor: 'utility'!

collectGarbage
	<primitive: 12>!

exit
	<primitive: 2>!

runningOnDevice
	<primitive: 3>!

freeMemory
	"Number of free bytes in the Smalltalk heap."
	<primitive: 28>! !


!Stream comment!
Streams provide a position reference for noncontinuous enumeration of arrayed collections.! !


!Stream methodsFor: 'initialization'!

on: streamedCollection
	collection := streamedCollection.
	position := 0.
	limit := collection size.! !


!Stream methodsFor: 'accessing'!

contents
	^self subclassResponsibility.!

size
	"Answer the number of remaining elements in the stream."
	^limit - position.! !


!Stream methodsFor: 'positioning'!

position
	^position.!

position: newPosition
	position := newPosition.!

reset
	position := 0.!

setToEnd
	position := limit.!

skip: amount
	"Skip forward, or backward if amount is negative."
	position := position + amount.! !


!Stream class methodsFor: 'instance creation'!

on: collection
	"This uses double dispatching to detect attempts to stream over a non-streamable collection."
	self subclassResponsibility.!

reallyOn: collection
	^self new on: collection.!

with: collection
	^(self on: collection) setToEnd.! !


!ReadStream comment!
ReadStreams can only read from a collection.! !


!ReadStream methodsFor: 'accessing'!

contents
	^collection.!

next
	position >= limit
		ifTrue: [self error: #endOfStream].
	^collection at: (position := position + 1).!

next: count
	"This could be optimized easily."
	| result |
	result := collection species new: count.
	1 to: count do: [:index |
		result
			at: index
			put: self next].
	^result.! !


!ReadStream methodsFor: 'stream operations'!

peek
	"Answers nil if there are no more elements."
	^self atEnd
		ifTrue: [nil]
		ifFalse: [collection at: position + 1].!

peekFor: object
	"Answer whether the next object matches, and if so, advance the stream."
	self atEnd ifTrue: [^false].
	^(collection at: position + 1) = object
		ifTrue: [
			position := position + 1.
			true]
		ifFalse: [false].!

skipThrough: object
	"Skip until after object.  Answer whether object was found at all."
	[self atEnd] whileFalse: [
		self next = object
			ifTrue: [^true]].
	^false.!

skipWhile: block
	"Answers whether there are any more elements left."
	[self atEnd] whileFalse: [
		(block value: self next) ifFalse: [
			self skip: -1.
			^true]].
	^false.!

upTo: object
	"All elements up to (not inclusive of) object, or the entire rest of the collection if object is not there."
	| index start |
	start := index := position + 1.
	[index <= limit] whileTrue: [
		(collection at: index) = object ifTrue: [
			index := index - 1.
			position := index.
			^collection copyFrom: start to: index].
		index := index + 1].
	position := limit.
	^collection copyFrom: start to: limit.!

skipWhitespace
	^self skipWhile: [:char | char isWhitespace].! !


!ReadStream methodsFor: 'predicates'!

atEnd
	^position >= limit.!

isEmpty
	^limit == 0.!

notEmpty
	^limit ~~ 0.! !


!ReadStream methodsFor: 'enumerating'!

do: block
	"Evaluate block for each _remaining_ element in the receiver."
	[self atEnd]
		whileTrue: [block value: self next].! !


!ReadStream class methodsFor: 'instance creation'!

on: collection
	^collection readStream.! !


!WriteStream comment!
WriteStreams can only write to a collection.! !


!WriteStream methodsFor: 'accessing'!

contents
	^collection copyFrom: 1 to: position.! !


!WriteStream methodsFor: 'stream operations'!

next: count put: object
	count timesRepeat: [self nextPut: object].
	^object.!

nextPut: object
	position >= limit
		ifTrue: [self expandCollection].
	collection
		at: (position := position + 1)
		put: object.!

nextPutAll: collection
	"This is only valid for indexable (arrayed) collections."
	1 to: collection size do: [:index |
		self nextPut: (collection at: index)].!

print: object
	^object printOn: self.!

space
	^self nextPut: $\space.!

tab
	^self nextPut: $\tab.!

cr
	^self nextPut: $\newline.! !


!WriteStream methodsFor: 'private'!

expandCollection
	collection := collection
		expandedBy: (limit // 2 max: 10).
	limit := collection size.! !


!WriteStream class methodsFor: 'instance creation'!

on: collection
	^collection writeStream.! !


!ByteArrayWriteStream methodsFor: 'stream operations'!

nextPutAll: string
	<primitive: 63>
	^super nextPutAll: string.! !


!StringWriteStream comment!
StringWriteStream is optimized for streaming over strings.

This is *much* faster than the ordinary WriteStream since the primitives avoid several levels of indirection necessary when dealing with ordinary collections.  StringWriteStreams will be created automatically when streaming over Strings.
! !


!StringWriteStream methodsFor: 'stream operations'!

nextPut: character
	<primitive: 62>
	^super nextPut: character.!

nextPutAll: string
	<primitive: 63>
	^super nextPutAll: string.! !


!Transcript methodsFor: 'initialization'!

initialize
	x := 0.! !


!Transcript methodsFor: 'displaying'!

nextPut: character
	^self nextPutAll: (String with: character).!

cr
	| window |
	window := Window.
	window
		scrollRectangleX: 0
		y: 8
		width: 160
		height: 160 - window fontHeight
		direction: 0
		distance: window fontHeight.
	window
		eraseRectangleX: 0
		y: 150 - window fontHeight
		width: 160
		height: window fontHeight
		rounded: 0.
	x := 0.!

nextPutAll: string
	| window |
	window := Window.
	window
		drawString: string
		x: x
		y: 150 - window fontHeight.
	x := x + (window widthOfString: string).! !


!Transcript class methodsFor: 'printing'!

cr
	^self current cr.!

nextPut: character
	^self current nextPut: character.!

nextPutAll: string
	^self current nextPutAll: string.!

print: object
	^self nextPutAll: object printString.!

display: object
	^self current nextPutAll: object displayString.!

show: object
	^self display: object.! !


!Transcript class methodsFor: 'accessing'!

current
	Current isNil ifTrue: [Current := self new].
	^Current.! !


!Transcript class methodsFor: 'instance creation'!

new
	^super new initialize.! !


!UndefinedObject comment!
UndefinedObject is the class of nil.! !


!UndefinedObject methodsFor: 'printing'!

printOn: stream
	stream nextPutAll: 'nil'.! !


!UndefinedObject methodsFor: 'system operations'!

orIfNil: block
	^block value.! !


!UndefinedObject methodsFor: 'predicates'!

isNil
	^true.!

notNil
	^false.! !


!UndefinedObject methodsFor: 'copying'!

shallowCopy
	^self.! !


!UndefinedObject class methodsFor: 'instance creation'!

new
	^self shouldNotImplement.! !


!Window class methodsFor: 'graphics functions'!

clearClip
	^self
		setClipX: 0
		y: 0
		width: 160
		height: 160.!

drawString: string x: x y: y
	"WARNING: Don't use this with very long strings (>= 100 chars) that may overrun the PadBuffer!!"
	| ptr |
	ptr := string copyToHeap: PadBuffer.
	SYSTRAP 
		WinDrawChars: ptr
		length: string size
		x: x
		y: y.
!

eraseRectangle: rectangle
	^self
		eraseRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: 0.
!

eraseRectangle: rectangle rounded: diameter
	^self
		eraseRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: diameter.!

eraseRectangleFrame: rectangle
	^self
		eraseRectangleFrameX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: 1.!

eraseRectangleFrame: rectangle frameType: frameType
	^self
		eraseRectangleFrameX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: frameType.!

fillPatternRectangle: rectangle
	^self
		fillPatternRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: 0.!

fillPatternRectangle: rectangle rounded: rounded
	^self
		fillPatternRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: rounded.!

fillRectangle: rectangle
	^self
		fillRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: 0.!

fillRectangle: rectangle rounded: rounded
	^self
		fillRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: rounded.!

invertRectangle: rectangle
	^self
		invertRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: 0.!

invertRectangle: rectangle rounded: diameter
	^self
		invertRectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		rounded: diameter.!

invertRectangleFrame: rectangle
	^self
		invertRectangleFrameX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: 1.!

invertRectangleFrame: rectangle frameType: frameType
	^self
		invertRectangleFrameX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: frameType.!

lineFrom: start to: stop
	^self
		lineX1: start x
		y1: start y
		x2: stop x
		y2: stop y.!

rectangle: rectangle
	^self
		rectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: 1.!

rectangle: rectangle frameType: frameType
	^self
		rectangleX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height
		frameType: frameType.!

setClip: rectangle
	^self
		setClipX: rectangle left
		y: rectangle top
		width: rectangle width
		height: rectangle height.!

drawString: string at: position
	^self
		drawString: string
		x: position x
		y: position y.!

erase
	SYSTRAP WinEraseWindow.!

eraseRectangleFrameX: x
y: y
width: width
height: height
frameType: frameType
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP
		WinEraseRectangleFrame: frameType
		rectangle: rect pointer.!

eraseRectangleX: x 
y: y 
width: width 
height: height 
rounded: rounded
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP 
		WinEraseRectangle: rect pointer 
		rounded: rounded.!

fillPatternRectangleX: x
y: y 
width: width 
height: height
rounded: rounded
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP 
		WinFillRectangle: rect pointer 
		rounded: rounded.!

fillRectangleX: x
y: y 
width: width 
height: height
rounded: rounded
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP 
		WinDrawRectangle: rect pointer 
		rounded: rounded.
!

fontHeight
	^SYSTRAP FntCharHeight.!

invertRectangleFrameX: x
y: y
width: width
height: height
frameType: frameType
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP
		WinInvertRectangleFrame: frameType
		rectangle: rect pointer.!

invertRectangleX: x
y: y 
width: width 
height: height
rounded: rounded
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP 
		WinInvertRectangle: rect pointer 
		rounded: rounded.!

lineX1: x1 y1: y1 x2: x2 y2: y2
	SYSTRAP
		WinDrawLine: x1
		y1: y1
		x2: x2
		y2: y2.!

rectangleX: x
y: y
width: width
height: height
	^self
		rectangleX: x
		y: y
		width: width
		height: height
		frameType: 1.!

rectangleX: x
y: y
width: width
height: height
frameType: frameType
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP
		WinDrawRectangleFrame: frameType
		rectangle: rect pointer.!

setClipX: x y: y width: width height: height
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP WinSetClip: rect pointer.!

widthOfString: string
	^SYSTRAP 
		FntCharsWidth: string "basicAddress"
		length: string size.!

makeCRectangleLeft: left
top: top
width: width
height: height
	| rect |
	rect := CRectangle buffer.
	rect
		left: left;
		top: top;
		width: width;
		height: height.
	^rect.!

setFillPattern: pattern
	| ptr |
	ptr := pattern copyToHeap: PadBuffer.
	SYSTRAP WinSetPattern: ptr.!

eraseLineX1: x1 y1: y1 x2: x2 y2: y2
	SYSTRAP
		WinEraseLine: x1
		y1: y1
		x2: x2
		y2: y2.!

eraseLineFrom: start to: stop
	^self
		eraseLineX1: start x
		y1: start y
		x2: stop x
		y2: stop y.!

scrollRectangleX: x 
y: y 
width: width 
height: height 
direction: direction
distance: distance
	| rect |
	rect := self
		makeCRectangleLeft: x
		top: y
		width: width
		height: height.
	SYSTRAP
		WinScrollRectangle: rect pointer
		direction: (direction bitShift: 8)
		distance: distance
		vacated: PadBuffer.!

font: fontID
	"Answers the old font ID."
	^SYSTRAP FntSetFont: (fontID bitShift: 8).! !


