Brazil.ns

Newspeak3
'Brazil'
class Brazil usingPlatform: platform = (
(* Brazil is Newspeak's multi-platform logical UI and layout framework. It provides the familiar widgets ('visuals') such as Labels, Buttons, and ListBoxes, and containers for combining visuals and managing their layout. Unlike a typical widget framework, Brazil does not implement the actual widgets. Instead it functions as a 'logical UI' layer that builds and manages the equivalent 'physical UI' made of native artifacts of the host platform.

Brazil was designed and implemented by Vassili Bykov in 2007, with a mapping to Morphic as the first supported platform. A Windows mapping was implemented in 2008. Brazil is indeed named after the movie.

Copyright 2007-2012 Cadence Design Systems, Inc.
Copyright 2009 Ryan Macnak and other contributors.

Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0 *)
|
	(* module state *)
	private defaultFontMapperS
	private theDesktopS
	private lastVisitedDirectoryS

	(* imports *)
	private Map = platform collections Map.
	private List = platform collections List.
	private IdentityMap = platform collections IdentityMap.
	private WeakArray = platform collections WeakArray.
	public (* bogus *) Color = platform graphics Color.
	private Rectangle = platform graphics Rectangle.
	private SeqCltnReadStream = platform streams SeqCltnReadStream.
	private Transcript = platform streams TempTranscript new. (* for SpyingWrapper, InformationRetriever *)
	private Duct = platform ducts Duct.
	private Holder = platform ducts Holder.

	private SmallInteger = platform squeak SmallInteger.
	private GradientFillStyle = platform squeak GradientFillStyle.
	private FileDirectory = platform squeak FileDirectory.
	private DosFileDirectory = platform squeak DosFileDirectory.
	private TimeStamp = platform squeak TimeStamp.
	private ZeroDivide = platform squeak ZeroDivide.
	private MorphicFontMapper = platform squeak MorphicFontMapper.
	private WorldState = platform squeak WorldState.
	private World = platform squeak World.
	private NewspeakGlobalState = platform squeak NewspeakGlobalState.

	private MorphicAgentFactory = platform squeak MorphicAgentFactory.
	private BrazilMappingForWin32 = platform namespace BrazilMappingForWin32.

	(* public interfacing *)
	public plumbing = PlumbingClasses new.
	public areas = AreaClasses new. (* uses plumbing *)
	public abilities = AbilityClasses new.
	public manipulation = ManipulationClasses new.
	public mapping = MappingClasses new.
	public menus = MenuClasses new.
	public text = TextClasses new.
	public visuals = VisualClasses new. (* uses plumbing, areas, containers,visuals, but hooked up with postInit *)
	public widgets = WidgetClasses new. (* uses visuals *)
	public containers = ContainerClasses new. (* uses visual,widgets,plmbing,areas *)
	public tools = ToolClasses new. (* uses containers, widgets, areas *)
|visuals postInit) (
class AbilityClasses = (
(* *** EXPERIMENTAL/WORK IN PROGRESS: This code is not yet used by the core system, and may be significantly revised or removed *** This module implements and manages Abilities. Abilities are low-level input event interpreters that translate sequences of events such as mouse presse, releases and moves, into higher-level gestures such as button clicks and drag attempts. *)
|
	(* private Dictionary = platform Collections Dictionary.
	private OrderedCollection = platform Collections OrderedCollection.

	clickability = Clickability new.
	draggability = Draggability new.
	clickabilityAndDraggability = ClickabilityAndDraggability new. *)
|) (
class Ability = (
(* This is the abstract superclass of abilities. Any ability is attached to the owner, which is the source of the low-level events it interprets. The owner is often a Visual *)
|
	owner
|) (
atttachTo: newOwner = (
	owner:: newOwner
)
detachFrom: presumedOwner = (
	(* A subclass may reimplement this to do the real detaching, provided the presumedOwner is the same as the current owner. *)
)
) : (
)
class Clickability = Mousability (
(* Clickability translates low-level events into click gestures. A click gesture follows the standard behavior of push buttons, where a button is clicked on a mouse up event that occurs within the button's bounds after a prior mouse down event within the bounds. Moving the mouse outside the bounds and then releasing the mouse button effectively cancels the click in progress. *)
|
	clickResponse
	pressResponse
	releaseResponse
|) (
defineBehavior = (
	| normal down outside |
	normal:: behavior newState.
	down:: behavior newState.
	outside:: behavior newState.
	normal
		exitAction: [owner grabMouse];
		entryAction: [owner releaseMouse];
		on: #mouseDown do:
			[[invokePressResponse]
				ensure: [down enter]].
	down
		on: #mouseUp do:
			[[invokeReleaseResponse.
			invokeClickResponse]
				ensure: [normal enter]];
		on: #mouseMove do:
			[hasMouse ifFalse:
				[[invokeReleaseResponse]
					ensure: [outside enter]]].
	outside
		on: #mouseUp do:
			[[invokeReleaseResponse]
				ensure: [normal enter]];
		on: #mouseMove do:
			[hasMouse ifTrue:
				[[invokePressResponse]
					ensure: [down enter]]].
)
hasMouse = (
	^owner localBounds containsPoint: owner mousePoint
)
invokeClickResponse = (
	clickResponse ifNotNil: [:it | it value]
)
invokePressResponse = (
	pressResponse ifNotNil: [:it | it value]
)
invokeReleaseResponse = (
	releaseResponse ifNotNil: [:it | it value]
)
resetResponses = (
	clickResponse: nil.
	pressResponse: nil.
	releaseResponse: nil.
)
) : (
)
class ClickabilityAndDraggability = Mousability (
(* This class aggregates the two other abilities by becoming the owner of their instances and coordinating their actions and requests. *)
|
	mouseGrabLevel ::= 0.
|) (
attachClickability = (
	clickability attachTo: self.
	clickability
		pressResponse: [respondToPress];
		releaseResponse: [respondToRelease];
		clickResponse: [respondToClick]
)
attachDraggability = (
	draggability attachTo: self.
)
attachTo: newOwner = (
	super attachTo: newOwner.
	mouseGrabLevel:: 0.
	attachClickability.
	attachDraggability.
)
public grabMouse = (
	mouseGrabLevel: mouseGrabLevel + 1.
	mouseGrabLevel = 1 ifTrue: [owner grabMouse].
)
public releaseMouse = (
	mouseGrabLevel: mouseGrabLevel - 1.
	mouseGrabLevel = 0 ifTrue: [owner releaseMouse].
)
resetResponses = (
	clickability detachFrom: self.
	draggability detachFrom: self.
)
respondToMouseDownLeft = (
	clickability respondToMouseDownLeft.
	draggability respondToMouseDownLeft.
)
respondToMouseEntry = (
	clickability respondToMouseEntry.
	draggability respondToMouseEntry.
)
respondToMouseExit = (
	clickability respondToMouseExit.
	draggability respondToMouseExit.
)
respondToMouseMove = (
	clickability respondToMouseMove.
	draggability respondToMouseMove.
)
respondToMouseUpLeft = (
	clickability respondToMouseUpLeft.
	draggability respondToMouseUpLeft.
)
) : (
)
class Draggability = Mousability (
(* Draggability is the ability of a visual to initiate a drag once the mouse button has been pressed over it and then the mouse moved further than a certain threshold distance. *)
|
	dragStartResponse
	dragContinueResponse
	dropResponse
|) (
defineBehavior = (
	| normalState activatedState draggingState downPoint |
	normalState:: behavior newState.
	activatedState:: behavior newState.
	draggingState:: behavior newState.
	normalState
		entryAction: [owner releaseMouse];
		exitAction: [owner grabMouse];
		on: #mouseDown do:
			[downPoint:: owner mousePoint.
			activatedState enter].
	activatedState
		on: #mouseMove do:
			[(is: owner mousePoint beyondDragThresholdFrom: downPoint)
				ifTrue: [draggingState enter]];
		on: #mouseUp do:
			[normalState enter].
	draggingState
		entryAction: [invokeDragStartResponse];
		on: #mouseMove do:
			[invokeDragContinueResponse];
		on: #mouseUp do:
			[invokeDropResponse.
			normalState enter].
)
dragThreshold ^<Number> = (
	^5
)
invokeDragContinueResponse = (
	dragContinueResponse ifNotNil: [:it | it value]
)
invokeDragStartResponse = (
	dragStartResponse ifNotNil: [:it | it value]
)
invokeDropResponse = (
	dropResponse ifNotNil: [:it | it value]
)
is: point1 beyondDragThresholdFrom: point2 = (
	^(point1 x - point2 x) abs > dragThreshold or:
		[(point1 y - point2 y) abs > dragThreshold]
)
resetResponses = (
	dragStartResponse: nil.
	dragContinueResponse: nil.
	dropResponse: nil.
)
) : (
)
class FSM = (
(* Finite state machines are used by abilities to describe the interpretation of input they perform. *)
|
	protected states = List new.
	protected initialState
	protected currentState
|) (
class State = (
|
	eventResponses = Map new.
	entryAction
	exitAction
|) (
enter = (
	enterState: self
)
enterState: newCurrentState = (
	outer FSM enterState: newCurrentState
)
on: event <Symbol> do: action <Block> = (
	^eventResponses at: event put: action
)
processEvent: event <Symbol> = (
	(eventResponses at: event ifAbsent: [^self]) value
)
respondToEntry = (
	entryAction ifNotNil: [:it | it value]
)
respondToExit = (
	exitAction ifNotNil: [:it | it value]
)
) : (
)
enterState: newCurrentState = (
	currentState = newCurrentState ifFalse:
		[currentState respondToExit.
		currentState:: newCurrentState.
		currentState respondToEntry].
)
newState = (
	(* Create a new state associated with this machine. The first state created is the initial state. *)
	| state |
	state:: State new.
	states add: state.
	initialState isNil ifTrue: [setInitialState: state].
	^state
)
processEvent: event <Symbol> = (
	currentState processEvent: event
)
reset = (
	currentState: initialState
)
setInitialState: state = (
	initialState:: state.
	currentState:: state
)
) : (
)
class Mousability = (
|
	protected behavior = FSM new.
|defineBehavior) (
attachTo: newOwner = (
	super attachTo: newOwner.
	behavior reset.
	owner
		mouseDownLeftResponse: [respondToMouseDownLeft];
		mouseUpLeftResponse: [respondToMouseUpLeft];
		mouseMoveResponse: [respondToMouseMove];
		mouseEntryResponse: [respondToMouseEntry];
		mouseExitResponse: [respondToMouseExit]
)
defineBehavior = (
	subclassResponsibility
)
detachFrom: presumedOwner = (
	presumedOwner == owner ifTrue:
		[owner
			mouseDownLeftResponse: nil;
			mouseUpLeftResponse: nil;
			mouseMoveResponse: nil;
			mouseEntryResponse: nil;
			mouseExitResponse: nil.
		resetResponses.
		owner:: nil]
)
resetResponses = (
	(* No responses here; subclasses with responses should redefine this to nil them all out. *)
)
respondToMouseDownLeft = (
	behavior processEvent: #mouseDown
)
respondToMouseEntry = (
	behavior processEvent: #mouseEntry
)
respondToMouseExit = (
	behavior processEvent: #mouseExit
)
respondToMouseMove = (
	behavior processEvent: #mouseMove
)
respondToMouseUpLeft = (
	behavior processEvent: #mouseUp
)
) : (
)
) : (
)
class AreaClasses = (
(* The former category Brazil-Areas *)
|
	private MessageRecorder = plumbing MessageRecorder.
	|) (
public class Anchor = Area (
(* An Anchor is an Area that dictates the placement but not the size of its visual within the parent. The visual is always as large as it wants to be.

The position of the visual is determined using a fraction/offset scheme similar to that used by Frame. Each of the dimensions of the parent is multiplied by the corresponding fraction, and the the offset is added to obtain the anchor position within the current bounds of the parent. For example, an Anchor with the following set of parameters:

	xFraction = 0.5; xOffset = 10
	yFraction = 0; yOffset = 20

is positioned at the location 100 @ 20 inside a parent visual of size 200 @ 200, and at the location 150 @ 20 inside a parent of size 300 @ 300.

An additional pair of fraction values, anchor fractions, defines what point of the child is positioned at the anchor location. If the anchor fractions are 0 and 0 it is the top left. If the fractions are 1 and 1, it is the bottom right.

A number of methods of the 'initialize-release' protocol, such as #beCentered or #offset:, cover the common usage scenarios. Refer to those methods for further configuration examples. *)
|
	xFractionS
	xOffsetS
	yFractionS
	yOffsetS
	xAnchorFractionS
	yAnchorFractionS
	cachedSuggestedParentExtent
	public lastSuggestedExtentKnownToParent
|) (
anchorPosition: newOrigin <Point> = (
	(* Configure the receiver so that its visual's top left corner is positioned at the specified offset from the parent's top left corner. *)

	xFractionS:: 0.
	xOffsetS:: newOrigin x.
	yFractionS:: 0.
	yOffsetS:: newOrigin y.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beBottomCenter = (
	(* Configure the receiver to position its visual so that the center of its bottom side is at the center of the bottom side of the visual's parent. *)

	xFractionS: 0.5.
	yFractionS: 1.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.5.
	yAnchorFractionS: 1.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beBottomLeft = (
	(* Configure the receiver to position its visual so that its bottom left corner is at the bottom left corner of the visual's parent. *)

	xFractionS: 0.
	yFractionS: 1.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.
	yAnchorFractionS: 1.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beBottomRight = (
	(* Configure the receiver to position its visual so that its bottom right corner is at the bottom right corner of the visual's parent. *)

	xFractionS: 1.
	yFractionS: 1.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 1.
	yAnchorFractionS: 1.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beCentered = (
	(* Configure the receiver to position its visual so that its center is at the center of the visual's parent. *)

	xFractionS: 0.5.
	yFractionS: 0.5.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.5.
	yAnchorFractionS: 0.5.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beLeftCenter = (
	(* Configure the receiver to position its visual so that the center of its left side is at the center of the left side of the visual's parent. *)

	xFractionS: 0.
	yFractionS: 0.5.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.
	yAnchorFractionS: 0.5.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beRightCenter = (
	(* Configure the receiver to position its visual so that the center of its right side is at the center of the right side of the visual's parent. *)

	xFractionS: 1.
	yFractionS: 0.5.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 1.
	yAnchorFractionS: 0.5.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beTopCenter = (
	(* Configure the receiver to position its visual so that the center of its top side is at the center of the top side of the visual's parent. *)

	xFractionS: 0.5.
	yFractionS: 0.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.5.
	yAnchorFractionS: 0.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beTopLeft = (
	(* Configure the receiver to position its visual so that its top left corner is at the top left corner of the visual's parent. *)

	xFractionS: 0.
	yFractionS: 0.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 0.
	yAnchorFractionS: 0.
	flushLayoutCaches.
	requestBoundsUpdate
)
public beTopRight = (
	(* Configure the receiver to position its visual so that its top right corner is at the top right corner of the visual's parent. *)

	xFractionS: 1.
	yFractionS: 0.
	xOffsetS: 0.
	yOffsetS: 0.
	xAnchorFractionS: 1.
	yAnchorFractionS: 0.
	flushLayoutCaches.
	requestBoundsUpdate
)
public boundsWithin: referenceBounds <Rectangle> ^<Rectangle> = (
	| parentOrigin parentExtent width height naturalExtent anchorX anchorY |
	parentExtent: referenceBounds extent.
	width: parentExtent x.
	height: parentExtent y.
	naturalExtent: visual naturalExtent.
	anchorX:: (width * xFraction) + xOffset - (naturalExtent x * xAnchorFraction).
	anchorY:: (height * yFraction) + yOffset - (naturalExtent y * yAnchorFraction).
	^Rectangle
		origin: anchorX rounded @ anchorY rounded + referenceBounds origin
		extent: naturalExtent
)
computeSuggestedParentExtent ^<Point> = (
	(* Answer the minimum extent the parent should have in order for the visual of this area to appear fully visible. In the general case this value depends both on the natural extent of the visual and on the parameters of the area. *)

	| naturalExtent |
	naturalExtent:: visual naturalExtent.
	^(suggestedParentSizeForFraction: xFraction
		offset: xOffset
		size: naturalExtent x
		anchorFraction: xAnchorFraction)
	@ (suggestedParentSizeForFraction: yFraction
		offset: yOffset
		size: naturalExtent y
		anchorFraction: yAnchorFraction)
)
public copyConfigurationFromAnchor: another <Anchor> = (
	xFraction:: another xFraction.
	xOffset:: another yOffset.
	yFraction:: another yFraction.
	yOffset:: another yOffset.
)
public copyConfigurationTo: another <Area> = (
	another copyConfigurationFromAnchor: self
)
public flushLayoutCaches = (
	cachedSuggestedParentExtent: nil
)
public isRelative ^<Boolean> = (
	(* True if the final bounds depend on the size of the parent. *)

	^xFraction ~= 0
		or: [yFraction ~= 0]
)
public isSqueezing ^<Boolean> = (
	^false
)
public isVisualSquishy ^<Boolean> = (
	^false (* no matter what the visual is, an anchored one has no chance to exhibit its squishiness *)
)
mayAccommodateVisualsNaturalHeightChange ^<Boolean> = (
	^true (* An anchor is accommodating by definition. *)
)
mayAccommodateVisualsNaturalWidthChange ^<Boolean> = (
	^true (* An anchor is accommodating by definition. *)
)
public origin: newOrigin <Point> = (
	(* Configure the receiver so that its visual's top left corner is positioned at the specified offset from the parent's top left corner. *)

	xFractionS:: 0.
	xOffsetS:: newOrigin x.
	yFractionS:: 0.
	yOffsetS:: newOrigin y.
	xAnchorFractionS: 0.
	yAnchorFractionS: 0.
	flushLayoutCaches.
	requestBoundsUpdate
)
public resetLastSuggestedExtentKnownToParent = (
	lastSuggestedExtentKnownToParent:: -1 @ -1
	(* we need a value that's a legal Point but cannot equal any legal extent *)
)
public suggestedParentExtent ^<Point> = (
	(* Answer the minimum extent the parent should have in order for the visual of this area to appear fully visible. In the general case this value depends both on the natural extent of the visual and on the parameters of the area. *)

	cachedSuggestedParentExtent == nil ifTrue:
		[cachedSuggestedParentExtent: computeSuggestedParentExtent].
	^cachedSuggestedParentExtent
)
public suggestedParentHeightForWidth: width <Number> = (
	^suggestedParentExtent y
)
public suggestedParentSizeForFraction: fraction <Number> offset: offset <Number> size: size <Number> anchorFraction: anchorFraction <Number> = (
	(* Used internally by #suggestedParentExtent to compute the suggested parent's size given all the relevant layout parameters along one of the axes. The suggested size is the minimum size of the parent such that the entire child will appear unobscured inside it. *)

	| size1 size2 |
	size1:: fraction ~= 1
		ifTrue: [(1 - anchorFraction) * size + offset / (1 - fraction)]
		ifFalse: [0].
	size2:: fraction ~= 0
		ifTrue: [anchorFraction * size - offset / fraction]
		ifFalse: [0].
	^size1 rounded max: size2 rounded
)
public visual: aVisual = (
	super visual: aVisual.
	resetLastSuggestedExtentKnownToParent.
	xFraction: 0.
	yFraction: 0.
	xOffset: 0.
	yOffset: 0.
	xAnchorFraction: 0.
	yAnchorFraction: 0.
)
public xAnchorFraction ^<Number> = (
	^xAnchorFractionS
)
public xAnchorFraction: fraction <Number> = (
	xAnchorFractionS:: fraction.
	flushLayoutCaches.
	requestBoundsUpdate
)
public xFraction ^<Number> = (
	^xFractionS
)
public xFraction: fraction <Number> = (
	xFractionS:: fraction.
	flushLayoutCaches.
	requestBoundsUpdate
)
public xOffset ^<Number> = (
	^xOffsetS
)
public xOffset: offset <Number> = (
	xOffsetS:: offset.
	flushLayoutCaches.
	requestBoundsUpdate
)
public yAnchorFraction ^<Number> = (
	^yAnchorFractionS
)
public yAnchorFraction: fraction <Number> = (
	yAnchorFractionS:: fraction.
	flushLayoutCaches.
	requestBoundsUpdate
)
public yFraction ^<Number> = (
	^yFractionS
)
public yFraction: fraction <Number> = (
	yFractionS:: fraction.
	flushLayoutCaches.
	requestBoundsUpdate
)
public yOffset ^<Number> = (
	^yOffsetS
)
public yOffset: offset <Number> = (
	yOffsetS:: offset.
	flushLayoutCaches.
	requestBoundsUpdate
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
class Area = (
(* An Area is an object associated with a visual to capture the visual's position properties. The Area class itself is abstract.

When a visual is added to a parent, the visual automatically installs an area most appropriate for the particular parent.

Slots:
	visualS <Visual> The visual this area is attached to. *)
|
	visualS
	|) (
public copyConfigurationFromAnchor: anchor <Anchor> = (
	(* No configuration here; nothing to copy to. *)
)
public copyConfigurationFromFrame: frame <Frame> = (
	(* No configuration here; nothing to copy to. *)
)
public copyConfigurationTo: another <Position> = (
	(* No configuration; nothing to copy. *)
)
public flushLayoutCaches = (
	(* Subclasses that cache state in order to speed things up must redefine this method to discard the cached data when requested. *)
)
public isFuture = (
	^false
)
public isSqueezing ^<Boolean> = (
	(* This method complements the one named the same in Visual, since some areas may override the squeezing behavior of their parents. *)

	^visual parent isSqueezing
)
public isVisualSquishy ^<Boolean> = (
	(* When containers compute their squishiness, they rely on this method to determine if the combination of a child's squishiness together with the area settings would in fact make the parent squishy. *)
	subclassResponsibility
)
mayAccommodateVisualsNaturalHeightChange ^<Boolean> = (
	^visual parent mayAccommodateNaturalHeightChangeOf: visual
)
mayAccommodateVisualsNaturalWidthChange ^<Boolean> = (
	^visual parent mayAccommodateNaturalWidthChangeOf: visual
)
requestBoundsUpdate = (
	(visual area == self and: [visual updateLockLevel < 1]) ifTrue:
		[visual parent
			child: visual
			requestsBoundsUpdateUsing:
				[:newBounds | visual occupyBounds: newBounds]]
)
public species = (
	^super class
)
public visual = (
	^visualS
)
public visual: aVisual <Visual> = (
	visualS:: aVisual
)
public visualRequestsBoundsUpdateUsing: aBlock = (
	(* An area receives this message when the visual wants to receive a bounds update, meaning its natural extent has changed. A subclass may redefine this method to filter requests in cases when the area  dictates a fixed size of the child and therefore the child's natural extent is known to have no effect on the parent. NOTE that the area must invoke the block with the final bounds of the visual, regardless of whether they have changed or not. *)

	visual parent
		child: visual
		requestsBoundsUpdateUsing: aBlock
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class CellWidthEqualizer = (|
	cellsX ::= List new.
	indexX
	cachedNaturalExtentX
	|) (
public commonNaturalWidth = (
	^cellsX
		inject: 0
		into:
			[:max :each |
			max max: each visual naturalExtent x]
)
equalize: collection at: index = (
	indexX:: index.
	collection do:
		[:each | | visual |
		visual:: each at: index.
		visual areaClass: WidthEqualizingRowCell.
		cellsX add: visual area.
		visual area equalizer: self].
)
public equalizeRowElements: visuals = (
	visuals do:
		[:each |
		each areaClass: WidthEqualizingRowCell.
		cellsX add: each area.
		each area equalizer: self].
)
) : (
public equalize: collection at: index = (
	^self new equalize: collection at: index
)
public equalizeRowElements: visuals = (
	^self new equalizeRowElements: visuals
)
)
public class ColumnCell = SequenceCell (
(* An area used for elements of a Column. *)
) (
public height = (
	^principalSize
)
public height: pixels <Integer> = (
	principalSize:: pixels
)
public isSqueezing ^<Boolean> = (
	^imposesSize not and: [super isSqueezing]
)
public isVisualSquishy ^<Boolean> = (
	^imposesSize not and: [visual isSquishy]
)
mayAccommodateVisualsNaturalHeightChange ^<Boolean> = (
	^imposesSize not and:
		[visual parent mayAccommodateNaturalHeightChangeOf: visual]
)
public minimumHeight ^<Number> = (
	^minimumSize
)
public minimumHeight: newValue <Number> = (
	minimumSize: newValue
)
public naturalExtent = (
	^visual naturalExtent x @ (minimumSize max: height)
)
public naturalHeightForWidth: size <Number> ^<Number> = (
	(* Answer the size the visual should take along the principal axis within a parent of the given size along the orthogonal axis. *)

	^principalSizeS ifNil: [visual naturalHeightForWidth: size]
)
naturalOrthogonalSize = (
	^visual naturalExtent x
)
naturalPrincipalSize = (
	^visual naturalExtent y
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class Frame = Area (|
	leftFractionS
	leftOffsetS
	topFractionS
	topOffsetS
	rightFractionS
	rightOffsetS
	bottomFractionS
	bottomOffsetS
	public lastSuggestedExtentKnownToParent
|) (
public bottomFraction = (
	^bottomFractionS
)
public bottomFraction: fraction <Number> = (
	bottomFractionS:: fraction.
	requestBoundsUpdate
)
public bottomOffset = (
	^bottomOffsetS
)
public bottomOffset: offset <Integer> = (
	bottomOffsetS:: offset.
	requestBoundsUpdate
)
public bounds: aRectangle = (
	(* Occupy the given rectangle; no elasticity. *)

	self
		offsetsLeft: aRectangle left
		top: aRectangle top
		right: aRectangle right
		bottom: aRectangle bottom
)
public boundsWithin: compositionBounds <Rectangle> = (
	| parentOrigin parentExtent width height left top right bottom |
	parentOrigin:: compositionBounds origin.
	parentExtent:: compositionBounds extent.
	width:: parentExtent x.
	height:: parentExtent y.
	left:: (width * leftFraction) rounded + leftOffset.
	top:: (height * topFraction) rounded + topOffset.
	right:: (width * rightFraction) rounded + rightOffset.
	bottom:: (height * bottomFraction) rounded + bottomOffset.
	^Rectangle
		origin: left @ top + parentOrigin
		corner: right @ bottom + parentOrigin
)
public copyConfigurationFromFrame: another <Frame> = (
	leftFraction:: another leftFraction.
	leftOffset:: another leftOffset.
	topFraction:: another topFraction.
	topOffset:: another topOffset.
	rightFraction:: another rightFraction.
	rightOffset:: another rightOffset.
	bottomFraction:: another bottomFraction.
	bottomOffset:: another bottomOffset
)
public copyConfigurationTo: another <Position> = (
	another copyConfigurationFromFrame: self
)
extent: newExtent <Point> = (
	rightOffsetS:: leftOffsetS + newExtent x.
	bottomOffsetS:: topOffsetS + newExtent y.
	requestBoundsUpdate
)
fractionsLeft: left top: top right: right bottom: bottom = (
	self
		leftFraction: left
		offset: 0
		topFraction: top
		offset: 0
		rightFraction: right
		offset: 0
		bottomFraction: bottom
		offset: 0
)
public fullyCoverParent = (
	(* Be elastic by fully covering the parent and resizing with it. *)

	padding: 0
)
public isElastic ^<Boolean> = (
	(* A frame is elastic if the bounds it computes for its visual depend on the size of the parent. *)

	^leftFraction ~= 0
		or: [topFraction ~= 0
			or: [rightFraction ~= 0
				or: [bottomFraction ~= 0]]]
)
public isElasticX ^<Boolean> = (
	(* True if the final bounds along the X axis depend on the size of the parent. *)

	^rightFraction ~= 0 or: [leftFraction ~= 0]
)
public isElasticY ^<Boolean> = (
	(* True if the final bounds along the Y axis depend on the size of the parent. *)

	^bottomFraction ~= 0 or: [topFraction ~= 0]
)
public isFramedByParent ^<Boolean> = (
	(* This is an even stronger condition than isElastic: a Frame with the four sides rigidly attached to the corresponding sides of the parent. *)

	^leftFraction = 0
		and: [topFraction = 0
			and: [rightFraction = 1
				and: [bottomFraction = 1]]]
)
public isSqueezing ^<Boolean> = (
	(* The parent will only be able to exhibit its squeezing behavior if the frame is able to grow vertically. *)
	^super isSqueezing and: [isElasticY]
)
public isVisualSquishy ^<Boolean> = (
	(* A squishy visual contained by a frame can only manifest its squishiness if the frame allows it to grow vertically. *)
	^isElasticY and:
		[visual isSquishy]
)
public isZero ^<Boolean> = (
	^isElastic not
		and: [leftOffset = 0
		and: [rightOffset = 0
		and: [topOffset = 0
		and: [bottomOffset = 0]]]]
)
public leftFraction = (
	^leftFractionS
)
public leftFraction: fraction <Number> = (
	leftFractionS:: fraction.
	requestBoundsUpdate
)
public leftFraction: lf offset: lo
topFraction: tf offset: to
rightFraction: rf offset: ro
bottomFraction: bf offset: bo = (
	leftFractionS:: lf.
	leftOffsetS:: lo.
	topFractionS:: tf.
	topOffsetS:: to.
	rightFractionS:: rf.
	rightOffsetS:: ro.
	bottomFractionS:: bf.
	bottomOffsetS:: bo.
	requestBoundsUpdate
)
public leftOffset = (
	^leftOffsetS
)
public leftOffset: offset <Integer> = (
	leftOffsetS:: offset.
	requestBoundsUpdate
)
mayAccommodateVisualsNaturalHeightChange ^<Boolean> = (
	^isElasticY and: [super mayAccommodateVisualsNaturalHeightChange]
)
mayAccommodateVisualsNaturalWidthChange ^<Boolean> = (
	^isElasticX and: [super mayAccommodateVisualsNaturalWidthChange]
)
offsetsLeft: left top: top right: right bottom: bottom = (
	self
		leftFraction: 0
		offset: left
		topFraction: 0
		offset: top
		rightFraction: 0
		offset: right
		bottomFraction: 0
		offset: bottom
)
padding: padding <Integer | Point> = (
	(* Set up the receiver so that its visual fully covers its parent and padded according to the argument. The argument is either the number of pixels to leave on all sides of the parent or a Point with separate settings used for for the left/right and top/bottom sides. *)

	padding isInteger
		ifTrue:
			[offsetsLeft: padding
				top: padding
				right: padding negated
				bottom: padding negated]
		ifFalse:
			[offsetsLeft: padding x
				top: padding y
				right: padding x negated
				bottom: padding y negated.].
	rightFraction: 1.
	bottomFraction: 1
)
public resetLastSuggestedExtentKnownToParent = (
	lastSuggestedExtentKnownToParent:: -1 @ -1
	(* we need a value that's a legal Point but cannot equal any legal extent *)
)
public rightFraction = (
	^rightFractionS
)
public rightFraction: fraction <Number> = (
	rightFractionS:: fraction.
	requestBoundsUpdate
)
public rightOffset = (
	^rightOffsetS
)
public rightOffset: offset <Integer> = (
	rightOffsetS:: offset.
	requestBoundsUpdate
)
public suggestedParentExtent ^<Point> = (
	isElastic ifFalse:
		[^rightOffset @ bottomOffset].
	isFramedByParent ifTrue:
		[^visual naturalExtent
			+ ((leftOffset - rightOffset) @ (topOffset - bottomOffset))].
	#BOGUS yourself.
	^0 @ 0 (* Should do more in some of the remaining cases; see Anchor *)
)
public suggestedParentHeightForWidth: width <Number> = (
	| left right imposedCompositionWidth heightFromVisual |
	(topFraction = 0 and: [bottomFraction = 1]) ifTrue:
		[left:: (width * leftFraction) + leftOffset.
		right:: (width * rightFraction) + rightOffset.
		imposedCompositionWidth:: right - left.
		heightFromVisual:: visual naturalHeightForWidth: imposedCompositionWidth.
		^heightFromVisual + topOffset - bottomOffset].
	#BOGUS yourself. (* the code below doesn't handle all cases *)
	^bottomOffset
)
public topFraction = (
	^topFractionS
)
public topFraction: fraction <Number> = (
	topFractionS:: fraction.
	requestBoundsUpdate
)
public topOffset = (
	^topOffsetS
)
public topOffset: offset <Integer> = (
	topOffsetS:: offset.
	requestBoundsUpdate
)
public visual: aVisual = (
	super visual: aVisual.
	resetLastSuggestedExtentKnownToParent.
	bounds: (0@0 corner: 0@0)
)
public visualRequestsBoundsUpdateUsing: aBlock = (
	(* If the frame is not elastic, i.e. has a fixed size, the change in the visual's natural extent that initiated this request has no chance of making any difference in the final layout. *)

	isElastic
		ifTrue: [super visualRequestsBoundsUpdateUsing: aBlock]
		ifFalse: [aBlock value: visual bounds]
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class FutureArea = MessageRecorder () (
public copyConfigurationTo: area <Area> = (
	self playRecordedMessagesTo: area
)
public flushLayoutCaches = (
	(* Understand but do nothing. *)
)
public isFuture = (
	^true
)
public isSqueezing = (
	^false
)
public visualRequestsBoundsUpdateUsing: continuation = (
	(* Understand but do nothing. *)
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class GridRowCell = RowCell (
(* A GridRowCell is a specialized area used by children of GridRowXs. GridRowCells keeps track of a number of layout parameters in addition to those inherited from the regular RowCell.

By default, the extent a cell will request from its row is equal to the natural extent of the cell content. This can be overridden by 'forcedExtent'. However, the concept of the natural extent of a cell is further complicated by the fact that the cell is part of the larger context of its grid.

Natural extent (fixed in the cell or passed through from the visual) is the extent the cell would prefer to be *on its own*. Principal and orthogonal sizes of a cell define the extent *the grid* would like it to be. They are set with consideration of sizes of other cells in the same row or column. *)
|
	orthogonalSizeS
	forcedExtentX
	|) (
extent ^<Point> = (
	^width @ height
)
extent: extent <Point> = (
	principalSizeS:: extent x.
	orthogonalSizeS:: extent y.
	requestBoundsUpdate
)
forcedExtent: newExtent <Point | nil> = (
	(* Sending a Point with this message causes this cell to try assuming this extent instead of whatever the visual itself wants. *)

	forcedExtentX:: newExtent.
	(* grid flushLayoutCaches. *)
	#BOGUS yourself. (* remove the above when it's verified not needed *)
	requestBoundsUpdate
)
grid ^<Grid> = (
	(* Answer the grid. The grid is known to the grid row, which is the parent of our visual. *)

	^visual parent grid
)
height ^<Number> = (
	^orthogonalSize
)
height: newHeight <Number> = (
	orthogonalSize:: newHeight
)
public naturalExtent ^<Point> = (
	^forcedExtentX ifNil: [visual naturalExtent]
)
public naturalHeightForWidth: width <Number> ^ <Number> = (
	^forcedExtentX
		ifNil: [super naturalHeightForWidth: width]
		ifNotNil: [forcedExtentX y]
)
naturalPrincipalSize = (
	^naturalExtent x
)
orthogonalSize = (
	^orthogonalSizeS == nil
		ifTrue: [forcedExtentX == nil
			ifTrue: [naturalOrthogonalSize]
			ifFalse: [forcedExtentX y]]
		ifFalse: [orthogonalSizeS]
)
orthogonalSize: size <Number> = (
	orthogonalSizeS:: size.
	requestBoundsUpdate
)
quietlySetWidth: newWidth <Integer> = (
	principalSizeS:: newWidth
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class LineArea = Area (
(* The area class used for lines, to keep track of their start and end point positions. *)
|
	startPointS ::= 0@0.
	endPointS ::= 0@0.
	public lastSuggestedExtentKnownToParent
|) (
public boundsWithin: referenceBounds <Rectangle> = (
	| width |
	width:: visual width.
	^Rectangle
		left: (startPointS x min: endPointS x) - width
		right: (startPointS x max: endPointS x) + width
		top: (startPointS y min: endPointS y) - width
		bottom: (startPointS y max: endPointS y) + width
)
public endPoint ^<Point> = (
	^endPointS
)
public endPoint: newEndPoint <Point> = (
	endPointS:: newEndPoint.
	requestBoundsUpdate
)
public isVisualSquishy ^<Boolean> = (
	^false
)
public resetLastSuggestedExtentKnownToParent = (
	lastSuggestedExtentKnownToParent:: -1 @ -1
	(* we need a value that's a legal Point but cannot equal any legal extent *)
)
public startPoint ^<Point> = (
	^startPointS
)
public startPoint: newStartPoint <Point> = (
	startPointS:: newStartPoint.
	requestBoundsUpdate
)
public startPoint: newStartPoint <Point> endPoint: newEndPoint <Point> = (
	startPointS:: newStartPoint.
	endPointS:: newEndPoint.
	requestBoundsUpdate
)
public suggestedParentExtent ^<Point> = (
	^(endPointS - startPointS) abs
)
public suggestedParentHeightForWidth: ignored <Number> ^<Number> = (
	^suggestedParentExtent y
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class PolygonArea = Area (
(* The area used for polygons. It holds onto a collection of points for the vertices. Each vertex is a simple Point value in absolute coordinates, as usual relative to the polygon's parent.
*)
|
	verticesS ::= {0 @ 0}.
	public lastSuggestedExtentKnownToParent
	cachedEnclosingRectangle
	|) (
public boundsWithin: referenceBounds <Rectangle> ^<Rectangle> = (
	^enclosingRectangle
)
computeEnclosingRectangle ^<Rectangle> = (
	| minX maxX minY maxY |
	minX:: SmallInteger maxVal.
	maxX:: SmallInteger minVal.
	minY:: minX.
	maxY:: maxX.
	vertices do:
		[:each | | x y |
		x:: each x.
		y:: each y.
		minX:: minX min: x.
		maxX:: maxX max: x.
		minY:: minY min: y.
		maxY:: maxY max: y].
	^minX @ minY corner: maxX @ maxY
)
enclosingRectangle ^<Rectangle> = (
	^cachedEnclosingRectangle ifNil:
		[cachedEnclosingRectangle:: computeEnclosingRectangle.
		cachedEnclosingRectangle]
)
public isVisualSquishy ^<Boolean> = (
	^false
)
public resetLastSuggestedExtentKnownToParent = (
	lastSuggestedExtentKnownToParent:: -1 @ -1
	(* we need a value that's a legal Point but cannot equal any legal extent *)
)
public suggestedParentExtent ^<Point> = (
	^enclosingRectangle corner
)
public suggestedParentHeightForWidth: ignored <Number> ^<Number> = (
	^suggestedParentExtent y
)
public vertices ^<Collection[Point]> = (
	^verticesS
)
public vertices: newValue <Collection[Point]> = (
	verticesS:: newValue.
	cachedEnclosingRectangle:: nil.
	requestBoundsUpdate
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class RowCell = SequenceCell (
(* An area used for elements of a Row. *)
|
	|) (
public isVisualSquishy ^<Boolean> = (
	^imposesSize or: [isElastic and: [visual isSquishy]]
)
mayAccommodateVisualsNaturalWidthChange ^<Boolean> = (
	^imposesSize not and:
		[visual parent mayAccommodateNaturalWidthChangeOf: visual]
)
minimumWidth ^<Number> = (
	^minimumSize
)
minimumWidth: newValue <Number> = (
	minimumSize: newValue
)
public naturalExtent = (
	^(minimumSize max: width) @ visual naturalExtent y
)
public naturalHeightForWidth: width <Number> ^<Number> = (
	^visual naturalHeightForWidth: width
)
naturalOrthogonalSize = (
	^visual naturalExtent y
)
naturalPrincipalSize = (
	^visual naturalExtent x
)
public width = (
	^principalSize
)
public width: pixels <Integer> = (
	principalSize:: pixels
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
class SequenceCell = Area (
(* A SequenceCell is the abstract superclass of areas used by elements of visual sequences such as Rows and Columns.

Slots
	principalSizeS <Number | nil> If set, the fixed number of pixels the cell should be allocated (the width for row cells and the height for column cells). If nil, the cell will be allocated the natural size reported by the visual.
	minimumSizeS <Number> The cell will always be allocated at least this many pixels. For backward compatibility, the default value is 'Integer minVal', i.e. no minimum limit.
	expansibilityS <Number> When not 0, this cell can stretch if the container has more room than the sum of cells requires.
	compressibilityS <Number> When not 0, this cell can shrink if the container has less room than the sum of cells requires.
	currentLayoutBasis <Number>
	lastKnownNaturalExtent <Point> Used by the parent to store properties it based its current layout on, in order to decide later if an update is needed. *)
|
	principalSizeS
	minimumSizeS ::= SmallInteger minVal.
	expansibilityS ::= 0.
	compressibilityS ::= 0.

	public currentLayoutBasis
	public lastKnownNaturalExtent
|) (
public compressibility = (
	(* The ifNil: clause in not needed in a stable image. Provided here for that first time when the change is loaded and already existing cells have this slot uninitialized. *)
	^compressibilityS ifNil: [0]
)
public compressibility: newElasticity <Number> = (
	compressibilityS:: newElasticity.
	requestBoundsUpdate
)
public elasticity ^<Number> = (
	(* BACKWARD COMPATIBILITY: split into expansion and compression elasticities. Keeping this one around for the time being. *)
	^expansibility
)
public elasticity: newElasticity <Number> = (
	(* BACKWARD COMPATIBILITY: the single elasticity setting is now split into separate expansion and compression elasticities. Setting both elasticities to the same value replicates the old behavior. *)
	expansibilityS:: newElasticity.
	compressibilityS:: newElasticity.
	requestBoundsUpdate
)
public expansibility = (
	(* The ifNil: clause in not needed in a stable image. Provided here for that first time when the change is loaded and already existing cells have this slot uninitialized. *)
	^expansibilityS ifNil: [0]
)
public expansibility: newElasticity <Number> = (
	expansibilityS:: newElasticity.
	requestBoundsUpdate
)
public flushLayoutCaches = (
	currentLayoutBasis:: nil.
	lastKnownNaturalExtent:: nil.
)
public imposesSize ^<Boolean> = (
	(* True if the cell is configured so that it ignores the contents natural extent and instead imposes its own size. *)

	^principalSizeS notNil
)
public isElastic = (
	^expansibility > 0 or: [compressibility > 0]
)
public minimumSize = (
	(* The ifNil: clause in not needed in a stable image. Provided here for that first time when the change is loaded and already existing cells have this slot uninitialized. *)
	^minimumSizeS ifNil: [0]
)
public minimumSize: newValue <Number> = (
	minimumSizeS: newValue.
	requestBoundsUpdate
)
public naturalExtent ^<Point> = (
	(* Answer the size the visual of this cell should ideally be given by its parent, based on the properties of both the area and the visual. For example, a Row cell with no explicitly set width would prefer to be sized to the width of its visual's natural extent, while a cell with an explicit width would prefer to have the visual sized to that width. *)

	subclassResponsibility
)
public naturalHeightForWidth: size <Number> ^<Number> = (
	(* Answer the size the visual should take along the principal axis within a parent of the given size along the orthogonal axis. *)

	subclassResponsibility
)
public naturalOrthogonalSize ^<Number> = (
	(* A subclass should implement this to fetch the value to be reported as its orthogonal size from the visual's natural extent properties. *)

	self subclassResponsibility
)
public naturalPrincipalSize ^<Number> = (
	(* A subclass should implement this to fetch the value to be reported as its principal size from the visual's natural extent properties. *)

	self subclassResponsibility
)
public principalSize ^<Number> = (
	^principalSizeS ifNil: [naturalPrincipalSize]
)
public principalSize: newSize <Number> = (
	principalSizeS:: newSize.
	requestBoundsUpdate
)
public printOn: aStream = (
	super printOn: aStream.
	aStream
		nextPutAll: ' size: '; print: principalSizeS;
		nextPutAll: ' expansibility: '; print: expansibilityS;
		nextPutAll: ' compressibility: '; print: compressibilityS
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
public class ShapeArea = Area (
(* A ShapeArea is an area intended for Shapes positioned inside a free-form parent such as a CompositeVisual. It keeps track of the origin the shape is to have inside the parent's bounds, while the shape keeps track of its own extent. The area always grants the visual the bounds with the origin it keeps track of and the extent equal to the visual's natural extent. *)
|
	originS
	public lastSuggestedExtentKnownToParent
|) (
bounds: newBounds <Rectangle> = (
	originS:: newBounds origin.
	visual size: newBounds extent.
	(* Setting the extent of the visual takes care of requesting layout update *)
)
public boundsWithin: referenceBounds <Rectangle> = (
	^originS extent: visual naturalExtent
)
public isSqueezing ^<Boolean> = (
	^false
)
moveBy: delta <Point> = (
	originS:: origin + delta.
	requestBoundsUpdate
)
moveTo: newOrigin <Point> = (
	(* A synonym of #origin:, for the cases when it's more natural. *)

	self origin: newOrigin
)
origin ^<Point> = (
	^originS
)
origin: newOrigin <Point> = (
	originS:: newOrigin.
	requestBoundsUpdate
)
public resetLastSuggestedExtentKnownToParent = (
	lastSuggestedExtentKnownToParent:: -1 @ -1
	(* we need a value that's a legal Point but cannot equal any legal extent *)
)
public suggestedParentExtent ^<Point> = (
	^originS + visual naturalExtent
)
public visual: aVisual = (
	super visual: aVisual.
	resetLastSuggestedExtentKnownToParent.
	origin: 0 @ 0
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
class WidthEqualizingRowCell = RowCell (|
	public equalizer
	|) (
naturalPrincipalSize = (
	^equalizer commonNaturalWidth
)
) : (
public visual: aVisual <Visual> = (
	^self new visual: aVisual; yourself
)
)
) : (
)
class ContainerClasses = (
(* Formerly the category Brazil-Visuals-Containers *)
|
	private ContainerVisual = visuals ContainerVisual.
	private VerticalVisualSequence = visuals VerticalVisualSequence.
	private VisualCollection = visuals VisualCollection.
	private HorizontalVisualSequence = visuals HorizontalVisualSequence.
	private Anchor = areas Anchor.
	private Frame = areas Frame.
	private ModifierKeyState = plumbing ModifierKeyState.
	private Attribute = Future computing: [plumbing Attribute].
	private Blank = widgets Blank.
	private MappableHolder = Future computing: [plumbing MappableHolder].
	|) (
public class Column = VerticalVisualSequence (
(* A Column positions its children vertically one after another.

The Y component of a Columns's own natural extent is the sum of natural extents of its children. The X component of a Column natural extent is equal to the largest of the X components of its children's natural extents. If a Column is sized to its natural extent, each child is allocated a parcel of the height equal to the Y component of the child's natural extent and the width equal to the width of the Column. If a Column size is different from its natural extent and there are no elastic children (see below),  then either the bottom-most children are hidden from view or there is empty space at the bottom end of the Column.

By default each child gets a ColumnCell as its area. A ColumnCell can be given an explicit height by sending to it the #height: message. If set, an explicit height overrides the height of the corresponding child naturalExtent in determining the layout of the child.

A ColumnCell can also be made _elastic_ by sending it the #elasiticity: message with a numeric argument. (The default elasticity value is 0). Elasticity affects the layout as follows. If the size of a Column is different from its naturalExtent, the excess or the lack of vertical room is distributed equally to elastic children, proportionally to their elasticity. *)
|
	|) (
public setupAreaIn: child <Visual> = (
	child setupAreaForColumn
)
) : (
)
public class CompositeVisual = VisualCollection (
(* A CompositeVisual is a simple container visual that can hold any number of children (including none). The children are expected to use an Area that responds to ''bounded'' positioning protocol, most importantly the #boundWithin: and #suggestedParentExtent messages. The three most commonly used such Areas are Anchor, Frame and ShapeArea. The first two are generic, the third can only be used with Shapes.

A CompositeVisual is a concrete class, but it also a superclass of a few classes the utilize different layout schemes, most importantly subclasses of VisualSequence such as Row and Column.

Instance Variables
	colorA:			<Attribute> The background color of the visual. Transparent by default.
	children:		<List [Visual]> The children of the receiver, arranged in the order of the increasing Z value (the topmost last).
	cachedNaturalExtent:		<Point | nil> If set, the last known value of the natural extent of the receiver, defined as the smallest rectangle that contains all the children and the 0 @ 0 point. *)
|
	cachedNaturalHeightForWidth
	|) (
public add: newChild <Visual> = (
	(* Add a new child to the recevier. The child becomes the topmost and will obscure any sibling it overlaps. *)

	^restructuring:
		[self privateAdd: newChild using: [children add: newChild]]
)
public add: newChild <Visual> inFrontOf: existingChild <Visual> = (
	(* Add a new child to the recevier. The child is the next one (on top of) the existing child passed as the second argument. *)

	^restructuring:
		[self privateAdd: newChild using:
			[children add: newChild after: existingChild]]
)
public addAtBack: newChild <Visual> = (
	(* Add a new child to the recevier. The child becomes the bottommost and will be obscured by any sibling it overlaps. *)

	^restructuring:
		[self privateAdd: newChild using: [children addFirst: newChild]]
)
adviseBoundsFor: child <Visual> = (
	child occupyBounds: (computeBoundsFor: child)
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* Process a layout update request coming from the child. *)

	| oldNaturalExtent |
	(mayAffectNaturalExtent: child)
		ifTrue:
			[oldNaturalExtent:: naturalExtent.
			updateGeometricProperties.
			naturalExtent = oldNaturalExtent
				ifTrue:
					[continuation value: (child area boundsWithin: innerBounds)]
				ifFalse:
					[updateLayoutByRequestFrom: child using: continuation.
					announceNaturalExtentChange]]
		ifFalse:
			[continuation value: (child area boundsWithin: innerBounds)].
	announceLayoutChange
)
computeBoundsFor: child <Visual> = (
	^child area boundsWithin: innerBounds
)
public computeNaturalExtent = (
	(* Compute and answer the natural extent of the receiver as defined by the current parameters of its children. A composite wants to be just large enough to accommodate all suggested extents of all children. *)

	| max |
	max:: (0@0).
	self childrenDo:
		[:each | | suggestion |
		suggestion: each area suggestedParentExtent.
		each area lastSuggestedExtentKnownToParent: suggestion.
		max:: max max: suggestion].
	^max
)
public computeNaturalHeightForWidth: width <Number> ^<Number> = (
	| maxHeight |
	maxHeight:: 0.
	childrenDo:
		[:each |
		maxHeight:: maxHeight max: (each area suggestedParentHeightForWidth: width)].
	^maxHeight
)
createAgentUsing: aMapping = (
	(* Mapping a tree of widgets often generates a stream on natural extent change notifications from the children as they discover their true natural extents after being mapped. To avoid constant recomputations we block incremental updates for the duration of mapping. *)

	aMapping createAgentForCompositeVisual: self
)
public flushLayoutCaches = (
	(* Also flush a layout note in each area, which is the last parent extent suggested by the area. *)

	super flushLayoutCaches.
	childrenDo: [:each | each area resetLastSuggestedExtentKnownToParent].
	updateGeometricProperties
)
public forceBoundsResponse: newBounds <Rectangle> = (
	| playground |
	super forceBoundsResponse: newBounds.
	playground: innerBounds.
	childrenDo:
		[:each |
		each forceBounds: (each area boundsWithin: playground)].
	announceLayoutChange
)
public legalAreaClassesFor: child <Visual> = (
	^child legalAreaClassesInCompositeVisual
)
mayAddingAffectNaturalExtent: child <Visual> = (
	(* The child is being added to the receiver, and we need to know if adding it will affect the receiver's natural extent. If this can't be determined without computing the receiver's current natural extent (i.e. if there is no cached value), just say it may. *)

	| suggestion myNaturalExtent |
	suggestion:: child area suggestedParentExtent.
	child area lastSuggestedExtentKnownToParent: suggestion.
	myNaturalExtent:: naturalExtent.
	^suggestion x > myNaturalExtent x or:
		[suggestion y > myNaturalExtent y]
)
mayAffectNaturalExtent: child <Visual> = (
	(* The argument is a child that is currently requesting a layout update due to changes in its parameters. Determine if there is a chance that the composite visual's natural extent has been affected by the change. If there is any doubt or there is no answer, say yes. *)

	| oldSuggestion newSuggestion |
	oldSuggestion:: child area lastSuggestedExtentKnownToParent.
	newSuggestion:: child area suggestedParentExtent.
	newSuggestion = oldSuggestion ifTrue: [^false].
	child area lastSuggestedExtentKnownToParent: newSuggestion.
(* The change in the child may have affected the parent's natural extent if either the parent extent previously suggested by this child touches the current natural extent of the parent along one of the axes (so shrinking or growing the child can shrink or grow the parent), or if the new suggested parent extent is larger than the current one, so we definitely know the parent's natural extent has been grown by the change. *)
	^oldSuggestion x = currentNaturalExtent x
		or: [oldSuggestion y = currentNaturalExtent y
		or: [newSuggestion x > currentNaturalExtent x
		or: [newSuggestion y > currentNaturalExtent y]]]
)
mayRemovingAffectNaturalExtent: child <Visual> = (
	(* The argument is a child that has just been removed. Determine if there is a chance that the composite visual's natural extent has been affected by that. If there is any doubt or there is no answer, say yes. *)

	| oldSuggestion |
	oldSuggestion:: child area lastSuggestedExtentKnownToParent.
	^oldSuggestion x = currentNaturalExtent x
		or: [oldSuggestion y = currentNaturalExtent y]
)
public naturalHeightForWidth: width = (
	cachedNaturalHeightForWidth = width ifFalse:
		[cachedNaturalHeightForWidth:: width.
		cachedNaturalHeightForWidth:: computeNaturalHeightForWidth: width].
	^cachedNaturalHeightForWidth
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	(* An unsolicited layout update: see superclass methods for a detailed discussion. In this class, the layout of the children can only change if the extent changes, therefore we only update the children if that is the case. *)

	| oldExtent playground |
	oldExtent: extent.
	super occupyBoundsResponse: newBounds.
	oldExtent = extent
		ifTrue:
			[childrenDo: [:each | each reiterateBounds]]
		ifFalse:
			[playground:: innerBounds.
			childrenDo:
				[:each |
				each occupyBounds: (each area boundsWithin: playground)].
			announceLayoutChange]
)
public privateAdd: newChild <Visual> using: childCollectionUpdateBlock <Block> = (
	(* The common private logic for adding a new child to the recevier. The collection update block takes care of actually adding the new child at the proper location in the collection of children. After the initial setup is complete and before the child may be mapped, we need to set its layout. The correct update behavior depends of whether the new child may have affected the receiver's natural extent, and whether it actually has. All of the branches are detected and handled independently because that often eliminates much redundant processing. *)

	| oldNaturalExtent |
	childCollectionUpdateBlock value.
	newChild linkToParent: self.
	isMapped ifTrue:
		[(mayAddingAffectNaturalExtent: newChild)
			ifTrue:
				[oldNaturalExtent:: naturalExtent.
				updateGeometricProperties.
				naturalExtent = oldNaturalExtent
					ifTrue:
						[adviseBoundsFor: newChild]
					ifFalse:
						[requestBoundsUpdateUsing:
							[:newBounds |
							newBounds = bounds
								ifTrue: [adviseBoundsFor: newChild]
								ifFalse: [occupyBounds: newBounds]]].
				announceNaturalExtentChange]
			ifFalse:
				[adviseBoundsFor: newChild].
		newChild mapSubtree]
)
public remove: child <Visual> = (
	| oldNaturalExtent |
	restructuring:
		[children remove: child.
		child unlinkFromParent.
		(mayRemovingAffectNaturalExtent: child) ifTrue:
			[oldNaturalExtent:: naturalExtent.
			updateGeometricProperties.
			naturalExtent = oldNaturalExtent
				ifFalse:
					[requestBoundsUpdate.
					announceNaturalExtentChange]]]
)
public setupAreaIn: child <Visual> = (
	child setupAreaForCompositeVisual
)
updateLayoutByRequestFrom: child <Visual> using: continuation <Block> = (
	(* In the course of processing a bounds request from the child, we determined we need to request a bounds update for ourselves from the parent. The following scenarios are possible:
	1. If the bounds received from the parents are unchanged, only update the affected child using the continuation it provided for the update.
	2. If our bounds have changed, update all children if the new bounds' extent is different from the old.
	For any child updates, use the continuation for the requestor child since this update is solicited by it. Use #occupyBounds: for the others since for them the update is unsolicited. *)

	| playground |
	requestBoundsUpdateUsing:
		[:newBounds | | extentChanged |
		newBounds = bounds
			ifTrue:
				[continuation value: (computeBoundsFor: child)]
			ifFalse:
				[extentChanged:: newBounds extent ~= bounds extent.
				boundsH value: newBounds.
				extentChanged ifTrue:
					[playground:: innerBounds.
					childrenDo:
						[:each | | eachBounds |
						eachBounds:: each area boundsWithin: playground.
						each == child
							ifTrue:
								[continuation value: eachBounds]
							ifFalse:
								[each occupyBounds: eachBounds]]]]]
)
) : (
)
public class Desktop withMapping: aMapping <BrazilMapping> = (
(* Desktop is the root of the tree of visuals. It is the parent of any open window. *)
|
	public agent
	public windows ::= List new.
	public updateLockLevel ::= 0.
	public windowClosePermission
	|mapUsing: aMapping) (
public add: aWindow <Window> = (
	windows add: aWindow.
	aWindow linkToParent: self.
	isMapped ifTrue:
		(* It is important to advise the bounds first and only then map, because
		advising the bounds forces all the visuals under the window, and first of all
		the window itself, to assume the correct bounds as dictated by their areas. *)
		[adviseBoundsFor: aWindow.
		aWindow mapSubtree].
)
public add: aWindow <Window> in: areaClass <Class> = (
	aWindow areaClass: areaClass.
	self add: aWindow
)
adviseBoundsFor: window <Window> = (
	window occupyBounds:
		(window area boundsWithin: self bounds)
)
adviseBoundsFor: window <Window> using: aBlock <Block> = (
	aBlock value:
		(window area boundsWithin: self bounds)
)
public bounds ^<Rectangle> = (
	(* Answer the entire area of the desktop, i.e. the rectangle as large as the screen with the origin at 0@0. 0@0 being the origin is an important invariant to allow the layout framework work properly. *)

	^agent desktopBounds
)
public centeredRectangleOfExtent: rectExtent <Point> ^<Rectangle> = (
	(* Answer a rectangle of the specified extent centered within the desktop. *)

	^(extent - rectExtent) // 2 extent: rectExtent
)
public child: child <Window> requestsBoundsUpdateUsing: aBlock = (
	self adviseBoundsFor: child using: aBlock
)
public clearDraggedImage = (
	agent clearDraggedImage
)
createAgentUsing: aMapping <BrazilMapping> = (
	unmap.
	agent:: aMapping createAgentForDesktop: self.
	windows do: [:each | each mapSubtreeUsing: aMapping]
)
createWindow = (
	| window |
	window:: Window new.
	add: window.
	^window
)
public desktop = (
	^self
)
disableUserInputDuring: action <[T]> ^<T> = (
	(* Disable U/I events during evaluation of the given action. Return the result of the evaluation.
	Example usage:
		[
			Desktop theDesktop disableUserInputDuring:
				[anObject performLongOperation]
		] forkAt: Processor userBackgroundPriority.
	*)
	^agent disableUserInputDuring: action
)
public discardMappings = (
	agent:: nil.
	windows copy do: [:each | each discardMappings]
)
effectivelyVisible ^<Boolean> = (
	^true
)
ensureUpToDateAppearance = (
	agent ensureUpToDateAppearance
)
public extent ^<Point> = (
	(* Answer the extent of the entire desktop (including the areas that cannot host windows, such as the Windows taskbar or the Mac menu bar). *)

	^bounds extent
)
public globalOrigin = (
	^0 @ 0
)
public isDescendantOf: anything = (
	^false
)
public isMapped = (
	^agent notNil
)
public isMorphic ^<Boolean> = (
	^agent isMorphic
)
public isSqueezing ^<Boolean> = (
	^false
)
public isWindows ^<Boolean> = (
	^agent isWindows
)
public legalAreaClassesFor: child = (
	^{Anchor. Frame}
)
mapUsing: aMapping <BrazilMapping> = (
	unmap.
	agent:: aMapping createAgentForDesktop: self.
	windows do: [:each | each mapSubtree]
)
public mapping = (
	^agent mapping
)
mayAccommodateNaturalHeightChangeOf: child <Visual> ^<Boolean> = (
	^true
)
mayAccommodateNaturalWidthChangeOf: child <Visual> ^<Boolean> = (
	^true
)
public modifierKeyStateForCurrentEvent = (
	^agent
		ifNil: [ModifierKeyState new]
		ifNotNil: [:it | it modifierKeyStateForCurrentEvent]
)
public mousePoint ^<Point> = (
	(* Answer the current location of the mouse in the global desktop coordinates. *)

	^agent mousePoint
)
public positionWindowsWithinVisibleScreenArea = (
	#BOGUS yourself. (* Unclear if this is a Morphic only problem. For now, assume it is. *)
	WorldState addDeferredUIMessage:
		[World fullRepaintNeeded]
)
printHierarchyLayoutReportOn: aStream = (
	aStream nextPutAll: '-- desktop --'
)
public remove: aWindow <Window> = (
	windows remove: aWindow.
	aWindow unlinkFromParent
)
public scheduleUIAction: aBlock <Block> = (
	(* Schedule an action to be spliced into the normal UI activity (this is presumably sent on a thread different from the UI thread). *)

	agent scheduleUIAction: aBlock
)
public scheduleUIInstallment: aBlock <Block> = (
	(* Schedule an action to be spliced into the normal UI activity (this is presumably sent on a thread different from the UI thread). *)

	agent scheduleUIInstallment: aBlock
)
public setDraggedImage: image <Form> = (
	agent setDraggedImage: image
)
setFingerCursor = (
	(* Change the mouse cursor to a finger (index, not middle). *)
	agent setFingerCursor
)
setLeftRightCursor = (
	(* Change the mouse cursor to be an arrow pointing left and right. *)
	agent setLeftRightCursor
)
setNormalCursor = (
	(* Change the mouse cursor to the arrow shape. *)
	agent setNormalCursor
)
setWaitCursor = (
	(* Change the mouse cursor to the wait (e.g. hourglass) shape. *)
	agent setWaitCursor
)
public setupAreaIn: child <Window> = (
	child setupAreaForDesktop
)
systemIsIdle = (
	(* Answers if the system is idle, that is, the user has generated no events recently. *)
	(* If the agent is nil we assume this is during image startup and pretend that system is idle.
	This default makes sense if clients of this method should be quiescent when the system is idle. *)
	^(agent ifNil: [^true]) systemIsIdle
)
public unmap = (
	agent ifNotNil:
		[windows do: [:each | each unmapSubtree].
		agent: nil]
)
public updateDraggedImagePosition = (
	agent updateDraggedImagePosition
)
usableBounds ^<Rectangle> = (
	(* Answer the usable area of the desktop, i.e. the portion of #bounds excluding the areas that should not normally host windows, such as the Windows taskbar or the Mac menu bar. *)

	^agent usableDesktopBounds
)
public windowAtPoint: point <Point> ^<Window | nil> = (
	^agent windowAtPoint: point
)
public windowHasPermissionToClose: window <Window> ^<Boolean> = (
	(* The window is about to be closed, and its regular code has already given permission to do so. The decision is delegated to a client-supplied windowClosePermission block, if present. *)
	^windowClosePermission isNil or:
		[windowClosePermission value: window]
)
) : (
)
public class Flow = VisualCollection (|
	horizontalGapA ::= Attribute name: #horizontalGap value: 0.
	verticalGapA ::= Attribute name: #verticalGap value: 0.
	cachedHeightGivenWidth
	precomputedChildrenBounds 	::= IdentityMap new.
|affectsNaturalExtent: horizontalGapA.
	affectsNaturalExtent: verticalGapA) (
public add: newChild <Visual> = (
	(* Add the new child as the last element in the sequence. *)

	restructuring:
		[children add: newChild.
		newChild linkToParent: self.
		isMapped ifTrue:
			[updateGeometricProperties.
			requestBoundsUpdate.
			newChild mapSubtree].
		announceNaturalExtentChange].
	^newChild
)
addAtBack: newChild <Visual> = (
	(* Adding as the first element in the sequence (which is what adding at back means for a Flow). *)

	restructuring:
		[children addFirst: newChild.
		newChild linkToParent: self.
		isMapped ifTrue:
			[updateGeometricProperties.
			requestBoundsUpdate.
			newChild mapSubtree].
		announceNaturalExtentChange].
	^newChild
)
addFirst: newChild <Visual> = (
	(* Add the new child as the first element in the sequence. *)

	^addAtBack: newChild
)
public child: child requestsBoundsUpdateUsing: continuation = (
	child area suggestedParentExtent = child area lastSuggestedExtentKnownToParent
		ifTrue:
			[continuation value: (precomputedBoundsFor: child)]
		ifFalse:
			[cachedHeightGivenWidth: nil.
			requestBoundsUpdateUsing:
				[:newBounds |
				boundsH value: newBounds.
				recomputeLayout.
				childrenDo:
					[:each |
					each == child
						ifTrue: [continuation value: (precomputedBoundsFor: each)]
						ifFalse: [each occupyBounds: (precomputedBoundsFor: each)]]]]
)
composeOneLineFrom: stream within: width using: aBlock = (
(* The stream is not empty on entry; must consume at least one element. *)
| elements extent maxHeight right |
elements:: List with: stream next.
extent:: elements first area suggestedParentExtent.
maxHeight:: extent y.
right:: extent x.
[stream atEnd] whileFalse:
	[right:: right + horizontalGap.
	extent:: stream peek area suggestedParentExtent.
	right + extent x <= width
		ifTrue:
			[right:: right + extent x.
			maxHeight:: maxHeight max: extent y.
			elements add: stream next]
		ifFalse:
			[^aBlock value: elements value: maxHeight]].
^aBlock value: elements value: maxHeight
)
public computeNaturalExtent = (
	| totalWidth maxHeight |
	totalWidth:: hasChildren ifTrue: [horizontalGap negated] ifFalse: [0].
	maxHeight:: 0.
	childrenDo:
		[:each | | extent |
		extent:: each area suggestedParentExtent.
		totalWidth:: totalWidth + extent x + horizontalGap.
		maxHeight:: maxHeight max: extent y].
	^totalWidth @ maxHeight
)
public computeNaturalHeightForWidth: width <Number> ^<Number> = (
	| stream height |
	stream:: children readStream.
	height:: stream atEnd
		ifTrue: [0]
		ifFalse: [verticalGap negated].
	[stream atEnd] whileFalse:
		[height:: height +
			verticalGap +
			(readAndMeasureOneLineFrom: stream within: width)].
	^height
)
createAgentUsing: aMapping = (
	aMapping createAgentForVisualSequence: self.
	cachedHeightGivenWidth: nil.
)
public flushLayoutCaches = (
	(* This message informs the receiver that something has changed that affects its visual appearance and layout. The cached value of the receiver's natural extent is now likely to be invalid. *)

	cachedHeightGivenWidth: nil.
	precomputedChildrenBounds:: IdentityMap new.
	super flushLayoutCaches
)
public forceBoundsResponse: newBounds <Rectangle> = (
	boundsH value: newBounds.
	recomputeLayout.
	childrenDo: [:each | each forceBounds: (precomputedBoundsFor: each)]
)
horizontalGap = (
	^horizontalGapA value
)
public horizontalGap: newValue <Integer> = (
	horizontalGapA value: newValue
)
public legalAreaClassesFor: child <Visual> ^<Collection[Class]> = (
	^child legalAreaClassesInFlow
)
public naturalHeightForWidth: width = (
	| height |
	^(cachedHeightGivenWidth notNil and: [cachedHeightGivenWidth first = width])
		ifTrue:
			[cachedHeightGivenWidth at: 2]
		ifFalse:
			[height:: computeNaturalHeightForWidth: width.
			cachedHeightGivenWidth:: {width. height}.
			height]
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	boundsH value: newBounds.
	recomputeLayout.
	childrenDo: [:each | each occupyBounds: (precomputedBoundsFor: each)]
)
precomputedBoundsFor: child <Visual> = (
	^precomputedChildrenBounds at: child
)
precomputedBoundsFor: child <Visual> are: box <Rectangle> = (
	precomputedChildrenBounds at: child put: box
)
readAndMeasureOneLineFrom: stream within: width = (
(* The stream is not empty on entry; must consume at least one element. *)
| extent maxHeight right |
extent:: stream next area suggestedParentExtent.
maxHeight:: extent y.
right:: extent x.
[stream atEnd] whileFalse:
	[right:: right + horizontalGap.
	extent:: stream peek area suggestedParentExtent.
	right + extent x <= width
		ifTrue:
			[right:: right + extent x.
			maxHeight:: maxHeight max: extent y.
			stream next]
		ifFalse:
			[^maxHeight]].
^maxHeight
)
recomputeLayout = (
	| width stream top box |
	width:: extent x.
	stream:: children readStream.
	top:: 0.
	[stream atEnd] whileFalse:
		[composeOneLineFrom: stream within: width using:
			[:visuals :maxHeight | | left |
			left:: 0.
			visuals do:
				[:each | | suggestion |
				suggestion:: each area suggestedParentExtent.
				each area lastSuggestedExtentKnownToParent: suggestion.
				box:: left @ top extent: suggestion x @ maxHeight.
				precomputedBoundsFor: each are: box.
				left:: box right + horizontalGap]].
		top:: box bottom + verticalGap]
)
remove: child <Visual> = (
	restructuring:
		[children remove: child.
		child unlinkFromParent.
		updateGeometricProperties.
		requestBoundsUpdate].
	announceNaturalExtentChange
)
public reorder: visuals = (
(* Make sure the order of the elements matches that of the argument. *)

(visuals select: [:any | (children includes: any) not]) isEmpty not ifTrue:
	[error: 'bad argument'].
children:: visuals asOrderedCollection.
recomputeLayout
)
public setupAreaIn: child <Visual> = (
	child setupAreaForFlow
)
verticalGap = (
	^verticalGapA value
)
verticalGap: newValue <Integer> = (
	verticalGapA value: newValue
)
) : (
)
public class Grid = Column (
(* A grid is a matrix of cells, each containing a visual. It can logically be viewed as a column of rows (or a row of columns), with the added constraint that the width of each row element needs to be equalized with the width of same-index elements of other rows. Thus, this implementation is a special kind of Column containing a special kind of Row (GridRowX).

A grid is initialized to be a certain size. Initially, each cell is a Wrapper with a Blank. The actual content can be added or replaced using the #at:put: message, with the first argument being a Point.

   Copyright 2008 Cadence Design Systems, Inc.

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0
*)
|
	columnGapA ::= Attribute name: #columnGap value: 0.
 |) (
addColumn = (
	blockIncrementalLayoutUpdatesWhile:
		[childrenDo: [:each | each addColumn]]
)
addRow = (
	add: (GridRowX columns: columnCount)
)
at: coordinate <Point> ^<Visual> = (
	^(children at: coordinate y) at: coordinate x
)
at: coordinate <Point> put: visual <Visual> = (
	(children at: coordinate y) at: coordinate x put: visual
)
columnCount ^<Integer> = (
	^children isEmpty
		ifTrue: [0]
		ifFalse: [children first columnCount]
)
columnGap ^<Integer> = (
	^columnGapA value
)
columnGap: newGap <Integer> = (
	columnGapA value: newGap.
	childrenDo: [:each | each gap: newGap]
)
computeColumnWidthAt: index = (
	^children inject: 0 into: [:max :each | max max: (each columnWidthAt: index)]
)
public computeNaturalExtent ^<Point> = (
	| sumX sumY gapSum |
	sumX: 0.
	1 to: columnCount do:
		[:index |
		sumX: sumX + (computeColumnWidthAt: index)].
	sumY: 0.
	childrenDo:
		[:each |
		sumY: sumY + each area naturalExtent y].
	gapSum: (children size - 1 max: 0) * gap.
	^sumX @ (sumY + gapSum)
)
extentAt: cell <Point> is: extent <Point> = (
	(at: cell) area forcedExtent: extent.
	refreshLayout
)
public finishedMapping = (
	super finishedMapping.
	refreshLayout.
)
recomputeColumnWidths = (
	| maxCellWidthInColumn |
	childrenDo:
		[:each | each flushPrecomputedColumnWidths].
	1 to: columnCount do:
		[:index |
		maxCellWidthInColumn:: 0.
		childrenDo:
			[:each |
			maxCellWidthInColumn::
				maxCellWidthInColumn max: (each columnWidthAt: index)].
		childrenDo:
			[:each | each setColumnAt: index widthTo: maxCellWidthInColumn]]
)
refreshLayout = (
	blockIncrementalLayoutUpdatesWhile:
		[flushLayoutCaches.
		recomputeColumnWidths.
		requestBoundsUpdateUsing:
			[:newBounds |
			forceBounds: newBounds]]
)
row: row <GridRow> requestsBoundsUpdateCausedBy: cell <Visual> using: continuation <Block> = (
	| newNaturalExtent |
	newNaturalExtent:: cell area naturalExtent.
	newNaturalExtent y = cell area currentLayoutBasis
		ifTrue:
			[continuation value: row bounds]
		ifFalse:
			[cell area currentLayoutBasis: newNaturalExtent y.
			updateGeometricProperties.
			updateLayoutForCell: cell inRow: row using: continuation]
)
rowCount ^<Integer> = (
	^children size
)
rows: rows <Integer> columns: columns <Integer> = (
	| row |
	rows timesRepeat:
		[row:: GridRowX columns: columns.
		row gap: columnGap.
		add: row]
)
updateLayoutForCell: cell <Visual> inRow: row <GridRow> using: continuation <Block> = (
	| index maxCellWidthInColumn |
	index:: row indexOf: cell.
	maxCellWidthInColumn:: 0.
	childrenDo:
		[:each | maxCellWidthInColumn:: maxCellWidthInColumn max: (each columnWidthAt: index)].
	blockIncrementalLayoutUpdatesSilentlyWhile:
		[childrenDo:
			[:each | each setColumnAt: index widthTo: maxCellWidthInColumn]].
	repositionAllChildrenByRequestFrom: row using: continuation
)
) : (
rows: rowCount columns: columnCount = (
	^new rows: rowCount columns: columnCount
)
)
class GridRowX = Row (
(* PRIVATE CLASS

GridRow is used internally by Grid to arrange its cells. It is not supposed to be used directly by an application. One of the main differences of a grid row is delegating any child bounds updates it receives to the parent (the grid) so that the grid can match the layout of the same cell in other rows. *)
) (
addColumn = (
	add: (Wrapper with: Blank new)
)
at: index <Integer> ^<Visual> = (
	^children at: index
)
at: index <Integer> put: visual <Visual> = (
	| old |
	old:: children at: index.
	restructuring:
		[children at: index put: visual.
		old unlinkFromParent.
		visual linkToParent: self.
		isMapped ifTrue:
			[visual mapSubtree.
			reportNaturalExtentChange]]
)
public child: cell <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	parent
		row: self
		requestsBoundsUpdateCausedBy: cell
		using:
			[:newBounds |
			setBounds: newBounds.
			repositionAllChildrenByRequestFrom: cell using: continuation]
)
columnCount ^<Integer> = (
	^children size
)
columnWidthAt: index <Integer> = (
	#BOGUS yourself. (* the older version is below, looks wrong. clean up the related story *)
	^(children at: index) area naturalExtent x
	(* ^(children at: index) area width *)
)
columns: columns <Integer> = (
	columns timesRepeat: [addColumn]
)
flushPrecomputedColumnWidths = (
	(* The hard widths set in individual cell areas need to be removed so that they do not shadow the cells' own natural extents during layout computation. *)

	childrenDo: [:each | each area quietlySetWidth: nil]
)
grid ^<Grid> = (
	^parent
)
public legalAreaClassesFor: child <Visual> = (
	^child legalAreaClassesInGridRow
)
setColumnAt: index <Integer> widthTo: width <Integer> = (
	(children at: index) area width: width.
	updateGeometricProperties
)
public setupAreaIn: child <Visual> = (
	child setupAreaForGridRow
)
) : (
columns: columns = (
	^new columns: columns
)
)
public class HorizontalViewport = HorizontalVisualSequence (|
	public scrollPositionH ::= MappableHolder with: 0 @ 0.
	public keystrokeChannel = Duct new beWeak.
|) (
public allowsHorizontalScrolling = (
	^true
)
public allowsVerticalScrolling = (
	^false
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	super child: child requestsBoundsUpdateUsing: continuation.
	isMapped ifTrue: [agent matchScrollbarRange]
)
createAgentUsing: aMapping = (
	aMapping createAgentForViewport: self
)
public forceBoundsResponse: newBounds = (
	super forceBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public globalOriginForChildren ^<Point> = (
	(* Answer the coordinates of the top left corner of the visual's surface, relative to which the children are positioned. This value if affected by the current scroll position of the visual for those visuals that support scrolling. *)

	^globalOrigin translateBy: scrollPosition negated
)
hasElasticChildren ^<Boolean> = (
	(* Viewports do not honor children elasticity. *)

	^false
)
innerBounds ^<Rectangle> = (
	^0 @ 0
		extent: bounds extent - (0 @ scrollbarHeight)
)
public innerExtent ^<Rectangle> = (
	^extent - (0 @ scrollbarHeight)
)
public keystrokeFactory = (
	(* Give non-Newspeak agents in Brazil mapping ability to instantiate keystrokes. *)
	^Keystroke
)
public occupyBoundsResponse: newBounds = (
	super occupyBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public scrollPosition = (
	^scrollPositionH value
)
public scrollPosition: newOrigin <Point> = (
	scrollPositionH value: newOrigin
)
scrollbarHeight = (
	^agent == nil
		ifTrue: [0]
		ifFalse: [agent scrollbarHeight]
)
public setupAreaIn: child <Visual> = (
	child setupAreaForHorizontalViewport
)
public virtualExtent ^<Point> = (
	(* The extent of the area of the receiver currently occupied by its content. *)
	^naturalExtent x @ innerExtent y
)
) : (
)
class Keystroke asciiValue: asciiValue <Integer> = (
(* WORK IN PROGRESS (not at all a container class, but there is no other good place for it in the current module structure). A strawman platform-independent keystroke implementation to provide clients of visuals with some access to keystrokes in the visuals. *)
|
	public asciiValue = asciiValue.
|) (
keyCharacter = (
	^asciiValue asCharacter
)
) : (
)
public class Row = HorizontalVisualSequence (
(* A Row positions its children horizontally one after another.

The X component of a Row's own natural extent is the sum of natural extents of its children. The Y component of a Row natural extent is equal to the largest of the Y components of its children's natural extents. If a Row is sized to its natural extent, each child is allocated a parcel of the width equal to the X component of the child's natural extent and the height equal to the height of the Row. If a Row size is different from its natural extent and there are no elastic children (see below),  then either the rightmost children are hidden from view or there is empty space at the right end of the Row. Each child has the height equal to the height of the Row.

By default each child gets a RowCell as its area. A RowCell can be given an explicit width by sending to it the #width: message. If set, an explicit width overrides the width of the corresponding child naturalExtent in determining the layout of the child.

A RowCell can also be made _elastic_ by sending it the #elasiticity: message with a numeric argument. (The default elasticity value is 0). Elasticity affects children layout as follows. If the size of a Row is different from its naturalExtent, the excess or the lack of horizontal room is distributed equally to elastic children, proportionally to their elasticity.

Consider this example. A Row has a child A of width 10 and elasticity 1, a child B of width 20 and elasticity 2 and child C of width 40 and the default elasticity of 0. The natural width of this Row is 70. If the row is given 100 pixels instead, the excess 30 pixels are distributed to children A and B proportionally to their elasticity, so that child A gets extra 10 pixels and child B gets 20. The final sizes of the children are 20, 40 and 40 pixels, respectively.

The important applications of elasticity are Rows with centered or right-aligned children. To right-align the content of a Row, add a Blank visual with elasticity 1 as the first child. To center the content of a Row, add two Blanks with elasticity 1, as the first and the last child of a Row. Adding a Blank with elasticity 1 in the middle of a row will have the effect of flushing the children preceding the Blank to the left, and those that follow--to the right. *)
) (
public setupAreaIn: child <Visual> = (
	child setupAreaForRow
)
) : (
)
public class SpyingWrapper = Wrapper (
(* Spying wrapper is just like the regular one, but it logs the various layout negotiation messages it receives. Wrapping a visual in a spying wrapper is an easy way of spying on its layout computation. This also is a convenient place to set breakpoints to catch instance-specific layout updates.
*)
) (
public child: theChild <Visual> requestsBoundsUpdateUsing: action <[:Rectangle]> = (
	Transcript cr; show: 'childRequestsBoundsUpdate (entered)'.
	^super child: theChild requestsBoundsUpdateUsing:
		[:newBounds |
		Transcript
			cr;
			show: 'childRequestsBoundsBoundsUpdate -> ';
			show: newBounds printString.
		action value: newBounds]
)
) : (
)
public class VerticalViewport = VerticalVisualSequence (
(* A vertical viewport is similar to a column in that it stacks its elements vertically, sizing each to its own width. However, it provides a scrollbar to access the elements not currently visible. It also ignores elasticity of elements. *)
|
	public scrollPositionH ::= MappableHolder with: 0@0.
	public keystrokeChannel = Duct new beWeak.
|) (
public allowsHorizontalScrolling = (
	^false
)
public allowsVerticalScrolling = (
	^true
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	super child: child requestsBoundsUpdateUsing: continuation.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public computeNaturalExtent = (
	(* Take the scrollbar width into account. *)
	^super computeNaturalExtent + (scrollbarWidth @ 0)
)
public computeNaturalHeightForWidth: width <Number> ^<Number> = (
	^super computeNaturalHeightForWidth: width - scrollbarWidth
)
createAgentUsing: aMapping = (
	aMapping createAgentForVerticalViewport: self
)
public forceBoundsResponse: newBounds = (
	super forceBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public globalOriginForChildren ^<Point> = (
	(* Answer the coordinates of the top left corner of the visual's surface, relative to which the children are positioned. This value if affected by the current scroll position of the visual for those visuals that support scrolling. *)

	^globalOrigin translateBy: scrollPosition negated
)
hasElasticChildren ^<Boolean> = (
	(* Viewports do not honor children elasticity. *)

	^false
)
public innerBounds ^<Rectangle> = (
	^0 @ 0
		extent: bounds extent - (scrollbarWidth @ 0)
)
public innerExtent ^<Rectangle> = (
	^extent - (scrollbarWidth @ 0)
)
public keystrokeFactory = (
	(* Give non-Newspeak agents in Brazil mapping ability to instantiate keystrokes. *)
	^Keystroke
)
public occupyBoundsResponse: newBounds = (
	super occupyBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public privateAdd: child using: modificationBlock = (
	| result |
	result:: super privateAdd: child using: modificationBlock.
	isMapped ifTrue: [agent matchScrollbarRange].
	^result
)
public scrollPosition ^<Point> = (
	^scrollPositionH value
)
public scrollPosition: aPoint = (
	scrollPositionH value: aPoint
)
scrollbarWidth = (
	^agent == nil
		ifTrue: [0]
		ifFalse: [agent scrollbarWidth]
)
public setupAreaIn: child <Visual> = (
	child setupAreaForVerticalViewport
)
public virtualExtent ^<Point> = (
	(* The extent of the area of the receiver currently occupied by its content. *)
	| width |
	width:: innerExtent x.
	^width @ (naturalHeightForWidth: width)
)
) : (
)
public class Viewport = CompositeVisual (
(* Viewport adds to CompositeVisual the ability to have scroll bars to scroll itself when its content is larger than the available area. It also keeps track of the current scroll position as the coordinates of the top left corner of the visible area. *)
|
	public scrollPositionH ::= MappableHolder with: 0 @ 0.
	public keystrokeChannel = Duct new beWeak.
|) (
public allowsHorizontalScrolling = (
	^true
)
public allowsVerticalScrolling = (
	^true
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	super child: child requestsBoundsUpdateUsing: continuation.
	isMapped ifTrue: [agent matchScrollbarRange]
)
createAgentUsing: aMapping = (
	aMapping createAgentForViewport: self
)
public forceBoundsResponse: newBounds = (
	super forceBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public globalOriginForChildren ^<Point> = (
	(* Answer the coordinates of the top left corner of the visual's surface, relative to which the children are positioned. This value if affected by the current scroll position of the visual for those visuals that support scrolling. *)

	^globalOrigin translateBy: scrollPosition negated
)
innerBounds ^<Rectangle> = (
	^0 @ 0
		extent: bounds extent - (scrollbarWidth @ scrollbarHeight)
)
innerExtent ^<Point> = (
	(* Answer the extent of the portion of the viewport available for displaying its content. *)

	^extent - (scrollbarWidth @ scrollbarHeight)
)
public keystrokeFactory = (
	(* Give non-Newspeak agents in Brazil mapping ability to instantiate keystrokes. *)
	^Keystroke
)
public occupyBoundsResponse: newBounds = (
	super occupyBoundsResponse: newBounds.
	isMapped ifTrue: [agent matchScrollbarRange]
)
public scrollPosition ^<Point> = (
	^scrollPositionH value
)
public scrollPosition: newOrigin <Point> = (
	scrollPositionH value: newOrigin
)
scrollToPosition: innerLocation <Point> at: ratioPoint <Point> = (
(* Scroll the viewport so that the <innerLocation> point of the viewport's inner space is positioned at the given ratioPoint within the viewport's bounds. A ratio point of 0 @ 0 is top left, 0.5 @ 0.5 is the center, 1 @ 1 is bottom right. *)

self scrollPosition: innerLocation - (ratioPoint * innerExtent)
)
scrollbarHeight = (
	^agent == nil
		ifTrue: [0]
		ifFalse: [agent scrollbarHeight]
)
scrollbarWidth = (
	^agent == nil
		ifTrue: [0]
		ifFalse: [agent scrollbarWidth]
)
public virtualExtent ^<Point> = (
	(* The extent of the area of the receiver currently occupied by its content. *)
	^naturalExtent
)
visibleArea ^<Rectangle> = (
	(* Answer a Rectangle identiying the portion of the virtual display area of the viewport that is currently visible. *)

	^scrollPosition extent: innerExtent
)
) : (
)
public class Window = Wrapper (
(* This is a top-level window. Its parent, if any, is a Desktop. *)
|
	public titleA ::= Attribute name: #title value: 'Unnamed Window'.
	public minimumExtentA ::= Attribute name: #minimumExtent value: 10 @ 10.
	public menuBarMenuA ::= Attribute name: #menuBarMenu value: nil.
	public closePermission
	public dragDropDispatcher
	isModal
	|content: CompositeVisual new.
	visible: false) (
add: newChild <Visual> = (
(* Add newChild to the content visual of the receiver. This is a convenience protocol to avoid having to always write things such as 'window content add: aVisual'. *)

content add: newChild
)
public bounds: newBounds <Rectangle> = (
	area bounds: newBounds
)
bringToFront = (
	(* Make the window the topmost on the desktop. *)
	agent ifNotNil: [agent bringToFront]
)
public close = (
	(* This message can be sent from the application to close the window. The agent/mapping part will take care of checking closePermission, if present. After return from (agent close) the window may still be open if closePermission was denied. If the window is closed by the user rather than the application action, #mappedWindowClosed is sent to the window by the agent. *)
	agent ifNotNil: [agent close].
	(* A successful close will send back #mappedWindowClosed,
	which will properly unlink the window from the parent. *)
)
createAgentUsing: aMapping = (
	aMapping createAgentForWindow: self
)
extent: newExtent <Point> = (
area extent: newExtent
)
public findTargetForDragAt: globalPoint <Point> forSession: session <DragDropSession> = (
^dragDropDispatcher isNil
	ifTrue:
		[nil]
	ifFalse:
		[dragDropDispatcher
			findTargetForDragAt: globalPoint - origin
			forSession: session]
)
public globalOrigin = (
	^bounds origin
)
public hasPermissionToClose ^<Boolean> = (
(* Determine whether it is ok to close the receiver. This is controlled at two levels: by the window itself through a client-supplied closePermission block, and by the desktop. *)
^(closePermission isNil or: [closePermission value]) and:
	[ | theDsktop |
	theDsktop: desktop.
	theDsktop isNil or: [theDsktop windowHasPermissionToClose: self]]
)
public isOpen = (
	^agent notNil and: [agent isOpen]
)
public mappedWindowClosed = (
	(* This message is sent by the agent when its window is closed, either by the user using the UI mechanisms or programmatically at the visual's request. This is a restricted message, not for the use by application code. The application should use #close to close a window. In the latter case this method runs inside the dynamic extent of the receiver's #close method invocation. *)

	notifications send: #closed.
	parent remove: self. (* will send #unmap back *)
	isModal:: false.
	agent: nil
)
public menuBarMenu ^<Menu | nil> = (
	^menuBarMenuA value
)
public menuBarMenu: newMenu <Menu | nil> = (
	menuBarMenuA value: newMenu
)
minimumExtent = (
	^minimumExtentA value
)
minimumExtent: aPoint <Point> = (
	minimumExtentA value: aPoint
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	| box |
	box:: newBounds origin extent: (newBounds extent max: minimumExtent).
	super occupyBoundsResponse: box
)
public open = (
	parent ifNil: [theDesktop add: self].
	visible: true.
)
public openModalWhileFalse: doneValueProvider afterOpening: setupBlock = (
	isModal:: true.
	parent ifNil: [
		theDesktop add: self].
	agent modalOpenWhileFalse: doneValueProvider afterOpening:
		[setupBlock value.
		visible: true]
)
openOnDesktop: aDesktop <Desktop> = (
	parent isNil
		ifTrue: [aDesktop add: self]
		ifFalse: [parent ~~ aDesktop
			ifTrue:
				[parent remove: self.
				aDesktop add: self]].
	visible: true.
)
outerBounds ^<Rectangle> = (
(* The standard #bounds message returns the content area of the window. Outer bounds are the bounds that also include the window frame and the title bar. Outer bounds depend on the host platform. If the UI is not yet mapped, outerBounds are by definition the same as bounds. *)

^agent
	ifNil: [bounds]
	ifNotNil: [agent outerBounds]
)
remove: existingChild <Visual> = (
content remove: existingChild
)
public resizeFromUserTo: newBounds <Rectangle> = (
	(* Sent by the agent after the window artifact has been resized by the user. *)

	#BOGUS yourself.
	(area isKindOf: Frame)
		ifTrue:
			[area bounds: newBounds]
		ifFalse:
			[self occupyBounds: newBounds]
)
public setupAreaForDesktop = (
	setArea: (Frame visual: self).
	area isZero ifTrue:
		[area bounds: (70@70 extent: 150@100)]
)
public setupAreaIn: child <Visual> = (
	child setupAreaForWindow
)
shrinkWrap: shrinkWrap <Boolean> = (
	(* Convenience and backward compatibility. In the new world shrinkWrap is simply what kind of Area we use. *)

	areaClass: (shrinkWrap ifTrue: [Anchor] ifFalse: [Frame])
)
shrinkWrapNow = (
	area extent: content naturalExtent
)
public title = (
	^titleA value
)
public title: aString = (
	titleA value: aString
)
public window = (
	^self
)
) : (
)
public class Wrapper = ContainerVisual (
(* A wrapper is a container that holds one child at a time, inside either a Frame or an Anchor. Initially contains a Blank. The child is accessible by sending the #content message, and can be changed using the #content: message. *)
|
	contentS
	cachedNaturalHeightWidth
	cachedNaturalHeightForWidth
	|content: Blank new) (
adviseBoundsFor: child <Visual> = (
	child occupyBounds: (child area boundsWithin: localBounds)
)
public beBottomCenter = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beBottomCenter.
	^self
)
public beBottomLeft = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beBottomLeft.
	^self
)
public beBottomRight = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beBottomRight.
	^self
)
public beCentered = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beCentered.
	^self
)
public beLeftCenter = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beLeftCenter.
	^self
)
public beRightCenter = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beRightCenter.
	^self
)
public beTopCenter = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beTopCenter.
	^self
)
public beTopLeft = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beTopLeft.
	^self
)
public beTopRight = (
	(* A convenience method to support easy wrapping of visuals in wrappers enforcing a particular alignment. For example: 'aVisual wrapped beLeftCenter'. It is assumed that the content is managed by an Anchor. *)

	content area beTopRight.
	^self
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* The key to updating properly is whether sqishing can occur or not. If it can, i.e. if the parent does the squishing and we are able to be squished, the update logic is slightly different. In a squishy case, we need to give the parent a chance to reposition us even if our natural extent has not changed. *)

	(isSqueezing and: [child area isVisualSquishy])
		ifTrue: [updateSquishyChildLayout: child using: continuation]
		ifFalse: [updateSolidChildLayout: child using: continuation]
)
public childrenDo: aBlock = (
	content ifNotNil: [aBlock value: content]
)
public computeNaturalExtent ^<Point> = (
	^content area suggestedParentExtent
)
public content = (
	^contentS
)
public content: newContent <Visual> = (
	| oldNaturalExtent |
	oldNaturalExtent:: naturalExtent.
	restructuring:
		[contentS ifNotNil: (* may be nil in a fresh instance initialized with a blank *)
			[content unlinkFromParent].
		contentS: newContent.
		newContent linkToParent: self.
		isMapped ifTrue:
			[newContent mapSubtree.
			(* It is important to map first so that all natural sizes are right. *)
			flushLayoutCaches. (* updates geometricProperties *)
			(* reportToTranscript: [:v :out | out print: v; space; print: v naturalExtent; flush]. *)
			(* self explore.
			error: 'asdf'. *)
			(naturalExtent ~= oldNaturalExtent
					or: [isSqueezing and: [content area isVisualSquishy]])
				ifTrue:
					[requestBoundsUpdateUsing: [:newBounds | forceBounds: newBounds]]
				ifFalse:
					[content forceBounds: (content area boundsWithin: localBounds)].
			currentNaturalExtent = oldNaturalExtent
				ifFalse: [announceNaturalExtentChange]]]
)
createAgentUsing: aMapping = (
	aMapping createAgentForWrapper: self
)
public flushLayoutCaches = (
	cachedNaturalHeightWidth: nil.
	super flushLayoutCaches.
	updateGeometricProperties
)
public forceBoundsResponse: newBounds <Rectangle> = (
	super forceBoundsResponse: newBounds.
	content forceBounds: (content area boundsWithin: localBounds)
)
innerBounds ^<Rectangle> = (
	(* Answer the area of the receiver available for displaying children, in the receiver's own coordinate system. *)

	^0 @ 0 extent: extent
)
installInformationRetriever: spy <InformationRetriever> on: child = (
	child == content ifFalse: [error: 'invalid child to spy on'].
	contentS:: spy downwardInterceptor
)
isEmpty = (
	^content isBlank
)
public isSquishy = (
	^content area isVisualSquishy
)
public legalAreaClassesFor: child = (
	^child legalAreaClassesInWrapper
)
public naturalHeightForWidth: size = (
	cachedNaturalHeightWidth ~= size
		ifTrue:
			[cachedNaturalHeightWidth:: size.
			cachedNaturalHeightForWidth::
				content area suggestedParentHeightForWidth: size].
	^cachedNaturalHeightForWidth
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	(* An unsolicited layout update: see superclass methods for a detailed discussion. In this class, the layout of the children can only change if the extent changes, therefore we only update the children if that is the case. *)

	| oldBounds |
	oldBounds:: bounds.
	super occupyBoundsResponse: newBounds.
	oldBounds = newBounds
		ifTrue: [content reiterateBounds]
		ifFalse: [adviseBoundsFor: content]
)
public setupAreaIn: child <Visual> = (
	child setupAreaForWrapper
)
public updateGeometricProperties = (
	cachedNaturalHeightWidth:: nil.
	super updateGeometricProperties
)
updateSolidChildLayout: child <Visual> using: continuation <Block> = (
	| oldNaturalExtent |
	cachedNaturalHeightWidth:: nil.
	oldNaturalExtent:: naturalExtent.
	updateGeometricProperties.
	naturalExtent = oldNaturalExtent
		ifTrue:
			[continuation value: (child area boundsWithin: localBounds)]
		ifFalse:
			[requestBoundsUpdateUsing:
				[:newBounds |
				setBounds: newBounds.
				continuation value: (child area boundsWithin: localBounds)].
			announceNaturalExtentChange]
)
updateSquishyChildLayout: child <Visual> using: continuation <Block> = (
	| oldNaturalExtent myExtent newCompositionHeight |
	cachedNaturalHeightWidth:: nil.
	oldNaturalExtent:: naturalExtent.
	updateGeometricProperties.
	requestBoundsUpdateUsing:
		[:newBounds |
		newBounds = bounds ifFalse: [setBounds: newBounds].
		continuation value: (child area boundsWithin: localBounds).
		naturalExtent ~= oldNaturalExtent
			ifTrue:
				[announceNaturalExtentChange]]
)
) : (
public with: aVisual <Visual> = (
	^self new
		content: aVisual;
		yourself
)
with: aVisual <Visual> in: areaClass <Class> = (
	aVisual areaClass: areaClass.
	^self with: aVisual
)
)
) : (
)
class ManipulationClasses = (
(* The former category Brazil-Manipulation *)
) (
public class AdHocMessageReceiver = (
(* This class is provided as a stopgap solution until we have real object literals we can use to respond to things such double-dispatched dragged data identification.
*)
|
	understoodSelectors ::= Map new.
	dispatchAlternative
	|) (
doesNotUnderstand: message <Message> = (
	| handler |
	handler:: understoodSelectors
		at: message selector
		ifAbsent:
			[^dispatchAlternative
				ifNotNil: [:it |
					dispatchAlternative:: nil.
					it value]
				ifNil: [super doesNotUnderstand: message]].
	^handler valueWithArguments: message arguments
)
public receive: selector <Symbol> using: block <Block | ArbitraryArityBlockWrapper> = (
	((block class == ArbitraryArityBlockWrapper) or:
		[selector numArgs = block numArgs])
			ifFalse:
				[^Error new signal: 'selector and block arity mismatch'].
	understoodSelectors at: selector put: block
)
public try: dispatchBlock or: alternativeBlock = (
	dispatchAlternative:: alternativeBlock.
	^dispatchBlock ensure: [dispatchAlternative:: nil]
)
) : (
)
public class ArbitraryArityBlockWrapper = (
(* This helper class wraps a one-argument block to provide the behavior similar to &rest arguments of Lisp. Invoking the wrapper using the standard value protocol with any number of arguments invokes the wrapped block with all the arguments passed as an array.
*)
|
	public block
	|) (
public value = (
	^block value: {}
)
public value: arg1 = (
	^block value: {arg1}
)
public value: arg1 value: arg2 = (
	^block value: {arg1. arg2}
)
public value: arg1 value: arg2 value: arg3 = (
	^block value: {arg1. arg2. arg3}
)
public value: arg1 value: arg2 value: arg3 value: arg4 = (
	^block value: {arg1. arg2. arg3. arg4}
)
public valueWithArguments: arguments <Array> = (
	^block value: arguments
)
) : (
public block: b = (
	(* cannot use block: in factory because it conflicts with the slot *)
	^new block: b; yourself
)
)
class AssociationDragSource = DragSource (
(* This DragSource carries around the data being dragged as an Association. The key presumably identifies the data being dragged, and the value is the data itself.
*)
|
	association ::= nil -> nil.
	|) (
draggedKey = (
	^association key
)
draggedKey: newKey = (
	association key: newKey
)
draggedValue = (
	^association value
)
draggedValue: newValue = (
	association value: newValue
)
public identifyPayloadTo: identificationReceiver = (
	^identificationReceiver
		try: [identificationReceiver draggingAssociation: association]
		or: [super identifyPayloadTo: identificationReceiver]
)
) : (
)
class DragDropDispatcher = (
(* A DragDropDispatcher holds onto a collection of DropTargets inside a Brazil Window. When installed as the dragDropDispatcher of the window, it looks for the target whose visual currently contains the mousePoint and returns it as the target for the drag/drop at that location). *)
|
	targetsX ::= List new.
	|) (
add: target <DragTargetNegotiator> = (
	^targetsX add: target
)
public findTargetForDragAt: windowRelativePoint <Point> forSession: session <DragSropSession> ^<DragTargetNegotiator | nil> = (
	^targetsX
		detect:
			[:each |
			each visual windowRelativeBounds containsPoint: windowRelativePoint]
		ifNone:
			[nil]
)
includes: target <DropTarget> = (
	^targetsX includes: target
)
remove: target <DropTarget> = (
	^targetsX remove: target
)
) : (
)
class DragDropSession forTracker: client <DragDropTracker> = (
(* Created by a tracker when a drag operation begins. *)
|
	tracker ::= client.
	public source
	targetRegistry ::= IdentityMap new.
	|) (
public cleanup = (
	(* Sent by the tracker when the drag session ends. *)
	targetRegistry do: [:each | each cleanup]
)
targetAt: key <Object> ifAbsentPut: absentBlock <[]> = (
	^targetRegistry at: key ifPresent: [:e|] ifAbsentPut: absentBlock
)
) : (
)
public class DragDropTracker = (
(* A DragTracker can be attached to a visual that supports mouse sensing (i.e. mouseDownAction and the like) in order to make it a drag source. Whenever a drag gesture is initiated from the visual, the responder creates a source negotiator and feeds all mouse events to it so that the negotiator can take care of handing the drag/drop process.

Slots:

	visual <Visual> The visual the responder is listening to; must support mouse actions (mouseDownAction, mouseMovedAction, mouseUpAction).

	sourceCreationBlock <Block> The block evaluated to create a DragSource when a drag-and-drop operation begins. The client attaching a responder to a visual will typically want to set one up. The default block creates a generic DragSource instance.

	dragOrigin <Point | nil> When the mouse button is pressed over the responder's visual, the mouse point where it happened is saved in this slot in order to later detect it moving outside the drag threshold.

	currentSession <DragDropSession | nil> When a drag-and-drop operation tracked by this instance is in progress, this slot holds the session that represents the operation.

	currentTarget <DropTarget | nil> When a drag-and-drop operation is in progress and the mouse is over a drop target, this slot points to the target. *)
|
	public visual
	public sourceCreationBlock ::= [DragSource new].
	public dragOrigin
	public currentSession
	public currentTarget
	|) (
public attachTo: aVisual = (
	visual:: aVisual.
	visual
		mouseDownAction: [respondToMouseDown];
		mouseMovedAction: [respondToMouseMove];
		mouseUpAction: [respondToMouseUp]
)
clearDraggedImage = (
	visual desktop clearDraggedImage
)
continueDragging = (
	(* The mouse has been moved another step. Check for possible target changes and let the current target know about the step. *)
	updateDraggedImage.
	establishTarget.
	deliverDragStepNotification
)
createSession = (
	| source |
	source:: sourceCreationBlock value.
	source visual: visual.
	currentSession:: DragDropSession forTracker: self.
	currentSession source: source
)
deliverDragStepNotification = (
	currentTarget
		ifNotNil: [:it | it dragStepFrom: dragSource]
		ifNil: [dragSource dragStepOverWasteland]
)
public desktop ^<Desktop> = (
	^visual desktop
)
dragSource = (
	^currentSession source
)
dragThreshold ^<Integer> = (
	(* How many pixels along one of the axes the mouse should move after the button has been pressed before we pay attention to it. *)
	^5
)
establishTarget = (
	(* Make sure currentTarget holds the target that corresponds to the current mouse position, sending the required notifications as targets are changed. *)

	| newTarget |
	newTarget:: findTargetAtMousePoint.
	newTarget = currentTarget ifTrue: [^self].
	currentTarget ifNotNil: [:it | it dragExitFrom: dragSource].
	currentTarget:: newTarget.
	currentTarget ifNotNil: [:it | it dragEnterFrom: dragSource].
)
findTargetAtMousePoint ^<DropTarget | nil> = (
	| where window |
	where:: desktop mousePoint.
	window:: desktop windowAtPoint: where.
	^window ifNotNil:
		[window findTargetForDragAt: where forSession: currentSession]
)
public isDragging = (
	^currentSession notNil
)
isOutsideDragThreshold: aPoint <Point> ^<Boolean> = (
	| delta |
	delta:: aPoint - dragOrigin.
	^delta x abs > dragThreshold or: [delta y abs > dragThreshold]
)
public respondToMouseDown = (
	dragOrigin:: visual mousePoint.
	visual grabMouse.
)
public respondToMouseMove = (
	dragOrigin notNil ifTrue:
		[isDragging
			ifFalse:
				[(isOutsideDragThreshold: visual mousePoint) ifTrue:
					[startDragging]]
			ifTrue:
				[continueDragging]]
)
public respondToMouseUp = (
	dragOrigin isNil ifFalse:
		[visual releaseMouse.
		isDragging ifTrue: [stopDragging]].
	dragOrigin:: nil.
)
setDraggedImage = (
	dragSource draggedImage ifNotNil:
		[:it |
		visual desktop setDraggedImage: it]
)
startDragging = (
	(* The mouse has been moved outside the drag threshold and the drag-and-drop operation really begins now. Set up the source. *)
	createSession.
	setDraggedImage.
	establishTarget.
	deliverDragStepNotification
)
stopDragging = (
	(* The mouse button has been released. *)
	establishTarget.
	clearDraggedImage.
	currentTarget
		ifNotNil: [:it | it dragDropFrom: dragSource]
		ifNil: [dragSource dragDropOverWasteland].
	currentTarget:: nil.
	currentSession cleanup.
	currentSession:: nil.
)
updateDraggedImage = (
	visual desktop updateDraggedImagePosition.
)
) : (
)
public class DragSource = (
(* A DragSource (or a subclass) is created by client code on a DragTracker's request when a drag-and-drop operation begins. It represents the source of the operation, including the object(s) being dragged. This top-level superclass is not abstract in the strict sense of the word, but still not particularly useful by itself as it cannot have any dragged data associated with it. That is a responsibility of a subclass. This class can, however, hold onto an image to represent the dragged thing. *)
|
	visualX
	public wastelandTarget
	public draggedImage
	|) (
public dragDropOverWasteland = (
	(* The dragged things were dropped over a point not occupied by any civilized windows. *)
	wastelandTarget ifNotNil:
		[:it | it dropFrom: self]
)
public dragStepOverWasteland = (
	(* The mouse has been moved over an area not occupied by any civilized windows. *)
	wastelandTarget ifNotNil:
		[:it | it dragStepFrom: self]
)
public identifyPayloadTo: identificationReceiver = (
	(* This is the heart of the mechanism that allows drag targets to determine what is being dragged. A subclass should reimplement this method following the same pattern, but sending the subclass-specific dragging...: message in the try: clause, and delegating to the superclass in the or: clause. *)
	^identificationReceiver
		try: [identificationReceiver draggingGenericData: self]
		or: []
)
public visual = (
	^visualX
)
public visual: sourceVisual = (
	visualX:: sourceVisual.
)
) : (
)
public class DropTarget = (
(* Represents a potential drop target associated with a visual. *)
|
	isActive ::= false.
	visual
	entryAction
	exitAction
	stepAction
	public dropAction
	|) (
cleanup = (
	(* Received when the drag session this target participated in ends, if the target has been registered with the session. *)
)
public dragDropFrom: source <DragSourceNegotiator> = (
	isActive ifTrue: [isActive:: false].
	dropAction ifNotNil: [:it | it value: source]
)
public dragEnterFrom: source <DragSourceNegotiator> = (
	isActive:: true.
	entryAction ifNotNil: [:it | it value: source]
)
public dragExitFrom: source <DragSourceNegotiator> = (
	isActive:: true.
	exitAction ifNotNil: [:it | it value: source]
)
public dragStepFrom: source <DragSourceNegotiator> = (
	(* Process a yet another mouse move event. Answer true to indicate that we want to process further events, or false to indicate that we lost interest. *)
	stepAction ifNotNil: [:it | it value: source]
)
) : (
)
) : (
)
class MappingClasses = (
(* The former category Brazil-Mapping *)
) (
public class AbstractAgentFactory = () (
public createAgentForActiveIcon: visual <ActiveIcon> = (
	subclassResponsibility
)
public createAgentForBlank: visual <TextView> = (
	subclassResponsibility
)
public createAgentForCompositeVisual: visual <CompositeVisual> = (
	self subclassResponsibility
)
public createAgentForDesktop: aDesktop <Desktop> = (
	subclassResponsibility
)
public createAgentForEllipseShape: shape <EllipseShape> = (
	self subclassResponsibility
)
public createAgentForHyperlink: visual <Hyperlink> = (
	subclassResponsibility
)
public createAgentForIcon: visual <Icon> = (
	subclassResponsibility
)
public createAgentForLabel: visual <Label> = (
	subclassResponsibility
)
public createAgentForLineShape: shape <LineShape> = (
	self subclassResponsibility
)
public createAgentForListBox: visual <ListBox> = (
	subclassResponsibility
)
public createAgentForMenu: menu <Menu> = (
	subclassResponsibility
)
public createAgentForPolygonShape: visual <PolygonShape> = (
	subclassResponsibility
)
public createAgentForPushButton: button <PushButton> = (
	self subclassResponsibility
)
public createAgentForRectangleShape: shape <RectangleShape> = (
	self subclassResponsibility
)
public createAgentForTextDisplay: visual <TextDisplay> = (
	subclassResponsibility
)
public createAgentForTextView: visual <TextView> = (
	subclassResponsibility
)
public createAgentForViewport: visual <CompositeVisual> = (
	subclassResponsibility
)
public createAgentForVisualSequence: visual <VisualSequence> = (
	self subclassResponsibility
)
public createAgentForWindow: window <Window> = (
	self subclassResponsibility
)
public createAgentForWrapper: wrapper <Wrapper> = (
	subclassResponsibility
)
) : (
)
class AttributeMapping attribute: anAttribute <MappableHolder> block: aBlock <[:Object]> = (
(* This private class is used by Agents to keep track of MappableHolders (or Attributes) that have been supplied with blocks to run in order to notify the agent of the holder value change. An agent stores a list of mappings it creates in order to unmap them when the agent is unmapped. *)
|
	attribute ::= anAttribute.
	updateBlock ::= aBlock.
	|attribute mapTo: updateBlock) (
public unmap = (
	(* When the owner agent is being unmapped, this message is sent to all the attribute mappings it has established in order to stop the holders/attributes from sending change updates to the agent. *)

	attribute unmap
)
public update = (
	(* Force evaluation of the update block with the attribute's current value. *)

	updateBlock value: attribute value
)
) : (
)
public class BrazilMappingAgent forVisual: aVisual = (|
	visualX
	attributeMappings
	public fullyMapped
	|fullyMapped:: false.
	attributeMappings:: List new.
	attachToVisual: aVisual) (
attachToVisual: aVisual <Visual> = (
	visualX:: aVisual.
	visual agent: self.
	map: visual boundsH to:
		[:newBounds |
		visual areUpdatesLocked ifFalse: [matchVisualsBounds]].
)
public childrenDo: aBlock <[:BrazilMappingAgent]> = (
	(* The visual's childrenDo: lifted into the agent world. *)

	visual childrenDo:
		[:each |
		each agent ifNotNil:
			[:it | aBlock value: it]]
)
childrenReverseDo: aBlock <[:BrazilMappingAgent]> = (
	(* The visual's childrenDo: lifted into the agent world. *)

	visual childrenReverseDo:
		[:each |
		each agent ifNotNil:
			[:it | aBlock value: it]]
)
public connectArtifactsOfChild: childAgent <BrazilMappingAgent> = (
(* This message is sent after a child of this agent's visual has finished creating its artifacts. This is the chance for the agent to recreate the parent-child structure of the visuals in its own artifacts. At this point in the mapping process, the agents and artifacts of both the receiver and the child are already in place. *)
)
public connectOwnArtifacts = (
	(* Establish the update relationship between the properties of the visual and the artifacts. The artifacts exists by the time this message is sent. *)
)
public createArtifactsForSubtree = (
	(* Sent by the parent in the process of mapping as a command to create the OS artifacts representing the visual. This cascading down is Initiated by the subtree root visual sending this to its agent. *)
	createOwnArtifacts.
	connectOwnArtifacts.
	matchAttributes.
	childrenDo:
		[:each |
		each createArtifactsForSubtree].
	visual area flushLayoutCaches.
	visual updateGeometricProperties.
	isNull ifFalse: [parent connectArtifactsOfChild: self]
)
createOwnArtifacts = (
	(* Create the host platoform artifacts such as native widgets or a Morph to represent the receiver's visual. At the moment this message is received none of the children are mapped yet. The receiver should only create its own artifacts. Recursion into the children is taken care of elsewhere. When the visual no longer needs to be represented, the artifacts are destroyed by #destroyOwnArtifacts. *)

	subclassResponsibility
)
public deactivate = (
	(* Disconnect any dependencies on the visual's attributes and consider self unmapped. Do not touch any native artifacts. This is the message that should be sent to stale (left over from the previous image session) instead of #destroy. *)
	attributeMappings do: [:each | each unmap].
	attributeMappings:: List new.
	fullyMapped: false
)
public destroy = (
	(* In preparation to unmapping, destroy any dependencies on the visual's attributes and native artifacts. Note that in the case of native mappings, this message must only be sent to an agent created in the same image session. Otherwise the artifacts it thinks it has are no longer there and an attempt to destroy them may have bad consequences. See #deactivate. *)
	deactivate.
	destroyOwnArtifacts.
)
public destroyOwnArtifacts = (
	(* Destroy the host artifacts previously created by #createOwnArtifacts, if any. *)
)
ensureUpToDateAppearance = (
	subclassResponsibility
)
public finishedMapping = (
	(* Right after the top level of a visual subtree is mapped, this message is sent by the parent object to the newly mapped top agent and is then recursively invoked to traverse the whole agent hierarchy. At the time it is received the whole mapping sub-hierarchy is complete. This gives any particular agent a chance to do the actions that require the whole hierarchy to be in place. *)

	fullyMapped:: true
)
public flushLayoutCaches = ()
inspectorIconOfSize: aNumberOrPoint = (
	(* Answer an appropiate form to represent the receiver. *)

	^nil
)
isNull = (
	^false
)
map: attribute <Attribute> to: block <Block> = (
	^attributeMappings add: (AttributeMapping attribute: attribute block: block)
)
matchAttributes = (
	attributeMappings do: [:each | each update]
)
matchVisualsBounds = (
	(* Sent by the visual after its effective bounds have been changed, after the new bounds are in place and before the 'changed' notification is broadcast. *)

	subclassResponsibility
)
noteBeginningOfBoundsChangeAndProvideEndContinuation ^<[] | nil> = (
	(* Sent by the visual just before it changes its bounds. This method must return a continuation block that will get invoked after the bounds change of the visual (and all of its descendents) is complete. Nil is also a valid answer. *)

	^nil
)
public noticeChangeInChildAgentStructure = (
	(* This message is received after a child or the receiver's visual--direct or indirect--has been mapped or unmapped and therefore the tree of agents under the receiver has changed. *)
	parent ifNotNil: [:it | it noticeChangeInChildAgentStructure]
)
public noticeChangeInNaturalExtent = (
	(* Sent by the visual after it has been detected that the visual's natural extent has changed. *)
)
public parent ^<BrazilMappingAgent | nil> = (
	^visual parent ifNotNil: [:it | it agent]
)
platform ^<Symbol> = (
	(* Return a Symbol identifying the platform this agent maps to. As of this writing, the options are #morphic and #win32. *)
	subclassResponsibility
)
public visual = (
	^visualX
)
) : (
public visual: aVisual = (
	^self new forVisual: aVisual
)
)
) : (
)
class MenuClasses = (
(* The former category Brazil-Menu *)
) (
public class Menu forVisual: v = (|
	public ownerVisual ::= v.
	items ::= List new.
	public agent
|) (
public add: newItem <MenuItem> = (
	items add: newItem.
	newItem menu: self
)
public add: newItem <MenuItem> after: existingItem <MenuItem> = (
	items add: newItem after: existingItem.
	newItem menu: self
)
add: newItem <MenuItem> afterKey: key <Symbol> = (
	| item |
	item:: self at: key ifAbsent: [nil].
	item isNil
		ifTrue: [add: newItem]
		ifFalse: [add: newItem after: item]
)
add: newItem <MenuItem> before: existingItem <MenuItem> = (
	items add: newItem before: existingItem.
	newItem menu: self
)
add: newItem <MenuItem> beforeKey: key <Symbol> = (
	| item |
	item:: self at: key ifAbsent: [nil].
	item isNil
		ifTrue: [addFirst: newItem]
		ifFalse: [add: newItem before: item]
)
addFirst: newItem <MenuItem> = (
	items addFirst: newItem.
	newItem menu: self
)
at: key <Symbol> = (
	^items detect: [:some | some key = key]
)
at: key <Symbol> ifAbsent: failureBlock <Block> = (
	^items
		detect: [:some | some key = key]
		ifNone: failureBlock
)
createAgentUsing: aMapping <BrazilMapping> = (
	agent:: aMapping createAgentForMenu: self
)
detect: aBlock = (
	^items detect: aBlock
)
detect: aBlock ifNone: failureBlock = (
	^items detect: aBlock ifNone: failureBlock
)
public dispatchTo: client = (
	(* Sent by an object that wants to visit items of the menu. The object should be prepared to receive messages sent by #dispatchTo: methods of the items. *)

	items do: [:each | each dispatchTo: client]
)
includes: anItem <MenuItem> = (
	^items includes: anItem
)
includesKey: key <Symbol> = (
	detect: [:some | some key = key] ifNone: [^false].
	^true
)
isMapped ^<Boolean> = (
	^agent notNil
)
mapUsing: aMapping <BrazilMapping> = (
	agent:: aMapping createAgentForMenu: self
)
public openIn: desktop <Desktop> = (
	self openIn: desktop at: desktop mousePoint
)
openIn: desktop <Desktop> above: window <Window> = (
	self openIn: desktop at: desktop mousePoint above: window
)
public openIn: desktop <Desktop> at: globalTopLeft <Point> = (
	isMapped ifFalse: [mapUsing: desktop mapping].
	agent openAt: globalTopLeft
)
openIn: desktop <Desktop> at: globalTopLeft <Point> above: window <Window> = (
	isMapped ifFalse: [mapUsing: desktop mapping].
	agent openAt: globalTopLeft above: window
)
remove: anItem <MenuItem> = (
	^items remove: anItem
)
remove: anItem <MenuItem> ifAbsent: failureBlock <Block> = (
	^items remove: anItem ifAbsent: failureBlock
)
respondToItemChange: anItem = (
	agent ifNotNil:
		[agent respondToMenuChange]
)
submenuItemsDo: aBlock = (
	items do:
		[:each |
		each isSubmenuItem ifTrue:
			[aBlock value: each]]
)
) : (
public new = (
	^forVisual: nil
)
)
public class MenuItem key: aSymbol <Symbol> label: aString <String> action: aBlock <Block> = (|
	public menu
	iconS
	public key ::= aSymbol.
	labelS ::= aString.
	actionS ::= aBlock.
	public enabled ::= true.
	public visible ::= true.
|) (
public action = (
	^actionS
)
public dispatchTo: client = (
	client visitMenuItem: self
)
public icon ^<Form | nil> = (
	^iconS
)
public icon: newIcon <Form | nil> = (
	iconS:: newIcon.
	informMenuOfChange
)
informMenuOfChange = (
	menu ifNotNil:
		[menu respondToItemChange: self]
)
public isSubmenuItem = (
	^false
)
public label ^<String> = (
	^labelS
)
public label: newLabel <String> = (
	labelS:: newLabel.
	informMenuOfChange
)
) : (
public label: aString action: aBlock = (
	^key: nil label: aString action: aBlock
)
)
public class SeparatorItem = (|
	public menu
	public key
|) (
public dispatchTo: client = (
	client visitSeparatorItem: self
)
public isSubmenuItem = (
	^false
)
) : (
)
public class SubmenuItem key: aSymbol label: aString action: aBlock = MenuItem key: aSymbol label: aString action: aBlock (|
	public submenu
|) (
public dispatchTo: client = (
	client visitSubmenuItem: self
)
public isSubmenuItem = (
	^true
)
) : (
public label: aString submenu: sm = (
	^(self key: nil label: aString action: []) submenu: sm
)
)
) : (
)
class PlumbingClasses = (
(* The former category Brazil-Plumbing *)
) (
public class Attribute name: n value: v = MappableHolder with: v (
(* An Attribute is a holder of a public attribute of a Visual. While this capability isn't used yet, reifying attributes allows for self-describing UIs which allow a tree of Visuals to be ''distilled'' back into a specification form.

Slots:
	name <Symbol> -- The name of the attribute, by convention the same as the getter selector implemented by the attribute's visual that returns the attribute's value.
	defaultValue <Object> -- The default value of the attribute, i.e. the value in a freshly created UI. Useful at the ''distilling'' stage.*)
| name ::= n. defaultValue |) (
isValueTheDefault = (
	^value = defaultValue
)
makeCurrentValueDefault = (
	defaultValue: value
)
) : (
public name: n = (
	^name: n value: nil
)
)
public class Font size: n = (
(* This class is an API stub for a future more developed font access capability. At some point in the future one would be able to instantiate a Font, set attributes such as style and point size and then assign the font to a text display widget such as a Label. For now, while we are in Morphic, instances of the class can only be created using class messages such as #normal or #large, and cannot be configured further. Those instances will be map to some standard Morphic fonts by MorphicFontMapper.

In the current implementation, sizeX is the size code used by MorphicFontMapper as an index of the array of font mappings. Any changes of the range of possible values will need to be matched in MorphicFontMapper. *)
|
	public (* BOGUS *) sizeX ::= n. |) (
) : (
public huge = (
	^size: 5
)
public large = (
	^size: 4
)
public normal = (
	^size: 3
)
public small = (
	^size: 2
)
public tiny = (
	^size: 1
)
)
public class Gradient from: startColorA to: endColorA = (
(* Gradient implements support for gradient fills of visuals that are tied to the bounds of visuals. Unlike the stock GradientFill of Morphic which operates in global coordinates and needs reconfiguring before each fill operation, a GradientColor applied to a visual will cause the visual to be painted ''properly'' (for example with the start color at the top and the bottom color at the bottom, regardless of the current position and size of the visual) without further intervention.

A Gradient keeps track of its start and end locations within a visual as two pairs of fractions and offsets. The fractions and offsets are used with the visuals's bounds to compute the effective start and end locations tied to the current position of the visual. By default a Gradient is configured to be a vertical gradient beginning at the top of the visual and ending at the bottom. *)
|
	public startColor ::= startColorA.
	public startFractionX ::= 0.
	public startFractionY ::= 0.
	public startOffsetX ::= 0.
	public startOffsetY ::= 0.
	public endColor ::= endColorA.
	public endFractionX ::= 0.
	public endOffsetX ::= 0.
	public endFractionY ::= 1.
	public endOffsetY ::= 0.
	|) (
public asColor = (
	^startColor
)
public asFillStyleWithin: bounds <Rectangle> = (
	(* Produce a stock Morphic GradientFillStyle appropriate for a visual with the given bounds. *)

	| start end |
	start:: startPointWithin: bounds.
	end:: endPointWithin: bounds.
	^(GradientFillStyle ramp: {0 -> startColor. 1-> endColor})
		radial: false;
		origin: start;
		direction: end - start
)
beHorizontalFrom: color1 <Color> to: color2 <Color> = (
	startColor:: color1.
	startFractionX: 0.
	startFractionY: 0.
	startOffsetX: 0.
	startOffsetY: 0.
	endColor: color2.
	endFractionX: 1.
	endOffsetX: 0.
	endFractionY: 0.
	endOffsetY: 0
)
beVerticalFrom: color1 <Color> to: color2 <Color> = (
	startColor:: color1.
	startFractionX: 0.
	startFractionY: 0.
	startOffsetX: 0.
	startOffsetY: 0.
	endColor: color2.
	endFractionX: 0.
	endOffsetX: 0.
	endFractionY: 1.
	endOffsetY: 0
)
endPointWithin: bounds <Rectangle> = (
	| x y |
	x:: bounds width * endFractionX + endOffsetX + bounds left.
	y:: bounds height * endFractionY + endOffsetY + bounds top.
	^x rounded @ y rounded
)
hasTranslucentColor = (
	^startColor isTranslucentColor or: [endColor isTranslucentColor]
)
public isGradient = (
	^true
)
startPointWithin: bounds <Rectangle> = (
	| x y |
	x:: bounds width * startFractionX + startOffsetX + bounds left.
	y:: bounds height * startFractionY + startOffsetY + bounds top.
	^x rounded @ y rounded
)
) : (
public new = (
	^from: Color white to: Color black.
)
)
public class HierarchicalReporter on: stm = (|
	stream ::= stm.
	currentIndent ::= 0.
	|) (
public contents = (
	^stream contents
)
public cr = (
	stream cr.
	printIndent.
)
public decreaseIndent = (
	currentIndent: currentIndent - indentStep
)
public flush = (
	stream flush
)
public increaseIndent = (
	currentIndent: currentIndent + indentStep
)
public indentStep = (
	^1
)
public nextPut: aCharacter = (
	stream nextPutAll: aCharacter
)
public nextPutAll: aString = (
	stream nextPutAll: aString
)
public print: anObject = (
	stream print: anObject
)
public printIndent = (
	stream next: currentIndent put: Character tab
)
public space = (
	stream space
)
) : (
public new = (
	^on: (CharacterReadWriteStream on: String new).
)
)
public class InformationRetriever parent: parent <Visual> child: child <Visual> = (|
	upwardInterceptor
	downwardInterceptor
	|upwardInterceptor::
		InformationRetrieverUpwardInterceptor new
			xyzzyOwner: self;
			xyzzyParent: parent.
	downwardInterceptor::
		InformationRetrieverDownwardInterceptor new
			xyzzyOwner: self;
			xyzzyChild: child) (
report: message <String> = (
	Transcript
		cr;
		nextPutAll: message;
		flush
)
report: message <String> with: arg <Object> = (
	Transcript
		cr;
		nextPutAll: message;
		nextPutAll: ': ';
		print: arg;
		flush
)
) : (
)
class InformationRetrieverDownwardInterceptor = (|
	xyzzzyOnwer
	xyzzyChild
	|) (
doesNotUnderstand: aMessage <Message> = (
	^aMessage sendTo: xyzzyChild
)
) : (
)
class InformationRetrieverUpwardInterceptor = (|
	xyzzyOwner
	xyzzyParent
	|) (
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	xyzzyOwner report: '<< childRequestsBoundsUpdate'.
	^xyzzyParent child: child requestsBoundsUpdateUsing:
		[:newBounds |
		xyzzyOwner report: '>> childRequestsBoundsUpdate' with: newBounds.
		continuation value: newBounds]
)
doesNotUnderstand: aMessage <Message> = (
	^aMessage sendTo: xyzzyParent
)
) : (
)
public class MappableHolder with: obj = Holder with: obj (
(* A MappableHolder is a holder geared for shared use as both part of the Visual API, i.e. something that holds a value and notifies dependents in the application glue layer about its changes, and also as a communication channel between the Visual and its MappingAgent.

To support this, a MappableHolder holds onto a mappingUpdateBlock that is set or cleared by the agent when the visual is mapped or unmapped. Each time the value of the holder is changed, the block is invoked with the new value. This happens just after the new value is stored in the holder but before the 'changed' notification is broadcast. This guarantees that the mapping is up to date by the time any object relying on the 'changed' notification to observe the visual sees the change.

A mapping can feed a value back the holder, usually when the value is changed by the user through the UI interaction. The mapping should do so by sending the message #acceptValueFromMapping: and NOT using the usual #value: protocol. That message does not invoke the mappingUpdateBlock, thus avoiding recursion if feedback occurs as part of the process of updating a mapping in the first place.

Slots:

mappingUpdateBlock <Block>
updateInProgress <Boolean> Usually false, set to true while mappingUpdateBlock runs. *)
|
	updateInProgress ::= false.
	mappingUpdateBlock ::= [:newValue | ].
	|) (
public acceptValueFromMapping: anObject = (
	(* Sent by the mapping agent to notify of the change of the mapped value on the agent side. If the mapping is in the process of being updated, we do not trigger any notifications as they have been/will be triggered by the update logic. *)

	updateInProgress ifFalse:
		[changingS ifNotNil: [changingS send: anObject]].
	valueS:: anObject.
	updateInProgress ifFalse:
		[changedS ifNotNil: [changedS send: anObject]]
)
public mapTo: aBlock = (
	mappingUpdateBlock:: aBlock
)
public unmap = (
	mappingUpdateBlock: [:newValue | ]
)
updateMapping = (
	| oldState |
	oldState:: updateInProgress.
	updateInProgress: true.
	^[mappingUpdateBlock value: valueS]
		ensure: [updateInProgress: oldState]
)
public value: anObject = (
	changingS ifNotNil: [changingS send: anObject].
	valueS:: anObject.
	updateMapping.
	changedS ifNotNil: [changedS send: anObject]
)
value: anObject beforeChanged: aBlock = (
	changingS ifNotNil: [changingS send: anObject].
	valueS:: anObject.
	updateMapping.
	aBlock value: anObject.
	changedS ifNotNil: [changedS send: anObject]
)
) : (
public new = (
	^with: nil
)
)
public class MessageRecorder = (
(* This class implement #doesNotUnderstand: to record the messages sent to it. On request, it can replay the messages to a different object.

Instance Variables
	recordedMessages:		<List of: Message> - Messages recorded in order of arrival. *)
|
	recordedMessages ::= List new.
	|) (
doesNotUnderstand: aMessage = (
	recordedMessages add: aMessage
)
public playRecordedMessagesTo: anObject = (
	recordedMessages do: [:each | each sendTo: anObject]
)
) : (
)
public class ModifierKeyState = (
(* Captures the state of the modifier keys at some point in time, so that the state of modifiers can be captured and examined later even if the keys change their state by that time. *)
|
	public shiftPressed ::= false.
	public controlPressed ::= false.
	public altPressed ::= false.
	|) (
optionPressed = (
	^altPressed
)
) : (
)
) : (
)
class TextClasses = (
(* This module contains the framework for defining and working with marked-up (stylized) text, to end Brazil's dependence on the Text class from Smalltalk. *)
) (
class MarkedUpString contents: theContents <String> markups: theMarkups <Collection[Markup]> = (
(* This class defines String-like behavior, however the instance also keeps track of Markups associated with itself. The receiver is intended to be used as an immutable string, with the contents and the markups specified at instance creation time and never changed afterwards. *)
|
	private string = theContents.
	public markups = theMarkups.
|) (
asString ^<String> = (
	(* Answer the plain string represented by the receiver. *)
	^string
)
at: index <Integer> ^<Character> = (
	(* Answer the character at the given index (1-based). *)
	^string at: index
)
markupChangesDo: block <[:Integer :Collection[Markup] :Collection[Markup]]> = (
	(* Evaluate the block for all indices where the set of markups applicable to characters changes. At each such index, the block is invoked with three arguments: 1) the index, 2) the markups added starting from this index, 3) the markups removed before this index. Note that removed markups are reported with the index of the character following the change (i.e. the first character to which the markup does not apply). For this reason the first argument can be 1 greater than the string size, if the markups removed extend to the end of the string. *)
	| map |
	map:: RangeMap markups: markups totalSize: string size.
	^map markupChangesDo: block
)
markupsAt: index <Integer> ^<Collection[Markup]> = (
	(* Answer a collection of Markups that apply to the character at the given index (1-based). *)
	^markups select: [:some | some includes: index]
)
markupsAt: index <Integer> do: block <[:Markup]> = (
	(* Evaluate 'block' for each markup that applies to the character at the given index, passing the markup instance as the argument to the block. *)
	markups do:
		[:each |
		(each includes: index) ifTrue: [block value: each]]
)
rangesDo: block <[:Integer :Integer :Collection[Markup]]> = (
	(* Evaluate the block for all ranges of characters that share the same markup sets. The block is invoked with three arguments: 1) the starting position of the range (the index of the first character), 2) the number of characters in the range, 3) the list of markups in effect throughout the range. Note that if a markup of size 0 is applied to the string, it will be enumerated by this method as a range of size 0. However, unmarked ranges (ranges whose effective markup list is empty) are only reported if their size is greater than 0. *)
	| map |
	map:: RangeMap markups: markups totalSize: string size.
	^map rangesDo: block
)
size ^<Integer> = (
	^string size
)
) : (
contents: string <String> allMarkedAs: markupClass <Class> = (
	^contents: string
		markups: {markupClass from: 1 size: string size}
)
)
class Markup from: theFirstIndex <Integer> size: theSize <Integer> = (
(* This is the superclass of markups, defining the common behavior of keeping track of the character range the markup applies to. The range is usually specified as the index of the first character and the number of characters included in the range. This is the method preferred to using the first and last indices, to avoid ambiguities over whether the last index is included in the range or not. However, last index-based creation is supported as well. The class is not abstract, however it defines no useful behavior other than range tracking. *)
|
	public firstIndex = theFirstIndex.
	public size = theSize.
|) (
public = another = (
	^class = another class and:
		[firstIndex = another firstIndex and:
		[size = another size]]
)
contains: another <Markup> ^<Boolean> = (
(* Answer whether the argument is fully contained within the range defined by the receiver. Equal markups are considered to mutually contain each other. *)
	^(includes: another firstIndex) and:
		[includes: another lastIndex]
)
hash = (
	^firstIndex hash bitXor: size hash
)
includes: index <Integer> ^<Boolean> = (
(* Answer whether the receiver markup includes the given index, that is whether the markup applies to a character at that index. *)
	^index - firstIndex between: 0 and: size - 1
)
isEmpty ^<Boolean> = (
	(* Answer whether the receiver is a zero-size range that marks a position in the string but affects no characters. *)
	^size = 0
)
lastIndex ^<Integer> = (
(* Answer the index of the last character that belongs to the marked-up range. For zero-size ranges, it is the index of the character preceding the first character of the range. *)
	^firstIndex + size - 1
)
nextIndex ^<Integer> = (
(* Answer the index of the first character following (not included into) the marked-up range. *)
	^firstIndex + size
)
public printOn: aStream <Stream> = (
	aStream
		nextPutAll: '<';
		nextPutAll: self class name;
		nextPutAll: ' ';
		print: firstIndex;
		nextPutAll: '-';
		print: lastIndex;
		nextPutAll: '>'
)
) : (
from: startIndex <Integer> through: endIndexInclusive <Integer> = (
	^self from: startIndex size: endIndexInclusive - startIndex + 1
)
from: startIndex <Integer> to: endIndexExclusive <Integer> = (
	^self from: startIndex size: endIndexExclusive - startIndex
)
)
class RangeMap markups: theMarkups totalSize: theTotalSize <Integer> = (
(* Given a collection of markups, calculates the ranges such that the set of markups effective within each range is the same. The instances are supposed to be single-use: they compute the map as part of initialization, then only report the map (see #rangesDo:). If a map needs to be updated, create a new instance. *)
|
	private markups = theMarkups.
	private totalSize = theTotalSize.
	private markupChangeMap = List new.
|populateMarkupChangeMap) (
markupChangesDo: block <[:Integer :Collection[Markup] :Collection[Markup]]> = (
	(* Evaluate the block for all indices where the set of markups applicable to characters changes. At each such index, the block is invoked with three arguments: 1) the index, 2) the markups added starting from this index, 3) the markups removed before this index). Note that removed markups are reported with the index of the character following the change (i.e. the first one to which the markup does not apply). For this reason the first argument can be 1 greater than the string size, if a markup extends to the end of the string. *)
	markupChangeMap do:
		[:each | block valueWithArguments: each]
)
markupEnds = (
	^markups asSortedCollection:
		[:a :b | a nextIndex <= b nextIndex]
)
markupStarts = (
	^markups asSortedCollection:
		[:a :b | a firstIndex <= b firstIndex]
)
populateMarkupChangeMap = (
	| sentinel starts ends |
	markupChangeMap:: List new.
	sentinel:: Markup from: SmallInteger maxVal size: 0.
	starts:: SeqCltnReadStream on: (markupStarts copyWith: sentinel).
	ends:: SeqCltnReadStream on: (markupEnds copyWith: sentinel).
	1 to: totalSize + 1 do:
		[:index |
		(starts peek firstIndex = index or: [ends peek nextIndex = index]) ifTrue:
			[ | added removed |
			added:: List new.
			removed:: List new.
			[starts peek firstIndex = index] whileTrue:
				[added add: starts next].
			[ends peek nextIndex = index] whileTrue:
				[removed add: ends next].
			markupChangeMap add: {index. added asArray. removed asArray}]]
)
rangesDo: block <[:Integer :Integer :Collection[Markup]]> = (
	(* Evaluate the block for all ranges of characters with the same markup. The block is invoked with three arguments: 1) the starting position of the range (the index of the first character), 2) the number of characters in the range, 3) the list of markups in effect in the range. Note that if a markup of size 0 is applied to the string, it will be enumerated by this method as a range of size 0. However, unmarked ranges (ranges whose effective markup list is empty) are only reported if their size is greater than 0. *)
	| start effectiveMarkups |
	start:: 1.
	effectiveMarkups:: List new.
	markupChangesDo:
		[:index :added :removed |
		index = 1 ifFalse:
			[block value: start value: index - start value: effectiveMarkups asArray].
		start:: index.
		effectiveMarkups addAll: added.
		(added select: [:any | removed includes: any]) isEmpty not ifTrue:
			[block value: start value: 0 value: effectiveMarkups asArray].
		effectiveMarkups removeAll: removed].
	start <= totalSize ifTrue:
		[block value: start value: totalSize - start + 1 value: effectiveMarkups asArray]
)
) : (
)
) : (
)
class ToolClasses = (|
	private Button = widgets Button.
	private Menu = menus Menu.
	private MenuItem = menus MenuItem.
	private Desktop = containers Desktop.
	private Row = containers Row.
	private CellWidthEqualizer = areas CellWidthEqualizer.
	private Column = containers Column.
	private HorizontalViewport = containers HorizontalViewport.
	private TextView = widgets TextView.
	private Window = containers Window.
	private ListBox = widgets ListBox.
	private Label = widgets Label.
	private VerticalViewport = containers VerticalViewport.
	private Blank = widgets Blank.
	private TextDisplay = widgets TextDisplay.
|) (
class AbstractFileDialog new = Object (
(* NOTE: Should eventually remove the locationButton field and related stuff. *)
|
	okButtonLabel ::= defaultOKButtonLabel.
	showNewFolderButton ::= true.
	window locationButton locationField upButton viewport
	panels ::= List new.
	okButton cancelButton
	shouldClose ::= false.
	closedWithOK ::= false.
	|) (
addNewPanel: panel = (
	panels add: panel.
	viewport add: panel visual setup: [:it | it area width: panel desiredWidth].
	scrollViewportToEnd
)
afterOpen = (
retargetAt: initialDirectory
)
baseDirectory ^<FileDirectory> = (
	^panels first directory
)
baseDirectoryDelimitedPathName ^<String> = (
	(* In case of the 'ultimate root' on Windows, i.e. the directory of which the drives are the children, answer an undelimited blank. *)

	| base baseName |
	base:: baseDirectory.
	baseName:: base pathName.
	^baseName isEmpty
		ifTrue: ['']
		ifFalse: [baseName copyWith: base pathNameDelimiter]
)
baseDirectorySummaryString ^<String> = (
	| base delimiter parts |
	base:: baseDirectory.
	delimiter:: String with: base pathNameDelimiter.
	parts:: base pathParts.
	^parts size < 3
		ifTrue: [base pathName, delimiter]
		ifFalse: [parts first, '...', delimiter, parts last, delimiter]
)
buildButtons = (
	| buttons |
	buttons:: Row new.
	showNewFolderButton ifTrue:
		[buttons add: buildNewFolderButton].
	buttons addElasticBlank.
	okButton:: buttons addNew: Button setup:
		[:button |
		button
			label: okButtonLabel;
			action: [respondToOK]].
	buttons addBlankSize: 10.
	cancelButton:: buttons addNew: Button setup:
		[:button |
		button label: 'Cancel'; action: [respondToCancel]].
	CellWidthEqualizer equalizeRowElements:
		{okButton. cancelButton}.
	^buttons
)
buildCenterColumn = (
	| column |
	column:: Column new.
	column
		add: buildTopRow;
		addBlankSize: 5.
	viewport::
		column addNew: HorizontalViewport setup:
			[:it |
			it color: (Color gray: 0.9).
			it area elasticity: 1].
	column
		addBlankSize: 10;
		add: buildButtons setup: [:it | it area height: 26];
		addBlankSize: 5.
	^column
)
buildLocationButton = (
	locationButton:: Button new.
	locationButton action: [respondToLocationClick].
	^locationButton
)
buildLocationField = (
	locationField:: TextView new.
	locationField enterKeyResponse:
		[:defaultResponse |
		navigateToLocationInField].
	^locationField
)
buildLocationMenu = (
	| menu |
	menu:: Menu forVisual: window.
	directoriesFromHereToRootDo:
		[:each | | label |
		label:: each localName isEmpty
			ifTrue: [drivesPseudoDirectoryName]
			ifFalse: [each localName].
		menu add:
			(MenuItem
				label: label
				action: [retargetAt: each])].
	^menu
)
buildNewFolderButton = (
	| button |
	button:: Button new.
	button
		label: 'New Folder...';
		action: [respondToNewFolder].
	^button
)
buildTopRow = (
	| row |
	row:: Row new.
	row
		add: buildLocationField setup: [:field | field area elasticity: 1];
		addBlankSize: 5;
		add: buildUpButton.
	^row
)
buildUpButton = (
	upButton:: Button new label: 'Up'.
	upButton action: [respondToUpButtonClick].
	^upButton
)
buildWindow = (
	window:: Window new.
	window title: defaultWindowLabel.
)
createFilePanelFor: entry in: directory = (
	| panel |
	panel:: FilePickerFilePanel new
		fileEntry: entry;
		directory: directory.
	^panel
)
createPanelFor: directory <FileDirectory> ^<FilePickerPanel> = (
	| panel |
	panel:: FilePickerDirectoryPanel new directory: directory.
	setupNewDirectoryPanel: panel.
	^panel
)
defaultDirectory ^<FileDirectory> = (
	(* The directory to show initially if none is remembered. *)

	^FileDirectory default
)
defaultOKButtonLabel ^<String> = (
	^'OK'
)
defaultWindowLabel = (
	^'Select a File'
)
directoriesFromHereToRootDo: aBlock = (
	| here |
	here:: baseDirectory containingDirectory.
	[here localName isEmpty] whileFalse:
		[aBlock value: here.
		here:: here containingDirectory].
	(here isKindOf: DosFileDirectory) ifTrue:
		(* on DOS we include the 'root' (of which drives are the children) *)
		[aBlock value: here]
)
drivesPseudoDirectoryName ^<String> = (
	(* On Windows, the root of the directory tree of which drives are the children is labelled with this string. *)

	^'<Drives>'
)
hereDirectory = (
	^panels last directory
)
initialDirectory ^<FileDirectory> = (
	(* Answer the directory the dialog will show after opening. It is either the last visited directory or some kind of a default. *)

	| lastDirectoryPath lastDirectory |
	lastDirectoryPath:: lastVisitedDirectory.
	lastDirectoryPath isNil ifTrue: [^defaultDirectory].
	lastDirectory:: FileDirectory on: lastDirectoryPath.
	^lastDirectory exists
		ifTrue: [lastDirectory]
		ifFalse: [defaultDirectory]
)
lastDirectoryPanel = (
	panels reverseDo:
		[:each | each isDirectoryPanel ifTrue: [^each]].
	error: 'invalid state - no directory panels'
)
navigateToLocationInField = (
(* To the location in the field showing the root directory, that is. *)
| target |
target:: FileDirectory on: locationField text asString.
target exists
	ifFalse: [locationField flash]
	ifTrue: [retargetAt: target]
)
public open ^<Boolean> = (
	(* Open the dialog as a modal window. After closing, return true if the OK button was clicked or false if Cancel was. *)

	| windowSize |
	windowSize:: 700 @ 500.
	buildWindow.
	populateWindow.
	window
		bounds:
			(theDesktop bounds center - (windowSize // 2)
				extent: windowSize);
		openModalWhileFalse: [shouldClose]
			afterOpening: [afterOpen].
	^closedWithOK
)
populateWindow = (
	window content: Row new.
	window content
		addBlankSize: 5;
		add: buildCenterColumn setup: [:it | it area elasticity: 1];
		addBlankSize: 5
)
refreshLocationField = (
	locationField text: baseDirectoryDelimitedPathName
)
refreshUpButton = (
	| directoryName |
	directoryName:: baseDirectory localName.
	upButton enabled: directoryName isEmpty not
)
removePanelsAfter: panel = (
	| index |
	index:: panels indexOf: panel.
	(panels size to: index + 1 by: -1) do:
		[:indexToRemove | | toRemove |
		toRemove:: panels at: indexToRemove.
		viewport remove: toRemove visual.
		panels remove: toRemove].
)
respondToCancel = (
	closedWithOK:: false.
	shouldClose:: true
)
respondToDoubleClickIn: panel = (
	panel selection ifNotNil:
		[:item <DirectoryEntry> |
		item isDirectory ifTrue:
			[retargetAt: panel directory / item name]
		]
)
respondToLocationClick = (
	| menu |
	menu:: buildLocationMenu.
	menu openIn: window desktop above: window
)
respondToNewFolder = (
	| newName |
	newName:: Prompter new
		title: 'New Folder Name';
		open.
	newName isNil ifTrue: [^self].
	newName:: newName withBlanksTrimmed.
	newName isEmpty ifTrue: [^self].
	(hereDirectory fileOrDirectoryExists: newName) ifFalse:
		[hereDirectory createDirectory: newName].
	lastDirectoryPanel
		populateList;
		selectEntryNamed: newName
)
respondToOK = (
	lastVisitedDirectory: hereDirectory pathName.
	closedWithOK:: true.
	shouldClose:: true
)
respondToSelection: item <DirectoryEntry | nil> in: panel = (
	self removePanelsAfter: panel.
	item notNil ifTrue:
		[item isDirectory
			ifTrue:
				[ | newDirectory |
				newDirectory:: hereDirectory / item name.
				^addNewPanel: (createPanelFor: newDirectory)]
			ifFalse:
				[ | newFile |
				newFile:: hereDirectory directoryEntryFor: item name.
				^addNewPanel: (createFilePanelFor: newFile in: hereDirectory)]]
)
respondToUpButtonClick = (
	retargetAt: baseDirectory containingDirectory
)
retargetAt: directory <DirectoryEntry> = (
	(* Make the argument the initial directory of our directory lineup. All base directory changes including displaying the initial directory when the dialog first opens are funnelled into this method. *)

	| seed |
	panels do: [:each | viewport remove: each visual].
	seed:: createPanelFor: directory.
	panels:: List with: seed.
	viewport
		add: seed visual
		setup: [:it | it area width: 200].
	refreshLocationField.
	refreshUpButton
)
scrollViewportToEnd = (
	| lastPanelEnd targetPosition overshoot |
	overshoot:: 5.
	lastPanelEnd:: panels last visual bounds right.
	targetPosition:: lastPanelEnd - viewport innerExtent x + overshoot.
	(* Only send the scroll command if scrolling is needed, as Morphic cannot properly handle scrolling to position 0. *)
	targetPosition > viewport scrollPosition x ifTrue:
		[viewport scrollPosition: (targetPosition max: 0) @ 0]
)
selectedPath ^<String | nil> = (
	(* After the dialog has been opened and accepted, send this message to get the path name of the selected file or directory as a String, or nil if the dialog was cancelled. *)

	subclassResponsibility
)
setupNewDirectoryPanel: panel <FilePickerPanel> = (
	panel selectionChannel =>
		[:selection |
		respondToSelection: selection in: panel].
	panel doubleClickAction:
		[respondToDoubleClickIn: panel]
)
) : (
)
class BrazilDirectorySelector new = BrazilFileSelector (
(* A dialog box-like application that presents a list of subdirectories of a given directory and allows to navigate in the directory tree. *)
) (
populateList = (
	| directories sortBlock |
	directories:: List new.
	directory entries do:
		[:each |
		each isDirectory ifTrue: [directories add: each]].
	sortBlock:: [:a :b | a name < b name].
	directories sort: sortBlock.
	fileList list: directories.
)
windowTitle = (
	^'Select a Directory'
)
) : (
)
class BrazilFileSelector new = Object (
(* A BrazilFileSelector is a dialog box-like application with a list box and two buttons that allows to navigate the file system and select an existing file.

In the current incarnation, the selector opens modelessly and is configured with an action block that gets invoked when the user clicks the OK button. Usage example:

	| fileSelector |
	fileSelector:: BrazilFileSelector new
		fileFilter: '*.st';
		okAction:
			[:filename |
			Cursor wait showWhile: [doStuffWith: filename]].
	fileSelector open
*)
| directory fileFilterHolder window filterInput upButton fileList okButton cancelButton selectedName okAction |) (
activate: entry = (
(* The entry has been either double-clicked or selected and the OK button pressed. Enter it if it's a directory or remember as the selection and close the UI if it's a file. *)

entry isDirectory
	ifTrue: [enterDirectory: entry]
	ifFalse: [finalSelection: entry]
)
cancelClicked = (
	selectedName: nil.
	window close
)
createBottomPanel = (
	(* The bottom panel is a row with OK and Cancel buttons. *)

	| panel |
	panel:: Row new.
	okButton:: Button new
		label: 'OK';
		action: [okClicked].
	cancelButton:: Button new
		label: 'Cancel';
		action: [cancelClicked].
	panel
		add: okButton;
		addBlankSize: 5;
		add: cancelButton.
	okButton area elasticity: 1.
	cancelButton area elasticity: 1.
	^panel
)
createMiddlePanel = (
	(* For now the panel is really just the file list itself. *)

	fileList:: ListBox new.
	fileList
		displayBlock: fileDisplayBlock;
		doubleClickAction: [fileListDoubleClicked].
	fileList selectionChanged =>
		[:selection |
		okButton enabled: selection notNil].
	^fileList
)
createTopPanel = (
	| panel |
	panel:: Row new gap: 5.
	filterInput:: TextView new
		text: fileFilter.
	filterInput hasEditsFromUserChannel => [:a | self newFilterTyped: a].
	upButton:: Button new
		label: 'Up';
		action: [upClicked].
	panel
		add: filterInput;
		add: upButton.
	filterInput area elasticity: 1.
	panel area height: 25.
	^panel
)
createUI = (
	| top middle bottom |
	createWindow.
	window content: (Column new gap: 5).
	top:: createTopPanel.
	middle:: createMiddlePanel.
	bottom:: createBottomPanel.
	window content
		add: top;
		add: middle;
		add: bottom.
	middle area elasticity: 1.
)
createWindow = (
	window:: Window new title: windowTitle.
	window bounds: (300 @ 300 extent: 200 @ 300)
)
enterDirectory: entry <DirectoryEntry> = (
	directory: (directory / entry name).
	refreshUI
)
fileDisplayBlock = (
	^[:entry |
		entry isDirectory
			ifTrue: ['[-', entry name, '-]']
			ifFalse: [entry name]]
)
fileFilter ^<String> = (
	^fileFilterHolder value
)
fileFilter: filter <String> = (
	fileFilterHolder value: filter.
)
fileListDoubleClicked = (
	fileList selectionDo:
		[:selection | activate: selection]
)
finalSelection: entry <DirectoryEntry> = (
	selectedName:: directory fullNameFor: entry name.
	window close.
	okAction ifNotNil: [okAction value: selectedName]
)
initialize = (
	directory:: FileDirectory default.
	fileFilterHolder:: Holder with: '*'.
)
newFilterTyped: ignored <Boolean> = (
	fileFilter:: filterInput text asString.
	refreshUI
)
okClicked = (
	activate: fileList selection
)
open = (
	createUI.
	refreshUI.
	window open
)
populateList = (
	| directories files sortBlock |
	directories:: List new.
	files:: List new.
	directory entries do:
		[:each |
		(each isDirectory ifTrue: [directories] ifFalse: [files]) add: each].
	files:: files select: [:each | fileFilter match: each name].
	sortBlock:: [:a :b | a name < b name].
	directories sort: sortBlock.
	files sort: sortBlock.
	fileList list: directories, files.
)
refreshUI = (
	fileFilter: fileFilter. (* tickle to force an update *)
	populateList.
	okButton enabled: fileList hasSelection
)
selectFileNamed: name <String> = (
	| entry |
	entry:: fileList list
		detect: [:some | some name = name]
		ifNone: [^self].
	fileList select: entry
)
upClicked = (
(* The up button was clicked, go one directory up. After going up, select the directory we just popped out of. *)
| last |
last:: directory.
directory:: directory containingDirectory.
refreshUI.
selectFileNamed: last localName
)
windowTitle = (
	(* Answer the title to use for the dialog window. *)

	^'Select a File'
)
) : (
)
class BrazilInspector = (| subject window |) (
addInstVarNamed: name value: value to: container = (
	container addNew: Label setup:
		[:label |
		label label: name, ': ', value printString.
		setup: label toInspect: value]
)
addSelfLineTo: container = (
	container addNew: Label setup:
		[:label |
		label label: 'self: ', subject printString.
		setup: label toInspect: subject]
)
buildIn: container = (
	| |
	addSelfLineTo: container.
	subject class allInstVarNames keysAndValuesDo:
		[:index :name |
		addInstVarNamed: name value: (subject instVarAt: index) to: container]
)
createWindow = (
	window:: Window new.
	window
		title: subject printString;
		content: VerticalViewport new
)
open = (
	createWindow.
	buildIn: window content.
	window open
)
setup: label toInspect: object = (
	label mouseUpAction: [object explore]
)
) : (
)
public class DirectoryPicker = AbstractFileDialog () (
afterOpen = (
(* Attempt to select the baseDirectory initially to enable OK button. *)
| current parent entry |
parent:: initialDirectory containingDirectory.
parent fullName = initialDirectory fullName ifTrue: [^super afterOpen].
entry:: initialDirectory directoryEntry.
retargetAt: parent.
respondToSelection: entry in: panels first
)
buildButtons = (
	| buttons |
	buttons:: super buildButtons.
	okButton enabled: false.
	^buttons
)
defaultWindowLabel = (
	^'Select a Folder'
)
respondToSelection: item <DirectoryEntry | nil> in: panel = (
	super respondToSelection: item in: panel.
	okButton enabled: panels size > 1
)
selectedPath = (
	^(closedWithOK and: [panels size > 1])
		ifTrue: [hereDirectory fullName]
		ifFalse: [nil]
)
setupNewDirectoryPanel: panel <FilePickerPanel> = (
	panel includeFiles: false.
	super setupNewDirectoryPanel: panel.
)
) : (
)
public class FilePicker = AbstractFileDialog (|
	public fileFilter
	filterField
	public selectedPath
|showNewFolderButton:: false.
	fileFilter:: '*') (
buildButtons = (
	| row |
	row:: super buildButtons.
	enableOrDisableOKForSelection: nil.
	^row
)
buildFilterField = (
	filterField:: TextView new text: fileFilter.
	filterField hasEditsFromUserChannel => [:a | self newFilterTyped: a].
	filterField enterKeyResponse: [:defaultResponse | ].
	^filterField
)
buildTopRow = (
	| row |
	row:: super buildTopRow.
	row
		addBlankSize: 10;
		add: (Label new text: 'Filter:') wrapped beCentered;
		addBlankSize: 10;
		add: buildFilterField.
	filterField area width: 100.
	^row
)
defaultOKButtonLabel = (
	^'Open'
)
defaultWindowLabel = (
	^'Open File'
)
enableOrDisableOKForSelection: item <DirectoryEntry | nil> = (
	okButton enabled: (item notNil and: [item isDirectory not])
)
newFilterTyped: ignored <Boolean> = (
	fileFilter:: filterField text asString.
	panels last fileFilter: fileFilter
)
respondToCancel = (
	selectedPath:: nil.
	super respondToCancel.
)
respondToSelection: item <DirectoryEntry | nil> in: panel = (
	super respondToSelection: item in: panel.
	selectedPath:: item
		ifNotNil: [hereDirectory fullNameFor: item name].
	enableOrDisableOKForSelection: item
)
setupNewDirectoryPanel: panel <FilePickerPanel> = (
	panel fileFilter: fileFilter.
	super setupNewDirectoryPanel: panel.
)
) : (
)
class FilePickerDirectoryPanel = (|
	public directory
	fileFilterX
	includeFiles
	list
|fileFilterX:: '*'.
	includeFiles:: true) (
createVisual = (
	list:: ListBox new.
	list displayBlock: fileDisplayBlock.
	populateList.
	^list
)
public desiredWidth = (
	^200
)
public doubleClickAction: aBlock = (
	list doubleClickAction: aBlock
)
fileDisplayBlock = (
	^[:entry |
		entry isDirectory
			ifTrue: ['[ ', entry name, ' ]']
			ifFalse: [entry name]]
)
public fileFilter ^<String> = (
	^fileFilterX
)
public fileFilter: newFilter <String> = (
	fileFilterX:: newFilter.
	list ifNotNil: [populateList]
)
public isDirectoryPanel = (
	^true
)
populateList = (
	| directories files sortBlock |
	directories:: List new.
	files:: List new.
	directory entries do:
		[:each |
		(each isDirectory ifTrue: [directories] ifFalse: [files]) add: each].
	files:: files select: [:each | fileFilter match: each name].
	sortBlock:: [:a :b | a name < b name].
	list list:
		(includeFiles
			ifTrue: [(directories asSortedList: sortBlock) , (files asSortedList: sortBlock)]
			ifFalse: [directories asSortedList: sortBlock])
)
selectEntryNamed: name <String> = (
	| entry |
	entry:: list list detect: [:some | some name = name] ifNone: [^self].
	list select: entry
)
public selection = (
	^list selection
)
public selectionChannel = (
	^visual selectionChanged
)
public visual = (
	list isNil ifTrue: [createVisual].
	^list
)
) : (
)
class FilePickerFilePanel = (|
	public directory
	public fileEntry
	visualX
|) (
createBlurb = (
	| blurb |
	blurb:: Column new.
	blurb
		add: (Label new text: fileEntry name);
		add: (Label new text: 'Size: ', fileSizeString);
		add: (Label new text: timestampString).
	^blurb
)
createVisual = (
	visualX:: Row new.
	visualX
		addBlankSize: 4;
		add: createBlurb.
	^visualX
)
public desiredWidth = (
	^nil
)
fileSizeString = (
	| size k m g |
	size:: fileEntry fileSize.
	k:: 1024.
	m:: 1024 * k.
	g:: 1024 * m.
	size < k ifTrue:
		[^size printString, ' bytes'].
	size < m ifTrue:
		[^(rounded: size in: k) printString, ' K'].
	size < g ifTrue:
		[^(rounded: size in: m) printString, ' M'].
	^(rounded: size in: g) printString, ' G'
)
public isDirectoryPanel = (
	^false
)
rounded: size in: divisor = (
	^(size * 10 / divisor) rounded asFloat / 10
)
timestampString = (
	^(TimeStamp fromSeconds: fileEntry modificationTime) printString
)
public visual = (
	visualX isNil ifTrue: [createVisual].
	^visualX
)
) : (
)
public class MessageBox = (|
	public title ::= NewspeakGlobalState theNativeSession systemName.
	shouldClose ::= false.
	width ::= 400. (* 40 em *)
	buttonLabels buttonSelections dialog message messageArea buttons selection
	|ok: '<no message provided>') (
buttonLabels: labels <Collection[String]> selections: selections <Collection> = (
	buttonLabels:: labels.
	buttonSelections:: selections.
)
createButtonLabelled: label <String> selection: tag <Object> = (
	| button |
	button:: Button new label: label.
	button action:
		[selection: tag.
		shouldClose: true].
	^button
)
createButtonRow = (
	| buttonsOnly |
	buttons:: Row new gap: 5.
	buttonsOnly:: List new.
	buttons add: Blank new.
	buttons children last area elasticity: 1.
	buttonLabels with: buttonSelections do:
		[:label :tag | | button |
		button:: createButtonLabelled: label selection: tag.
		buttonsOnly add: button.
		buttons add: button].
	buttons add: Blank new.
	CellWidthEqualizer equalizeRowElements: buttonsOnly.
	buttons children last area elasticity: 1.
	^buttons
)
createUI = (
| column |
dialog:: Window new title: title.
dialog content: Row new.
dialog content addBlankSize: 10.
column:: Column new.
column addBlankSize: 5.
column add: (TextDisplay new text: message asString).
column addBlankSize: 15.
column children last area elasticity: 1.
column add: createButtonRow.
column addBlankSize: 10.
dialog content add: column.
column area elasticity: 1.
dialog content addBlankSize: 10.
)
public ok: text <String> = (
	message:: text.
	buttonLabels: {'OK'} selections: {#ok}
)
public okCancel: text <String> = (
	message:: text.
	buttonLabels: {'OK'. 'Cancel'} selections: {#ok. #cancel}
)
public open = (
	createUI.
	dialog
		openModalWhileFalse: [ shouldClose]
		afterOpening: [setWindowBounds].
	^selection
)
setWindowBounds = (
	| extent bounds |

	extent:: width isNil
		ifTrue: [dialog content naturalExtent + (10 @ 0)]
		ifFalse: [width @ (dialog naturalHeightForWidth: width)].
	bounds:: dialog desktop centeredRectangleOfExtent: extent.
	dialog area bounds: bounds
)
public yesNo: text <String> = (
	message:: text.
	buttonLabels: {'Yes'. 'No'} selections: {#yes. #no}
)
public yesNoCancel: text <String> = (
	message:: text.
	buttonLabels: {'Yes'. 'No'. 'Cancel'} selections: {#yes. #no. #cancel}
)
) : (
)
public class NewFilePicker = AbstractFileDialog (| fileNameX ::= String new.  nameField |) (
buildButtons = (
	| buttons |
	buttons:: Row new.
	showNewFolderButton ifTrue:
		[buttons add: buildNewFolderButton].
	buttons
		addElasticBlank;
		add: (Label new text: 'Save as:') wrapped beCentered;
		addBlankSize: 10;
		add: buildNameField;
		addBlankSize: 10.
	nameField area width: 200; elasticity: 2.
	okButton:: buttons addNew: Button setup:
		[:button |
		button
			label: okButtonLabel;
			action: [respondToOK]].
	enableOrDisableOK.
	buttons addBlankSize: 10.
	cancelButton:: buttons addNew: Button setup:
		[:button |
		button label: 'Cancel'; action: [respondToCancel]].
	CellWidthEqualizer equalizeRowElements:
		{okButton. cancelButton}.
	^buttons
)
buildNameField = (
	| row |
	nameField:: TextView new.
	nameField hasEditsFromUserChannel => [:x | enableOrDisableOK].
	nameField
		text: fileName;
		enterKeyResponse:
			[:defaultResponse | okButton enabled ifTrue: [respondToOK]].
	^nameField
)
defaultOKButtonLabel = (
(* Assuming this will be used to pick a file to save. *)

^'Save'
)
defaultWindowLabel = (
(* Assuming this will be used to pick a file to save. *)

^'Save File'
)
enableOrDisableOK = (
	nil = okButton ifTrue: [^self].
	okButton enabled: nameField text isEmpty not
)
public fileName ^<String> = (
	^fileNameX
)
public fileName: newName <String> = (
	fileNameX:: newName.
	nameField ifNotNil: [nameField text: newName]
)
respondToSelection: item in: panel = (
	(item notNil and: [item isDirectory not]) ifTrue:
		[nameField text: item name].
	enableOrDisableOK.
	super respondToSelection: item in: panel
)
public selectedPath = (
	^(nameField notNil and: [nameField text notEmpty])
		ifTrue: [hereDirectory fullNameFor: nameField text]
		ifFalse: [nil]
)
) : (
)
public class Prompter = MessageBox (
(* A utility dialog with a one-line text view that allows entering a short text and an OK and Cancel buttons. *)
|
	public initialText
	textView
	cancelled
|) (
createButtons = (
	| row buttons |
	buttons:: List new.
	row:: Row new
		addElasticBlank;
		addNew: Button setup:
			[:button |
			buttons add: button.
			button
				label: 'OK';
				action: [respondToOK]];
		addBlankSize: 5;
		addNew: Button setup:
			[:button |
			buttons add: button.
			button
				label: 'Cancel';
				action: [respondToCancel]];
		addBlankSize: 5;
		yourself.
	CellWidthEqualizer equalizeRowElements: buttons.
	^row
)
createTextView = (
	textView:: TextView new.
	textView
		text: initialText;
		enterKeyResponse: [:defaultResponse | respondToOK];
		escapeKeyResponse: [:defaultResponse | respondToCancel].
	^textView
)
createUI = (
	dialog:: Window new title: title.
	dialog content: Column new.
	dialog content
		addBlankSize: 5;
		add: createTextView;
		addBlankSize: 5.
	dialog content children last area elasticity: 1.
	dialog content
		add: createButtons;
		addBlankSize: 5.
	textView area height: 25.
)
initialize = (
	super initialize.
	initialText:: String new
)
public open ^<String | nil> = (
	createUI.
	dialog openModalWhileFalse: [shouldClose] afterOpening: [setWindowBounds].
	^(cancelled isNil or: [cancelled])
		ifTrue: [nil]
		ifFalse: [textView text asString]
)
respondToCancel = (
	cancelled:: true.
	shouldClose:: true
)
respondToOK = (
	cancelled:: false.
	shouldClose:: true
)
text = (
	^textView text asString
)
) : (
)
) : (
)
class VisualClasses = (
(* The former category of Brazil-Visuals-Abstract *)
|
	private Attribute
	private ShapeArea
	private FutureArea
	private MappableHolder
	private InformationRetriever
	private Frame
	private Anchor
	private GridRowCell
	private RowCell
	private ColumnCell
	private HierarchicalReporter
	private Wrapper
	private Blank
	|) (
public class BoxShape = Shape (
(* A BoxShape is the abstract superclass of shapes fully (or at least mostly) defined by their bounding box rectangle, such as rectangles and ellipses. The one attribute all BoxShapes share is 'size', so named to distinguish it from the shape's extent. The size of a BoxShape determines the shape's natural extent (how big the shape wants to be). The actual visible size of the shape as allocated by the parent may be different. *)
|
	sizeS ::= 0@0.
	|) (
public computeNaturalExtent ^<Point> = (
	^sizeS
)
public naturalExtent ^<Point> = (
	^sizeS
)
public size ^<Point> = (
	^sizeS
)
public size: newSize <Point> = (
	sizeS:: newSize.
	reportNaturalExtentChange
)
) : (
)
public class ContainerVisual = Visual (
(* An abstract superclass of those visuals that can have children, at least as a possibility. Defines additional layout-management API such classes should support. Also introduces the color attribute. *)
|
	public colorA ::= Attribute name: #color value: Color transparent.
	|) (
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* This message is sent by the area of the child to inform the parent that the parameters (either of the child or of the area) determining the child's layout have changed. The receiver may choose to request an update of its own layout in response to this message.
	Whether the receiver updates its or the child's layout or not, it should invoke the continuation block with the bounds allocated to the child. *)

	subclassResponsibility
)
public color ^<Color> = (
	(* Answer the background color of the receiver. *)

	^colorA value
)
public color: newColor <Color> = (
	(* Set the background color of the receiver. *)

	colorA value: newColor
)
compositionBounds ^<Rectangle> = (
	(* Answer the area within which the receiver allocates positions for its children. The answer is in receiver's inner coordinate system, meaning the origin is always 0@0. *)

	^0 @ 0 extent: innerExtent
)
compositionExtent ^<Point> = (
	(* Answer the size of the area within which the receiver allocates positions for its children. *)

	^innerExtent
)
public globalOriginForChildren ^<Point> = (
	(* Answer the coordinates of the top left corner of the visual's surface, relative to which the children are positioned. This value is affected by the current scroll position of the visual for those visuals that support scrolling. *)

	^globalOrigin
)
innerBounds ^<Rectangle> = (
	(* Answer the area of the receiver available for displaying children, in the receiver's own coordinate system. *)

	subclassResponsibility
)
innerExtent ^<Point> = (
	^innerBounds extent
)
public legalAreaClassesFor: child <Visual> ^<Collection[Class]> = (
	(* Subclasses must reimplement this to send the appropriate #legalAreaClassesIn... message to the child and return the result. *)

	subclassResponsibility
)
mayAccommodateNaturalHeightChangeOf: child <Visual> ^<Boolean> = (
	(* Subclasses may redefine this to reflect their idea of how accommodating they are. *)
	^parentMayAccommodateNaturalHeightChange
)
mayAccommodateNaturalWidthChangeOf: child <Visual> ^<Boolean> = (
	(* Subclasses may redefine this to reflect their idea of how accommodating they are. *)
	^parentMayAccommodateNaturalWidthChange
)
restructuring: restructureBlock <[]> = (
	(* Execute the argument block as a restructuring section, notifying the agent of the beginning and the end of that process. *)
	(* This facility is disabled pending a usefulness review, however for the time being we are keeping this message and its senders. The non-trivial implementation is in the comment at the end of the method. *)

	| result |
	notifications send: #childrenChanging.
	result: restructureBlock value.
	notifications send: #childrenChanged.
	^result

(*	| endK result |
	notifications send: #childrenChanging.
	agent ifNotNil: [endK:: agent noteRestructuringStartAndProvideEndContinuation].
	inRestructuring:: true.
	result:: restructureBlock ensure:
		[inRestructuring:: false.
		endK ifNotNil: [endK value].
		notifications send: #childrenChanged].
	^result. *)
)
public setupAreaIn: child <Visual> = (
	(* A subclass should redefine this to send an appropriate #setupAreaFor... message to the child. *)

	self subclassResponsibility
)
) : (
)
public class HorizontalVisualSequence = VisualSequence () (
childRectangleFrom: base <Integer> size: size <Integer>
^<Rectangle> = (
	(* Create and answer a rectangle which begins at the 'base' position along the principal axis of the receiver and has the size of 'size', occupying all space available along the orthogonal axis. *)

	| box |
	box:: innerBounds.
	^base @ box top corner: (base + size) @ box bottom
)
public computeNaturalHeightForWidth: suggestedWidth = (
	| excess isExpanding totalElasticity elasticityFactor base across maxHeight |
	excess: suggestedWidth - (principalOf: naturalExtent).
	isExpanding: excess >= 0.
	totalElasticity:: 0.
	isExpanding
		ifTrue: [childrenDo: [:each | totalElasticity:: totalElasticity + each area expansibility]]
		ifFalse: [childrenDo: [:each | totalElasticity:: totalElasticity + each area compressibility]].
	elasticityFactor:: [excess asFloat / totalElasticity]
		on: ZeroDivide
		do: [:ex | ex return: 0].
	base:: 0.
	maxHeight:: 0.
	childrenDo:
		[:each | | allocated |
		allocated:: each area minimumSize max:
			(each area principalSize
			+ (elasticityFactor
				* (isExpanding
					ifTrue: [each area expansibility]
					ifFalse: [each area compressibility])) floor).
		maxHeight:: maxHeight max: (each area naturalHeightForWidth: allocated)].
	^maxHeight
)
public legalAreaClassesFor: child <Visual> = (
	^child legalAreaClassesInHorizontalVisualSequence
)
orthogonalOf: aPoint <Point>
^<Number> = (
	^aPoint y
)
pointPrincipal: x <Number> orthogonal: y <Number>
^<Point> = (
	^x @ y
)
principalOf: aPoint <Point>
^<Number> = (
	^aPoint x
)
repositionAllChildrenByRequestFrom: child <Visual> using: continuation <Block> = (
	(* Recompute the layout of all children of the receiver and notify them of their new layout. Use the continuation block passed as the second argument to notify the child passed as the first argument. Send #occupyBounds: to all other children.
	Note that this method is largely replicated in VerticalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| excessX isExpanding totalElasticity elasticityFactor base |
	excessX: innerExtent x - naturalExtent x.
	isExpanding: excessX >= 0.
	totalElasticity:: 0.
	isExpanding
		ifTrue: [childrenDo: [:each | totalElasticity:: totalElasticity + each area expansibility]]
		ifFalse: [childrenDo: [:each | totalElasticity:: totalElasticity + each area compressibility]].
	elasticityFactor:: totalElasticity = 0
		ifTrue: [0]
		ifFalse: [excessX asFloat / totalElasticity].
	base:: 0.
	childrenDo:
		[:each | | requested allocatedX |
		requested: each area principalSize.
		each area currentLayoutBasis: requested.
		allocatedX:: each area minimumSize max:
			(requested +
				(elasticityFactor
					* (isExpanding
						ifTrue: [each area expansibility]
						ifFalse: [each area compressibility])) floor).
		each == child
			ifTrue: [continuation value: (childRectangleFrom: base size: allocatedX)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocatedX)].
		base:: base + allocatedX + gap]
)
repositionAllChildrenWithElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver, taking children elasticity into account. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	Note that this method is largely replicated in VerticalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| excess isExpanding totalElasticity elasticityFactor base |
	excess: innerExtent x - naturalExtent x.
	isExpanding: excess >= 0.
	totalElasticity:: 0.
	isExpanding
		ifTrue: [childrenDo: [:each | totalElasticity:: totalElasticity + each area expansibility]]
		ifFalse: [childrenDo: [:each | totalElasticity:: totalElasticity + each area compressibility]].
	elasticityFactor:: totalElasticity = 0
		ifTrue: [0]
		ifFalse: [excess asFloat / totalElasticity].
	base:: 0.
	childrenDo:
		[:each | | requested allocated |
		requested:: each area principalSize.
		each area currentLayoutBasis: requested.
		allocated:: each area minimumSize max:
			(requested +
				(elasticityFactor
					* (isExpanding
						ifTrue: [each area expansibility]
						ifFalse: [each area compressibility])) floor).
		force
			ifTrue: [each forceBounds: (childRectangleFrom: base size: allocated)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocated)].
		base:: base + allocated + gap]
)
repositionAllChildrenWithNoElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver in a sitiuation when we do not need to take elasticity into account. Notify all the children of their new effective bounds. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	Note that this method is largely replicated in VerticalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| base |
	base:: 0.
	childrenDo:
		[:each | | allocated |
		allocated:: each area minimumSize max: each area principalSize.
		each area currentLayoutBasis: allocated.
		force
			ifTrue: [each forceBounds: (childRectangleFrom: base size: allocated)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocated)].
		base:: base + allocated + gap]
)
repositionChildrenStartingWith: child <Visual> using: continuation <Block> = (
	(* In the course of an update, we determined that only the given child and those that follow it in the sequence need to be repositioned. Furthermore, if the size of the child is unchanged, those that follow remain where they are and need not be touched.
	Note that this method is largely replicated in VerticalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| index base size shift |
	index:: indexOf: child.
	base:: child bounds origin x.
	size:: child area minimumSize max: child area principalSize.
	shift:: size - child extent x.
	shift = 0
		ifTrue:
			[continuation value: child bounds (* and no further update is needed *)]
		ifFalse:
			[continuation value: (childRectangleFrom: base size: size).
			index + 1 to: children size do:
				[:i | | each |
				each:: children at: i.
				each occupyBounds: (shiftRectangle: each bounds by: shift)]]
)
setPositionOfNewlyInserted: child <Visual> = (
	(* Note that this method is largely replicated in VerticalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| index base childSize shift |
	index:: children indexOf: child.
	base:: index > 1
		ifTrue: [(children at: index - 1) bounds right + gap]
		ifFalse: [0].
	childSize:: child area minimumSize max: child area principalSize.
	child area currentLayoutBasis: childSize.
	child occupyBounds: (childRectangleFrom: base size: childSize).
	shift:: childSize + gap.
	index + 1 to: children size do:
		[:i | | each |
		each:: children at: i.
		each occupyBounds: (shiftRectangle: each bounds by: shift)]
)
shiftRectangle: rect <Rectangle> by: shift <Integer>
^<Rectangle> = (
	(* Answer a new rectangle which is the first argument shifted by 'shift' pixels along the X axis of the receiver. *)

	^rect origin + (shift @ 0) extent: rect extent
)
) : (
)
public class LeafVisual = Visual (
(* The abstract superclass of visuals that have no children. Just like Visual, LeafVisual is an abstract class as it leaves unimplemented some of the subclass responsibilities required by Visual. *)
) (
public children = (
	(* A shortcut to the quick answer. *)

	^Array new
)
public childrenDo: aBlock <Block> = (
	(* No children--nothing to do. *)
)
public hasChildren = (
	(* A shortcut to the quick answer. *)

	^false
)
) : (
)
public class Shape = LeafVisual (|
	public colorA ::= Attribute name: #color value: Color black.
	public borderColorA ::= Attribute name: #borderColor value: Color black.
	public borderWidthA ::= Attribute name: #borderWidth value: 0.
	public entryAction
	public exitAction
	public mouseDownAction
	public mouseUpAction
	public mouseMovedAction
	|) (
public borderColor ^ <Color> = (
	^borderColorA value
)
public borderColor: aColor <Color> = (
	borderColorA value: aColor
)
public borderWidth ^<Number> = (
	^borderWidthA value
)
public borderWidth: width <Integer> = (
	borderWidthA value: width
)
public color = (
	^colorA value
)
public color: aColor = (
	colorA value: aColor
)
public legalAreaClassesInCompositeVisual = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of CompositeVisual. *)

	^{ShapeArea}, super legalAreaClassesInCompositeVisual
)
public mouseDownLeftResponse: response <Block> = (
	mouseDownAction:: response
)
public mouseEntryResponse: response <Block> = (
	entryAction:: response
)
public mouseExitResponse: response <Block> = (
	exitAction:: response
)
public mouseMoveResponse: response <Block> = (
	mouseMovedAction:: response
)
public mouseUpLeftResponse: response <Block> = (
	mouseUpAction:: response
)
public respondToMouseDownLeft = (
	mouseDownAction ifNotNil: [:it | it value]
)
public respondToMouseEntry = (
	entryAction ifNotNil: [:it | it value]
)
public respondToMouseExit = (
	exitAction ifNotNil: [:it | it value]
)
public respondToMouseMove = (
	mouseMovedAction ifNotNil: [:it | it value]
)
public respondToMouseUpLeft = (
	mouseUpAction ifNotNil: [:it | it value]
)
public setupAreaForCompositeVisual = (
	setArea: (ShapeArea visual: self)
)
) : (
)
public class VerticalVisualSequence = VisualSequence (
(* This is the abstract superclass of sequences arranging their children vertically as a column. *)
) (
public childInElasticLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* Here we capture an important optimization opportunity: if the natural height of the child for the current width has not changed, there is no need to percolate the update upwards. *)

	| newDesiredHeight |
	newDesiredHeight:: child area naturalHeightForWidth: innerExtent x.
	^newDesiredHeight = child area currentLayoutBasis
		ifTrue: [continuation value: child bounds]
		ifFalse: [super childInElasticLineup: child requestsBoundsUpdateUsing: continuation]
)
public childInRigidSquishyLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* Here we capture an important optimization opportunity: if the natural height of the child for the current width has not changed, there is no need to percolate the update upwards. *)

	| newDesiredHeight |
	newDesiredHeight:: child area naturalHeightForWidth: innerExtent x.
	^newDesiredHeight = child area currentLayoutBasis
		ifTrue: [continuation value: child bounds]
		ifFalse: [super childInRigidSquishyLineup: child requestsBoundsUpdateUsing: continuation]
)
childRectangleFrom: base <Integer> size: size <Integer>
^<Rectangle> = (
	(* Create and answer a rectangle which begins at the 'base' position along the principal axis of the receiver and has the size of 'size', occupying all space available along the orthogonal axis. *)

	| box |
	box:: innerBounds.
	^box left @ base corner: box right @ (base + size)
)
public computeNaturalHeightForWidth: width <Number> ^<Number> = (
	(* For a vertical sequence, the natural height is simply the sum of natural heights of the children plus the gaps. *)

	| total |
	total:: 0.
	childrenDo:
		[:each |
		total:: total + (each area naturalHeightForWidth: width)].
	^total + (((children size - 1) max: 0) * gap)
)
createAgentUsing: aMapping = (
	aMapping createAgentForVerticalVisualSequence: self
)
public isSqueezing ^<Boolean> = (
	^true
)
public legalAreaClassesFor: child <Visual> = (
	^child legalAreaClassesInVerticalVisualSequence
)
orthogonalOf: aPoint <Point>
^<Number> = (
	^aPoint x
)
pointPrincipal: y <Number> orthogonal: x <Number>
^<Point> = (
	^x @ y
)
principalOf: aPoint <Point>
^<Number> = (
	^aPoint y
)
repositionAllChildrenByRequestFrom: child <Visual> using: continuation <Block> = (
	(* Recompute the layout of all children of the receiver and notify them of their new layout. Use the continuation block passed as the second argument to notify the child passed as the first argument. Send #occupyBounds: to all other children.
	Note that this method is largely replicated in HorizontalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| across excessY isExpanding totalElasticity elasticityFactor base |
	across:: innerExtent x.
	excessY: innerExtent y - (naturalHeightForWidth: across).
	isExpanding: excessY >= 0.
	totalElasticity:: 0.
	isExpanding
		ifTrue: [childrenDo: [:each | totalElasticity:: totalElasticity + each area expansibility]]
		ifFalse: [childrenDo: [:each | totalElasticity:: totalElasticity + each area compressibility]].
	elasticityFactor:: totalElasticity = 0
		ifTrue: [0]
		ifFalse: [excessY asFloat / totalElasticity].
	base:: 0.
	childrenDo:
		[:each | | requested allocated |
		requested:: each area naturalHeightForWidth: across.
		each area currentLayoutBasis: requested.
		allocated:: each area minimumSize max:
			(requested +
				(elasticityFactor
					* (isExpanding
						ifTrue: [each area expansibility]
						ifFalse: [each area compressibility])) floor).
		each == child
			ifTrue: [continuation value: (childRectangleFrom: base size: allocated)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocated)].
		base:: base + allocated + gap]
)
repositionAllChildrenWithElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver, taking children elasticity into account. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	Note that this method is largely replicated in HorizontalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| excess isExpanding totalElasticity elasticityFactor base across |
	across:: innerExtent x.
	excess: innerExtent y - (naturalHeightForWidth: across).
	isExpanding: excess >= 0.
	totalElasticity:: 0.
	isExpanding
		ifTrue: [childrenDo: [:each | totalElasticity:: totalElasticity + each area expansibility]]
		ifFalse: [childrenDo: [:each | totalElasticity:: totalElasticity + each area compressibility]].
	elasticityFactor:: totalElasticity = 0
		ifTrue: [0]
		ifFalse: [excess asFloat / totalElasticity].
	base:: 0.
	childrenDo:
		[:each | | requested allocated |
		requested:: each area naturalHeightForWidth: across.
		each area currentLayoutBasis: requested.
		allocated:: each area minimumSize max:
			(requested +
				(elasticityFactor
					* (isExpanding
						ifTrue: [each area expansibility]
						ifFalse: [each area compressibility])) floor).
		force
			ifTrue: [each forceBounds: (childRectangleFrom: base size: allocated)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocated)].
		base:: base + allocated + gap]
)
repositionAllChildrenWithNoElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver in a sitiuation when we do not need to take elasticity into account. Notify all the children of their new effective bounds. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	Note that this method is largely replicated in HorizontalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| base across |
	base:: 0.
	across:: orthogonalOf: innerExtent.
	childrenDo:
		[:each | | allocated |
		allocated:: each area naturalHeightForWidth: across.
		each area currentLayoutBasis: allocated.
		force
			ifTrue: [each forceBounds: (childRectangleFrom: base size: allocated)]
			ifFalse: [each occupyBounds: (childRectangleFrom: base size: allocated)].
		base:: base + allocated + gap]
)
repositionChildrenStartingWith: child <Visual> using: continuation <Block> = (
	(* In the course of an update, we determined that only the given child and those that follow it in the sequence need to be repositioned. Furthermore, if the size of the child is unchanged, those that follow remain where they are and need not be touched.
	Note that this method is largely replicated in HorizontalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| index boundsNow base size shift |
	index:: indexOf: child.
	boundsNow:: child bounds.
	base:: boundsNow top.
	size:: child area minimumSize max: (child area naturalHeightForWidth: innerExtent x).
	child area
		currentLayoutBasis: size.
	shift:: size - boundsNow height.
	shift = 0
		ifTrue: (* no change at all *)
			[continuation value: child bounds]
		ifFalse:
			[continuation value: (childRectangleFrom: base size: size).
			index + 1 to: children size do:
				[:i | | each |
				each:: children at: i.
				each occupyBounds: (shiftRectangle: each bounds by: shift)]]
)
setPositionOfNewlyInserted: child <Visual> = (
	(* Note that this method is largely replicated in HorizontalVisualSequence, but with the axes transposed (to avoid paying the indirection through the cell penalty of the earlier Brazil versions). *)

	| index base childSize shift |
	index:: children indexOf: child.
	base:: index > 1
		ifTrue: [(children at: index - 1) bounds bottom + gap]
		ifFalse: [0].
	childSize:: child area minimumSize max: (child area naturalHeightForWidth: orthogonalSize).
	child area
		currentLayoutBasis: childSize.
	child occupyBounds: (childRectangleFrom: base size: childSize).
	shift:: childSize + gap.
	index + 1 to: children size do:
		[:i | | each |
		each:: children at: i.
		each occupyBounds: (shiftRectangle: each bounds by: shift)]
)
shiftRectangle: rect <Rectangle> by: shift <Integer>
^<Rectangle> = (
	(* Answer a new rectangle which is the first argument shifted by 'shift' pixels along the principal axis of the receiver. *)

	^rect origin + (0 @ shift) extent: rect extent
)
) : (
)
class Visual = (
(* Visual is the abstract superclass of any Brazil UI component. By itself, it is not a usable component. Instead, the class provides a number of useful defaults, instance structure and core protocols. The functionality common to all visuals that it captures is:

	Parent/child structure.
	The 'visible' attribute.
	The 'area' controlling the visual's position inside the parent.
	The 'agent' responsible for representing the visual in a particular target UI framework.

In addition to the above, all Visuals have the following private and protected properties used by the machinery of the framework.

'treeIsInFlux' is a Boolean containing the current value of this visual's 'isInFlux' value ORed with those of all of its parent up to and including the window. 'isInFlux' is a property that is false for most visuals, but can be set to true by certain containers while their progeny is undergoing a massive restructuring.

'updateLockLevel' is an integer initialized to 1 in a newly created unattached Visual and normally set to 0 in visuals currently displayed on the screen. When the value is 0, the visual requests bounds update from its parent whenever needed. When the value is greater than 0, the updates are not requested. Incrementing or decrementing the level in a visual increments or decrements it by the same amount in all children of the visual.

'currentNaturalExtent' holds an instance of Point describing how large the visual would like to be.

'parentMayGrantX', 'parentMayGrantY', and 'parentSqueezesX' are parts of what is known as the visual's ''layout context''. These three Boolean values describe cumulative properties of the visual's parents and their areas. They are computed and updated ''statically'' as the tree of visuals is modified. The two 'parentMayGrant' values say whether the parent may care of changes in the visual's natural extent along the respective axes. The 'parentSqueezesX' value, if true, indicates that the parent will send #naturalHeightForWidth: to the visual and will allocate the requested amount of vertical space within its fixed width. *)
|
	public parent
	public agent
	public owner
(* Comment from createAttributes *)
(* Subclasses that add attributes must reimplement this method to call the superclass implementation and then initialize the attribute slots. By convention, an attribute named 'foo' should be represented by a slot named 'fooA' initialized by this method to hold an Attribute instance with a name #foo. The value of the attribute should be accessible using accessor methods #foo and #foo: classified under the 'accessing-attributes' protocol. *)
	public visibleA ::= Attribute name: #visible value: true.
	duct ::= Duct owner: self.
	public area ::= FutureArea new.
	public boundsH ::= MappableHolder with: (0@0 corner: 0@0).
	public updateLockLevel ::= 1.
	currentNaturalExtent ::= 0@0.
	|) (
addTo: parent <Visual> = (
	(* An inverse way of adding a child to a parent, for more coding flexibility. *)

	parent add: self
)
affectsNaturalExtent: attribute <Attribute> = (
	(* Part of attribute definition API, used to declare the attribute as one whose value affects natural extent of the visual it belongs to. Any change of the attribute value will automatically trigger a natural extent update of the visual. *)

	attribute changed =>
		[:ignored |
		reportNaturalExtentChange]
)
public allChildrenDo: aBlock <Block> = (
	(* Evaluate aBlock for each child in the transitive closure of the receiver's children. Enumeration proceeds in depth-first order. *)

	childrenDo:
		[:each |
		aBlock value: each.
		each allChildrenDo: aBlock]
)
announceLayoutChange = (
	notifications send: #layoutChanged
)
announceNaturalExtentChange = (
	agent ifNotNil: [:it | it noticeChangeInNaturalExtent].
	notifications send: #naturalExtentChanged
)
public areUpdatesLocked ^<Boolean> = (
	^updateLockLevel > 0
)
public areaClass: aClass <Class> = (
	(* Force the receiver to use an instance of a particular class as its area. *)

	(isAreaClassLegalForSelf: aClass) ifFalse:
		[error: 'invalid area class for this parent-child combination'].
	setArea: (aClass visual: self).
	requestBoundsUpdate
)
blockIncrementalLayoutUpdatesSilentlyWhile: aBlock = (
	incrementUpdateLockLevelBy: 1.
	^aBlock ensure:
		[incrementUpdateLockLevelBy: -1].
)
public blockIncrementalLayoutUpdatesWhile: aBlock = (
	| result |
	result:: self blockIncrementalLayoutUpdatesSilentlyWhile: aBlock.
	(* We don't include the following in an ensure block, so that if things break we don't keep exercising broken visuals. *)
	updateLockLevel < 1 ifTrue:
		[flushLayoutCaches.
		requestBoundsUpdateUsing:
			[:newBounds | forceBounds: newBounds]].
	^result
)
public bounds ^<Rectangle> = (
	(* Bounds are the area, in the parent's coordinate system, that the visual currently occupies. This property is read-only, as the bounds are determined by the widget itself based on its content and layout parameters. *)

	^boundsH value
)
boundsChangedChannel ^<Duct> = (
	(* Answer a Duct that transmits the bounds of the receiver each time they change. *)

	^boundsH changed
)
public children ^<Collection[Visual]> = (
	(* Answer a collection of all direct children of the receiver. Here is a reasonable default implementation based on the childrenDo: method we expect subclasses to provide. Subclasses may redefine this for better performance. *)

	| result |
	result:: List new: 10.
	self childrenDo: [:each | result add: each].
	^result
)
public childrenDo: aBlock <Block> = (
	(* Subclasses must redefine this to enumerate the visual's children, if any. *)

	self subclassResponsibility
)
public childrenReverseDo: action <[:Visual]> = (
	(* The simple universal implementation; a subclass might want to improve on this if its #children conses up a new collection (as the default Visual>>children does). *)
	^children reverseDo: action
)
public computeNaturalExtent ^<Point> = (
	(* Concrete subclasses must implement this to compute and answer the natural extent corresponding to the current state of the receiver. *)

	subclassResponsibility
)
public containsMouse ^<Boolean> = (
	(* Answer whether the mouse is located within the visual's bounds. *)
	^localBounds containsPoint: mousePoint
)
public createAgentSubtreeUsing: agentFactory <AbstractAgentFactory> = (
	(* Create agents for this visual and all of its children (direct and indirect). In that process, an agent for a parent is created before an agent for any of its children. *)
	self createAgentUsing: agentFactory.
	childrenDo: [:each | each createAgentSubtreeUsing: agentFactory]
)
createAgentUsing: agentFactory <AbstractAgentFactory> = (
	(* A subclass must implement this method to double-dispatch the mapping request to the factory identifying itself in the selector, so that the factory creates the mapping instance appropriate for the receiver. *)

	self subclassResponsibility
)
public desktop ^<Desktop | nil> = (
	(* Answer the desktop instance at the top of this visual's containment hierarchy. Nil if the visual is not part of a proper hierarchy. *)

	^parent ifNotNil: [parent desktop]
)
public discardMappings = (
	(* Discard the mappings of this visual and all of its children without actually invoking the agents. This message should be sent in a new image session to Windows that were mapped to native artifacts, so that 'properly' unmapping them now is both unnecessary and impossible. *)

	agent ifNotNil:
		[agent deactivate.
		agent:: nil].
	childrenDo: [:each | each discardMappings].
	area flushLayoutCaches
)
effectivelyVisible ^<Boolean> = (
	(* The 'visible' property of a visual only reports the 'local' visibility withing the immediate parent. However, a visual that is visible by itself can still be effectively hidden if an ancestor of the visual is hidden. *)

	^visible and: [parent isNil or: [parent effectivelyVisible]]
)
ensureUpToDateAppearance = (
	(* Some platforms may not update the visible image of their display objects immediately. Sending this message on such platforms ensures that the visible state of the visual reflects all of its current attributes. *)

	agent ifNotNil: [:it | it ensureUpToDateAppearance]
)
public extent ^<Point> = (
	(* Answer the current size of the widget. Just like the #bounds property it is derived from, extent is a read-only property. *)

	^bounds extent
)
public finishedMapping = (
	(* This is a notification sent to all visuals of a visual tree after the entire tree has been mapped. *)

	childrenDo: [:each | each finishedMapping].
	agent ifNotNil: [:agnt | agnt finishedMapping].
	updateGeometricProperties.
)
public flash = (
	(* Flash the visual. Handy for debugging. *)

	isMapped ifTrue: [agent flash]
)
public flushLayoutCaches = (
	(* Subclasses that cache layout-related information need to augment this to flush any such information upon receipt of this message. *)

	area flushLayoutCaches.
	agent ifNotNil: [:it | it flushLayoutCaches].
	childrenDo: [:each | each flushLayoutCaches]
)
public forceBounds: newBounds <Rectangle> = (
	(* A 'hard' unsolicited bounds update: the receiver must update its own bounds and force the children to do likewise. The send of this should typically be preceded by a #flushLayoutCaches.
	A visual must not optimize its response to this message, and should always communicate to all children their effective bounds using the same #forceBounds: protocol.
	NOTE: this message is for internal framework use and is not supposed to be sent by application code. *)

	| endK |
	endK:: agent ifNotNil:
		[:it | it noteBeginningOfBoundsChangeAndProvideEndContinuation].
	[forceBoundsResponse: newBounds]
		ensure: [endK ifNotNil: [:it | it value]]
)
public forceBoundsResponse: newBounds <Rectangle> = (
	(* A 'hard' unsolicited bounds update: the receiver must update its own bounds and force the children to do likewise. The send of this should typically be preceded by a #flushLayoutCaches.
	A visual must not optimize its response to this message, and should always communicate to all children their effective bounds using the same #forceBounds: protocol.
	NOTE: this message is for internal framework use and is not supposed to be sent by application code. *)

	boundsH value: newBounds
)
public globalOrigin ^<Point> = (
	(* Answer the coordinates of the visual's visible top left corner in the desktop coordinate system. This value is not affected by the current scroll position of the visual. *)

	^parent == nil
		ifTrue: [origin]
		ifFalse: [parent globalOriginForChildren + origin]
)
public grabMouse = (
	(* Force all mouse events to be delivered to this visual regardless of whether the mouse pointer is within its bounds or not. The grab is in effect until #releaseMouse is sent to the same visual or until another visual grabs the mouse. This action has no effect if the visual is not mapped. Though this operation is part of all visuals API, its applicability to a given visual is platform-specific, but if the operation is inapplicable it is a no-op and not an error. *)

	agent ifNotNil: [:it | it grabMouse]
)
public hasChildren ^<Boolean> = (
	(* True if the receiver has at least one child. *)

	childrenDo: [:any | ^true].
	^false
)
public hasParent ^<Boolean> = (
	(* True if the receiver currently has a (direct) parent. *)

	^parent notNil
)
hierarchyLayoutReport = (
	| stream |
	stream:: CharacterReadWriteStream on: String new.
	printHierarchyLayoutReportOn: stream.
	^stream contents
)
incrementUpdateLockLevelBy: delta = (
	withAllChildrenDo: [:each | each updateLockLevel: each updateLockLevel + delta]
)
installSpy = (
	(* Install a spy that will print to the transcript the log of layout-related communication between the visual and its parent. *)

	| spy |
	parent isNil ifTrue:
		[^error: 'no parent'].
	(parent isKindOf: Visual) ifFalse:
		[^error: 'already spying'].
	spy:: InformationRetriever parent: parent child: self.
	parent installInformationRetriever: spy on: self.
	parent:: spy upwardInterceptor
)
isAreaClassLegalForSelf: aClass <Class> ^<Boolean> = (
	(* Answer whether an instance of the argument class can be used as an area of the receiver in its current parent. If the visual has no parent, assume the argument is legal (it is later checked again when the visual gets a parent). *)

	^parent isNil or:
		[((parent legalAreaClassesFor: self) select:
			[:some | aClass includesBehavior: some]) isEmpty not]
)
public isBlank ^<Boolean> = (
	^false
)
public isDescendantOf: another <Visual> ^<Boolean> = (
	(* True if the receiver is a direct or an indirect child of the argument. *)

	^parent == another or: [parent notNil and: [parent isDescendantOf: another]]
)
isMapped ^<Boolean> = (
	(* True if the receiver is mapped. This means that it has an agent with associated artifacts from the target UI framework. *)

	^agent ~~ nil and: [agent fullyMapped]
)
public isSqueezing ^<Boolean> = (
	(* True if this visual asks its children for their natural height for the given width and grants them the requested height. See also isSquishy. Note that 'squishy' is the property describing the behavior of the visual itself while 'squeezing' is the property describing the behavior of the visual with respect to its children. *)

	^area isSqueezing
)
public isSquishy ^<Boolean> = (
	(* Indicates whether it is possible that the visual's naturalHeightForWidth:, given the value of the width less than the x component of its natural extent, may be different from the y component of its natural extent. For example, text views are squishy while labels are not. Most visuals are not squishy. *)

	^false
)
public legalAreaClassesInCompositeVisual = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of CompositeVisual. *)

	^{Frame. Anchor}
)
public legalAreaClassesInFlow = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of Flow. *)

	^{Frame. Anchor}
)
public legalAreaClassesInGridRow = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of GridRow. *)

	^{GridRowCell}
)
public legalAreaClassesInHorizontalVisualSequence = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of any kind of HorizontalVisualSequence. *)

	^{RowCell}
)
public legalAreaClassesInVerticalVisualSequence = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of any kind of VerticalVisualSequence. *)

	^{ColumnCell}
)
public legalAreaClassesInWrapper = (
	(* Return a list of classes that are legal as the second parameter of the #add:in: message when adding the receiver as a child of an instance of Wrapper. *)

	^{Frame. Anchor}
)
public linkToParent: theParent <Visual> = (
	(* This message is sent to the receiver by a new parent right after the receiver has been registered as the parent's child. At the time of the call the receiver is already reported as one of the parent's #children. *)

	parent:: theParent.
	area isFuture ifTrue:
		[parent setupAreaIn: self].
	(isAreaClassLegalForSelf: area species) ifFalse:
		[error: 'the child was given an invalid area for this parent'].
	flushLayoutCaches.
	(* For our entire child subtree, we want to bring lock levels in sync with the new parentage.
	This means adjusting them all so that the receiver ends up with the same level as the parent. *)
	incrementUpdateLockLevelBy: parent updateLockLevel - updateLockLevel.
)
public localBounds ^<Rectangle> = (
	(* Answer the bounds of the receiver in the receiver's own coordinate system. The origin of the resulting rectangle is 0 @ 0 by definition. *)

	^0 @ 0 extent: extent
)
public mapSubtree = (
	(* This is sent to a newly linked child after its initial structural setup is complete (parent-child links are in place), and the parent is mapped. At this point the child should map itself using the parent's mapping. *)

	mapSubtreeUsing: desktop mapping.
	requestBoundsUpdateUsing: [:newBounds | forceBounds: newBounds]
)
mapSubtreeUsing: agentFactory <AbstractAgentFactory> = (
(* Sent by the parent (or more specifically, the parent's agent) when it is time for this visual to create a mapping agent for itself. Mapping is hierarchy operation that cascades down, and it is important to understand the mapping stages the visual is going through. See the comments throughout the method. *)

	self createAgentSubtreeUsing: agentFactory.
	agent createArtifactsForSubtree.
	self finishedMapping.
	parent agent noticeChangeInChildAgentStructure
)
public mousePoint ^<Point> = (
	(* Answer the current position of the mouse relative to the visual.
	The position is 0@0 if the visual is not mapped. *)

	^agent
		ifNil: [0 @ 0]
		ifNotNil: [:it | it mousePoint]
)
public naturalExtent ^<Point> = (
	(* Natural extent is the ideal size the component would like to have, based on its current content and parameters. *)

	^currentNaturalExtent
)
public naturalHeightForWidth: width <Number> ^<Number> = (
	(* The height the component would like to have given the specified width. Visuals such as text blocks handle this in an interesting way, for most it's simply the height of the natural extent. *)

	^naturalExtent y
)
public notifications ^<Duct> = (
	(* Answer the duct that transmits Symbols to notify about interesting occurrences in the visual's life. Clients will often find the #on:do: message convenient instead of attaching outlets to the duct 'by hand'. *)

	^duct
)
public occupyBounds: newBounds <Rectangle> = (
	(* This message is sent by the parent as an unsolicited bounds update. An unsolicited update happens when a parent updates the layout of a child without a prior request from the child to update its layout. For example, resizing a window triggers an unsolicited bounds update of the entire visual hierarchy of the window.
	A visual is free to optimize its response to this message. For example, if the visual has children and their layout is unaffected by the change in the bounds, the visual may choose not to notify them of the (no-op for them) bounds update.
	NOTE: this message is for internal framework use and is not supposed to be sent by application code. *)

	| endK |
	endK:: agent ifNotNil:
		[:it | it noteBeginningOfBoundsChangeAndProvideEndContinuation].
	[occupyBoundsResponse: newBounds]
		ensure: [endK ifNotNil: [:it | it value]]
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	(* This message is sent by the parent as an unsolicited bounds update. An unsolicited update happens when a parent updates the layout of a child without a prior request from the child to update its layout. For example, resizing a window triggers an unsolicited bounds update of the entire visual hierarchy of the window.
	A visual is free to optimize its response to this message. For example, if the visual has children and their layout is unaffected by the change in the bounds, the visual may choose not to notify them of the (no-op for them) bounds update.
	NOTE: this message is for internal framework use and is not supposed to be sent by application code. *)

	self setBounds: newBounds
)
public on: expected <Symbol> do: action <Block> ^<Outlet> = (
	(* A convenience message for associating an action with a notification broadcast by the receiver. Whenever the receiver broadcasts a notification (though its 'notifications' duct) which is equal to 'expected', the 'action' niladic block gets evaluated. The method returns the outlet attached to 'notifications' it creates to establish this association. *)

	^notifications => [:received | received = expected ifTrue: [action value]]
)
public origin ^<Point> = (
	(* Answer the coordinates of the top left corner of the visual, relative to the visual's parent. Just like the #bounds property it is derived from, extent is a read-only property. *)

	^bounds origin
)
parentMayAccommodateNaturalHeightChange ^<Boolean> = (
	(* True if the parent of this visual may change the layout if the Y component of the receiver's natural extent changes. The 'may' in the selector reflects that the method should be optimistic (favor the true response) in its assessment. *)

	^hasParent and: [area mayAccommodateVisualsNaturalHeightChange]
)
parentMayAccommodateNaturalWidthChange ^<Boolean> = (
	(* True if the parent of this visual may change the layout if the X component of the receiver's natural extent changes. The 'may' in the selector reflects that the method should be optimistic (favor the true response) in its assessment. *)

	^hasParent and: [area mayAccommodateVisualsNaturalWidthChange]
)
printHierarchyLayoutReportOn: aStream = (
	self printLayoutReportOn: aStream.
	parent ifNotNil:
		[:it |
		aStream cr.
		it printHierarchyLayoutReportOn: aStream]
)
printLayoutReportOn: aStream = (
	aStream
		print: self; cr;
		nextPutAll: 'bounds: '; print: bounds;
		nextPutAll: ' (extent: '; print: extent; nextPutAll: ')'; cr;
		nextPutAll: 'currentNE: '; print: currentNaturalExtent; cr
)
public printOn: aStream = (
	super printOn: aStream.
	aStream nextPutAll: ' in '.
	area printOn: aStream.
)
refreshLayout = (
	(* Force a complete layout update of the visual tree with the receiver as the root. *)

	flushLayoutCaches.
	requestBoundsUpdateUsing:
		[:newBounds |
		forceBounds: newBounds]
)
public reiterateBounds = (
	(* Sent to a visual by its parent as a signal that changes have occurred in the geometry of the visual tree, and while the value of bounds of the receiver is unchanged, it should behave as if they changed so that the various listeners are notified. Since the bounds are relative to the visual's parent, the visual's position relative to the window may change even when the bounds are unchanged, hence the need for this. *)

	setBounds: bounds.
	childrenDo: [:each | each reiterateBounds]
)
public releaseMouse = (
	(* Cancel a previously established mouse grab. This action has no effect if the visual is not mapped or if it is not the one that grabbed the mouse most recently. *)

	agent ifNotNil: [:it | it releaseMouse]
)
report: reportBlock = (
	| reporter |
	reporter:: HierarchicalReporter new.
	report: reportBlock using: reporter.
	^reporter contents
)
report: reportBlock using: aReporter <HierarchicalReporter> = (
	reportBlock value: self value: aReporter.
	aReporter increaseIndent.
	childrenDo:
		[:each |
		aReporter cr.
		each report: reportBlock using: aReporter].
	aReporter decreaseIndent
)
reportGeometry = (
	^report:
		[:visual :reporter |
		reporter
			print: visual;
			nextPutAll: ' (';
			print: visual bounds;
			nextPutAll: ') n.e.: ';
			print: visual naturalExtent]
)
reportGeometryToTranscript = (
	reportToTranscript:
		[:visual :reporter |
		reporter
			print: visual;
			nextPutAll: ' (';
			print: visual bounds;
			nextPutAll: ') n.e.: ';
			print: visual naturalExtent]
)
public reportNaturalExtentChange = (
	(* The receiver sends this message to itself whenever something happens that affects its natural extent. This sets layout arbitration in motion. *)

	flushLayoutCaches.
	#BOGUS yourself. (* ^^ do we need to flush the caches? removing the above seems to affect nobody. *)
	requestBoundsUpdate.
	announceNaturalExtentChange
)
reportToTranscript: reportBlock = (
	self report: reportBlock using: (HierarchicalReporter on: Transcript)
)
requestBoundsUpdate = (
	(* A visual sends this message to self in situations when it wants to receive a bounds update in the form of the #occupyBounds: message with the bounds it needs to occupy. The visual expects to ALWAYS receive that message as the result of the request, even if the bounds it receives are the bounds it already occupies. *)

	requestBoundsUpdateUsing:
		[:newBounds | occupyBounds: newBounds]
)
requestBoundsUpdateUsing: aBlock = (
	(* A visual sends this message to self in situations when it wants to receive a bounds update in the form of the #occupyBounds: message with the bounds it needs to occupy. The visual expects to ALWAYS receive that message as the result of the request, even if the bounds it receives are the bounds it already occupies. *)

	updateLockLevel < 1 ifTrue:
		[area visualRequestsBoundsUpdateUsing: aBlock]
)
setArea: newArea <Area> = (
	(* Note that we need to set the new area as the current area *before* copying the configuration over! *)

	| oldArea |
	oldArea:: area.
	area:: newArea.
	oldArea notNil ifTrue:
		[oldArea copyConfigurationTo: area]
)
setBounds: newBounds <Rectangle> = (
	boundsH value: newBounds

(* We used to do it the following way, but such update avoidance starts to look like an overly aggressive optimization with nasty-looking non-local dependencies. What especially worries me is that on Windows where the structure of native controls is different from that of visuals, effective bounds of a control may change even if its bounds (relative to the immediate parent) are unchanged. So, we are going back to simple unoptimized behavior unless it turns out to cause bad performace degradation. The old optimized code follows. --vassili, 5/23/08 *)

(* Set the bounds of the receiver, but only go through the motions if the new bounds are different from the old. Otherwise do nothing so that no bounds change notifications go out. *)

(*	(boundsH value ~= newBounds or: [parent isMapped and: [parent agent isNull]])
		ifTrue: [boundsH value: newBounds] *)
)
public setupAreaForColumn ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	All visuals use a ColumnCell to manage their position inside a column. *)

	setArea: (ColumnCell visual: self)
)
public setupAreaForCompositeVisual ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation. *)

	setArea: (Frame visual: self)
)
public setupAreaForFlow = (
	setArea: (Anchor visual: self)
)
public setupAreaForGridRow ^<Area> = (
	setArea: (GridRowCell visual: self)
)
public setupAreaForHorizontalViewport ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	All visuals use a RowCell to manage their position inside a horizontal viewport. *)

	setArea: (RowCell visual: self)
)
public setupAreaForRow ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	All visuals use a RowCell to manage their position inside a Row. *)

	setArea: (RowCell visual: self)
)
public setupAreaForVerticalViewport ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	All visuals use a ColumnCell to manage their position inside a vertical viewport. *)

	setArea: (ColumnCell visual: self)
)
public setupAreaForWindow ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	The appropriate area class for a window depends on whether the window is shrink-wrapped or not. The shrink-wrap case calls for an Anchor, which will expose the natural extent of the content as the natural extent of the window itself. Otherwise, a Frame fully covering the parent will do the job of keeping the content appropriately sized. *)

	setArea: (Frame visual: self) fullyCoverParent
)
public setupAreaForWrapper ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation.
	A Wrapper typically want to be permissive and size the child according to its desired extent, therefore Anchor is the right area for the situation. *)

	setArea: (Anchor visual: self)
)
public unlinkFromParent = (
	(* This message is sent to a visual by its parent just before the visual is removed from the list (or however the parent stores them) of parent's children. At the time of the call however, the receiver is still considered to be the child of the parent. *)

	incrementUpdateLockLevelBy: 1.
	unmapSubtree.
	parent: nil.
	flushLayoutCaches
)
public unmap = (
	(* Destroy the mappings of this visual and all of its children. This message cascades down the tree of visuals and their agents, initiated by #unmapSubtree sent to the root of the subtree being unmapped. *)

	agent notNil ifTrue:
		[agent destroy.
		agent: nil].
	childrenDo: [:each | each unmap].
	area flushLayoutCaches
)
unmapSubtree = (
	(* Destroy the mappings of this visual and all of its children. In case of native mappings, this message must only be sent to the visuals whose mappings were created in the same image session. Otherwise, use #discardMappings. *)
	self unmap.
	parent agent ifNotNil: [:it | it noticeChangeInChildAgentStructure]
)
public updateGeometricProperties = (
	currentNaturalExtent:: computeNaturalExtent
)
public visible ^<Boolean> = (
	(* True if the visual is visible locally, false otherwise. A visual with the visible property set to true will still in effect be invisible if one of the parents of this visual is invisible--that is why this attribute is called visibility in the local sense. Use #effectivelyVisible to test effective visibility of a visual. *)

	^visibleA value
)
public visible: state <Boolean> = (
	(* Set the local visibility of a visual. See the comment to the #visible accessor for an explanation of what local visibility means. *)

	visibleA value: state
)
public window ^<Window | nil> = (
	(* Answer the window instance at the top of this visual's containment hierarchy. Nil if the visual is not part of a proper hierarchy. *)

	^parent ifNotNil: [parent window]
)
windowRelativeBounds ^<Rectangle> = (
	(* Answer the bounds of the receiver in the receiver window's coordinate system. *)

(*	^localBounds translateFrom: self to: window *)
	^localBounds translateBy: self globalOrigin - window globalOrigin
)
withAllChildrenDo: aBlock <Block> = (
	(* Evaluate aBlock with the receiver and with all visuals in the transitive closure of the receiver's children. Enumeration proceeds in depth-first order. *)

	aBlock value: self.
	allChildrenDo: aBlock
)
public wrapped ^<Wrapper> = (
	(* Create a wrapper around the receiver and answer the wrapper. This is a convenience message used in creation of complex interfaces. *)

	^Wrapper with: self
)
) : (
)
public class VisualCollection = ContainerVisual (
(* VisualCollection is the abstract superclass of all visuals that are able to have an arbitrary number of children (including none). This does not include visuals such as Wrapper which do have children but the number of the children is fixed.

Instance Variables
	childrenX:		<List [Visual]> The children of the receiver, arranged in the order of increasing Z values (i.e. topmost last).
	cachedNaturalExtent:		<Point | nil> If set, the last known value of the natural extent of the receiver, defined as the smallest rectangle that contains all the children and the 0 @ 0 point. *)
|
	childrenX ::= List new.
	|) (
public add: newChild <Visual> ^<Visual> = (
	(* Add a new child to the recevier. The child becomes the topmost and will obscure any sibling it overlaps. *)

	subclassResponsibility
)
public add: newChild <Visual> in: areaClass <Class> = (
	(* Add a new child inside an area of the specified class. It is the sender's responsibility to specify a class that can indeed function as an area of the receiver's child. *)

	((legalAreaClassesFor: newChild) select:
			[:some | areaClass includesBehavior: some]) isEmpty not ifFalse:
		[error: 'invalid area class for this child in this container'].
	newChild areaClass: areaClass.
	self add: newChild.
	^newChild
)
public add: newChild <Visual> setup: setupBlock <Block> = (
	(* Add a new child to the recevier. The child becomes the topmost and will obscure any sibling it overlaps. After adding, evaluate the setup block with the newly added child as the argument. *)

	self add: newChild.
	setupBlock value: newChild.
	^newChild
)
public addAtBack: newChild <Visual> = (
	(* Add a new child to the recevier. The child becomes the bottommost and will be obscured by any sibling it overlaps. *)

	subclassResponsibility
)
public addNew: visualClass <Class> setup: setupBlock <Block> = (
	(* Create an instance of visualClass then run setupBlock with the instance as the argument. Add the instance to the receiver using #add: and return the instance. *)

	| child |
	child:: visualClass new.
	setupBlock value: child.
	add: child.
	^child
)
addNewWrapped: visualClass <Class> setup: setupBlock <Block> = (
	(* Create an instance of visualClass then run setupBlock with the instance as the argument. Add the instance to the receiver using #add: and return the instance. *)

	| child wrapper |
	child:: visualClass new.
	wrapper:: Wrapper with: child. (* arrange to have proper parent before setup *)
	setupBlock value: child.
	add: wrapper.
	^child
)
public children ^<Collection[Visual]> = (
	^childrenX
)
public childrenDo: aBlock <Block> = (
	(* Evaluate the one-argument receiver block for all direct children of the receiver. *)

	children do: aBlock
)
public flushLayoutCaches = (
	(* This message informs the receiver that something has changed that affects its visual appearance and layout. The cached value of the receiver's natural extent is now likely to be invalid. *)

	super flushLayoutCaches.
	updateGeometricProperties
)
innerBounds ^<Rectangle> = (
	(* Simple containers make all of their area available for displaying children. *)

	^0 @ 0 extent: extent
)
innerExtent ^<Point> = (
	(* Answer the inner extent of the visual, which is the extent of the area available to display the receiver's children. *)

	^innerBounds extent
)
installInformationRetriever: spy <InformationRetriever> on: child = (
	children
		at: (children indexOf: child)
		put: spy downwardInterceptor
)
public remove: aChild <Visual> = (
	(* Remove the child from the collection of the receiver's children. The argument must be the receiver's child at the time of the call or an error will occur. *)

	subclassResponsibility
)
public setupAreaForWrapper ^<Area> = (
	(* This is a part of the double dispatch exchange that configures a visual with an area appropriate for the visual and its parent. The selector encodes the class of the parent the visual has just been added to. The implementation should create and set (by sending setArea:) an instance of a subclass of Area appropriate for the situation. *)

	setArea: (Frame visual: self) fullyCoverParent
)
public size = (
	^children size
)
) : (
)
class VisualSequence = VisualCollection (
(* This is the abstract superclass of VisualCollections that arrange their children one after another horizontally or vertically, i.e. rows and columns. It captures the behavior common to both rows and columns by factoring the selection of the X or Y dimensions of all measurements into messages #principalOf: and #orthogonalOf: sent to the receiver.

The principal dimension is the one along which the children are positioned: X for a row-like visual and Y for a column-like one.

A child of VisualSequence is expected to use an Area which is a subclass of SequenceCell, or supports a compatible protocol.

Instance Variables
	gapA:		<Attribute with: Integer> The number of pixels to leave between the children; 0 by default. [NOTE: this attribute is DEPRECATED and will be removed. Use explicit blanks instead.] *)
|
	gapA ::= Attribute name: #gap value: 0.
	cachedNaturalHeightWidth
	cachedNaturalHeightForWidth
	|) (
public add: child = (
	^restructuring:
		[self privateAdd: child using: [children add: child]]
)
public add: child <Visual> after: existing <Visual> = (
	^restructuring:
		[privateAdd: child using: [children add: child after: existing]]
)
public add: child <Visual> afterIndex: index <Integer> = (
	^restructuring:
		[privateAdd: child using: [children add: child afterIndex: index]]
)
public add: child <Visual> before: existing <Visual> = (
	^restructuring:
		[privateAdd: child using: [children add: child before: existing]]
)
public add: child <Visual> beforeIndex: index <Integer> = (
	^restructuring:
		[privateAdd: child using: [children add: child beforeIndex: index]]
)
public addAtBack: child = (
	^restructuring:
		[self privateAdd: child using: [children addFirst: child]]
)
addBlank = (
	(* Add a new Blank of elasticity 0 to the receiver. Answer the blank. *)

	^add: Blank new
)
public addBlankSize: size <Integer> = (
	(* Add a new Blank of the given size. Answer the blank. *)

	^addNew: Blank setup: [:blank | blank area principalSize: size]
)
public addElasticBlank = (
	(* Add a new Blank of elasticity 1 to the receiver. Answer the blank. *)

	^addNew: Blank
		setup: [:blank | blank area expansibility: 1]
)
public addFirst: newChild <Visual> = (
	^self addAtBack: newChild
)
public at: index <Integer> ^<Visual> = (
	^children at: index
)
public at: index <Integer> put: child <Visual> = (
	#BOGUS yourself. (* optimize this to avoid a double update *)
	remove: (at: index).
	^add: child beforeIndex: index
)
public child: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* The case when the receiver has no elastic children (or ignores their elasticity) offers many optimization opportunities and is handled separately. *)

	hasElasticChildren
		ifTrue: [childInElasticLineup: child requestsBoundsUpdateUsing: continuation]
		ifFalse: [childInRigidLineup: child requestsBoundsUpdateUsing: continuation]
)
public childInElasticLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* An update request has been received from a child, and elasticity is present in our layout. The changes in the child may have affected other children. The receiver's layout needs to be fully recomputed.
	There may be some optimization opportunities here, but they need to be carelly thought through. For now just recompute everything. *)

	| oldNaturalExtent |
	cachedNaturalHeightWidth: nil.
	oldNaturalExtent:: naturalExtent.
	updateGeometricProperties.
	requestBoundsUpdateUsing:
		[:newBounds |
		setBounds: newBounds.
		repositionAllChildrenByRequestFrom: child using: continuation.
		currentNaturalExtent = naturalExtent
			ifFalse: [announceNaturalExtentChange]]
)
public childInRigidFixedLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* Rigid means we have no elastic children and updates are limited to the changed child and those that follow. Fixed means we are not squeezing the child. *)

	| oldNaturalExtent |
	oldNaturalExtent:: naturalExtent.
	updateGeometricProperties.
	cachedNaturalHeightWidth: nil.
	naturalExtent = oldNaturalExtent
		ifTrue:
			[repositionChildrenStartingWith: child using: continuation]
		ifFalse:
			[requestBoundsUpdateUsing:
				[:newBounds | | crossSizeChanged |
				crossSizeChanged:: (orthogonalOf: bounds extent) ~= (orthogonalOf: newBounds extent).
				setBounds: newBounds.
				crossSizeChanged
					ifTrue: [repositionAllChildrenByRequestFrom: child using: continuation]
					ifFalse: [repositionChildrenStartingWith: child using: continuation]].
			announceNaturalExtentChange]
)
public childInRigidLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	(* Knowing that we have no elasticity, we can predict the effects of this layout change and isolate the update activity. Often, only the requestor child and those that follow it in the sequence need be perturbed. *)

	(isSqueezing and: [child area isVisualSquishy])
		ifTrue:
			[childInRigidSquishyLineup: child requestsBoundsUpdateUsing: continuation]
		ifFalse:
			[childInRigidFixedLineup: child requestsBoundsUpdateUsing: continuation]
)
public childInRigidSquishyLineup: child <Visual> requestsBoundsUpdateUsing: continuation <Block> = (
	| oldNaturalExtent |
	(* >>> *) cachedNaturalHeightWidth: nil.
	oldNaturalExtent:: naturalExtent.
	updateGeometricProperties.
	requestBoundsUpdateUsing:
		[:newBounds | | crossSizeChanged |
		crossSizeChanged::
			(orthogonalOf: bounds extent) ~= (orthogonalOf: newBounds extent).
		setBounds: newBounds.
		crossSizeChanged
			ifTrue: [repositionAllChildrenByRequestFrom: child using: continuation]
			ifFalse: [repositionChildrenStartingWith: child using: continuation]].
	naturalExtent = oldNaturalExtent ifFalse:
		[announceNaturalExtentChange]
)
childRectangleFrom: base <Integer> size: size <Integer> ^<Rectangle> = (
	(* Create and answer a rectangle which begins at the 'base' position along the principal axis of the receiver and has the size of 'size', occupying all space available along the orthogonal axis. *)

	subclassResponsibility
)
public children: newChildren <Collection[Visual]> = (
	(* Batch replace the current children of the visual. *)

	restructuring:
		[privateRemoveAllChildren.
		privateSetChildren: newChildren].
	announceNaturalExtentChange
)
public computeNaturalExtent ^<Point> = (
	(* The natural extent of a visual sequence is the sum of natural extents of its children along the principal axis, plus the gaps, and the maximum of the natural extents of the children along the orthogonal axis. *)

	| principalSum gapSum orthogonalMax |
	principalSum: 0.
	orthogonalMax: 0.
	childrenDo:
		[:each | | eachTarget |
		eachTarget: each area naturalExtent.
		each area lastKnownNaturalExtent: eachTarget.
		principalSum: principalSum + (principalOf: eachTarget).
		orthogonalMax:: orthogonalMax max: (orthogonalOf: eachTarget)].
	gapSum: (children size - 1 max: 0) * gap.
	^pointPrincipal: principalSum + gapSum orthogonal: orthogonalMax
)
public computeNaturalHeightForWidth: size <Number> ^ <Number> = (
	subclassResponsibility
)
createAgentUsing: aMapping = (
	aMapping createAgentForVisualSequence: self
)
public flushLayoutCaches = (
	cachedNaturalHeightWidth: nil.
	children do:
		[:each | each area flushLayoutCaches].
	super flushLayoutCaches
)
public forceBoundsResponse: newBounds <Rectangle> = (
	super forceBoundsResponse: newBounds.
	repositionAllChildrenByForce: true
)
gap ^<Integer> = (
	^gapA value
)
public gap: newGap <Integer> = (
	| oldNaturalExtent |
	oldNaturalExtent:: naturalExtent.
	gapA value: newGap.
	cachedNaturalHeightWidth: nil.
	updateGeometricProperties.
	repositionAllChildrenByForce: false.
	oldNaturalExtent ~= naturalExtent
		ifTrue: [announceNaturalExtentChange]
)
hasElasticChildren ^<Boolean> = (
	(* Subclasses that do not honor children elasticity should override this to answer false. *)

	childrenDo:
		[:each |
		(each area isFuture not and: [each area isElastic]) ifTrue: [^true]].
	^false
)
indexOf: child <Visual> = (
	(* Return the index of the visual in the sequence of children (one-based).
	Fail if the argument is not a child. *)

	children keysAndValuesDo:
		[:index :each |
		each == child ifTrue: [^index]].
	error: 'the argument is not a child of the receiver'
)
public isSquishy = (
	childrenDo:
		[:each |
		each area isVisualSquishy ifTrue: [^true]].
	^false
)
public naturalHeightForWidth: width = (
	cachedNaturalHeightWidth = width ifFalse:
		[cachedNaturalHeightWidth:: width.
		cachedNaturalHeightForWidth:: computeNaturalHeightForWidth: width].
	^cachedNaturalHeightForWidth
)
public occupyBoundsResponse: newBounds <Rectangle> = (
	(* An unsolicited layout update: see superclass methods for a detailed discussion. *)

	| oldExtent |
	oldExtent: innerExtent.
	super occupyBoundsResponse: newBounds.
	oldExtent = innerExtent
		ifTrue:
			[childrenDo: [:each | each reiterateBounds]]
		ifFalse:
			[hasElasticChildren
				ifTrue: [repositionAllChildrenWithElasticityByForce: false]
				ifFalse:
					(* In the absense of elasticity, child layout can only change if the cross size of the parent changes. *)
					[(orthogonalOf: oldExtent) = (orthogonalOf: innerExtent) ifFalse:
						[repositionAllChildrenWithNoElasticityByForce: false]]]
)
orthogonalOf: aPoint <Point> ^<Number> = (
	(* Return the orthogonal component (Y for a row, X for a column) of the argument. *)

	subclassResponsibility
)
orthogonalSize ^<Number> = (
	(* Return the size of the visual along the orthogonal (Y for a row, X for a column) axis. *)

	^orthogonalOf: extent
)
pointPrincipal: principalSize orthogonal: orthogonalSize ^<Point> = (
	(* Create a point with the components as given. *)

	subclassResponsibility
)
principalOf: aPoint <Point> ^<Number> = (
	(* Return the principal component (X for a row, Y for a column) of the argument. *)

	self subclassResponsibility
)
principalSize ^<Number> = (
	(* Return the size of the visual along the principal (X for a row, Y for a column) axis. *)

	^principalOf: extent
)
public privateAdd: child <Visual> using: modifier <Block> = (
	modifier value.
	child linkToParent: self.
	cachedNaturalHeightWidth: nil.
	isMapped ifTrue:
		[updateGeometricProperties.
		requestBoundsUpdateUsing:
			[:newBounds |
			(bounds = newBounds and: [hasElasticChildren not])
				ifTrue:
					[setPositionOfNewlyInserted: child]
				ifFalse:
					[boundsH value: newBounds.
					repositionAllChildrenByForce: false]].
		child mapSubtree].
	announceNaturalExtentChange.
	^child
)
privateRemoveAllChildren = (
	(* A batch removal of all the receiver's children. *)

	| formerChildren |
	formerChildren:: childrenX.
	childrenX:: List new.
	formerChildren do: [:each |	each unlinkFromParent].
	cachedNaturalHeightWidth: nil.
	updateGeometricProperties.
	requestBoundsUpdateUsing:
		[:newBounds |
		boundsH value: newBounds]
)
privateSetChildren: newChildren <Collection[Visual]> = (
	(* A batch assignment of the receiver's children. Note that this is a private method that does not properly remove the existing children! *)

	childrenX:: newChildren.
	childrenX do:
		[:each | each linkToParent: self].
	cachedNaturalHeightWidth: nil.
	isMapped ifTrue:
		[updateGeometricProperties.
		requestBoundsUpdateUsing:
			[:newBounds |
			boundsH value: newBounds.
			repositionAllChildrenByForce: true].
		children do: [:each | each mapSubtree]].
	^childrenX
)
public remove: aChild <Visual> = (
	(* Remove the child from the collection of the receiver's children. The argument must be the receiver's child at the time of the call or an error will occur. *)

	| hadElasticChildren index shift |
	hadElasticChildren:: hasElasticChildren.
	index:: indexOf: aChild.
	shift:: (principalOf: aChild extent) + gap.
	restructuring:
		[children remove: aChild.
		aChild unlinkFromParent.
		cachedNaturalHeightWidth: nil.
		updateGeometricProperties.
		requestBoundsUpdateUsing:
			[:newBounds |
			(bounds = newBounds and: [hadElasticChildren not])
				ifTrue:
					[shiftChildrenAtAndAfter: index by: shift negated]
				ifFalse:
					[boundsH value: newBounds.
					repositionAllChildrenByForce: false]]].
		announceNaturalExtentChange
)
public removeAll = (
	(* Remove all of the receiver's children. *)

	| formerChildren |
	formerChildren:: children.
	restructuring:
		[childrenX:: List new.
		formerChildren do: [:each | each unlinkFromParent].
		cachedNaturalHeightWidth: nil.
		updateGeometricProperties.
		requestBoundsUpdateUsing:
			[:newBounds |
			boundsH value: newBounds]].
	announceNaturalExtentChange
)
public removeAt: index <Integer> = (
	(* Remove the child at the given index from the collection of the receiver's children.
	The argument must be within the meaningful range [1..n] at the time of the call or an error will occur. *)

	remove: (at: index)
)
public reorder: visuals = (
	(* Make the order of the elements match that of the argument collection. The argument must include all elements already in the sequence, only in a different order. *)

	(visuals reject: [:ea| children includes: ea]) isEmpty ifFalse: [error: 'bad argument'].
	childrenX:: visuals asMutableArrayList.
	repositionAllChildrenByForce: false
)
repositionAllChildrenByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver and notify the children of their new effective bounds. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children. *)

	hasElasticChildren
		ifTrue: [repositionAllChildrenWithElasticityByForce: force]
		ifFalse: [repositionAllChildrenWithNoElasticityByForce: force]
)
repositionAllChildrenByRequestFrom: child <Visual> using: continuation <Block> = (
	(* Recompute the layout of all children of the receiver and notify them of their new layout. Use the continuation block passed as the second argument to notify the child passed as the first argument. Send #occupyBounds: to all other children.
	The implementation of this method is largely the same for horizontal and vertical sequences and could all be done here, with coordinate differences factored out. However, for perfomance and simplicity of individual methods, we declare this a subclass responsibility and provide custom implementations in subclasses. *)

	subclassResponsibility
)
repositionAllChildrenWithElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver, taking children elasticity into account. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	The implementation of this method is largely the same for horizontal and vertical sequences and could all be done here, with coordinate differences factored out. However, for perfomance and simplicity of individual methods, we declare this a subclass responsibility and provide custom implementations in subclasses. *)

	subclassResponsibility
)
repositionAllChildrenWithNoElasticityByForce: force <Boolean> = (
	(* Recompute the layout of all children of the receiver in a sitiuation when we do not need to take elasticity into account. Notify all the children of their new effective bounds. Depending on the value of force, use either the soft #occupyBounds: or the hard #forceBounds: to communicate the new bounds to the children.
	The implementation of this method is largely the same for horizontal and vertical sequences and could all be done here, with coordinate differences factored out. However, for perfomance and simplicity of individual methods, we declare this a subclass responsibility and provide custom implementations in subclasses. *)

	subclassResponsibility
)
repositionChildrenStartingWith: child <Visual> using: continuation <Block> = (
	(* In the course of an update, we determined that only the given child and those that follow it in the sequence need to be repositioned. Furthermore, if the size of the child is unchanged, those that follow remain where they are and need not be touched.
	The implementation of this method is largely the same for horizontal and vertical sequences and could all be done here, with coordinate differences factored out. However, for perfomance and simplicity of individual methods, we declare this a subclass responsibility and provide custom implementations in subclasses. *)

	subclassResponsibility
)
setPositionOfNewlyInserted: child <Visual> = (
	(* The implementation of this method is largely the same for horizontal and vertical sequences and could all be done here, with coordinate differences factored out. However, for perfomance and simplicity of individual methods, we declare this a subclass responsibility and provide custom implementations in subclasses. *)

	subclassResponsibility
)
shiftChildrenAtAndAfter: index <Integer> by: shift <Integer> = (
	(* Somewhere in layout update, we figured that the update can be optimized to moving all children at the specified index and those that follow it, without actually computing their layout. A positive 'shift' value moves the children down or to the right. *)

	index to: children size do:
		[:i | | child |
		child:: children at: i.
		child occupyBounds: (shiftRectangle: child bounds by: shift)]
)
shiftRectangle: rect <Rectangle> by: shift <Integer> ^<Rectangle> = (
	(* Answer a new rectangle which is the first argument shifted by 'shift' pixels along the principal axis of the receiver. *)

	subclassResponsibility
)
public updateGeometricProperties = (
	cachedNaturalHeightWidth:: nil.
	super updateGeometricProperties
)
) : (
)
public postInit = (
	Attribute:: Future computing: [plumbing Attribute].
	ShapeArea:: areas ShapeArea.
	FutureArea:: areas FutureArea.
	MappableHolder:: Future computing: [plumbing MappableHolder].
	InformationRetriever:: plumbing InformationRetriever.
	Frame:: areas Frame.
	Anchor:: areas Anchor.
	GridRowCell:: areas GridRowCell.
	RowCell:: areas RowCell.
	ColumnCell:: areas ColumnCell.
	HierarchicalReporter:: plumbing HierarchicalReporter.
	Wrapper:: containers Wrapper.
	Blank:: widgets Blank.
)
) : (
)
class WidgetClasses = (
(* The former category Brazil-Visuals-Widgets *)
|
	private LeafVisual = visuals LeafVisual.
	private BoxShape = visuals BoxShape.
	private Shape = visuals Shape.
	private Attribute = Future computing: [plumbing Attribute].
	private Anchor = areas Anchor.
	private Font = plumbing Font.
	private LineArea = areas LineArea.
	private PolygonArea = areas PolygonArea.
	private Frame = areas Frame.
	private MappableHolder = Future computing: [plumbing MappableHolder].
	|) (
public class ActiveIcon = Icon (
(* ActiveIcon is a clickable icon that changes appearance with mouse actions. In addition to the ''main'' image inherited from Icon, an instance may be configured with secondary images. The main image is the one displayed in the normal button state. The ''hover'' image replaces the main when the mouse is within the bounds of the icon. The ''down'' image is displayed when the mouse is depressed while the pointer is inside the icon. The ''disabled'' image is displayed when the 'enabled' attribute of the icon is false.

Any of the images may be nil. If a secondary image (hover, down or disabled) is nil, the main one is displayed instead. If the main image is also nil, nothing is displayed.

An active icon also has the action, which is a zero-argument block invoked when the icon is clicked (on a mouse up event). *)
|
	public disabledImageA ::= Attribute name: #disabledImage value: nil.
	public hoverImageA ::= Attribute name: #hoverImage value: nil.
	public downImageA ::= Attribute name: #downImage value: nil.
	public enabledA ::= Attribute name: #enabled value: true.
	public actOnMouseDownA ::= Attribute name: #actOnMouseDown value: false.
	public action
	|) (
public actOnMouseDown = (
	^actOnMouseDownA value
)
public actOnMouseDown: newValue <Boolean> = (
	actOnMouseDownA value: newValue
)
createAgentUsing: aMapping = (
	aMapping createAgentForActiveIcon: self
)
public disabledImage = (
	^disabledImageA value
)
public disabledImage: aForm = (
	disabledImageA value: aForm
)
public doAction = (
	enabled ifTrue:
		[action ifNotNil: [action value]]
)
public downImage = (
	^downImageA value
)
public downImage: aForm = (
	downImageA value: aForm
)
public enabled = (
	^enabledA value
)
public enabled: aBoolean = (
	enabledA value: aBoolean
)
public hoverImage = (
	^hoverImageA value
)
public hoverImage: aForm = (
	hoverImageA value: aForm
)
) : (
)
public class Blank = LeafVisual (
(* A blank is a no-visual. It has no visible representation or behavior. It is typically not mapped to any components of the underlying UI library.

Blanks are useful as placeholders in the layout, most often as elastic components in rows and columns used to center or right-align other elements. They are also useful as a ''visual nil'', that is as a visual used as the default content of a wrapper or a window. *)
) (
public childrenDo: aBlock = ()
public computeNaturalExtent ^<Point> = (
	^0 @ 0
)
createAgentUsing: aMapping = (
	aMapping createAgentForBlank: self
)
public isBlank ^<Boolean> = (
	^true
)
public naturalExtent = (
	^0 @ 0
)
) : (
)
public class Button = LeafVisual (
(* PushButton will be renamed to Button when Newspeak gets a module system. (The name Button is already taken in the global namespace). *)
|
	public labelA ::= Attribute name: #label value: 'unnamed'.
	public enabledA ::= Attribute name: #enabled value: true.
	public action
	|affectsNaturalExtent: labelA) (
public computeNaturalExtent ^<Point> = (
	^agent isNil
		ifTrue: [80 @ 25]
		ifFalse: [agent naturalExtent]
)
createAgentUsing: aMapping = (
	aMapping createAgentForPushButton: self
)
public doAction = (
	action ifNotNil: [:it | it value]
)
public enabled ^<Boolean> = (
	^enabledA value
)
public enabled: newState <Boolean> = (
	enabledA value: newState
)
public label ^<String> = (
	^labelA value
)
public label: newLabel <String> = (
	labelA value: newLabel
)
public naturalExtent = (
	^agent isNil
		ifTrue: [80 @ 25]
		ifFalse: [agent naturalExtent]
)
public setupAreaForCompositeVisual = (
	setArea: (Anchor visual: self)
)
) : (
)
public class EllipseShape = BoxShape () (
createAgentUsing: aMapping = (
	aMapping createAgentForEllipseShape: self
)
) : (
)
public class Hyperlink = Label (
(* A hyperlink is similar to a PushButton in having the 'action' property that gets invoked when the label is clicked (more precisely, when the mouse is released over the link after being pressed over it), but it is rendered as an underlined string line. A hyperlink may potentially be mapped to an OS widget if the host OS supports it.

   Copyright 2008 Cadence Design Systems, Inc.

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0
*)
|
	hoverColorA ::= Attribute name: #hoverColor value: standardHyperlinkColor.
	downColorA ::= Attribute name: #downColor value: standardHyperlinkColor.
	public underlineNormal ::= false.
	public underlineHover ::= true.
	public action
	public dragTracker
	|label: 'a hyperlink'.
	color: standardHyperlinkColor) (
changeColorTo: newColor <Color> = (
	(* Change the visual color without changing the value of the color attribute. *)

	colorA value: newColor
)
createAgentUsing: aMapping = (
	aMapping createAgentForHyperlink: self.
)
public doAction = (
	action ifNotNil: [action value]
)
public downColor ^<Color> = (
	^downColorA value
)
public downColor: newColor <Color> = (
	downColorA value: newColor
)
public hoverColor ^<Color> = (
	^hoverColorA value
)
public hoverColor: newColor <Color> = (
	hoverColorA value: newColor
)
standardHyperlinkColor = (
	^Color h: 240 s: 1 v: 0.9
)
) : (
)
public class Icon = LeafVisual (
(* An Icon is a static graphical label. The 'image' attribute contains the Squeak Form displayed as the visual image. The natural extent of an icon is the extent of the form. The image may be nil, in which case nothing is displayed. The natural extent of such an icon is 0@0. *)
|
	public imageA ::= Attribute name: #image value: nil.
|) (
public computeNaturalExtent ^<Point> = (
	^image ifNotNil: [image extent] ifNil: [0 @ 0]
)
createAgentUsing: aMapping = (
	aMapping createAgentForIcon: self
)
public image ^<Form | nil> = (
	^imageA value
)
public image: aForm = (
	| oldExtent |
	oldExtent:: naturalExtent.
	imageA value: aForm.
	oldExtent = naturalExtent ifFalse:
		[self reportNaturalExtentChange]
)
public naturalExtent = (
	^image ifNotNil: [:it | it extent] ifNil: [0 @ 0]
)
public setupAreaForCompositeVisual = (
	setArea: (Anchor visual: self)
)
) : (
)
public class Label = LeafVisual (
(* A Label is a textual label. *)
|
	public textA ::= Attribute name: #text value: 'a label'.
	public fontA ::= Attribute name: #font value: Font normal.
	public colorA ::= Attribute name: #color value: Color black.
	|affectsNaturalExtent: textA) (
public color ^<Color> = (
	^colorA value
)
public color: newColor <Color> = (
	colorA value: newColor
)
public computeNaturalExtent ^<Point> = (
	^agent isNil
		ifTrue: [80 @ 25]
		ifFalse: [agent naturalExtent]
)
createAgentUsing: aMapping = (
	aMapping createAgentForLabel: self.
)
public font ^<Font> = (
	^fontA value
)
public font: newFont <Font> = (
	fontA value: newFont
)
public isActive = (
	^false
)
public label ^<String> = (
	(* Backward compatibility. *)

	^text
)
public label: newLabel <String> = (
	(* Backward compatibility. *)

	self text: newLabel
)
public naturalExtent = (
	^agent isNil
		ifTrue: [80 @ 25]
		ifFalse: [agent naturalExtent]
)
public printOn: aStream = (
	super printOn: aStream.
	aStream
		space;
		print: label
)
public setupAreaForCompositeVisual = (
	setArea: (Anchor visual: self)
)
public text ^<Text> = (
	^textA value
)
public text: newLabel <Text> = (
	textA value: newLabel
)
) : (
)
public class LineShape = LeafVisual (
(* This shape represents a line of a given color and width.

NOTE: The start and end points are currently held onto by the line itself, however we are changing those to be maintained by the area. *)
|
	colorA ::= Attribute name: #color value: Color black.
	widthA ::= Attribute name: #width value: 1.
	|) (
color ^<Color> = (
	^colorA value
)
public color: newColor <Color> = (
	colorA value: newColor
)
public computeNaturalExtent ^<Point> = (
	^(area endPoint - area startPoint) abs
)
createAgentUsing: aMapping = (
	aMapping createAgentForLineShape: self
)
public legalAreaClassesInCompositeVisual = (
	^{LineArea}
)
public naturalExtent = (
	^computeNaturalExtent
)
public setupAreaForCompositeVisual ^<Area> = (
	setArea: (LineArea visual: self)
)
width ^<Integer> = (
	^widthA value
)
width: newWidth <Integer> = (
	widthA value: newWidth
)
) : (
)
public class ListBox = LeafVisual (
(* A list of objects displayed as a sequence of strings. The string to show for each object is computed by the displayBlock. By default, the object's printString is displayed.

Mappable properties:

objectsHolder <MappableHolder[Sequence]>
selectionIndexHolder <MappableHolder[Integer]>
showHScrollbarA <Attribute[Boolean | nil]> The nil value means show or hide as necessary.
showVScrollbarA <Attribute[Boolean | nil]>

Notifications:

doubleClickAction <[] | nil> If not nil, a block to invoke when a list item is double-clicked. *)
|
	public showHScrollbarA ::= Attribute name: #showHScrollbar value: nil.
	public showVScrollbarA ::= Attribute name: #showVScrollbar value: nil.

 	public objectsHolder ::= MappableHolder with: Array new.
	public displayBlock ::= [:object | object printString].
	public selectionIndexHolder ::= MappableHolder with: 0.
	public selectionChanged ::= selectionIndexHolder changed transformedUsing:
		[:index | (index = 0 ifTrue: [nil] ifFalse: [list at: index])].
	public menuBlock
	public doubleClickAction
	|) (
public computeNaturalExtent ^<Point> = (
	#BOUGS yourself.
	^100 @ (list size * 15)
)
createAgentUsing: agentFactory = (
	agentFactory createAgentForListBox: self
)
hasSelection ^<Boolean> = (
(* Answer true if there is an item selected. *)
^selectionIndex ~= 0
)
public list ^<SequenceableCollection> = (
(* Old API; redirect to standard. *)
^objects
)
public list: list <SequenceableCollection> = (
(* Old API, redirect to standard. *)
self objects: list
)
menu ^<Menu | nil> = (
	^menuBlock value
)
public naturalExtent ^<Point> = (
	^100 @ (list size * 15) (* BOGUS *)
)
objects ^<SequenceableCollection> = (
	^objectsHolder value
)
objects: sequence <SequenceableCollection> = (
(* Change the sequence displayed by the visual to be the one passed as the argument. Preserve the original selection if possible (select an object that is = to the selection at the time of the change). *)
| originalSelection |
originalSelection:: selection.
objectsHolder value: sequence.
select: originalSelection
)
public objectsAsStrings ^<Collection[String]> = (
(* Answer the current object sequence with all elements coerced to Strings. This message is expected to be sent from the agent. *)
^objects collect: displayBlock
)
select: anObject <Object> = (
(* Select the object passed as the argument or clear the selection if the object is not in the sequence. *)
selectIndex: (objects indexOf: anObject)
)
public selectIndex: index <Integer> = (
(* Select the item at the specified index, but only if the index is valid, i.e. is either 0 or lies within the current object sequence. *)
(index between: 0 and: objects size) ifTrue:
	[selectionIndexHolder value: index]
)
public selection ^<Object | nil> = (
(* Return the currently selected object, or nil if there is no selection. *)
| index stuff |
index:: selectionIndex.
stuff:: objects.
^(index between: 1 and: stuff size)
	ifTrue: [stuff at: index]
	ifFalse: [nil]
)
selectionDo: aBlock <Block> = (
	(* Evaluate aBlock with the currently selected object as the argument, if there is an object selected. *)

	^(selectionIndex between: 1 and: objects size)  ifTrue:
		[aBlock value: (objects at: selectionIndex)]
)
public selectionIndex ^<Integer> = (
(* Answer a 1-based index of the currently selected item. Answer 0 if there is no selection. *)
^selectionIndexHolder value
)
showHScrollbar ^<Boolean | nil> = (
	(* true means show always, false means hide always, nil means show if necessary. *)

	^showHScrollbarA value
)
showHScrollbar: newState <Boolean | nil> = (
	(* true means show always, false means hide always, nil means show if necessary. *)

	showHScrollbarA value: newState
)
showVScrollbar ^<Boolean | nil> = (
	(* true means show always, false means hide always, nil means show if necessary. *)

	^showVScrollbarA value
)
showVScrollbar: newState <Boolean | nil> = (
	(* true means show always, false means hide always, nil means show if necessary. *)

	showVScrollbarA value: newState
)
) : (
)
public class PolygonShape = Shape (
(* A polygon defined by the collection of vertices held onto by the area. *)
) (
public computeNaturalExtent ^<Point> = (
	^area suggestedParentExtent
)
createAgentUsing: aMapping = (
aMapping createAgentForPolygonShape: self
)
public legalAreaClassesInCompositeVisual = (
^{PolygonArea}
)
public naturalExtent ^<Point> = (
^computeNaturalExtent
)
public setupAreaForCompositeVisual ^<Area> = (
	setArea: (PolygonArea visual: self)
)
) : (
)
public class RectangleShape = BoxShape () (
createAgentUsing: aMapping = (
	aMapping createAgentForRectangleShape: self
)
) : (
)
public class RoundedRectangleShape = BoxShape (
(* This shape renders itself as a rectangle with rounded corners, so some approximation on systems which cannot reasonably do that (i.e. Morphic). *)
|
	cornerRadiusA ::= Attribute name: #cornerRadius value: 5.
	|) (
public cornerRadius ^<Number> = (
	^cornerRadiusA value
)
public cornerRadius: newRadius <Number> = (
	cornerRadiusA value: newRadius
)
createAgentUsing: aMapping = (
	aMapping createAgentForRoundedRectangleShape: self
)
) : (
)
public class SensitiveIcon = Icon (
(* This icon class adds to the superclass the ability to sense and respond to mouse events such as button presses and mouse movement. *)
|
	public entryAction
	public exitAction
	public mouseDownAction
	public mouseUpAction
	public mouseMovedAction
|) (
createAgentUsing: aMapping = (
	aMapping createAgentForSensitiveIcon: self
)
mouseDownLeftResponse: response <Block> = (
mouseDownAction:: response
)
mouseEntryResponse: response <Block> = (
entryAction:: response
)
mouseExitResponse: response <Block> = (
exitAction:: response
)
mouseMoveResponse: response <Block> = (
mouseMovedAction:: response
)
mouseUpLeftResponse: response <Block> = (
mouseUpAction:: response
)
respondToMouseDownLeft = (
	mouseDownAction ifNotNil: [:it | it value]
)
respondToMouseEntry = (
	entryAction ifNotNil: [:it | it value]
)
respondToMouseExit = (
	exitAction ifNotNil: [:it | it value]
)
respondToMouseMove = (
	mouseMovedAction ifNotNil: [:it | it value]
)
respondToMouseUpLeft = (
	mouseUpAction ifNotNil: [:it | it value]
)
) : (
)
class SensitiveLabel = Label (
(* A sensitive label is a Label that listens to mouse input events. *)
|
	public entryAction
	public exitAction
	public mouseDownAction
	public mouseUpAction
	public mouseMovedAction
|) (
createAgentUsing: aMapping = (
	aMapping createAgentForActiveLabel: self.
)
isActive = (
^true
)
mouseDownLeftResponse: response <Block> = (
mouseDownAction:: response
)
mouseEntryResponse: response <Block> = (
entryAction:: response
)
mouseExitResponse: response <Block> = (
exitAction:: response
)
mouseMoveResponse: response <Block> = (
mouseMovedAction:: response
)
mouseUpLeftResponse: response <Block> = (
mouseUpAction:: response
)
respondToMouseDownLeft = (
	mouseDownAction ifNotNil: [:it | it value]
)
respondToMouseEntry = (
	entryAction ifNotNil: [:it | it value]
)
respondToMouseExit = (
	exitAction ifNotNil: [:it | it value]
)
respondToMouseMove = (
	mouseMovedAction ifNotNil: [:it | it value]
)
respondToMouseUpLeft = (
	mouseUpAction ifNotNil: [:it | it value]
)
) : (
)
public class TextDisplay = LeafVisual (|
	public textA ::= Attribute name: #text value: String new.
	public fontA ::= Attribute name: #font value: Font normal.
	|affectsNaturalExtent: textA.
	affectsNaturalExtent: fontA) (
public computeNaturalExtent ^<Point> = (
	^isMapped
		ifTrue: [agent naturalExtent]
		ifFalse: [0 @ 0]
)
createAgentUsing: aMapping = (
	aMapping createAgentForTextDisplay: self
)
public font ^<Font> = (
	^fontA value
)
public font: newFont <Font> = (
	fontA value: newFont
)
public isSquishy ^<Boolean> = (
	^true
)
public naturalExtent = (
	^isMapped
		ifTrue: [agent naturalExtent]
		ifFalse: [0 @ 0]
)
public naturalHeightForWidth: size <Number> ^<Number> = (
	^agent
		ifNil: [0]
		ifNotNil: [agent naturalHeightForWidth: size]
)
public setupAreaForWrapper ^<Area> = (
	setArea: (Frame visual: self) fullyCoverParent
)
public text ^<String> = (
	^textA value
)
public text: aString <String> = (
	textA value: aString
)
) : (
)
public class TextView = LeafVisual (
(* Renders itself as an editable text view. *)
|
	public textA ::= Attribute name: #text value: String new.
	public fontA ::= Attribute name: #font value: Font normal.
	public suppressScrollbarsA ::= Attribute name: #suppressScrollbars value: false.
	hasChangesH ::= Holder with: false.
	public verticalScrollPositionHolder = Holder with: 0.
	public menuBlock
	public enterKeyResponse
	public escapeKeyResponse
	public acceptKeyResponse
	postMapActions ::= List new.
	|affectsNaturalExtent: fontA) (
acceptText: text = (
^false
)
public acceptTextFromAgent: text = (
	textA acceptValueFromMapping: text.
	agent hasUnacceptedEdits ifTrue:
		[hasChangesH value: true]
)
append: aString = (
	self text: text, aString.
	agent ifNotNil: [:it | it scrollToEnd]
)
clearHasEditsFromUserFlag = (
	hasChangesH value: false
)
public computeNaturalExtent ^<Point> = (
	^agent
		ifNil: [0 @ 0]
		ifNotNil: [agent naturalExtent]
)
createAgentUsing: aMapping = (
	^aMapping createAgentForTextView: self
)
public finishedMapping = (
	super finishedMapping.
	postMapActions do: [:each | each value].
)
public font ^<Font> = (
	^fontA value
)
public font: newFont <Font> = (
	fontA value: newFont
)
hasChangesChannel ^<Duct> = (
	(* Backward compatibility -- this message has been renamed for clarity. Please use #hasEditsFromUserChannel. *)

	^hasEditsFromUserChannel
)
hasEditsFromUser ^<Boolean> = (
	(* Reply whether the editor has changes made by the user since the text has last been set using #text:, or since the #clearHasChangesFlag message was last sent. *)

	^hasChangesH value
)
public hasEditsFromUserChannel ^<Duct> = (
	(* Return a Duct that transmits a Boolean value whenever the 'hasEditsFromUser' status of the receiver changes. *)

	^hasChangesH changed
)
public isSquishy ^<Boolean> = (
	^true
)
lineHeight ^<Integer> = (
	(* Return the height of a line of text. Meaningful only after the visual has been mapped. *)
	^isMapped
		ifTrue: [agent lineHeight]
		ifFalse: [0]
)
linesDo: aBlock <[:Integer :Integer :Integer :Integer]> = (
	(* Invoke the block for each visible line in the text view. The block expects four arguments. At each invocation, the arguments are: 1) the index of the current visible (post-word-wrap) line; 2) the index of the corresponding physical (pre-word-wrap) line; 3) the index of the first character of the line; 4) the index past the last character of the line (exclusive). The first argument begins at 1 in the first invocation and increases by 1 for each successive invocation. The second argument begins at 1 but takes the same value for visible lines that come from the same physical line. First and last character indices indicate the range of the line in the text displayed by the view and exclude any newline/linefeed characters. *)
	isMapped ifFalse: [^self].
	agent enumerateLinesUsing: aBlock
)
public maybeSelectCurrentLine = (
	selectedText isEmpty ifTrue: [selectLine].
	^selectedText
)
public menu = (
	^menuBlock value
)
public naturalExtent = (
	^agent
		ifNil: [0 @ 0]
		ifNotNil: [agent naturalExtent]
)
public naturalHeightForWidth: size <Number> ^<Number> = (
	^agent
		ifNil: [0]
		ifNotNil: [agent naturalHeightForWidth: size]
)
public selectAll = (
	^isMapped
		ifTrue: [agent selectAll]
		ifFalse: [postMapActions add: [agent selectAll]]
)
public selectFrom: start to: end = (
	^isMapped
		ifTrue: [agent selectFrom: start to: end]
		ifFalse: [postMapActions add: [agent selectFrom: start to: end]]
)
public selectLine = (
	^isMapped
		ifTrue: [agent selectLine]
		ifFalse: [postMapActions add: [agent selectLine]]
)
public selectedText = (
	^isMapped
		ifTrue: [agent selectedText]
		ifFalse: ['']
)
public selectionInterval = (
	^isMapped
		ifTrue: [agent selectionInterval]
		ifFalse: [1 to: 0]
)
public suppressScrollbars ^<Boolean> = (
	^suppressScrollbarsA value
)
public suppressScrollbars: newValue <Boolean> = (
	suppressScrollbarsA value: newValue
)
public text = (
	^textA value
)
public text: aString <String> = (
	(* Set the new content in the receiver and mark it as 'clean' in the sense of the hasChanges status. *)

	textA value: aString.
	clearHasEditsFromUserFlag
)
visibleLineCount = (
	(* Answer the number of lines after word wrapping. *)
	^isMapped
		ifTrue: [agent visibleLineCount]
		ifFalse: [text lineCount]
)
) : (
)
) : (
)
createTheDesktop = (
	^containers Desktop withMapping: currentMappingClass new
)
currentMappingClass = (
	^MorphicAgentFactory
)
public defaultFontMapper = (
	defaultFontMapperS ifNil: [defaultFontMapperS:: MorphicFontMapper new].
	^defaultFontMapperS
)
error: str = (
	(* Parts of brazil still expect Object has this method *)
	Error signal: str
)
flushDefaultFontMapper = (
	defaultFontMapperS:: nil
)
lastVisitedDirectory ^<String> = (
	^lastVisitedDirectoryS
)
lastVisitedDirectory: aString = (
	lastVisitedDirectoryS:: aString
)
public newMorphicDesktop = (
	^containers Desktop withMapping: MorphicAgentFactory new
)
public resetDesktop = (
	theDesktop:: nil
)
public theDesktop = (
	theDesktopS ifNil: [theDesktopS:: createTheDesktop].
	^theDesktopS
)
public theDesktop: aDesktop = (
	theDesktopS:: aDesktop
)
) : (
)