home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP12.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
12KB
|
477 lines
'Smalltalk Textbook Appendix 12'!
ControllerWithMenu subclass: #EngiViewBuilderController
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-ViewBuilder'!
EngiViewBuilderController comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiViewBuilderController methodsFor: 'control defaults'!
yellowButtonActivity
| menu selection |
menu := self view yellowButtonMenu.
menu notNil
ifTrue:
[selection := menu startUp.
selection ~= 0
ifTrue:
[(Delay forMilliseconds: 50) wait.
self poll.
self model perform: selection with: self]]
ifFalse: [super controlActivity]! !
!EngiViewBuilderController methodsFor: 'framing'!
frameFromUser: boundingBox minSize: minSize
"EngiViewBuilderController new frameFromUser: Screen default bounds minSize: 50@50."
| frameRect allButton originPoint |
frameRect := 0 @ 0 extent: minSize.
allButton := 0.
Cursor crossHair
showWhile:
[originPoint := Screen default
dragShape: frameRect asPointArray
offset: 0 @ 0
gridPhase: 0 @ 0
gridSpacing: 1 @ 1
boundedBy: (boundingBox insetBy: (0 @ 0 corner: minSize + 1))
whileButton: allButton
isDown: false.
frameRect := originPoint extent: frameRect extent.
frameRect := Screen default
resizeRectangle: frameRect
minimumExtent: minSize
resizeIncrement: 1 @ 1
boundedBy: boundingBox
whileButton: allButton
isDown: true].
^frameRect!
normalFrameFromUser: minSize
| clippingBox globalOrigin viewBox |
clippingBox := self view bounds.
globalOrigin := self view container globalOrigin.
viewBox := clippingBox translatedBy: globalOrigin.
viewBox := self frameFromUser: viewBox minSize: minSize.
viewBox := viewBox translatedBy: globalOrigin negated.
^viewBox origin / clippingBox extent corner: viewBox corner / clippingBox extent! !
CompositeView subclass: #EngiViewBuilderView
instanceVariableNames: 'wrappers menuSelector '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-ViewBuilder'!
EngiViewBuilderView comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiViewBuilderView methodsFor: 'initialize-release'!
initialize
super initialize.
wrappers := OrderedCollection new! !
!EngiViewBuilderView methodsFor: 'controller accessing'!
defaultController
^self defaultControllerClass new!
defaultControllerClass
^EngiViewBuilderController! !
!EngiViewBuilderView methodsFor: 'control'!
objectWantingControl
| myController |
myController := self getController.
myController isNil ifTrue: [^nil].
myController isControlWanted
ifTrue: [^self]
ifFalse: [^nil]! !
!EngiViewBuilderView methodsFor: 'accessing'!
areaOf: wrapper
| association |
association := wrappers detect: [:assoc | assoc value = wrapper]
ifNone: [^nil].
^association key!
wrapperIn: aRectangle
| association |
association := wrappers detect: [:assoc | assoc key = aRectangle]
ifNone: [^nil].
^association value! !
!EngiViewBuilderView methodsFor: 'testing'!
includes: area
wrappers do: [:assoc | assoc key = area ifTrue: [^true]].
^false! !
!EngiViewBuilderView methodsFor: 'adding'!
addBoolViewIn: aRectangle
| wrapper |
(self includes: aRectangle)
ifTrue: [^nil].
wrapper := BorderedWrapper on:
[| baseModel valueModel boolView |
baseModel := (PluggableAdaptor on: self model)
getSelector: #bool putSelector: #bool:.
valueModel := (PluggableAdaptor on: baseModel)
selectValue: false.
boolView := LabeledBooleanView model: valueModel.
boolView label: ''.
boolView beToggle.
boolView controller beTriggerOnUp.
boolView] value in: aRectangle.
self addWrapper: wrapper.
self displayOn: wrapper graphicsContext.
wrappers add: aRectangle -> wrapper!
addListViewIn: aRectangle
| wrapper |
(self includes: aRectangle)
ifTrue: [^nil].
wrapper := BoundedWrapper on: (LookPreferences edgeDecorator on: (SelectionInListView
on: self model
aspect: #item
change: #item:
list: #list
menu: #listMenu
initialSelection: #item)).
self add: wrapper in: aRectangle.
self displayOn: wrapper graphicsContext.
wrappers add: aRectangle -> wrapper!
addTextViewIn: aRectangle
| wrapper |
(self includes: aRectangle)
ifTrue: [^nil].
wrapper := BoundedWrapper on: (LookPreferences edgeDecorator on: (TextView
on: self model
aspect: #text
change: #acceptText:from:
menu: #textMenu
initialSelection: nil)).
self add: wrapper in: aRectangle.
self displayOn: wrapper graphicsContext.
wrappers add: aRectangle -> wrapper! !
!EngiViewBuilderView methodsFor: 'removing'!
removeViewIn: aRectangle
| wrapper |
wrapper := self wrapperIn: aRectangle.
wrapper notNil
ifTrue:
[wrappers copy do: [:assoc | assoc key = aRectangle ifTrue: [wrappers remove: assoc]].
self remove: wrapper.
self displayOn: self graphicsContext]! !
!EngiViewBuilderView methodsFor: 'adaptor'!
yellowButtonMenu
menuSelector isNil ifTrue: [^nil].
^self model perform: menuSelector! !
!EngiViewBuilderView methodsFor: 'updating'!
update: aSymbol with: aRectangle
aSymbol = #textView ifTrue: [self addTextViewIn: aRectangle].
aSymbol = #listView ifTrue: [self addListViewIn: aRectangle].
aSymbol = #boolView ifTrue: [self addBoolViewIn: aRectangle].
aSymbol = #removeView ifTrue: [self removeViewIn: aRectangle]! !
!EngiViewBuilderView methodsFor: 'private'!
on: aModel menu: aSymbol
self model: aModel.
menuSelector := aSymbol! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiViewBuilderView class
instanceVariableNames: ''!
!EngiViewBuilderView class methodsFor: 'instance creation'!
on: aModel menu: aSymbol
^self new on: aModel menu: aSymbol! !
Model subclass: #EngiViewBuilderModel
instanceVariableNames: 'views '
classVariableNames: 'ViewBuilderMenu '
poolDictionaries: ''
category: 'Engi-ViewBuilder'!
EngiViewBuilderModel comment:
'
Engi 0.04 (8 February 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiViewBuilderModel methodsFor: 'initialize-release'!
initialize
views := OrderedCollection new! !
!EngiViewBuilderModel methodsFor: 'testing'!
includes: area
views do: [:assoc | assoc key = area ifTrue: [^true]].
^false! !
!EngiViewBuilderModel methodsFor: 'adding'!
addBoolViewIn: area
(self includes: area)
ifTrue: [^nil].
views add: area -> #boolView!
addListViewIn: area
(self includes: area)
ifTrue: [^nil].
views add: area -> #listView!
addTextViewIn: area
(self includes: area)
ifTrue: [^nil].
views add: area -> #textView! !
!EngiViewBuilderModel methodsFor: 'removing'!
removeViewIn: area
(self includes: area)
ifTrue: [views copy do: [:assoc | assoc key = area ifTrue: [views remove: assoc]]]! !
!EngiViewBuilderModel methodsFor: 'source code'!
sourceCode
| stream area type |
stream := WriteStream on: String new.
stream nextPutAll: '| aModel topWindow topView |
aModel := EngiViewBuilderModel new.
topWindow := ScheduledWindow
model: aModel
label: ''''
minimumSize: 300@200.
topView := CompositePart new.
topWindow component: topView.
'.
views do:
[:assoc |
area := assoc key.
type := assoc value.
type = #textView ifTrue: [stream nextPutAll: (self sourceCodeForTextView: area)].
type = #listView ifTrue: [stream nextPutAll: (self sourceCodeForListView: area)].
type = #boolView ifTrue: [stream nextPutAll: (self sourceCodeForBoolView: area)]].
stream nextPutAll: 'topWindow open'.
^stream contents!
sourceCodeForBoolView: area
^'topView
addWrapper: (BorderedWrapper on:
[| baseModel valueModel boolView |
baseModel := (PluggableAdaptor on: aModel) getSelector: #bool putSelector: #bool:.
valueModel := (PluggableAdaptor on: baseModel) selectValue: false.
boolView := LabeledBooleanView model: valueModel.
boolView label: ''''.
boolView beToggle.
boolView controller beTriggerOnUp.
boolView] value in: (' , area printString , ')).
'!
sourceCodeForListView: area
^'topView
add: (LookPreferences edgeDecorator on:
(SelectionInListView
on: aModel
aspect: #item
change: #item:
lis