UI.st

CompositePart subclass: #ModelValueViewContainer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Model Views'!



!ModelValueViewContainer methodsFor: 'view layout'!


addView: view in: area 
	| wrapper |
	wrapper := BorderedWrapper on: view in: area.
	self addWrapper: wrapper! !


!ModelValueViewContainer methodsFor: 'view creation'!


makeButton: buttonLabel on: aModel for: action 
	"Make a button to send a message to aModel
	to perform an action"


	| buttonView buttonAdaptor |
	buttonAdaptor := (PluggableAdaptor on: aModel)
				performAction: action.
	buttonView := LabeledBooleanView new.
	buttonView model: buttonAdaptor.
	buttonView label: buttonLabel.
	buttonView beTrigger.
	buttonView controller beTriggerOnUp.
	^buttonView!


makeDisplayBoxOn: aModel for: aspect
	"Make a display box that displays that value indicated
	by aspect, but has no message by which it can change a
	value"


	| itemView |
	itemView := DisplayBox
			on: aModel
			aspect: aspect
			change: nil
			menu: nil.
	^itemView!


makeLightBoxFor: lane color: colorValue rule: ruleBlock 
	| lightBox |
	lightBox := LightBox new.
	lightBox color: colorValue displayRule: ruleBlock.
	lightBox model: lane.
	^lightBox!


makeLightBoxFor: lane color: colorValue rule: ruleBlock
	shape: geometricShape


	| lightBox |
	lightBox := self
			makeLightBoxFor: lane
			color: colorValue
			rule: ruleBlock.
	lightBox shape: geometricShape.
	^lightBox! !


!ModelValueViewContainer methodsFor: 'window opening'!


openOn: aModel
	"Build the views for the model inside me.
	Place myself in a window with my default label.
	Open the window on the screen."


	self openOn: aModel
		labeled: self windowLabel!


openOn: aModel labeled: aLabel
	"Build the views for the model inside me.
	Place myself in a window with my default label.
	Open the window on the screen."


	| window |
	window := ScheduledWindow new.
	window component: self.
	self buildViewOn: aModel.
	window label: aLabel.
	window minimumSize: self windowSize.
	window open!


windowLabel
	^'Model Value'!


windowSize
	^100 @ 100  "pixels"! !


!ModelValueViewContainer methodsFor: 'private'!


constraintFrame: originConstraints corner: cornerConstraints
	^LayoutFrame originFractions: originConstraints
			   cornerFractions: cornerConstraints! !

ModelValueViewContainer subclass: #ModelCollectionViewContainer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Model Views'!



!ModelCollectionViewContainer methodsFor: 'view layout'!


addListView: subView in: area 
	| wrapper |
	wrapper := BorderDecorator on: subView.
	self add: wrapper in: area! !


!ModelCollectionViewContainer methodsFor: 'view creation'!


makeListOn: aModel showing: getListMsg selecting:
	selectedItemMsg updateFor: aspect
	| listView |
	listView := SelectionInListView
				on: aModel
				printItems: false
				oneItem: false
				aspect: aspect
				change: selectedItemMsg
				list: getListMsg
				menu: nil
				initialSelection: nil
				useIndex: true.
	^listView! !

TextView subclass: #DisplayBox
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Model Views'!



!DisplayBox methodsFor: 'model access'!


getContents
	"Ask the model to perform the partMsg and convert 
	the result to a String"


	^(model perform: partMsg) printString! !


!DisplayBox methodsFor: 'selection'!


displayInsertionPointFor: aCharacterBlock on: aGraphicsContext 
	"Override this method so I will not display a cursor 
	and a user cannot type inside me"


	^self! !


!DisplayBox methodsFor: 'controller access'!


defaultController
	^DisplayBoxController new! !
TextController subclass: #DisplayBoxController
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Model Views'!



!DisplayBoxController methodsFor: 'private'!


doAccept
	"Ignore the user's input.  Flash my view."


	view flash.
	^false!


replaceSelectionWith: aText saveSelectionForUndo: aBoolean 
	"Disable the sending of user text to a view."


	^self! !