'From etoys3.0 of 24 February 2008 [latest update: #2081] on 25 September 2008 at 4:37:27 pm'!
"Change Set:		lastEdits-bf-tak-mir
Date:			25 September 2008
Author:			Takashi Yamamiya, Bert Freudenberg, and Michael Rueger

Clean up some code."
g!


!BitBlt methodsFor: 'private' stamp: 'mir 9/25/2008 15:03'!
cachedFontColormapFrom: sourceDepth to: destDepth
	"Modified from computeColormapFrom:to:."

	| srcIndex map |
	CachedFontColorMaps class == Array 
		ifFalse: [CachedFontColorMaps _ (1 to: 9) collect: [:i | Array new: 32]].
	srcIndex _ sourceDepth.
	sourceDepth > 8 ifTrue: [srcIndex _ 9].
	(map _ (CachedFontColorMaps at: srcIndex) at: destDepth) ~~ nil ifTrue: [^ map].

	map _ (Color cachedColormapFrom: sourceDepth to: destDepth) copy.
	(CachedFontColorMaps at: srcIndex) at: destDepth put: map.
	^ map
! !


!Browser methodsFor: 'accessing' stamp: 'tak 9/25/2008 14:58'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	messageCategoryListIndex > 0 & (messageListIndex = 0)
		ifTrue: [^ 1 to: 500]	"entire empty method template"
		ifFalse: [^ 1 to: 0]		"null selection"! !

!Browser methodsFor: 'message list' stamp: 'tak 9/25/2008 15:00'!
messageList
	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
	| sel |
	(sel _ self messageCategoryListSelection) ifNil: [
		^ self classOrMetaClassOrganizer
			ifNil:		[Array new]
			ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]
	].

	^ sel = ClassOrganizer allCategory ifTrue:  [
		self classOrMetaClassOrganizer
			ifNil:		[Array new]
			ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]]
		ifFalse:
			[(self classOrMetaClassOrganizer listAtCategoryNumber: messageCategoryListIndex - 1)
				ifNil: [messageCategoryListIndex _ 0.  Array new]]! !

!Browser methodsFor: 'metaclass' stamp: 'mir 9/25/2008 14:56'!
classMessagesIndicated
	"Answer whether the messages to be presented should come from the metaclass."

	^ self metaClassIndicated and: [self classCommentIndicated not]! !


!Class methodsFor: 'initialize-release' stamp: 'mir 9/25/2008 15:05'!
unload
	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."
	""
! !

!Class methodsFor: 'subclass creation' stamp: 'tak 9/25/2008 15:00'!
weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables."
	^(ClassBuilder new)
		superclass: self
		weakSubclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !


!ChangeList class methodsFor: 'public access' stamp: 'tak 9/25/2008 16:25'!
browseRecent: charCount 
	"ChangeList browseRecent: 5000"
	"Opens a changeList on the end of the changes log file"
	"The core was moved to browserRecent:on:."
	^ self browseRecent: charCount on: (SourceFiles at: 2) ! !


!Debugger class methodsFor: 'class initialization' stamp: 'tak 9/25/2008 15:10'!
initialize
	ErrorRecursion := false.
	ContextStackKeystrokes _ Dictionary new
		at: $e put: #send;
		at: $t put: #doStep;
		at: $T put: #stepIntoBlock;
		at: $p put: #proceed;
		at: $r put: #restart;
		at: $f put: #fullStack;
		at: $w put: #where;
		yourself.

	"Debugger initialize"! !


!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'tak 9/25/2008 15:15'!
computeSignatureForMessageHash: hash privateKey: privateKey
	"Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)."

	| p q g x r s k tmp |
	p _ privateKey first.
	q _ privateKey second.
	g _ privateKey third.
	x _ privateKey fourth.

	r _ s _ 0.
	[r = 0 or: [s = 0]] whileTrue: [
		k _ self nextRandom160 \\ q.
		r _ (g raisedTo: k modulo: p) \\ q.
		tmp _ (hash + (x * r)) \\ q.
		s _ ((self inverseOf: k mod: q) * tmp) \\ q].

	^ Array with: r with: s.
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'tak 9/25/2008 15:16'!
generateKeySet
	"Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature."
	"Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!!"

	| qAndPandS q p exp g h x y |
	qAndPandS _ self generateQandP.
	Transcript show: 'Computing g...'.
	q _ qAndPandS first.
	p _ qAndPandS second.
	exp _ (p - 1) / q.
	h _ 2.
	[g _ h raisedTo: exp modulo: p. g = 1] whileTrue: [h _ h + 1].
	Transcript show: 'done.'; cr.
	Transcript show: 'Computing x and y...'.
	x _ self nextRandom160.
	y _ g raisedTo: x modulo: p.
	Transcript show: 'done.'; cr.
	Transcript show: 'Key generation complete!!'; cr.
	^ Array
		with: (Array with: p with: q with: g with: x)
		with: (Array with: p with: q with: g with: y).
! !

!DigitalSignatureAlgorithm methodsFor: 'public' stamp: 'bf 9/25/2008 15:15'!
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey
	"Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)."

	| p q g y r s w u1 u2 v0 v |
	p _ publicKey first.
	q _ publicKey second.
	g _ publicKey third.
	y _ publicKey fourth.
	r _ aSignature first.
	s _ aSignature last.
	((r > 0) and: [r < q]) ifFalse: [^ false].  "reject"
	((s > 0) and: [s < q]) ifFalse: [^ false].  "reject"

	w _ self inverseOf: s mod: q.
	u1 _ (hash * w) \\ q.
	u2 _ (r * w) \\ q.
	v0 _ (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p).
	v _ ( v0 \\ p) \\ q.
	^ v = r.
! !

!DigitalSignatureAlgorithm methodsFor: 'large integer arithmetic' stamp: 'bf 9/25/2008 15:15'!
isProbablyPrime: p
	"Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)."

	| iterations factor pMinusOne b m r a j z couldBePrime |
	iterations _ 50.  "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)"

	"quick elimination: check for p divisible by a small prime"
	SmallPrimes ifNil: [  "generate list of small primes > 2"
		SmallPrimes _ Integer primesUpTo: 2000.
		SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size].
	factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil].
	factor ifNotNil: [^ p = factor].

	pMinusOne _ p - 1.
	b _ self logOfLargestPowerOfTwoDividing: pMinusOne.
	m _ pMinusOne // (2 raisedTo: b).
	"Assert: pMinusOne = m * (2 raisedTo: b) and m is odd"

	Transcript show: '      Prime test pass '.
	r _ Random new.
	1 to: iterations do: [:i |
		Transcript show: i printString; space.
		a _ (r next * 16rFFFFFF) truncated.
		j _ 0.
		z _ (a raisedTo: m modulo: p) normalize.
		couldBePrime _ z = 1.
		[couldBePrime] whileFalse: [
			z = 1 ifTrue: [Transcript show: 'failed!!'; cr. ^ false].  "not prime"
			z = pMinusOne
				ifTrue: [couldBePrime _ true]
				ifFalse: [
					(j _ j + 1) < b
						ifTrue: [z _ (z * z) \\ p]
						ifFalse: [Transcript show: 'failed!!'; cr. ^ false]]]].  "not prime"

	Transcript show: 'passed!!'; cr.
	^ true  "passed all tests; probably prime."
! !


!EndOfStream methodsFor: 'description' stamp: 'mir 9/25/2008 15:16'!
isResumable
	"EndOfStream is resumable, so ReadStream>>next can answer."

	^ true! !


!ExternalData methodsFor: 'conversion' stamp: 'tak 9/25/2008 15:08'!
fromCString
	"Based on earlier implementation of FFI."
	"Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18"

	| stream index char |
	type isPointerType ifFalse: [self error: 'External object is not a pointer type.'].
	stream := WriteStream on: String new.
	index _ 1.
	[(char := handle unsignedCharAt: index) = 0 asCharacter] whileFalse: [
		stream nextPut: char.
		index := index + 1].
	^stream contents! !


!FlashMorphReader class methodsFor: 'read Flash file' stamp: 'tak 9/25/2008 15:06'!
openAsFlash: fullFileName
	"Open a MoviePlayerMorph on the file (must be in .movie format)."
	| f player |
	f := (FileStream readOnlyFileNamed: fullFileName) binary.
	player := (FlashMorphReader on: f) processFile.
	player startPlaying.
	player open.
! !


!HTTPSocket class methodsFor: 'get the page' stamp: 'tak 9/25/2008 15:09'!
httpGet: url args: args accept: mimeType
	^self httpGet: url args: args accept: mimeType request: ''! !

!HTTPSocket class methodsFor: 'utilities' stamp: 'tak 9/25/2008 15:09'!
userAgentString 
	"self userAgentString."

	^'User-Agent: ',
		SystemVersion current version, '-', 
		SystemVersion current highestUpdate printString! !


!Integer methodsFor: 'arithmetic' stamp: 'bf 9/25/2008 15:13'!
\\\ anInteger 
	"a modulo method for use in DSA. Be careful if you try to use this elsewhere."

	^self \\ anInteger! !

!Integer methodsFor: 'mathematical functions' stamp: 'tak 9/25/2008 15:13'!
raisedTo: y modulo: n
	"Answer the modular exponential. Code by Jesse Welton."
	| s t u |
	s _ 1.
	t _ self.
	u _ y.
	[u = 0] whileFalse: [
		u odd ifTrue: [
			s _ s * t.
			s >= n ifTrue: [s _ s \\\ n]].
		t _ t * t.
		t >= n ifTrue: [t _ t \\\ n].
		u _ u bitShift: -1].
	^ s.
! !

!Integer methodsFor: 'bit manipulation' stamp: 'tak 9/25/2008 15:17'!
bitInvert
	"Answer an Integer whose bits are the logical negation of the receiver's bits.
	Numbers are interpreted as having 2's-complement representation."

	^ -1 - self.! !


!LedDigitMorph class methodsFor: 'class initialization' stamp: 'mir 9/25/2008 15:17'!
initialize
	HSegmentOrigins _ {0.2@0.1. 0.2@0.45. 0.2@0.8}.
	VSegmentOrigins _ {0.1@0.2. 0.1@0.55. 0.8@0.2. 0.8@0.55}.
	HSegments _ {
		{true. false. true}.
		{false. false. false}.
		{true. true. true}.
		{true. true. true}.
		{false. true. false}.
		{true. true. true}.
		{true. true. true}.
		{true. false. false}.
		{true. true. true}.
		{true. true. true}.
		{false. true. false}}.
	VSegments _ {
		{true. true. true. true}.
		{false. false. true. true}.
		{false. true. true. false}.
		{false. false. true. true}.
		{true. false. true. true}.
		{true. false. false. true}.
		{true. true. false. true}.
		{false. false. true. true}.
		{true. true. true. true}.
		{true. false. true. true}.
		{false. false. false. false}}.! !


!MacFileDirectory class methodsFor: 'platform specific' stamp: 'bf 9/25/2008 15:06'!
maxFileNameLength

	^ 32-1! !


!ObjectTracer methodsFor: 'very few messages' stamp: 'bf 9/25/2008 15:02'!
doesNotUnderstand: aMessage 
	"All external messages (those not caused by the re-send) get trapped here."
	"Present a dubugger before proceeding to re-send the message."

	Debugger openContext: thisContext
				label: 'About to perform: ', aMessage selector
				contents: nil.
	^ aMessage sentTo: tracedObject.
! !


!PackageInfo methodsFor: 'listing' stamp: 'mir 9/25/2008 15:38'!
classes
	^(self systemCategories gather: [:cat |
		(SystemOrganization listAtCategoryNamed: cat)
			collect: [:className | Smalltalk at: className]])
				sortBy: [:a :b | a className <= b className]! !


!PackagePaneBrowser methodsFor: 'class list' stamp: 'bf 9/25/2008 14:56'!
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection exists."

	| name envt |
	(name _ self selectedClassName) ifNil: [^ nil].
	"(envt _ self selectedEnvironment) ifNil: [^ nil]."
	envt_(Smalltalk environmentForCategory: self selectedSystemCategoryName).
	^ envt at: name! !


!PseudoClass methodsFor: 'fileIn/fileOut' stamp: 'mir 9/25/2008 15:04'!
fileOutDefinitionOn: aStream
	self hasDefinition ifFalse:[^self].
	aStream nextChunkPut: self definition; cr.
	self hasComment ifTrue: [
		aStream cr.
		self organization commentRemoteStr fileOutOn: aStream]! !


!ServerDirectory methodsFor: 'up/download' stamp: 'mir 9/25/2008 15:11'!
fileExists: fileName
	"Does the file exist on this server directory?  fileName must be simple with no / or references to other directories."

	| stream |
	self isTypeFile ifTrue: [^ self fileNames includes: fileName].
	self isTypeHTTP ifTrue: [
		"http"
		stream _ self readOnlyFileNamed: fileName.
		^stream contents notEmpty].
	"ftp"
	^ self entries anySatisfy: [:entry | entry name = fileName]! !

!ServerDirectory methodsFor: 'up/download' stamp: 'tak 9/25/2008 15:12'!
getFileNamed: fileNameOnServer into: dataStream
	
	^ self getFileNamed: fileNameOnServer into: dataStream
		httpRequest: 'Pragma: no-cache', String crlf! !

!ServerDirectory methodsFor: 'file directory' stamp: 'tak 9/25/2008 15:13'!
directoryNamed: localFileName 
	"Return a copy of me pointing at this directory below me"
	| new newPath newAltUrl |
	new _ self copy.
	urlObject ifNotNil: [
		new urlObject path: new urlObject path copy.
		new urlObject path removeLast; addLast: localFileName; addLast: ''.
		^ new].
	"sbw.  When working from an FTP server, the first time we access
	a subdirectory the <directory> variable is empty.  In that case we
	cannot begin with a leading path delimiter since that leads us to
	the wrong place."
	newPath _ directory isEmpty
				ifTrue: [localFileName]
				ifFalse: [directory , self pathNameDelimiter asString , localFileName].
	self altUrl ifNotNil: [
		newAltUrl _ self altUrl, self pathNameDelimiter asString , localFileName].
	new directory: newPath; altUrl: newAltUrl.
	^ new! !

!ServerDirectory methodsFor: 'file directory' stamp: 'tak 9/25/2008 15:12'!
fullNameFor: aFileName
	"Convention: 
	If it is an absolute path, directory stored with a leading slash, and url has no user@.
	If relative path, directory stored with no leading slash, and url begins user@.
	Should we include ftp:// on the front?"

	urlObject ifNotNil: [^ urlObject pathString, aFileName].
	(aFileName includes: self pathNameDelimiter)
		ifTrue: [^ aFileName].
	self isTypeHTTP ifTrue: [^ self downloadUrl, aFileName].
	directory isEmpty ifTrue: [^ server,  self pathNameDelimiter asString, aFileName].
	^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), 
		server, self slashDirectory, 
		self pathNameDelimiter asString, aFileName! !

!ServerDirectory methodsFor: 'file directory' stamp: 'bf 9/25/2008 15:11'!
localName

	directory isEmpty ifTrue: [self error: 'no directory'].
	^ self localNameFor: directory.! !

!ServerDirectory methodsFor: 'file directory' stamp: 'mir 9/25/2008 15:11'!
localPathExists: localPath

	^ self directoryNames includes: localPath! !


!ServerDirectory class methodsFor: 'misc' stamp: 'tak 9/25/2008 15:10'!
on: pathString

	^ self new on: pathString! !


!SimpleServiceEntry methodsFor: 'accessing' stamp: 'tak 9/25/2008 16:09'!
label
	^label! !

!SimpleServiceEntry methodsFor: 'services menu' stamp: 'tak 9/25/2008 15:10'!
useLineAfter

	^ useLineAfter == true! !

!SimpleServiceEntry methodsFor: 'services menu' stamp: 'tak 9/25/2008 15:10'!
useLineAfter: aBoolean

	useLineAfter := aBoolean
! !


!SmallInteger methodsFor: 'arithmetic' stamp: 'tak 9/25/2008 15:14'!
/ aNumber 
	"Primitive. This primitive (for /) divides the receiver by the argument
	and returns the result if the division is exact. Fail if the result is not a
	whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional.
	No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 10>
	aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal].
	^(aNumber isMemberOf: SmallInteger)
		ifTrue: [(Fraction numerator: self denominator: aNumber) reduced]
		ifFalse: [super / aNumber]! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'bf 9/25/2008 15:18'!
bitAnd: arg 
	"Primitive. Answer an Integer whose bits are the logical OR of the
	receiver's bits and those of the argument, arg.
	Numbers are interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 14>
	self >= 0 ifTrue: [^ arg bitAnd: self].
	^ (self bitInvert bitOr: arg bitInvert) bitInvert.! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'mir 9/25/2008 15:18'!
bitShift: arg 
	"Primitive. Answer an Integer whose value is the receiver's value shifted
	left by the number of bits indicated by the argument. Negative arguments
	shift right. The receiver is interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 17>
	self >= 0 ifTrue: [^ super bitShift: arg].
	^ arg >= 0
		ifTrue: [(self negated bitShift: arg) negated]
		ifFalse: [(self bitInvert bitShift: arg) bitInvert].! !

!SmallInteger methodsFor: 'bit manipulation' stamp: 'mir 9/25/2008 15:18'!
bitXor: arg 
	"Primitive. Answer an Integer whose bits are the logical XOR of the
	receiver's bits and those of the argument, arg.
	Numbers are interpreted as having 2's-complement representation.
	Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 16>
	self >= 0 ifTrue: [^ arg bitXor: self].
	^ arg < 0
		ifTrue: [self bitInvert bitXor: arg bitInvert]
		ifFalse: [(self bitInvert bitXor: arg) bitInvert].! !


!SystemWindow methodsFor: 'events' stamp: 'bf 9/25/2008 14:58'!
doFastFrameDrag: grabPoint
	"Do fast frame dragging from the given point"
	"modified from doFastFrameDrag."

	| offset newBounds outerWorldBounds |
	outerWorldBounds _ self boundsIn: nil.
	offset _ outerWorldBounds origin - grabPoint.
	newBounds _ outerWorldBounds newRectFrom: [:f | 
		Sensor cursorPoint + offset extent: outerWorldBounds extent].
	self position: (self globalPointToLocal: newBounds topLeft); comeToFront! !

!SystemWindow methodsFor: 'events' stamp: 'bf 9/25/2008 14:58'!
mouseMove: evt
	"Handle a mouse-move event"

	| cp |
	cp _ evt cursorPoint.
	self valueOfProperty: #clickPoint ifPresentDo: 
		[:firstClick |
		((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue:
		["If this is a drag that started in the title bar, then pick me up"
		^ self isSticky ifFalse:
			[self fastFramingOn 
				ifTrue: [self doFastFrameDrag: firstClick] "pass the first click."
				ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]].
	model windowActiveOnFirstClick ifTrue:
		["Normally window takes control on first click.
		Need explicit transmission for first-click activity."
		submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]]! !


!Tetris methodsFor: 'event handling' stamp: 'tak 9/25/2008 14:57'!
handlesMouseOver: evt
	^true
! !


!TetrisBoard methodsFor: 'testing' stamp: 'bf 9/25/2008 14:55'!
stepTime
	^ delay! !


!WatchMorph methodsFor: 'accessing' stamp: 'bf 9/25/2008 15:17'!
handsColor: aColor

	handsColor := aColor! !

!WatchMorph methodsFor: 'stepping and presenter' stamp: 'bf 9/25/2008 15:17'!
step

	self changed.! !

LedDigitMorph initialize!
Debugger initialize!