|
1 " |
|
2 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 PseudoView subclass:#View |
|
14 instanceVariableNames:'superView subViews |
|
15 components style resources |
|
16 transformation viewport |
|
17 borderColor borderWidth borderShape viewShape |
|
18 top left |
|
19 extentChanged originChanged cornerChanged |
|
20 relativeOrigin relativeExtent relativeCorner |
|
21 originRule extentRule cornerRule |
|
22 topInset leftInset bottomInset rightInset |
|
23 shown hidden name |
|
24 level softEdge margin innerClipRect |
|
25 shadowColor lightColor |
|
26 halfShadowColor halfLightColor |
|
27 viewOrigin |
|
28 contentsChangeAction originChangeAction |
|
29 bitGravity viewGravity |
|
30 keyboardHandler model controller |
|
31 aspectSymbol changeSymbol menuSymbol' |
|
32 classVariableNames: 'Grey ZeroPoint CentPoint |
|
33 ViewSpacing DefaultStyle |
|
34 Resources' |
|
35 poolDictionaries: '' |
|
36 category:'Views-Basic' |
|
37 ! |
|
38 |
|
39 View comment:' |
|
40 |
|
41 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
42 All Rights Reserved |
|
43 |
|
44 this class implements functions common to all Views. Instances of View are seldom |
|
45 used, most views in the system inherit from this class. However, sometimes a view |
|
46 is used to create a dummy view for framing purposes. |
|
47 |
|
48 Instance variables: |
|
49 |
|
50 superView <aView> my superview i.e. the view I am in |
|
51 subViews <aCollection> the collection of subviews |
|
52 transformation <WindowingTransformation> |
|
53 window <Rectangle> my window i.e. local coordinate-system |
|
54 viewport <Rectangle> my Rectangle in superviews coordinates |
|
55 borderColor <Color> color of border |
|
56 borderWidth <Number> borderWidth in pixels (device dep.) |
|
57 borderShape <Form> shape of border (if device supports it) |
|
58 viewShape <Form> shape of view (if device supports it) |
|
59 top <Number> top coordinate in superview |
|
60 left <Number> left coordinate in superview |
|
61 extendChanged <Boolean> true if extend changed during setup |
|
62 originChanged <Boolean> true if origin changed during setup |
|
63 relativeOrigin <Number> relative origin in percent within superview |
|
64 relativeExtent <Number> relative extent in percent within superview |
|
65 originRule <Block> rule to compute origin if superview changes size |
|
66 extentRule <Block> rule to compute extent if superview changes size |
|
67 shown <Boolean> true if visible (false if iconified) |
|
68 hidden <Boolean> dont show automatically when superview is realized |
|
69 name <String> my name (future use for resources) |
|
70 level <Number> 3D level relative to superview |
|
71 margin <Number> convenient margin |
|
72 innerClipRect <Rectangle> convenient inner clip (minus margin) |
|
73 shadowColor <Color> color used to draw 3D shadowed edges |
|
74 lightColor <Color> color used to draw 3D lighted edges |
|
75 viewOrigin <Point> origin within model |
|
76 contentsChanngeAction <Block> action to perform when model contents changes |
|
77 originChangeAction <Block> action to perform when model origin changes |
|
78 bitGravity <Symbol> gravity of contents (if device supports it) |
|
79 viewGravity <Symbol> gravity of view (if device supports it) |
|
80 keyboardHandler <anObject> gets keyboard input if non-nil |
|
81 model <anObject> the model (if MVC is used) |
|
82 controller <aController> the controller - gets events (if MVC is used) |
|
83 |
|
84 Class variables: |
|
85 |
|
86 Grey <Color> the color grey - its used so often |
|
87 ViewSpacing <Number> the number of pixels in a millimeter (prefered |
|
88 spacing between views) |
|
89 ZeroPoint <Point> 0 @ 0 - its used so often |
|
90 CentPoint <Point> 100 @ 100 - its used so often |
|
91 |
|
92 %W% %E% |
|
93 |
|
94 written spring/summer 89 by claus |
|
95 3D effects summer 90 by claus |
|
96 MVC, viewport and window stuff summer 92 by claus (for ST-80 compatibility) |
|
97 '! |
|
98 |
|
99 "this flag controls (globally) how views look" |
|
100 |
|
101 Smalltalk at:#View3D put:false! |
|
102 |
|
103 !View class methodsFor:'initialization'! |
|
104 |
|
105 initialize |
|
106 "Workstation initialize." |
|
107 |
|
108 super initialize. |
|
109 |
|
110 Resources := ResourcePack for:self. |
|
111 |
|
112 Form initialize. |
|
113 Color initialize. |
|
114 |
|
115 Grey := Resource name:'VIEW_GREY' |
|
116 default:nil |
|
117 fromFile:'Smalltalk.rs'. |
|
118 Grey isNil ifTrue:[ |
|
119 Grey := Color grey |
|
120 ]. |
|
121 DefaultStyle := Resource name:'VIEW_STYLE' |
|
122 default:(View3D ifTrue:[#view3D] ifFalse:[#normal]) |
|
123 fromFile:'Smalltalk.rs' |
|
124 ! ! |
|
125 |
|
126 !View class methodsFor:'defaults'! |
|
127 |
|
128 defaultExtent |
|
129 "define the default extent" |
|
130 |
|
131 CentPoint isNil ifTrue:[CentPoint := 100 @ 100]. |
|
132 ^ CentPoint |
|
133 ! |
|
134 |
|
135 defaultStyle |
|
136 ^ DefaultStyle |
|
137 |
|
138 "View defaultStyle" |
|
139 ! |
|
140 |
|
141 defaultStyle:aStyle |
|
142 DefaultStyle := aStyle |
|
143 |
|
144 "View defaultStyle:#next" |
|
145 ! ! |
|
146 |
|
147 !View class methodsFor:'instance creation'! |
|
148 |
|
149 in:aView |
|
150 "return a new view as a subview of aView" |
|
151 |
|
152 |newView| |
|
153 |
|
154 newView := self basicNew. |
|
155 newView device:(aView device). |
|
156 newView superView:(aView). |
|
157 newView initialize. |
|
158 aView addSubView:newView. |
|
159 ^ newView |
|
160 ! |
|
161 |
|
162 extent:extent in:aView |
|
163 "create a new view as a subview of aView with given extent" |
|
164 |
|
165 ^ self origin:nil extent:extent borderWidth:nil |
|
166 font:nil label:nil in:aView |
|
167 ! |
|
168 |
|
169 origin:origin in:aView |
|
170 "create a new view as a subview of aView with given origin" |
|
171 |
|
172 ^ self origin:origin extent:nil borderWidth:nil |
|
173 font:nil label:nil in:aView |
|
174 ! |
|
175 |
|
176 extent:extent |
|
177 "create a new view with given extent" |
|
178 |
|
179 ^ self origin:nil extent:extent borderWidth:nil |
|
180 font:nil label:nil in:nil |
|
181 ! |
|
182 |
|
183 origin:origin extent:extent |
|
184 "create a new view with given origin and extent" |
|
185 |
|
186 ^ self origin:origin extent:extent borderWidth:nil |
|
187 font:nil label:nil in:nil |
|
188 ! |
|
189 |
|
190 origin:origin extent:extent in:aView |
|
191 "create a new view as a subview of aView with given origin and extent" |
|
192 |
|
193 ^ self origin:origin extent:extent borderWidth:nil |
|
194 font:nil label:nil in:aView |
|
195 ! |
|
196 |
|
197 origin:origin extent:extent borderWidth:bw in:aView |
|
198 "create a new view as a subview of aView with given origin, extent |
|
199 and borderWidth" |
|
200 |
|
201 ^ self origin:origin extent:extent borderWidth:bw |
|
202 font:nil label:nil in:aView |
|
203 ! |
|
204 |
|
205 origin:origin extent:extent borderWidth:bw |
|
206 "create a new view with given origin, extent and borderWidth" |
|
207 |
|
208 ^ self origin:origin extent:extent borderWidth:bw |
|
209 font:nil label:nil in:nil |
|
210 ! |
|
211 |
|
212 label:label |
|
213 "create a new view with given label" |
|
214 |
|
215 ^ self origin:nil extent:nil borderWidth:nil |
|
216 font:nil label:label in:nil |
|
217 ! |
|
218 |
|
219 label:label in:aView |
|
220 "create a new view as subview of aView with given label" |
|
221 |
|
222 ^ self origin:nil extent:nil borderWidth:nil |
|
223 font:nil label:label in:aView |
|
224 ! |
|
225 |
|
226 extent:extent label:label |
|
227 "create a new view with given extent and label" |
|
228 |
|
229 ^ self origin:nil extent:extent borderWidth:nil |
|
230 font:nil label:label in:nil |
|
231 ! |
|
232 |
|
233 origin:origin extent:extent label:label |
|
234 "create a new view with given origin, extent and label" |
|
235 |
|
236 ^ self origin:origin extent:extent borderWidth:nil |
|
237 font:nil label:label in:nil |
|
238 ! |
|
239 |
|
240 origin:origin extent:extent font:aFont label:label |
|
241 ^ self origin:origin extent:extent borderWidth:nil |
|
242 font:nil label:label in:nil |
|
243 ! |
|
244 |
|
245 origin:origin extent:extent font:aFont label:label in:aView |
|
246 ^ self origin:origin extent:extent borderWidth:nil |
|
247 font:aFont label:label in:aView |
|
248 ! |
|
249 |
|
250 origin:anOrigin extent:anExtent |
|
251 label:aLabel icon:aForm |
|
252 minExtent:minExtent maxExtent:maxExtent |
|
253 |newView| |
|
254 |
|
255 newView := self on:Display. |
|
256 anOrigin notNil ifTrue:[newView origin:anOrigin]. |
|
257 anExtent notNil ifTrue:[newView extent:anExtent]. |
|
258 aLabel notNil ifTrue:[newView label:aLabel]. |
|
259 aForm notNil ifTrue:[newView icon:aForm]. |
|
260 minExtent notNil ifTrue:[newView minExtent:minExtent]. |
|
261 maxExtent notNil ifTrue:[newView maxExtent:maxExtent]. |
|
262 ^ newView |
|
263 ! |
|
264 |
|
265 origin:anOrigin extent:anExtent borderWidth:bw |
|
266 font:aFont label:aLabel in:aView |
|
267 |newView| |
|
268 |
|
269 aView notNil ifTrue:[ |
|
270 newView := self basicNew. |
|
271 newView device:(aView device). |
|
272 aView addSubView:newView. |
|
273 newView initialize |
|
274 ] ifFalse:[ |
|
275 newView := self on:Display |
|
276 ]. |
|
277 bw notNil ifTrue:[newView borderWidth:bw]. |
|
278 anExtent notNil ifTrue:[newView extent:anExtent]. |
|
279 anOrigin notNil ifTrue:[newView origin:anOrigin]. |
|
280 aFont notNil ifTrue:[newView font:aFont]. |
|
281 aLabel notNil ifTrue:[newView label:aLabel]. |
|
282 ^ newView |
|
283 ! |
|
284 |
|
285 origin:origin corner:corner |
|
286 "create a new view with given origin and extent" |
|
287 |
|
288 ^ self origin:origin corner:corner borderWidth:nil |
|
289 font:nil label:nil in:nil |
|
290 ! |
|
291 |
|
292 origin:origin corner:corner in:aView |
|
293 "create a new view as a subview of aView with given origin and extent" |
|
294 |
|
295 ^ self origin:origin corner:corner borderWidth:nil |
|
296 font:nil label:nil in:aView |
|
297 ! |
|
298 |
|
299 origin:origin corner:corner borderWidth:bw in:aView |
|
300 "create a new view as a subview of aView with given origin and extent" |
|
301 |
|
302 ^ self origin:origin corner:corner borderWidth:bw |
|
303 font:nil label:nil in:aView |
|
304 ! |
|
305 |
|
306 origin:anOrigin corner:aCorner borderWidth:bw |
|
307 font:aFont label:aLabel in:aView |
|
308 |newView| |
|
309 |
|
310 aView notNil ifTrue:[ |
|
311 newView := self basicNew. |
|
312 newView device:(aView device). |
|
313 aView addSubView:newView. |
|
314 newView initialize |
|
315 ] ifFalse:[ |
|
316 newView := self on:Display |
|
317 ]. |
|
318 bw notNil ifTrue:[newView borderWidth:bw]. |
|
319 anOrigin notNil ifTrue:[newView origin:anOrigin]. |
|
320 aCorner notNil ifTrue:[newView corner:aCorner]. |
|
321 aFont notNil ifTrue:[newView font:aFont]. |
|
322 aLabel notNil ifTrue:[newView label:aLabel]. |
|
323 ^ newView |
|
324 ! |
|
325 |
|
326 on:anObject aspect:aspectMsg change:changeMsg menu:menuMsg |
|
327 ^ self new on:anObject |
|
328 aspect:aspectMsg |
|
329 change:changeMsg |
|
330 menu:menuMsg |
|
331 ! |
|
332 |
|
333 model:aModel |
|
334 ^ self new model:aModel |
|
335 ! ! |
|
336 |
|
337 !View methodsFor:'initialization'! |
|
338 |
|
339 initialize |
|
340 |ext| |
|
341 |
|
342 super initialize. |
|
343 shown := false. |
|
344 |
|
345 "fill in some defaults - some of them are usually redefined in subclasses |
|
346 initialize methods" |
|
347 |
|
348 name := self class name. |
|
349 ext := self class defaultExtent. |
|
350 |
|
351 level := 0. |
|
352 margin := 0. |
|
353 softEdge := false. |
|
354 |
|
355 self initStyle. |
|
356 |
|
357 left := 0. |
|
358 top := 0. |
|
359 width := ext x. |
|
360 height := ext y. |
|
361 ZeroPoint isNil ifTrue:[ZeroPoint := 0 @ 0]. |
|
362 viewOrigin := ZeroPoint. |
|
363 ViewSpacing isNil ifTrue:[ |
|
364 ViewSpacing := Display verticalPixelPerMillimeter rounded |
|
365 ]. |
|
366 originChanged := false. |
|
367 extentChanged := false. |
|
368 bitGravity := nil. |
|
369 viewGravity := nil. |
|
370 |
|
371 "ST-80 compatibility; if I define a defaultController |
|
372 create one and set it up; otherwise do nothing" |
|
373 |
|
374 (self respondsTo:#defaultControllerClass) ifTrue:[ |
|
375 self defaultControllerClass notNil ifTrue:[ |
|
376 controller := self defaultControllerClass basicNew. |
|
377 controller view:self. |
|
378 controller initialize |
|
379 ] |
|
380 ] |
|
381 ! |
|
382 |
|
383 initStyle |
|
384 style := DefaultStyle. |
|
385 |
|
386 self is3D ifTrue:[ |
|
387 borderWidth := 0 |
|
388 ] ifFalse:[ |
|
389 borderWidth := 1 |
|
390 ]. |
|
391 |
|
392 (self is3D and:[device hasGreyscales]) ifTrue:[ |
|
393 viewBackground := Grey. |
|
394 lightColor := White. |
|
395 shadowColor := Black. |
|
396 halfShadowColor := Color darkGrey. |
|
397 halfLightColor := White. |
|
398 ] ifFalse:[ |
|
399 viewBackground := White. |
|
400 lightColor := Color grey |
|
401 "or White" |
|
402 "or Color lightGrey". "cant say which is better ..." |
|
403 shadowColor := Black. |
|
404 halfShadowColor := Color grey. |
|
405 halfLightColor := White. |
|
406 ]. |
|
407 |
|
408 borderColor := Black. |
|
409 ! |
|
410 |
|
411 initEvents |
|
412 "will be sent by create - can be redefined by subclasses to enable |
|
413 view events" |
|
414 |
|
415 ^ self |
|
416 ! |
|
417 |
|
418 reinitialize |
|
419 "this is called right after snapIn" |
|
420 |
|
421 |myController| |
|
422 |
|
423 "if I have already been reinited - return" |
|
424 drawableId notNil ifTrue:[ |
|
425 ^ self |
|
426 ]. |
|
427 |
|
428 myController := controller. |
|
429 controller := nil. |
|
430 self recreate. |
|
431 |
|
432 "if I was mapped, do it again" |
|
433 realized ifTrue:[ |
|
434 "if it was iconified, try to remap iconified" |
|
435 shown ifFalse:[ |
|
436 device mapWindow:drawableId iconified:true |
|
437 atX:left y:top |
|
438 width:width height:height |
|
439 ] ifTrue:[ |
|
440 device mapWindow:drawableId iconified:false |
|
441 atX:left y:top |
|
442 width:width height:height |
|
443 ] |
|
444 ]. |
|
445 |
|
446 "restore controller" |
|
447 controller := myController |
|
448 ! |
|
449 |
|
450 recreate |
|
451 "recreate (i.e. tell X about me) after a snapin" |
|
452 |
|
453 drawableId isNil ifTrue:[ |
|
454 "associate cursor/colors to device" |
|
455 |
|
456 super recreate. |
|
457 |
|
458 borderColor notNil ifTrue:[ |
|
459 borderColor := borderColor on:device. |
|
460 ]. |
|
461 shadowColor notNil ifTrue:[ |
|
462 shadowColor := shadowColor on:device. |
|
463 ]. |
|
464 lightColor notNil ifTrue:[ |
|
465 lightColor := lightColor on:device. |
|
466 ]. |
|
467 halfShadowColor notNil ifTrue:[ |
|
468 halfShadowColor := halfShadowColor on:device. |
|
469 ]. |
|
470 halfLightColor notNil ifTrue:[ |
|
471 halfLightColor := halfLightColor on:device. |
|
472 ]. |
|
473 |
|
474 drawableId := device createWindowFor:self |
|
475 left:left top:top |
|
476 width:width height:height. |
|
477 |
|
478 extentChanged := false. |
|
479 originChanged := false. |
|
480 |
|
481 borderShape notNil ifTrue:[ |
|
482 device setWindowBorderShape:(borderShape id) in:drawableId |
|
483 ]. |
|
484 viewShape notNil ifTrue:[ |
|
485 device setWindowShape:(viewShape id) in:drawableId |
|
486 ]. |
|
487 backed notNil ifTrue:[ |
|
488 device setBackingStore:backed in:drawableId |
|
489 ]. |
|
490 saveUnder ifTrue:[ |
|
491 device setSaveUnder:saveUnder in:drawableId |
|
492 ]. |
|
493 |
|
494 font := font on:device. |
|
495 |
|
496 "XXX has to be changed: eventmasks are device specific - |
|
497 will not allow restart on another Workstation-type" |
|
498 |
|
499 device setEventMask:eventMask in:drawableId |
|
500 ] |
|
501 ! ! |
|
502 |
|
503 !View methodsFor:'accessing-mvc'! |
|
504 |
|
505 controller |
|
506 "return the controller. For non MVC views, return nil" |
|
507 |
|
508 ^ controller |
|
509 ! |
|
510 |
|
511 controller:aController |
|
512 "set the controller" |
|
513 |
|
514 controller := aController. |
|
515 controller view:self. |
|
516 controller model:model |
|
517 ! |
|
518 |
|
519 model |
|
520 "return the model, for non-MVC views, |
|
521 this is usually the receiver" |
|
522 |
|
523 ^ model |
|
524 ! |
|
525 |
|
526 model:aModel |
|
527 "set the model" |
|
528 |
|
529 model notNil ifTrue:[ |
|
530 model removeDependent:self |
|
531 ]. |
|
532 model := aModel. |
|
533 model notNil ifTrue:[ |
|
534 aModel addDependent:self |
|
535 ]. |
|
536 controller notNil ifTrue:[ |
|
537 controller model:aModel |
|
538 ] |
|
539 ! |
|
540 |
|
541 on: anObject aspect: aspectMsg change: changeMsg menu: menuMsg |
|
542 self model:anObject. |
|
543 self aspect:aspectMsg. |
|
544 self change:changeMsg. |
|
545 self menu:menuMsg |
|
546 ! |
|
547 |
|
548 aspect:aspectMsg |
|
549 aspectSymbol := aspectMsg |
|
550 ! |
|
551 |
|
552 change:changeMsg |
|
553 changeSymbol := changeMsg |
|
554 ! |
|
555 |
|
556 menu:menuMsg |
|
557 menuSymbol := menuMsg |
|
558 ! |
|
559 |
|
560 heightOfContents |
|
561 "return the height of the contents in pixels |
|
562 - defaults to views visible area here" |
|
563 |
|
564 ^ self innerHeight |
|
565 ! |
|
566 |
|
567 widthOfContents |
|
568 "return the width of the contents in pixels |
|
569 - defaults to views visible area here" |
|
570 |
|
571 ^ self innerWidth |
|
572 ! ! |
|
573 |
|
574 !View methodsFor:'accessing-dimensions'! |
|
575 |
|
576 left:aNumber |
|
577 "set the x position" |
|
578 |
|
579 self origin:(aNumber @ top) |
|
580 ! |
|
581 |
|
582 top:aNumber |
|
583 "set the y position" |
|
584 |
|
585 self origin:(left @ aNumber) |
|
586 ! |
|
587 |
|
588 width:aNumber |
|
589 "set the views width in pixels" |
|
590 |
|
591 self extent:(aNumber @ height) |
|
592 ! |
|
593 |
|
594 height:aNumber |
|
595 "set the views height in pixels" |
|
596 |
|
597 self extent:(width @ aNumber) |
|
598 ! |
|
599 |
|
600 innerWidth |
|
601 "return the width of the view minus any shadow-borders" |
|
602 |
|
603 (level == 0) ifTrue:[^ width]. |
|
604 ^ width - (2 * margin) |
|
605 ! |
|
606 |
|
607 innerHeight |
|
608 "return the height of the view minus any shadow-borders" |
|
609 |
|
610 (margin == 0) ifTrue:[^ height]. |
|
611 ^ height - (2 * margin) |
|
612 ! |
|
613 |
|
614 extent:extent |
|
615 "set the views extent; extent may be: |
|
616 a point where integer fields mean pixel-values |
|
617 and float values mean relative-to-superview; |
|
618 or a block returning a point" |
|
619 |
|
620 |w h e| |
|
621 |
|
622 extent isBlock ifTrue:[ |
|
623 extentRule := extent. |
|
624 "shown "drawableId notNil"" ifTrue:[ "23-feb-93" |
|
625 self pixelExtent:(extent value) |
|
626 ] ifFalse:[ |
|
627 extentChanged := true |
|
628 ] |
|
629 ] ifFalse:[ |
|
630 w := extent x. |
|
631 h := extent y. |
|
632 ((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[ |
|
633 relativeExtent := extent. |
|
634 e := self extentFromRelativeExtent. |
|
635 e isNil ifTrue:[ |
|
636 extentChanged := true |
|
637 ] ifFalse:[ |
|
638 self pixelExtent:e |
|
639 ] |
|
640 ] ifFalse:[ |
|
641 self pixelExtent:extent |
|
642 ] |
|
643 ] |
|
644 ! |
|
645 |
|
646 origin:origin |
|
647 "set the views origin; origin may be: |
|
648 a point where integer fields mean pixel-values |
|
649 and float values mean relative-to-superview; |
|
650 or a block returning a point" |
|
651 |
|
652 |newLeft newTop o| |
|
653 |
|
654 origin isBlock ifTrue:[ |
|
655 originRule := origin. |
|
656 drawableId notNil ifTrue:[ |
|
657 self pixelOrigin:(origin value) |
|
658 ] ifFalse:[ |
|
659 originChanged := true |
|
660 ] |
|
661 ] ifFalse:[ |
|
662 newLeft := origin x. |
|
663 newTop := origin y. |
|
664 ((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[ |
|
665 relativeOrigin := origin. |
|
666 o := self originFromRelativeOrigin. |
|
667 o isNil ifTrue:[ |
|
668 originChanged := true |
|
669 ] ifFalse:[ |
|
670 self pixelOrigin:o |
|
671 ] |
|
672 ] ifFalse:[ |
|
673 self pixelOrigin:origin |
|
674 ] |
|
675 ] |
|
676 ! |
|
677 |
|
678 origin:origin corner:corner |
|
679 "set both origin and extent" |
|
680 |
|
681 |newLeft newTop newRight newBot| |
|
682 |
|
683 "do it as one operation if possible" |
|
684 |
|
685 origin isBlock ifFalse:[ |
|
686 corner isBlock ifFalse:[ |
|
687 newLeft := origin x. |
|
688 (newLeft isMemberOf:Float) ifFalse:[ |
|
689 newTop := origin y. |
|
690 (newTop isMemberOf:Float) ifFalse:[ |
|
691 newRight := corner x. |
|
692 (newRight isMemberOf:Float) ifFalse:[ |
|
693 newBot := corner y. |
|
694 (newBot isMemberOf:Float) ifFalse:[ |
|
695 self pixelOrigin:origin corner:corner |
|
696 ] |
|
697 ] |
|
698 ] |
|
699 ] |
|
700 ] |
|
701 ]. |
|
702 self origin:origin. |
|
703 self corner:corner |
|
704 ! |
|
705 |
|
706 origin:origin extent:extent |
|
707 "set both origin and extent" |
|
708 |
|
709 |newLeft newTop newWidth newHeight| |
|
710 |
|
711 "do it as one operation if possible" |
|
712 |
|
713 origin isBlock ifFalse:[ |
|
714 extent isBlock ifFalse:[ |
|
715 newLeft := origin x. |
|
716 (newLeft isMemberOf:Float) ifFalse:[ |
|
717 newTop := origin y. |
|
718 (newTop isMemberOf:Float) ifFalse:[ |
|
719 newWidth := extent x. |
|
720 (newWidth isMemberOf:Float) ifFalse:[ |
|
721 newHeight := extent y. |
|
722 (newHeight isMemberOf:Float) ifFalse:[ |
|
723 self pixelOrigin:origin extent:extent |
|
724 ] |
|
725 ] |
|
726 ] |
|
727 ] |
|
728 ] |
|
729 ]. |
|
730 self extent:extent. |
|
731 self origin:origin |
|
732 ! |
|
733 |
|
734 left:newLeft top:newTop width:newWidth height:newHeight |
|
735 "another way of specifying origin and extent" |
|
736 |
|
737 self origin:(newLeft @ newTop) extent:(newWidth @ newHeight) |
|
738 ! |
|
739 |
|
740 relativeOrigin |
|
741 "return the relative origin or nil" |
|
742 |
|
743 ^ relativeOrigin |
|
744 ! |
|
745 |
|
746 relativeCorner |
|
747 "return the relative corner or nil" |
|
748 |
|
749 ^ relativeCorner |
|
750 ! |
|
751 |
|
752 relativeExtent |
|
753 "return the relative extent or nil" |
|
754 |
|
755 ^ relativeExtent |
|
756 ! |
|
757 |
|
758 relativeOrigin:aPoint |
|
759 "set the relative origin" |
|
760 |
|
761 relativeOrigin := aPoint |
|
762 ! |
|
763 |
|
764 relativeCorner:aPoint |
|
765 "set the relative corner" |
|
766 |
|
767 relativeCorner := aPoint |
|
768 ! |
|
769 |
|
770 relativeExtent:aPoint |
|
771 "set the relative extent" |
|
772 |
|
773 relativeExtent := aPoint |
|
774 ! |
|
775 |
|
776 center:newCenter |
|
777 "move the receiver so that newCenter, aPoint becomes the center point" |
|
778 |
|
779 self origin:(newCenter - ((width // 2) @ (height // 2))) |
|
780 ! |
|
781 |
|
782 center |
|
783 "return the point at the center of the receiver" |
|
784 |
|
785 ^ (left + (width // 2)) @ (top + (height // 2)) |
|
786 ! |
|
787 |
|
788 origin |
|
789 "return the origin (in pixels)" |
|
790 |
|
791 ^ left@top |
|
792 ! |
|
793 |
|
794 originRelativeTo:aView |
|
795 "return the origin (in pixels) relative to a superView" |
|
796 |
|
797 |currentView |
|
798 org "{ Class: Point }" |
|
799 sumX "{ Class: SmallInteger }" |
|
800 sumY "{ Class: SmallInteger }" | |
|
801 |
|
802 currentView := self. |
|
803 sumX := 0. |
|
804 sumY := 0. |
|
805 [currentView notNil] whileTrue:[ |
|
806 (currentView == aView) ifTrue:[ |
|
807 ^ (sumX @ sumY) |
|
808 ]. |
|
809 org := currentView origin. |
|
810 sumX := sumX + org x. |
|
811 sumY := sumY + org y. |
|
812 currentView := currentView superView |
|
813 ]. |
|
814 ^ nil |
|
815 ! |
|
816 |
|
817 left |
|
818 "return the x position of the left border" |
|
819 |
|
820 ^ left |
|
821 ! |
|
822 |
|
823 right |
|
824 "return the x position of the right border" |
|
825 |
|
826 ^ left + width - 1 |
|
827 ! |
|
828 |
|
829 top |
|
830 "return the y position of the top border" |
|
831 |
|
832 ^ top |
|
833 ! |
|
834 |
|
835 bottom |
|
836 "return the y position of the bottom border" |
|
837 |
|
838 ^ top + height - 1 |
|
839 ! |
|
840 |
|
841 corner |
|
842 "return the lower right corner-point" |
|
843 |
|
844 ^ (left + width - 1) @ (top + height - 1) |
|
845 ! |
|
846 |
|
847 corner:corner |
|
848 "set the views corner; corner may be: |
|
849 a point where integer fields mean pixel-values |
|
850 and float values mean relative-to-superview; |
|
851 or a block returning a point" |
|
852 |
|
853 |x y c| |
|
854 |
|
855 corner isBlock ifTrue:[ |
|
856 cornerRule := corner. |
|
857 drawableId notNil ifTrue:[ |
|
858 self pixelCorner:(corner value) |
|
859 ] ifFalse:[ |
|
860 extentChanged := true |
|
861 ] |
|
862 ] ifFalse:[ |
|
863 x := corner x. |
|
864 y := corner y. |
|
865 ((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[ |
|
866 relativeCorner := corner. |
|
867 c := self cornerFromRelativeCorner. |
|
868 c isNil ifTrue:[ |
|
869 extentChanged := true |
|
870 ] ifFalse:[ |
|
871 self pixelCorner:c |
|
872 ] |
|
873 ] ifFalse:[ |
|
874 self pixelCorner:corner |
|
875 ] |
|
876 ] |
|
877 ! ! |
|
878 |
|
879 !View methodsFor:'accessing-transformation'! |
|
880 |
|
881 window |
|
882 ^ window |
|
883 ! |
|
884 |
|
885 window:aRectangle |
|
886 window := aRectangle. |
|
887 subViews notNil ifTrue:[ |
|
888 subViews do:[:s | |
|
889 s superViewChangedSize |
|
890 ] |
|
891 ] |
|
892 |
|
893 " |
|
894 viewport isNil ifTrue:[ |
|
895 viewport := aRectangle. |
|
896 ]. |
|
897 " |
|
898 " |
|
899 superView notNil ifTrue:[ |
|
900 self superViewChangedSize |
|
901 ] ifFalse:[ |
|
902 originChanged := true. |
|
903 extentChanged := true |
|
904 ] |
|
905 " |
|
906 ! |
|
907 |
|
908 window:aRectangle viewport:vRect |
|
909 window := aRectangle. |
|
910 self viewport:vRect. |
|
911 subViews notNil ifTrue:[ |
|
912 subViews do:[:s | |
|
913 s superViewChangedSize |
|
914 ] |
|
915 ] |
|
916 ! |
|
917 |
|
918 transformation |
|
919 transformation isNil ifTrue:[ |
|
920 superView isNil ifTrue:[ |
|
921 transformation := WindowingTransformation window:window |
|
922 viewport:(0@0 extent:self extent) |
|
923 ] ifFalse:[ |
|
924 window isNil ifTrue:[ |
|
925 window := (0 @ 0) corner:(1 @ 1) |
|
926 ]. |
|
927 transformation := WindowingTransformation window:window |
|
928 viewport:(self origin extent:self extent) |
|
929 ] |
|
930 ]. |
|
931 ^ transformation |
|
932 ! |
|
933 |
|
934 displayTransformation |
|
935 "ST-80 compatibility - ST/X does not draw onto the display" |
|
936 |
|
937 ^ self transformation |
|
938 ! |
|
939 |
|
940 displayTransform:aPoint |
|
941 "given a point in window coordinate, make pixel coordinate" |
|
942 |
|
943 |nx ny| |
|
944 |
|
945 nx := aPoint x - window left * width / window width. |
|
946 ny := aPoint y - window top * height / window height. |
|
947 ^ nx @ ny |
|
948 ! |
|
949 |
|
950 inverseDisplayTransform:aPoint |
|
951 "given a pixel coordinate, make window coordinate" |
|
952 |
|
953 |nx ny| |
|
954 |
|
955 window isNil ifTrue:[^ aPoint]. |
|
956 nx := aPoint x * window width / width + window left. |
|
957 ny := aPoint y * window height / height + window top. |
|
958 ^ nx @ ny |
|
959 ! |
|
960 |
|
961 viewport:aRectangle |
|
962 "define my extend in my superviews coordinate-system." |
|
963 |
|
964 |relW relH relX relY winW winH| |
|
965 |
|
966 viewport := aRectangle. |
|
967 self dimensionFromViewport |
|
968 " |
|
969 superView notNil ifTrue:[ |
|
970 superView window isNil ifTrue:[ |
|
971 winW := 1. |
|
972 winH := 1 |
|
973 ] ifFalse:[ |
|
974 winW := superView window width. |
|
975 winH := superView window height |
|
976 ]. |
|
977 relW := (aRectangle width / winW) asFloat. |
|
978 relH := (aRectangle height / winH) asFloat. |
|
979 relX := (aRectangle left / winW) asFloat. |
|
980 relY := (aRectangle top / winH) asFloat. |
|
981 self origin:(relX @ relY) extent:(relW @ relH) |
|
982 ] |
|
983 " |
|
984 ! |
|
985 |
|
986 viewRectangle |
|
987 "return the inside area" |
|
988 |
|
989 |m2| |
|
990 |
|
991 innerClipRect notNil ifTrue:[ |
|
992 ^ innerClipRect |
|
993 ]. |
|
994 m2 := margin + margin. |
|
995 |
|
996 ^ (margin @ margin) extent:((width - m2) @ (height - m2)) |
|
997 ! |
|
998 |
|
999 viewOrigin |
|
1000 "return the viewOrigin; thats the coordinate of the contents |
|
1001 which is shown topLeft in the view |
|
1002 (i.e. the origin of the visible part of the contents)." |
|
1003 |
|
1004 ^ viewOrigin |
|
1005 ! |
|
1006 |
|
1007 viewOrigin:aPoint |
|
1008 "set the viewOrigin - i.e. virtually scroll without redrawing" |
|
1009 |
|
1010 viewOrigin := aPoint |
|
1011 ! |
|
1012 |
|
1013 xOriginOfContents |
|
1014 "return the x coordinate of the viewOrigin; used by scrollBars to compute |
|
1015 thumb position" |
|
1016 |
|
1017 ^ viewOrigin x |
|
1018 ! |
|
1019 |
|
1020 yOriginOfContents |
|
1021 "return the y coordinate of the viewOrigin; used by scrollBars to compute |
|
1022 thumb position" |
|
1023 |
|
1024 ^ viewOrigin y |
|
1025 ! ! |
|
1026 |
|
1027 !View methodsFor:'accessing-hierarchy'! |
|
1028 |
|
1029 superView |
|
1030 "return my superView" |
|
1031 |
|
1032 ^ superView |
|
1033 ! |
|
1034 |
|
1035 superView:aView |
|
1036 "set my superView to be aView" |
|
1037 |
|
1038 superView := aView |
|
1039 ! |
|
1040 |
|
1041 topView |
|
1042 "return the topView - thats the one with no superview" |
|
1043 |
|
1044 |v| |
|
1045 |
|
1046 v := self. |
|
1047 [v notNil] whileTrue:[ |
|
1048 v superView isNil ifTrue:[^ v]. |
|
1049 v := v superView |
|
1050 ]. |
|
1051 |
|
1052 ^ nil |
|
1053 ! |
|
1054 |
|
1055 subViews |
|
1056 "return the collection of subviews" |
|
1057 |
|
1058 ^ subViews |
|
1059 ! |
|
1060 |
|
1061 subViews:aListOfViews |
|
1062 "set the collection of subviews" |
|
1063 |
|
1064 subViews := aListOfViews. |
|
1065 subViews notNil ifTrue:[ |
|
1066 subViews do:[:view | |
|
1067 view superView:self |
|
1068 ] |
|
1069 ] |
|
1070 ! ! |
|
1071 |
|
1072 !View methodsFor:'accessing-misc'! |
|
1073 |
|
1074 viewGravity |
|
1075 "return the viewGravity - thats the direction where the view will move |
|
1076 when the superView is resized." |
|
1077 |
|
1078 ^ viewGravity |
|
1079 ! |
|
1080 |
|
1081 viewGravity:gravity |
|
1082 "set the viewGravity - thats the direction where the view will move |
|
1083 when the superView is resized." |
|
1084 |
|
1085 viewGravity := gravity |
|
1086 ! |
|
1087 |
|
1088 bitGravity |
|
1089 "return the bitGravity - thats the direction where the contents will move |
|
1090 when the the view is resized." |
|
1091 |
|
1092 ^ bitGravity |
|
1093 ! |
|
1094 |
|
1095 inputOnly |
|
1096 "return true, if this view is an input-only view; |
|
1097 input only views are transparent and can be layed on top of a view to |
|
1098 catch its input" |
|
1099 |
|
1100 ^ false |
|
1101 ! |
|
1102 |
|
1103 createOnTop |
|
1104 "return true, if this view should be put on top (raised) automatically. |
|
1105 usually this is true for alertBoxes etc." |
|
1106 |
|
1107 ^ false |
|
1108 ! |
|
1109 |
|
1110 canDrop:anObjectOrCollection |
|
1111 "return true, if anObjectOrCollection can be |
|
1112 dropped in the receiver. This method should be |
|
1113 redefined in views which can take objects" |
|
1114 |
|
1115 ^ false |
|
1116 ! |
|
1117 |
|
1118 is3D |
|
1119 ^ #(next iris openwin view3D motif) includes:style |
|
1120 ! |
|
1121 |
|
1122 shown |
|
1123 "return true if the view is shown; false if hidden" |
|
1124 |
|
1125 ^ shown |
|
1126 ! |
|
1127 |
|
1128 isCollapsed |
|
1129 ^ shown not |
|
1130 ! |
|
1131 |
|
1132 hidden:aBoolean |
|
1133 "if the argument is true, the receiver view will not |
|
1134 be realized automatically when superview is realized" |
|
1135 |
|
1136 hidden := aBoolean |
|
1137 ! |
|
1138 |
|
1139 hidden |
|
1140 "return true, if the view does not want to be realized |
|
1141 automatically when superview is realized" |
|
1142 |
|
1143 ^ hidden |
|
1144 ! |
|
1145 |
|
1146 lower |
|
1147 "bring to back" |
|
1148 |
|
1149 drawableId isNil ifTrue:[self create]. |
|
1150 device lowerWindow:drawableId |
|
1151 ! |
|
1152 |
|
1153 raise |
|
1154 "bring to front" |
|
1155 |
|
1156 drawableId isNil ifTrue:[self create]. |
|
1157 device raiseWindow:drawableId |
|
1158 ! ! |
|
1159 |
|
1160 !View methodsFor:'accessing-bg & border'! |
|
1161 |
|
1162 viewBackground:something |
|
1163 "set the viewBackground to something, a color, pixel or form. |
|
1164 if its a color and we run on a color display, also set shadow and light |
|
1165 colors." |
|
1166 |
|
1167 (something isKindOf:Color) ifTrue:[ |
|
1168 (device hasColors or:[device hasGreyscales]) ifTrue:[ |
|
1169 shadowColor := something darkened. |
|
1170 lightColor := something lightened |
|
1171 ] |
|
1172 ]. |
|
1173 super viewBackground:something |
|
1174 ! |
|
1175 |
|
1176 borderColor |
|
1177 "return my borderColor" |
|
1178 |
|
1179 ^ borderColor |
|
1180 ! |
|
1181 |
|
1182 borderColor:aColor |
|
1183 "set my borderColor" |
|
1184 |
|
1185 |id dither| |
|
1186 |
|
1187 (aColor ~~ borderColor) ifTrue:[ |
|
1188 borderColor := aColor. |
|
1189 drawableId notNil ifTrue:[ |
|
1190 borderColor := borderColor on:device. |
|
1191 id := borderColor colorId. |
|
1192 id notNil ifTrue:[ |
|
1193 device setWindowBorderColor:id in:drawableId |
|
1194 ] ifFalse:[ |
|
1195 dither := borderColor ditherForm. |
|
1196 dither notNil ifTrue:[ |
|
1197 device setWindowBorderPixmap:(dither id) in:drawableId |
|
1198 ] ifFalse:[ |
|
1199 'bad borderColor' printNewline |
|
1200 ] |
|
1201 ] |
|
1202 ] |
|
1203 ] |
|
1204 ! |
|
1205 |
|
1206 borderWidth |
|
1207 "return my borderWidth" |
|
1208 |
|
1209 ^ borderWidth |
|
1210 ! |
|
1211 |
|
1212 borderWidth:aNumber |
|
1213 "set my borderWidth" |
|
1214 |
|
1215 (aNumber ~~ borderWidth) ifTrue:[ |
|
1216 borderWidth := aNumber. |
|
1217 drawableId notNil ifTrue:[ |
|
1218 device setWindowBorderWidth:aNumber in:drawableId |
|
1219 ] |
|
1220 ] |
|
1221 ! |
|
1222 |
|
1223 borderShape:aForm |
|
1224 "set the borderShape to aForm" |
|
1225 |
|
1226 borderShape := aForm. |
|
1227 drawableId notNil ifTrue:[ |
|
1228 device setWindowBorderShape:(aForm id) in:drawableId |
|
1229 ] |
|
1230 ! |
|
1231 |
|
1232 viewShape:aForm |
|
1233 "set the viewShape to aForm" |
|
1234 |
|
1235 viewShape := aForm. |
|
1236 drawableId notNil ifTrue:[ |
|
1237 device setWindowShape:(aForm id) in:drawableId |
|
1238 ] |
|
1239 ! |
|
1240 |
|
1241 name |
|
1242 "return my name component to be used for resource-access" |
|
1243 |
|
1244 ^ name |
|
1245 ! |
|
1246 |
|
1247 fullName |
|
1248 "return my full name to be used for resource-access" |
|
1249 |
|
1250 superView notNil ifTrue:[ |
|
1251 ^ superView fullName , '.' , name |
|
1252 ]. |
|
1253 ^ name |
|
1254 ! |
|
1255 |
|
1256 name:aString |
|
1257 "set my name component to be used for resource-access" |
|
1258 |
|
1259 name := aString |
|
1260 ! |
|
1261 |
|
1262 keyboardHandler:someOne |
|
1263 "set my keyboardHandler" |
|
1264 |
|
1265 keyboardHandler := someOne |
|
1266 ! |
|
1267 |
|
1268 level |
|
1269 "return my level relative to superView (3D)" |
|
1270 |
|
1271 ^ level |
|
1272 ! |
|
1273 |
|
1274 level:aNumber |
|
1275 "set my level relative to superView (3D)" |
|
1276 |
|
1277 |oldMargin how| |
|
1278 |
|
1279 self is3D ifTrue:[ |
|
1280 (aNumber ~~ level) ifTrue:[ |
|
1281 level := aNumber. |
|
1282 oldMargin := margin. |
|
1283 margin := level abs. |
|
1284 |
|
1285 realized ifTrue:[ |
|
1286 (margin > oldMargin) ifTrue:[ |
|
1287 how := #smaller |
|
1288 ] ifFalse:[ |
|
1289 how := #larger |
|
1290 ]. |
|
1291 controller notNil ifTrue:[ |
|
1292 controller sizeChanged:how of:self |
|
1293 ] ifFalse:[ |
|
1294 self sizeChanged:how |
|
1295 ]. |
|
1296 self computeInnerClip. |
|
1297 self redrawEdges |
|
1298 ] |
|
1299 ] |
|
1300 ] |
|
1301 ! |
|
1302 |
|
1303 margin |
|
1304 "return my margin - this is usually the level, |
|
1305 but can be more for some views" |
|
1306 |
|
1307 ^ margin |
|
1308 ! |
|
1309 |
|
1310 widthIncludingBorder |
|
1311 "return my width including border" |
|
1312 |
|
1313 ^ width + (2*borderWidth) |
|
1314 ! |
|
1315 |
|
1316 heightIncludingBorder |
|
1317 "return my height including border" |
|
1318 |
|
1319 ^ height + (2*borderWidth) |
|
1320 ! ! |
|
1321 |
|
1322 !View methodsFor:'adding & removing components'! |
|
1323 |
|
1324 addComponent:aComponent |
|
1325 components isNil ifTrue:[ |
|
1326 components := IdentitySet new |
|
1327 ]. |
|
1328 components add:aComponent |
|
1329 ! |
|
1330 |
|
1331 removeComponent:aComponent |
|
1332 components isNil ifTrue:[^self]. |
|
1333 components remove:aComponent ifAbsent:[] |
|
1334 ! |
|
1335 |
|
1336 addSubView:aView |
|
1337 "add a view to the collection of subviews" |
|
1338 |
|
1339 subViews isNil ifTrue:[ |
|
1340 subViews := OrderedCollection new |
|
1341 ]. |
|
1342 subViews add:aView. |
|
1343 aView superView:self. |
|
1344 (aView device ~~ device) ifTrue:[ |
|
1345 'warning subview (' print. aView class name print. |
|
1346 ') has different device than me (' print. |
|
1347 self class name print. ').' printNewline. |
|
1348 aView device:device |
|
1349 ] |
|
1350 ! |
|
1351 |
|
1352 addSubView:aView in:bounds borderWidth:bw |
|
1353 aView borderWidth:bw. |
|
1354 aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat) |
|
1355 extent:(bounds extent x asFloat) @ (bounds extent y asFloat). |
|
1356 self addSubView:aView |
|
1357 ! |
|
1358 |
|
1359 add:aView in:bounds |
|
1360 aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat) |
|
1361 extent:(bounds extent x asFloat) @ (bounds extent y asFloat). |
|
1362 self addSubView:aView |
|
1363 ! |
|
1364 |
|
1365 addSubView:aView viewport:aRectangle |
|
1366 "Adds aView to the views list of subviews and uses the |
|
1367 existing subviews window and the new viewport to position it" |
|
1368 |
|
1369 self addSubView:aView. |
|
1370 aView viewport:aRectangle |
|
1371 ! |
|
1372 |
|
1373 addSubView:aView window:aWindowRectangle viewport:aViewportRectangle |
|
1374 "Adds aView to the views list of subviews and uses |
|
1375 aWindowRectangle and aViewportRectangle to position it" |
|
1376 |
|
1377 self addSubView:aView. |
|
1378 aView window:aWindowRectangle. |
|
1379 aView viewport:aViewportRectangle |
|
1380 ! |
|
1381 |
|
1382 removeSubView:aView |
|
1383 "remove a view from the collection of subviews" |
|
1384 |
|
1385 subViews remove:aView ifAbsent:[nil]. |
|
1386 (subViews size == 0) ifTrue:[ |
|
1387 subViews := nil |
|
1388 ] |
|
1389 ! ! |
|
1390 |
|
1391 !View methodsFor:'ST-80 compatibility'! |
|
1392 |
|
1393 on:aModel aspect:aspect change:change list:list menu:menu |
|
1394 "ST-80 compatibility" |
|
1395 |
|
1396 aspectSymbol := aspect. |
|
1397 changeSymbol := change. |
|
1398 menuSymbol := menu. |
|
1399 self model:aModel |
|
1400 ! |
|
1401 |
|
1402 sensor |
|
1403 "in this smalltalk, all sensor messages are simulated by the display-device" |
|
1404 |
|
1405 ^ device |
|
1406 ! |
|
1407 |
|
1408 open |
|
1409 ^ self realize |
|
1410 ! |
|
1411 |
|
1412 update |
|
1413 ^ self redraw |
|
1414 ! |
|
1415 |
|
1416 update:aspect |
|
1417 "an update request - should be redefined in subclasses" |
|
1418 |
|
1419 ^ self update |
|
1420 ! |
|
1421 |
|
1422 update:aspect with:anObject |
|
1423 "an update request - should be redefined in subclasses" |
|
1424 |
|
1425 aspect == #rectangle ifTrue:[ |
|
1426 ^ self update:#all |
|
1427 ]. |
|
1428 ^ self update:aspect |
|
1429 ! ! |
|
1430 |
|
1431 !View methodsFor:'informing others of changes'! |
|
1432 |
|
1433 originWillChange |
|
1434 "this one is sent, just before viewOrigin changes - |
|
1435 gives subclasses a chance to catch scrolls easily |
|
1436 (for example to hide cursor before scroll)" |
|
1437 |
|
1438 ^ self |
|
1439 ! |
|
1440 |
|
1441 originChangeAction:aBlock |
|
1442 "set the action, aBlock to be evaluated whenever my orgin changes |
|
1443 - to allow for scrollBars to track contents" |
|
1444 |
|
1445 originChangeAction := aBlock |
|
1446 ! |
|
1447 |
|
1448 originChanged:delta |
|
1449 "this one is sent, after my origin changed - |
|
1450 (for example to redraw cursor)" |
|
1451 |
|
1452 originChangeAction notNil ifTrue:[originChangeAction value:self] |
|
1453 ! |
|
1454 |
|
1455 contentsChangeAction:aBlock |
|
1456 "set the action, aBlock to be evaluated whenever my contents changes |
|
1457 - to allow for scrollBars to track contents" |
|
1458 |
|
1459 contentsChangeAction := aBlock |
|
1460 ! |
|
1461 |
|
1462 contentsChanged |
|
1463 "this one is sent, whenever contents changes size - |
|
1464 gives subclasses a chance to catch it (i.e. scrollbars etc)" |
|
1465 |
|
1466 contentsChangeAction notNil ifTrue:[contentsChangeAction value:self] |
|
1467 ! ! |
|
1468 |
|
1469 !View methodsFor:'scrolling'! |
|
1470 |
|
1471 widthForScrollBetween:firstLine and:lastLine |
|
1472 "answer the width in pixels for a scroll between firstLine and lastLine |
|
1473 - return full width here since we do not know how wide contents is" |
|
1474 |
|
1475 ^ (width - margin - margin) |
|
1476 ! |
|
1477 |
|
1478 scrollVerticalToPercent:percent |
|
1479 "scroll to a position given in percent of total" |
|
1480 |
|
1481 self scrollVerticalTo: |
|
1482 ((((self heightOfContents * percent) / 100.0) + 0.5) asInteger) |
|
1483 ! |
|
1484 |
|
1485 scrollVerticalTo:aPixelOffset |
|
1486 "change origin to make aPixelOffset be the top line" |
|
1487 |
|
1488 |orgY| |
|
1489 |
|
1490 orgY := viewOrigin y. |
|
1491 |
|
1492 (aPixelOffset < orgY) ifTrue:[ |
|
1493 self scrollUp:(orgY - aPixelOffset) |
|
1494 ] ifFalse:[ |
|
1495 (aPixelOffset > orgY) ifTrue:[ |
|
1496 self scrollDown:(aPixelOffset - orgY) |
|
1497 ] |
|
1498 ] |
|
1499 ! |
|
1500 |
|
1501 scrollHorizontalToPercent:percent |
|
1502 "scroll to a position given in percent of total" |
|
1503 |
|
1504 self scrollHorizontalTo: |
|
1505 ((((self widthOfContents * percent) / 100.0) + 0.5) asInteger) |
|
1506 ! |
|
1507 |
|
1508 scrollHorizontalTo:aPixelOffset |
|
1509 "change origin to make aPixelOffset be the left col" |
|
1510 |
|
1511 |orgX| |
|
1512 |
|
1513 orgX := viewOrigin x. |
|
1514 |
|
1515 (aPixelOffset < orgX) ifTrue:[ |
|
1516 self scrollLeft:(orgX - aPixelOffset) |
|
1517 ] ifFalse:[ |
|
1518 (aPixelOffset > orgX) ifTrue:[ |
|
1519 self scrollRight:(aPixelOffset - orgX) |
|
1520 ] |
|
1521 ] |
|
1522 ! |
|
1523 |
|
1524 scrollTo:aPixelOffset |
|
1525 "only here for historic reasons - will vanish soon" |
|
1526 |
|
1527 ^ self scrollVerticalTo:aPixelOffset |
|
1528 ! |
|
1529 |
|
1530 scrollToTop |
|
1531 "move viewOrigin to top" |
|
1532 |
|
1533 self scrollVerticalTo:0 |
|
1534 ! |
|
1535 |
|
1536 scrollUp:nPixels |
|
1537 "change origin to scroll up some pixels" |
|
1538 |
|
1539 |count "{ Class:SmallInteger }" |
|
1540 m2 "{ Class:SmallInteger }" |
|
1541 w "{ Class:SmallInteger }"| |
|
1542 |
|
1543 count := nPixels. |
|
1544 (count > viewOrigin y) ifTrue:[ |
|
1545 count := viewOrigin y |
|
1546 ]. |
|
1547 (count <= 0) ifTrue:[^ self]. |
|
1548 |
|
1549 self originWillChange. |
|
1550 viewOrigin := viewOrigin x @ (viewOrigin y - count). |
|
1551 |
|
1552 (count >= self innerHeight) ifTrue:[ |
|
1553 self redraw. |
|
1554 self originChanged:(0 @ count negated) |
|
1555 ] ifFalse:[ |
|
1556 w := self widthForScrollBetween:(viewOrigin y) |
|
1557 and:(viewOrigin y + count). |
|
1558 m2 := margin * 2. |
|
1559 w := w min:(width - m2). |
|
1560 |
|
1561 " |
|
1562 super function:#copy. |
|
1563 super foreground:White. |
|
1564 " |
|
1565 self copyFrom:self x:margin y:margin |
|
1566 toX:margin y:(count + margin) |
|
1567 width:w |
|
1568 height:(height - m2 - count). |
|
1569 self redrawX:margin y:margin |
|
1570 width:(width - m2) |
|
1571 height:count. |
|
1572 |
|
1573 self originChanged:(0 @ count negated). |
|
1574 self waitForExpose |
|
1575 ] |
|
1576 ! |
|
1577 |
|
1578 scrollUp |
|
1579 "scroll up by some amount |
|
1580 - question is how much is a good default here" |
|
1581 |
|
1582 self scrollUp:(device verticalPixelPerMillimeter * 20) asInteger |
|
1583 ! |
|
1584 |
|
1585 scrollDown:nPixels |
|
1586 "change origin to scroll down some pixels" |
|
1587 |
|
1588 |count "{ Class:SmallInteger }" |
|
1589 m2 "{ Class:SmallInteger }" |
|
1590 w "{ Class:SmallInteger }" |
|
1591 hCont "{ Class:SmallInteger }" |
|
1592 ih "{ Class:SmallInteger }"| |
|
1593 |
|
1594 count := nPixels. |
|
1595 hCont := self heightOfContents. |
|
1596 ih := self innerHeight. |
|
1597 |
|
1598 ((viewOrigin y + nPixels + ih) > hCont) ifTrue:[ |
|
1599 count := hCont - viewOrigin y - ih |
|
1600 ]. |
|
1601 (count <= 0) ifTrue:[^ self]. |
|
1602 |
|
1603 self originWillChange. |
|
1604 viewOrigin := viewOrigin x @ (viewOrigin y + count). |
|
1605 |
|
1606 (count >= ih) ifTrue:[ |
|
1607 self redraw. |
|
1608 self originChanged:(0 @ count) |
|
1609 ] ifFalse:[ |
|
1610 m2 := margin * 2. |
|
1611 w := self widthForScrollBetween:(viewOrigin y) |
|
1612 and:(viewOrigin y + count). |
|
1613 w := w min:(width - m2). |
|
1614 |
|
1615 " |
|
1616 super function:#copy. |
|
1617 super foreground:White. |
|
1618 " |
|
1619 self copyFrom:self x:margin y:(count + margin) |
|
1620 toX:margin y:margin |
|
1621 width:w |
|
1622 height:(height - m2 - count). |
|
1623 |
|
1624 self redrawX:margin y:(height - margin - count) |
|
1625 width:(width - m2) height:count. |
|
1626 |
|
1627 self originChanged:(0 @ count). |
|
1628 self waitForExpose |
|
1629 ] |
|
1630 ! |
|
1631 |
|
1632 scrollDown |
|
1633 "scroll down by some amount |
|
1634 - question is how much is a good default here" |
|
1635 |
|
1636 self scrollDown:(device verticalPixelPerMillimeter * 20) asInteger |
|
1637 ! |
|
1638 |
|
1639 scrollLeft:nPixels |
|
1640 "change origin to scroll left some pixels" |
|
1641 |
|
1642 |count "{ Class:SmallInteger }" |
|
1643 m2 "{ Class:SmallInteger }" |
|
1644 h "{ Class:SmallInteger }"| |
|
1645 |
|
1646 count := nPixels. |
|
1647 (count > viewOrigin x) ifTrue:[ |
|
1648 count := viewOrigin x |
|
1649 ]. |
|
1650 (count <= 0) ifTrue:[^ self]. |
|
1651 |
|
1652 self originWillChange. |
|
1653 viewOrigin := (viewOrigin x - count) @ viewOrigin y. |
|
1654 |
|
1655 (count >= self innerWidth) ifTrue:[ |
|
1656 self redraw. |
|
1657 self originChanged:(count negated @ 0) |
|
1658 ] ifFalse:[ |
|
1659 m2 := margin * 2. |
|
1660 h := (height - m2). |
|
1661 |
|
1662 " |
|
1663 super function:#copy. |
|
1664 super foreground:White. |
|
1665 " |
|
1666 self copyFrom:self x:margin y:margin |
|
1667 toX:(count + margin) y:margin |
|
1668 width:(width - m2 - count) |
|
1669 height:h. |
|
1670 |
|
1671 self redrawX:margin y:margin |
|
1672 width:count |
|
1673 height:(height - m2). |
|
1674 |
|
1675 self originChanged:(count negated @ 0). |
|
1676 self waitForExpose |
|
1677 ] |
|
1678 ! |
|
1679 |
|
1680 scrollLeft |
|
1681 "scroll left by some amount |
|
1682 - question is how much is a good default here" |
|
1683 |
|
1684 self scrollLeft:(device horizontalPixelPerMillimeter * 20) asInteger |
|
1685 ! |
|
1686 |
|
1687 scrollRight:nPixels |
|
1688 "change origin to scroll right some pixels" |
|
1689 |
|
1690 |count "{ Class:SmallInteger }" |
|
1691 m2 "{ Class:SmallInteger }" |
|
1692 h "{ Class:SmallInteger }" |
|
1693 wCont "{ Class:SmallInteger }" |
|
1694 iw "{ Class:SmallInteger }"| |
|
1695 |
|
1696 count := nPixels. |
|
1697 wCont := self widthOfContents. |
|
1698 iw := self innerWidth. |
|
1699 |
|
1700 ((viewOrigin x + nPixels + iw) > wCont) ifTrue:[ |
|
1701 count := wCont - viewOrigin x - iw |
|
1702 ]. |
|
1703 (count <= 0) ifTrue:[^ self]. |
|
1704 |
|
1705 self originWillChange. |
|
1706 viewOrigin := (viewOrigin x + count) @ viewOrigin y. |
|
1707 |
|
1708 (count >= iw) ifTrue:[ |
|
1709 self redraw. |
|
1710 self originChanged:(count @ 0) |
|
1711 ] ifFalse:[ |
|
1712 m2 := margin * 2. |
|
1713 h := (height - m2). |
|
1714 |
|
1715 " |
|
1716 super function:#copy. |
|
1717 super foreground:White. |
|
1718 " |
|
1719 self copyFrom:self x:(count + margin) y:margin |
|
1720 toX:margin y:margin |
|
1721 width:(width - m2 - count) |
|
1722 height:h. |
|
1723 |
|
1724 self redrawX:(width - margin - count) y:margin |
|
1725 width:count height:(height - m2). |
|
1726 |
|
1727 self originChanged:(count @ 0). |
|
1728 self waitForExpose |
|
1729 ] |
|
1730 ! |
|
1731 |
|
1732 scrollRight |
|
1733 "scroll right by some amount |
|
1734 - question is how much is a good default here" |
|
1735 |
|
1736 self scrollRight:(device horizontalPixelPerMillimeter * 20) asInteger |
|
1737 ! ! |
|
1738 |
|
1739 !View methodsFor:'private'! |
|
1740 |
|
1741 pixelExtent:extent |
|
1742 "set the views extent in pixels" |
|
1743 |
|
1744 |newWidth newHeight how mustRedrawBottomEdge mustRedrawRightEdge| |
|
1745 |
|
1746 newWidth := extent x. |
|
1747 newHeight := extent y. |
|
1748 ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[ |
|
1749 "shown "drawableId notNil"" ifTrue:[ "23-feb-93" |
|
1750 ((newHeight <= height) and:[newWidth <= width]) ifTrue:[ |
|
1751 how := #smaller |
|
1752 ]. |
|
1753 |
|
1754 mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height]. |
|
1755 mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width]. |
|
1756 |
|
1757 (level ~~ 0) ifTrue:[ |
|
1758 "clear the old edges" |
|
1759 |
|
1760 newWidth > width ifTrue:[ |
|
1761 self clipRect:nil. |
|
1762 self paint:viewBackground. |
|
1763 self fillRectangleX:(width - margin) |
|
1764 y:0 |
|
1765 width:margin |
|
1766 height:height |
|
1767 ]. |
|
1768 newHeight > height ifTrue:[ |
|
1769 self clipRect:nil. |
|
1770 self paint:viewBackground. |
|
1771 self fillRectangleX:0 |
|
1772 y:(height - margin) |
|
1773 width:width |
|
1774 height:margin |
|
1775 ] |
|
1776 ] |
|
1777 ]. |
|
1778 |
|
1779 width := newWidth. |
|
1780 height := newHeight. |
|
1781 |
|
1782 "shown "drawableId notNil"" ifTrue:[ "23-feb-93" |
|
1783 self setInnerClip. |
|
1784 |
|
1785 (how == #smaller) ifTrue:[ |
|
1786 "if view becomes smaller, send sizeChanged first" |
|
1787 controller notNil ifTrue:[ |
|
1788 controller sizeChanged:how of:self |
|
1789 ] ifFalse:[ |
|
1790 self sizeChanged:how |
|
1791 ] |
|
1792 ]. |
|
1793 |
|
1794 "have to tell X, when extent of view is changed" |
|
1795 device resizeWindow:drawableId width:width height:height. |
|
1796 |
|
1797 "if view becomes bigger, send sizeChanged after" |
|
1798 (how ~~ #smaller) ifTrue:[ |
|
1799 controller notNil ifTrue:[ |
|
1800 controller sizeChanged:how of:self |
|
1801 ] ifFalse:[ |
|
1802 self sizeChanged:how |
|
1803 ] |
|
1804 ]. |
|
1805 |
|
1806 (mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[ |
|
1807 self clipRect:nil. |
|
1808 mustRedrawBottomEdge ifTrue:[ |
|
1809 self drawBottomEdge |
|
1810 ]. |
|
1811 mustRedrawRightEdge ifTrue:[ |
|
1812 self drawRightEdge |
|
1813 ]. |
|
1814 self clipRect:innerClipRect |
|
1815 ] |
|
1816 ] ifFalse:[ |
|
1817 "otherwise memorize the need for a sizeChanged message" |
|
1818 extentChanged := true |
|
1819 ] |
|
1820 ] |
|
1821 ! |
|
1822 |
|
1823 pixelOrigin:origin |
|
1824 "set the views origin in pixels" |
|
1825 |
|
1826 |newLeft newTop| |
|
1827 |
|
1828 newLeft := origin x. |
|
1829 newTop := origin y. |
|
1830 ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[ |
|
1831 top := newTop. |
|
1832 left := newLeft. |
|
1833 drawableId notNil ifTrue:[ |
|
1834 "have to tell X, when origin of view is changed" |
|
1835 device moveWindow:drawableId x:left y:top |
|
1836 ]. |
|
1837 realized ifFalse:[ |
|
1838 originChanged := true |
|
1839 ] |
|
1840 ] |
|
1841 ! |
|
1842 |
|
1843 pixelCorner:corner |
|
1844 "set the views corner in pixels" |
|
1845 |
|
1846 |newWidth newHeight| |
|
1847 |
|
1848 newWidth := corner x - left. |
|
1849 newHeight := corner y - top. |
|
1850 self pixelExtent:(newWidth @ newHeight) |
|
1851 ! |
|
1852 |
|
1853 pixelOrigin:origin corner:corner |
|
1854 "set the views origin and extent in pixels" |
|
1855 |
|
1856 |newWidth newHeight| |
|
1857 |
|
1858 newWidth := corner x - origin x. |
|
1859 newHeight := corner y - origin y. |
|
1860 self pixelOrigin:origin extent:(newWidth @ newHeight) |
|
1861 ! |
|
1862 |
|
1863 pixelOrigin:origin extent:extent |
|
1864 "set the views origin and extent in pixels" |
|
1865 |
|
1866 |newLeft newTop newWidth newHeight how |
|
1867 mustRedrawBottomEdge mustRedrawRightEdge| |
|
1868 |
|
1869 newLeft := origin x. |
|
1870 newTop := origin y. |
|
1871 ((newTop == top) and:[newLeft == left]) ifTrue:[ |
|
1872 ^ self pixelExtent:extent |
|
1873 ]. |
|
1874 newWidth := extent x. |
|
1875 newHeight := extent y. |
|
1876 ((newWidth == width) and:[newHeight == height]) ifTrue:[ |
|
1877 ^ self pixelOrigin:origin |
|
1878 ]. |
|
1879 top := newTop. |
|
1880 left := newLeft. |
|
1881 |
|
1882 mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height]. |
|
1883 mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width]. |
|
1884 |
|
1885 width := newWidth. |
|
1886 height := newHeight. |
|
1887 ((newHeight <= height) and:[newWidth <= width]) ifTrue:[ |
|
1888 how := #smaller |
|
1889 ]. |
|
1890 |
|
1891 "shown "drawableId notNil"" ifTrue:[ "23-feb-93" |
|
1892 (level ~~ 0) ifTrue:[ |
|
1893 "clear the old edges" |
|
1894 |
|
1895 newWidth > width ifTrue:[ |
|
1896 self clipRect:nil. |
|
1897 self paint:viewBackground. |
|
1898 self fillRectangleX:(width - margin) |
|
1899 y:0 |
|
1900 width:margin |
|
1901 height:height |
|
1902 ]. |
|
1903 newHeight > height ifTrue:[ |
|
1904 self clipRect:nil. |
|
1905 self paint:viewBackground. |
|
1906 self fillRectangleX:0 |
|
1907 y:(height - margin) |
|
1908 width:width |
|
1909 height:margin |
|
1910 ] |
|
1911 ]. |
|
1912 |
|
1913 self setInnerClip. |
|
1914 |
|
1915 "if view becomes smaller, send sizeChanged first" |
|
1916 (how == #smaller) ifTrue:[ |
|
1917 controller notNil ifTrue:[ |
|
1918 controller sizeChanged:how of:self |
|
1919 ] ifFalse:[ |
|
1920 self sizeChanged:how |
|
1921 ] |
|
1922 ]. |
|
1923 |
|
1924 "have to tell X, when extent of view is changed" |
|
1925 " |
|
1926 (how == #smaller) ifTrue:[ |
|
1927 device resizeWindow:drawableId width:width height:height. |
|
1928 device moveWindow:drawableId x:left y:top |
|
1929 ] ifFalse:[ |
|
1930 device moveResizeWindow:drawableId x:left y:top width:width height:height |
|
1931 ]. |
|
1932 " |
|
1933 device moveResizeWindow:drawableId x:left y:top |
|
1934 width:width height:height. |
|
1935 |
|
1936 "if view becomes bigger, send sizeChanged after" |
|
1937 (how ~~ #smaller) ifTrue:[ |
|
1938 controller notNil ifTrue:[ |
|
1939 controller sizeChanged:how of:self |
|
1940 ] ifFalse:[ |
|
1941 self sizeChanged:how |
|
1942 ] |
|
1943 ]. |
|
1944 (mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[ |
|
1945 self clipRect:nil. |
|
1946 mustRedrawBottomEdge ifTrue:[ |
|
1947 self drawBottomEdge |
|
1948 ]. |
|
1949 mustRedrawRightEdge ifTrue:[ |
|
1950 self drawRightEdge |
|
1951 ]. |
|
1952 self clipRect:innerClipRect |
|
1953 ] |
|
1954 ] ifFalse:[ |
|
1955 "otherwise memorize the need for a sizeChanged message" |
|
1956 originChanged := true. |
|
1957 extentChanged := true |
|
1958 ] |
|
1959 ! |
|
1960 |
|
1961 pointFromRelativePoint:relativePoint |
|
1962 "given relative point, compute absolute point (in pixels)" |
|
1963 |
|
1964 |newX newY rel inRect| |
|
1965 |
|
1966 superView isNil ifTrue:[^ nil]. |
|
1967 inRect := superView viewRectangle. |
|
1968 |
|
1969 rel := relativePoint x. |
|
1970 (rel isMemberOf:Float) ifTrue:[ |
|
1971 newX := (rel * (inRect width + (2 * borderWidth))) asInteger + inRect left |
|
1972 ] ifFalse:[ |
|
1973 newX := rel |
|
1974 ]. |
|
1975 rel := relativePoint y. |
|
1976 (rel isMemberOf:Float) ifTrue:[ |
|
1977 newY := (rel * (inRect height + (2 * borderWidth))) asInteger + inRect top |
|
1978 ] ifFalse:[ |
|
1979 newY := rel |
|
1980 ]. |
|
1981 ^ (newX @ newY) |
|
1982 ! |
|
1983 |
|
1984 originFromRelativeOrigin |
|
1985 "compute pixel origin from relativeOrigin" |
|
1986 |
|
1987 |newOrigin newX newY rel inRect bw2| |
|
1988 |
|
1989 superView isNil ifTrue:[^ nil]. |
|
1990 |
|
1991 inRect := superView viewRectangle. |
|
1992 bw2 := borderWidth * 2. |
|
1993 rel := relativeOrigin x. |
|
1994 (rel isMemberOf:Float) ifTrue:[ |
|
1995 newX := (rel * (inRect width + bw2)) asInteger + inRect left |
|
1996 ] ifFalse:[ |
|
1997 newX := rel |
|
1998 ]. |
|
1999 rel := relativeOrigin y. |
|
2000 (rel isMemberOf:Float) ifTrue:[ |
|
2001 newY := (rel * (inRect height + bw2)) asInteger + inRect top |
|
2002 ] ifFalse:[ |
|
2003 newY := rel |
|
2004 ]. |
|
2005 newOrigin := (newX @ newY). |
|
2006 |
|
2007 (borderWidth ~~ 0) ifTrue:[ |
|
2008 (relativeOrigin x isMemberOf:Float) ifTrue:[ |
|
2009 newOrigin x:(newOrigin x - borderWidth) |
|
2010 ]. |
|
2011 (relativeOrigin y isMemberOf:Float) ifTrue:[ |
|
2012 newOrigin y:(newOrigin y - borderWidth) |
|
2013 ] |
|
2014 ]. |
|
2015 ^ newOrigin |
|
2016 ! |
|
2017 |
|
2018 cornerFromRelativeCorner |
|
2019 "compute pixel corner from relativeCorner" |
|
2020 |
|
2021 |newCorner newX newY rel inRect bw2| |
|
2022 |
|
2023 superView isNil ifTrue:[^ nil]. |
|
2024 |
|
2025 inRect := superView viewRectangle. |
|
2026 bw2 := borderWidth * 2. |
|
2027 rel := relativeCorner x. |
|
2028 (rel isMemberOf:Float) ifTrue:[ |
|
2029 newX := (rel * (inRect width" + bw2")) asInteger "+ inRect left" |
|
2030 ] ifFalse:[ |
|
2031 newX := rel |
|
2032 ]. |
|
2033 rel := relativeCorner y. |
|
2034 (rel isMemberOf:Float) ifTrue:[ |
|
2035 newY := (rel * (inRect height" + bw2")) asInteger "+ inRect top" |
|
2036 ] ifFalse:[ |
|
2037 newY := rel |
|
2038 ]. |
|
2039 newCorner := (newX @ newY). |
|
2040 |
|
2041 (borderWidth ~~ 0) ifTrue:[ |
|
2042 (relativeCorner x isMemberOf:Float) ifTrue:[ |
|
2043 newCorner x:(newCorner x - borderWidth) |
|
2044 ]. |
|
2045 (relativeCorner y isMemberOf:Float) ifTrue:[ |
|
2046 newCorner y:(newCorner y - borderWidth) |
|
2047 ] |
|
2048 ]. |
|
2049 ^ newCorner |
|
2050 ! |
|
2051 |
|
2052 extentFromRelativeExtent |
|
2053 "compute pixel extent from relativeExtent" |
|
2054 |
|
2055 |newExtent newX newY rel inRect bw2| |
|
2056 |
|
2057 superView isNil ifTrue:[^ nil]. |
|
2058 |
|
2059 inRect := superView viewRectangle. |
|
2060 bw2 := borderWidth * 2. |
|
2061 rel := relativeExtent x. |
|
2062 (rel isMemberOf:Float) ifTrue:[ |
|
2063 newX := (rel * (inRect width + bw2)) asInteger + inRect left |
|
2064 ] ifFalse:[ |
|
2065 newX := rel |
|
2066 ]. |
|
2067 rel := relativeExtent y. |
|
2068 (rel isMemberOf:Float) ifTrue:[ |
|
2069 newY := (rel * (inRect height + bw2)) asInteger + inRect top |
|
2070 ] ifFalse:[ |
|
2071 newY := rel |
|
2072 ]. |
|
2073 newExtent := (newX @ newY). |
|
2074 |
|
2075 (borderWidth ~~ 0) ifTrue:[ |
|
2076 (relativeExtent x isMemberOf:Float) ifTrue:[ |
|
2077 newExtent x:(newExtent x - (1 * borderWidth)) |
|
2078 ]. |
|
2079 (relativeExtent y isMemberOf:Float) ifTrue:[ |
|
2080 newExtent y:(newExtent y - (1 * borderWidth)) |
|
2081 ] |
|
2082 ]. |
|
2083 ^ newExtent |
|
2084 ! |
|
2085 |
|
2086 dimensionFromViewport |
|
2087 "define my origin/extend from viewport" |
|
2088 |
|
2089 |relW relH relX relY winW winH org ext| |
|
2090 |
|
2091 superView notNil ifTrue:[ |
|
2092 superView window isNil ifTrue:[ |
|
2093 " |
|
2094 v := superView. |
|
2095 (v notNil and:[v window isNil]) whileTrue:[ |
|
2096 v := v superview |
|
2097 ]. |
|
2098 v notNil ifTrue:[ |
|
2099 w := v window |
|
2100 ]. |
|
2101 " |
|
2102 " |
|
2103 winW := 1. |
|
2104 winH := 1 |
|
2105 " |
|
2106 winW := superView width. |
|
2107 winH := superView height. |
|
2108 |
|
2109 ] ifFalse:[ |
|
2110 winW := superView window width. |
|
2111 winH := superView window height |
|
2112 ]. |
|
2113 relW := (viewport width / winW) asFloat. |
|
2114 relH := (viewport height / winH) asFloat. |
|
2115 relX := (viewport left / winW) asFloat. |
|
2116 relY := (viewport top / winH) asFloat. |
|
2117 relativeOrigin := (relX @ relY). |
|
2118 org := self originFromRelativeOrigin. |
|
2119 relativeOrigin := nil. |
|
2120 |
|
2121 relativeExtent := (relW @ relH). |
|
2122 ext := self extentFromRelativeExtent. |
|
2123 relativeExtent := nil. |
|
2124 |
|
2125 self pixelOrigin:org extent:ext. |
|
2126 ] |
|
2127 ! |
|
2128 |
|
2129 computeInnerClip |
|
2130 |m2| |
|
2131 |
|
2132 (margin ~~ 0) ifTrue:[ |
|
2133 m2 := margin + margin. |
|
2134 innerClipRect := Rectangle left:margin top:margin |
|
2135 width:(width - m2) height:(height - m2) |
|
2136 ] ifFalse:[ |
|
2137 innerClipRect := nil |
|
2138 ] |
|
2139 ! |
|
2140 |
|
2141 setInnerClip |
|
2142 |m2| |
|
2143 |
|
2144 (margin ~~ 0) ifTrue:[ |
|
2145 m2 := margin + margin. |
|
2146 innerClipRect := Rectangle left:margin top:margin |
|
2147 width:(width - m2) |
|
2148 height:(height - m2) |
|
2149 ] ifFalse:[ |
|
2150 innerClipRect := nil |
|
2151 ]. |
|
2152 self clipRect:innerClipRect |
|
2153 ! ! |
|
2154 |
|
2155 !View methodsFor:'realization'! |
|
2156 |
|
2157 create |
|
2158 "create (i.e. tell X about me) |
|
2159 this is kind of stupid - creation means XCreateWindow; |
|
2160 realizing means XMapWindow" |
|
2161 |
|
2162 drawableId isNil ifTrue:[ |
|
2163 "make certain, superview is created also" |
|
2164 |
|
2165 superView notNil ifTrue:[ |
|
2166 superView id isNil ifTrue:[ |
|
2167 superView create |
|
2168 ] |
|
2169 ]. |
|
2170 |
|
2171 "associate cursor/colors to device" |
|
2172 |
|
2173 viewBackground := viewBackground on:device. |
|
2174 borderColor := borderColor on:device. |
|
2175 shadowColor := shadowColor on:device. |
|
2176 lightColor := lightColor on:device. |
|
2177 cursor := cursor on:device. |
|
2178 |
|
2179 drawableId := device createWindowFor:self |
|
2180 left:left top:top |
|
2181 width:width height:height. |
|
2182 |
|
2183 extentChanged := false. |
|
2184 originChanged := false. |
|
2185 |
|
2186 borderShape notNil ifTrue:[ |
|
2187 device setWindowBorderShape:(borderShape id) in:drawableId |
|
2188 ]. |
|
2189 viewShape notNil ifTrue:[ |
|
2190 device setWindowShape:(viewShape id) in:drawableId |
|
2191 ]. |
|
2192 backed notNil ifTrue:[ |
|
2193 device setBackingStore:backed in:drawableId |
|
2194 ]. |
|
2195 saveUnder ifTrue:[ |
|
2196 device setSaveUnder:true in:drawableId |
|
2197 ]. |
|
2198 |
|
2199 font := font on:device. |
|
2200 " |
|
2201 self inputOnly ifFalse:[ |
|
2202 self initGC |
|
2203 ]. |
|
2204 " |
|
2205 self initializeMiddleButtonMenu. |
|
2206 self initEvents. |
|
2207 controller notNil ifTrue:[ |
|
2208 controller created:self |
|
2209 ] |
|
2210 ] |
|
2211 ! |
|
2212 |
|
2213 createWithAllSubViews |
|
2214 "create, then create all subviews" |
|
2215 |
|
2216 drawableId isNil ifTrue:[self create]. |
|
2217 subViews notNil ifTrue:[ |
|
2218 subViews do:[:subView | subView createWithAllSubViews] |
|
2219 ] |
|
2220 ! |
|
2221 |
|
2222 initializeMiddleButtonMenu |
|
2223 "a place to initialize menu - this one is sent once when the view is |
|
2224 first created; usually redefined in subclasses; default here is no menu" |
|
2225 |
|
2226 ^ self |
|
2227 ! |
|
2228 |
|
2229 fixSize |
|
2230 "adjust size of window according to either relative/abs or |
|
2231 block extent; also set origin" |
|
2232 |
|
2233 window notNil ifTrue:[ |
|
2234 ^ self superViewChangedSize |
|
2235 ]. |
|
2236 |
|
2237 "if the extent is not the one we created the window with ..." |
|
2238 extentChanged ifTrue:[ |
|
2239 controller notNil ifTrue:[ |
|
2240 controller sizeChanged:nil of:self |
|
2241 ] ifFalse:[ |
|
2242 self sizeChanged:nil |
|
2243 ]. |
|
2244 extentChanged := false |
|
2245 ]. |
|
2246 |
|
2247 originChanged ifTrue:[ |
|
2248 originRule notNil ifTrue:[ |
|
2249 self pixelOrigin:(originRule value) |
|
2250 ] ifFalse:[ |
|
2251 relativeOrigin notNil ifTrue:[ |
|
2252 self originFromRelativeOrigin |
|
2253 ] |
|
2254 ]. |
|
2255 originChanged := false |
|
2256 ] |
|
2257 ! |
|
2258 |
|
2259 realize |
|
2260 "realize - make visible; |
|
2261 realizing is done very late (after layout is fixed) to avoid |
|
2262 visible rearranging of windows on the screen" |
|
2263 |
|
2264 drawableId isNil ifTrue:[ |
|
2265 self create. |
|
2266 "if it is the first realize (which means a create), |
|
2267 force sizechange messages" |
|
2268 extentChanged := true. |
|
2269 originChanged := true |
|
2270 ]. |
|
2271 |
|
2272 hidden ifTrue:[ |
|
2273 ^ self |
|
2274 ]. |
|
2275 |
|
2276 realized ifFalse:[ |
|
2277 (originChanged or:[extentChanged]) ifTrue:[self fixSize]. |
|
2278 subViews notNil ifTrue:[ |
|
2279 subViews do:[:subView | |
|
2280 subView realize |
|
2281 ] |
|
2282 ]. |
|
2283 self setInnerClip. |
|
2284 |
|
2285 "and make it visible" |
|
2286 device mapWindow:drawableId. |
|
2287 realized := true |
|
2288 ] |
|
2289 ! |
|
2290 |
|
2291 rerealize |
|
2292 "rerealize at old position" |
|
2293 |
|
2294 device mapWindow:drawableId iconified:false |
|
2295 atX:left y:top |
|
2296 width:width height:height |
|
2297 ! |
|
2298 |
|
2299 destroy |
|
2300 "unrealize & destroy - make me invisible, destroy subviews then |
|
2301 make me unknown to the device" |
|
2302 |
|
2303 realized ifTrue:[ |
|
2304 self unrealize. |
|
2305 device synchronizeOutput. "make it go away immediately |
|
2306 - also, this hides the subview killing" |
|
2307 ]. |
|
2308 |
|
2309 model notNil ifTrue:[ |
|
2310 model removeDependent:self |
|
2311 ]. |
|
2312 controller := nil. |
|
2313 |
|
2314 [subViews notNil] whileTrue:[ |
|
2315 (subViews at:1) destroy |
|
2316 ]. |
|
2317 superView notNil ifTrue:[ |
|
2318 superView removeSubView:self. |
|
2319 superView := nil |
|
2320 ]. |
|
2321 super destroy |
|
2322 ! |
|
2323 |
|
2324 unrealize |
|
2325 "hide me" |
|
2326 |
|
2327 realized ifTrue:[ |
|
2328 drawableId notNil ifTrue:[ |
|
2329 device unmapWindow:drawableId |
|
2330 ]. |
|
2331 realized := false. |
|
2332 shown := false "23-feb-93" |
|
2333 ] |
|
2334 ! ! |
|
2335 |
|
2336 !View methodsFor:'drawing'! |
|
2337 |
|
2338 drawEdgesForX:x y:y width:w height:h level:l |
|
2339 shadow:shadowColor light:lightColor |
|
2340 halfShadow:halfShadowColor halfLight:halfLightColor |
|
2341 "draw 3D edges into a rectangle" |
|
2342 |
|
2343 |topLeftFg botRightFg topLeftHalfFg botRightHalfFg |
|
2344 count "{ Class: SmallInteger }" |
|
2345 r "{ Class: SmallInteger }" |
|
2346 b "{ Class: SmallInteger }" |
|
2347 xi "{ Class: SmallInteger }" |
|
2348 yi "{ Class: SmallInteger }" |
|
2349 run | |
|
2350 |
|
2351 (l < 0) ifTrue:[ |
|
2352 topLeftFg := shadowColor. |
|
2353 botRightFg := lightColor. |
|
2354 topLeftHalfFg := halfShadowColor. |
|
2355 botRightHalfFg := halfLightColor. |
|
2356 count := l negated |
|
2357 ] ifFalse:[ |
|
2358 topLeftFg := lightColor. |
|
2359 botRightFg := shadowColor. |
|
2360 topLeftHalfFg := halfLightColor. |
|
2361 botRightHalfFg := halfShadowColor. |
|
2362 count := l |
|
2363 ]. |
|
2364 r := x + w - 1. "right" |
|
2365 b := y + h - 1. "bottom" |
|
2366 |
|
2367 super lineWidth:0. |
|
2368 |
|
2369 "top and left edges" |
|
2370 (softEdge and:[l > 0]) ifTrue:[ |
|
2371 super paint:topLeftHalfFg |
|
2372 ] ifFalse:[ |
|
2373 super paint:topLeftFg |
|
2374 ]. |
|
2375 0 to:(count - 1) do:[:i | |
|
2376 run := y + i. |
|
2377 super displayLineFromX:x y:run toX:r y:run. "top" |
|
2378 run := x + i. |
|
2379 super displayLineFromX:run y:y toX:run y:b "left" |
|
2380 ]. |
|
2381 softEdge ifTrue:[ |
|
2382 " |
|
2383 super paint:topLeftFg. |
|
2384 super displayLineFromX:x y:y toX:r y:y. |
|
2385 super displayLineFromX:x y:y toX:x y:b |
|
2386 " |
|
2387 (l > 2) ifTrue:[ |
|
2388 super paint:Black. |
|
2389 super displayLineFromX:x y:y toX:r y:y. |
|
2390 super displayLineFromX:x y:y toX:x y:b. |
|
2391 ] |
|
2392 ]. |
|
2393 |
|
2394 xi := x + 1. |
|
2395 yi := y + 1. |
|
2396 |
|
2397 "bottom and right edges" |
|
2398 (softEdge) ifTrue:[ |
|
2399 super paint:botRightHalfFg |
|
2400 ] ifFalse:[ |
|
2401 super paint:botRightFg |
|
2402 ]. |
|
2403 0 to:(count - 1) do:[:i | |
|
2404 run := b - i. |
|
2405 super displayLineFromX:xi-1 y:run toX:r y:run. "bottom" |
|
2406 run := r - i. |
|
2407 super displayLineFromX:run y:yi-1 toX:run y:b. "right" |
|
2408 xi := xi + 1. |
|
2409 yi := yi + 1 |
|
2410 ]. |
|
2411 (softEdge and:[l > 1]) ifTrue:[ |
|
2412 super paint:shadowColor. |
|
2413 super displayLineFromX:(x + 1-1) y:b toX:r y:b. |
|
2414 super displayLineFromX:r y:(y + 1 - 1) toX:r y:b |
|
2415 ] |
|
2416 ! |
|
2417 |
|
2418 drawEdgesForX:x y:y width:w height:h level:l |
|
2419 "draw 3D edges into a rectangle" |
|
2420 |
|
2421 self drawEdgesForX:x y:y width:w height:h level:l |
|
2422 shadow:shadowColor light:lightColor |
|
2423 halfShadow:halfShadowColor halfLight:halfLightColor |
|
2424 ! |
|
2425 |
|
2426 drawLeftEdge |
|
2427 "draw left 3D edge into window frame" |
|
2428 |
|
2429 |leftFg leftHalfFg |
|
2430 count "{ Class: SmallInteger }" | |
|
2431 |
|
2432 (level < 0) ifTrue:[ |
|
2433 leftFg := shadowColor. |
|
2434 leftHalfFg := halfShadowColor. |
|
2435 count := level negated |
|
2436 ] ifFalse:[ |
|
2437 leftFg := lightColor. |
|
2438 leftHalfFg := halfLightColor. |
|
2439 count := level |
|
2440 ]. |
|
2441 |
|
2442 super lineWidth:0. |
|
2443 (softEdge and:[level > 0]) ifTrue:[ |
|
2444 super paint:leftHalfFg |
|
2445 ] ifFalse:[ |
|
2446 super paint:leftFg |
|
2447 ]. |
|
2448 0 to:(count - 1) do:[:i | |
|
2449 super displayLineFromX:i y:i toX:i y:(height - 1 - i) |
|
2450 ]. |
|
2451 (softEdge and:[level > 2]) ifTrue:[ |
|
2452 super paint:Black. |
|
2453 super displayLineFromX:0 y:0 toX:0 y:height-1. |
|
2454 ] |
|
2455 ! |
|
2456 |
|
2457 drawRightEdge |
|
2458 "draw right 3D edge into window frame" |
|
2459 |
|
2460 |rightFg |
|
2461 count "{ Class: SmallInteger }" |
|
2462 r| |
|
2463 |
|
2464 (level < 0) ifTrue:[ |
|
2465 rightFg := lightColor. |
|
2466 count := level negated |
|
2467 ] ifFalse:[ |
|
2468 (softEdge and:[level > 1]) ifTrue:[ |
|
2469 rightFg := halfShadowColor |
|
2470 ] ifFalse:[ |
|
2471 rightFg := shadowColor |
|
2472 ]. |
|
2473 count := level |
|
2474 ]. |
|
2475 |
|
2476 super lineWidth:0. |
|
2477 super paint:rightFg. |
|
2478 0 to:(count - 1) do:[:i | |
|
2479 r := width - 1 - i. |
|
2480 super displayLineFromX:r y:i toX:r y:(height - 1 - i) |
|
2481 ]. |
|
2482 (softEdge and:[level > 1]) ifTrue:[ |
|
2483 super paint:shadowColor. |
|
2484 super displayLineFromX:width-1 y:1 toX:width-1 y:height-1. |
|
2485 ] |
|
2486 ! |
|
2487 |
|
2488 drawTopEdge |
|
2489 "draw top 3D edge into window frame" |
|
2490 |
|
2491 |topFg topHalfFg |
|
2492 count "{ Class: SmallInteger }" | |
|
2493 |
|
2494 (level < 0) ifTrue:[ |
|
2495 topFg := shadowColor. |
|
2496 topHalfFg := halfShadowColor. |
|
2497 count := level negated |
|
2498 ] ifFalse:[ |
|
2499 topFg := lightColor. |
|
2500 topHalfFg := halfLightColor. |
|
2501 count := level |
|
2502 ]. |
|
2503 |
|
2504 super lineWidth:0. |
|
2505 (softEdge and:[level > 0]) ifTrue:[ |
|
2506 super paint:topHalfFg |
|
2507 ] ifFalse:[ |
|
2508 super paint:topFg |
|
2509 ]. |
|
2510 0 to:(count - 1) do:[:i | |
|
2511 super displayLineFromX:i y:i toX:(width - 1 - i) y:i |
|
2512 ]. |
|
2513 (softEdge and:[level > 2]) ifTrue:[ |
|
2514 super paint:Black. |
|
2515 super displayLineFromX:0 y:0 toX:width-1 y:0. |
|
2516 ] |
|
2517 ! |
|
2518 |
|
2519 drawBottomEdge |
|
2520 "draw bottom 3D edge into window frame" |
|
2521 |
|
2522 |botFg |
|
2523 count "{ Class: SmallInteger }" |
|
2524 b| |
|
2525 |
|
2526 (level < 0) ifTrue:[ |
|
2527 botFg := lightColor. |
|
2528 count := level negated |
|
2529 ] ifFalse:[ |
|
2530 (softEdge and:[level > 1]) ifTrue:[ |
|
2531 botFg := halfShadowColor |
|
2532 ] ifFalse:[ |
|
2533 botFg := shadowColor |
|
2534 ]. |
|
2535 count := level |
|
2536 ]. |
|
2537 |
|
2538 super lineWidth:0. |
|
2539 super paint:botFg. |
|
2540 0 to:(count - 1) do:[:i | |
|
2541 b := height - 1 - i. |
|
2542 super displayLineFromX:i y:b toX:(width "- 1" - i) y:b |
|
2543 ]. |
|
2544 (softEdge and:[level > 1]) ifTrue:[ |
|
2545 super paint:shadowColor. |
|
2546 super displayLineFromX:1 y:height-1 toX:width-1 y:height-1. |
|
2547 ] |
|
2548 ! |
|
2549 |
|
2550 redrawEdges |
|
2551 "redraw my edges if 3D" |
|
2552 |
|
2553 self is3D ifTrue:[ |
|
2554 (level ~~ 0) ifTrue:[ |
|
2555 self clipRect:nil. |
|
2556 self drawEdgesForX:0 y:0 |
|
2557 width:width height:height |
|
2558 level:level. |
|
2559 self clipRect:innerClipRect |
|
2560 ] |
|
2561 ] |
|
2562 ! |
|
2563 |
|
2564 redraw |
|
2565 "redraw myself |
|
2566 if there is a model, this one shall redraw itself, |
|
2567 otherwise we cannot do much here - has to be redefined in subclasses" |
|
2568 |
|
2569 model notNil ifTrue:[ |
|
2570 model update:self |
|
2571 ] |
|
2572 ! |
|
2573 |
|
2574 redrawX:x y:y width:w height:h |
|
2575 "have to redraw part - |
|
2576 default is to redraw everything - subclasses should add intelligence" |
|
2577 |
|
2578 |area| |
|
2579 |
|
2580 area := Rectangle left:x top:y width:w height:h. |
|
2581 self clippedTo:area do:[ |
|
2582 controller notNil ifTrue:[ |
|
2583 "ST-80 updating" |
|
2584 self update:#rectangle with:area |
|
2585 ] ifFalse:[ |
|
2586 components notNil ifTrue:[ |
|
2587 components do:[:aComponent | |
|
2588 (aComponent frame intersects:area) ifTrue:[ |
|
2589 aComponent drawIn:self offset:0@0 |
|
2590 ] |
|
2591 ] |
|
2592 ] ifFalse:[ |
|
2593 self redraw |
|
2594 ] |
|
2595 ] |
|
2596 ] |
|
2597 ! ! |
|
2598 |
|
2599 !View methodsFor:'events'! |
|
2600 |
|
2601 sizeChanged:how |
|
2602 "tell subviews if I change size" |
|
2603 |
|
2604 transformation := nil. "transformation becomes void" |
|
2605 subViews notNil ifTrue:[ |
|
2606 (how == #smaller) ifTrue:[ |
|
2607 subViews do:[:view | |
|
2608 view superViewChangedSize |
|
2609 ] |
|
2610 ] ifFalse:[ |
|
2611 "doing it reverse speeds up resizing - usually subviews |
|
2612 are created from top-left to bottom-right; therefore |
|
2613 bottom-right views will be moved/resized first, then top-left ones; |
|
2614 this avoids multiple redraws of subviews" |
|
2615 |
|
2616 subViews reverseDo:[:view | |
|
2617 view superViewChangedSize |
|
2618 ] |
|
2619 ] |
|
2620 ] |
|
2621 ! |
|
2622 |
|
2623 superViewChangedSize |
|
2624 "my superView has changed size; if I have relative |
|
2625 origin/extent or blocks to evaluate, do it now .." |
|
2626 |
|
2627 |oldWidth oldHeight oldTop oldLeft newExt newOrg |
|
2628 winSuper newWidth newHeight newLeft newTop newCorner |
|
2629 superWidth superHeight superWinWidth superWinHeight| |
|
2630 |
|
2631 oldWidth := width. |
|
2632 oldHeight := height. |
|
2633 oldTop := top. |
|
2634 oldLeft := left. |
|
2635 |
|
2636 viewport notNil ifTrue:[ |
|
2637 "if this view has a viewPort, resize a la st-80" |
|
2638 superView isNil ifTrue:[^ self]. |
|
2639 winSuper := superView window. |
|
2640 winSuper isNil ifTrue:[ |
|
2641 "take pixel size as window" |
|
2642 winSuper := 0@0 extent:(superView width@superView height) |
|
2643 ]. |
|
2644 |
|
2645 |
|
2646 superWidth := superView width. |
|
2647 superHeight := superView height. |
|
2648 superWinWidth := winSuper width. |
|
2649 superWinHeight := winSuper height. |
|
2650 newLeft := (viewport left - winSuper left) * superWidth // superWinWidth. |
|
2651 newTop := (viewport top - winSuper top) * superHeight // superWinHeight. |
|
2652 newWidth := superWidth * viewport width // superWinWidth. |
|
2653 newHeight := superHeight * viewport height // superWinHeight. |
|
2654 self pixelOrigin:(newLeft @ newTop). |
|
2655 self pixelExtent:(newWidth @ newHeight). |
|
2656 ^ self |
|
2657 ]. |
|
2658 |
|
2659 (originRule notNil) ifTrue:[ |
|
2660 newOrg := originRule value |
|
2661 ] ifFalse:[ |
|
2662 (relativeOrigin notNil) ifTrue:[ |
|
2663 "self originFromRelativeOrigin " |
|
2664 newOrg := self originFromRelativeOrigin. |
|
2665 " |
|
2666 borderWidth ~~ 0 ifTrue:[ |
|
2667 newOrg := newOrg - (borderWidth @ borderWidth) |
|
2668 ] |
|
2669 " |
|
2670 ] |
|
2671 ]. |
|
2672 |
|
2673 (cornerRule notNil) ifTrue:[ |
|
2674 newCorner := cornerRule value |
|
2675 ] ifFalse:[ |
|
2676 (relativeCorner notNil) ifTrue:[ |
|
2677 newCorner := self cornerFromRelativeCorner |
|
2678 ] ifFalse:[ |
|
2679 (extentRule notNil) ifTrue:[ |
|
2680 newExt := extentRule value |
|
2681 ] ifFalse:[ |
|
2682 (relativeExtent notNil) ifTrue:[ |
|
2683 newExt := self extentFromRelativeExtent |
|
2684 ] |
|
2685 ]. |
|
2686 ] |
|
2687 ]. |
|
2688 |
|
2689 newOrg notNil ifTrue:[ |
|
2690 ((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[ |
|
2691 newOrg := nil |
|
2692 ] |
|
2693 ]. |
|
2694 newCorner notNil ifTrue:[ |
|
2695 (newCorner = self corner) ifTrue:[ |
|
2696 newCorner := nil |
|
2697 ] ifFalse:[ |
|
2698 self corner isNil ifTrue:[ |
|
2699 newExt notNil ifTrue:[ |
|
2700 ((newExt x == oldWidth) and:[newExt y == oldHeight]) ifTrue:[ |
|
2701 newExt := nil |
|
2702 ] |
|
2703 ]. |
|
2704 ] |
|
2705 ] |
|
2706 ]. |
|
2707 |
|
2708 newCorner isNil ifTrue:[ |
|
2709 newExt isNil ifTrue:[ |
|
2710 newOrg notNil ifTrue:[ |
|
2711 self pixelOrigin:newOrg |
|
2712 ] |
|
2713 ] ifFalse:[ |
|
2714 newOrg isNil ifTrue:[ |
|
2715 self pixelExtent:newExt |
|
2716 ] ifFalse:[ |
|
2717 self pixelOrigin:newOrg extent:newExt |
|
2718 ] |
|
2719 ] |
|
2720 ] ifFalse:[ |
|
2721 newOrg isNil ifTrue:[ |
|
2722 self pixelCorner:newCorner |
|
2723 ] ifFalse:[ |
|
2724 self pixelOrigin:newOrg corner:newCorner |
|
2725 ] |
|
2726 ] |
|
2727 ! |
|
2728 |
|
2729 configureX:x y:y width:newWidth height:newHeight |
|
2730 "my size has changed by window manager action" |
|
2731 |
|
2732 |how anyEdge mustRedrawBottomEdge mustRedrawRightEdge| |
|
2733 |
|
2734 left := x. |
|
2735 top := y. |
|
2736 ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[ |
|
2737 realized ifFalse:[ |
|
2738 width := newWidth. |
|
2739 height := newHeight. |
|
2740 extentChanged := true. |
|
2741 ^ self |
|
2742 ]. |
|
2743 |
|
2744 ((newWidth <= width) and:[newHeight <= height]) ifTrue:[ |
|
2745 how := #smaller |
|
2746 ]. |
|
2747 |
|
2748 self is3D ifTrue:[ |
|
2749 mustRedrawBottomEdge := newHeight < height. |
|
2750 mustRedrawRightEdge := newWidth < width. |
|
2751 anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge] |
|
2752 ] ifFalse:[ |
|
2753 anyEdge := false |
|
2754 ]. |
|
2755 |
|
2756 width := newWidth. |
|
2757 height := newHeight. |
|
2758 |
|
2759 "recompute inner-clip if needed" |
|
2760 self setInnerClip. |
|
2761 |
|
2762 controller notNil ifTrue:[ |
|
2763 controller sizeChanged:how of:self |
|
2764 ] ifFalse:[ |
|
2765 self sizeChanged:how |
|
2766 ]. |
|
2767 |
|
2768 anyEdge ifTrue:[ |
|
2769 self clipRect:nil. |
|
2770 mustRedrawBottomEdge ifTrue:[ |
|
2771 self drawBottomEdge |
|
2772 ]. |
|
2773 mustRedrawRightEdge ifTrue:[ |
|
2774 self drawRightEdge |
|
2775 ]. |
|
2776 self clipRect:innerClipRect |
|
2777 ] |
|
2778 ] |
|
2779 ! |
|
2780 |
|
2781 mapped |
|
2782 "the view has been mapped (by some outside |
|
2783 action - i.e. window manager de-iconified me)" |
|
2784 |
|
2785 realized := true. |
|
2786 shown := true |
|
2787 ! |
|
2788 |
|
2789 unmapped |
|
2790 "the view has been unmapped (by some outside |
|
2791 action - i.e. window manager iconified me)" |
|
2792 |
|
2793 shown := false |
|
2794 ! |
|
2795 |
|
2796 exposeX:x y:y width:w height:h |
|
2797 "a low level redraw event from device |
|
2798 - let subclass handle the redraw and take care of edges here" |
|
2799 |
|
2800 |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh| |
|
2801 |
|
2802 nw := w. |
|
2803 nh := h. |
|
2804 nx := x. |
|
2805 ny := y. |
|
2806 |
|
2807 anyEdge := false. |
|
2808 |
|
2809 "check if there is a need to draw an edge" |
|
2810 |
|
2811 (margin ~~ 0) ifTrue:[ |
|
2812 leftEdge := false. |
|
2813 topEdge := false. |
|
2814 rightEdge := false. |
|
2815 botEdge := false. |
|
2816 (x < margin) ifTrue:[ |
|
2817 nx := margin. |
|
2818 nw := nw - (nx - x). |
|
2819 leftEdge := true. |
|
2820 anyEdge := true |
|
2821 ]. |
|
2822 ((x + w - 1) >= (width - margin)) ifTrue:[ |
|
2823 nw := (width - margin - nx). |
|
2824 rightEdge := true. |
|
2825 anyEdge := true |
|
2826 ]. |
|
2827 (y < margin) ifTrue:[ |
|
2828 ny := margin. |
|
2829 nh := nh - (ny - y). |
|
2830 topEdge := true. |
|
2831 anyEdge := true |
|
2832 ]. |
|
2833 ((y + h - 1) >= (height - margin)) ifTrue:[ |
|
2834 nh := (height - margin - ny). |
|
2835 botEdge := true. |
|
2836 anyEdge := true |
|
2837 ] |
|
2838 ]. |
|
2839 |
|
2840 "redraw inside area" |
|
2841 |
|
2842 self redrawX:nx y:ny width:nw height:nh. |
|
2843 |
|
2844 "redraw edge(s)" |
|
2845 |
|
2846 anyEdge ifTrue:[ |
|
2847 self clipRect:nil. |
|
2848 (topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[ |
|
2849 self drawEdgesForX:0 y:0 |
|
2850 width:width height:height |
|
2851 level:level |
|
2852 ] ifFalse:[ |
|
2853 topEdge ifTrue:[ |
|
2854 self drawTopEdge |
|
2855 ]. |
|
2856 leftEdge ifTrue:[ |
|
2857 self drawLeftEdge |
|
2858 ]. |
|
2859 botEdge ifTrue:[ |
|
2860 self drawBottomEdge |
|
2861 ]. |
|
2862 rightEdge ifTrue:[ |
|
2863 self drawRightEdge |
|
2864 ] |
|
2865 ]. |
|
2866 self clipRect:innerClipRect |
|
2867 ] |
|
2868 ! |
|
2869 |
|
2870 keyPress:key x:x y:y |
|
2871 "a key has been pressed. |
|
2872 if there is a keyboardHandler, pass input to him" |
|
2873 |
|
2874 "allow forwarding events to the keyboardhandler" |
|
2875 keyboardHandler notNil ifTrue:[ |
|
2876 keyboardHandler keyPress:key x:x y:y |
|
2877 ] ifFalse:[ |
|
2878 super keyPress:key x:x y:y |
|
2879 ] |
|
2880 ! |
|
2881 |
|
2882 buttonPress:button x:x y:y |
|
2883 "button was pressed - if its middle button and there is a menu, show it." |
|
2884 |
|
2885 |menu menuSelector| |
|
2886 |
|
2887 (button == 2) ifTrue:[ |
|
2888 "try ST-80 style menus first" |
|
2889 model notNil ifTrue:[ |
|
2890 menuSymbol notNil ifTrue:[ |
|
2891 menu := model perform:menuSymbol. |
|
2892 menu notNil ifTrue:[ |
|
2893 menuSelector := menu startUp. |
|
2894 menuSelector ~~ 0 ifTrue:[ |
|
2895 model perform:menuSelector |
|
2896 ] |
|
2897 ]. |
|
2898 ^ self |
|
2899 ] |
|
2900 ] |
|
2901 ]. |
|
2902 super buttonPress:button x:x y:y |
|
2903 ! |
|
2904 |
|
2905 waitForExpose |
|
2906 "after a scroll, we have to wait for expose/noexpose" |
|
2907 |
|
2908 device dispatchExposeEventsFor:drawableId |
|
2909 ! |
|
2910 |
|
2911 terminate |
|
2912 "window manager wants me to go away" |
|
2913 |
|
2914 ^ self destroy |
|
2915 ! |
|
2916 |
|
2917 saveAndTerminate |
|
2918 "window manager wants me to save and go away" |
|
2919 |
|
2920 ^ self destroy |
|
2921 ! ! |