home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP13.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  7KB  |  277 lines
  1.  
  2. 'Smalltalk Textbook Appendix 13'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiVariable subclass: #EngiGaugeModel
  9.     instanceVariableNames: ''
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Gauge'!
  13. EngiGaugeModel comment:
  14. '
  15.  
  16. Engi 0.04 (8 February 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiGaugeModel methodsFor: 'initialize-release'!
  23.  
  24. initialize
  25.     self setValue: 0! !
  26.  
  27. !EngiGaugeModel methodsFor: 'accessing'!
  28.  
  29. value: aNumber 
  30.     ((aNumber isKindOf: Number)
  31.         and: [self value ~= aNumber])
  32.         ifTrue: 
  33.             [self setValue: aNumber.
  34.             self changed: #value]! !
  35. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  36.  
  37. EngiGaugeModel class
  38.     instanceVariableNames: ''!
  39.  
  40.  
  41. !EngiGaugeModel class methodsFor: 'instance creation'!
  42.  
  43. new
  44.     ^super new initialize! !
  45.  
  46. !EngiGaugeModel class methodsFor: 'examples'!
  47.  
  48. example1
  49.     "EngiGaugeModel example1."
  50.  
  51.     | gaugeModel windowCreation |
  52.     gaugeModel := EngiGaugeModel new.
  53.     windowCreation := 
  54.             [| gaugeView edgeDecorator topWindow |
  55.             gaugeView := EngiGaugeView
  56.                         on: gaugeModel
  57.                         get: #value
  58.                         put: #value:
  59.                         valuesMinMaxDivideRound: #(-100 100 10 1 ).
  60.             edgeDecorator := LookPreferences edgeDecorator on: gaugeView.
  61.             edgeDecorator noMenuBar.
  62.             edgeDecorator noVerticalScrollBar.
  63.             edgeDecorator noHorizontalScrollBar.
  64.             topWindow := EngiTopView
  65.                         model: nil
  66.                         label: 'Gauge'
  67.                         minimumSize: 100 @ 180.
  68.             topWindow add: edgeDecorator in: (0 @ 0 corner: 1 @ 1).
  69.             topWindow].
  70.     3 timesRepeat: [windowCreation value open].
  71.     gaugeModel inspect! !
  72.  
  73.  
  74.  
  75.  
  76.  
  77. View subclass: #EngiGaugeView
  78.     instanceVariableNames: 'getSelector putSelector minValue maxValue divideValue roundValue scalesLayout '
  79.     classVariableNames: ''
  80.     poolDictionaries: ''
  81.     category: 'Engi-Gauge'!
  82. EngiGaugeView comment:
  83. '
  84.  
  85. Engi 0.04 (8 February 1994)
  86. Copyright (C) 1994 by Atsushi Aoki
  87.  
  88. '!
  89.  
  90.  
  91. !EngiGaugeView methodsFor: 'accessing'!
  92.  
  93. gaugeBorder
  94.     | box x |
  95.     box := self bounds insetBy: self defaultMargin.
  96.     x := box left + self gaugeScalesExtent x + 13.
  97.     ^(x @ box top corner: box corner) rounded!
  98.  
  99. gaugeScales
  100.     ^self scalesLayout first!
  101.  
  102. gaugeScalesExtent
  103.     ^self scalesLayout last! !
  104.  
  105. !EngiGaugeView methodsFor: 'controller accessing'!
  106.  
  107. defaultControllerClass
  108.     ^EngiGaugeController! !
  109.  
  110. !EngiGaugeView methodsFor: 'displaying'!
  111.  
  112. displayBorderOn: graphicsContext 
  113.     | border preferences |
  114.     border := self gaugeBorder.
  115.     preferences := LookPreferences defaultBorder.
  116.     graphicsContext lineWidth: preferences top.
  117.     graphicsContext paint: preferences topColor.
  118.     graphicsContext displayLineFrom: border bottomLeft to: border bottomRight.
  119.     graphicsContext lineWidth: preferences left.
  120.     graphicsContext paint: preferences leftColor.
  121.     graphicsContext displayLineFrom: border topRight to: border bottomRight.
  122.     graphicsContext lineWidth: preferences bottom.
  123.     graphicsContext paint: preferences bottomColor.
  124.     graphicsContext displayLineFrom: border topLeft to: border topRight.
  125.     graphicsContext lineWidth: preferences right.
  126.     graphicsContext paint: preferences rightColor.
  127.     graphicsContext displayLineFrom: border topLeft to: border bottomLeft!
  128.  
  129. displayOn: graphicsContext 
  130.     self displayBorderOn: graphicsContext.
  131.     self displayScalesOn: graphicsContext.
  132.     self displayValueOn: graphicsContext!
  133.  
  134. displayScalesOn: graphicsContext 
  135.     | box label location point extent |
  136.     box := self bounds insetBy: self defaultMargin.
  137.     extent := self gaugeScalesExtent.
  138.     self gaugeScales do: 
  139.         [:assoc | 
  140.         label := assoc key.
  141.         location := assoc value.
  142.         label := label printString asComposedText.
  143.         point := box height - (box height * location).
  144.         point := box left + (extent x - label bounds width) @ (point + box top).
  145.         point := point - (0 @ (label bounds height // 2)).
  146.         graphicsContext paint: self foregroundColor.
  147.         label displayOn: graphicsContext at: point.
  148.         point := box height - (box height * location).
  149.         point := (box left @ (point + box top) + (extent x @ 0)) rounded.
  150.         graphicsContext lineWidth: 1.
  151.         graphicsContext paint: self foregroundColor.
  152.         graphicsContext displayLineFrom: point + (3 @ 0) to: point + (7 @ 0)]!
  153.  
  154. displayValueOn: graphicsContext 
  155.     | value border back fore |
  156.     value := self getValue - minValue / (maxValue - minValue).
  157.     border := self gaugeBorder insetBy: (1 @ 1 corner: 0 @ 0).
  158.     back := border origin extent: border width @ (border height - (border height * value)).
  159.     fore := back left @ back bottom corner: border corner.
  160.     graphicsContext paint: self selectionForegroundColor.
  161.     graphicsContext displayRectangle: (back rounded intersect: border).
  162.     graphicsContext paint: self selectionBackgroundColor.
  163.     graphicsContext displayRectangle: (fore rounded intersect: border)! !
  164.  
  165. !EngiGaugeView methodsFor: 'adaptor'!
  166.  
  167. getValue
  168.     ^self model perform: getSelector!
  169.  
  170. putValue: aNumber 
  171.     (roundValue isNil or: [roundValue = 0])
  172.         ifTrue: [self model perform: putSelector with: aNumber]
  173.         ifFalse: [self model perform: putSelector with: (aNumber roundTo: roundValue)]!
  174.  
  175. setValue: cursorPoint 
  176.     | box value |
  177.     box := self gaugeBorder.
  178.     value := cursorPoint - box origin / box extent.
  179.     value := 1 - value y.
  180.     value := value * (maxValue - minValue) + minValue.
  181.     self putValue: value! !
  182.  
  183. !EngiGaugeView methodsFor: 'updating'!
  184.  
  185. update: aSymbol 
  186.     aSymbol = getSelector ifTrue: [^self displayValueOn: self graphicsContext]! !
  187.  
  188. !EngiGaugeView methodsFor: 'defaults'!
  189.  
  190. defaultMargin
  191.     ^Rectangle origin: (Point x: 10 y: 10)
  192.         corner: (Point x: 10 y: 10)! !
  193.  
  194. !EngiGaugeView methodsFor: 'private'!
  195.  
  196. on: aModel get: getSymbol put: putSymbol valuesMinMaxDivideRound: anArray 
  197.     | min max div rnd |
  198.     min := anArray at: 1.
  199.     max := anArray at: 2.
  200.     div := anArray at: 3.
  201.     rnd := anArray at: 4.
  202.     self model: aModel.
  203.     getSelector := getSymbol.
  204.     putSelector := putSymbol.
  205.     minValue := min min: max.
  206.     maxValue := max max: min.
  207.     divideValue := div rounded max: 1.
  208.     roundValue := max - min min: (rnd max: 0).
  209.     self scalesLayout!
  210.  
  211. scalesLayout
  212.     scalesLayout isNil
  213.         ifTrue: 
  214.             [| labels increment extent value location |
  215.             labels := OrderedCollection new.
  216.             increment := maxValue - minValue / divideValue.
  217.             labels add: minValue -> 0.
  218.             extent := minValue printString asComposedText bounds extent.
  219.             value := minValue.
  220.             location := 0.
  221.             divideValue - 1
  222.                 timesRepeat: 
  223.                     [value := value + increment.
  224.                     location := 1 / divideValue + location.
  225.                     labels add: value -> location.
  226.                     extent := extent max: value printString asComposedText bounds extent].
  227.             labels add: maxValue -> 1.
  228.             extent := extent max: maxValue printString asComposedText bounds extent.
  229.             scalesLayout := Array with: labels asArray with: extent].
  230.     ^scalesLayout! !
  231. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  232.  
  233. EngiGaugeView class
  234.     instanceVariableNames: ''!
  235.  
  236.  
  237. !EngiGaugeView class methodsFor: 'instance creation'!
  238.  
  239. on: aModel get: getSymbol put: putSymbol valuesMinMaxDivideRound: anArray 
  240.     ^self new
  241.         on: aModel
  242.         get: getSymbol
  243.         put: putSymbol
  244.         valuesMinMaxDivideRound: anArray! !
  245.  
  246.  
  247.  
  248.  
  249.  
  250. Controller subclass: #EngiGaugeController
  251.     instanceVariableNames: ''
  252.     classVariableNames: ''
  253.     poolDictionaries: ''
  254.     category: 'Engi-Gauge'!
  255. EngiGaugeController comment:
  256. '
  257.  
  258. Engi 0.04 (8 February 1994)
  259. Copyright (C) 1994 by Atsushi Aoki
  260.  
  261. '!
  262.  
  263.  
  264. !EngiGaugeController methodsFor: 'control defaults'!
  265.  
  266. controlActivity
  267.     | box block point |
  268.     box := view gaugeBorder.
  269.     block := [:p | box origin <= p and: [p <= box corner]].
  270.     [sensor redButtonPressed
  271.         and: 
  272.             [point := sensor cursorPoint.
  273.             block value: point]]
  274.         whileTrue: 
  275.             [view setValue: point.
  276.             self poll]! !
  277.