[FIX] TransfoimingAMorphFix

Lic. Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Thu Aug 22 20:40:52 UTC 2002


Skipped content of type multipart/alternative-------------- next part --------------
'From Squeak3.2 of 11 July 2002 [latest update: #4956] on 22 August 2002 at 5:04:12 pm'!
StringMorph subclass: #InfoMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SqueakRos'!
InfoMorph class
	instanceVariableNames: ''!
Object subclass: #NewPolygon
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SqueakRos'!

!NewPolygon commentStamp: '<historical>' prior: 0!
"Solo sirve cuando en el Mundo actual hay dos poligonos que se  
	intersectan
Los pol’gonos originales deben estar compuestos por rectas "!

NewPolygon class
	instanceVariableNames: ''!
TrashCanMorph subclass: #SmartTrashCanMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SqueakRos'!

!FileList2 methodsFor: 'as yet unclassified' stamp: 'mir 11/15/2001 18:20'!
limitedSuperSwikiDirectoryList

	| dir nameToShow dirList |

	dirList _ OrderedCollection new.
	ServerDirectory serverNames do: [ :n | 
		dir _ ServerDirectory serverNamed: n.
		dir isProjectSwiki ifTrue: [
			nameToShow _ n.
			dirList add: ((dir directoryWrapperClass with: dir name: nameToShow model: self)
				balloonText: dir realUrl)
		].
	].
	ServerDirectory localProjectDirectories do: [ :each |
		dirList add: (FileDirectoryWrapper with: each name: each localName model: self)
	].
	(dirList anySatisfy: [:each | each withoutListWrapper acceptsUploads])
		ifFalse: [dirList add: (FileDirectoryWrapper with: FileDirectory default name: FileDirectory default localName model: self)].
	^dirList! !


!InfoMorph methodsFor: 'as yet unclassified' stamp: 'EDC 6/26/2002 15:34'!
cambio: s
info contents:s! !

!InfoMorph methodsFor: 'initialization' stamp: 'EDC 2/20/2002 11:30'!
initialize
	super initialize.
	showSeconds _ true.
	self step! !

!InfoMorph methodsFor: 'initialization' stamp: 'EDC 2/20/2002 11:39'!
initializeToStandAlone
	super initializeToStandAlone.
	self step! !

!InfoMorph methodsFor: 'step' stamp: 'EDC 2/20/2002 11:33'!
step
	| time |
	super step.
	time _ Sensor peekMousePt.
self contents: time asString! !

!InfoMorph methodsFor: 'step' stamp: 'EDC 2/20/2002 11:30'!
stepTime
	"Answer the desired time between steps in milliseconds."

	^ 1000! !


!InfoMorph class methodsFor: 'parts bin' stamp: 'EDC 2/20/2002 11:30'!
authoringPrototype
	^ super authoringPrototype contents: Time now printString! !

!InfoMorph class methodsFor: 'parts bin' stamp: 'EDC 2/20/2002 11:30'!
descriptionForPartsBin
	^ self partName:	'Clock'
		categories:		#('Useful')
		documentation:	'A digital clock'! !


!MatrixTransform2x3 methodsFor: 'objects from disk' stamp: 'EDC 8/21/2002 09:09'!
restoreEndianness "Valido solo en Mac"
^ self! !


!NewPolygon class methodsFor: 'as yet unclassified' stamp: 'EDC 8/17/2002 06:42'!
centro: newVertices
| nuevoPoly |
nuevoPoly _ PolygonMorph
		vertices: newVertices asArray
		color: Color yellow
		borderWidth: 2
		borderColor: Color red.
^nuevoPoly center.! !

!NewPolygon class methodsFor: 'as yet unclassified' stamp: 'EDC 8/19/2002 17:43'!
dibujar: newVertices
| nuevoPoly |
nuevoPoly _ PolygonMorph
		vertices: newVertices asArray
		color: Color yellow
		borderWidth: 2
		borderColor: Color red.
nuevoPoly openInWorld.
^ nuevoPoly .! !

!NewPolygon class methodsFor: 'as yet unclassified' stamp: 'EDC 8/16/2002 17:53'!
intersectFrom: pt1Start to: pt1End with: pt2Start to: pt2End 
	| det deltaPt alpha beta pt1Dir pt2Dir p |
	pt1Dir _ pt1End - pt1Start.
	pt2Dir _ pt2End - pt2Start.
	det _ pt1Dir x * pt2Dir y - (pt1Dir y * pt2Dir x).
	deltaPt _ pt2Start - pt1Start.
	alpha _ deltaPt x * pt2Dir y - (deltaPt y * pt2Dir x).
	beta _ deltaPt x * pt1Dir y - (deltaPt y * pt1Dir x).
	det = 0
		ifTrue: [^ nil].
	"no intersection"
	alpha * det < 0
		ifTrue: [^ nil].
	beta * det < 0
		ifTrue: [^ nil].
	det > 0
		ifTrue: [(alpha > det
					or: [beta > det])
				ifTrue: [^ nil]]
		ifFalse: [(alpha < det
					or: [beta < det])
				ifTrue: [^ nil]].
	"And compute intersection"
	p _ pt1Start + (alpha * pt1Dir / (det @ det)).
p _ p  x asInteger @ p y asInteger.
^ p! !

!NewPolygon class methodsFor: 'as yet unclassified' stamp: 'EDC 8/17/2002 08:53'!
union
	"Solo sirve cuando en el Mundo actual hay dos poligonos que se  
	intersectan"
	| pol nuevosVertices v  c puntoInterseccion l1 l2 polUnion|
	nuevosVertices _ OrderedCollection new.
 nuevosVertices _ OrderedCollection new.
	
	pol _ ActiveWorld submorphs
				select: [:any | any class == PolygonMorph]
				thenCollect: [:p | p].
	
	pol
		do: [:simple | 
			v _ simple vertices
						collect: [:each | each x asInteger @ each y asInteger].
			simple setVertices: v].
 "Agregar los puntos del primer poligono no contenidos en el segundo".
pol first vertices do: [ :each | (pol last  containsPoint: each)  ifFalse: [ nuevosVertices add: each ]].

 "Agregar los puntos resultantes de las intersecciones de las lineas del primer poligono con el segundo".
	pol first lineSegments do:[:s1 |
					pol last lineSegments
						do: [ :s2 | l1 _ LineMorph from: (s1 at: 1) to: (s1 at: 2) color: Color red width: 2.
l1 openInWorld.
 l2 _ LineMorph from: (s2 at: 1) to: (s2 at: 2) color: Color green width: 2.
l2 openInWorld.
ActiveWorld displayWorld.
(Delay forSeconds: 3) wait.
((s1 at: 1)
									to: (s1 at: 2)
									intersects: (s2 at: 1)
									to: (s2 at: 2)) ifTrue: [puntoInterseccion _ self
												intersectFrom: (s1 at: 1)
												to: (s1 at: 2)
												with: (s2 at: 1)
												to:(s2 at: 2).



									nuevosVertices add: puntoInterseccion.
									c _ self centro: nuevosVertices.
"Ordenar los puntos de acuerdo a su centro "
nuevosVertices := (nuevosVertices asSortedCollection: [ :a :b | (a-c) degrees < (b-c) degrees ]) .
"Mostrar el poligono resultante por tres segundos y borrar"
polUnion _ self dibujar: nuevosVertices.
polUnion openInWorld.
ActiveWorld displayWorld.
(Delay forSeconds: 3) wait.
polUnion delete. 
 ].
l1 delete.
l2 delete]].
"Agregar los puntos del segundo  poligono no contenidos en el primero".
pol last  vertices do: [ :each | (pol  first containsPoint: each)  ifFalse: [ nuevosVertices add: each ]].
"Mostrar el poligono resultante "
c _ self centro: nuevosVertices.
"Ordenar los puntos de acuerdo a su centro "
nuevosVertices := (nuevosVertices asSortedCollection: [ :a :b | (a-c) degrees < (b-c) degrees ]) .
polUnion _ self dibujar: nuevosVertices.
polUnion openInWorld.



! !


!PolygonMorph methodsFor: 'geometry' stamp: 'EDC 3/20/2002 14:24'!
flipHAroundX: centerX
	"Flip me horizontally around the center.  If centerX is nil, compute my center of gravity."

	| cent |
	cent _ centerX 
		ifNil: [bounds center x
			"cent _ 0.
			vertices do: [:each | cent _ cent + each x].
			cent asFloat / vertices size"]		"average is the center"
		ifNotNil: [centerX].
	self setVertices: (vertices collect: [:vv |
			((vv x - cent) * -1 + cent) @ vv y]) reversed.! !


!SmartTrashCanMorph methodsFor: 'as yet unclassified' stamp: 'EDC 7/30/2002 16:13'!
acceptDroppingMorph: aMorph event:  evt 
 ActiveWorld submorphs copy do: [:each | (each class  == aMorph class ) ifTrue: [each delete]].

! !

!SmartTrashCanMorph methodsFor: 'initialization' stamp: 'EDC 3/11/2002 05:35'!
initialize
	"Initialize the receiver's graphics, name, and balloon-help"
	super initialize.
	self image: TrashPicOn;
		 offImage: TrashPic;
		 pressedImage: TrashPicOn.
	self setNameTo: 'Trash'.
	self setBalloonText: 'Para eliminar todos los objetos de una misma clase, arrastre uno de ellos dentro del tacho'! !

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/octet-stream
Size: 119261 bytes
Desc: not available
Url : http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20020822/52fdad78/attachment.obj


More information about the Squeak-dev mailing list