home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP12.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  12KB  |  477 lines
  1.  
  2. 'Smalltalk Textbook Appendix 12'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. ControllerWithMenu subclass: #EngiViewBuilderController
  9.     instanceVariableNames: ''
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-ViewBuilder'!
  13. EngiViewBuilderController comment:
  14. '
  15.  
  16. Engi 0.04 (8 February 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiViewBuilderController methodsFor: 'control defaults'!
  23.  
  24. yellowButtonActivity
  25.     | menu selection |
  26.     menu := self view yellowButtonMenu.
  27.     menu notNil
  28.         ifTrue: 
  29.             [selection := menu startUp.
  30.             selection ~= 0
  31.                 ifTrue: 
  32.                     [(Delay forMilliseconds: 50) wait.
  33.                     self poll.
  34.                     self model perform: selection with: self]]
  35.         ifFalse: [super controlActivity]! !
  36.  
  37. !EngiViewBuilderController methodsFor: 'framing'!
  38.  
  39. frameFromUser: boundingBox minSize: minSize 
  40.     "EngiViewBuilderController new frameFromUser: Screen default bounds minSize: 50@50."
  41.  
  42.     | frameRect allButton originPoint |
  43.     frameRect := 0 @ 0 extent: minSize.
  44.     allButton := 0.
  45.     Cursor crossHair
  46.         showWhile: 
  47.             [originPoint := Screen default
  48.                         dragShape: frameRect asPointArray
  49.                         offset: 0 @ 0
  50.                         gridPhase: 0 @ 0
  51.                         gridSpacing: 1 @ 1
  52.                         boundedBy: (boundingBox insetBy: (0 @ 0 corner: minSize + 1))
  53.                         whileButton: allButton
  54.                         isDown: false.
  55.             frameRect := originPoint extent: frameRect extent.
  56.             frameRect := Screen default
  57.                         resizeRectangle: frameRect
  58.                         minimumExtent: minSize
  59.                         resizeIncrement: 1 @ 1
  60.                         boundedBy: boundingBox
  61.                         whileButton: allButton
  62.                         isDown: true].
  63.     ^frameRect!
  64.  
  65. normalFrameFromUser: minSize 
  66.     | clippingBox globalOrigin viewBox |
  67.     clippingBox := self view bounds.
  68.     globalOrigin := self view container globalOrigin.
  69.     viewBox := clippingBox translatedBy: globalOrigin.
  70.     viewBox := self frameFromUser: viewBox minSize: minSize.
  71.     viewBox := viewBox translatedBy: globalOrigin negated.
  72.     ^viewBox origin / clippingBox extent corner: viewBox corner / clippingBox extent! !
  73.  
  74.  
  75.  
  76.  
  77.  
  78. CompositeView subclass: #EngiViewBuilderView
  79.     instanceVariableNames: 'wrappers menuSelector '
  80.     classVariableNames: ''
  81.     poolDictionaries: ''
  82.     category: 'Engi-ViewBuilder'!
  83. EngiViewBuilderView comment:
  84. '
  85.  
  86. Engi 0.04 (8 February 1994)
  87. Copyright (C) 1994 by Atsushi Aoki
  88.  
  89. '!
  90.  
  91.  
  92. !EngiViewBuilderView methodsFor: 'initialize-release'!
  93.  
  94. initialize
  95.     super initialize.
  96.     wrappers := OrderedCollection new! !
  97.  
  98. !EngiViewBuilderView methodsFor: 'controller accessing'!
  99.  
  100. defaultController
  101.     ^self defaultControllerClass new!
  102.  
  103. defaultControllerClass
  104.     ^EngiViewBuilderController! !
  105.  
  106. !EngiViewBuilderView methodsFor: 'control'!
  107.  
  108. objectWantingControl
  109.     | myController |
  110.     myController := self getController.
  111.     myController isNil ifTrue: [^nil].
  112.     myController isControlWanted
  113.         ifTrue: [^self]
  114.         ifFalse: [^nil]! !
  115.  
  116. !EngiViewBuilderView methodsFor: 'accessing'!
  117.  
  118. areaOf: wrapper 
  119.     | association |
  120.     association := wrappers detect: [:assoc | assoc value = wrapper]
  121.                 ifNone: [^nil].
  122.     ^association key!
  123.  
  124. wrapperIn: aRectangle 
  125.     | association |
  126.     association := wrappers detect: [:assoc | assoc key = aRectangle]
  127.                 ifNone: [^nil].
  128.     ^association value! !
  129.  
  130. !EngiViewBuilderView methodsFor: 'testing'!
  131.  
  132. includes: area 
  133.     wrappers do: [:assoc | assoc key = area ifTrue: [^true]].
  134.     ^false! !
  135.  
  136. !EngiViewBuilderView methodsFor: 'adding'!
  137.  
  138. addBoolViewIn: aRectangle 
  139.     | wrapper |
  140.     (self includes: aRectangle)
  141.         ifTrue: [^nil].
  142.     wrapper := BorderedWrapper on: 
  143.                 [| baseModel valueModel boolView |
  144.                 baseModel := (PluggableAdaptor on: self model)
  145.                             getSelector: #bool putSelector: #bool:.
  146.                 valueModel := (PluggableAdaptor on: baseModel)
  147.                             selectValue: false.
  148.                 boolView := LabeledBooleanView model: valueModel.
  149.                 boolView label: ''.
  150.                 boolView beToggle.
  151.                 boolView controller beTriggerOnUp.
  152.                 boolView] value in: aRectangle.
  153.     self addWrapper: wrapper.
  154.     self displayOn: wrapper graphicsContext.
  155.     wrappers add: aRectangle -> wrapper!
  156.  
  157. addListViewIn: aRectangle 
  158.     | wrapper |
  159.     (self includes: aRectangle)
  160.         ifTrue: [^nil].
  161.     wrapper := BoundedWrapper on: (LookPreferences edgeDecorator on: (SelectionInListView
  162.                         on: self model
  163.                         aspect: #item
  164.                         change: #item:
  165.                         list: #list
  166.                         menu: #listMenu
  167.                         initialSelection: #item)).
  168.     self add: wrapper in: aRectangle.
  169.     self displayOn: wrapper graphicsContext.
  170.     wrappers add: aRectangle -> wrapper!
  171.  
  172. addTextViewIn: aRectangle 
  173.     | wrapper |
  174.     (self includes: aRectangle)
  175.         ifTrue: [^nil].
  176.     wrapper := BoundedWrapper on: (LookPreferences edgeDecorator on: (TextView
  177.                         on: self model
  178.                         aspect: #text
  179.                         change: #acceptText:from:
  180.                         menu: #textMenu
  181.                         initialSelection: nil)).
  182.     self add: wrapper in: aRectangle.
  183.     self displayOn: wrapper graphicsContext.
  184.     wrappers add: aRectangle -> wrapper! !
  185.  
  186. !EngiViewBuilderView methodsFor: 'removing'!
  187.  
  188. removeViewIn: aRectangle 
  189.     | wrapper |
  190.     wrapper := self wrapperIn: aRectangle.
  191.     wrapper notNil
  192.         ifTrue: 
  193.             [wrappers copy do: [:assoc | assoc key = aRectangle ifTrue: [wrappers remove: assoc]].
  194.             self remove: wrapper.
  195.             self displayOn: self graphicsContext]! !
  196.  
  197. !EngiViewBuilderView methodsFor: 'adaptor'!
  198.  
  199. yellowButtonMenu
  200.     menuSelector isNil ifTrue: [^nil].
  201.     ^self model perform: menuSelector! !
  202.  
  203. !EngiViewBuilderView methodsFor: 'updating'!
  204.  
  205. update: aSymbol with: aRectangle 
  206.     aSymbol = #textView ifTrue: [self addTextViewIn: aRectangle].
  207.     aSymbol = #listView ifTrue: [self addListViewIn: aRectangle].
  208.     aSymbol = #boolView ifTrue: [self addBoolViewIn: aRectangle].
  209.     aSymbol = #removeView ifTrue: [self removeViewIn: aRectangle]! !
  210.  
  211. !EngiViewBuilderView methodsFor: 'private'!
  212.  
  213. on: aModel menu: aSymbol 
  214.     self model: aModel.
  215.     menuSelector := aSymbol! !
  216. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  217.  
  218. EngiViewBuilderView class
  219.     instanceVariableNames: ''!
  220.  
  221.  
  222. !EngiViewBuilderView class methodsFor: 'instance creation'!
  223.  
  224. on: aModel menu: aSymbol 
  225.     ^self new on: aModel menu: aSymbol! !
  226.  
  227.  
  228.  
  229.  
  230.  
  231. Model subclass: #EngiViewBuilderModel
  232.     instanceVariableNames: 'views '
  233.     classVariableNames: 'ViewBuilderMenu '
  234.     poolDictionaries: ''
  235.     category: 'Engi-ViewBuilder'!
  236. EngiViewBuilderModel comment:
  237. '
  238.  
  239. Engi 0.04 (8 February 1994)
  240. Copyright (C) 1994 by Atsushi Aoki
  241.  
  242. '!
  243.  
  244.  
  245. !EngiViewBuilderModel methodsFor: 'initialize-release'!
  246.  
  247. initialize
  248.     views := OrderedCollection new! !
  249.  
  250. !EngiViewBuilderModel methodsFor: 'testing'!
  251.  
  252. includes: area 
  253.     views do: [:assoc | assoc key = area ifTrue: [^true]].
  254.     ^false! !
  255.  
  256. !EngiViewBuilderModel methodsFor: 'adding'!
  257.  
  258. addBoolViewIn: area 
  259.     (self includes: area)
  260.         ifTrue: [^nil].
  261.     views add: area -> #boolView!
  262.  
  263. addListViewIn: area 
  264.     (self includes: area)
  265.         ifTrue: [^nil].
  266.     views add: area -> #listView!
  267.  
  268. addTextViewIn: area 
  269.     (self includes: area)
  270.         ifTrue: [^nil].
  271.     views add: area -> #textView! !
  272.  
  273. !EngiViewBuilderModel methodsFor: 'removing'!
  274.  
  275. removeViewIn: area 
  276.     (self includes: area)
  277.         ifTrue: [views copy do: [:assoc | assoc key = area ifTrue: [views remove: assoc]]]! !
  278.  
  279. !EngiViewBuilderModel methodsFor: 'source code'!
  280.  
  281. sourceCode
  282.     | stream area type |
  283.     stream := WriteStream on: String new.
  284.     stream nextPutAll: '| aModel topWindow topView |
  285. aModel := EngiViewBuilderModel new.
  286. topWindow := ScheduledWindow
  287.             model: aModel
  288.             label: ''''
  289.             minimumSize: 300@200.
  290. topView := CompositePart new.
  291. topWindow component: topView.
  292. '.
  293.     views do: 
  294.         [:assoc | 
  295.         area := assoc key.
  296.         type := assoc value.
  297.         type = #textView ifTrue: [stream nextPutAll: (self sourceCodeForTextView: area)].
  298.         type = #listView ifTrue: [stream nextPutAll: (self sourceCodeForListView: area)].
  299.         type = #boolView ifTrue: [stream nextPutAll: (self sourceCodeForBoolView: area)]].
  300.     stream nextPutAll: 'topWindow open'.
  301.     ^stream contents!
  302.  
  303. sourceCodeForBoolView: area 
  304.     ^'topView
  305.     addWrapper: (BorderedWrapper on:
  306.         [| baseModel valueModel boolView |
  307.         baseModel := (PluggableAdaptor on: aModel) getSelector: #bool putSelector: #bool:.
  308.         valueModel := (PluggableAdaptor on: baseModel) selectValue: false.
  309.         boolView := LabeledBooleanView model: valueModel.
  310.         boolView label: ''''.
  311.         boolView beToggle.
  312.         boolView controller beTriggerOnUp.
  313.         boolView] value in: (' , area printString , ')).
  314. '!
  315.  
  316. sourceCodeForListView: area 
  317.     ^'topView
  318.     add: (LookPreferences edgeDecorator on:
  319.             (SelectionInListView
  320.                     on: aModel
  321.                     aspect: #item
  322.                     change: #item:
  323.                     lis