prev back

Quick introduction to view programming

This document is not yet finished

Contents

Introduction

This document should give you a quick start to using the ST/X View & Widget classes. It consists of a tutorial text and code fragments to give you some starting point. Of course, its far from being complete.

Learning is usually much better 'by doing' than 'by reading manuals'.
Therefore, I suggest, you best learn by creating your own little goodies, taking existing code as example (i.e. copy some code which creates a view looking similar to what you need, and modify/enhance it step by step).

The examples below can be selected and evaluated using doit from the menu or by typing CMD-d on the keyboard.
If you are looking at this text using a WWW reader, copy the code fragments in the viewer and paste it into a workspace. Then select and execute it there.

You should read the text and the examples code, try to understand what is going on, execute the example and play around with the parameters (i.e. get the code into a workspace, modify it and execute it again).

Each example gives you some new information based on the previous ones, thus providing step by step lessions. For beginners, it does not make sense to skip examples. Read the text, and execute the corresponding examples in sequence.

Also, you may (should) look into the actual code implementing the used functionality. Do so by opening a SystemBrowser and inspect the code. Since the examples only cover a fraction of the full functionality, this reading may also lead to more advanced uses of some classes.
As a side effect, you will also learn how to find your way through the system using the various search functions in the browser.

Close all example views using the window manager.

Model-View-Controller operation

In Smalltalk/X, widgets can be used both with and without a model. For simple widgets, there is usually no need to define or create a model; instead, the operation of the widget can be controlled by giving it an actionBlock which is evaluated on user interaction.

The following chapters will mostly describe this non-MVC operation.
MVC operation is described in more detail in a section below.

TopViews

In Smalltalk/X, most visible User Interface (UI) elements are derived from a common superclass, called View. A view can have subviews, and each of these subviews has that view as their common superview. The one view in such a hierarchy, which has no superview, is called a topview. Topviews are the outermost views, which usually get decorated by labels and borders by your X-window manager.

Notice for the curious:

Topviews also play a special game in ST/X with respect to event handling:
a topView together with all of its subviews are handled by one process within ST/X and will usually be served from one shared event queue.
This means, that within such a so called windowGroup execution is normally not parallel. (However, with some tricks, you can arrange for subviews to be put into separate windowgroups.)
Let us create & show our first view:
(select the code-line below, and execute the doIt-function from the menu)
    (View new) open          "create a view, and make it show itself"
The above code performs two steps:

Instances of this (general) view-class do not support icons and window-labels. There is a specialized class, called StandardSystemView, which was written exactly for that purpose. Usually, all of your topviews should be instances of this class, or of a subclass of it.
Although it is possible to use any view as a topView (as was done in the above example and will be done later for demonstration purposes), applications should use an instance of StandardSystemView as the topView.

modeless vs. modal open

After creation (with View new), the view is not visible - it was simply created and some internals where initialized.
It can be shown under control of the current process with:
    v openModal
or, detached as a separate process, with:
    v openModeless
Your application views should normally run as a separate process (except, if its some kind of dialog box. If nonmodal, errors occuring in it will not affect the view which created and realized your view.

Also, no interaction is possible with the previously active view while the other view is open, if it was opened modal. Modal views are typically used for dialogboxes or popup menus.

Each view knows what is the most useful way of opening itself, thus the general

    v open
is defined according to that. (i.e. sending open to a StandardSystemView will open it modeless, while sending it to some dialogbox will open it modal).
Therefore, you usually do not have to care about this yourself, just use open for all views (of course, there could be applications where this is not true, there you should use an explicit openModal or openModeless).

labels, icons & titles

lets see how a standardSystemViews gets more decoration:
    |v|
    v := StandardSystemView new.                        "create new topview"
    v label:'Hello World'.                              "set its window-label"
    v icon:(Image fromFile:'bitmaps/hello_world.icon'). "set its icon"  
    v iconLabel:'world'.                                "set its iconlabel"
    v open                                              "- bring it up"
Just to see the difference, try (read on before doing it):
    |v|
    v := StandardSystemView new.               
    v label:'Hello World'.                    
    v icon:(Image fromFile:'bitmaps/hello_world.icon').   
    v iconLabel:'world'.                        
    v openModal                                          "- bring it up modal"
and find out, that you cannot interact with me (the view showing this text) until the helloview is closed. However, you can still interact with other topviews. Close the helloview with the window manager.

There is currently no ST/X icon editor available, but you can create and edit bitmaps using X's bitmap tools, or any other icon editor provided by your system. (ST/X supports many different image formats: XBM, XPM, sun-ICON , windows & OS/2's BMP formats, GIF, face and even TIFF and Targa formats).

The following demonstrates this with a nice icon:

    |v|
    v := StandardSystemView new.                        
    v label:'Hello World'.                              
    v icon:((Image fromFile:'bitmaps/garfield.gif') magnifyBy:0.2 @ 0.2).  
    v iconLabel:'world'.                                
    v open                                            

dimensions & position

The view will come up in its default dimension (i.e. extent), which is defined in the classes defaultExtent-method. For StandardSystemView, the default value is (some stupid) 640@400 (read as: "640 pixels wide and 400 pixels high"), for other views it is 100@100 (which is also normally not what you want).

You may want to change a views extent with:

    v extent:(400 @ 300)
or (better style !) in a device independent way, with:
    v extent:(Display horizontalPixelPerMillimeter * 20)
	     @
	     (Display verticalPixelPerMillimeter * 10)
Now you see, why opening is a separate action from view creation: you can change all these settings before the view is visible - otherwise you would get quite some visible action on your display (try changing the extent after the open).
    |v|
    v := StandardSystemView new.               
    v label:'Hello World'.                     
    v icon:(Image fromFile:'bitmaps/hello_world.icon').  
    v iconLabel:'world'.                      
    v extent:(400 @ 300).                        "- set its extent"
    v open
the views extent is normally under control of the window system. This means, that usually the window manager lets the user specify the size of the view (however, some show the view immediately).
In any case, you can define some limits, which the window system should honor:
    |v|
    v := StandardSystemView new.              
    v label:'try to resize me'.                    
    v extent:(300 @ 300).
    v maxExtent:(600 @ 600).
    v minExtent:(200 @ 200).
    v open
you already thought this: a fix size is done with:
    |v|
    v := StandardSystemView new.              
    v label:'no way to resize me'.                    
    v extent:(300 @ 300).
    v maxExtent:(300 @ 300).
    v minExtent:(300 @ 300).
    v open
Excercise:
add a method fixExtent: to the StandardSystemView-class which does this more convenient.
A views position is called origin and is specified much like its extent. Be prepared, that most window managers simply ignore the given origin for topViews - either placing it somewhere on the screen, or asking the user to position the view by showing a ghostline.
You can specify view position and dimension both in pixels (as above) or relative to the superviews size. If the coordinate(s) in a origin:, extent: or corner: -message is integer, it is interpreted as pixels. If its a float or fraction, its value should be between 0.0 and 1.0 and is interpreted as that fraction of the superviews size.
For topviews the superview is the screen - thus:
	|v|
	v := StandardSystemView
		 origin:(0.25 @ 0.25)
		 corner:(0.75 @ 0.75).
	v open
creates a topview with half-width and half-height of the sceen. (Notice, that some window managers insist on letting the user specify the origin of the view - thus the origin argument may be ignored on some systems).

The final and most flexible way of specifying these is by passing a computation rule as a block.
You can do arbitrary complex size computations in these blocks. The block will be (re)evaluated whenever the superviews size changes.
Example:
(ignore the button details here - it will be described later.
Concentrate on the origin: and corner:-stuff):

	|top b originalHeight|

	top := StandardSystemView new.
	top extent:(200 @ 200).

	b := Button label:'hello' in:top.
	originalHeight := b height.
	b origin:(10 @ 10).
	b corner:[ (top width - 10) @ (10 + originalHeight) ].

	top realize.
notice that the block uses the buttons remembered original height - which is the buttons preferred height originally computed at the buttons creation time. Thus the button will have a fixed height, combined with a variable width.

If you base your computation on some other subviews position or size, you should keep in mind that those blocks are evaluated in the order in which those subviews where created within the superview.
Example:

	|top b1 b2 h1 h2|

	top := StandardSystemView new.
	top extent:(200 @ 200).

	b1 := Button label:'hello' in:top.
	h1 := b1 height.
	b1 origin:(10 @ 10).
	b1 corner:[ (top width // 2 - 5) @ (10 + h1) ].

	b2 := Button label:'wow' in:top.
	h2 := b2 height.
	b2 origin:[ (b1 corner x + 5) @ 10 ].
	b2 corner:[ (top width - 10) @ (10 + h2) ].

	top realize.
the following example demonstrates the effect of the evaluation order and will not work correctly:
(because b2's rule-block will always be evaluated before b1's rule, while depending on the value computed in b1's rule. Thus the old corner of b1 will be used in the computation of b2's origin.)
	|top b1 b2 h1 h2|

	top := StandardSystemView new.
	top extent:200 @ 200.

	b2 := Button label:'wow' in:top.
	h2 := b2 height.
	b2 origin:[(b1 corner x + 5) @ 10].
	b2 corner:[(top width - 10) @ (10 + h2)].

	b1 := Button label:'hello' in:top.
	h1 := b1 height.
	b1 origin:(10 @ 10).
	b1 corner:[(top width // 2 - 5) @ (10 + h1)].

	top realize.
Note for advanced use:
You can force evaluation of these blocks (i.e. simulating a size-change) by sending sizeChanged: to the superview or superViewChangedSize to the subview(s).
Hint:
Although you can also specify the extent as relative extent it is not wise to do so, since rounding errors may lead to off-by-one pixel errors (for example, specifying a width of 0.5 for two views side-by-side, will produce a one-pixel error if the superviews width has an odd number of pixels, leading to an ugly looking layout.
Using relative corner instead will produce a good looking result; however, one of the views will be smaller by one pixel in this case.

general view appearance

A views appearance consists of many paramaters, to name some. In general, if using existing widgets for your application, you should not specify these explicit, but depend on the default values, which are provided by a so called styleSheet.
Doing so makes it possible to change the appearance and make ST/X applications fit nicely into existing frameworks.

dont fight the style sheet

The headline already says it: dont hardcode any style settings into your code (it used to be in previous versions of ST/X and took hard work to make it more flexible - dont repeat my bugs).

In situations, where the default values are not acceptable, read the value from the styleSheet (after all, its nothing more than a table of name<->value associations). For example, if you have a button which you think should show itself in red color, dont hardcode Color red into your application. Instead, use something like:

    StyleSheet colorAt:'mySpecialButtonsColor' default:Color red
This avoids dictating your personal style onto other users.

As always, there are some exceptions to the above rule. For example, the default border for views is 1-pixel of black in the normal (i.e. non 3D) style. If you want to use a simple view for grouping (as described below), you usually do not want a border to be visible. In this case, you can set the border explicit to zero.

Layout views

using subviews for layout

Typical applications consist of many elements which have to be organized into topviews. The follwoing chapter describes how subviews are arranged and how to control the layout.

For very simple layouts, use just another subview, as in:

    |top frame1 frame2|

    top := StandardSystemView label:'wow'.

    frame1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:top.
    frame2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:top.

    top open
(please read on, if you think the example does not work ...)
Notice, that the origin and corners are given as floating point (i.e. rational) numbers in the range [0..1]. In this case, they are interpreted as fraction of the superviews extent.

Remember:

integer values are interpreted in pixel,
rationals as relative to the superviews size
When doing your first experiments, you may run into this when erronously using "1" instead of "1.0" as a dimension in the extent or corner parameter.

3D level, border & background

You will NOT see the subviews in the above example, because all have the same background, and no border around (non-3D styles will show a border though). For some 3D effect, you can make views "come out-of" or "go-into" the display, by setting its Z-level relative to the superView.
As in:
    |top frame1 frame2|

    top := StandardSystemView label:'wow'.

    frame1 := View origin:(0.1 @ 0.1) corner:(0.9 @ 0.5) in:top.
    frame2 := View origin:(0.1 @ 0.6) corner:(0.9 @ 0.9) in:top.

    frame1 level:-1.
    frame2 level:-1.

    top realize
or:
    |top frame1 frame2|

    top := StandardSystemView label:'wow'.

    frame1 := View origin:(0.1 @ 0.1) corner:(0.9 @ 0.9) in:top.
    frame2 := View origin:(0.25 @ 0.25) corner:(0.75 @ 0.75) in:frame1.

    frame1 level:2.
    frame2 level:-2.

    top realize
On non 3D view styles (see configuration), the level is ignored. Here you can try:
    |top frame1 frame2|

    top := StandardSystemView label:'wow'.

    frame1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:top.
    frame2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:top.

    frame1 viewBackground:(Color grey:50).
    frame2 viewBackground:(Color red:75 green:75 blue:25).

    top realize
Which also shows us how to use colors, and how a views background color is defined.

By the way:
the values given to grey: and red:green:blue: are interpreted in percent, thus

    Color red:100 green:100 blue:0
is yellow, while
    Color grey:25
is some darkish grey.
For the standard colors, there are also shorter messages, such as Color red, Color blue etc. For ST-80 compatibility, you can also use Color brightness:value. Here the argument is in [0..1].

On black&white displays, Smalltalk has a hard time to try to get colors onto the screen - of course. But at least it does its best it can (it will put a grey pattern, corresponding to the colors brightness into the view).
On greyscale displays, a grey color corresponding to the colors brightness will be used.

Thus, you really do not have to care for which type of display your program will finally run on. However, when designing your application, you should keep in mind that others may have displays with less capabilities than yours and the colors may be replaced by greyscales.
Never depend only on colors for highlighting or marking. For example, red-on-green may produce a good contrast on your color screen, but may not be visible on your friends greyscale or b&w display.

... and background pattern

Aaah, before I forget, not only colors can be defined as background; have a look at:
    |top frame1 frame2|

    top := StandardSystemView label:'wow'.

    frame1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:top.
    frame2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:top.

    frame1 viewBackground:(Image fromFile:'bitmaps/garfield.gif').
    frame2 viewBackground:(Image fromFile:'bitmaps/hello_world.icon').

    top realize
Notice, that Image fromFile: is able to find out the file format itself. The first image in the above example is a depth-8 GIF encoded palette image, while the second is a monochrome bitmap in sun-icon file format.
More formats are supported (TIFF, XBM, XPM, ST80-Form, Face and Windows-bitmap). Also notice, that the above example works on any kind of display: on monochrome or greyscale displays, the image will be converted to some useful approximation (dithered).

Of course, the bitmaps can also be specified directly in your code (but, it is always better, to load them from a file - thereby allowing for more flexibility):

    |top|

    top := StandardSystemView label:'a pattern'.
    top extent:100@100.

    top viewBackground:(Form width:8 
			     height:8 
			     fromArray:#(2r11001100
					 2r00110011
					 2r11001100
					 2r00110011
					 2r11001100
					 2r00110011
					 2r11001100
					 2r00110011)).
    top realize
or:
    |top|

    top := StandardSystemView label:'a smiley pattern'.
    top extent:100@100.

    top viewBackground:(Form width:12 
			     height:11
			     fromArray:#(
					 2r00000000 2r0000
					 2r00000000 2r0000
					 2r11000110 2r0000                                         
					 2r11000110 2r0000
					 2r00000000 2r0000
					 2r00011000 2r0000
					 2r00011000 2r0000
					 2r00011000 2r0000
					 2r01000010 2r0000
					 2r01100110 2r0000
					 2r00111100 2r0000)).
    top realize
As you see, constant bitmaps are defined in chunks of 8 pixels, left to right.

You can specify a colormap to be used with monochrome mitmaps too:

    |top bitmap|

    top := StandardSystemView label:'a pattern'.
    top extent:100@100.

    bitmap := (Form width:12 
		   height:11
		fromArray:#(
			    2r00000000 2r0000
			    2r00000000 2r0000
			    2r11000110 2r0000                                         
			    2r11000110 2r0000
			    2r00000000 2r0000
			    2r00011000 2r0000
			    2r00011000 2r0000
			    2r00011000 2r0000
			    2r01000010 2r0000
			    2r01100110 2r0000
			    2r00111100 2r0000)).
    bitmap colorMap:(Array with:Color red        "to be used for 0-bits"
			   with:Color yellow).    "used for 1-bits"

    top viewBackground:bitmap.
    top realize
Just to show what is possible, try the following (buttons will be explained below in more detail):
	|v b granite wood|

	granite := (Image fromFile:'bitmaps/granite.tiff').
	wood := (Image fromFile:'bitmaps/woodH.tiff').

	v := StandardSystemView label:'rock solid'.
	v extent:300@300.
	v viewBackground:granite.
	b := Button label:'quit' in:v.
	b backgroundColor:wood.
	b activeBackgroundColor:wood.
	b enteredBackgroundColor:wood.
	b action:[v destroy].
	b origin:(0.5 @ 0.5).
	b leftInset:(b width // 2) negated.
	b topInset:(b height // 2) negated.
	v open.

inset

Lets go back to view geometry. You can also specify a so called inset on the views corner coordinates in pixels. This allows you to create views where the extent is based on the superviews size, but offset by some margin. For example, to create 2 subviews which take half of the superviews width, AND have some 4-millimeter margin in between, use:
	|top sub1 sub2 mm|

	mm := Display verticalPixelPerMillimeter rounded.
	top := StandardSystemView label:'wow'.
	sub1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:top.
	sub1 level:-1.
	sub1 bottomInset:(mm * 2).

	sub2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:top.
	sub2 level:-1.
	sub2 topInset:(mm * 2).

	top realize
or:
(have a careful look at the labels definition - negative insets are possible and very useful).
	|top sub1 sub2 lbl mm|

	mm := Display verticalPixelPerMillimeter rounded.
	top := StandardSystemView label:'wow'.
	sub1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:top.
	sub1 level:-1.
	sub1 topInset:mm.
	sub1 leftInset:mm.
	sub1 rightInset:mm.
	sub1 bottomInset:mm // 2.


	sub2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:top.
	sub2 level:-1.
	sub2 topInset:mm // 2.
	sub2 bottomInset:mm * 10.
	sub2 leftInset:mm.
	sub2 rightInset:mm.

	lbl := Label label:'info:' in:top.
	lbl adjust:#left.
	lbl level:-1.
	lbl origin:(0.0 @ 1.0) corner:(1.0 @ 1.0).
	lbl topInset:(mm * 9) negated.         
	lbl bottomInset:mm.         
	lbl leftInset:mm.
	lbl rightInset:mm.

	top realize
HINT:
Negative insets are useful, if you want to place some view at the bottom or right of its superview, and you want a constant distance from that edge. For example, the instance/class toggles in the browser could be created this way (the inset is choosen so that the Toggles are always at the bottom):
	|frame toggleI toggleC hI hC|

	frame := View new.
	frame extent:(300 @ 100).

	toggleI := Toggle label:'instance' in:frame.
	toggleC := Toggle label:'class' in:frame.
	"
	 get the default (preferred) heights before changing
	 the extent ...
	"
	hI := toggleI height.
	hC := toggleC height.

	"
	 now set the origin to the corner to the bottom
	 (actually shrinking their height to 0 temporarily)
	"
	toggleI origin:(0.0 @ 1.0) corner:(0.5 @ 1.0).
	toggleC origin:(0.5 @ 1.0) corner:(1.0 @ 1.0).

	"
	 finally, set their top-inset to have them
	 appear at their preferred height from the bottom line
	"
	toggleI topInset:(hI negated).
	toggleC topInset:(hC negated).

	frame open.
Without negative insets, a somewhat complicated block would be needed to compute the origin and size of those toggles (taking care of round-off errors, odd sizes and borders ...)

Of course, an alternative is to use Panels. These will be described below in detail.

panels

Often, you need to arrange many little subviews (Buttons, Labels etc.) in a view, and have them automatically rearrange, when the superview changes its size. To do so, use one of PanelView, HorizontalPanelView and VerticalPanelView.
They differ in the arrangement preference:
VerticalPanelView always arranges its elements top-to-bottom. HorizontalPanelView always arranges left-to-right. Finally, the general PanelView arranges from top-left to bottom-right.
Try:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 300.

    panel := VerticalPanelView origin:(0.0 @ 0.0)
			       corner:(1.0 @ 1.0)
				   in:top.

    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
(I hope you already know some Smalltalk, to understand this ... :-)

By default, the panel centers its elements with some 1mm (millimeter) spacing between the elements (try resizing the view). If they do not fit, the spacing is reduced. If they still dont fit, some elements may not be visible.
You can arrange elements different as in:

    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 400.

    panel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel layout:#top.  "not centered, but at top"
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
You can specify #top, #topSpace, #bottom, #bottomSpace, #center, #spread, #spreadSpace, #fit or #fitSpace as layout strategy.
#top arranges elements at the top; #bottom at the bottom; #center places elements centered, while #spread spreads them equally. Finally, #fit will resize the elements to fill the panel completely.
The additional #xxxSpace layouts behave basically like their corresponding nonSpace leyouts, but start with a spacing.
Try:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 300.

    panel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel layout:#fit.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
Try the above with #fit replaced by any other and see the difference.

The twin of the VerticalPanelView is the HorizontalPanelView, which offers the same layout startegies, but does things horizontally.

    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:550 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel layout:#spread.  "not centered, but at evenly distributed"
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
The layouts supported by HorizontalPanelView are #left, #leftSpace, #right, #rightSpace, #center, #spread and #fit.
Try the other layouts too.

You can specify the horizontal layout to be different from the vertical layout; also, the spacing between elements can be changed in both horizontal and vertical directions. This allows for some very nice element arrangements. See more examples in the classes example category.

Finally, a PanelView arranges multiple rows, buts is currently not able to have the layout specified as detailed as above. It simply fills itself with the elements starting top-left to bottom-right.:

    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 100.

    panel := PanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
You can change the space between elements (in all PanelViews) as in:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 100.

    panel := PanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel horizontalSpace:0.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
or:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 100.

    panel := PanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel horizontalSpace:0.
    panel verticalSpace:0.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
Of course, you can arrange any kind of view in panels:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:160 @ 200.

    panel := PanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel horizontalSpace:5.
    panel verticalSpace:10.
    #('one' 'two' 'three' 'four' 'five')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    (Label label:'label1' in:panel) level:-1.
    (Label label:'label2' in:panel) level:1.
    Toggle label:'toggle1' in:panel.
    View extent:50@10 in:panel.    "just a separator"
    #('six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
Adding empty views allows grouping:
    |top panel|

    top := StandardSystemView label:'buttons'.
    top extent:350 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel horizontalSpace:0.
    #('one' 'two' 'three')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    View extent:30@10 in:panel.    "just a separator"
    #('four' 'five')
    do:[:thisLabel |
	Toggle label:thisLabel in:panel
    ].
    View extent:30@10 in:panel.    "just a separator"
    #('six' 'seven' 'eight')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
combining a layout of #fit with an empty spacing, gives you dense packing:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 300.

    panel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel layout:#fit.
    panel verticalSpace:0.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	Button label:thisLabel in:panel
    ].
    top realize.
in a vertical panel, you can still control horizontal sizes of the elements (and vice versa). Try:
    |top panel|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 300.

    panel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
    panel layout:#fit.
    panel verticalSpace:0.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	|button|

	button := Button label:thisLabel in:panel.
	button width:1.0.
    ].
    top realize.
Usually, you would want to do something with those buttons later, so better keep them around somewhere - as in:
    |top panel buttons|

    top := StandardSystemView label:'many buttons'.
    top extent:100 @ 300.

    panel := VerticalPanelView origin:(0.0 @ 0.0)
			       corner:(1.0 @ 1.0)
				   in:top.

    buttons := OrderedCollection new.
    #('one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine' 'ten')
    do:[:thisLabel |
	buttons add:(Button label:thisLabel in:panel)
    ].
    top realize.

    (buttons at:5) disable.
    (buttons at:4) action:[(buttons at:5) enable].
    (buttons at:5) action:[(buttons at:5) disable].
Can you imagine, what this does ? (try to find out before starting it :-)

variable panels

Finally, there are panels, which allow variable relative sizes: the VariableHorizontalPanel and VariableVerticalPanel. Most browsers use these to allow for a variable ratio between their selection list and their codeview.
Try:
    |top panel subview1 subview2|

    top := StandardSystemView label:'hello'.

    panel := VariableVerticalPanel origin:(0.0 @ 0.0)
				   corner:(1.0 @ 1.0)
				       in:top.

    subview1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:panel.
    subview2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:panel.

    subview1 viewBackground:Color red.
    subview2 viewBackground:(Image fromFile:'bitmaps/garfield.gif').
    top realize
you may want to add some 3D effects, as in:
    |top panel subview1 subview2|

    top := StandardSystemView label:'hello'.

    panel := VariableVerticalPanel origin:(0.0 @ 0.0)
				   corner:(1.0 @ 1.0)
				       in:top.

    subview1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:panel.
    subview2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:panel.
    subview1 level:-1.
    subview2 level:-1.
    top realize
or (just a try):
    |top panel subview1 subview2|

    top := StandardSystemView label:'hello'.

    panel := VariableVerticalPanel origin:(10 @ 10)
				   corner:[(top width - 10) @ (top height - 10)]
				       in:top.

    subview1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:panel.
    subview2 := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:panel.
    panel level:3.
    subview1 level:-1.
    subview2 level:-1.
    top realize
Although not being very beautiful, the above example shows how a views corner can also be given by a computation rule. Whenever the topView is resized, the subview will recompute its corner, by evaluating the corner-block. This also works for origin and extent. Using blocks as rules provides a most powerful and flexible way to specify view dimensions.

Variable panels require their subviews to have relative origins and corners (or extends). If you want to add constant size subviews, you have to use (currently) a helper view:
See:

    |top panel helper subview1 subview2 subview3|

    top := StandardSystemView label:'hello'.

    panel := VariableVerticalPanel origin:(0.0 @ 0.0)
				   corner:(1.0 @ 1.0)
				       in:top.

    subview1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.5) in:panel.
    subview1 viewBackground:Color red.

    helper := View origin:(0.0 @ 0.5) corner:(1.0 @ 1.0) in:panel.
    subview2 := View origin:(0.0 @ 0.0) corner:(1.0 @ 20) in:helper.
    subview2 viewBackground:Color green.
    subview3 := View origin:(0.0 @ 20) corner:(1.0 @ 1.0) in:helper.
    subview3 viewBackground:Color blue.

    subview1 level:-1.
    helper level:-1.
    top realize
to show a more complex example, the following puts constant height button panels in between the variable size views:
    |top panel helper1 subjectview helper2 
     buttonPanel1 buttonPanel2 letterview b|

    top := StandardSystemView label:'Mail'.

    panel := VariableVerticalPanel origin:(0.0 @ 0.0)
				   corner:(1.0 @ 1.0)
				       in:top.

    helper1 := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.4) in:panel.

    buttonPanel1 := HorizontalPanelView 
			origin:(0.0 @ 0.0) corner:(1.0 @ 40) in:helper1.
    buttonPanel1 layout:#leftSpace.

    b := Button label:'delete' in:buttonPanel1.
    b := Button label:'new mail' in:buttonPanel1.
    (View in:buttonPanel1) extent:30@1; borderWidth:0; level:0. "for spacing"
    b := Button label:'exit' in:buttonPanel1.
    b action:[top destroy].

    subjectview := ScrollableView for:SelectionInListView in:helper1.
    subjectview origin:(0.0 @ 40) corner:(1.0 @ 1.0).
    subjectview list:#('letter1' 'letter2' 'letter3' '...' 'last letter').

    helper2 := View origin:(0.0 @ 0.4) corner:(1.0 @ 1.0) in:panel.
    buttonPanel2 := HorizontalPanelView 
			origin:(0.0 @ 0.0) corner:(1.0 @ 40) in:helper2.
    buttonPanel2 layout:#leftSpace.
    b := Button label:'reply' in:buttonPanel2.
    b := Button label:'print' in:buttonPanel2.

    letterview := ScrollableView for:TextView in:helper2.
    letterview origin:(0.0 @ 40) corner:(1.0 @ 1.0).

    top realize

hidden and stacked views

It is possible to stack muliple subviews views onto each other and, depending on some external event, choose which one should be visible. The easiest way to do this is to simply define each of them as having the same origin/corner, and raise one of them to the front.

Example (this examples uses elements which will be explained later - simply concentrate on the view creation and the raise-message sent from the buttons):

	|top viewStack buttonPanel sub1 sub2|

	top := StandardSystemView new.
	top extent:300 @ 350.

	buttonPanel := HorizontalPanelView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 50)
			    in:top.
	(Button label:'view1' action:[sub1 raise] in:buttonPanel).
	(Button label:'view2' action:[sub2 raise] in:buttonPanel).

	viewStack := View 
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:top.
	viewStack topInset:(buttonPanel height).

	sub1 := TextView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:viewStack.
	sub1 contents:'Hello, I am the TextView (sub1)'.

	sub2 := ClockView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:viewStack.

	top open
Of course, the subviews dimensions and positions can be arbitrary (however, except in noteStack-like applications, it does not make much sense to NOT align the views).
as in:
	|top viewStack buttonPanel sub1 sub2 sub3|

	top := StandardSystemView new.
	top extent:300 @ 350.

	buttonPanel := HorizontalPanelView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 50)
			    in:top.
	(Button label:'view1' action:[sub1 raise] in:buttonPanel).
	(Button label:'view2' action:[sub2 raise] in:buttonPanel).
	(Button label:'view3' action:[sub3 raise] in:buttonPanel).

	viewStack := View 
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:top.
	viewStack topInset:(buttonPanel height).

	sub1 := TextView
			origin:(0.1 @ 0.1)
			corner:(0.75 @ 0.75)
			    in:viewStack.
	sub1 contents:'Hello, I am the TextView (sub1)'.
	sub1 level:0; borderWidth:1.

	sub2 := ClockView
			origin:(0.25 @ 0.25)
			corner:(0.9 @ 0.9)
			    in:viewStack.
	sub2 level:0; borderWidth:1.

	sub3 := View
			origin:(0.2 @ 0.2)
			corner:(0.8 @ 0.8)
			    in:viewStack.
	sub3 viewBackground:Color red.
	sub3 level:0; borderWidth:1.

	top open
If you want to implement noteStack-like applications, you can use the event delegation mechanism, to catch events and raise when clicked-upon.

Since different view classes have different default-borders and 3D levels, you may have to set these explicit in this kind of application. The following example adds some more fancy stuff to the above demo. (notice, that each subview comes with its correct middleButtonMenu - and that you can modify the drawViews elements as in the DrawTool).
Try:

	|top viewStack buttonPanel l sub1 sub2 sub3 sub4|

	top := StandardSystemView new.
	top extent:300 @ 350.

	buttonPanel := HorizontalPanelView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 50)
			    in:top.

	l := Label label:'4' in:buttonPanel.
	(View in:buttonPanel) width:10.
	(Button label:'view1' action:[l label:'1'. sub1 raise] in:buttonPanel).
	(Button label:'view2' action:[l label:'2'. sub2 raise] in:buttonPanel).
	(Button label:'view3' action:[l label:'3'. sub3 raise] in:buttonPanel).
	(Button label:'view4' action:[l label:'4'. sub4 raise] in:buttonPanel).

	viewStack := View 
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:top.
	viewStack topInset:(buttonPanel height).
	viewStack level:0.

	sub1 := TextView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:viewStack.
	sub1 contents:'I am the TextView (sub1)'.
	sub1 level:-1; borderWidth:0.

	sub2 := ScrollableView for:EditTextView in:viewStack.
	sub2 origin:(0.0 @ 0.0)
	     corner:(1.0 @ 1.0).
	sub2 contents:'I am the EditTextView (sub2)'.
	sub2 level:0; borderWidth:0.

	sub3 := DrawView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:viewStack.
	sub3 level:-1; borderWidth:0.
	sub3 add:(DrawEllipse new 
			origin:(50 @ 50) corner:(250 @ 250);
			foreground:(Color green);
			background:(Color black);
			fillPattern:(Form fromFile:'SmalltalkX.xbm')
		).
	sub3 add:(DrawRectangle new 
			origin:(50 @ 50) corner:(250 @ 250);
			foreground:(Color green);
			fillPattern:nil
		).

	sub4 := ClockView
			origin:(0.0 @ 0.0)
			corner:(1.0 @ 1.0)
			    in:viewStack.
	sub4 level:-1; borderWidth:0.

	top open

scrolling views

Every view can be wrapped into a ScrollableView or HVScrollableView, which add vertical or vertical and horizontal scrollbars. (Currently, there is no horizontal-only wrapper - this will be added soon).
To be able to set the correct position and size of the scrollbars thumb, the view to be scrolled must respond to the following messages: Scrolling is done by changing the transformation of the scrolled view. Therefore, scrolling is almost transparent to the scrolled view. However, for performance reasons, the scrolled view may use the scroll origin and view dimensions to optimize redraw operations by limiting them to the visible area.

Currently, due to historical reasons, the ListView class and its subclasses use a different mechanism to implement scrolling (they keep track of the scroll origin themselfes - not using transformations). This implementation is a leftover from times when no transformation existed and TextViews where the only views which supported scrolling. The implementation of these will be changed in the next release, to have a consistent implementation over all views.

interactors

We call those views which allow interaction with the user interactors in contrast to layout views.

buttons

We have already met Buttons in the previous examples. Lets go into more detail here.
Since Button is a superclass of Toggle, CheckToggle and RadioButton, the following is also valid for these classes which are described in more detail below.

fonts or images

Buttons (like all other views) have a font in which they draw text. You can set the font to be used with the font: message.

Hint (read before you start to change fonts in your buttons ;-):
do not play around too much (if at all) with different font styles and/or font sizes - it usually makes a user interface worse and harder to use for others. Do not use decorative fonts (such as gothic or old-english). Finally, do not depend on the font being available on all machines.
You can almost always depend on 'times', 'courier' and 'helvetica' being available; other fonts may not be present in all X-installations.
The default font to use for all buttons is defined in the styleSheet.

    |top panel b1 b2|

    top := StandardSystemView label:'many buttons'.
    top extent:200 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := Button label:'one' in:panel.
    b1 font:(Font family:'helvetica' face:'bold' style:'roman' size:24).

    b2 := Button label:'two' in:panel.
    b2 font:(Font family:'helvetica' face:'bold' style:'roman' size:8).

    top open
The Smalltalk/X's Font class is smart enough to detect non existing fonts (and provide some default fall-back then):
    |b|

    b := Button label:'one'.
    b font:(Font family:'funnyFont' face:'bold' style:'roman' size:24).
    b open
Buttons can have image-labels instead of textual labels:
(you already know about panels, so the following example should be easy to understand):
    |top panel b1 b2 b3 b4|

    top := StandardSystemView label:'many buttons'.
    top extent:200 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := Button label:'one' in:panel.
    b2 := Button label:'two' in:panel.
    b3 := Button form:(Image fromFile:'bitmaps/Camera.xbm') in:panel.
    b4 := Button label:'bye bye' in:panel.
    b4 action:[top destroy] 

    top realize

enabling & disabling

Buttons can be enabled, disabled and also be turned on and off under program control:
    |top panel b1 b2 b3 b4|

    top := StandardSystemView label:'many buttons'.
    top extent:250 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := Button label:'one' in:panel.
    b2 := Button form:(Image fromFile:'bitmaps/ljet3.xpm') in:panel.
    b3 := Button form:(Image fromFile:'bitmaps/Camera.xbm') in:panel.
    b4 := Button label:'bye bye' in:panel.

    b1 action:[b3 turnOn. b4 enable].
    b2 action:[b3 turnOff].
    b3 action:[b4 disable].
    b4 action:[top destroy].
    top realize.
you can specify the foreground/background colors for the passive state, the active state (i.e. when pressed) and the entered state (i.e. when the mouse-pointer is in the button). Usually, you should let buttons use their default values (which come from the styleSheet). But, for special applications, it may be useful to change those.
Try:
    |top panel b1 b2 b3 b4|

    top := StandardSystemView label:'many buttons'.
    top extent:200 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := Button label:'one' in:panel.
    b2 := Button label:'two' in:panel.
    b3 := Button form:(Image fromFile:'bitmaps/Camera.xbm') in:panel.
    b4 := Button label:'bye bye' in:panel.

    b1 action:[b3 turnOn. 
	       b4 enable. 
	       b4 backgroundColor:(Color red lightened).
	       b4 enteredBackgroundColor:(Color red).
	      ].
    b2 action:[b3 turnOff].
    b3 action:[b4 disable];
       foregroundColor:Color blue;
       backgroundColor:Color red.
    b4 action:[top destroy].

    top realize.
You can also specify separate press- and releaseActions (the one set with action: is the pressAction.
try:
    (Button label:'see the transcript') pressAction:[Transcript showCr:'pressed'];
				      releaseAction:[Transcript showCr:'released'];
					    realize.
    Transcript topView raise
or:
    |p|
    p := HorizontalPanelView new.
    Button label:'up' action:[Transcript topView raise] in:p.
    Button label:'down' action:[Transcript topView lower] in:p.
    p open
(notice the combination instance creation message - use the browser to see which messages are available)

Beside the buttons interface, these examples gave us some more new information:

(the reason you need the topview in the above exapample is, that Transcript is actually the one subview showing the text - not the StandardSystemView around it - try Transcript inspect and follow the superView instance variables till you get to this topview. Sending topView to a real topview does not hurt, it will return itself.)

different active/passive logos

Normally, only the buttons level or (for 2D styles) its colors are affected when activated. However, it may be useful to specify different logos.
Example:
	|v b1 b2|

	v := HorizontalPanelView new.
	v extent:200 @ 100.

	b1 := Button in:v.
	b1 borderWidth:0; level:0; onLevel:0; offLevel:0.
	b1 activeLogo:(Image fromFile:'../../goodies/bitmaps/winBitmaps/pd/setup_down.bmp').
	b1 passiveLogo:(Image fromFile:'../../goodies/bitmaps/winBitmaps/pd/setup.bmp').

	b2 := Button in:v.
	b2 borderWidth:0; level:0; onLevel:0; offLevel:0.
	b2 activeLogo:(Image fromFile:'../../goodies/bitmaps/winBitmaps/pd/help_down.bmp').
	b2 passiveLogo:(Image fromFile:'../../goodies/bitmaps/winBitmaps/pd/help.bmp').

	v open
Note:
in the example above the levels and borders are explicitely turned off, since the bitmaps already include 3D effects. This may not be the case for other bitmaps.

The above also works with strings:

	|v b|

	v := HorizontalPanelView new.
	v extent:200 @ 100.

	b := Button in:v.
	b activeLogo:'release me'.
	b passiveLogo:'press me'.

	v open
However, this shows a little problem: the button resizes itself, to make the bigger logo fully visible.
Especially, if your button is arranged in some panel, this is definitely not what you want. Therefore, you should fix the buttons size.

fix size vs. variable size

You can fix a buttons size by sending sizeFixed:true to it. This method will freeze the current buttons size. You should do so after you defined the largest logo that will ever appear in it. (actually, since all of this is defined in buttons superclass: Label, all of this is also true for labels).
Example:
	|v b|

	v := HorizontalPanelView new.
	v extent:200 @ 100.

	b := Button in:v.
	"
	 set to the largest logo - just for the fixing
	"
	b logo:'release me'.
	b sizeFixed:true.

	b activeLogo:'release me'.
	b passiveLogo:'press me'.

	v open
BTW:
Labels (and therefore buttons, toggles and radioButtons too) offer various logo adjustment schemes, which control where the logo is to be placed within the view. The default adjustment is #center. But the above example may also look good with left adjusted logos. (you can use any of #left, #right, #center, #centerLeft or #centerRight.
#centerLeft or #centerRight also center their logo, but change the adjustment to left or right resp. if the logo does not fit. (i.e. use these if your logo may become very long, to tell the label/button which part should be shown in this case).
Try:
	|v b|

	v := HorizontalPanelView new.
	v extent:200 @ 100.

	b := Button in:v.
	"
	 set to the largest logo - just for the fixing
	"
	b logo:'release me'.
	b sizeFixed:true.
	b adjust:#left.

	b activeLogo:'release me'.
	b passiveLogo:'press me'.

	v open

toggles and radio buttons

A specialized button is the toggle - it will toggle its state whenever pressed. The protocol for toggles is the same as for buttons, with the exception, that a toggle defines both an onAction and an offAction.
Lets modify one of the above examples to use a toggle:
    |top panel b1 b2 b3 b4|

    top := StandardSystemView label:'many buttons'.
    top extent:200 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := Button label:'one' in:panel.
    b2 := Toggle label:'two' in:panel.
    b3 := Button form:(Image fromFile:'bitmaps/Camera.xbm') in:panel.
    b4 := Button label:'bye bye' in:panel.

    b1 action:[b3 turnOn.].
    b2 pressAction:[b4 enable].
    b2 releaseAction:[b4 disable].
    b4 action:[top destroy].

    b4 disable.
    top realize.
Sometimes, you want to arrange toggles in a group, such that only one of them may be on at any time. This is done by using radio buttons, and an instance of its companion class, a RadioButtonGroup:
    |top panel b1 b2 b3 b4 b5 group|

    top := StandardSystemView label:'one only buttons'.
    top extent:200 @ 100.

    panel := HorizontalPanelView origin:(0.0 @ 0.0)
				 corner:(1.0 @ 1.0)
				     in:top.

    b1 := RadioButton label:'one' in:panel.
    b2 := RadioButton label:'two' in:panel.
    b3 := RadioButton label:'three' in:panel.
    b4 := RadioButton form:(Image fromFile:'bitmaps/Camera.xbm') in:panel.
    b5 := Button label:'exit' in:panel.

    group := RadioButtonGroup new.
    group add:b1;
	  add:b2;
	  add:b3;
	  add:b4.

    b5 action:[top destroy].
    top realize.
If you want one of those buttons to be ON initially, add a line such as:
    b3 turnOn.  
to the above setup.

sliders and scrollers

Sliders and Scrollers are used much like Buttons, in that an action is defined to be evaluated when the sliders/scrollers value changed.
This value is passed as argument to the actionBlock - therefore we need a block which expects one argument as the scrollAction:
    |sl|

    sl := Slider new.
    sl extent:20 @ 200.    "notice: soem window manager ignore this"
    sl scrollAction:[:percent | Transcript showCr:('moved to ' , percent rounded printString) ].
    sl realize.
Note:
I should have called it "slideAction"; but Slider is inheriting most of its protocol from Scroller; and thats where the whole show is actually performed.

Another Note:
We wont go too deep into Scrollers here - they need more information about the size and position of the thing that is scrolled; if you want to try a standalone scroller, try and experiment by sending the scroller thumbHeight: and thumbOrigin: messages. Pass numerical percentage-values as arguments.

    |s|

    s := Scroller extent:20 @ 200.
    s scrollAction:[:percent | Transcript showCr:('moved to ' , percent rounded printString) ].
    s thumbHeight:50.
    s thumbOrigin:10.
    s realize.
A final (funny) example:
    |sl sc|

    sl := Slider extent:20 @ 200.
    sc := HorizontalScroller extent:200 @ 20.
    sl scrollAction:[:percent | sc thumbHeight:percent].
    sc scrollAction:[:percent | sl thumbOrigin:percent].
    sl realize.
    sc realize.
You will notice, that a scroller decides to show nothing for a size of 100% - that is also the behavior of Scrollbars in all of your textviews.

scrollbars

Normally you should not care for these low-level details (there are complex views, such as ScrolledView, which do all for you. Anyway, it may be interresting to use a standalone scrollbar sometimes:
    |v s|

    v := View extent:100 @ 200.
    s := ScrollBar in:v.
    s height:1.0.             "only changing height - let width stay its default"
    s scrollAction:[:percent | Transcript showCr:('moved to ' , percent rounded printString) ].
    s scrollUpAction:[Transcript showCr:'one step up' ].
    s scrollDownAction:[Transcript showCr:'one step down' ].
    s thumbHeight:50.
    s thumbOrigin:10.
    v realize.
In addition to the scroller, a scrollbar defines two additional actions: scrollUpAction which gets evaluated when the scrollup button is pressed; and scrollDownAction which gets evaluated when the scrolldown button is pressed;

Of course, the scrollbar has no idea of "how much" one step is in this isolated example, so the scroller is not updated when the step-up and step-down buttons are pressed.
We have to tell it (in this example):

    |v s|

    v := View extent:100 @ 200.
    s := ScrollBar in:v.
    s height:1.0.
    s scrollAction:[:percent | Transcript showCr:('moved to ' , percent rounded printString) ].
    s scrollUpAction:[
			Transcript showCr:'one step up'.
			s thumbOrigin:(s thumbOrigin - 10)
		     ].
    s scrollDownAction:[
			Transcript showCr:'one step down'.
			s thumbOrigin:(s thumbOrigin + 10)
		     ].
    s thumbHeight:50.
    s thumbOrigin:10.
    v realize.
But again, this is not the normal use of scrollbars - usually they are connected to some view which calls:
    s setThumbFor:self
whenever some change takes place. Typically, this is an instance of ScrollableView, doing so whenever its scrolled-view (which does not really know about being scrolled) sends a self contentsChanged or self originChanged.
More on this later ...

scrolled views

Typically, scrollbars are used in situations as:
    |v t|

    v := ScrollableView new.
    t := TextView new.
    v scrolledView:t.
    t contents:('/etc/hosts' asFilename readStream contents).
    v realize
by the way: the following is probably the shortest code to set up an editor:
(we will come to the EnterBox soon ...)
    |box|

    box := EnterBox new title:'which file'.
    box action:[:fileName |
	|v t top|

	top := StandardSystemView new.
	top label:'editing ' , fileName.
	v := ScrollableView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:top.
	v scrolledView:(t := EditTextView new).
	t contents:(fileName asFilename readStream contents).
	top realize
    ].
    box showAtPointer
If you want to have your own view scrolled, use the following code:
    |top v myView|

    ....
    top := StandardSystemView new ....
    ...
    v := ScrollableView origin:0.0 @ 0.0
			corner:1.0 @ 1.0
			    in:top.
    ...
    myView := MyViewClass new.
    v scrolledView:myView
    ...
    top realize
    ...
your view (an instance of 'MyViewClass') will be asked for the size and position of the contents (so that the scroller can reflect this correctly) by the following messages: and set an instance variable (viewOrigin) in your view.

Whenever moved, the scrollbar will ask you view to scroll accordingly. This is done by sending it messages like scrollVerticalTo:.
However, since there is a reasonable default implementation of all these scroll methods (in the View class), there is normally no need to add code for scrolling support in subclasses of view.

textviews

ListView - simple text display

The simplest and basic class to present text is the ListView. Since this does not offer any editing or selection capabilities, it is normally not used in the system. Instead, its subclasses inherit the functionality thus use this class as a framework.

ListViews main purpose is to handle all redrawing and scrolling; while the subclasses add user interaction.

Despite that, it is useful to create a listView and set its contents: the protocol of the other text view classes is similar enough to make this worthwhile.
Non scrollable case:

	|top listView|

	top := StandardSystemView label:'a simple listview'.
	top extent:300@400.

	listView := ListView origin:0.0@0.0
			     corner:1.0@1.0
				 in:top.

	listView contents:('smalltalk.rc' asFilename readStream contents).
	top open
scrollable case:
	|top scrollView listView|

	top := StandardSystemView label:'a scrollable listview'.
	top extent:300@400.

	scrollView := ScrollableView for:ListView in:top.
	scrollView origin:0.0@0.0 corner:1.0@1.0.

	listView := scrollView scrolledView.
	listView contents:('smalltalk.rc' asFilename readStream contents).
	top open
As you will notice, listViews do not support selections, editing or even a popup menu. However, the PageUp and PageDown keys (if available on your keyboard) are understood and can be used to scroll your text. to be written...
  simple lists 
    - ListView
      - contents:
      - contents
    - scrolling
    - scrollTo
    - makeLineVisible

  text
    - TextView
    - EditTextView
    - CodeView
    - Workspace

  SelectionInListView
    - selection
    - selectionValue
    - selection:
    - multiple selections
    - makeSelectionVisible

dialog boxes

All of the above was about non-modal topviews or views to be used as components for more complex views. Often you need to perform some user dialog, which stops him/her from interacting with the original view. Examples are popup menus, the save-box, the font-selection box and many others.

There is a number of different dialog boxes already available in the system, new ones are easily created by subclassing ModalBox or any other DialogView.

InfoBox - information display

The simplest of these DialogBoxes is the InfoBox. It is used to output some information to the user, and stops its caller until the user confirms by pressing a button. Try:
	|b|

	b := InfoBox new.
	b title:'how about this ?'.
	b show
(Notice: it can also be opened using #open or #openModal (even #openModeless if you like). However, #show has been added to allow easier search on DialogBoxes using the browser - if all your DialogBoxes are opened with #show, you will find all places where modal boxes are used, by looking for senders of 'show*'. If you use #open, you still have to look at the code to decide if its a modalBox or regular view.) Using #show, the box will open-up at some unspecified place on the screen. Actually, it is either its default position, or the porsition where it was opened previously. This is almost always not the place, where you want the box to appear. Thus, you should either set its origin, as in:
	|b|

	b := InfoBox new.
	b title:'how about this ?'.
	b origin:0@0.
	b show
or:
	|b|

	b := InfoBox new.
	b title:'how about this ?'.
	b origin:(Display extent - b extent).
	b show
or, more convenient for the user, with:
	|b|

	b := InfoBox new.
	b title:'how about this ?'.
	b showAtPointer
here, the box will showup whereever the mouse-pointer is currently located. You should always use this to open your boxes, since it is more convenient for the person behind the glass (no mouse movement is needed for confirmation). If there is some other view, which you do not want to cover (usually the view which launched the box), you should use:
	b showAtPointerNotCovering:anotherView
(where anotherView is typically 'self' in your program). Using this, the box will show itself either to the right or left of the specified view. The following example looks more complicated than needed, since in this immediate doit-evaluation, there is no self avaiulable:
	|b|

	b := InfoBox new.
	b title:'how about this ?'.
	b showAtPointerNotCovering:(WindowGroup activeGroup topViews first) 
Finally, for very urgent information, use:
	|b|

	b := InfoBox new.
	b title:'water in disk !!!!'.
	b showAtCenter
this will open the box at the center of the screen. By the way: there is a shortcut available for creating AND setting the title of the box:
	(InfoBox title:'wow !') showAtPointer
also, every object understands another shortcut message: #information:. Which takes the argument as a titletext and opens an info box for it. Thus you can use: self information:'thats simple' everywhere in your program. The reason telling you about all the individual messages is that they allow more customized boxes to be set up. The easy-to-use box shown with the #information message is only a very general box. For example:
	|b|

	b := InfoBox new.
	b title:'this operation will flood your harddisk ?'.
	b okText:'are you certain ?'.
	b okButton enteredForegroundColor:(Color red).
	b formLabel foregroundColor:(Color red).
	b textLabel foregroundColor:(Color blue).
	b showAtPointer 
or:
	|b|

	b := InfoBox new.
	b okText:'ok, refilled '.
	b okButton enteredBackgroundColor:(Color red lightened).
	b title:'Your printer is out of paper !\\please refill before continuing' withCRs.
	b form:(Image fromFile:'../fileIn/bitmaps/ljet.xpm').
	b formLabel level:1.
	b textLabel foregroundColor:(Color red).
	b showAtPointer 
If you plan to use customized boxes as the above, it may be a good idea to create a subclass of WarnBox (say 'OutOfPaperBox') for the above - this makes certain, that all boxes look similar, saves code by not replicating this setup all over, and finally makes your program easier to maintain (since there is only one place you have to modify in case, changes have to be made). i.e. (suggestion):

   InfoBox subclass:#OutOfPaperBox
	    instanceVariableNames:''
	    classVariableNames:''
	    poolDictionaries:''
	    category:'MyViews-DialogBoxes'

   !OutOfPaperBox class methodsFor:'instance creation'!

   new
       |b|

       b := super new.
       b okText:'ok, refilled '.
       b okButton enteredBackgroundColor:(Color red lightened).
       b title:'Your printer is out of paper !!\\please refill before continuing' withCRs.
       b form:(Image fromFile:'../fileIn/bitmaps/ljet.xpm').
       b formLabel level:1.
       b textLabel foregroundColor:(Color red).
       ^ b
   ! !
you can then show those boxes with:
	OutOfPaperBox new showAtPointer

WarningBox - warnings

A WarningBox is almost the same as an InfoBox; it simply uses a different (default) icon. See the difference between:
	(InfoBox title:'wow !') showAtPointer
and:
	(WarningBox title:'wow !') showAtPointer
Also, warnboxes beep when coming up, while InfoBoxes are silent. Since warnings are also very common, there is a convenient message to create those:
	self warn:'something is wierd'
Warnboxes inherit from InfoBox, therefore all messages in InfoBox to access or modify their appearance can also be applied to them.

YesNoBox - yes/no confirmations

YesNoBoxes are for simple yes/no questions; they provide two buttons and have actions associated with both of them:
	|b result|

	b := YesNoBox new.
	b title:'do you like ST/X ?'.
	b yesAction:[result := true].
	b noAction:[result := false].
	b showAtPointer.

	self information:('the result was: ' , result printString).
there are all kinds of things you can change in the look of the box. We will only look at a few things that are possible (look into those box-classes with the browser):
	|b|

	b := YesNoBox new.
	b title:'something else'.
	b textLabel font:(Font family:'times' face:'bold' style:'roman' size:18).
	b okText:'wow great'.
	b noText:'mhmh'.
	b yesButton foregroundColor:(Color green darkened).
	b form:(Image fromFile:'bitmaps/SmalltalkX.xbm').
	b yesAction:[Transcript showCr:'yes was pressed'].
	b noAction:[Transcript showCr:'no was pressed'].
	b showAtPointer
Also, if you are simply interrested in the result of a simple yes/no question, you can open the box with the confirm-message instead of defining the action blocks:
	|b result|

	b := YesNoBox new.
	result := b confirm:'are you sure ?'.
	Transcript showCr:('the answer is ' , result printString)
in the above example, you really dont need the temporary variable 'b', thus the same can be done shorter with:
	|result|

	result := YesNoBox new confirm:'are you sure ?'.
	Transcript showCr:('the answer is ' , result printString)
if you are asking multiple questions, the box can be reused, as in:
	|b result|

	b := YesNoBox new.
	result := b confirm:'are you sure ?'.
	result ifTrue:[
	    result := b confirm:'definitely ?'.
	    result ifTrue:[
		result := b confirm:'absolutely certain ?'.
		result ifTrue:[
		    Transcript showCr:'ok'
		]
	    ]
	]
Since this kind of confirmation is also very common, there is a convenient shortcut too:
	|result|

	result := self confirm:'answer yes or no'
this returns either true or false, depending on the button the user has pressed.

Since #confirm: is defined in Object, every receiver can be used for the #confirm: message above (it works for every self).

EnterBox

EnterBoxes allow input of a string; they will call an action with the entered string as argument.
	|b|

	b := EnterBox new.
	b title:'enter your name, please'.
	b initialText:(OperatingSystem getLoginName).
	b action:[:theString | Transcript showCr:'the name is ' , theString].
	b showAtPointer.
the box does not evaluate the action-block if cancel is pressed, thus you should be prepared for this, in your program:
	|b value|

	value := nil.
	b := EnterBox new.
	b title:'enter your name, please'.
	b initialText:(OperatingSystem getLoginName).
	b action:[:theString |  value := theString].
	b showAtPointer.

	value isNil ifTrue:[
	    Transcript showCr:'operation cancelled'
	] ifFalse:[
	    Transcript showCr:'operation to be performed with ' , value
	]
Since it is sometimes a bit inconvenient, to setup a box and define all those actions, there are some standard messages prepared for the most common queries. These are defined as class-messages of EnterBox and YesNoBox (for compatibility with ST-80, there is also a class called DialogView which also understands these).
The above can also be written as:
	|b value|

	b := EnterBox new.
	b title:'enter your name, please'.
	b initialText:(OperatingSystem getLoginName).
	value := b request:'enter your name, please'.

	value isNil ifTrue:[
	    Transcript showCr:'operation cancelled'
	] ifFalse:[
	    Transcript showCr:'operation to be performed with ' , value
	]
even more compact code is possible, using class messages:
	|result|
	result := EnterBox request:'enter some string'.
	Transcript showCr:result.
or:
	|result|
	result := YesNoBox confirm:'are you certain'.
	Transcript showCr:result.
or:
	|result|
	result := DialogView confirm:'are you certain'.
	Transcript showCr:result.
have a look at DialogView for more on this.

EnterBox2

This is like an EnterBox, but it adds a third button. For example, the search box is of this type.
(more to come ...)

OptionBox

Like an EnterBox, with an arbitrary number of option-buttons. This is a bit more complicated to set up, which is why EnterBox and EnterBox2 have been provided.

TextBox

like an Enterbox, but allows input of more than one line of text.

ListSelectionBox

like an enterbox, but offers a list to choose from.
	|box|

	box := ListSelectionBox new.
	box title:'which color'.
	box list:#('red' 'green' 'blue' 'white' 'black').
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer
you can also preset an initial string:
	|box|

	box := ListSelectionBox new.
	box title:'which color'.
	box list:#('red' 'green' 'blue' 'white' 'black').
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box initialText:'fooBar'.
	box showAtPointer

file open & save dialogs

FileSelectionBox - file open dialog

A FileSelectionBox looks like a ListSelectionBox, but the list consists of the file names in a directory.
See:
	|box|

	box := FileSelectionBox new. 
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer
you can also specify the directory:
	|box|

	box := FileSelectionBox new. 
	box directory:'/usr'.
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer
and/or a filename-pattern:
	|box|

	box := FileSelectionBox new. 
	box pattern:'*.st'.
	box directory:'../libbasic'.
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer
and/or a filterBlock to select which filenames are shown:
	|box|

	box := FileSelectionBox new. 
	box pattern:'*.st'.
	box matchBlock:[:fileName | fileName first between:$A and:$F].
	box directory:'../libbasic'.
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer
the box remembers its last directory and filename. Therefore, you should reuse the old box in your application (instead of recreating new ones).
This makes certain, that the user gets some convenient default directory when the box shows up (i.e. the last directory).

To see how this works, evaluate the following code, then change the directory in the first box and press ok.
The second box will show up with the last directory:

	|box|

	box := FileSelectionBox new. 
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'selected: ' , aString].
	box showAtPointer.

	box title:'again - which file ?'.
	box action:[:aString | Transcript showCr:'selected2: ' , aString].
	box showAtPointer

FileSaveBox - file save dialog

is like a FileSelectionBox, with 2 buttons labelled append and save. The action of the new button is defined with appendAction:;
as in:
	|box|

	box := FileSaveBox new. 
	box title:'which file ?'.
	box action:[:aString | Transcript showCr:'save to: ' , aString].
	box appendAction:[:aString | Transcript showCr:'append to: ' , aString].
	box showAtPointer

FontPanel - choose a font

This dialog allows choosing a font. The box will evaluate its actionBlock, passing the choosen font as an argument.
	|box|

	box := FontPanel new. 
	box action:[:aFont | Transcript showCr:'font is: ' , aFont].
	box showAtPointer

popup menus

PopUpMenus are defined with an array of label-strings and an array of selectors. When activated, a message with a selector corresponding to the selected entry will be sent to some object. The simplest way of defining a popupmenu is:
	|aMenu|

	aMenu := PopUpMenu 
			labels:#('foo' 'bar')
			selectors:#(doFoo doBar)
			receiver:someObject
the menu is shown with:
	aMenu showAtPointer

defining a middle button menu

Usually, popUpMenus are accociated with the middle-mouse button. The handling of this is done in some superclass of all views, so you normally do not have to care about all these details. Every view can get a popupMenu by sending it the #middleButtonMenu-message with the menu as an argument. Try the following:
	|myView myMenu|

	myView := View new.
	myMenu := PopUpMenu
			labels:#('foo' 'bar')
			selectors:#(doFoo doBar)
			receiver:myView.
	myView middleButtonMenu:myMenu.
	myView open
(if you try this example, be prepared to have a debugger come up - the view will of course not understand any foo-bar messages. Simply press 'continue' or 'abort' to leave the debugger) For a working example, try:
	|v m|

	v := View new.
	m := PopUpMenu
		labels:#('lower'
			 'raise'
			 '-'
			 'destroy')
		selectors:#(#lower #raise nil #destroy)
		receiver:v.
	v middleButtonMenu:m.
	v open
sometimes, you want to specify both selectors and some arguments to be sent; this is done by:
	|v p|

	v := View new.
	p := PopUpMenu
		labels:#('foo' 'bar' 'baz')
		selectors:#(#foo: #bar: #foo:)
		args:#(1 2 3)
		receiver:nil.
	v middleButtonMenu:m.
	v open.
or, the same selector but different arguments:
	|v p|

	v := View new.
	p := PopUpMenu
		labels:#('foo' 'bar' 'baz')
		selectors:#foo:
		args:#(1 2 3)
		receiver:nil.
	v middleButtonMenu:m.
	v open.

check-mark entries

It is also possible, to add check-mark entries, with an entry string starting with the special sequence '\c' (for check-mark). The value passed will be the truth-state of the check-mark.
	|m v|

	v := View new.
	m := PopUpMenu
		labels:#('\c foo'
			 '\c bar')
		selectors:#(#value: #value:)
		receiver:[:v | Transcript show:'arg: '; showCr:v].
	v middleButtonMenu:m.
	v open

wrapping arbitrary views as popup

Finally, you can wrap any other view into a popup menu (for example, to implement menus with icons or other components). The wrapped view should respond to some messages sent from popupmenu (for example: #hideSubmenus, #deselectWithoutRedraw and others), see the MenuView protocol, the PatternMenu class, or just try and see where you reach the debugger. Currently there is only one class in the system, which can be used this way (PatternMenu in the DrawTool demo). PatternMenu has been declared as subclass of MenuView - so it automatically understands all these messages.
	|v p|

	v := View new.
	p := PatternMenu new.
	p patterns:(Array with:Color red
			  with:Color green
			  with:Color blue).
	v middleButtonMenu:(PopUpMenu forMenu:p).
	v open
or try: (have a look at the receiver of the menu-message ;-)
	|v p|

	v := View new.
	p := PatternMenu new.
	p patterns:(Array with:Color red
			  with:Color green
			  with:Color blue).
	p selectors:#value:.
	p receiver:[:val | v viewBackground:val. v clear].
	p args:(Array with:Color red
		      with:Color green
		      with:Color blue).
	v middleButtonMenu:(PopUpMenu forMenu:p).
	v open
or even (see below for more on submenus):
	|v pMain pRed pGreen pBlue colors|

	v := View new.
	pMain := PatternMenu new.
	pMain patterns:(Array with:Color red
			      with:Color green
			      with:Color blue).
	pMain selectors:#(red green blue).

	pRed := PatternMenu new.
	colors := (Array with:(Color red:100 green:0 blue:0)
			 with:(Color red:75 green:0 blue:0)
			 with:(Color red:50 green:0 blue:0)
			 with:(Color red:25 green:0 blue:0)).

	pRed patterns:colors.
	pRed selectors:#value:.
	pRed args:colors.
	pRed receiver:[:val | v viewBackground:val. v clear].
	pRed windowRatio:(4 @ 1).
	pMain subMenuAt:#red put:(PopUpMenu forMenu:pRed).

	pGreen := PatternMenu new.
	colors := (Array with:(Color red:0 green:100 blue:0)
			 with:(Color red:0 green:75 blue:0)
			 with:(Color red:0 green:50 blue:0)
			 with:(Color red:0 green:25 blue:0)).

	pGreen patterns:colors.
	pGreen selectors:#value:.
	pGreen args:colors.
	pGreen receiver:[:val | v viewBackground:val. v clear].
	pGreen windowRatio:(2 @ 2).
	pMain subMenuAt:#green put:(PopUpMenu forMenu:pGreen).

	pBlue := PatternMenu new.
	colors := (Array with:(Color red:0 green:0 blue:100)
			 with:(Color red:0 green:0 blue:75)
			 with:(Color red:0 green:0 blue:50)
			 with:(Color red:0 green:0 blue:25)).

	pBlue patterns:colors.
	pBlue selectors:#value:.
	pBlue args:colors.
	pBlue receiver:[:val | v viewBackground:val. v clear].
	pBlue windowRatio:(1 @ 4).
	pMain subMenuAt:#blue put:(PopUpMenu forMenu:pBlue).

	v middleButtonMenu:(PopUpMenu forMenu:pMain).
v open You will find some more examples in the PatternMenus documentation (PatternMenu class documentation). Menus can also be used with any other view - the following adds one to a button:
	|b|

	b := Button label:'press me'.
	b middleButtonMenu:(PopUpMenu labels:#('foo' 'bar')).
	b open.
The buttons left-mouse-button functionality is not affected by the added middle-button menu. BTW: this is how PopUpList is implemented.

ST-80 style menus

The above menus all did some message send on selection; it is also possible, to use Smalltalk-80 style menus (which return some value from their startup method):
	|m selection|

	m := PopUpMenu
		labels:#('one' 'two' 'three').
	selection := m startUp.
	Transcript show:'the selection was: '; showCr:selection
startUp will return the entries index, or 0 if there was no selection. You can also specify an array of values to be returned instead of the index:
	|m selection|

	m := PopUpMenu
		labels:#('one' 'two' 'three')
		values:#(10 20 30).
	selection := m startUp.
	Transcript show:'the value was: '; showCr:selection
In ST/X style menus, separating lines between entries are created by a '-'-string as its label text (and corresponding nil-entries in the selectors- and args-arrays). In ST-80, you have to pass the indices of the lines in an extra array:
	|m selection|

	m := PopUpMenu
		labels:#('one' 'two' 'three' 'four' 'five')
		lines:#(2 4).
	selection := m startUp.
	Transcript show:'the value was: '; showCr:selection
or:
	|m selection|

	m := PopUpMenu
		labels:#('one' 'two' 'three')
		lines:#(2)
		values:#(10 20 30).
	selection := m startUp.
	Transcript show:'the value was: '; showCr:selection
Use whichever interface (ST-80 or ST/X) you prefer.

defining submenus

Submenus are created by changing an entry using #subMenuAt:put:.
Best is by example:
	|v main sub|

	v := View new.
	main := PopUpMenu
		labels:#('foo' 'bar' '-' 'more')
		selectors:#(#foo #bar nil #more)
		receiver:nil.

	sub := PopUpMenu
		labels:#('more foo' 'more bar')
		selectors:#(moreFoo moreBar)
		receiver:nil.

	main subMenuAt:#more put:sub.

	v middleButtonMenu:main.
	v open.
The index (first argument) to the subMenuAt:put: message may be either an entries label-text, a numeric index starting at 1, or the selector. Please use the selector, since the string could be different for national variants. Also the numeric index may change as your menu gets more indices. (see below on how to dynamically add/remove entries).

dynamically adding/removing entries

You can get the index of an existing entry with:
	aMenu indexOf:someKey
where key can be a selector or an entries text. Then, add new entries with:
	aMenu addLabel:'something' selector:#foo after:anIndex
or, to add a submenu:
	aMenu addLabel:'something' selector:#foo after:anIndex
	aMenu subMenuAt:(anIndex + 1) put:aNewSubmenu.
In analogy, entries are removed with:
	aMenu remove:someIndex
where index is again, either numeric, a selector or an entries text. Finally, you can change both label nad selector of entries:
	aMenu labelAt:index put:'newLabel'
and:
	aMenu selectorAt:index put:#fooBar
Lets wrap all this into an example: (I use a block as the receiver here since in this doIt-example, there is no class to implement the messages sent from the menu. In real programs, the receiver is either some view or model. The message sent is then some action-methods message, instead of #value:)
	|v menu action|

	action := [:action |
		action == #add ifTrue:[
			menu addLabel:'newLabel'
			     selector:#newFunction:
			     after:2
		].
		action == #remove ifTrue:[
			menu remove:#newFunction
		]
	].

	v := View new.
	menu := PopUpMenu
		labels:#('add' 'remove')
		selectors:#(#value: #value:)
		args:#(add remove)
		receiver:action.

	v middleButtonMenu:menu.
	v open.

pulldown menus

this chapter is to be written
    - PullDownMenu
    - special menus
	- PatternMenu

special views

ShadowView - shadows under views

this section is to be written

arbitrary shaped views

You can give your views arbitrary (non rectanglular) shapes if your graphic system supports this (i.e. if your X-server supports the Shape Extension).

To do so, create a bitmap in which 1-bits represent pixels which are to be included as view-pixels and 0-bits stand for pixels which are not.
Then define this bitmap as the views shape and (optional) border forms. The bits need not be connected.
Example:

    |v viewForm borderForm|

    v := View new.

    "
     create two bitmaps which are first cleared to zero,
     then filled with a circle.
     The borderShape is somewhat (2-pixels on each side)
     wider than the viewShape, which defines the inside of the view.
    "
    borderForm := Form width:50 height:50.
    borderForm clear.
    viewForm := Form width:50 height:50.
    viewForm clear.

    borderForm fillArcX:0 y:0 
		      w:50
		      h:50
		   from:0
		  angle:360.

    viewForm fillArcX:1 y:1 
		     w:48
		     h:48
		   from:0
		  angle:360.

    "
     finally set the views border- and view-Shape
    "
    v borderShape:borderForm.
    v viewShape:viewForm.

    v open
For portable applications, you should not use viewShapes, since not all X servers support this. On other than X systems, it may not be supported at all. To make your program portable across display systems, you should ask the Display if it supports arbitrary view shapes. This is done by:
    Display hasShapes
which returns true, if arbitrary shapes are supported.

the root view

this section is to be written

the Display

this section is to be written

invisible views (InputView)

this section is to be written

Using modal boxes non-modal and vice versa

It is possible to startup any view as a modal box, and to open dialogs in non-modal mode:
	FileBrowser new openModal
will block this view until you are finished with the fileBrowser. And:
	|b|

	b := FileSelectionBox new.
	b origin:0@0.
	b openModeless
allows the file box to stay around.

other views

this chapter is to be written

Rulers

this section is to be written

ObjectView - for structured graphics

this section is to be written

creating your own views

this chapter is to be written

Model-View-Controller operation again

this section is not yet finished - please use the browser to see more details.

In ST/X, most views can be operated either with or without true model. If used without a model, they typically inform others of actions and/or changes by performing so called action blocks. This is similar to callback functions in other GUI environments.
For example, a button can be told to perform some action by setting its pressaction as in:

	|b|

	b := Button new.
	b label:'press me'.
	b action:[Transcript showCr:'here I am'.
	...
To make porting of MVC-based applications easier, many views also support the well known MVC operation, in which the interaction is not by using action blocks, but by sending messages to and receiving changes from a model. The MVC support in ST/X has been provided to make porting of these applications easier.
It should be noted, that not all view classes behave completely in the same way as (for example) ST-80 views classes do. The MVC operation is provided as a portability aid. However, more classes are and will be converted to use and support the MVC paradigma.

MVC with Buttons, Toggles etc.

If used with a model, you have to Example:
	|b m|

	m := MyModelClass new.

	b := Button new.
	b label:'press me'.

	b model:m.
	b change:#buttonPressed.
	...
this arranges, that the model gets the #buttonPressed method be sent. If you set the changeSeletor to a one argument selector, the button will pass the current state as additional argument (for buttons, this will always be true, but for toggles or radiobuttons, this will be true or false). Finally, 2 selector for a 2-argument message will arrange for the button itself to be passed as second argument. Example:
	|v b1 b2 m|

	m := MyModelClass new.

	v := HorizontalPanelView new.

	b1 := Button in:v.
	b1 label:'press me'.
	b1 model:m.
	b1 change:#buttonPressed:from:.

	b2 := Button in:v.
	b2 label:'or me'.
	b2 model:m.
	b2 change:#buttonPressed:from:.

	v open
the models #buttonPressed:from: method will get the button as the from- argument.

MVC and TextViews

The model has to provide a method which return the text to be displayed. If the text is editable (i.e. the view is an editTextView or subclass), you also have to define the selector of a message which is sent whenever the text is accepted.
Example:
	|t myModel|

	myModel := MyModelClass new.

	t := TextView new.
	t model:myModel.
	t aspect::#aspect.
	t change:#accept:from: 
	t open
the textView will aquire the text to be shown via the #aspect message, whenever the aspect changes. An accept will lead to the #accept:from: message being sent to the model, with the new text as first argument, and the view itself as the second argument.

MVC and SelectionInListViews

The setup is:
	|l myModel|

	myModel := MyModelClass new.

	l := SelectionInListView
		on:myModel
		printItems:true
		oneItem:true
		aspect:#aspect
		change:#selectionChanged: 
		list:#getList
		menu:#getMenu 
		initialSelection:#initialSelection
		useIndex:true

	l open
In the above, the selectionInListView will ask the model for the list to be displayed whenever the aspect defined by #aspect changes. This change is signalled by the model in doing a self changed:#aspect. Since the selectionInListView installs itself as dependent of the model, it will get an update notification whenever that happens.
To aquire the list of selectable entries, the selectionInListView will send #getList to the model. The model should return an appropriate collection entries. If printItems was set to true (as in the above case), these entries are not taken directly, but instead, #printString is applied to each to get the strings which are actually displayed.
Whenever the selection changes, the selectionInListView will send the change-message to the model. As in the above button example, this may be a zero, one or 2-arg selector. If its a one or 2-arg selector, the selected entries value will be passed as first argument. The passed value will be the entry from te list which was optained via the #getList message - except, if useIndex was true (as in the above); in this case, the numeric index in the list is passed instead.
Finally, #initialSelection should return an index or nil - which defines if and what initial entry should be highlighted.

The discussion of the #menu message will follow.

Please expect more information and examples to be added here ....

drawing model

The following chapter tells you how the low level drawing is done. If you use the above widgets, you do not need to know these details; they do all the drawing for you.
However, if you are going to create your own views or widgets, you have to know these low level operations.

All drawing in graphic contexts is done by sending it (usually via self from a subclasses method) a displayXXX message.
For example, there are methods to display lines (displayLine:), rectangles (displayRectangle:) and so on.
For most drawing operations, a single paint color is needed, which is defined with:

	aGC paint:someColor
where someColor is an instance of a color.

Therefore,

	aGC paint:(Color red).
	aGC displayLineFrom:(10@10) to:(50@50).
will draw a red line.
For all examples that follow, we will (re)use the same view. To allow access to this view in the future, we have to create it first and define a new global variable which will keep a reference to it.
Execute:
	|v|
	v := View new.
	v open.
	Smalltalk at:#DemoView put:v.
then draw into it with:
	DemoView paint:(Color black).
	DemoView displayLineFrom:(0@0) to:(50@50).
to clear the view, use:
	DemoView clear
Once you are finished with these examples, close the view, and remove the global variable with:
	Smalltalk removeKey:#DemoView

Lets start with the views background. This is not the drawing background, but instead the default color with which the view is filled when exposed. This filling is done automatically by the window system.
To change the views background execute:

	DemoView viewBackground:(Color yellow).
the views appearance will not change immediately. However, this color is used to fill exposed regions. Try iconifying and deiconifying (or covering/uncovering) the view to see this.
If you want to make the new viewBackground immediately visible, you have to use:
	DemoView viewBackground:(Color blue).
	DemoView clear.
You can use either a color or an image as viewBackground:
	DemoView viewBackground:(Image fromFile:'bitmaps/garfield.gif').
	DemoView clear.

coordinates

By default, all coordinates are in pixels, starting with 0/0 in the upper left, advancing to the lower-right. This can be changed using a transformation. See the section below for more about this.

now, lets draw some geometric shapes:

lines:

	DemoView clear.
	DemoView paint:(Color white).
	DemoView displayLineFrom:(0@0) to:(50@50).
or (if you dont want to create temporary points):
	DemoView clear.
	DemoView paint:(Color white).
	DemoView displayLineFromX:50 y:0 toX:0 y:50.

rectangles:

	DemoView clear.
	DemoView paint:(Color red).
	DemoView displayRectangle:(1@1 corner:50@50).
there are also methods which expect the rectangles values as separate arguments:
	DemoView clear.
	DemoView paint:(Color red).
	DemoView displayRectangleOrigin:20@20 corner:50@50
	DemoView clear.
	DemoView paint:(Color red).
	DemoView displayRectangleX:10 y:10 width:20 height:20

arcs, ellipses & circles:

by specifying a bounding box:

	DemoView clear.
	DemoView paint:(Color green).
	DemoView displayArcX:0 y:0 
			   w:50 h:50
			from:0 angle:180
or a center-point and radius:
	DemoView clear.
	DemoView paint:(Color white).
	DemoView displayArc:(25@25) 
		     radius:25
		       from:180 angle:180
if the bounding box is not square, you get (part of) an ellipse:
	DemoView clear.
	DemoView paint:(Color green).
	DemoView displayArcX:0 y:0 
			   w:75 h:25
			from:0 angle:180
of course, 360 degrees make a full ellipse or circle:
	DemoView clear.
	DemoView paint:(Color green).
	DemoView displayArcX:0 y:0 
			   w:75 h:25
			from:0 angle:360

	DemoView clear.
	DemoView paint:(Color green).
	DemoView displayArcX:0 y:0 
			   w:50 h:50
			from:0 angle:360

for full circles, there is a shorter method available:
	DemoView clear.
	DemoView paint:(Color red).
	DemoView displayCircleX:25 y:25 radius:25
or:
	DemoView clear.
	DemoView paint:(Color red).
	DemoView displayCircle:(50@50) radius:25
polygons:
	|p|

	p := Array with:(10@10)
		   with:(75@20)
		   with:(20@75)
		   with:(10@10).
	DemoView clear.
	DemoView paint:(Color magenta).
	DemoView displayPolygon:p
strings:
	DemoView clear.
	DemoView paint:(Color cyan).
	DemoView font:(Font family:'courier'
			      face:'medium'
			     style:'roman'
			      size:12).
	DemoView displayString:'hello' x:20 y:50
notice, that the y coordinate defines the position where the baseline of the characters is drawn. You may have to ask the font for the ascent (the number of pixels above the baseline), its descent (the number of pixels below) or its height (the sum of these).
the current font is accessed via aView font.
Therefore, multiline text is drawn with:
	|h ascent font|

	DemoView clear.
	DemoView paint:(Color white).
	font := Font family:'courier'
		       face:'medium'
		      style:'roman'
		       size:12.
	font := font on:(DemoView device).
	DemoView font:font.

	h := font height.
	ascent := font ascent.

	DemoView displayString:'hello' x:20 y:ascent.
	DemoView displayString:'there' x:20 y:(ascent + h)
For now, ignore the font on: stuff - this will be explained below.

bitmaps:

	|f|

	f := Image fromFile:'bitmaps/SBrowser.xbm'.
	DemoView clear.
	DemoView paint:(Color cyan).
	DemoView displayForm:f x:20 y:50
there are also filling versions of the above:

filled rectangles:

	DemoView clear.
	DemoView paint:(Color red).
	DemoView fillRectangle:(1@1 corner:50@50).
filled arcs, ellipses & circles:
	DemoView clear.
	DemoView paint:(Color green).
	DemoView fillArcX:0 y:0 
			w:50 h:50
		     from:0 angle:90 


	DemoView clear.
	DemoView paint:(Color white).
	DemoView fillArc:(25@25) 
		  radius:25
		    from:180 angle:180


	DemoView clear.
	DemoView paint:(Color yellow).
	DemoView fillArc:(25@25) 
		  radius:25
		    from:180 angle:180


	DemoView clear.
	DemoView paint:(Color green).
	DemoView fillArcX:0 y:0 
			w:50 h:50
		     from:0 angle:360 


	DemoView clear.
	DemoView paint:(Color red).
	DemoView fillArcX:0 y:0 
			w:75 h:25 
		     from:0 angle:360 


	DemoView clear.
	DemoView paint:(Color green).
	DemoView fillCircleX:25 y:25 radius:25
filled polygons:
	|p|

	p := Array with:(10@10)
		   with:(75@20)
		   with:(20@75).
	DemoView clear.
	DemoView paint:(Color magenta).
	DemoView fillPolygon:p
Have a look at the GraphicsContext-class for even more drawing methods.

opaque drawing

Forms and strings can also be drawn with both foreground and background colors. This is done by the displayOpaqueString: and displayOpaqueForm: methods.
These will draw 1-bits using the current paint color, and 0-bits using the background-paint color. The background color can be either defined together with the paint color in the paint:on: message, or separate with the bgPaint: message.
Examples:

drawing opaque strings:

	DemoView clear.
	DemoView paint:(Color red) on:(Color yellow).
	DemoView font:(Font family:'courier'
			      face:'medium'
			     style:'roman'
			      size:12).
	DemoView displayOpaqueString:'hello' x:20 y:50
drawing opaque bitmaps:
	|f|

	f := Image fromFile:'bitmaps/SBrowser.xbm'.
	DemoView clear.
	DemoView paint:(Color red) on:(Color yellow).
	DemoView displayOpaqueForm:f x:20 y:50
going back to the non-opaque versions, these do NOT modify the pixels where 0-bits are in the form/string.
Thus, you can create transparency effects as in:
	|bits|

	DemoView clear.
	DemoView paint:(Color red) on:(Color yellow).
	"
	 draw a string using both foreground and background colors
	"
	DemoView font:(Font family:'courier'
			      face:'medium'
			     style:'roman'
			      size:12).
	DemoView displayOpaqueString:'hello' x:0 y:15.

	bits := Image
		width:16
		height:16
		fromArray:#[
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000

		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111]. 

	DemoView paint:(Color green).
	"
	 draw 1-bits only
	"
	DemoView displayForm:bits x:0 y:0
using bitmaps as paint:

Smalltalk/X not only supports colors as paint/bgPaint - you can also specify bitmaps to draw with.
example:

	|pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	"
	 draw a wide line using that 'pattern'-color
	"
	DemoView paint:pattern.
	DemoView lineWidth:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:40.
or:
	|pattern poly|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	"
	 draw a wide line using that 'pattern'-color
	"
	DemoView paint:pattern.
	DemoView lineWidth:10.
	DemoView joinStyle:#round.
	poly := Array with:(50 @ 10)
		      with:(90 @ 90)
		      with:(10 @ 90)
		      with:(50 @ 10).
	DemoView displayPolygon:poly.
(see a more detailed description of joinStyle below).

of course, filling works too:

	|pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	DemoView paint:pattern.
	DemoView fillCircle:(50@50) radius:25.
the same is true for strings:
	|pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	DemoView paint:pattern.
	DemoView font:(Font family:'helvetica'
			      face:'bold'
			     style:'roman'
			      size:24).
	DemoView displayString:'Wow !' x:10 y:50
opaque strings:
	|pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	DemoView paint:pattern on:(Color yellow).
	DemoView font:(Font family:'helvetica'
			      face:'bold'
			     style:'roman'
			      size:24).
	DemoView displayOpaqueString:'Wow !' x:10 y:50
another opaque string:
	|pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.

	DemoView clear.
	DemoView paint:(Color yellow) on:pattern.
	DemoView font:(Font family:'helvetica'
			      face:'bold'
			     style:'roman'
			      size:24).
	DemoView displayOpaqueString:'Wow !' x:10 y:50
finally, an opaque string with both fg and bg being patterns:
	|pattern1 pattern2|

	pattern1 := Image fromFile:'bitmaps/woodH.tiff'.
	pattern2 := Image fromFile:'bitmaps/granite.tiff'.

	DemoView clear.
	DemoView paint:pattern1 on:pattern2.
	DemoView font:(Font family:'helvetica'
			      face:'bold'
			     style:'roman'
			      size:24).
	DemoView displayOpaqueString:'Wow !' x:10 y:50
and bitmaps:
	|pattern bits|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.
	DemoView clear.
	DemoView paint:pattern.
	bits := Image fromFile:'bitmaps/SBrowser.xbm'.
	bits := bits magnifyBy:(2 @ 2).

	DemoView displayForm:bits x:5 y:5 
or:
	|bits pattern|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.
	bits := Image
		width:16
		height:16
		fromArray:#[
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000
		    2r11111111 2r00000000

		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111 
		    2r00000000 2r11111111]. 

	DemoView clear.
	DemoView paint:pattern.
	DemoView displayForm:bits x:0 y:0
opaque bitmaps (foreground is a pattern, background a color):
	|pattern bits|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.
	bits := Image fromFile:'bitmaps/SBrowser.xbm'.
	bits := bits magnifyBy:(2 @ 2).

	DemoView clear.
	DemoView paint:pattern on:Color yellow.
	DemoView displayOpaqueForm:bits x:0 y:0 
or (foreground is a color, background a pattern):
	|pattern bits|

	pattern := Image fromFile:'bitmaps/woodH.tiff'.
	bits := Image fromFile:'bitmaps/SBrowser.xbm'.
	bits := bits magnifyBy:(2 @ 2).

	DemoView clear.
	DemoView paint:Color yellow on:pattern.
	DemoView displayOpaqueForm:bits x:0 y:0 
or even (both foreground and background are patterns):
	|pattern1 pattern2 bits|

	pattern1 := Image fromFile:'bitmaps/woodH.tiff'.
	pattern2 := Image fromFile:'bitmaps/granite.tiff'.
	bits := Image fromFile:'bitmaps/SBrowser.xbm'.
	bits := bits magnifyBy:(2 @ 2).

	DemoView clear.
	DemoView paint:pattern1 on:pattern2.
	DemoView displayOpaqueForm:bits x:0 y:0 
line styles

In the above line, rectangle, polygon and arc examples, we were drawing solid lines. You can also draw dashed lines:

	DemoView clear.
	DemoView lineStyle:#dashed.
	DemoView displayLineFromX:10 y:10 toX:80 y:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:80.
	DemoView displayLineFromX:10 y:10 toX:10 y:80.
the above lineStyle only draws every second dash with the current paint color. The doubleDash mode draws every dash, with alternating paint and backgroundPaint colors (like opaque drawing).
	DemoView clear.
	DemoView lineStyle:#doubleDashed.

	DemoView paint:(Color red) on:(Color yellow).
	DemoView displayLineFromX:10 y:10 toX:80 y:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:80.
	DemoView displayLineFromX:10 y:10 toX:10 y:80.
the default (if not specified otherwise) is solid:
	DemoView clear.
	DemoView lineStyle:#solid.
	DemoView displayLineFromX:10 y:10 toX:80 y:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:80.
	DemoView displayLineFromX:10 y:10 toX:10 y:80.
line width

You can set the lineWidth with lineWidth:. The argument is width of the line in pixels.

	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView lineWidth:5.
	DemoView displayLineFromX:10 y:10 toX:80 y:10.

	DemoView lineWidth:10.
	DemoView displayLineFromX:20 y:20 toX:80 y:80.

	DemoView lineWidth:1.
	DemoView displayLineFromX:10 y:30 toX:10 y:80.
join style

When drawing wide lines, you may want to control how the endpoints look and how line segments of polygons and rectangles are joined. These are called capStyle and joinStyle. For thin lines, different settings may not make any visible difference.
The following examples show various joinStyles:

	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView joinStyle:#miter.   "/ thats the default anyway
	DemoView lineWidth:10.
	DemoView displayRectangleX:10 y:10 width:80 height:80.
	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView joinStyle:#round.
	DemoView lineWidth:10.
	DemoView displayRectangleX:10 y:10 width:80 height:80.
it makes more of a difference with non 90-degrees angles as in:
	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView joinStyle:#miter.   "/ thats the default anyway
	DemoView lineWidth:10.
	DemoView displayPolygon:(Array with:10@10
				       with:80@10
				       with:45@80
				       with:10@10)
	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView joinStyle:#round.
	DemoView lineWidth:10.
	DemoView displayPolygon:(Array with:10@10
				       with:80@10
				       with:45@80
				       with:10@10)
	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView joinStyle:#bevel.
	DemoView lineWidth:10.
	DemoView displayPolygon:(Array with:10@10
				       with:80@10
				       with:45@80
				       with:10@10)
cap style

and various capStyles:

	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView capStyle:#butt.   "/ thats the default anyway
	DemoView lineWidth:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:10.
	DemoView displayLineFromX:10 y:30 toX:80 y:80.
	DemoView clear.
	DemoView paint:(Color yellow).

	DemoView capStyle:#round.  
	DemoView lineWidth:10.
	DemoView displayLineFromX:10 y:10 toX:80 y:10.
	DemoView displayLineFromX:10 y:30 toX:80 y:80.
transformations

Every drawable supports coordinate transformations. In all of the above examples, we have been drawing using device coordinates (actually, we should say: "we have been drawing using an identity transformation").

Each drawable contains a transformation object which must be an instance of WindowingTransformation and can be set up to both scale and translate coordinates of the drawable. If the transformation is set to nil, this is equivalent to the identity transformation (i.e. scale of 1 and translation of 0).

In Smalltalk/X this transformation also affects clipping and event coordinates - thus, once you defined your logical coordinates, your view will receive button, keyboard and redraw events in logical coordinates too.

As a first, simple example, lets scale all drawing by a factor of 2:

	DemoView clear.
	DemoView paint:(Color yellow).
	DemoView lineWidth:1.

	DemoView transformation:nil.
	DemoView displayLineFromX:10 y:10 toX:40 y:10.

	(Delay forSeconds:1) wait.
	DemoView transformation:(WindowingTransformation 
					scale:2@2 translation:0@0).

	DemoView displayLineFromX:10 y:10 toX:40 y:10.
everything will be transformed; even strings, bitmaps and line widths:
	|img|

	DemoView extent:300@300.

	img := Image fromFile:'bitmaps/SBrowser.xbm'.
	DemoView clear.
	DemoView paint:(Color yellow) on:(Color red).
	DemoView lineWidth:1.

	DemoView transformation:nil.
	DemoView displayLineFromX:10 y:10 toX:40 y:10.
	DemoView displayOpaqueForm:img x:20 y:20.
	DemoView displayOpaqueString:'hello' x:50 y:30.

	(Delay forSeconds:1) wait.
	DemoView transformation:(WindowingTransformation 
					scale:2@2 translation:0@0).

	DemoView displayLineFromX:10 y:10 toX:40 y:10.
	DemoView displayOpaqueForm:img x:20 y:20.
	DemoView displayOpaqueString:'hello' x:50 y:30.
(notice, that transformations also work with all of the above drawing operations; you may want to try the opaque string and bitmap examples above again with scaling now in effect)

there are also convenient methods in WindowingTransformation to setup for drawing in real-world units, such as inches or millimeters. In the following, drawing is done in centimeters:

	DemoView clear.
	DemoView paint:(Color yellow).
	DemoView lineWidth:1.

	DemoView transformation:(WindowingTransformation 
					unit:#cm on:Display).

	DemoView displayLineFromX:0 y:0.1 toX:5 y:0.1.
	0 to:5 do:[:i |
	    DemoView displayLineFromX:i y:0 toX:i y:0.2.
	]
the same in inches:
	DemoView clear.
	DemoView paint:(Color yellow).
	DemoView lineWidth:1.

	DemoView transformation:(WindowingTransformation 
					unit:#inch on:Display).

	DemoView displayLineFromX:0 y:0.1 toX:3 y:0.1.
	0 to:3 by:0.25 do:[:i |
	    DemoView displayLineFromX:i y:0 toX:i y:0.2.
	]
the above examples show one problem with scaling: you may want to label the above line (think of axes being drawn). In this labelling, the coordinates should be transformed, while the string itself shoul be drawn unscaled.
For this, you can use displayUnscaledString:x:y: which transformes the x/y coordinate, but draws the unscaled (device) font.
	DemoView viewBackground:(Color blue).
	DemoView clear.
	DemoView paint:(Color yellow).
	DemoView lineWidth:1.

	DemoView transformation:(WindowingTransformation 
					unit:#inch on:Display).

	DemoView displayLineFromX:0 y:0.1 toX:3 y:0.1.
	0 to:3 by:0.25 do:[:i |
	    DemoView displayLineFromX:i y:0 toX:i y:0.2.
	].
	DemoView font:(Font family:'helvetica'
			      face:'medium'
			     style:'roman'
			      size:12).
	0 to:3 do:[:i |
	    DemoView displayUnscaledString:i printString x:i y:0.3.
	]
There are also unscaled versions of the opaque string methods and the bitmap display methods.

Of course, instead of using these unscaled versions, you could also switch back to an identity transformation when drawing those strings. But then, you still had to apply the transformation manually to the x/y coordinates of the strings.

To get transformed values of your coordinates, transformations may be manually applied. For example:

	devicePoint := (aView transformation) applyTo:logicalPoint
or vice versa (i.e. from device coordinates back to logical coordinates):
	logicalPoint := (aView transformation) applyInverseTo:devicePoint
Internally, Smalltalk/X uses the transformation also for scrolling. Therefore, all scrolling operations are transparent to your drawing calls.

Colors

Instances of Color are representing colorss in a device independent way. Internally, they store the red, green and blue components. Since the eye only differenciates between about 100 greylevels, these rgb values are internally rounded somewhatinternally.
Instances are created by:
	|myColor|

	myColor := Color red:50 green:100 blue:0.
The component values are in percent, ranging from 0/0/0 (for black) to 100/100/100 (for white). Thus, the above color should be some lime-like green-yellow. After creation, colors are not associated to a specific device. This is done by sending on:aDevice to the color instance. The device argument can be either a Workstation device (such as Display) or some other medium, such as a postscript printer. Once associated to a device, a color stores the device id of the color (which is either the colormap index or any other device handle for the color) internally. Be careful, once the color is reclaimed by the garbage collector, the corresponding device color will be freed as well. This may lead to hard to find redraw bugs, if you do something like:
	...
	aView paint:(Color yellow).
	...
	aView paint:(Color green).
	...
and a garbage collect occurs in between. In the above, something is drawn in yellow, for which the next free device color is allocated. If a garbage collect occurs in between, this colormap entry may be reclaimed and reused for the green color. Everything drawn in yellow before will now (since the devices colormap has changed) be shown in green too !
To avoid the above, you must keep a reference to the device color somewhere, to prevent the garbage collector from reclaiming the color cell, as long as the view is visible. The best strategy is to keep all used colors in some instance variable of the view or of your model. i.e.:
	in an instance variable:
		... myColors yellow green ...

	myColors := OrderedCollection new.
	yellow := Color yellow on:Display.
	green := Color green on:Display.
	myColors add:yellow; add:green.

	...
	aView paint:yellow.
	...
	aView paint:green.
	...

Fonts

Instances of Font are representing fonts in a device independent way. Internally, they store the name of the font as family, face, style and size.
Instances are created by:
	|myFont|

	myFont := Font family:'times'
			 face:'medium'
			style:'roman'
			 size:12
The size parameter is not the number of device pixels, but instead the point size (printer units) of the font. Here, one point is 1/72'th of an inch.
Therefore a size-12 font may (and will) have a different number of device pixels depending on the medium on which it is to be rendered. On a 100dpi display, it will be about 12*(1/72)*100 = 16 pixels high; on a 75dpi display, about 12 and on a 300 dpi printer page, there will be roughly 12*(1/72)*300 = 48 pixels. The device is free to round, or take a nearby size as replacement. You should make your applications drawing independ if the physical size.

You can work with fonts in this device independent manner as long as no device specific queries are to be made. All drawing operations (i.e. displayString...) will take device independent fonts and convert themself to a device representation.

Therefore, you can use the same font object for different display media - for example, a view and a postscript printer page.
As in:

	|myFont myView myPage|

	myFont := Font family:'times'
			 face:'medium'
			style:'roman'
			 size:12.

	myView := View in: .....

	myPage := PSGraphicsContext ....

	myView font:myFont.
	myView displayString: ....

	myPage font:myFont.
	myPage displayString: ....
However, as soon as you need some physical characteristics of a font, you need a font to be bound to the specific device.
The conversion from a device independent font to one that is bound to a specific device is done by sending on:aDevice to a font. The returned value is an instance of Font which represents the same font as the original, but is bound to that device (if the original was already for that device, this is a noop and the original font is returned. Therefore, if in doubt, use this conversion; it does not hurt).

In particular, this conversion is required when asking a font for its ascent, descent, height and some other device specific attributes.

You will get an error (debugger) when asking a font which is not bound to a device about these attributes.

As a summary, have a look at the following code fragment:

	|f|

	f := Font family:'times'
		    face:'medium'
		   style:'roman'
		    size:18.
	f := f on:(DemoView device).
	DemoView displayString:'hello' x:0 y:(f ascent).
	DemoView displayString:'world' x:0 y:(f height + f ascent).
in the above, ascent asks for the number of pixels above the baseline (remember: displayString's y argument specifies the y coordinate of the baseline) and height asks for the fonts overall height (i.e. ascent plus descent).

Cursors

For cursors, the same device-independent vs. device dependent story is true as for fonts. However, this conversion is typically invisibly done by the views cursor setting methods.

A cursor can be created either using one of the quick cursor class methods, which are provided for the most commonly used cursors.
For example, the waiting hourglass cursor is returned by:

	Cursor wait
You can set the cursor in every view with:
	aView cursor:someCursor
or, a concrete example using above demoView:
	DemoView cursor:(Cursor wait)
There are also convenient methods to change the cursor in all views which belong to a common windowGroup for the duration of some block evaluation. You can ask every view about its windowGroup with the windowGroup method.
Thus, a busy subview can change the cursor of all its associated views with (assuming self is some view):
	self windowGroup withCursor:(Cursor wait)
	do:[
	    ...
	    ... long computation
	    ...
	]
using this assures correct restoration of the original cursors - even in case of an aborted or terminated computation.
Beside windowGroups, views also understand the above method:
(assuming self is some view)
	self withCursor:(Cursor wait)
	do:[
	    ...
	    ... long computation
	    ...
	]
Finally, standardSystemViews also offer this interface to change the cursor in itself and all of its subviews. Since all topviews are instances of StandardSystemView (or of its subclasses), a busy view can also use:
	self topView withCursor:(Cursor wait)
	do:[
	    ...
	    ... long computation
	    ...
	]
So you can decide if a wait cursor is to be shown in a single view or in all views belonging to that windowGroup.

Events

The following is only of interrest, if you plan to create your own widgets or view classes.
Every event is initially handled by an event dispatcher process, of which there is exactly one per display screen.
(You can handle multiple screens, by starting an event dispatcher and create views on the other display(s)).

The event dispatcher will read the event and put it into an event queue. Then the associated windowGroup process gets a signal that some work is to be done.
The event processing method (in WindowGroup) fetches the event from the queue and sends a corresponding message to the view in question. (see also: views and processes.)
All event forwarding is concentrated in one single method (WindowEvent class sendEvent:...). Therefore, additional or different event processing functionality can be easily added there.

event types

The following table lists the events and the corresponding messages: A special situation arises if the view has a transformation defined. In this case, some of the above methods are called with logical coordinates (i.e. the inverse transformation being applied). If the view is interrested in the raw device events, it should redefine the deviceXXX methods, which actually do the transformation and call for one of the above methods with the logical coordinates.
For example, to get the device coordinate for buttonPress events, redefine deviceButtonPress:x:y: in your view class.
see the classes WindowSensor, WindowGroup and WindowEvent for more details.

enabling/disabling events

some events have to be enabled - otherwise, they will not be delivered. Events are enabled with: Key-, button- and ExposeEvents are always enabled by default (but can be disabled and re-enabled).
See the enableXXX and disableXXX methods in the PseudoView class.

event forwarding: delegates and controllers

Events can be forwarded to a delegate. Any view with an event delegate will not receive user events. Instead, these will be forwarded to the delegate with the original view as an addition argument.
To delegate events, you need some object which understands the messages: and set the views delegate with:
    aView delegate:theDelegate
Since the delegate may only be interrested in some events (and let others be handled as usual), it will be asked by another message before the above forwarding takes place. If the delegate has no interrest, it should return false on those messages; otherwise true. The corresponding query messages are: If the delegate does not implement those messages, this is taken as if it is not interrested in those events. Therefore, only the handlesXXX methods for those that are actually to be forwarded have to be implemented.

To support both views which do event processing themselfes and views for which a controller (i.e. Smalltalk-80's Model-View-Controller or MVC way of handling events), events are alternatively forwarded to the controller if the views controller instance variable is non-nil.
This makes porting of Smalltalk-80 code easier, since all you have to do is to set a views controller to have that controller process these events .

Delegation via the delegate takes precedence over the controller. This allows event delegation even for views which have a controller; therefore, this allows adding/modifying the behavior of existing widgets without a need to modify these and/or define a new controller class. (For example, additional keyboard shortcuts can be easily implemented using the delegation mechanism.)

Trouble Guide

This chapter tries to list common errors made in view programming. It lists trouble symptoms and gives hints for fixing.
The list is defintely not complete and will be extended over time.


Copyright © Claus Gittinger Development & Consulting, all rights reserved

(cg@ssw.de)