'From etoys2.3 of 28 November 2007 [latest update: #1894] on 11 February 2008 at 10:57:01 pm'!
Exception subclass: #Abort
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Exceptions Kernel'!

!Abort methodsFor: 'as yet unclassified' stamp: 'ajh 3/24/2003 00:55'!
defaultAction
	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"

	UnhandledError signalForException: self! !
Object subclass: #AbstractEvent
	instanceVariableNames: 'item itemKind environment'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Change Notification'!

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:10'!
changeKind

	^self class changeKind! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:43'!
environmentAt: anItemKind

	(self itemKind = anItemKind) ifTrue: [^self item].
	^environment at: anItemKind ifAbsent: [nil]! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:20'!
eventSelector

	^self class eventSelectorBlock value: itemKind value: self changeKind! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:36'!
item: anItem kind: anItemKind

	item := anItem.
	itemKind := anItemKind.
	environment := Dictionary new! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:37'!
itemCategory: aCategory

	environment at: self class categoryKind put: aCategory! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:36'!
itemClass: aClass

	environment at: self class classKind put: aClass! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/14/2003 12:11'!
itemExpression: anExpression

	environment at: self class expressionKind put: anExpression! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:38'!
itemMethod: aMethod

	environment at: self class methodKind put: aMethod! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'rw 7/10/2003 12:38'!
itemProtocol: aProtocol

	environment at: self class protocolKind put: aProtocol! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'NS 1/27/2004 10:38'!
itemRequestor: requestor

	environment at: #requestor put: requestor! !

!AbstractEvent methodsFor: 'private-accessing' stamp: 'NS 1/27/2004 10:39'!
itemSelector: aSymbol

	environment at: #selector put: aSymbol! !


!AbstractEvent methodsFor: 'accessing' stamp: 'rw 6/30/2003 08:22'!
item
	"Return the item that triggered the event (typically the name of a class, a category, a protocol, a method)."

	^item! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:43'!
itemCategory

	^self environmentAt: self class categoryKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:43'!
itemClass

	^self environmentAt: self class classKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 7/14/2003 12:10'!
itemExpression

	^self environmentAt: self class expressionKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 6/30/2003 08:22'!
itemKind
	"Return the kind of the item of the event (#category, #class, #protocol, #method, ...)"

	^itemKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:44'!
itemMethod

	^self environmentAt: self class methodKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:44'!
itemProtocol

	^self environmentAt: self class protocolKind! !

!AbstractEvent methodsFor: 'accessing' stamp: 'NS 1/27/2004 10:38'!
itemRequestor

	^self environmentAt: #requestor! !

!AbstractEvent methodsFor: 'accessing' stamp: 'NS 1/27/2004 10:38'!
itemSelector

	^self environmentAt: #selector! !


!AbstractEvent methodsFor: 'printing' stamp: 'NS 1/19/2004 17:52'!
printOn: aStream

	self printEventKindOn: aStream.
	aStream
		nextPutAll: ' Event for item: ';
		print: self item;
		nextPutAll: ' of kind: ';
		print: self itemKind! !


!AbstractEvent methodsFor: 'testing' stamp: 'rw 6/30/2003 08:34'!
isAdded

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'NS 1/19/2004 18:41'!
isCategoryKnown

	^self itemCategory notNil! !

!AbstractEvent methodsFor: 'testing' stamp: 'rw 7/10/2003 15:01'!
isCommented

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'rw 7/14/2003 10:15'!
isDoIt

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'NS 1/19/2004 15:09'!
isModified

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'NS 1/21/2004 09:40'!
isProtocolKnown

	^self itemCategory notNil! !

!AbstractEvent methodsFor: 'testing' stamp: 'rw 7/1/2003 19:53'!
isRecategorized

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'rw 6/30/2003 08:34'!
isRemoved

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'rw 7/1/2003 11:35'!
isRenamed

	^false! !

!AbstractEvent methodsFor: 'testing' stamp: 'NS 1/27/2004 12:44'!
isReorganized
	^ false! !


!AbstractEvent methodsFor: 'triggering' stamp: 'rw 7/14/2003 17:06'!
trigger: anEventManager 
	"Trigger the event manager."

	anEventManager triggerEvent: self eventSelector with: self.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AbstractEvent class
	instanceVariableNames: ''!

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/19/2004 18:42'!
class: aClass
	^ self item: aClass kind: AbstractEvent classKind.! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/19/2004 18:42'!
class: aClass category: cat 
	| instance |
	instance := self class: aClass.
	instance itemCategory: cat.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'rw 7/9/2003 11:19'!
item: anItem kind: anItemKind

	^self basicNew item: anItem kind: anItemKind! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/16/2004 14:19'!
method: aMethod class: aClass

	| instance |
	instance := self item: aMethod kind: self methodKind.
	instance itemClass: aClass.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/16/2004 14:20'!
method: aMethod protocol: prot class: aClass

	| instance |
	instance := self method: aMethod class: aClass.
	instance itemProtocol: prot.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/27/2004 10:48'!
method: aMethod selector: aSymbol class: aClass

	| instance |
	instance := self item: aMethod kind: self methodKind.
	instance itemSelector: aSymbol.
	instance itemClass: aClass.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/27/2004 10:49'!
method: aMethod selector: aSymbol class: aClass requestor: requestor

	| instance |
	instance := self method: aMethod selector: aSymbol class: aClass.
	instance itemRequestor: requestor.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/27/2004 10:49'!
method: aMethod selector: aSymbol protocol: prot class: aClass

	| instance |
	instance := self method: aMethod selector: aSymbol class: aClass.
	instance itemProtocol: prot.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'NS 1/27/2004 10:50'!
method: aMethod selector: aSymbol protocol: prot class: aClass requestor: requestor

	| instance |
	instance := self method: aMethod selector: aSymbol protocol: prot class: aClass.
	instance itemRequestor: requestor.
	^instance! !

!AbstractEvent class methodsFor: 'instance creation' stamp: 'rw 6/30/2003 09:20'!
new
	"Override new to trigger an error, since we want to use specialized methods to create basic and higher-level events."

	^self error: 'Instances can only be created using specialized instance creation methods.'! !


!AbstractEvent class methodsFor: 'accessing' stamp: 'NS 1/16/2004 14:08'!
allChangeKinds
	"AbstractEvent allChangeKinds"

	^AbstractEvent allSubclasses collect: [:cl | cl changeKind]! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'bvs 7/20/2004 12:12'!
allItemKinds
	"self allItemKinds"

	^(AbstractEvent class organization listAtCategoryNamed: #'item kinds') 
		collect: [:sel | self perform: sel]! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:08'!
changeKind
	"Return a symbol, with a : as last character, identifying the change kind."

	self subclassResponsibility! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:18'!
eventSelectorBlock

	^[:itemKind :changeKind | itemKind, changeKind, 'Event:']! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:19'!
itemChangeCombinations

	^self supportedKinds collect: [:itemKind | self eventSelectorBlock value: itemKind value: self changeKind]! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'rw 7/10/2003 12:04'!
supportedKinds
	"All the kinds of items that this event can take. By default this is all the kinds in the system. But subclasses can override this to limit the choices. For example, the SuperChangedEvent only works with classes, and not with methods, instance variables, ..."

	^self allItemKinds! !

!AbstractEvent class methodsFor: 'accessing' stamp: 'rw 7/10/2003 11:39'!
systemEvents
	"Return all the possible events in the system. Make a cross product of 
	the items and the change types."
	"self systemEvents"

	^self allSubclasses
		inject: OrderedCollection new
		into: [:allEvents :eventClass | allEvents addAll: eventClass itemChangeCombinations; yourself]! !


!AbstractEvent class methodsFor: 'item kinds' stamp: 'rw 7/9/2003 11:12'!
categoryKind

	^#category! !

!AbstractEvent class methodsFor: 'item kinds' stamp: 'rw 7/9/2003 11:12'!
classKind

	^#class! !

!AbstractEvent class methodsFor: 'item kinds' stamp: 'rw 7/14/2003 11:41'!
expressionKind

	^#expression! !

!AbstractEvent class methodsFor: 'item kinds' stamp: 'rw 7/9/2003 11:12'!
methodKind

	^#method! !

!AbstractEvent class methodsFor: 'item kinds' stamp: 'rw 7/10/2003 12:36'!
protocolKind

	^#protocol! !


!AbstractEvent class methodsFor: 'temporary' stamp: 'rw 7/11/2003 10:23'!
comment1

"Smalltalk organization removeElement: #ClassForTestingSystemChanges3
Smalltalk garbageCollect 
Smalltalk organizati

classify:under:


SystemChangeNotifier uniqueInstance releaseAll
SystemChangeNotifier uniqueInstance noMoreNotificationsFor: aDependent.


aDependent := SystemChangeNotifierTest new.
SystemChangeNotifier uniqueInstance
	notifyOfAllSystemChanges: aDependent
	using: #event:

SystemChangeNotifier uniqueInstance classAdded: #Foo inCategory: #FooCat



| eventSource dependentObject |
eventSource := EventManager new.
dependentObject := Object new.

register - dependentObject becomes dependent:
eventSource
	when: #anEvent send: #error to: dependentObject.

unregister dependentObject:
eventSource removeDependent: dependentObject.

[eventSource triggerEvent: #anEvent]
	on: Error
	do: [:exc | self halt: 'Should not be!!']."! !

!AbstractEvent class methodsFor: 'temporary' stamp: 'rw 7/11/2003 10:24'!
comment2

"HTTPSocket useProxyServerNamed: 'proxy.telenet.be' port: 8080
TestRunner open

--------------------
We propose two orthogonal groups to categorize each event:
(1) the 'change type':
	added, removed, modified, renamed
	+ the composite 'changed' (see below for an explanation)
(2) the 'item type':
	class, method, instance variable, pool variable, protocol, category
	+ the composite 'any' (see below for an explanation).
The list of supported events is the cross product of these two lists (see below for an explicit enumeration of the events).

Depending on the change type, certain information related to the change is always present (for adding, the new things that was added, for removals, what was removed, for renaming, the old and the new name, etc.).

Depending on the item type, information regarding the item is present (for a method, which class it belongs to). 

Certain events 'overlap', for example, a method rename triggers a class change. To capture this I impose a hierarchy on the 'item types' (just put some numbers to clearly show the idea. They don't need numbers, really. Items at a certain categories are included by items one category number higher):
level 1 category
level 2 class
level 3 instance variable, pool variable, protocol, method.

Changes propagate according to this tree: any 'added', 'removed' or 'renamed' change type in level X triggers a 'changed' change type in level X - 1. A 'modified' change type does not trigger anything special.
For example, a method additions triggers a class modification. This does not trigger a category modification.

Note that we added 'composite events': wildcards for the 'change type' ('any' - any system additions) and for the 'item type' ('Changed' - all changes related to classes), and one for 'any change systemwide' (systemChanged).

This result is this list of Events:

classAdded
classRemoved
classModified
classRenamed (?)
classChanged (composite)

methodAdded
methodRemoved
methodModified
methodRenamed (?)
methodChanged (composite)

instanceVariableAdded
instanceVariableRemoved
instanceVariableModified 
instanceVariableRenamed (?)
instanceVariableChanged (composite)

protocolAdded
protocolRemoved
protocolModified
protocolRenamed (?)
protocolChanged (composite)

poolVariableAdded
poolVariableRemoved
poolVariableModified
poolVariableRenamed (?)
poolChanged (composite)

categoryAdded
categoryRemoved
categoryModified
categeryRenamed (?)
categoryChanged (composite)

anyAdded (composite)
anyRemoved (composite)
anyModified (composite)
anyRenamed (composite)

anyChanged (composite)



To check: can we pass somehow the 'source' of the change (a browser, a file-in, something else) ? Maybe by checking the context, but should not be too expensive either... I found this useful in some of my tools, but it might be too advanced to have in general. Tools that need this can always write code to check it for them.  But is not always simple...


Utilities (for the recent methods) and ChangeSet are the two main clients at this moment.

Important: make it very explicit that the event is send synchronously (or asynchronously, would we take that route).


					category
						class
							comment
							protocol
								method
OR
				category
				Smalltalk
					class
						comment
						protocol
						method
??



						Smalltalk	category
								\	/
								class
							/	  |	\
						comment  |	protocol
								  |	/
								method

"! !

!AbstractEvent class methodsFor: 'temporary' stamp: 'rw 7/11/2003 15:43'!
comment3

"Things to consider for trapping:
ClassOrganizer>>#changeFromCategorySpecs:
	Problem: I want to trap this to send the appropriate bunch of ReCategorization events, but ClassOrganizer instances do not know where they belong to (what class, or what system); it just uses symbols. So I cannot trigger the change, because not enough information is available. This is a conceptual problem: the organization is stand-alone implementation-wise, while conceptually it belongs to a class. The clean solution could be to reroute this message to a class, but this does not work for all of the senders (that would work from the browserm but not for the file-in).

Browser>>#categorizeAllUncategorizedMethods
	Problem: should be trapped to send a ReCategorization event. However, this is model code that should not be in the Browser. Clean solution is to move it out of there to the model, and then trap it there (or reroute it to one of the trapped places).

Note: Debugger>>#contents:notifying: recompiles methods when needed, so I trapped it to get updates. However, I need to find a way to write a unit test for this. Haven't gotten around yet for doing this though...
"! !

!AbstractEvent class methodsFor: 'temporary' stamp: 'sd 3/9/2004 19:42'!
saveChangeNotificationAsSARFileWithNumber: aNumber 
	"Use the SARBuilder package to output the SystemChangeNotification 
	stuff as a SAR file. Put this statement here so that I don't forget it 
	when moving between images :-)"
	"self saveChangeNotificationAsSARFileWithNumber: 6"

	| filename changesText readmeText dumper |
	filename := 'SystemchangeNotification'.
	dumper _ self class environment at: #SARChangeSetDumper ifAbsent: [ ^self ].
	changesText := 
'
0.6 Version for Squeak 3.7 (no longer for 3.6!!!!) Changed one hook method to make this version work in Squeak3.7. Download version 5 from http://www.iam.unibe.ch/~wuyts/SystemchangeNotification5.sar if you are working with Squeak 3.6.

0.5 Updated the safeguard mechanism so that clients with halts and errors do not stop all notifications. Added and updated new tests for this. If this interests you have a look at the class WeakActionSequenceTrappingErrors.

0.4 Ported to Squeak 3.6.

0.3 Added the hooks for instance variables (addition, removal and renaming). Refactored the tests.

0.2 Added hooks and tests for method removal and method recategorization.

0.1 First release'.
	readmeText :=
'Implements (part of) the system change notification mechanism. Clients that want to receive notifications about system changes should look at the category #public of the class SystemChangeNotifier, and the unit tests.

VERY IMPORTANT: This version is for Squeak 3.7 only. It will not work in Squeak version 3.6. Download and install the last version that worked in Squeak 3.6 (version 5) from the following URL: http://www.iam.unibe.ch/~wuyts/SystemchangeNotification5.sar'.

	(dumper
		on: Project current changeSet
		including: (ChangeSorter allChangeSetNames
				select: [:ea | 'SystemChangeHooks' match: ea])) changesText: changesText;
		 readmeText: readmeText;
		 fileOutAsZipNamed: filename , aNumber printString , '.sar'! !
Object subclass: #AbstractFont
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!AbstractFont commentStamp: '<historical>' prior: 0!
AbstractFont defines the generic interface that all fonts need to implement.!


!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:19'!
ascent

	self subclassResponsibility.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:18'!
ascentOf: aCharacter

	^ self ascent.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/2/2004 11:06'!
baseKern
	^0! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:18'!
basicAscentOf: aCharacter

	^ self ascent.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:19'!
basicDescentOf: aCharacter

	^ self descent.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:56'!
characterToGlyphMap
	"Return the character to glyph mapping table. If the table is not provided the character scanner will query the font directly for the width of each individual character."
	^nil! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 3/15/2004 18:57'!
derivativeFonts
	^#()! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:20'!
descent

	self subclassResponsibility.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'yo 1/7/2005 11:20'!
descentOf: aCharacter

	^ self descent.
! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:15'!
familyName
	"Answer the name to be used as a key in the TextConstants dictionary."
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:14'!
height
	"Answer the height of the receiver, total of maximum extents of 
	characters above and below the baseline."

	^self subclassResponsibility! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 5/26/2003 09:45'!
isRegular
	^false! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 8/31/2004 09:14'!
lineGrid
	"Answer the relative space between lines"

	^self subclassResponsibility! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/2/2004 11:33'!
pixelSize
	"Make sure that we don't return a Fraction"
	^ TextStyle pointsToPixels: self pointSize! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 4/1/2004 10:48'!
pointSize
	self subclassResponsibility.! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 7/11/2004 21:15'!
textStyle
	^ TextStyle actualTextStyles detect:
		[:aStyle | aStyle fontArray includes: self] ifNone: [ TextStyle fontArray: { self } ]! !

!AbstractFont methodsFor: 'accessing' stamp: 'nk 3/22/2004 15:15'!
textStyleName
	"Answer the name to be used as a key in the TextConstants dictionary."
	^self familyName! !

!AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:57'!
xTable
	"Return the xTable for the font. The xTable defines the left x-value for each individual glyph in the receiver. If such a table is not provided, the character scanner will ask the font directly for the appropriate width of each individual character."
	^nil! !


!AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) display context."
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'displaying' stamp: 'yo 1/7/2005 11:36'!
displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY
	"Draw the given string from startIndex to stopIndex 
	at aPoint on the (already prepared) display context."
	^self subclassResponsibility! !

!AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'!
installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
	"Install the receiver on the given DisplayContext (either BitBlt or Canvas) for further drawing operations."
	^self subclassResponsibility! !


!AbstractFont methodsFor: 'measuring' stamp: 'tak 1/11/2005 17:20'!
approxWidthOfText: aText
"Return the width of aText -- quickly, and a little bit dirty. Used by lists morphs containing Text objects to get a quick, fairly accurate measure of the width of a list item."

    | w |
    
    (aText isNil or: [aText size == 0 ])
        ifTrue:[^0].
       
    w _ self
        widthOfString: aText asString.

     "If the text has no emphasis, just return the string size.  If it is empasized, 
    just approximate the width by adding about 20% to the width"   
    (((aText runLengthFor: 1) == aText size)
        and: [(aText emphasisAt: 1) == 0 ])
            ifTrue:[^w]
            ifFalse:[ ^w * 6 // 5 ]. ! !

!AbstractFont methodsFor: 'measuring' stamp: 'sps 3/23/2004 15:50'!
widthOfStringOrText: aStringOrText
    aStringOrText ifNil:[^0].
    ^aStringOrText isText
        ifTrue:[self approxWidthOfText: aStringOrText ]
        ifFalse:[self widthOfString: aStringOrText ] ! !

!AbstractFont methodsFor: 'measuring' stamp: 'ar 12/31/2001 14:25'!
widthOfString: aString
	aString ifNil:[^0].
	^self widthOfString: aString from: 1 to: aString size.
"
	TextStyle default defaultFont widthOfString: 'zort' 21
"! !

!AbstractFont methodsFor: 'measuring' stamp: 'ar 12/31/2001 00:54'!
widthOfString: aString from: startIndex to: stopIndex
	"Measure the length of the given string between start and stop index"
	| character resultX |
	resultX _ 0.
	startIndex to: stopIndex do:[:i | 
		character _ aString at: i.
		resultX _ resultX + (self widthOf: character)].
	^resultX! !

!AbstractFont methodsFor: 'measuring' stamp: 'ar 5/19/2000 14:58'!
widthOf: aCharacter
	"Return the width of the given character"
	^self subclassResponsibility! !


!AbstractFont methodsFor: 'testing' stamp: 'yo 2/12/2007 19:34'!
isFontSet

	^ false.
! !

!AbstractFont methodsFor: 'testing' stamp: 'nk 6/25/2003 12:54'!
isTTCFont
	^false! !


!AbstractFont methodsFor: 'notifications' stamp: 'nk 4/2/2004 11:25'!
pixelsPerInchChanged
	"The definition of TextStyle class>>pixelsPerInch has changed. Do whatever is necessary."! !


!AbstractFont methodsFor: 'caching' stamp: 'nk 3/15/2004 18:47'!
releaseCachedState
	! !


!AbstractFont methodsFor: '*siss-private' stamp: 'yo 3/5/2007 11:31'!
sissIsLiteral

	^ true.
! !


!AbstractFont methodsFor: '*siss-interface' stamp: 'yo 3/5/2007 11:27'!
sissStoreString

	^ self fontNameWithPointSize, ' ', self emphasis asString! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AbstractFont class
	instanceVariableNames: ''!

!AbstractFont class methodsFor: 'as yet unclassified' stamp: 'nk 9/1/2004 11:41'!
emphasisStringFor: emphasisCode
	"Answer a translated string that represents the attributes given in emphasisCode."

	| emphases bit |
	emphasisCode = 0 ifTrue: [ ^'Normal' translated ].

	emphases := (IdentityDictionary new)
		at: 1 put: 'Bold' translated;
		at: 2 put: 'Italic' translated;
		at: 4 put: 'Underlined' translated;
		at: 8 put: 'Narrow' translated;
		at: 16 put: 'StruckOut' translated;
		yourself.

	bit := 1.
	^String streamContents: [ :s |
		[ bit < 32 ] whileTrue: [ | code |
			code := emphasisCode bitAnd: bit.
			code isZero ifFalse: [ s nextPutAll: (emphases at: code); space ].
			bit := bit bitShift: 1 ].
		s position isZero ifFalse: [ s skip: -1 ].
	]! !


!AbstractFont class methodsFor: '*siss-instance creation' stamp: 'yo 3/5/2007 11:57'!
sissCreateInstanceFromSexp: sexp idref: idref from: from to: to

	| stream space familyName size emphasisCode |
	stream := ReadStream on: (sexp attributeAt: #value).
	space := Character space.
	familyName := stream upTo: space.
	size := (stream upTo: space) asInteger.
	emphasisCode := (stream upTo: space) asInteger.
	^self familyName: familyName size: size emphasized: emphasisCode.
! !
Model subclass: #AbstractHierarchicalList
	instanceVariableNames: 'currentSelection myBrowser'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Explorer'!
!AbstractHierarchicalList commentStamp: '<historical>' prior: 0!
Contributed by Bob Arning as part of the ObjectExplorer package.
!


!AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 6/21/1999 15:22'!
genericMenu: aMenu

	aMenu add: 'no menu yet' target: self selector: #yourself.
	^aMenu! !

!AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:44'!
getCurrentSelection

	^currentSelection! !

!AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:46'!
noteNewSelection: x

	currentSelection _ x.
	self changed: #getCurrentSelection.
	currentSelection ifNil: [^self].
	currentSelection sendSettingMessageTo: self.
! !

!AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:53'!
perform: selector orSendTo: otherTarget
	"Selector was just chosen from a menu by a user.  If can respond, then
perform it on myself. If not, send it to otherTarget, presumably the
editPane from which the menu was invoked."

	(self respondsTo: selector)
		ifTrue: [^ self perform: selector]
		ifFalse: [^ otherTarget perform: selector]! !

!AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:47'!
update: aSymbol

	aSymbol == #hierarchicalList ifTrue: [
		^self changed: #getList
	].
	super update: aSymbol! !
Object subclass: #AbstractLauncher
	instanceVariableNames: 'parameters'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Support'!
!AbstractLauncher commentStamp: '<historical>' prior: 0!
The class AutoStart in combination with the Launcher classes provides a mechanism for starting Squeak from the command line or a web page. Parameters on the command line or in the embed tag in the web page a parsed and stored in the lauchner's parameter dictionary.
Subclasses can access these parameters to determine what to do.

CommandLineLauncherExample provides an example for a command line application. if you start squeak with a command line 'class Integer' it will launch a class browser on class Integer.
To enable this execute
CommandLineLauncherExample activate
before you save the image.
To disable execute
CommandLineLauncherExample deactivate

The PluginLauchner is an example how to use this framework to start Squeak as a browser plugin. It looks for a parameter 'src' which should point to a file containing a squeak script.!


!AbstractLauncher methodsFor: 'private' stamp: 'jm 8/20/1999 15:33'!
commandLine: aString
	"Start up this launcher from within Squeak as if it Squeak been launched the given command line."

	| dict tokens cmd arg |
	dict _ Dictionary new.
	tokens _ ReadStream on: (aString findTokens: ' ').
	[cmd _ tokens next.
	 arg _ tokens next.
	 ((cmd ~~ nil) and: [arg ~~ nil])]
		whileTrue: [dict at: cmd put: arg].
	self parameters: dict.
	self startUp.
! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 9/23/1999 13:18'!
determineParameterNameFrom: alternateParameterNames
	"Determine which of the given alternate parameter names is actually used."

	^alternateParameterNames detect: [:each | self includesParameter: each asUppercase] ifNone: [nil] ! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:35'!
includesParameter: parName
	"Return if the parameter named parName exists."
	^self parameters
		includesKey: parName asUppercase! !

!AbstractLauncher methodsFor: 'private' stamp: 'mdr 4/10/2001 10:50'!
numericParameterAtOneOf: alternateParameterNames ifAbsent: aBlock
	"Return the parameter named using one of the alternate names or an empty string"

	| parameterValue |
	parameterValue _ self parameterAtOneOf: alternateParameterNames.
	parameterValue isEmpty
		ifTrue: [^aBlock value].
	^[Number readFrom: parameterValue] ifError: aBlock 

! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 8/4/1999 14:19'!
parameterAt: parName
	"Return the parameter named parName or an empty string"
	^self
		parameterAt: parName
		ifAbsent: ['']! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:36'!
parameterAt: parName ifAbsent: aBlock
	"Return the parameter named parName.
	Evaluate the block if parameter does not exist."
	^self parameters
		at: parName asUppercase
		ifAbsent: [aBlock value]! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 9/23/1999 12:09'!
parameterAtOneOf: alternateParameterNames
	| parameterName |
	"Return the parameter named using one of the alternate names or an empty string"

	parameterName _ self determineParameterNameFrom: alternateParameterNames.
	^parameterName isNil
		ifTrue: ['']
		ifFalse: [self parameterAt: parameterName ifAbsent: ['']]! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:53'!
parameters
	parameters == nil
		ifTrue: [parameters _ self class extractParameters].
	^parameters! !

!AbstractLauncher methodsFor: 'private' stamp: 'mir 7/29/1999 10:21'!
parameters: startupParameters
	parameters _ startupParameters! !


!AbstractLauncher methodsFor: 'running' stamp: 'tk 10/24/2001 06:40'!
startUp
	"A backstop for subclasses.  Note that this is not a class message (most startUps are class messages)."

! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AbstractLauncher class
	instanceVariableNames: ''!

!AbstractLauncher class methodsFor: 'private' stamp: 'mir 8/4/1999 13:57'!
autoStarter
	^AutoStart! !

!AbstractLauncher class methodsFor: 'private' stamp: 'sd 9/30/2003 13:55'!
extractParameters
	
	^ SmalltalkImage current extractParameters! !


!AbstractLauncher class methodsFor: 'activation' stamp: 'mir 8/6/1999 18:14'!
activate
	"Register this launcher with the auto start class"

	self autoStarter addLauncher: self! !

!AbstractLauncher class methodsFor: 'activation'!
deactivate
	"Unregister this launcher with the auto start class"
	self autoStarter removeLauncher: self! !
RectangleMorph subclass: #AbstractMediaEventMorph
	instanceVariableNames: 'startTimeInScore endTimeInScore'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Demo'!
!AbstractMediaEventMorph commentStamp: '<historical>' prior: 0!
An abstract representation of media events to be placed in a PianoRollScoreMorph (or others as they are developed)!


!AbstractMediaEventMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/7/2000 12:58'!
endTime

	^endTimeInScore ifNil: [startTimeInScore + 100]! !


!AbstractMediaEventMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:36'!
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 1! !

!AbstractMediaEventMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:24'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color paleYellow! !

!AbstractMediaEventMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 21:38'!
initialize
	"initialize the state of the receiver"
	super initialize.
	""
	self layoutPolicy: TableLayout new;
	  listDirection: #leftToRight;
	  wrapCentering: #topLeft;
	  hResizing: #shrinkWrap;
	  vResizing: #shrinkWrap;
	  layoutInset: 2;
	  rubberBandCells: true! !


!AbstractMediaEventMorph methodsFor: '*sound-piano rolls' stamp: 'RAA 12/9/2000 18:45'!
justDroppedIntoPianoRoll: pianoRoll event: evt
	
	| ambientEvent |
	startTimeInScore _ pianoRoll timeForX: self left.

	ambientEvent _ AmbientEvent new 
		morph: self;
		time: startTimeInScore.

	pianoRoll score addAmbientEvent: ambientEvent.

	"self endTime > pianoRoll scorePlayer durationInTicks ifTrue:
		[pianoRoll scorePlayer updateDuration]"
! !
Object subclass: #AbstractScoreEvent
	instanceVariableNames: 'time'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sound-Scores'!
!AbstractScoreEvent commentStamp: '<historical>' prior: 0!
Abstract class for timed events in a MIDI score.
!


!AbstractScoreEvent methodsFor: 'accessing' stamp: 'di 6/17/1999 14:28'!
adjustTimeBy: delta

	time _ time + delta
! !

!AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 8/27/1998 16:38'!
endTime
	"Subclasses should override to return the ending time if the event has some duration."

	^ time
! !

!AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 12/31/97 11:43'!
time

	^ time
! !

!AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 12/31/97 11:43'!
time: aNumber

	time _ aNumber.
! !


!AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'!
isControlChange

	^ false
! !

!AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 12/31/97 11:46'!
isNoteEvent

	^ false
! !

!AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'!
isPitchBend

	^ false
! !

!AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'!
isProgramChange

	^ false
! !

!AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 12/31/97 11:46'!
isTempoEvent

	^ false
! !


!AbstractScoreEvent methodsFor: 'midi' stamp: 'jm 9/10/1998 18:31'!
outputOnMidiPort: aMidiPort
	"Output this event to the given MIDI port. This default implementation does nothing."
! !
Object subclass: #AbstractSound
	instanceVariableNames: 'envelopes mSecsSinceStart samplesUntilNextControl scaledVol scaledVolIncr scaledVolLimit'
	classVariableNames: 'FloatScaleFactor MaxScaledValue PitchesForBottomOctave ScaleFactor Sounds TopOfBottomOctave UnloadedSnd'
	poolDictionaries: ''
	category: 'Sound-Synthesis'!

!AbstractSound methodsFor: 'initialization' stamp: 'jm 12/9/97 11:31'!
duration: seconds
	"Scale my envelopes to the given duration. Subclasses overriding this method should include a resend to super."

	envelopes do: [:e | e duration: seconds].
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 2/4/98 09:54'!
initialize

	envelopes _ #().
	mSecsSinceStart _ 0.
	samplesUntilNextControl _ 0.
	scaledVol _ (1.0 * ScaleFactor) rounded.
	scaledVolIncr _ 0.
	scaledVolLimit _ scaledVol.
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 3/24/1999 12:03'!
loudness: aNumber
	"Initialize my volume envelopes and initial volume. Subclasses overriding this method should include a resend to super."

	| vol |
	vol _ (aNumber asFloat max: 0.0) min: 1.0.
	envelopes do: [:e |
		(e isKindOf: VolumeEnvelope) ifTrue: [e scale: vol]].
	self initialVolume: vol.
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 7/6/1998 17:04'!
nameOrNumberToPitch: aStringOrNumber
	"Answer the pitch in cycles/second for the given pitch specification. The specification can be either a numeric pitch or pitch name such as 'c4'."

	aStringOrNumber isNumber
		ifTrue: [^ aStringOrNumber asFloat]
		ifFalse: [^ AbstractSound pitchForName: aStringOrNumber]
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 8/19/1998 08:45'!
setPitch: pitchNameOrNumber dur: d loudness: l
	"Initialize my envelopes for the given parameters. Subclasses overriding this method should include a resend to super."

	| p |
	p _ self nameOrNumberToPitch: pitchNameOrNumber.
	envelopes do: [:e |
		e volume: l.
		e centerPitch: p].
	self initialVolume: l.
	self duration: d.
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 8/3/1998 17:11'!
soundForMidiKey: midiKey dur: d loudness: l
	"Answer an initialized sound object (a copy of the receiver) that generates a note for the given MIDI key (in the range 0..127), duration (in seconds), and loudness (in the range 0.0 to 1.0)."

	^ self copy
		setPitch: (AbstractSound pitchForMIDIKey: midiKey)
		dur: d
		loudness: l
! !

!AbstractSound methodsFor: 'initialization' stamp: 'jm 8/3/1998 16:58'!
soundForPitch: pitchNameOrNumber dur: d loudness: l
	"Answer an initialized sound object (a copy of the receiver) that generates a note of the given pitch, duration, and loudness. Pitch may be a numeric pitch or a string pitch name such as 'c4'. Duration is in seconds and loudness is in the range 0.0 to 1.0."

	^ self copy setPitch: pitchNameOrNumber dur: d loudness: l
! !


!AbstractSound methodsFor: 'accessing' stamp: 'sw 12/20/2006 04:17'!
durationInMilliseconds
	"Answer the duration in milliseconds."

	^ self duration * 1000! !

!AbstractSound methodsFor: 'accessing' stamp: 'tak 4/23/2007 20:43'!
isCompressed
	^ false! !

!AbstractSound methodsFor: 'accessing' stamp: 'jm 12/16/2001 22:34'!
isStereo
	"Answer true if this sound has distinct left and right channels. (Every sound plays into a stereo sample buffer, but most sounds, which produce exactly the same samples on both channels, are not stereo.)"

	^ false
! !


!AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/15/97 14:15'!
controlRate
	"Answer the number of control changes per second."

	^ 100
! !

!AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/16/2001 13:14'!
originalSamplingRate
	"For sampled sounds, answer the sampling rate used to record the stored samples. For other sounds, this is the same as the playback sampling rate."

	^ SoundPlayer samplingRate
! !

!AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/17/97 18:00'!
samplingRate
	"Answer the sampling rate in samples per second."

	^ SoundPlayer samplingRate
! !


!AbstractSound methodsFor: 'copying' stamp: 'jm 12/15/97 19:15'!
copy
	"A sound should copy all of the state needed to play itself, allowing two copies of a sound to play at the same time. These semantics require a recursive copy but only down to the level of immutable data. For example, a SampledSound need not copy its sample buffer. Subclasses overriding this method should include a resend to super."

	^ self clone copyEnvelopes
! !

!AbstractSound methodsFor: 'copying' stamp: 'jm 12/17/97 22:22'!
copyEnvelopes
	"Private!! Support for copying. Copy my envelopes."

	envelopes _ envelopes collect: [:e | e copy target: self].
! !

!AbstractSound methodsFor: 'copying' stamp: 'di 3/4/1999 21:29'!
sounds
	"Allows simple sounds to behave as, eg, sequential sounds"

	^ Array with: self! !


!AbstractSound methodsFor: 'conversion' stamp: 'jm 12/16/2001 13:26'!
asSampledSound
	"Answer a SampledSound containing my samples. If the receiver is some kind of sampled sound, the resulting SampledSound will have the same original sampling rate as the receiver."

	^ SampledSound samples: self samples samplingRate: self originalSamplingRate
! !


!AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/17/97 22:23'!
addEnvelope: anEnvelope
	"Add the given envelope to my envelopes list."

	anEnvelope target: self.
	envelopes _ envelopes copyWith: anEnvelope.
! !

!AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/15/97 17:02'!
envelopes
	"Return my collection of envelopes."

	^ envelopes
! !

!AbstractSound methodsFor: 'envelopes' stamp: 'jm 8/18/1998 09:57'!
removeAllEnvelopes
	"Remove all envelopes from my envelopes list."

	envelopes _ #().
! !

!AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/15/97 17:02'!
removeEnvelope: anEnvelope
	"Remove the given envelope from my envelopes list."

	envelopes _ envelopes copyWithout: anEnvelope.
! !


!AbstractSound methodsFor: 'volume' stamp: 'RAA 8/11/2000 11:51'!
adjustVolumeTo: vol overMSecs: mSecs
	"Adjust the volume of this sound to the given volume, a number in the range [0.0..1.0], over the given number of milliseconds. The volume will be changed a little bit on each sample until the desired volume is reached."

	| newScaledVol |

	self flag: #bob.		"I removed the upper limit to allow making sounds louder. hmm..."

	newScaledVol _ (32768.0 * vol) truncated.
	newScaledVol = scaledVol ifTrue: [^ self].
	scaledVolLimit _ newScaledVol.
	"scaledVolLimit > ScaleFactor ifTrue: [scaledVolLimit _ ScaleFactor]."
	scaledVolLimit < 0 ifTrue: [scaledVolLimit _ 0].
	mSecs = 0
		ifTrue: [  "change immediately"
			scaledVol _ scaledVolLimit.
			scaledVolIncr _ 0]
		ifFalse: [
			scaledVolIncr _
				((scaledVolLimit - scaledVol) * 1000) // (self samplingRate * mSecs)].
! !

!AbstractSound methodsFor: 'volume' stamp: 'jm 12/17/97 17:39'!
initialVolume: vol
	"Set the initial volume of this sound to the given volume, a number in the range [0.0..1.0]."

	scaledVol _ (((vol asFloat min: 1.0) max: 0.0) * ScaleFactor) rounded.
	scaledVolLimit _ scaledVol.
	scaledVolIncr _ 0.
! !

!AbstractSound methodsFor: 'volume' stamp: 'jm 8/13/1998 16:37'!
loudness
	"Answer the current volume setting for this sound."

	^ scaledVol asFloat / ScaleFactor asFloat! !

!AbstractSound methodsFor: 'volume' stamp: 'jm 8/13/1998 16:28'!
volumeEnvelopeScaledTo: scalePoint
	"Return a collection of values representing my volume envelope scaled by the given point. The scale point's x component is pixels/second and its y component is the number of pixels for full volume."

	self error: 'not yet implemented'.
! !


!AbstractSound methodsFor: 'playing' stamp: 'jm 1/26/98 22:05'!
computeSamplesForSeconds: seconds
	"Compute the samples of this sound without outputting them, and return the resulting buffer of samples."

	| buf |
	self reset.
	buf _ SoundBuffer newStereoSampleCount: (self samplingRate * seconds) asInteger.
	self playSampleCount: buf stereoSampleCount into: buf startingAt: 1.
	^ buf
! !

!AbstractSound methodsFor: 'playing' stamp: 'ar 12/5/1998 22:20'!
isPlaying
	"Return true if the receiver is currently playing"
	^ SoundPlayer isPlaying: self! !

!AbstractSound methodsFor: 'playing' stamp: 'di 5/30/1999 12:46'!
millisecondsSinceStart

	^ mSecsSinceStart! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 8/24/97 20:48'!
pause
	"Pause this sound. It can be resumed from this point, or reset and resumed to start from the beginning."

	SoundPlayer pauseSound: self.! !

!AbstractSound methodsFor: 'playing' stamp: 'gk 2/24/2004 22:23'!
play
	"Play this sound to the sound output port in real time."

	SoundPlayer playSound: self.! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 8/13/1998 15:09'!
playAndWaitUntilDone
	"Play this sound to the sound ouput port and wait until it has finished playing before returning."

	SoundPlayer playSound: self.
	[self samplesRemaining > 0] whileTrue.
	(Delay forMilliseconds: 2 * SoundPlayer bufferMSecs) wait.  "ensure last buffer has been output"
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 8/18/1998 10:52'!
playChromaticRunFrom: startPitch to: endPitch
	"Play a fast chromatic run between the given pitches. Useful for auditioning a sound."

	(AbstractSound chromaticRunFrom: startPitch to: endPitch on: self) play.
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 8/13/1998 16:17'!
playSampleCount: n into: aSoundBuffer startingAt: startIndex
	"Mix the next n samples of this sound into the given buffer starting at the given index. Update the receiver's control parameters periodically."

	| fullVol samplesBetweenControlUpdates pastEnd i remainingSamples count |
	fullVol _ AbstractSound scaleFactor.
	samplesBetweenControlUpdates _ self samplingRate // self controlRate.
	pastEnd _ startIndex + n.  "index just after the last sample"
	i _ startIndex.
	[i < pastEnd] whileTrue: [
		remainingSamples _ self samplesRemaining.
		remainingSamples <= 0 ifTrue: [^ self].
		count _ pastEnd - i.
		samplesUntilNextControl < count ifTrue: [count _ samplesUntilNextControl].
		remainingSamples < count ifTrue: [count _ remainingSamples].
		self mixSampleCount: count into: aSoundBuffer startingAt: i leftVol: fullVol rightVol: fullVol.
		samplesUntilNextControl _ samplesUntilNextControl - count.
		samplesUntilNextControl <= 0 ifTrue: [
			self doControl.
			samplesUntilNextControl _ samplesBetweenControlUpdates].
		i _ i + count].
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 7/5/1998 17:53'!
playSilently
	"Compute the samples of this sound without outputting them. Used for performance analysis."

	| bufSize buf |
	self reset.
	bufSize _ self samplingRate // 10.
	buf _ SoundBuffer newStereoSampleCount: bufSize.
	[self samplesRemaining > 0] whileTrue: [
		buf primFill: 0.
		self playSampleCount: bufSize into: buf startingAt: 1].
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 1/26/98 22:06'!
playSilentlyUntil: startTime
	"Compute the samples of this sound without outputting them. Used to fast foward to a particular starting time. The start time is given in seconds."

	| buf startSample nextSample samplesRemaining n |
	self reset.
	buf _ SoundBuffer newStereoSampleCount: (self samplingRate // 10).
	startSample _ (startTime * self samplingRate) asInteger.
	nextSample _ 1.
	[self samplesRemaining > 0] whileTrue: [
		nextSample >= startSample ifTrue: [^ self].
		samplesRemaining _ startSample - nextSample.
		samplesRemaining > buf stereoSampleCount
			ifTrue: [n _ buf stereoSampleCount]
			ifFalse: [n _ samplesRemaining].
		self playSampleCount: n into: buf startingAt: 1.
		nextSample _ nextSample + n].
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 3/4/98 13:16'!
resumePlaying
	"Resume playing this sound from where it last stopped."

	SoundPlayer resumePlaying: self.
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 12/16/2001 13:22'!
samples
	"Answer a monophonic sample buffer containing my samples. The left and write channels are merged."
	"Warning: This may require a lot of memory!!"

	^ (self computeSamplesForSeconds: self duration) mergeStereo
! !

!AbstractSound methodsFor: 'playing' stamp: 'jm 12/16/2001 13:24'!
viewSamples
	"Open a WaveEditor on my samples."

	WaveEditor openOn: self samples.
! !


!AbstractSound methodsFor: 'sound generation' stamp: 'jm 8/17/1998 13:34'!
doControl
	"Update the control parameters of this sound using its envelopes, if any."
	"Note: This is only called at a small fraction of the sampling rate."

	| pitchModOrRatioChange |
	envelopes size > 0 ifTrue: [
		pitchModOrRatioChange _ false.
		1 to: envelopes size do: [:i |
			((envelopes at: i) updateTargetAt: mSecsSinceStart)
				ifTrue: [pitchModOrRatioChange _ true]].
		pitchModOrRatioChange ifTrue: [self internalizeModulationAndRatio]].
	mSecsSinceStart _ mSecsSinceStart + (1000 // self controlRate).
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 2/4/98 08:56'!
internalizeModulationAndRatio
	"Overridden by FMSound. This default implementation does nothing."
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 7/6/1998 06:40'!
mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol
	"Mix the given number of samples with the samples already in the given buffer starting at the given index. Assume that the buffer size is at least (index + count) - 1. The leftVol and rightVol parameters determine the volume of the sound in each channel, where 0 is silence and ScaleFactor is full volume."

	self subclassResponsibility.
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 8/17/1998 13:45'!
reset
	"Reset my internal state for a replay. Methods that override this method should do super reset."

	mSecsSinceStart _ 0.
	samplesUntilNextControl _ 0.
	envelopes size > 0 ifTrue: [
		1 to: envelopes size do: [:i | (envelopes at: i) reset]].
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 12/17/97 17:57'!
samplesRemaining
	"Answer the number of samples remaining until the end of this sound. A sound with an indefinite ending time should answer some large integer such as 1000000."

	^ 1000000
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 9/9/1998 21:56'!
stopAfterMSecs: mSecs
	"Terminate this sound this note after the given number of milliseconds. This default implementation does nothing."
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 9/9/1998 21:54'!
stopGracefully
	"End this note with a graceful decay. If the note has envelopes, determine the decay time from its envelopes."

	| decayInMs env |
	envelopes isEmpty
		ifTrue: [
			self adjustVolumeTo: 0 overMSecs: 10.
			decayInMs _ 10]
		ifFalse: [
			env _ envelopes first.
			decayInMs _ env attackTime + env decayTime].
	self duration: (mSecsSinceStart + decayInMs) / 1000.0.
	self stopAfterMSecs: decayInMs.
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 1/5/98 14:21'!
storeSample: sample in: aSoundBuffer at: sliceIndex leftVol: leftVol rightVol: rightVol
	"This method is provided for documentation. To gain 10% more speed when running sound generation in Smalltalk, this method is hand-inlined into all sound generation methods that use it."

	| i s |
		leftVol > 0 ifTrue: [
			i _ (2 * sliceIndex) - 1.
			s _ (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor).
			s >  32767 ifTrue: [s _  32767].  "clipping!!"
			s < -32767 ifTrue: [s _ -32767].  "clipping!!"
			aSoundBuffer at: i put: s].
		rightVol > 0 ifTrue: [
			i _ 2 * sliceIndex.
			s _ (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor).
			s >  32767 ifTrue: [s _  32767].  "clipping!!"
			s < -32767 ifTrue: [s _ -32767].  "clipping!!"
			aSoundBuffer at: i put: s].
! !

!AbstractSound methodsFor: 'sound generation' stamp: 'jm 12/17/97 17:57'!
updateVolume
	"Increment the volume envelope of this sound. To avoid clicks, the volume envelope must be interpolated at the sampling rate, rather than just at the control rate like other envelopes. At the control rate, the volume envelope computes the slope and next target volume volume for the current segment of the envelope (i.e., it sets the rate of change for the volume parameter). When that target volume is reached, incrementing is stopped until a new increment is set."
	"This method is provided for documentation. To gain 10% more speed when running sound generation in Smalltalk, it is hand-inlined into all sound generation methods that use it."

		scaledVolIncr ~= 0 ifTrue: [
			scaledVol _ scaledVol + scaledVolIncr.
			((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or:
			 [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]])
				ifTrue: [  "reached the limit; stop incrementing"
					scaledVol _ scaledVolLimit.
					scaledVolIncr _ 0]].
! !


!AbstractSound methodsFor: 'composition'!
+ aSound
	"Return the mix of the receiver and the argument sound."

	^ MixedSound new
		add: self;
		add: aSound
! !

!AbstractSound methodsFor: 'composition'!
, aSound
	"Return the concatenation of the receiver and the argument sound."

	^ SequentialSound new
		add: self;
		add: aSound
! !

!AbstractSound methodsFor: 'composition' stamp: 'jm 2/2/1999 15:53'!
asSound

	^ self
! !

!AbstractSound methodsFor: 'composition' stamp: 'jm 12/17/97 18:00'!
delayedBy: seconds
	"Return a composite sound consisting of a rest for the given amount of time followed by the receiver."

	^ (RestSound dur: seconds), self
! !


!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 21:51'!
storeAIFFOnFileNamed: fileName
	"Store this sound as a AIFF file of the given name."

	| f |
	f _ (FileStream fileNamed: fileName) binary.
	self storeAIFFSamplesOn: f.
	f close.
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:31'!
storeAIFFSamplesOn: aBinaryStream
	"Store this sound as a 16-bit AIFF file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound."

	| samplesToStore channelCount dataByteCount |
	samplesToStore _ (self duration * self samplingRate) ceiling.
	channelCount _ self isStereo ifTrue: [2] ifFalse: [1].
	dataByteCount _ samplesToStore * channelCount * 2.

	"write AIFF file header:"
	aBinaryStream nextPutAll: 'FORM' asByteArray.
	aBinaryStream nextInt32Put: ((7 * 4) + 18) + dataByteCount.
	aBinaryStream nextPutAll: 'AIFF' asByteArray.
	aBinaryStream nextPutAll: 'COMM' asByteArray.
	aBinaryStream nextInt32Put: 18.
	aBinaryStream nextNumber: 2 put: channelCount.
	aBinaryStream nextInt32Put: samplesToStore.
	aBinaryStream nextNumber: 2 put: 16.  "bits/sample"
	self storeExtendedFloat: self samplingRate on: aBinaryStream.
	aBinaryStream nextPutAll: 'SSND' asByteArray.
	aBinaryStream nextInt32Put: dataByteCount + 8.
	aBinaryStream nextInt32Put: 0.
	aBinaryStream nextInt32Put: 0.

	"write data:"
	self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream.
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 3/13/1999 11:34'!
storeExtendedFloat: aNumber on: aBinaryStream
	"Store an Apple extended-precision 80-bit floating point number on the given stream."
	"Details: I could not find the specification for this format, so constants were determined empirically based on assumption of 1-bit sign, 15-bit exponent, 64-bit mantissa. This format does not seem to have an implicit one before the mantissa as some float formats do."

	| n isNeg exp mantissa |
	n _ aNumber asFloat.
	isNeg _ false.
	n < 0.0 ifTrue: [
		n _ 0.0 - n.
		isNeg _ true].
	exp _ (n log: 2.0) ceiling.
	mantissa _ (n * (2 raisedTo: 64 - exp)) truncated.
	exp _ exp + 16r4000 - 2.  "not sure why the -2 is needed..."
	isNeg ifTrue: [exp _ exp bitOr: 16r8000].  "set sign bit"
	aBinaryStream nextPut: ((exp bitShift: -8) bitAnd: 16rFF).
	aBinaryStream nextPut: (exp bitAnd: 16rFF).
	8 to: 1 by: -1 do: [:i | aBinaryStream nextPut: (mantissa digitAt: i)].
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'sd 9/30/2003 13:41'!
storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream
	"Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file."

	| bufSize stereoBuffer reverseBytes remaining out |
	self reset.
	bufSize _ (2 * self samplingRate rounded) min: samplesToStore.  "two second buffer"
	stereoBuffer _ SoundBuffer newStereoSampleCount: bufSize.
	reverseBytes _ bigEndianFlag ~= (SmalltalkImage current isBigEndian).

	'Storing audio...' displayProgressAt: Sensor cursorPoint
		from: 0 to: samplesToStore during: [:bar |
			remaining _ samplesToStore.
			[remaining > 0] whileTrue: [
				bar value: samplesToStore - remaining.
				stereoBuffer primFill: 0.  "clear the buffer"
				self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1.
				self isStereo
					ifTrue: [out _ stereoBuffer]
					ifFalse: [out _ stereoBuffer extractLeftChannel].
				reverseBytes ifTrue: [out reverseEndianness].
				(aBinaryStream isKindOf: StandardFileStream)
					ifTrue: [  "optimization for files: write sound buffer directly to file"
						aBinaryStream next: (out size // 2) putAll: out startingAt: 1]  "size in words"
					ifFalse: [  "for non-file streams:"
						1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]].
				remaining _ remaining - bufSize]].
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 21:47'!
storeSunAudioOnFileNamed: fileName
	"Store this sound as an uncompressed Sun audio file of the given name."

	| f |
	f _ (FileStream fileNamed: fileName) binary.
	self storeSunAudioSamplesOn: f.
	f close.
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:32'!
storeSunAudioSamplesOn: aBinaryStream
	"Store this sound as a 16-bit Sun audio file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound."


	| samplesToStore channelCount dataByteCount |
	samplesToStore _ (self duration * self samplingRate) ceiling.
	channelCount _ self isStereo ifTrue: [2] ifFalse: [1].
	dataByteCount _ samplesToStore * channelCount * 2.

	"write Sun audio file header"
	channelCount _ self isStereo ifTrue: [2] ifFalse: [1].
	aBinaryStream nextPutAll: '.snd' asByteArray.
	aBinaryStream uint32: 24.	"header size in bytes"
	aBinaryStream uint32: dataByteCount.
	aBinaryStream uint32: 3.	"format: 16-bit linear"
	aBinaryStream uint32: self samplingRate truncated.
	aBinaryStream uint32: channelCount.

	"write data:"
	self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream.
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 20:03'!
storeWAVOnFileNamed: fileName
	"Store this sound as a 16-bit Windows WAV file of the given name."

	| f |
	f _ (FileStream fileNamed: fileName) binary.
	self storeWAVSamplesOn: f.
	f close.
! !

!AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:32'!
storeWAVSamplesOn: aBinaryStream
	"Store this sound as a 16-bit Windows WAV file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound."

	| samplesToStore channelCount dataByteCount samplesPerSec bytesPerSec |
	samplesToStore _ (self duration * self samplingRate) ceiling.
	channelCount _ self isStereo ifTrue: [2] ifFalse: [1].
	dataByteCount _ samplesToStore * channelCount * 2.
	samplesPerSec _ self samplingRate rounded.
	bytesPerSec _ samplesPerSec * channelCount * 2.

	"file header"
	aBinaryStream
		nextPutAll: 'RIFF' asByteArray;
		nextLittleEndianNumber: 4 put: dataByteCount + 36;	"total length of all chunks"
		nextPutAll: 'WAVE' asByteArray.

	"format chunk"
	aBinaryStream
		nextPutAll: 'fmt ' asByteArray;
		nextLittleEndianNumber: 4 put: 16;	"length of this chunk"
		nextLittleEndianNumber: 2 put: 1;	"format tag"
		nextLittleEndianNumber: 2 put: channelCount;
		nextLittleEndianNumber: 4 put: samplesPerSec;
		nextLittleEndianNumber: 4 put: bytesPerSec;
		nextLittleEndianNumber: 2 put: 4;	"alignment"
		nextLittleEndianNumber: 2 put: 16.	"bits per sample"

	"data chunk"
	aBinaryStream
		nextPutAll: 'data' asByteArray;
		nextLittleEndianNumber: 4 put: dataByteCount.  "length of this chunk"

	self storeSampleCount: samplesToStore bigEndian: false on: aBinaryStream.
! !


!AbstractSound methodsFor: 'as yet unclassified' stamp: 'sw 7/24/2007 15:46'!
codecSignature
	"Backstop..."

	^ nil! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AbstractSound class
	instanceVariableNames: ''!

!AbstractSound class methodsFor: 'class initialization' stamp: 'jm 8/3/1998 16:13'!
initialize
	"AbstractSound initialize"
 
	| bottomC |
	ScaleFactor _ 2 raisedTo: 15.
	FloatScaleFactor _ ScaleFactor asFloat.
	MaxScaledValue _ ((2 raisedTo: 31) // ScaleFactor) - 1.  "magnitude of largest scaled value in 32-bits"

	"generate pitches for c-1 through c0"
	bottomC _ (440.0 / 32) * (2.0 raisedTo: -9.0 / 12.0).
	PitchesForBottomOctave _ (0 to: 12) collect: [:i | bottomC * (2.0 raisedTo: i asFloat / 12.0)].
	TopOfBottomOctave _ PitchesForBottomOctave last.
! !

!AbstractSound class methodsFor: 'class initialization' stamp: 'jm 1/5/98 13:51'!
scaleFactor

	^ ScaleFactor
! !


!AbstractSound class methodsFor: 'instance creation' stamp: 'jm 1/5/98 17:40'!
default
	"Return a default sound prototype for this class, with envelopes if appropriate. (This is in contrast to new, which returns a raw instance without envelopes.)"

	^ self new
! !

!AbstractSound class methodsFor: 'instance creation' stamp: 'jm 12/17/97 17:26'!
dur: d
	"Return a rest of the given duration."

	^ self basicNew setDur: d
! !

!AbstractSound class methodsFor: 'instance creation' stamp: 'jm 8/3/1998 17:00'!
noteSequenceOn: aSound from: anArray
	"Build a note sequence (i.e., a SequentialSound) from the given array using the given sound as the instrument. Elements are either (pitch, duration, loudness) triples or (#rest duration) pairs.  Pitches can be given as names or as numbers."
	| score pitch |
	score _ SequentialSound new.
	anArray do: [:el |
		el size = 3
			ifTrue: [
				pitch _ el at: 1.
				pitch isNumber ifFalse: [pitch _ self pitchForName: pitch].
				score add: (
					aSound
						soundForPitch: pitch
						dur: (el at: 2)
						loudness: (el at: 3) / 1000.0)]
			ifFalse: [
				score add: (RestSound dur: (el at: 2))]].
	^ score
! !

!AbstractSound class methodsFor: 'instance creation' stamp: 'jm 12/17/97 17:27'!
pitch: p dur: d loudness: l
	"Return a new sound object for a note with the given parameters."

	^ self new setPitch: p dur: d loudness: l
! !


!AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:50'!
busySignal: count
	"AbstractSound busySignal: 3"
	| m s |
	s _ SequentialSound new.
	m _ MixedSound new.
	m	add: (FMSound new setPitch: 480 dur: 0.5 loudness: 0.5);
		add: (FMSound new setPitch: 620 dur: 0.5 loudness: 0.5).
	s add: m.
	s add: (FMSound new setPitch: 1 dur: 0.5 loudness: 0).
	^ (RepeatingSound repeat: s count: count) play.

! !

!AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:56'!
dial: aString
	| index lo hi m s |
	"AbstractSound dial: '867-5309'" "ask for Jenny"

	s _ SequentialSound new.
	aString do: [ :c |
		c = $,
			ifTrue: [ s add: (FMSound new setPitch: 1 dur: 1 loudness: 0) ]
			ifFalse: [
				(index _ ('123A456B789C*0#D' indexOf: c)) > 0
					ifTrue: [
						lo _ #(697 770 852 941) at: (index - 1 // 4 + 1).
						hi _ #(1209 1336 1477 1633) at: (index - 1 \\ 4 + 1).
						m _ MixedSound new.
						m add: (FMSound new setPitch: lo dur: 0.15 loudness: 0.5).
						m add: (FMSound new setPitch: hi dur: 0.15 loudness: 0.5).
						s add: m.
						s add: (FMSound new setPitch: 1 dur: 0.05 loudness: 0)]]].
	^ s play.

! !

!AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:49'!
dialTone: duration
	"AbstractSound dialTone: 2"
	| m |
	m _ MixedSound new.
	m add: (FMSound new setPitch: 350 dur: duration loudness: 0.5).
	m add: (FMSound new setPitch: 440 dur: duration loudness: 0.5).
	m play.
	^ m! !

!AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:50'!
hangUpWarning: count
	"AbstractSound hangUpWarning: 20"
	| m s |
	s _ SequentialSound new.
	m _ MixedSound new.
	m	add: (FMSound new setPitch: 1400 dur: 0.1 loudness: 0.5);
		add: (FMSound new setPitch: 2060 dur: 0.1 loudness: 0.5).
	s add: m; add: (FMSound new setPitch: 1 dur: 0.1 loudness: 0).
	^ (RepeatingSound repeat: s count: count) play

! !

!AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:16'!
indexOfBottomOctavePitch: p
	"Answer the index of the first pitch in the bottom octave equal to or higher than the given pitch. Assume that the given pitch is below the top pitch of the bottom octave."

	1 to: PitchesForBottomOctave size do: [:i |
		(PitchesForBottomOctave at: i) >= p ifTrue: [^ i]].
	self error: 'implementation error: argument pitch should be below or within the bottom octave'.
! !

!AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:16'!
midiKeyForPitch: pitchNameOrNumber
	"Answer the midiKey closest to the given pitch. Pitch may be a numeric pitch or a pitch name string such as 'c4'."
	"AbstractSound midiKeyForPitch: 440.0"

	| p octave i midiKey |
	pitchNameOrNumber isNumber
		ifTrue: [p _ pitchNameOrNumber asFloat]
		ifFalse: [p _ AbstractSound pitchForName: pitchNameOrNumber].
	octave _ -1.
	[p >= TopOfBottomOctave] whileTrue: [
		octave _ octave + 1.
		p _ p / 2.0].

	i _ self indexOfBottomOctavePitch: p.
	(i > 1) ifTrue: [
		(p - (PitchesForBottomOctave at: i - 1)) < ((PitchesForBottomOctave at: i) - p)
			ifTrue: [i _ i - 1]].

	midiKey _ ((octave * 12) + 11 + i).
	midiKey > 127 ifTrue: [midiKey _ 127].
	^ midiKey
! !

!AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:43'!
pitchForMIDIKey: midiKey
	"Answer the pitch for the given MIDI key."
	"(1 to: 127) collect: [:i | AbstractSound pitchForMIDIKey: i]"

	| indexInOctave octave |
	indexInOctave _ (midiKey \\ 12) + 1.
	octave _ (midiKey // 12) + 1.
	^ (PitchesForBottomOctave at: indexInOctave) *
		(#(1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0) at: octave)
! !

!AbstractSound class methodsFor: 'utilities'!
pitchForName: aString
	"AbstractSound pitchForName: 'c2'"
	"#(c 'c#' d eb e f fs g 'g#' a bf b) collect: [ :s | AbstractSound pitchForName: s, '4']"

	| s modifier octave i j noteName p |
	s _ ReadStream on: aString.
	modifier _ $n.
	noteName _ s next.
	(s atEnd not and: [s peek isDigit]) ifFalse: [ modifier _ s next ].
	s atEnd
		ifTrue: [ octave _ 4 ]
		ifFalse: [ octave _ Integer readFrom: s ].
	octave < 0 ifTrue: [ self error: 'cannot use negative octave number' ].
	i _ 'cdefgab' indexOf: noteName.
	i = 0 ifTrue: [ self error: 'bad note name: ', noteName asString ].
	i _ #(2 4 6 7 9 11 13) at: i.
	j _ 's#fb' indexOf: modifier.
	j = 0 ifFalse: [ i _ i + (#(1 1 -1 -1) at: j) ].  "i is now in range: [1..14]"
	"Table generator: (1 to: 14) collect: [ :i | 16.3516 * (2.0 raisedTo: (i - 2) asFloat / 12.0)]"
	p _ #(15.4339 16.3516 17.3239 18.354 19.4454 20.6017 21.8268 23.1247 24.4997 25.9565 27.5 29.1352 30.8677 32.7032) at: i.
	octave timesRepeat: [ p _ 2.0 * p ].
	^ p
! !

!AbstractSound class methodsFor: 'utilities' stamp: 'jm 7/6/1998 15:47'!
pitchTable
	"AbstractSound pitchTable"

	| out note i |
	out _ WriteStream on: (String new: 1000).
	i _ 12.
	0 to: 8 do: [:octave |
		#(c 'c#' d eb e f fs g 'g#' a bf b) do: [:noteName |
			note _ noteName, octave printString.
			out nextPutAll: note; tab.
			out nextPutAll: i printString; tab.
			out nextPutAll: (AbstractSound pitchForName: note) printString; cr.
			i _ i + 1]].
	^ out contents
! !


!AbstractSound class methodsFor: 'examples' stamp: 'jm 6/30/1998 18:40'!
chromaticPitchesFrom: aPitch

	| halfStep pitch |
	halfStep _ 2.0 raisedTo: (1.0 / 12.0).
	pitch _ aPitch isNumber
			ifTrue: [aPitch]
			ifFalse: [self pitchForName: aPitch].
	pitch _ pitch / halfStep.
	^ (0 to: 14) collect: [:i | pitch _ pitch * halfStep]
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 8/18/1998 11:32'!
chromaticRunFrom: startPitch to: endPitch on: aSound
	"Answer a composite sound consisting of a rapid chromatic run between the given pitches on the given sound."
	"(AbstractSound chromaticRunFrom: 'c3' to: 'c#5' on: FMSound oboe1) play"

	| scale halfStep pEnd p |
	scale _ SequentialSound new.
	halfStep _ 2.0 raisedTo: (1.0 / 12.0).
	endPitch isNumber
		ifTrue: [pEnd _ endPitch asFloat]
		ifFalse: [pEnd _ AbstractSound pitchForName: endPitch].
	startPitch isNumber
		ifTrue: [p _ startPitch asFloat]
		ifFalse: [p _ AbstractSound pitchForName: startPitch].
	[p <= pEnd] whileTrue: [
		scale add: (aSound soundForPitch: p dur: 0.2 loudness: 0.5).
		p _ p * halfStep].
	^ scale
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:35'!
chromaticScale
	"PluckedSound chromaticScale play"

	^ self chromaticScaleOn: self default
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/31/98 16:14'!
chromaticScaleOn: aSound
	"PluckedSound chromaticScale play"

	^ self noteSequenceOn: aSound
		from: (((self chromaticPitchesFrom: #c4) copyFrom: 1 to: 13)
			 collect: [:pitch | Array with: pitch with: 0.5 with: 300])
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:36'!
hiMajorScale
	"FMSound hiMajorScale play"

	^ self hiMajorScaleOn: self default
! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:00'!
hiMajorScaleOn: aSound
	"FMSound hiMajorScale play"

	^ self majorScaleOn: aSound from: #c6! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:36'!
lowMajorScale
	"PluckedSound lowMajorScale play"

	^ self lowMajorScaleOn: self default
! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:01'!
lowMajorScaleOn: aSound
	"PluckedSound lowMajorScale play"

	^ self majorScaleOn: aSound from: #c3! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:04'!
majorChord
	"FMSound majorChord play"
	^ self majorChordOn: self default from: #c4! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 8/3/1998 17:00'!
majorChordOn: aSound from: aPitch
	"FMSound majorChord play"

	| score majorScale leadingRest pan note |
	majorScale _ self majorPitchesFrom: aPitch.
	score _ MixedSound new.
	leadingRest _ pan _ 0.
	#(1 3 5 8) do: [:noteIndex |
		note _ aSound
			soundForPitch: (majorScale at: noteIndex)
			dur: 2.0 - leadingRest
			loudness: 0.3.
		score add: (RestSound dur: leadingRest), note pan: pan.
		leadingRest _ leadingRest + 0.2.
		pan _ pan + 0.3].
	^ score
! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 14:45'!
majorPitchesFrom: aPitch
	| chromatic |
	chromatic _ self chromaticPitchesFrom: aPitch.
	^ #(1 3 5 6 8 10 12 13 15 13 12 10 8 6 5 3 1) collect: [:i | chromatic at: i].
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:34'!
majorScale
	"FMSound majorScale play"

	^ self majorScaleOn: self default
! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:00'!
majorScaleOn: aSound
	"FMSound majorScale play"

	^ self majorScaleOn: aSound from: #c5! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 7/13/1998 13:09'!
majorScaleOn: aSound from: aPitch
	"FMSound majorScale play"

	^ self noteSequenceOn: aSound
		from: ((self majorPitchesFrom: aPitch)
			 collect: [:pitch | Array with: pitch with: 0.5 with: 300])
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/4/1999 09:26'!
majorScaleOn: aSound from: aPitch octaves: octaveCount
	"(AbstractSound majorScaleOn: FMSound oboe1 from: #c2 octaves: 5) play"

	| startingPitch pitches chromatic |
	startingPitch _ aPitch isNumber
		ifTrue: [aPitch]
		ifFalse: [self pitchForName: aPitch].
	pitches _ OrderedCollection new.
	0 to: octaveCount - 1 do: [:i |
		chromatic _ self chromaticPitchesFrom: startingPitch * (2 raisedTo: i).
		#(1 3 5 6 8 10 12) do: [:j | pitches addLast: (chromatic at: j)]].
	pitches addLast: startingPitch * (2 raisedTo: octaveCount).
	^ self noteSequenceOn: aSound
		from: (pitches collect: [:pitch | Array with: pitch with: 0.5 with: 300])
! !

!AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:32'!
scaleTest
	"AbstractSound scaleTest play"

	^ MixedSound new
		add: FMSound majorScale pan: 0;
		add: (PluckedSound lowMajorScale delayedBy: 0.5) pan: 1.0.
! !

!AbstractSound class methodsFor: 'examples' stamp: 'di 4/13/1999 13:53'!
testFMInteractively
	"Experiment with different settings of the FM modulation and multiplier settings interactively by moving the mouse. The top-left corner of the screen is 0 for both parameters. Stop when the mouse is pressed."
	"AbstractSound testFMInteractively"

	| s mousePt lastVal status mod ratio |
	SoundPlayer startPlayerProcessBufferSize: 1100 rate: 11025 stereo: false.
	s _ FMSound pitch: 440.0 dur: 200.0 loudness: 0.2.

	SoundPlayer playSound: s.
	lastVal _ nil.
	[Sensor anyButtonPressed] whileFalse: [
		mousePt _ Sensor cursorPoint.
		mousePt ~= lastVal ifTrue: [
			mod _ mousePt x asFloat / 20.0.
			ratio _ mousePt y asFloat / 20.0.
			s modulation: mod ratio: ratio.
			lastVal _ mousePt.
			status _
'mod: ', mod printString, '
ratio: ', ratio printString.
			status displayOn: Display at: 10@10]].

	SoundPlayer shutDown.
! !


!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 17:38'!
bachFugue
	"Play a fugue by J. S. Bach using and instance of me as the sound for all four voices."
	"PluckedSound bachFugue play"

	^ self bachFugueOn: self default
! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 18:27'!
bachFugueOn: aSound
	"Play a fugue by J. S. Bach using the given sound as the sound for all four voices."
	"PluckedSound bachFugue play"

	^ MixedSound new
		add: (self bachFugueVoice1On: aSound) pan: 1.0;
		add: (self bachFugueVoice2On: aSound) pan: 0.0;
		add: (self bachFugueVoice3On: aSound) pan: 1.0;
		add: (self bachFugueVoice4On: aSound) pan: 0.0.
! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:51'!
bachFugueVoice1On: aSound
	"Voice one of a fugue by J. S. Bach."

	^ self noteSequenceOn: aSound from: #(
		(1047 0.15 268)
		(988  0.15 268)
		(1047 0.30 268)
		(784  0.30 268)
		(831  0.30 268)
		(1047 0.15 268)
		(988  0.15 268)
		(1047 0.30 268)
		(1175 0.30 268)
		(784  0.30 268)
		(1047 0.15 268)
		(988  0.15 268)
		(1047 0.30 268)
		(1175 0.30 268)
		(698  0.15 268)
		(784  0.15 268)
		(831  0.60 268)
		(784  0.15 268)
		(698  0.15 268)
		(622  0.15 268)
		(1047 0.15 268)
		(988  0.15 268)
		(880  0.15 268)
		(784  0.15 268)
		(698  0.15 268)
		(622  0.15 268)
		(587  0.15 268)
		(523  0.30 268)
		(1245 0.30 268)
		(1175 0.30 268)
		(1047 0.30 268)
		(932  0.30 268)
		(880  0.30 268)
		(932  0.30 268)
		(1047 0.30 268)
		(740  0.30 268)
		(784  0.30 268)
		(880  0.30 268)
		(740  0.30 268)
		(784  0.60 268)
		(rest 0.15)
		(523  0.15 268)
		(587  0.15 268)
		(622  0.15 268)
		(698  0.15 268)
		(784  0.15 268)
		(831  0.45 268)
		(587  0.15 268)
		(622  0.15 268)
		(698  0.15 268)
		(784  0.15 268)
		(880  0.15 268)
		(932  0.45 268)
		(622  0.15 268)
		(698  0.15 268)
		(784  0.15 268)
		(831  0.15 268)
		(784  0.15 268)
		(698  0.15 268)
		(622  0.15 268)
		(587  0.30 268)
		(1047 0.15 268)
		(988  0.15 268)
		(1047 0.60 268)
		(rest 0.9)
		(1397 0.30 268)
		(1245 0.30 268)
		(1175 0.30 268)
		(rest 0.3)
		(831  0.30 268)
		(784  0.30 268)
		(698  0.30 268)
		(784  0.30 268)
		(698  0.15 268)
		(622  0.15 268)
		(698  0.30 268)
		(587  0.30 268)
		(784  0.60 268)
		(rest 0.3)
		(988  0.30 268)
		(1047 0.30 268)
		(1047 0.15 268)
		(988  0.15 268)
		(1047 0.30 268)
		(784  0.30 268)
		(831  0.60 268)
		(rest 0.3)
		(880  0.30 268)
		(932  0.30 268)
		(932  0.15 268)
		(880  0.15 268)
		(932  0.30 268)
		(698  0.30 268)
		(784  0.60 268)
		(rest 0.3)
		(784  0.30 268)
		(831  0.30 268)
		(831  0.30 268)
		(784  0.30 268)
		(698  0.30 268)
		(rest 0.3)
		(415  0.30 268)
		(466  0.30 268)
		(523  0.30 268)
		(rest 0.3)
		(415  0.15 268)
		(392  0.15 268)
		(415  0.30 268)
		(349  0.30 268)
		(466  0.30 268)
		(523  0.30 268)
		(466  0.30 268)
		(415  0.30 268)
		(466  0.30 268)
		(392  0.30 268)
		(349  0.30 268)
		(311  0.30 268)
		(349  0.30 268)
		(554  0.30 268)
		(523  0.30 268)
		(466  0.30 268)
		(523  0.30 268)
		(415  0.30 268)
		(392  0.30 268)
		(349  0.30 268)
		(392  0.30 268)
		(784  0.15 268)
		(740  0.15 268)
		(784  0.30 268)
		(523  0.30 268)
		(622  0.30 268)
		(784  0.15 268)
		(740  0.15 268)
		(784  0.30 268)
		(880  0.30 268)
		(587  0.30 268)
		(784  0.15 268)
		(740  0.15 268)
		(784  0.30 268)
		(880  0.30 268)
		(523  0.15 268)
		(587  0.15 268)
		(622  0.60 268)
		(587  0.15 268)
		(523  0.15 268)
		(466  0.30 346)
		(rest 0.45)
		(587  0.15 346)
		(659  0.15 346)
		(740  0.15 346)
		(784  0.15 346)
		(880  0.15 346)
		(932  0.45 346)
		(659  0.15 346)
		(698  0.15 346)
		(784  0.15 346)
		(880  0.15 346)
		(932  0.15 346)
		(1047 0.45 346)
		(740  0.15 346)
		(784  0.15 346)
		(880  0.15 346)
		(932  0.30 346)
		(622  0.15 346)
		(587  0.15 346)
		(622  0.30 346)
		(392  0.30 346)
		(415  0.30 346)
		(698  0.15 346)
		(622  0.15 346)
		(698  0.30 346)
		(440  0.30 346)
		(466  0.30 346)
		(784  0.15 346)
		(698  0.15 346)
		(784  0.30 346)
		(494  0.30 346)
		(523  0.15 346)
		(698  0.15 346)
		(622  0.15 346)
		(587  0.15 346)
		(523  0.15 346)
		(466  0.15 346)
		(440  0.15 346)
		(392  0.15 346)
		(349  0.30 346)
		(831  0.30 346)
		(784  0.30 346)
		(698  0.30 346)
		(622  0.30 346)
		(587  0.30 346)
		(622  0.30 346)
		(698  0.30 346)
		(494  0.30 346)
		(523  0.30 346)
		(587  0.30 346)
		(494  0.30 346)
		(523  0.60 346)
		(rest 0.3)
		(659  0.30 346)
		(698  0.30 346)
		(698  0.15 346)
		(659  0.15 346)
		(698  0.30 346)
		(523  0.30 346)
		(587  0.60 346)
		(rest 0.3)
		(587  0.30 346)
		(622  0.30 346)
		(622  0.15 346)
		(587  0.15 346)
		(622  0.30 346)
		(466  0.30 346)
		(523  1.20 346)
		(523  0.30 346)
		(587  0.15 346)
		(622  0.15 346)
		(698  0.15 346)
		(622  0.15 346)
		(698  0.15 346)
		(587  0.15 346)
		(494  0.30 457)
		(rest 0.6)
		(494  0.30 457)
		(523  0.30 457)
		(rest 0.6)
		(622  0.30 457)
		(587  0.30 457)
		(rest 0.6)
		(698  0.60 457)
		(rest 0.6)
		(698  0.30 457)
		(622  0.30 457)
		(831  0.30 457)
		(784  0.30 457)
		(698  0.30 457)
		(622  0.30 457)
		(587  0.30 457)
		(622  0.30 457)
		(698  0.30 457)
		(494  0.30 457)
		(523  0.30 457)
		(587  0.30 457)
		(494  0.30 457)
		(494  0.30 457)
		(523  0.30 457)
		(rest 0.3)
		(523  0.30 457)
		(698  0.15 457)
		(587  0.15 457)
		(622  0.15 457)
		(523  0.45 457)
		(494  0.30 457)
		(523  0.60 457)
		(rest 0.3)
		(659  0.30 268)
		(698  0.60 268)
		(rest 0.3)
		(698  0.30 268)
		(698  0.30 268)
		(622  0.15 268)
		(587  0.15 268)
		(622  0.30 268)
		(698  0.30 268)
		(587  0.40 268)
		(rest 0.4)
		(587  0.40 268)
		(rest 0.4)
		(523  1.60 268)).! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'!
bachFugueVoice2On: aSound
	"Voice two of a fugue by J. S. Bach."

	^ self noteSequenceOn: aSound from: #(
		(rest 4.8)
		(1568 0.15 346)
		(1480 0.15 346)
		(1568 0.30 346)
		(1047 0.30 346)
		(1245 0.30 346)
		(1568 0.15 346)
		(1480 0.15 346)
		(1568 0.30 346)
		(1760 0.30 346)
		(1175 0.30 346)
		(1568 0.15 346)
		(1480 0.15 346)
		(1568 0.30 346)
		(1760 0.30 346)
		(1047 0.15 346)
		(1175 0.15 346)
		(1245 0.60 346)
		(1175 0.15 346)
		(1047 0.15 346)
		(932  0.30 346)
		(1245 0.15 346)
		(1175 0.15 346)
		(1245 0.30 346)
		(784  0.30 346)
		(831  0.30 346)
		(1397 0.15 346)
		(1245 0.15 346)
		(1397 0.30 346)
		(880  0.30 346)
		(932  0.30 346)
		(1568 0.15 346)
		(1397 0.15 346)
		(1568 0.30 346)
		(988  0.30 346)
		(1047 0.30 346)
		(1175 0.15 346)
		(1245 0.15 346)
		(1397 0.90 346)
		(1245 0.15 346)
		(1175 0.15 346)
		(1047 0.15 346)
		(932  0.15 346)
		(831  0.15 346)
		(784  0.15 346)
		(698  0.30 346)
		(1661 0.30 346)
		(1568 0.30 346)
		(1397 0.30 346)
		(1245 0.30 346)
		(1175 0.30 346)
		(1245 0.30 346)
		(1397 0.30 346)
		(988  0.30 346)
		(1047 0.30 346)
		(1175 0.30 346)
		(988  0.30 346)
		(1047 0.30 457)
		(1568 0.15 457)
		(1480 0.15 457)
		(1568 0.30 457)
		(1175 0.30 457)
		(1245 0.60 457)
		(rest 0.3)
		(1319 0.30 457)
		(1397 0.30 457)
		(1397 0.15 457)
		(1319 0.15 457)
		(1397 0.30 457)
		(1047 0.30 457)
		(1175 0.60 457)
		(rest 0.3)
		(1175 0.30 457)
		(1245 0.30 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1245 0.30 457)
		(932  0.30 457)
		(1047 0.30 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1245 0.30 457)
		(1397 0.30 457)
		(932  0.30 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1245 0.30 457)
		(1397 0.30 457)
		(831  0.15 457)
		(932  0.15 457)
		(1047 0.60 457)
		(932  0.15 457)
		(831  0.15 457)
		(784  0.15 457)
		(622  0.15 457)
		(698  0.15 457)
		(784  0.15 457)
		(831  0.15 457)
		(932  0.15 457)
		(1047 0.15 457)
		(1175 0.15 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1047 0.15 457)
		(1175 0.15 457)
		(1245 0.15 457)
		(1397 0.15 457)
		(1568 0.15 457)
		(1760 0.15 457)
		(1865 0.15 457)
		(698  0.15 457)
		(784  0.15 457)
		(831  0.15 457)
		(932  0.15 457)
		(1047 0.15 457)
		(1175 0.15 457)
		(1319 0.15 457)
		(1397 0.15 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1245 0.15 457)
		(1397 0.15 457)
		(1568 0.15 457)
		(1760 0.15 457)
		(1976 0.15 457)
		(2093 0.30 457)
		(1976 0.15 457)
		(1760 0.15 457)
		(1568 0.15 457)
		(1397 0.15 457)
		(1245 0.15 457)
		(1175 0.15 457)
		(1047 0.30 457)
		(1245 0.30 457)
		(1175 0.30 457)
		(1047 0.30 457)
		(932  0.30 457)
		(880  0.30 457)
		(932  0.30 457)
		(1047 0.30 457)
		(740  0.30 457)
		(784  0.30 457)
		(880  0.30 457)
		(740  0.30 457)
		(784  0.30 457)
		(1175 0.15 457)
		(1047 0.15 457)
		(1175 0.30 457)
		(rest 0.6)
		(1319 0.15 457)
		(1175 0.15 457)
		(1319 0.30 457)
		(rest 0.6)
		(1480 0.15 457)
		(1319 0.15 457)
		(1480 0.30 457)
		(rest 0.6)
		(784  0.15 457)
		(698  0.15 457)
		(784  0.30 457)
		(rest 0.6)
		(880  0.15 457)
		(784  0.15 457)
		(880  0.30 457)
		(rest 0.6)
		(988  0.15 457)
		(880  0.15 457)
		(988  0.30 457)
		(rest 0.6)
		(1047 0.15 457)
		(988  0.15 457)
		(1047 0.30 457)
		(784  0.30 457)
		(831  0.30 457)
		(1047 0.15 457)
		(988  0.15 457)
		(1047 0.30 457)
		(1175 0.30 457)
		(784  0.30 457)
		(1047 0.15 457)
		(988  0.15 457)
		(1047 0.30 457)
		(1175 0.30 457)
		(698  0.15 457)
		(784  0.15 457)
		(831  0.60 457)
		(784  0.15 457)
		(698  0.15 457)
		(622  0.30 457)
		(1047 0.15 457)
		(988  0.15 457)
		(1047 0.30 457)
		(784  0.30 457)
		(831  0.60 457)
		(rest 0.3)
		(880  0.30 457)
		(932  0.30 457)
		(932  0.15 457)
		(880  0.15 457)
		(932  0.30 457)
		(698  0.30 457)
		(784  0.60 457)
		(rest 0.3)
		(784  0.60 457)
		(831  0.15 457)
		(932  0.15 457)
		(1047 0.15 457)
		(988  0.15 457)
		(1047 0.15 457)
		(831  0.15 457)
		(698  1.20 457)
		(698  0.30 591)
		(1175 0.15 591)
		(1047 0.15 591)
		(1175 0.30 591)
		(698  0.30 591)
		(622  0.30 591)
		(1245 0.15 591)
		(1175 0.15 591)
		(1245 0.30 591)
		(784  0.30 591)
		(698  0.30 591)
		(1397 0.15 591)
		(1245 0.15 591)
		(1397 0.30 591)
		(831  0.30 591)
		(784  0.15 591)
		(1397 0.15 591)
		(1245 0.15 591)
		(1175 0.15 591)
		(1047 0.15 591)
		(988  0.15 591)
		(880  0.15 591)
		(784  0.15 591)
		(1047 0.30 591)
		(1397 0.30 591)
		(1245 0.30 591)
		(1175 0.30 591)
		(rest 0.3)
		(831  0.30 591)
		(784  0.30 591)
		(698  0.30 591)
		(784  0.30 591)
		(698  0.15 591)
		(622  0.15 591)
		(698  0.30 591)
		(587  0.30 591)
		(831  0.30 591)
		(784  0.30 591)
		(rest 0.3)
		(880  0.30 591)
		(988  0.30 591)
		(1047 0.30 591)
		(698  0.15 591)
		(622  0.15 591)
		(587  0.15 591)
		(523  0.15 591)
		(523  0.30 591)
		(1047 0.15 346)
		(988  0.15 346)
		(1047 0.30 346)
		(784  0.30 346)
		(831  0.30 346)
		(1047 0.15 346)
		(988  0.15 346)
		(1047 0.30 346)
		(1175 0.30 346)
		(784  0.30 346)
		(1047 0.15 346)
		(988  0.15 346)
		(1047 0.30 346)
		(1175 0.30 346)
		(698  0.20 346)
		(784  0.20 346)
		(831  0.80 346)
		(784  0.20 346)
		(698  0.20 346)
		(659  1.60 346)).
! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'!
bachFugueVoice3On: aSound
	"Voice three of a fugue by J. S. Bach."

	^ self noteSequenceOn: aSound from: #(
		(rest 14.4)
		(523  0.15 457)
		(494  0.15 457)
		(523  0.30 457)
		(392  0.30 457)
		(415  0.30 457)
		(523  0.15 457)
		(494  0.15 457)
		(523  0.30 457)
		(587  0.30 457)
		(392  0.30 457)
		(523  0.15 457)
		(494  0.15 457)
		(523  0.30 457)
		(587  0.30 457)
		(349  0.15 457)
		(392  0.15 457)
		(415  0.60 457)
		(392  0.15 457)
		(349  0.15 457)
		(311  0.15 457)
		(523  0.15 457)
		(494  0.15 457)
		(440  0.15 457)
		(392  0.15 457)
		(349  0.15 457)
		(311  0.15 457)
		(294  0.15 457)
		(262  0.15 457)
		(294  0.15 457)
		(311  0.15 457)
		(294  0.15 457)
		(262  0.15 457)
		(233  0.15 457)
		(208  0.15 457)
		(196  0.15 457)
		(175  0.15 457)
		(466  0.15 457)
		(415  0.15 457)
		(392  0.15 457)
		(349  0.15 457)
		(311  0.15 457)
		(294  0.15 457)
		(262  0.15 457)
		(233  0.15 457)
		(262  0.15 457)
		(294  0.15 457)
		(262  0.15 457)
		(233  0.15 457)
		(208  0.15 457)
		(196  0.15 457)
		(175  0.15 457)
		(156  0.15 457)
		(415  0.15 457)
		(392  0.15 457)
		(349  0.15 457)
		(311  0.15 457)
		(277  0.15 457)
		(262  0.15 457)
		(233  0.15 457)
		(208  0.30 457)
		(523  0.30 457)
		(466  0.30 457)
		(415  0.30 457)
		(392  0.30 457)
		(349  0.30 457)
		(392  0.30 457)
		(415  0.30 457)
		(294  0.30 457)
		(311  0.30 457)
		(349  0.30 457)
		(294  0.30 457)
		(311  0.30 457)
		(415  0.30 457)
		(392  0.30 457)
		(349  0.30 457)
		(392  0.30 457)
		(311  0.30 457)
		(294  0.30 457)
		(262  0.30 457)
		(294  0.30 457)
		(466  0.30 457)
		(415  0.30 457)
		(392  0.30 457)
		(415  0.30 457)
		(349  0.30 457)
		(311  0.30 457)
		(294  0.30 457)
		(311  0.30 457)
		(rest 1.2)
		(262  0.30 457)
		(233  0.30 457)
		(220  0.30 457)
		(rest 0.3)
		(311  0.30 457)
		(294  0.30 457)
		(262  0.30 457)
		(294  0.30 457)
		(262  0.15 457)
		(233  0.15 457)
		(262  0.30 457)
		(294  0.30 457)
		(196  0.30 591)
		(466  0.15 591)
		(440  0.15 591)
		(466  0.30 591)
		(294  0.30 591)
		(311  0.30 591)
		(523  0.15 591)
		(466  0.15 591)
		(523  0.30 591)
		(330  0.30 591)
		(349  0.30 591)
		(587  0.15 591)
		(523  0.15 591)
		(587  0.30 591)
		(370  0.30 591)
		(392  0.60 591)
		(rest 0.15)
		(196  0.15 591)
		(220  0.15 591)
		(247  0.15 591)
		(262  0.15 591)
		(294  0.15 591)
		(311  0.45 591)
		(220  0.15 591)
		(233  0.15 591)
		(262  0.15 591)
		(294  0.15 591)
		(311  0.15 591)
		(349  0.45 591)
		(247  0.15 591)
		(262  0.15 591)
		(294  0.15 591)
		(311  0.30 591)
		(rest 0.6)
		(330  0.30 591)
		(349  0.30 591)
		(175  0.30 591)
		(156  0.30 591)
		(147  0.30 591)
		(rest 0.3)
		(208  0.30 591)
		(196  0.30 591)
		(175  0.30 591)
		(196  0.30 591)
		(175  0.15 591)
		(156  0.15 591)
		(175  0.30 591)
		(196  0.30 591)
		(262  0.15 591)
		(294  0.15 591)
		(311  0.15 591)
		(294  0.15 591)
		(262  0.15 591)
		(233  0.15 591)
		(208  0.15 591)
		(196  0.15 591)
		(175  0.15 591)
		(466  0.15 591)
		(415  0.15 591)
		(392  0.15 591)
		(349  0.15 591)
		(311  0.15 591)
		(294  0.15 591)
		(262  0.15 591)
		(233  0.15 591)
		(262  0.15 591)
		(294  0.15 591)
		(262  0.15 591)
		(233  0.15 591)
		(208  0.15 591)
		(196  0.15 591)
		(175  0.15 591)
		(156  0.15 591)
		(415  0.15 591)
		(392  0.15 591)
		(349  0.15 591)
		(311  0.15 591)
		(294  0.15 591)
		(262  0.15 591)
		(233  0.15 591)
		(208  0.15 591)
		(233  0.15 591)
		(262  0.15 591)
		(233  0.15 591)
		(208  0.15 591)
		(196  0.15 591)
		(175  0.15 591)
		(156  0.15 591)
		(147  0.15 591)
		(392  0.15 591)
		(349  0.15 591)
		(311  0.15 591)
		(294  0.15 591)
		(262  0.15 591)
		(247  0.15 591)
		(220  0.15 591)
		(196  0.60 772)
		(196  0.60 772)
		(rest 0.15)
		(196  0.15 772)
		(220  0.15 772)
		(247  0.15 772)
		(262  0.15 772)
		(294  0.15 772)
		(311  0.15 772)
		(349  0.15 772)
		(392  0.15 772)
		(349  0.15 772)
		(415  0.15 772)
		(392  0.15 772)
		(349  0.15 772)
		(311  0.15 772)
		(294  0.15 772)
		(262  0.15 772)
		(247  0.30 772)
		(262  0.15 772)
		(494  0.15 772)
		(262  0.30 772)
		(196  0.30 772)
		(208  0.30 772)
		(262  0.15 772)
		(247  0.15 772)
		(262  0.30 772)
		(294  0.30 772)
		(196  0.30 772)
		(262  0.15 772)
		(247  0.15 772)
		(262  0.30 772)
		(294  0.30 772)
		(175  0.15 772)
		(196  0.15 772)
		(208  0.60 772)
		(196  0.15 772)
		(175  0.15 772)
		(156  0.60 772)
		(rest 0.3)
		(311  0.30 772)
		(294  0.30 772)
		(262  0.30 772)
		(392  0.30 772)
		(196  0.30 772)
		(262  3.60 268)
		(494  0.40 268)
		(rest 0.4)
		(494  0.40 268)
		(rest 0.4)
		(392  1.60 268)).
! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'!
bachFugueVoice4On: aSound
	"Voice four of a fugue by J. S. Bach."

	^ self noteSequenceOn: aSound from: #(
		(rest 61.2)
		(131  0.15 500)
		(123  0.15 500)
		(131  0.30 500)
		(98   0.30 500)
		(104  0.30 500)
		(131  0.15 500)
		(123  0.15 500)
		(131  0.30 500)
		(147  0.30 500)
		(98   0.30 500)
		(131  0.15 500)
		(123  0.15 500)
		(131  0.30 500)
		(147  0.30 500)
		(87   0.15 500)
		(98   0.15 500)
		(104  0.60 500)
		(98   0.15 500)
		(87   0.15 500)
		(78   0.60 500)
		(rest 0.3)
		(156  0.30 500)
		(147  0.30 500)
		(131  0.30 500)
		(196  0.30 500)
		(98   0.30 500)
		(131  3.60 268)
		(131  3.20 205)).
! !

!AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 17:45'!
stereoBachFugue
	"Play fugue by J. S. Bach in stereo using different timbres."
	"AbstractSound stereoBachFugue play"

	"(AbstractSound bachFugueVoice1On: FMSound flute1) play"
	"(AbstractSound bachFugueVoice1On: PluckedSound default) play"

	^ MixedSound new
		add: (self bachFugueVoice1On: FMSound oboe1) pan: 0.2;
		add: (self bachFugueVoice2On: FMSound organ1) pan: 0.8;
		add: (self bachFugueVoice3On: PluckedSound default) pan: 0.4;
		add: (self bachFugueVoice4On: FMSound brass1) pan: 0.6.
! !


!AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/14/1998 13:27'!
initSounds
	"AbstractSound initSounds"

	Sounds _ Dictionary new.
	(FMSound class organization listAtCategoryNamed: #instruments)
		do: [:sel | Sounds at: sel asString put: (FMSound perform: sel)].
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/14/1998 13:25'!
soundNamed: soundName

	^ Sounds at: soundName
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'jm 3/4/98 10:29'!
soundNamed: soundName ifAbsent: aBlock

	^ Sounds at: soundName ifAbsent: aBlock
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'di 11/7/2000 12:12'!
soundNamed: soundName put: aSound

	Sounds at: soundName put: aSound.
	AbstractSound updateScorePlayers.
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/19/1998 14:11'!
soundNames

	^ Sounds keys asSortedCollection asArray
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/4/1998 18:26'!
sounds

	^ Sounds
! !

!AbstractSound class methodsFor: 'sound library' stamp: 'jm 1/14/1999 13:00'!
updateFMSounds
	"AbstractSound updateFMSounds"

	Sounds keys do: [:k |
		((Sounds at: k) isKindOf: FMSound) ifTrue: [
			Sounds removeKey: k ifAbsent: []]].

	(FMSound class organization listAtCategoryNamed: #instruments) do:
		[:sel | Sounds at: sel asString put: (FMSound perform: sel)].
! !


!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'sge 2/13/2000 05:20'!
fileInSoundLibrary
	"Prompt the user for a file name and the file in the sound library with that name."
	"AbstractSound fileInSoundLibrary"

	| fileName |
	fileName _ FillInTheBlank request: 'Sound library file name?'.
	fileName isEmptyOrNil ifTrue: [^ self].
	(fileName endsWith: '.sounds') ifFalse: [fileName _ fileName, '.sounds'].
	self fileInSoundLibraryNamed: fileName.
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'kks 9/27/2007 16:25'!
fileInSoundLibraryNamed: fileName
	"File in the sound library with the given file name, and add its contents to the current sound library."

	| s newSounds |
	s _ FileStream readOnlyFileNamed: fileName.
	newSounds _ s fileInObjectAndCode.
	s close.
	newSounds associationsDo:
		[:assoc | self storeFiledInSound: assoc value named: assoc key].
	AbstractSound updateScorePlayers.
	Smalltalk garbageCollect.  "Large objects may have been released"
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 8/19/1998 12:42'!
fileOutSoundLibrary
	"File out the current sound library."
	"AbstractSound fileOutSoundLibrary"

	self fileOutSoundLibrary: Sounds.
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'sge 2/13/2000 05:22'!
fileOutSoundLibrary: aDictionary
	"File out the given dictionary, which is assumed to contain sound and instrument objects keyed by their names."
	"Note: This method is separated out so that one can file out edited sound libraries, as well as the system sound library. To make such a collection, you can inspect AbstractSound sounds and remove the items you don't want. Then do: 'AbstractSound fileOutSoundLibrary: self' from the Dictionary inspector."

	| fileName refStream |
	(aDictionary isKindOf: Dictionary)
		ifFalse: [self error: 'arg should be a dictionary of sounds'].
	fileName _ FillInTheBlank request: 'Sound library file name?'.
	fileName isEmptyOrNil ifTrue: [^ self].
	refStream _ SmartRefStream fileNamed: fileName, '.sounds'.
	refStream nextPut: aDictionary.
	refStream close.
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 21:35'!
storeFiledInSound: snd named: sndName
	"Store the given sound in the sound library. Use the given name if it isn't in use, otherwise ask the user what to do."

	| menu choice i |
	(Sounds includesKey: sndName) ifFalse: [  "no name clash"
		Sounds at: sndName put: snd.
		^ self].

	(Sounds at: sndName) == UnloadedSnd ifTrue: [
		"re-loading a sound that was unloaded to save space"
		Sounds at: sndName put: snd.
		^ self].

	"the given sound name is already used"
	menu _ SelectionMenu selections:
		#('replace the existing sound' 'rename the new sound' 'skip it').
	choice _ menu startUpWithCaption:
		'"', sndName, '" has the same name as an existing sound'.
	(choice beginsWith: 'replace') ifTrue: [
		Sounds at: sndName put: snd.
		^ self].
	(choice beginsWith: 'rename') ifTrue: [
		i _ 2.
		[Sounds includesKey: (sndName, ' v', i printString)] whileTrue: [i _ i + 1].
		Sounds at: (sndName, ' v', i printString) put: snd].
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 22:18'!
unloadSampledTimbres
	"This can be done to unload those bulky sampled timbres to shrink the image. The unloaded sounds are replaced by a well-known 'unloaded sound' object to enable the unloaded sounds to be detected when the process is reversed."
	"AbstractSound unloadSampledTimbres"

	Sounds keys copy do: [:soundName |
		(((Sounds at: soundName) isKindOf: SampledInstrument) or:
		 [(Sounds at: soundName) isKindOf: LoopedSampledSound]) ifTrue: [
			Sounds at: soundName put: self unloadedSound]].
	self updateScorePlayers.
	Smalltalk garbageCollect.
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/11/1998 16:47'!
unloadSoundNamed: soundName

	(Sounds includesKey: soundName) ifTrue: [
		Sounds at: soundName put: self unloadedSound].
	self updateScorePlayers.
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 21:48'!
unloadedSound
	"Answer a sound to be used as the place-holder for sounds that have been unloaded."

	UnloadedSnd ifNil: [UnloadedSnd _ UnloadedSound default copy].
	^ UnloadedSnd
! !

!AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'di 11/7/2000 13:00'!
updateScorePlayers
	| soundsBeingEdited |
	"Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change."

	ScorePlayer allSubInstancesDo:
		[:p | p pause].
	SoundPlayer shutDown.
	soundsBeingEdited _ EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited].
	ScorePlayerMorph allSubInstancesDo:
		[:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited].
! !


!AbstractSound class methodsFor: 'primitive generation' stamp: 'ar 2/3/2001 15:30'!
translatedPrimitives
	^#(
		(FMSound mixSampleCount:into:startingAt:leftVol:rightVol:)
		(PluckedSound mixSampleCount:into:startingAt:leftVol:rightVol:)
		(LoopedSampledSound mixSampleCount:into:startingAt:leftVol:rightVol:)
		(SampledSound mixSampleCount:into:startingAt:leftVol:rightVol:)
		(ReverbSound applyReverbTo:startingAt:count:)
	).
! !
Object subclass: #AbstractSoundSystem
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Support'!
!AbstractSoundSystem commentStamp: 'gk 2/24/2004 08:34' prior: 0!
This is the abstract base class for a sound system. A sound system offers a small protocol for playing sounds and making beeps and works like a facade towards the rest of Squeak. A sound system is registered in the application registry SoundService and can be accessed by "SoundService default" like for example:

SoundService default playSoundNamed: 'croak'

The idea is that as much sound playing as possible should go through this facade. This way we decouple the sound system from the rest of Squeak and make it pluggable. It also is a perfect spot to check for the Preference class>>soundsEnabled.

Two basic subclasses exist at the time of this writing, the BaseSoundSystem which represents the standard Squeak sound system, and the DummySoundSystem which is a dummy implementation that can be used when there is no sound card available, or when the base sound system isn't in the image, or when you simply don't want to use the available sound card.!


!AbstractSoundSystem methodsFor: 'playing' stamp: 'gk 2/24/2004 23:27'!
beep
	"Make a primitive beep."

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'playing' stamp: 'gk 2/23/2004 19:47'!
playSampledSound: samples rate: rate

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'playing' stamp: 'gk 2/23/2004 19:50'!
playSoundNamed: soundName

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'playing' stamp: 'gk 2/23/2004 19:51'!
playSoundNamed: soundName ifAbsentReadFrom: aifFileName

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'playing' stamp: 'gk 2/23/2004 19:51'!
playSoundNamedOrBeep: soundName

	self subclassResponsibility! !


!AbstractSoundSystem methodsFor: 'misc' stamp: 'gk 2/23/2004 19:52'!
randomBitsFromSoundInput: bitCount

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'misc' stamp: 'gk 2/23/2004 19:52'!
sampledSoundChoices

	self subclassResponsibility! !

!AbstractSoundSystem methodsFor: 'misc' stamp: 'gk 2/23/2004 19:53'!
shutDown
	"Default is to do nothing."! !

!AbstractSoundSystem methodsFor: 'misc' stamp: 'gk 2/23/2004 19:56'!
soundNamed: soundName

	self subclassResponsibility! !
PluggableTextMorph subclass: #AcceptableCleanTextMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!

!AcceptableCleanTextMorph methodsFor: 'menu commands' stamp: 'dgd 2/21/2003 22:50'!
accept
	"Overridden to allow accept of clean text"

	| textToAccept ok |
	textToAccept := textMorph asText.
	ok := setTextSelector isNil or: 
					[setTextSelector numArgs = 2 
						ifTrue: 
							[model 
								perform: setTextSelector
								with: textToAccept
								with: self]
						ifFalse: [model perform: setTextSelector with: textToAccept]].
	ok 
		ifTrue: 
			[self setText: self getText.
			self hasUnacceptedEdits: false]! !
FileDirectory subclass: #AcornFileDirectory
	instanceVariableNames: ''
	classVariableNames: 'LegalCharMap'
	poolDictionaries: ''
	category: 'System-Files'!

!AcornFileDirectory methodsFor: 'file name utilities' stamp: 'tpr 12/23/2004 19:21'!
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	| fName hasBadChars correctedName newChar|
	fName _ super checkName: aFileName fixErrors: fixing.
	correctedName _ String streamContents:[:s|
								fName do:[:c|
									(newChar _ LegalCharMap at: c asciiValue +1) ifNotNil:[s nextPut: newChar]]]. 
	hasBadChars _ fName ~= correctedName.
	(hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name'].
	hasBadChars ifFalse:[^ fName].
	^ correctedName! !

!AcornFileDirectory methodsFor: 'file name utilities' stamp: 'tpr 11/5/2004 13:08'!
fullPathFor: path
	"if the arg is an empty string, just return my path name converted via the language stuff. 
If the arg seems to be a  rooted path, return it raw, assuming it is already ok.
Otherwise cons up a path"
	path isEmpty ifTrue:[^pathName asSqueakPathName].
	((path includes: $$ ) or:[path includes: $:]) ifTrue:[^path].
	^pathName asSqueakPathName, self slash, path! !


!AcornFileDirectory methodsFor: 'private' stamp: 'tpr 11/5/2004 13:08'!
directoryContentsFor: fullPath 
	"Return a collection of directory entries for the files and directories in 
	the directory with the given path. See primLookupEntryIn:index: for 
	further details."
	"FileDirectory default directoryContentsFor: ''"

	| entries extraPath |
	entries _ super directoryContentsFor: fullPath.
	fullPath isNullPath
		ifTrue: [
			"For Acorn we also make sure that at least the parent of the current dir 
			is added - sometimes this is in a filing system that has not been (or 
			cannot be) polled for disc root names"
			extraPath _ self class default containingDirectory.
			"Only add the extra path if we haven't already got the root of the current dir in the list"
			entries detect: [:ent | extraPath fullName beginsWith: ent name] 
				ifNone: [entries _ entries
								copyWith: (DirectoryEntry
										name: extraPath fullName
										creationTime: 0
										modificationTime: 0
										isDirectory: true
										fileSize: 0)]].
	^ entries
! !


!AcornFileDirectory methodsFor: 'testing' stamp: 'tpr 4/28/2004 21:54'!
directoryExists: filenameOrPath
"if the path is a root,we have to treat it carefully"
	(filenameOrPath endsWith: '$') ifTrue:[^(FileDirectory on: filenameOrPath) exists].
	^(self directoryNamed: filenameOrPath ) exists! !


!AcornFileDirectory methodsFor: 'path access' stamp: 'tpr 11/30/2003 21:42'!
pathParts
	"Return the path from the root of the file system to this directory as an 
	array of directory names.
	This version tries to cope with the RISC OS' strange filename formatting; 
	filesystem::discname/$/path/to/file
	where the $ needs to be considered part of the filingsystem-discname atom."
	| pathList |
	pathList := super pathParts.
	(pathList indexOf: '$') = 2
		ifTrue: ["if the second atom is root ($) then stick $ on the first atom 
				and drop the second. Yuck"
			^ Array
				streamContents: [:a | 
					a nextPut: (pathList at: 1), '/$'.
					3 to: pathList size do: [:i | a
								nextPut: (pathList at: i)]]].
	^ pathList! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AcornFileDirectory class
	instanceVariableNames: ''!

!AcornFileDirectory class methodsFor: 'platform specific' stamp: 'md 10/26/2003 13:16'!
isActiveDirectoryClass
	"Does this class claim to be that properly active subclass of FileDirectory  
	for the current platform? On Acorn, the test is whether platformName 
	is 'RiscOS' (on newer VMs) or if the primPathNameDelimiter is $. (on
	older ones), which is what we would like to use for a dirsep if only it
	would work out. See pathNameDelimiter for more woeful details - then
	just get on and enjoy Squeak"

	^ SmalltalkImage current platformName = 'RiscOS'
		or: [self primPathNameDelimiter = $.]! !

!AcornFileDirectory class methodsFor: 'platform specific' stamp: 'tpr 8/1/2003 16:38'!
isCaseSensitive
	"Risc OS ignores the case of file names"
	^ false! !

!AcornFileDirectory class methodsFor: 'platform specific' stamp: 'TPR 7/20/1999 17:52'!
maxFileNameLength

	^ 255
! !

!AcornFileDirectory class methodsFor: 'platform specific' stamp: 'TPR 5/10/1998 21:45'!
pathNameDelimiter
"Acorn RiscOS uses a dot as the directory separator and has no real concept of filename extensions. We tried to make code handle this, but there are just too many uses of dot as a filename extension - so fake it out by pretending to use a slash. The file prims do conversions instead.
Sad, but pragmatic"
	^ $/
! !


!AcornFileDirectory class methodsFor: 'class initialization' stamp: 'tpr 12/23/2004 19:20'!
initialize
"Set up the legal chars map for filenames. May need extending for unicode etc.
Basic rule is that any char legal for use in filenames will have a non-nil entry in this array; except for space, this is the same character. Space is transcoded to a char 160 to be a 'hard space' "
"AcornFileDirectory initialize"
	| aVal |
	LegalCharMap _ Array new: 256.
	Character alphabet do:[:c|
		LegalCharMap at: c asciiValue +1  put: c.
		LegalCharMap at: (aVal _ c asUppercase) asciiValue +1 put: aVal].
	'`!!()-_=+[{]};~,./1234567890' do:[:c|
			LegalCharMap at: c asciiValue + 1 put: c].
	LegalCharMap at: Character space asciiValue +1 put: (Character value:160 "hardspace").
	LegalCharMap at: 161 put: (Character value:160 "hardspace")."secondary mapping to keep it in strings"! !
Array variableSubclass: #ActionSequence
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Object Events'!

!ActionSequence methodsFor: 'converting' stamp: 'reThink 2/18/2001 15:12'!
asActionSequence

	^self! !

!ActionSequence methodsFor: 'converting' stamp: 'rw 7/20/2003 16:03'!
asActionSequenceTrappingErrors

	^WeakActionSequenceTrappingErrors withAll: self! !

!ActionSequence methodsFor: 'converting' stamp: 'reThink 2/18/2001 15:28'!
asMinimalRepresentation

	self size = 0
		ifTrue: [^nil].
	self size = 1
		ifTrue: [^self first].
	^self! !


!ActionSequence methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 17:51'!
value
    "Answer the result of evaluating the elements of the receiver."

    | answer |
    self do:
        [:each |
        answer := each value].
    ^answer! !

!ActionSequence methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 17:52'!
valueWithArguments: anArray

    | answer |
    self do:
        [:each |
        answer := each valueWithArguments: anArray].
    ^answer! !


!ActionSequence methodsFor: 'printing' stamp: 'SqR 07/28/2001 18:25'!
printOn: aStream

	self size < 2 ifTrue: [^super printOn: aStream].
	aStream nextPutAll: '#('.
	self
		do: [:each | each printOn: aStream]
		separatedBy: [aStream cr].
	aStream nextPut: $)! !
Object subclass: #ActorState
	instanceVariableNames: 'owningPlayer penDown penSize penColor fractionalPosition instantiatedUserScriptsDictionary penArrowheads trailStyle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Scripting Support'!
!ActorState commentStamp: '<historical>' prior: 0!
Holds a record of data representing actor-like slots in the Morph, on behalf of an associated Player.  Presently also holds onto the scriptInstantion objects that represent active scripts in an instance, but this will probably change soon.!


!ActorState methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 21:53'!
printOnStream: aStream
	aStream print: 'ActorState for '; print:owningPlayer externalName; print:' '.
	penDown ifNotNil: [aStream cr; print: 'penDown '; write:penDown].
	penColor ifNotNil: [aStream cr; print: 'penColor '; write:penColor].
	penSize ifNotNil: [aStream cr; print: 'penSize '; write:penSize].
	instantiatedUserScriptsDictionary ifNotNil:
		[aStream cr; print:
			'+ '; write: instantiatedUserScriptsDictionary size; print:' user scripts'].
! !


!ActorState methodsFor: 'initialization' stamp: 'sw 5/13/1998 16:37'!
initializeFor: aPlayer
	| aNewDictionary |
	owningPlayer _ aPlayer.
	instantiatedUserScriptsDictionary ifNil: [^ self].
	aNewDictionary _ IdentityDictionary new.
	instantiatedUserScriptsDictionary associationsDo: 
		[:assoc |
			aNewDictionary at: assoc key put: (assoc value shallowCopy player: aPlayer)].
	instantiatedUserScriptsDictionary _ aNewDictionary.! !


!ActorState methodsFor: 'other' stamp: 'sw 4/22/1998 17:02'!
addPlayerMenuItemsTo: aMenu hand: aHandMorph
	self getPenDown
		ifTrue: [aMenu add: 'pen up' action: #liftPen]
		ifFalse: [aMenu add: 'pen down' action: #lowerPen].
	aMenu add: 'pen size' action: #choosePenSize.
	aMenu add: 'pen color' action: #choosePenColor:.! !

!ActorState methodsFor: 'other' stamp: 'sw 4/13/1998 19:36'!
costume
	^ owningPlayer costume! !


!ActorState methodsFor: 'pen' stamp: 'nk 6/12/2004 16:36'!
choosePenColor: evt
	owningPlayer costume changeColorTarget: owningPlayer costume selector: #penColor: originalColor: owningPlayer getPenColor hand: evt hand.! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:44'!
choosePenSize
	| menu sz |
	menu _ CustomMenu new.
	1 to: 10 do: [:w | menu add: w printString action: w].
	sz _ menu startUp.
	sz ifNotNil: [penSize _ sz]! !

!ActorState methodsFor: 'pen' stamp: 'sw 2/4/98 15:16'!
defaultPenColor
	^ Color blue! !

!ActorState methodsFor: 'pen' stamp: 'sw 2/4/98 15:03'!
defaultPenSize
	^ 1! !

!ActorState methodsFor: 'pen' stamp: 'tk 10/4/2001 16:42'!
getPenArrowheads
	^ penArrowheads == true! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:35'!
getPenColor
	penColor ifNil: [penColor _ self defaultPenColor].
	^ penColor! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:40'!
getPenDown
	^ penDown == true! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:43'!
getPenSize
	penSize ifNil: [penSize _ self defaultPenSize].
	^ penSize! !

!ActorState methodsFor: 'pen' stamp: 'sw 2/4/98 18:07'!
liftPen
	penDown _ false! !

!ActorState methodsFor: 'pen' stamp: 'sw 2/4/98 14:58'!
lowerPen
	penDown _ true! !

!ActorState methodsFor: 'pen' stamp: 'sw 2/4/98 18:03'!
penColor: aColor
	penColor _ aColor! !

!ActorState methodsFor: 'pen' stamp: 'tk 10/4/2001 16:43'!
setPenArrowheads: aBoolean
	penArrowheads _ aBoolean! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:51'!
setPenColor: aColor
	penColor _ aColor
! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:47'!
setPenDown: aBoolean
	penDown _ aBoolean! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/22/1998 13:45'!
setPenSize: aNumber
	penSize _ aNumber! !

!ActorState methodsFor: 'pen' stamp: 'sw 4/16/2003 12:26'!
trailStyle
	"Answer the receiver's trailStyle.  For backward compatibility, if the old penArrowheads slot is in found to be set, use it as a guide for initialization"

	^ trailStyle ifNil: [trailStyle _ penArrowheads == true ifTrue: [#arrows] ifFalse: [#lines]]! !

!ActorState methodsFor: 'pen' stamp: 'sw 3/11/2003 11:28'!
trailStyle: aSymbol
	"Set the trail style to the given symbol"

	trailStyle _ aSymbol! !


!ActorState methodsFor: 'position' stamp: 'jm 4/24/1998 21:34'!
fractionalPosition
	"Return my player's costume's position including the fractional part. This allows the precise position to be retained to avoid cummulative rounding errors, while letting Morphic do all its calculations with integer pixel coordinates. See the implementation of forward:."

	^ fractionalPosition
! !

!ActorState methodsFor: 'position' stamp: 'jm 4/24/1998 21:31'!
fractionalPosition: aPoint

	fractionalPosition _ aPoint asFloatPoint.
! !


!ActorState methodsFor: 'printing' stamp: 'sw 5/12/1998 23:35'!
printOn: aStream
	aStream nextPutAll: 'ActorState for ', owningPlayer externalName, ' '.
	penDown ifNotNil: [aStream cr; nextPutAll: 'penDown ', penDown printString].
	penColor ifNotNil: [aStream cr; nextPutAll: 'penColor ', penColor printString].
	penSize ifNotNil: [aStream cr; nextPutAll: 'penSize ', penSize printString].
	instantiatedUserScriptsDictionary ifNotNil:
		[aStream cr; nextPutAll:
			'+ ', instantiatedUserScriptsDictionary size printString, ' user scripts'].
! !


!ActorState methodsFor: 'script instantiations' stamp: 'sw 4/9/98 22:35'!
instantiatedUserScriptsDictionary
	instantiatedUserScriptsDictionary ifNil: [instantiatedUserScriptsDictionary _ IdentityDictionary new].
	^ instantiatedUserScriptsDictionary! !
SoundCodec subclass: #ADPCMCodec
	instanceVariableNames: 'predicted index deltaSignMask deltaValueMask deltaValueHighBit frameSizeMask currentByte bitPosition byteIndex encodedBytes samples rightSamples sampleIndex bitsPerSample stepSizeTable indexTable'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sound-Synthesis'!
!ADPCMCodec commentStamp: '<historical>' prior: 0!
This is a simple ADPCM (adapative delta pulse code modulation) codec. This is a general audio codec that compresses speech, music, or sound effects equally well, and works at any sampling rate (i.e., it contains no frequency-sensitive filters). It compresses 16-bit sample data down to 5, 4, 3, or 2 bits per sample, with lower fidelity and increased noise at the lowest bit rates. Although it does not deliver state-of-the-art compressions, the algorithm is small, simple, and extremely fast, since the encode/decode primitives have been translated into C primitives.

This codec will also encode and decode all Flash .swf file compressed sound formats, both mono and stereo. (Note: stereo Flash compression is not yet implemented, but stereo decompression works.)
!


!ADPCMCodec methodsFor: 'bit streaming' stamp: 'jm 3/28/1999 16:24'!
nextBits: n
	"Answer the next n bits of my bit stream as an unsigned integer."

	| result remaining shift |
	self inline: true.

	result _ 0.
	remaining _ n.
	[true] whileTrue: [
		shift _ remaining - bitPosition.
		result _ result + (currentByte bitShift: shift).
		shift > 0
			ifTrue: [  "consumed currentByte buffer; fetch next byte"
				remaining _ remaining - bitPosition.			
				currentByte _ (encodedBytes at: (byteIndex _ byteIndex + 1)).
				bitPosition _ 8]
			ifFalse: [  "still some bits left in currentByte buffer"
				bitPosition _ bitPosition - remaining.
				"mask out the consumed bits:"
				currentByte _ currentByte bitAnd: (255 bitShift: (bitPosition - 8)).
				^ result]].
! !

!ADPCMCodec methodsFor: 'bit streaming' stamp: 'jm 3/28/1999 20:21'!
nextBits: n put: anInteger
	"Write the next n bits to my bit stream."

	| buf bufBits bitsAvailable shift |
	self inline: true.

	buf _ anInteger.
	bufBits _ n.
	[true] whileTrue: [
		bitsAvailable _ 8 - bitPosition.
		shift _ bitsAvailable - bufBits.  "either left or right shift"
		"append high bits of buf to end of currentByte:"
		currentByte _ currentByte + (buf bitShift: shift).
		shift < 0
			ifTrue: [  "currentByte buffer filled; output it"
				encodedBytes at: (byteIndex _ byteIndex + 1) put: currentByte.
				bitPosition _ 0.
				currentByte _ 0.
				"clear saved high bits of buf:"
				buf _ buf bitAnd: (1 bitShift: 0 - shift) - 1.
				bufBits _ bufBits - bitsAvailable]
			ifFalse: [  "still some bits available in currentByte buffer"
				bitPosition _ bitPosition + bufBits.
				^ self]].
! !


!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 12/12/2001 17:57'!
bytesPerEncodedFrame
	"Answer the number of bytes required to hold one frame of compressed sound data."
	"Note: When used as a normal codec, the frame size is always 8 samples which results in (8 * bitsPerSample) / 8 = bitsPerSample bytes."

	| bitCount |
	frameSizeMask = 0 ifTrue: [^ bitsPerSample].
	"Following assumes mono:"
	bitCount _ 16 + 6 + ((self samplesPerFrame - 1) * bitsPerSample).
	^ (bitCount + 7) // 8
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 7/2/1999 13:29'!
compressAndDecompress: aSound
	"Compress and decompress the given sound. Overridden to use same bits per sample for both compressing and decompressing."

	| compressed decoder |
	compressed _ self compressSound: aSound.
	decoder _ self class new
		initializeForBitsPerSample: bitsPerSample
		samplesPerFrame: 0.
	^ decoder decompressSound: compressed

! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 15:37'!
decodeFrames: frameCount from: srcByteArray at: srcIndex into: dstSoundBuffer at: dstIndex
	"Decode the given number of monophonic frames starting at the given index in the given ByteArray of compressed sound data and storing the decoded samples into the given SoundBuffer starting at the given destination index. Answer a pair containing the number of bytes of compressed data consumed and the number of decompressed samples produced."
	"Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers."

	encodedBytes _ srcByteArray.
	byteIndex _ srcIndex - 1.
	bitPosition _ 0.
	currentByte _ 0.
	samples _ dstSoundBuffer.
	sampleIndex _ dstIndex - 1.
	self privateDecodeMono: (frameCount * self samplesPerFrame).
	^ Array with: (byteIndex - (srcIndex - 1)) with: (sampleIndex - (dstIndex - 1))
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 15:28'!
encodeFrames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex
	"Encode the given number of frames starting at the given index in the given monophonic SoundBuffer and storing the encoded sound data into the given ByteArray starting at the given destination index. Encode only as many complete frames as will fit into the destination. Answer a pair containing the number of samples consumed and the number of bytes of compressed data produced."
	"Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers."

	samples _ srcSoundBuffer.
	sampleIndex _ srcIndex - 1.
	encodedBytes _ dstByteArray.
	byteIndex _ dstIndex - 1.
	bitPosition _ 0.
	currentByte _ 0.
	self privateEncodeMono: (frameCount * self samplesPerFrame).
	^ Array with: frameCount with: (byteIndex - (dstIndex - 1))
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 12/14/2001 11:21'!
reset

	self resetForMono.
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 20:12'!
resetForMono
	"Reset my encoding and decoding state for mono."

	predicted _ 0.
	index _ 0.
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 20:12'!
resetForStereo
	"Reset my encoding and decoding state for stereo."

	"keep state as SoundBuffers to allow fast access from primitive"
	predicted _ SoundBuffer new: 2.
	index _ SoundBuffer new: 2.
! !

!ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/27/1999 08:34'!
samplesPerFrame
	"Answer the number of sound samples per compression frame."

	frameSizeMask > 0 ifTrue: [^ frameSizeMask + 1].
	^ 8  "frame size when there are no running headers"
! !


!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 06:26'!
decode: aByteArray bitsPerSample: bits

	^ self
		decode: aByteArray
		sampleCount: (aByteArray size * 8) // bits
		bitsPerSample: bits
		frameSize: 0
		stereo: false
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 15:57'!
decode: aByteArray sampleCount: count bitsPerSample: bits frameSize: frameSize stereo: stereoFlag

	self initializeForBitsPerSample: bits samplesPerFrame: frameSize.
	encodedBytes _ aByteArray.
	byteIndex _ 0.
	bitPosition _ 0.
	currentByte _ 0.
	stereoFlag
		ifTrue: [
			self resetForStereo.
			samples _ SoundBuffer newMonoSampleCount: count.
			rightSamples _ SoundBuffer newMonoSampleCount: count.
			sampleIndex _ 0.
			self privateDecodeStereo: count.
			^ Array with: samples with: rightSamples]
		ifFalse: [
			samples _ SoundBuffer newMonoSampleCount: count.
			sampleIndex _ 0.
			self privateDecodeMono: count.
			^ samples]
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/30/1999 08:56'!
decodeFlash: aByteArray sampleCount: sampleCount stereo: stereoFlag

	| bits |
	encodedBytes _ aByteArray.
	byteIndex _ 0.
	bitPosition _ 0.
	currentByte _ 0.
	bits _ 2 + (self nextBits: 2).  "bits per sample"
	self initializeForBitsPerSample: bits samplesPerFrame: 4096.
	stereoFlag
		ifTrue: [
			self resetForStereo.
			samples _ SoundBuffer newMonoSampleCount: sampleCount.
			rightSamples _ SoundBuffer newMonoSampleCount: sampleCount.
			sampleIndex _ 0.
			self privateDecodeStereo: sampleCount.
			^ Array with: samples with: rightSamples]
		ifFalse: [
			samples _ SoundBuffer newMonoSampleCount: sampleCount.
			sampleIndex _ 0.
			self privateDecodeMono: sampleCount.
			^ Array with: samples].
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 08:59'!
encode: aSoundBuffer bitsPerSample: bits

	^ self
		encodeLeft: aSoundBuffer
		right: nil
		bitsPerSample: bits
		frameSize: 0
		forFlash: false
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 08:58'!
encodeFlashLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits

	^ self
		encodeLeft: leftSoundBuffer
		right: rightSoundBuffer
		bitsPerSample: bits
		frameSize: 4096
		forFlash: true
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 11/21/2001 11:35'!
encodeLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits frameSize: frameSize forFlash: flashFlag

	| stereoFlag sampleCount sampleBitCount bitCount |
	self initializeForBitsPerSample: bits samplesPerFrame: frameSize.
	stereoFlag _ rightSoundBuffer notNil.
	sampleCount _ leftSoundBuffer monoSampleCount.
	stereoFlag
		ifTrue: [sampleBitCount _ 2 * (sampleCount * bitsPerSample)]
		ifFalse: [sampleBitCount _ sampleCount * bitsPerSample].
	bitCount _ sampleBitCount +
		(self headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag).

	encodedBytes _ ByteArray new: ((bitCount / 8) ceiling roundUpTo: self bytesPerEncodedFrame).
	byteIndex _ 0.
	bitPosition _ 0.
	currentByte _ 0.
	flashFlag ifTrue: [self nextBits: 2 put: bits - 2].
	stereoFlag
		ifTrue: [
			samples _ Array with: leftSoundBuffer with: rightSoundBuffer.
			sampleIndex _ Array with: 0 with: 0.
			self privateEncodeStereo: sampleCount]
		ifFalse: [
			samples _ leftSoundBuffer.
			sampleIndex _ 0.
			self privateEncodeMono: sampleCount].

	^ encodedBytes
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/27/1999 12:14'!
headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag
	"Answer the number of extra header bits required for the given number of samples. This will be zero if I am not using frame headers."

	| frameCount bitsPerHeader |
	frameSizeMask = 0 ifTrue: [^ 0].
	frameCount _ (sampleCount / self samplesPerFrame) ceiling.
	bitsPerHeader _ 16 + 6.
	stereoFlag ifTrue: [bitsPerHeader _ 2 * bitsPerHeader].
	^ frameCount * bitsPerHeader
! !

!ADPCMCodec methodsFor: 'private' stamp: 'zz 3/2/2004 07:58'!
indexForDeltaFrom: thisSample to: nextSample
	"Answer the best index to use for the difference between the given samples."
	"Details: Scan stepSizeTable for the first entry >= the absolute value of the difference between sample values. Since indexes are zero-based, the index used during decoding will be the one in the following stepSizeTable entry. Since the index field of a Flash frame header is only six bits, the maximum index value is 63."
	"Note: Since there does not appear to be any documentation of how Flash actually computes the indices used in its frame headers, this algorithm was guessed by reverse-engineering the Flash ADPCM decoder."

	| diff bestIndex |
	self inline: true.

	diff _ nextSample - thisSample.
	diff < 0 ifTrue: [diff _ 0 - diff].
	bestIndex _ 63.
	1 to: 62 do: [:j |
		bestIndex = 63 ifTrue: [
			(stepSizeTable at: j) >= diff ifTrue: [bestIndex _ j]]].
	^ bestIndex
! !

!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 20:48'!
initializeForBitsPerSample: sampleBits samplesPerFrame: frameSize

	self resetForMono.
	stepSizeTable _ #(7 8 9 10 11 12 13 14 16 17 19 21 23 25 28 31 34 37 41 45 50 55 60 66 73 80 88 97 107 118 130 143 157 173 190 209 230 253 279 307 337 371 408 449 494 544 598 658 724 796 876 963 1060 1166 1282 1411 1552 1707 1878 2066 2272 2499 2749 3024 3327 3660 4026 4428 4871 5358 5894 6484 7132 7845 8630 9493 10442 11487 12635 13899 15289 16818 18500 20350 22385 24623 27086 29794 32767).

	indexTable _ nil.
	sampleBits = 2 ifTrue: [
		indexTable _ #(-1 2)].
	sampleBits = 3 ifTrue: [
		indexTable _ #(-1 -1 2 4)].
	sampleBits = 4 ifTrue: [
		indexTable _ #(-1 -1 -1 -1 2 4 6 8)].
	sampleBits = 5 ifTrue: [
		indexTable _ #(-1 -1 -1 -1 -1 -1 -1 -1 1 2 4 6 8 10 13 16)].
	indexTable ifNil: [self error: 'unimplemented bits/sample'].

	bitsPerSample _ sampleBits.
	deltaSignMask _ 1 bitShift: bitsPerSample - 1.
	deltaValueMask _ deltaSignMask - 1.
	deltaValueHighBit _ deltaSignMask / 2.

	frameSize <= 1
		ifTrue: [frameSizeMask _ 0]
		ifFalse: [
			(frameSize = (1 bitShift: frameSize highBit - 1))
				ifFalse: [self error: 'frameSize must be a power of two'].
			frameSizeMask _ frameSize - 1].

	"keep as SoundBuffer to allow fast access from primitive"
	indexTable _ SoundBuffer fromArray: indexTable.
	stepSizeTable _ SoundBuffer fromArray: stepSizeTable.
! !

!ADPCMCodec methodsFor: 'private' stamp: 'ar 4/23/2001 15:11'!
privateDecodeMono: count

	| delta step predictedDelta bit |
	<primitive: 'primitiveDecodeMono' module: 'ADPCMCodecPlugin'>
	self var: #stepSizeTable declareC: 'short int *stepSizeTable'.
	self var: #indexTable declareC: 'short int *indexTable'.
	self var: #samples declareC: 'short int *samples'.
	self var: #encodedBytes declareC: 'unsigned char *encodedBytes'.

	1 to: count do: [:i |
		(i bitAnd: frameSizeMask) = 1
			ifTrue: [  "start of frame; read frame header"
				predicted _ self nextBits: 16.
				predicted > 32767 ifTrue: [predicted _ predicted - 65536].
				index _ self nextBits: 6.
				samples at: (sampleIndex _ sampleIndex + 1) put: predicted]
			ifFalse: [
				delta _ self nextBits: bitsPerSample.
				step _ stepSizeTable at: index + 1.
				predictedDelta _ 0.
				bit _ deltaValueHighBit.
				[bit > 0] whileTrue: [
					(delta bitAnd: bit) > 0 ifTrue: [predictedDelta _ predictedDelta + step].
					step _ step bitShift: -1.
					bit _ bit bitShift: -1].
				predictedDelta _ predictedDelta + step.

				(delta bitAnd: deltaSignMask) > 0
					ifTrue: [predicted _ predicted - predictedDelta]
					ifFalse: [predicted _ predicted + predictedDelta].
				predicted > 32767
					ifTrue: [predicted _ 32767]
					ifFalse: [predicted < -32768 ifTrue: [predicted _ -32768]].

				index _ index + (indexTable at: (delta bitAnd: deltaValueMask) + 1).
				index < 0
					ifTrue: [index _ 0]
					ifFalse: [index > 88 ifTrue: [index _ 88]].

				samples at: (sampleIndex _ sampleIndex + 1) put: predicted]].
! !

!ADPCMCodec methodsFor: 'private' stamp: 'ar 4/23/2001 15:11'!
privateDecodeStereo: count

	| predictedLeft predictedRight indexLeft indexRight deltaLeft deltaRight
	 stepLeft stepRight predictedDeltaLeft predictedDeltaRight bit |

	<primitive: 'primitiveDecodeStereo' module: 'ADPCMCodecPlugin'>
	self var: #stepSizeTable declareC: 'short int *stepSizeTable'.
	self var: #indexTable declareC: 'short int *indexTable'.
	self var: #samples declareC: 'short int *samples'.
	self var: #encodedBytes declareC: 'unsigned char *encodedBytes'.
	self var: #rightSamples declareC: 'short int *rightSamples'.
	self var: #predicted declareC: 'short int *predicted'.
	self var: #index declareC: 'short int *index'.

	"make local copies of decoder state variables"
	predictedLeft _ predicted at: 1.
	predictedRight _ predicted at: 2.
	indexLeft _ index at: 1.
	indexRight _ index at: 2.

	1 to: count do: [:i |
		(i bitAnd: frameSizeMask) = 1
			ifTrue: [  "start of frame; read frame header"
				predictedLeft _ self nextBits: 16.
				indexLeft _ self nextBits: 6.
				predictedRight _ self nextBits: 16.
				indexRight _ self nextBits: 6.
				predictedLeft > 32767 ifTrue: [predictedLeft _ predictedLeft - 65536].
				predictedRight > 32767 ifTrue: [predictedRight _ predictedRight - 65536].
				samples at: (sampleIndex _ sampleIndex + 1) put: predictedLeft.
				rightSamples at: sampleIndex put: predictedRight]
			ifFalse: [
				deltaLeft _ self nextBits: bitsPerSample.
				deltaRight _ self nextBits: bitsPerSample.
				stepLeft _ stepSizeTable at: indexLeft + 1.
				stepRight _ stepSizeTable at: indexRight + 1.
				predictedDeltaLeft _ predictedDeltaRight _ 0.
				bit _ deltaValueHighBit.
				[bit > 0] whileTrue: [
					(deltaLeft bitAnd: bit) > 0 ifTrue: [
						predictedDeltaLeft _ predictedDeltaLeft + stepLeft].
					(deltaRight bitAnd: bit) > 0 ifTrue: [
						predictedDeltaRight _ predictedDeltaRight + stepRight].
					stepLeft _ stepLeft bitShift: -1.
					stepRight _ stepRight bitShift: -1.
					bit _ bit bitShift: -1].
				predictedDeltaLeft _ predictedDeltaLeft + stepLeft.
				predictedDeltaRight _ predictedDeltaRight + stepRight.

				(deltaLeft bitAnd: deltaSignMask) > 0
					ifTrue: [predictedLeft _ predictedLeft - predictedDeltaLeft]
					ifFalse: [predictedLeft _ predictedLeft + predictedDeltaLeft].
				(deltaRight bitAnd: deltaSignMask) > 0
					ifTrue: [predictedRight _ predictedRight - predictedDeltaRight]
					ifFalse: [predictedRight _ predictedRight + predictedDeltaRight].
				predictedLeft > 32767
					ifTrue: [predictedLeft _ 32767]
					ifFalse: [predictedLeft < -32768 ifTrue: [predictedLeft _ -32768]].
				predictedRight > 32767
					ifTrue: [predictedRight _ 32767]
					ifFalse: [predictedRight < -32768 ifTrue: [predictedRight _ -32768]].

				indexLeft _ indexLeft + (indexTable at: (deltaLeft bitAnd: deltaValueMask) + 1).
				indexLeft < 0
					ifTrue: [indexLeft _ 0]
					ifFalse: [indexLeft > 88 ifTrue: [indexLeft _ 88]].
				indexRight _ indexRight + (indexTable at: (deltaRight bitAnd: deltaValueMask) + 1).
				indexRight < 0
					ifTrue: [indexRight _ 0]
					ifFalse: [indexRight > 88 ifTrue: [indexRight _ 88]].

				samples at: (sampleIndex _ sampleIndex + 1) put: predictedLeft.
				rightSamples at: sampleIndex put: predictedRight]].

	"save local copies of decoder state variables"
	predicted at: 1 put: predictedLeft.
	predicted at: 2 put: predictedRight.
	index at: 1 put: indexLeft.
	index at: 2 put: indexRight.
! !

!ADPCMCodec methodsFor: 'private' stamp: 'ar 4/23/2001 15:11'!
privateEncodeMono: count

	| step sign diff delta predictedDelta bit p |
	<primitive: 'primitiveEncodeMono' module: 'ADPCMCodecPlugin'>
	self var: #stepSizeTable declareC: 'short int *stepSizeTable'.
	self var: #indexTable declareC: 'short int *indexTable'.
	self var: #samples declareC: 'short int *samples'.
	self var: #encodedBytes declareC: 'unsigned char *encodedBytes'.

	step _ stepSizeTable at: 1.
	1 to: count do: [:i |
		(i bitAnd: frameSizeMask) = 1 ifTrue: [
			predicted _ samples at: (sampleIndex _ sampleIndex + 1).
			(p _ predicted) < 0 ifTrue: [p _ p + 65536].
			self nextBits: 16 put: p.
			i < count ifTrue: [
				index _ self indexForDeltaFrom: predicted to: (samples at: sampleIndex + 1)].
			self nextBits: 6 put: index.
		] ifFalse: [
			"compute sign and magnitude of difference from the predicted sample"
			sign _ 0.
			diff _ (samples at: (sampleIndex _ sampleIndex + 1)) - predicted.
			diff < 0 ifTrue: [
				sign _ deltaSignMask.
				diff _ 0 - diff].

			"Compute encoded delta and the difference that this will cause in the predicted sample value during decoding. Note that this code approximates:
				delta _ (4 * diff) / step.
				predictedDelta _ ((delta + 0.5) * step) / 4;
			but in the shift step bits are dropped. Thus, even if you have fast mul/div hardware you cannot use it since you would get slightly different bits what than the algorithm defines."
			delta _ 0.
			predictedDelta _ 0.
			bit _ deltaValueHighBit.
			[bit > 0] whileTrue: [
				diff >= step ifTrue: [
					delta _ delta + bit.
					predictedDelta _ predictedDelta + step.
					diff _ diff - step].
				step _ step bitShift: -1.
				bit _ bit bitShift: -1].
			predictedDelta _ predictedDelta + step.

			"compute and clamp new prediction"
			sign > 0
				ifTrue: [predicted _ predicted - predictedDelta]
				ifFalse: [predicted _ predicted + predictedDelta].
			predicted > 32767
				ifTrue: [predicted _ 32767]
				ifFalse: [predicted < -32768 ifTrue: [predicted _ -32768]].

			"compute new index and step values"
			index _ index + (indexTable at: delta + 1).
			index < 0
				ifTrue: [index _ 0]
				ifFalse: [index > 88 ifTrue: [index _ 88]].
			step _ stepSizeTable at: index + 1.

			"output encoded, signed delta"
			self nextBits: bitsPerSample put: (sign bitOr: