[FIX] Miscellaneous fixes

Bert Freudenberg bert at isgnw.CS.Uni-Magdeburg.De
Mon Sep 27 08:04:56 UTC 1999


-Restores Morph's 'inspect in MVC' feature.
-Disallows repositioning the world.
-Fixes a bug when shadow-drawing a translucent polygon morph (fillstyle
 was a Bitmap instead of InfiniteForm).
-Makes pasteUpMorph>>patchAt:without:andNothingAbove: really fill outside
 areas with black, as stated in it's comment (it's still off by 1 pixel
 though)
-Makes SelectionMenu class>>selections: accept non-string values
-Makes moving dirty change sorters possible by not re-activating a
 SystemWindow if it's already on top

  /bert

Content-Type: TEXT/PLAIN; charset=US-ASCII; name="MiscFixes-bf.24Sep1216pm.cs"
Content-ID: <Pine.LNX.3.96.990927100456.31728E at balloon.cs.uni-magdeburg.de>
Content-Description: 

'From Squeak 2.5 of August 6, 1999 on 24 September 1999 at 12:16:39 pm'!
"Change Set:		miscfixes-bf
Date:			22 September 1999
Author:			Bert Freudenberg

-Restores Morph's 'inspect in MVC' feature.
-Disallows repositioning the world.
-Fixes a bug when shadow-drawing a translucent polygon morph (fillstyle was a Bitmap instead of InfiniteForm).
-Makes pasteUpMorph>>patchAt:without:andNothingAbove: really fill outside areas with black, as stated in it's comment (it's still off by 1 pixel though)
-Makes SelectionMenu class>>selections: accept non-string values
-Makes moving dirty change sorters possible by not re-activating a SystemWindow if it's already on top"!


!FormCanvas methodsFor: 'drawing-polygons' stamp: 'bf 9/22/1999 10:04'!
drawPolygon: vertices fillStyle: aFillStyle borderWidth: bw borderColor: bc
	"Use a BalloonCanvas"
	self asBalloonCanvas 
		drawPolygon: vertices 
		fillStyle: (shadowDrawing
			ifTrue:[self flag: #fixThis.
				(shadowStipple isKindOf: Bitmap)
					ifTrue: [InfiniteForm with: (Form extent: 2 at 2 depth: 1 bits: shadowStipple)]
					ifFalse: [shadowStipple]]
			ifFalse:[aFillStyle])
		borderWidth: bw 
		borderColor: bc! !


!Morph methodsFor: 'debug and other' stamp: 'bf 9/22/1999 14:47'!
debuggingMenuFor: aHandMorph
	| aMenu aPlayer |
	aMenu _ MenuMorph new defaultTarget: self.
	(self hasProperty: #errorOnDraw) ifTrue:
		[aMenu add: 'start drawing again' action: #resumeAfterDrawError.
		aMenu addLine].
	(self hasProperty: #errorOnStep) ifTrue:
		[aMenu add: 'start stepping again' action: #resumeAfterStepError.
		aMenu addLine].
	aMenu add: 'control-menu...' target: aHandMorph selector: #invokeMetaMenuFor: argument: self.
	aMenu add: 'inspect morph' action: #inspectInMorphic.
	Smalltalk isMorphic ifFalse:
		[aMenu add: 'inspect morph (in MVC)' action: #inspect].

     aMenu add: 'explore morph' target: aHandMorph selector: #exploreArgument.
	aMenu add: 'browse morph class' target: aHandMorph selector: #browseMorphClassFor: argument: self.

	(aPlayer _ self player) ifNotNil:
		[aMenu add: 'inspect player' target: aPlayer action: #inspect.
		World ifNil: [aMenu add: 'inspect player (morphic)' action: #inspectArgumentsPlayerInMorphic].
		aMenu add: 'browse player class' target: aPlayer action: #inspect].

	aMenu add: 'make own subclass' action: #subclassMorph.
	aMenu add: 'internal name ' action: #choosePartName.
	aMenu add: 'save morph in file'  action: #saveOnFile.
	aMenu addLine.
	aMenu add: 'call #tempCommand' target: aHandMorph action: #callTempCommand.
	aMenu add: 'define #tempCommand' target: aHandMorph action: #defineTempCommand.

	aMenu addLine.
	aMenu add: 'edit balloon help' action: #editBalloonHelpText.
	^ aMenu! !


!PasteUpMorph methodsFor: 'misc' stamp: 'bf 9/22/1999 14:55'!
position: aPoint
	"Prevent moving a world (e.g. via HandMorph>>specialGesture:)"

	self isWorldMorph ifFalse: [super position: aPoint]
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'bf 9/20/1999 15:18'!
patchAt: patchRect without: stopMorph andNothingAbove: stopThere
	"Return a complete rendering of this patch of the display screen
	without stopMorph, and possibly without anything above it."
	| c |
	c _ ColorPatchCanvas extent: patchRect extent depth: Display depth.
	c stopMorph: stopMorph.
	c doStop: stopThere.
	c _ c copyOrigin: patchRect topLeft negated clipRect: (0 at 0 extent: patchRect extent).
	(self bounds containsRect: patchRect) ifFalse:
		["Need to fill area outside bounds with black."
		c form fillColor: Color black].
	(self bounds intersects: patchRect) ifFalse:
		["Nothing within bounds to show."
		^ c form].
	c fillRectangle: self bounds color: color.  "Fill bounds with world color."
	self drawSubmorphsOn: c.
	self hands reverseDo: [:h | h drawSubmorphsOn: c].
	^c form
! !


!SelectionMenu class methodsFor: 'instance creation' stamp: 'bf 9/18/1999 19:55'!
selections: aList
	"Answer an instance of me whose labels and selections are identical.  "

	^ self selections: aList lines: nil! !

!SelectionMenu class methodsFor: 'instance creation' stamp: 'bf 9/18/1999 19:58'!
selections: aList lines: lineList
	"Answer an instance of me whose labels and selections are identical"

	^ self labelList: (aList collect: [:each | each asString])
		lines: lineList
		selections: aList! !


!SystemWindow methodsFor: 'events' stamp: 'bf 9/24/1999 12:07'!
mouseDown: evt
	| cp offset newBounds vbtl |
	TopWindow == self ifFalse: [self activate].
	(Sensor redButtonPressed "If mouse is really still down after activate"
		and: [self labelRect containsPoint: evt cursorPoint]) ifTrue:
		["All copied from super (should use that code)"
		Preferences fastDragWindowForMorphic
		ifTrue: [vbtl _ self world viewBox topLeft.
				offset _ self position + vbtl - Sensor cursorPoint.
				newBounds _ (self bounds translateBy: vbtl)
					newRectFrom: [:f | Sensor cursorPoint + offset extent: self extent].
				^ self position: newBounds topLeft - vbtl]
		ifFalse: [^ evt hand grabMorph: self topRendererOrSelf]].
	model windowActiveOnFirstClick ifTrue:
		["Normally window keeps control of first click.
		Need explicit transmission for first-click activity."
		cp _ evt cursorPoint.
		submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseDown: evt]]]! !





More information about the Squeak-dev mailing list