[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 polgonos 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
|