SETL's Interactive Graphical Interface; Sockets and Internet-Programming Basics
SETL's Interactive Graphical Interface, which is built upon the powerful and widely used Tk widget library developed by John Osterhout, provides a full set of interactive graphical widgets, including buttons, menus, editable text entry and display areas of one or more lines, sliders, listboxes, 'labels' and 'messages' for the display of non-editable text, sliders, scrollbars, and 'canvases' in which a variety of geometric objects can be drawn and repositioned. Checkbuttons and radiobuttons are also supported. The geometric objects available within canvases are rectangles, ovals, polygons, lines (open multipoint spline curves), arcs, bitmaps, images, and embedded text. Additionally, any other widget, including subcanvases, can drawn to a canvas, so that canvases can be structured as collages of basic geometric objects and subcanvases.
All widgets are sensitive to a wide variety of events, including mouse clicks and mouse motion, making it easy to support many kinds of draggable objects. The text area widget is particularly powerful, in that it supports fully fonted and hotworded text, and allows embedding of images, and, indeed, of any other widget.
The facilities provided allow any number of self-standing windows, called 'toplevels', to be opened, displayed or temporarily hidden, positioned, and resized. Within these windows one can hierarchically arrange rectangular 'frames', subframes, canvases, and text areas, with other widgets placed in them. The detailed arrangement of all these items can either be calculated automatically (allowing for easy, and often adequate, response to window resizing), or can be brought under detailed program control. The two forms of automatic placement provided are called the 'pack geometry manager' (which tries to fit items as close as it can to a specified frame edge), and the 'grid geometry manager' (which places elements in row-and-column arrays.) The third and last of 'geometry manager', provided, the 'place geometry manager', allows detailed program control of placement.
To use the interactive graphical interface, one simply includes the declaration
use tkw;
in one's program or package; this loads the tkw class, supplied with SETL, which provides all the interactive graphical interface facilities. Use of the interactive graphical interface is then initiated by executing the single statement
master_window_name := tkw();
which performs all necessary initializations and opens a first toplevel window. This is followed by a block of code which creates all desired additional windows and widgets which are to open immediately.
Once all initially desired windows and widgets have been created, event-driven execution of the interface system, and of the SETL system backing it up, is initiated by making the call
Tk.mainloop();
(Other windows and widgets can then be created dynamically whenever desired). This enters Tk's main loop, to which the SETL interpreter is subsequently subordinate, in the sense that it will only receive control via event-driven callbacks from Tk set up by the initial 'Setup' code.
Here is a small "Hello World" example, which simply displays "Hello World" inside a window in large-size red type. We will shortly detail the all the operations and conventions which it uses.
program test; -- SETL interactive interface example 1
use tkw; -- use the standard graphical interface package
Tk := tkw(); -- create the Tk interpreter
txt := Tk("text","20,3"); txt("side") := "top";
-- create a 'text area' widget, 20 characters by 3 lines in size
txt(OM) := "Hello World"; -- insert text into it
txt("font,foreground") := "{Times 48},red";
-- set the text font and color
Tk.mainloop(); -- enter the main Tk loop
end test;
'Toplevel' widgets are self-standing windows of whatever kinds are available in the system under which SETL and Tk are running. They are created by commands of the form
toplevel_name := master_window_name("toplevel","initial_width,initial_height");
where 'tkw_name' is the name of the master widget object. (This is generally the object 'Tk' created by the initiating call
Tk := tkw(); -- create the Tk interpreter
All other widgets are then created and arranged hierarchically within the toplevel' widgets opened. Each toplevel can have its own menubar.
'Frames' are rectangular areas within toplevel windows or other frames, within which other widgets can be arranged. They are created by commands of the form
frame_name := parent_frame_or_window("frame","initial_width,initial_height");
Other widgets can then be created and arranged hierarchically within such frames.
A frame or other widget created within a toplevel window or another frame only becomes visible when it has been assigned a place, either explicitly or by defining the 'geometry manager' responsible for placing it. For example, once can write
frame_name("side") := "top";
This use of "side" implies that the frame is to be placed within its parent P by the 'pack geometry manager', which in our example is instructed to position the frame toward the top of P. Instead of "top", one could use "bottom", "left", or "right".
The same rules apply to other widgets created within frames. Once such a widget has been created, it can be made visible by positioning it within its parent frame, e.g. by writing
widget_name("side") := "top";
A widget with a given parent is created by writing
widget_name := parent_frame(widget_type,main_parameter);
for example
button_name := parent_frame("button","Please Click Me Right Now!");
as seen in this example, the 'main parameter' used when creating a button is the button text. The following table shows the main parameters used in creating other kinds of widgets:
button parent("button",button_text)
menu parent("menu",descriptor)
-- the structure of 'descriptor' is detailed below
one-line text parent("entry",width_in_characters)
text area parent("text",width_in_characters_and_height_in_lines)
slider parent("scale",least_value_and_greatest_value)
listbox parent("listbox",number_of_items)
label parent("label",label_text)
message parent("message",message_text_and_width)
scrollbar parent("scrollbar",orientation_and_width)
-- e.g. "horizontal,16" or "vertical,10"
canvas parent("canvas",width_and_height)
subframe parent("frame",width_and_height)
Examples are
one-line text parent("entry",50)
text area parent("text","50,10")
slider parent("scale","-100,100")
listbox parent("listbox",15)
canvas parent("canvas","640,480")
subframe parent("frame","320,240")
The second parameter supplied can either be a string, an integer, or a tuple of appropriate length. For example, the preceding examples can instead be written as
one-line text parent("entry","50")
text area parent("text",[50,10])
slider parent("scale",[-100,100])
listbox parent("listbox",15)
canvas parent("canvas",[640,480])
subframe parent("frame",[320,240])
Each kind of widget has a variety of additional attributes which can be set to define various details of the widget's geometry and behavior. For example, the attributes available for button widgets are:
text - button caption state - 'normal' or 'disabled' (if disabled, text is greyed out) width - button width, in characters height - button height, in characters borderwidth - button border width, in pixels image - image to display instead of text caption font - text font anchor - caption anchor point: n,ne,e,se,s,sw,w,nw, center justify - caption justification in its rectangle: - left, right, or center foreground - text color background - background color activeforeground - text color when mouse is pressed over button activebackground - background color when mouse is pressed over button disabledforeground - text color when button is disabled cursor - cursor to display when mouse is over button default - if true, button is emphasized padx,pady - size of extra padding space around text highlightthickness - thickness of additional border used to indicate focus highlightbackground - color of additional border when widget - does not have focus highlightcolor - color of additional border when widget has focus takefocus - command to be executed when widget receives focus via tab textvariable - if non-null, names a Tk variable holding - the button's string underline - index of text character to underline wraplength - maximum line length before caption text wrapsComprehensive lists of attributes for all the other kinds of widgets appear later in this chapter. Note that not every Tk implementation actually supports all the effects of all widget attributes. In such situations, setting unsupported widget attributes simply has no effect.
Widget attributes are set by writing assignments of the form
widget(attribute_list) := attribute_value_list;
An example is
button_obj("foreground,background,cursor") := "red,yellow,crosshair";
or equivalently
button_obj("foreground,background,cursor") := "red;yellow;crosshair";
or
button_obj("foreground,background,cursor") := ["red","yellow","crosshair"];
as these examples indicate, the parameter attribute_list can be either a single attribute name or a comma-separated list of attribute names, and the attribute_value_list can be either (i) a single attribute value, or (ii) a comma-separated list of attribute values, given as a string, or (iii) a semicolon-separated list of attribute values, given as a string, or (iv) a tuple of attribute values. Also, whenever an integer-valued attribute appears, it can be given either as a SETL integer, or as the corresponding string. Plainly, assignment forms like those seen above facilitate simultaneous modification of multiple widget attributes.
'Principal' Attributes. As a matter of convenience, many kinds of widgets w are considered to have one 'principal' attribute, which can be retrieved/set by writing
x := w(OM) and w(OM) := x; respectively.
This simply makes it unnecessary to remember any more detailed name for the attribute. The 'principal' attributes available in this way are as follows:
Widget Type Principal Attribute TextLine String contents Label String contents Message String contents Text String contents Slider Numerical slider value Listbox List of all currently selected items (Read only) Menubutton The associated menu (Write only) Canvas Tuple of all canvas items (Read only) Toplevel Window title
Attributes available for all widgets. The following attributes are available for all widgets (some are read-only):
children tuple of widgets which are children of given widget showing true if widget is currently showing on screen, false otherwise manager geometry manager for window: pack, place, grid, canvas, or text parent parent widget of given widget rect rectangle of given widget: [r,t,l,b] wincoords corner of toplevel window containing widget toplevel toplevel window containing widget mouse current position of the mouse screendepth number of bits used to store screen colors screensize size of screen, in pixels screenmm size of screen, in millimeters
Items placed by 'packing'. The positions and sizes of items 'packed' into a frame are calculated using a set of placement attributes associated with each such object; side, padx, pady, ipadx, ipady, expand, fill, and anchor. All objects to be packed into a frame (or window) appear in an ordered 'packing list' associated with the frame. Objects appear on such a list when their "side" attribute is set, and can be removed either by setting this attribute to OM or by setting an attribute which transfers control of the object to one of the other geometry managers. The packing list can also be manipulated by setting the an object's 'in' attribute (which can move it to another frame or window), by making assignments to its 'after' or 'before' attribute (which moves it on the packing list), or by setting the 'children' attribute of the frame originally containing the object. Aside from this, the general rule is that
(i) objects obj appear on the packing list of their parent frame or window, that is, the frame or window fw using which the object was created by a statement like
obj := parent_frame(widget_type,main_parameter);
(ii) unless moved by assignments to their 'after' or 'before' attributes, objects appear on a frame's packing list in the order in which the operations
obj("side") := "left"; -- or "right", "top", or "bottom"
that put them there are executed.
The detailed placement within a frame F of all the objects on F's packing list is worked out by processing them in the order of that list. The algorithm used is roughly as follows. Let the objects to be packed be o1,o2,...olast. If the first few objects being packed are packed toward the left or right edge, break the list just before the first oj which is packed toward the top or bottom, then subsequently before the first oj which is packed toward the left or right, etc. This breaks the packing list into runs of objects, each consisting of objects which are all packed either in the vertical or all in the horizontal direction. Recursively pack oj,...olast into a large enough rectangle R; then pack o1,o2,...o(j - 1) and R horizontally into the frame F, placing all elements packed to the left (resp. right) in an initial (resp. final) sequence, with R in the middle. The frame F can then shrink to the minimum size needed to hold all the elements packed into it.
Note that if, in our example, the objects o1,o2,...o(j - 1) are of different heights, there may be unoccupied space above or below them. If this is the case each object will be placed in the center of the space assigned to it, except that (i) it can be moved to another position in this space if its 'anchor' attribute is set (to one of the positions n, s, e, w, ne, se, nw, sw), and (ii) it can be enlarged to fill the available space if its 'fill' attribute, which designates the directions in the object is allowed to expand (none, x, y, or both), is appropriately set.
If a rectangle like R is packed into the middle of a run of objects taller (or wider) than itself, then more space may be available to R than it would occupy if minimized. In such cases, if the 'expand' attribute of some of the objects packed into R has been set to true, the additional space available to R will be divided between them, each such object being placed either in the center of its available space, or at the position (n, s, e, w, ne, se, nw, sw, or center) determined by its 'anchor' attribute.
Sometimes one wants to hold some of the intermediate frames of a placement hierarchy at their stated sizes rather than allowing them to shrink to fit their contents. This can be done by setting their 'adjust' attribute to 'false'.
Objects are placed by default into their parent frame. This default action can be over-ridden by setting their 'in' attribute to ay other window descended from the same ancestral toplevel window (but no other, since an object always can become invisible when this ancestral window does.
Additional internal space, into which an object will always expand, can be reserved for it by setting its ipadx and ipady attributes to the desired number of pixels.
The above remarks should clarify the meaning of the packing-control attributes listed below. However, since the action of the packing algorithm is not always intuitive, its is generally better to control packing explicitly by introducing as may intermediate frames as necessary to make packing at any one level of the hierarchy of frames introduced run either horizontally or vertically. (In any case, the packing algorithm does this implicitly.)
The attributes involved in widget placement by 'packing' are:
side - edge (top, bottom, left, right) toward which widget is packed in - widget, other than parent, in which this widget should be packed - Note: can only pack into frame belonging to same toplevel after - widget that this should follow in packing order before - widget that this should precede in packing order anchor - position in available space that item should occupy: - (n, s, e, w, ne, se, nw, sw, or center) expand - if true, widget will claim available space - in its packing direction fill - none, x, y, or both: widget fills available space - in that direction ipadx,ipady - size of extra internal padding space within item packed children - ordered list of items packed within a frame adjust - if true, frame will adjust to minimum size required for children
The following example illustrates the use of placement by packing.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
msg := Tk("message","A first message"); msg("side") := "top";
-- create and place a first message
but := Tk("button","You can click this"); but("side,fill") := "top,y";
-- create and place a first button
msg2 := Tk("message","A second message"); msg2("side") := "bottom";
-- create and place a second message
but2 := Tk("button","Or click this"); but2("side,fill") := "bottom,both";
-- create and place a second button
Tk.mainloop(); -- enter the Tk main loop
end test;
We now give a series of small examples illustrating the use of the 'pack'-related attributes listed above. In all the examples, two thin colored frames are inserted into a window as 'supports' to keep it from shrinking to a smaller size dictated by its contents (this will be discussed below), and one or two buttons are inserted into the remaining space. Our first example is
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Scan to (4,4)"); but("side") := "left";
-- create and pack a button
but("pack,anchor") := "nw"; print(but("pack"));
-- set some of its packing attributes, print all of them
Tk.mainloop(); -- enter the Tk main loop
end test;
Note the placement of the packed button, and the fact that it fills only a small part of the available space. In this and our next few examples, we use the expression
obj("pack")
to retrieve the list of all widgets packed into a given object. The output produced is
{["in", "."], ["padx", "0"], ["ipadx", "0"], ["expand", "0"], ["side", "left"],
["fill", "none"], ["pady", "0"], ["ipady", "0"], ["anchor", "nw"]}
[frame:.w1, frame:.w2, button:.w3]
Changing the 'side' and the 'anchor' attributes leads to the alternate placement generated by the following example.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Scan to (4,4)"); but("side") := "right";
-- create and pack a button
but("pack,anchor") := "sw"; print(but("pack"));
-- set some of its packing attributes, print all of them
print(Tk("children"));
-- print the list of items packed into the window
Tk.mainloop(); -- enter the Tk main loop
end test;
By setting the 'fill' attribute to 'y' we cause the button to expand vertically into all the space available to it.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Scan to (4,4)"); but("side") := "left";
-- create and pack a button
but("pack,anchor,fill") := "nw,y"; print(but("pack"));
-- set some of its packing attributes, print all of them
Tk.mainloop(); -- enter the Tk main loop
end test;
In our next example we introduce a second button and set the 'fill' attribute of both buttons to 'both', but the 'expand' attribute of only the first button. This causes the first, but not the second button, to expand in its horizontal packing direction, to fill all available space. Both buttons then expand vertically, so all the frame space is filled, but the first button is wider.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Button1"); but("side") := "left"; -- create a button
but("pack,anchor,expand,fill") := "nw,1,both";
-- set some of its packing attributes
but := Tk("button","Button2"); but("side") := "left";
-- create a second button
but("pack,anchor,fill") := "nw,both";
-- set some of its packing attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
The next example is almost identical with the preceding one, but does not set the 'expand' attribute of the first button, so the available space is filled only vertically, but not horizontally.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Button1"); but("side") := "left"; -- create a button
but("pack,anchor,fill") := "nw,both"; -- set some of its packing attributes
but := Tk("button","Button2"); but("side") := "left";
-- create a second button
but("pack,anchor,fill") := "nw,both"; -- set some of its packing attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
If, as seen in the next example, we set the 'expand' attribute of both buttons, they expand equally to fill all available space.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Button1"); but("side") := "left"; -- create a button
but("pack,anchor,expand,fill") := "nw,1,both";
-- set some of its packing attributes
but := Tk("button","Button2"); but("side") := "left";
-- create a second button
but("pack,anchor,expand,fill") := "nw,1,both";
-- set some of its packing attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
Yet another possibility, shown in the following example, is to set the 'expand' attribute of both buttons, but to give the second button additional 'internal padding space' by setting its 'ipadx' attribute. This causes the buttons to expand to fill all available space, but now the second button is 40 pixels wider.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
frtop := Tk("frame","200,10"); -- put in two frames as 'supports'
frtop("side") := "top"; frtop("background") := "yellow";
fleft := Tk("frame","10,190");
fleft("side") := "left"; fleft("background") := "red";
but := Tk("button","Button1"); but("side") := "left";
-- create a button
but("pack,anchor,expand,fill") := "nw,1,both";
-- set some of its packing attributes
but := Tk("button","Button2"); but("side") := "left";
-- create a second button
but("pack,anchor,expand,fill,ipadx") := "nw,1,both,20";
-- set some of its packing attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
When items are packed into a frame (or window), the frame adjusts by default to the minimum size required to hold all the items packed into it, and this adjustment process carries recursively through all frames packed within frames. To turn this adjustment action off (resp. back on), one can use the operation
frame_or_window("propagate") := true; or frame_or_window("propagate") := false;The related expression
frame_or_window("propagate")
returns the propagation status of a frame or window.
These operations are seen in the following small program.
program test; -- SETL interactive interface example 1
use tkw,string_utility_pak; -- use the main widget class
var Tk,ca,parent;
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
Tk("propagate") := false; -- turn off size-on-contents dependency
print(Tk("propagate"));
but := Tk("button","Propagate"); but("side") := "top";
-- create and pack a button
but{OM} := lambda();
Tk("propagate") := true; print(Tk("propagate")); end lambda;
-- the button turns on size-on-contents dependency
but := Tk("button","Don't propagate"); but("side") := "top";
-- create and pack a second button
but{OM} := lambda(); Tk("width,height") := "300,300";
Tk("propagate") := false; end lambda;
-- the button turns off size-on-contents dependency,
-- and sets window size
Tk.mainloop(); -- enter the Tk main loop
end test;
Items placed by 'gridding'. Grid-placement of objects into a frame works much like packing, except that the items 'grid-placed' into a frame are arranged in a grid rather than being packed into a tighter arrangement. Each grid-placed object is assigned to a particular row and column, either by explicitly setting its 'row' and 'column' attributes, or implicitly, by setting one of these attributes and using the rule that items are then placed into the first unused row or column. (One should ordinarily avoid assigning two objects to the same row and column, as is this case they will simply be superimposed.)
All objects to be gridded into a frame appear in an ordered 'grid list' associated with the frame. Objects appear on such a list when their "row" or "column" attribute is set, and can be removed either by setting both these attributes to OM or by setting an attribute which transfers control of the object to one of the other geometry managers. The grid list can also be manipulated by setting the an object's 'in' attribute (which can move it to another frame or window.)
Once the grid list for a frame has been set up, the minimum row and column sizes needed to hold all the gridded objects are worked out, and the objects placed in their grid positions. The grid box allocated to an object can be larger than is needed to hold it. If this is the case each object will be placed in the center of the space assigned to it, except that (i) it can be moved to another position in this space or enlarged to fill the available space horizontally or vertically if its 'sticky' attribute, which designates the edges of its box to which it must 'stick' is set (to one or more of n, s, e, w).
Additional internal space, into which an object will always expand, can be reserved for it by setting its ipadx and ipady attributes to the desired number of bits. Additional external space, into which an object will never expand, can be reserved for it by setting its padx and pady attributes.
The above remarks should clarify the meaning of all the grid-placement control attributes, which are:
row, column - row and column in which widget is placed rowspan - number of rows occupied by widget columnspan - number of columns occupied by widget in - widget, other than parent, in which this widget should be placed - Note: can only placed in frame belonging to same toplevel sticky - edges in available space to which item should adhere, - by enlarging the item if necessary (n, e, s, and w, e.g 'news') padx,pady - size of extra padding space around item packed ipadx,ipady - size of extra internal padding space around item packed children - ordered list of items grid-placed within a frame adjust - if true, frame will adjust to minimum size required for children
The following example shows the gridding of widgets.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
msg := Tk("message","A first message"); msg("row,column") := "1,1";
-- create a first message and place it in the grid
but := Tk("button","You can click this"); but("row,column") := "1,2";
-- create a first button and place it in the grid
msg2 := Tk("message","A second message"); msg2("row,column") := "2,2";
-- create a second message and place it in the grid
but2 := Tk("button","Or click this"); but2("row,column,sticky") := "2,1,news";
-- create a second button and place it in the grid
Tk.mainloop(); -- enter the Tk main loop
end test;
We can use the 'columnspan' attribute of a gridded item to cause it to occupy more than one column (or its 'rowspan' attribute to cause it to occupy more than one row). This is shown in our next example, in which the button in the first row is seen not to expand in size, but to sit in the middle of the two columns it occupies.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Button1"); but("row,column,sticky") := "1,1,news";
-- create and "grid' a button
but("grid,columnspan") := "2"; print(but("grid"));
-- set its columnspan to 2, printing grid attributes
but := Tk("button","Button2"); but("row,column,sticky") := "2,1,news";
-- create and "grid' a second button
but := Tk("button","Button3"); -- create and "grid' a third button
but("row,column,ipadx,ipady,padx,pady") := "2,2,20,20,20,20";
print(Tk("children"));
-- print the list of widgets gridded into toplevel window
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced is
{{["in", "."], ["padx", "0"], ["ipadx", "0"], ["columnspan", "2"],
["pady", "0"], ["ipady", "0"], ["row", "1"],
["sticky", "nesw"], ["column", "1"], ["rowspan", "1"]}
[button:.w1, button:.w2, button:.w3]
A more acceptable appearance results if we set the 'sticky' attribute of the 'double columned' button in the first row, causing it to fill all the space reserved for it. This is shown in our next example.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Button1"); but("row,column") := "1,1";
-- create and 'grid' a button
but("grid,columnspan,sticky") := "2,ew";
-- set its columnspan to 2, and make it east set its columnspan to 2,
-- and make it east-west 'sticky'
but := Tk("button","Button2"); but("row,column") := "2,1";
-- create and "grid' a second button
but("grid,padx,pady,") := "5,5";
but := Tk("button","Button3"); but("row,column") := "2,2";
-- create and "grid' a third button
but("grid,ipadx,ipady") := "10,10";
Tk.mainloop(); -- enter the Tk main loop
end test;
As in the case of items packed into a frame (or window), when items are 'gridded' into a frame the frame adjusts by default to the minimum size required to hold all the items packed into it, and this adjustment process carries recursively through all frames packed within frames. To turn this adjustment action off (resp. back on), one can use the same operation as in the 'pack' case. This is seen in the following example, which also shows the use of the 'gridbox' expression that returns the containing rectangle of a gridded item.
program test; -- SETL interactive interface example 1
use tkw,string_utility_pak; -- use the main widget class
var Tk,ca,parent;
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
Tk("propagate") := false; -- turn off size-on-contents dependency
print(Tk("manager"));
print(Tk("propagate"));
but := Tk("button","Propagate"); but("row,column") := "1,1";
-- create and grid a button
but{OM} := lambda();
Tk("propagate") := true; print(Tk("propagate")); end lambda;
-- the button turns on size-on-contents dependency
but := Tk("button","Don't propagate"); but("row,column") := "1,2";
-- create and grid a second button
but{OM} := lambda();
Tk("width,height") := "300,300"; Tk("propagate") := false; end lambda;
-- the button turns off size-on-contents dependency, and sets window size
but := Tk("button","Dead Button"); but("row,column") := "2,1";
-- create and grid two more buttons
but{OM} := lambda();
Tk("width,height") := "300,300"; Tk("propagate") := false; end lambda;
-- the third button prints various gridbox boundaries
but := Tk("button","Dead Button"); but("row,column") := "2,2";
Tk.mainloop(); -- enter the Tk main loop
end test;
Explicitly placed items. Items are explicitly placed into a given frame by being assigned a position, height, and width. The attributes used for this are:
x,y - x and y pixel positions of anchor point relx,rely - x and y positions of anchor point, as fraction of frame width,height - pixel width and height of widget relwidth,relheight - width and height of widget, as fraction of parent frame anchor - 'key' point in widget occupying stated position: - (n, s, e, w, ne, se, nw, sw corner, or center) in - widget, other than parent, in which this widget should be placed - Note: can only placed in frame belonging to same toplevel children - ordered list of items manually placed within a frame
The following examples shows the positioning of widgets by explicit placement.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
msg := Tk("message","A first message"); msg("place,x,y") := "1,1";
-- create and place a first message
but := Tk("button","You can click this"); but("place,x,y") := "60,20";
-- create and place a first button
msg2 := Tk("message","A second message"); msg2("place,x,y") := "100,100";
-- create and place a second message
but2 := Tk("button","Or click this"); but2("place,x,y") := "80,80";
-- create and place a second button
Tk.mainloop(); -- enter the Tk main loop
end test;
Our next example illustrates the fact that explicitly placed items can overlap, and also shows the use of fractional' placement of an item relative to its containing frame. We create two buttons in a frame, and place them in overlapping positions. The second button is placed using the 'place,relx,rely', 'fractional' placement, command.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Button1"); but("place,x,y") := "5,5";
-- create a first button
print(but("place")); -- print its placement attributes
but := Tk("button","Button2"); but("place,x,y") := "15,15";
-- create a second button
but := Tk("button","Button3"); but("place,relx,rely") := "0.25,0.25";
-- create a button, giving it 'fractional' placement it its containing window
print(Tk("children")); -- print the list of items placed in the master window
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced is
{["y", "5"], ["relx", "0"], ["x", "5"], ["rely", "0"], ["anchor", "nw"]}
[button:.w1, button:.w2, button:.w3]
The next example is very similar to the preceding, but shows the result of using the 'anchor' attribute of the first button to move its placement anchor from a corner point to the button's center. Note that the centered anchoring of the first button placed causes it to move up and to the left relative to its previous position.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Button1"); but("place,x,y,anchor") := "5,5,center";
-- create a button and place it
but := Tk("button","Button2"); but("place,x,y") := "15,15";
-- create a second button and place it
but := Tk("button","Button3"); but("place,relx,rely") := "0.25,0.25";
-- create a third button and place it
Tk.mainloop(); -- enter the Tk main loop
end test;
Each kind of widget and or text canvas item is sensitive to a variety of events (e.g. button clicks, key-presses, mouse motions), among which one particular type of event is designated as the widget's 'principal' event. The following table shows these principal events:
button - (first) button up (i.e. 'click') menu - (first) button up menubutton - (first) button down radiobutton - (first) button up checkbox - (first) button up frame - mouse motion with (first) button down toplevel - mouse motion with (first) button down textline - loss of focus listbox - (first) button up text - loss of focus canvas - mouse motion with (first) button down arc - (first) button down bitmap - (first) button down image - (first) button down line - (first) button down oval - (first) button down polygon - (first) button down rectangle - (first) button downTags in canvases or text (see below) can also be event sensitive; their 'principal' event is (first) button down.
Parameterless callbacks to designated SETL procedures can be associated in a particularly easy way with each of these principal events. (This is a special case of the more general event-binding capability discussed in section XXX below.) To set up such an association, we simply write
widget_name{OM} := SETL_procedure_value;An example is
mybutton{OM} := print_primes_till_100;
After this is executed, and assuming that the procedure print_primes_till_100 has been supplied and does what its name implies, clicking on 'mybutton' will cause the primes up to be printed.
The example below shows the bidding of actions to button clicks. When clicked both of the buttons print appropriate messages. The code also binds an action to a click on each of the messages. When clicked the first message will beep once and the second message will beep twice.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk; -- globalize Tk for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
msg := Tk("message","A first message"); msg("place,x,y") := "1,1";
-- create and place a first message
but := Tk("button","You can click this"); but("place,x,y") := "60,20";
-- create and place a first button
msg2 := Tk("message","A second message"); msg2("place,x,y") := "100,100";
-- create and place a second message
but2 := Tk("button","Or click this"); but2("place,x,y") := "80,80";
-- create and place a second button
msg{OM} := Tk.beeper;
msg2{OM} := lambda(); Tk.beeper(); Tk.beeper(); end lambda;
but{OM} := lambda(); print("Clicked button 1"); end lambda;
but2{OM} := lambda(); print("Clicked button 2"); end lambda;
Tk.mainloop(); -- enter the Tk main loop
end test;
The expression
Tk.win_of_pt(x,y)
returns the Tk widget underneath the point [x,y] (in absolute screen coordinates), or, if there is no such widget, returns OM. Its use is illustrated by the following short program. We create two frames, each 500 pixels wide and 250 high. Two buttons are added, each of which shows the widget containing a particular screen point when clicked depending on where the master window containing all of these items is placed on the screen. This will be one or another widget, or will be undefined. You can experiment with this program by moving the window that it brings up.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
parent := Tk("frame","500,250"); parent("side") := "top";
-- create a grey 500 by 250 frame
parent("background") := "#aaaaaa"; -- grey background
parent := Tk("frame","500,250"); parent("side") := "top";
-- create a pink 500 by 250 frame under it
parent("background") := "#ccaaaa"; -- pink-grey background
but := Tk("button","Show widget containing 200,200"); but("side") := "top";
-- create a button
but{OM} := lambda(); print(Tk.win_of_pt(200,200)); end lambda;
-- when clicked, shows the widget containing 200,200
but := Tk("button","Show widget containing 200,400"); but("side") := "top";
-- create a button
but{OM} := lambda(); print(Tk.win_of_pt(200,400)); end lambda;
-- when clicked, shows the widget containing 200,400
Tk.mainloop(); -- enter the Tk main loop
end test;
id := Tk.createtimer(interval,SETL_fun);
Here 'interval' is the time, in milliseconds, before the parameterless SETL function 'SETL_fun' is to be invoked. This call returns an identifier for the pending timer event, which can be cancelled any time before it has taken place by writing
Tk.cancel_event(id);
The following small program shows the use of timer-driven events. It uses a procedure which causes itself to be called once each second beeping each time and then triggering another timed call to itself. This endless beeping can be stopped by clicking on the button shown which cancels any outstanding beep event.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,id; -- globalize Tk and the timer id for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Click this to stop the beeping");
-- create and place a first button
but("row,column,sticky") := "1,1,news";
but{OM} := cancel_beeps;
-- bind beep cancellation action to click on this button
id := Tk.createtimer(1000,beep_and_beep_again);
-- schedule a beep one second later
Tk.mainloop(); -- enter the Tk main loop
procedure beep_and_beep_again();
-- beep, then schedule another beep 1 second later
Tk.beeper(); -- beep
id := Tk.createtimer(1000,beep_and_beep_again);
-- reschedule a beep one second later
end beep_and_beep_again;
procedure cancel_beeps(); -- cancel any scheduled beep
Tk.cancel_event(id); -- cancel any scheduled beep
end cancel_beeps;
end test;
To set up a 'when-idle' call that will be triggered when the interface quiesces, write
id := Tk.createtimer(OM,SETL_fun);
The following example which is a variant of the example shown just above illustrates the use of 'idle calls' to trigger actions whenever the interactive interface is idle. Note once more that calls of this kind are indicated by giving an OM first parameter to the 'createtimer' procedure. In the code shown we trigger a printing routine which causes itself to be called repeatedly whenever the interactive interface quiesces. The high-speed printing that results can be stopped by clicking on the button shown, which cancels any outstanding 'on idle' call.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,id; -- globalize Tk and the timer id for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
but := Tk("button","Click this to stop the printing");
-- create and place a first button
but("row,column,sticky") := "1,1,news";
but{OM} := cancel_beeps;
-- bind beep cancellation action to click on this button
id := Tk.createtimer(OM,beep_and_beep_again);
-- schedule a beep one second later
Tk.mainloop(); -- enter the Tk main loop
procedure beep_and_beep_again();
-- beep, then schedule another beep 1 second later
print("Hello World"); -- print something
id := Tk.createtimer(OM,beep_and_beep_again);
-- reschedule a beep one second later
end beep_and_beep_again;
procedure cancel_beeps(); -- cancel any scheduled beep
Tk.cancel_event(id); -- cancel any scheduled beep
end cancel_beeps;
end test;
Note that each timer 'rings' just once, and so must be rescheduled, as in the above examples, if a repeating action is desired.
Much of the text widget's power derives from the system of tags and marks which can be associated with the string text held in such a widget. Tags mark ranges of characters of the string held within a text widget, and marks attach to positions between characters. If t is a text widget, the operation
lis := t("tag",tg);
maps each of the tags tg associated with t into the ordered list [[start_ix_1,end_ix_1],[start_ix_2,end_ix_2],..] of text ranges which carry the tag tg, and assignments of the form
t("tag",tg) := [[start_ix_1,end_ix_1],[start_ix_2,end_ix_2],..];
can be used to manipulate these lists. The operation t("tags") retrieves the list of all tags associated with t.
The code shown below creates a text widget containing three lines of text and then adds two tags to this text by explicitly calling the 'tag_' routine. Font and color attributes are set for each of these tags. These are automatically applied to the character ranges carrying the indicated tags and so become visible. We also print the range of text carrying the first of the tags added and the list of all tags present in the text widget.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,10"); txt("side") := "left";
-- create and place a text widget
txt(OM) := "Type\ntext\nhere"; -- put some text into it
print(txt("1.0".."2.1")); -- print a range of this text
txt.tag_add("my_tag","1.1,1.1,2.1,3.3");
-- add a tag to two disjoint character ranges
txt.tag_add("my_tag2","1.3,1.5"); -- add a second tag to a character range
-- set tag attributes, to make tagged ranges visible
txt("my_tag","font,background,foreground")
:= "{times 24 bold italic},red,yellow";
txt("my_tag2","font,background,foreground")
:= "{times 36 bold},blue,white";
print(txt.tag_names(OM));
-- print ordered list of tags associated with widget
Tk.mainloop(); -- enter the Tk main loop
end test;
The output printed is
Type t ["sel", "my_tag", "my_tag2"]
The first two lines of this output represent the first line and first character of the second line of the text in the text area of our example. The third line of output shows the tags present in the text widget: two that we have set up, and a third (the 'selection'), always present, that represent whatever range of characters may have been selected using the mouse.
Similarly, the operation t("marks") retrieves the list of all marks 'mrk' associated with t, while
pos := t.index(mrk);
returns the character position before which mrk appears, and
t.mark_set(mrk,ix);
can be used to define or modify this position. Marks are removed by writing
t.mark_unset(mrk) := OM;
Marks are invisible items inserted between two characters of text that can be used for searching and positioning the text. When additional characters are inserted into text the 'marks' and 'tags' in the text automatically reposition themselves properly, similarly when text is deleted. If a range of text containing a 'mark' is deleted the 'mark' disappears.
The following variant of the 'tags' program shown above inserts 'marks' rather than 'tags' into text. This is done using the 'mark_set' primitive. One of these marks is subsequently removed using ''mark_unset'. The inserted 'marks' are then listed.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,10"); txt("side") := "left";
-- create and place a text widget
txt(OM) := "Type\ntext\nhere"; -- put some text into it
print(txt("1.0".."2.1")); -- print a range of this text
txt.mark_set("my_mark","2.2"); -- place a named mark at the specified index
txt.mark_set("my_mark2","3.2"); -- place a named mark at the specified index
print(txt("marks")); -- show the marks present in the text
print(txt.index("my_mark")); -- show the location of my_mark
txt.mark_set("my_mark","3.1"); -- move the location of my_mark
print(txt.index("my_mark")); -- show the location of my_mark
txt.mark_unset("my_mark"); -- remove the mark
print(txt("marks")); -- show the marks present in the text
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced is
Type t ["my_mark", "insert", "my_mark2", "current"] 2.3 3.2 ["insert", "my_mark2", "current"]
showing the insertion of a mark, how a mark is moved, and its removal.
Tags in text (tags can also be associated with canvas items) are used for several critical purposes: (i) event sensitivities can be bound to tags. Text for which this has been done becomes 'hotworded.' (ii) fonts and other typographical characteristics can be associated with text tags.
To set the attributes of a tag associated with one or more a text ranges in a text area, write
text_area(tag_name,list_of_attributes) := list_of_values;
To bind an event response to such a tag, write
text_widget{"tag_name","event_descriptor:event_fields_signature"} := SETL_procedure;
As for other widgets the 'principal event' (i.e. a click, that is 'ButtonRelease-1") associated with a text tag can be set by an attribute-like assignment of the special form
text_area{tag_name,OM} := SETL_procedure;
Examples are
texta_1("Coloredtext","foreground,background") := "yellow,blue";
texta_1{"RolloverSensitive_text","Enter"} := display_help_caption;
and
texta_2{"Coloredtext",OM} := open_aux_window;
One special built-in tag, 'sel', designating the current selection in a text widget, is always available. The operation t("tag","sel") returns the boundary of the selection as a list containing one pair; the operation
t("tag","sel") := [[start,fin]];
can be used to set the selection boundary. If no selection has been made the 'sel' tag will still exist but will cover no range, so the operation t("tag","sel") will return an empty list of pairs.
The following program illustrates the use of the selection tag 'sel'. It creates a text widget containing three lines of text but with space for two additional lines and an auxiliary button to which a click procedure is bound. A tag is added to the first line of text and made visible by setting its font and color attributes. The callback procedure invoked when the button is clicked reads the selection tag and copies the starting and ending positions of the selections to an auxiliary tag which carries the foreground color magenta. The net effect is as follows. If text is selected and the button then clicked the characters in the selected range will take on the color magenta. If this is repeated with a different range of characters selected then the new range becomes magenta and the previous range reverts to black. (Reversion to black is forced by the fact that we remove the temporary tag from the entire text area. This is done by the first line of 'click' procedure.) Note that if this line were deleted clicking would extend the auxiliary tag to larger and larger portions of the text, so more and more characters would become magenta.
Note also that we cannot simply assign the color magenta to the 'sel' tag since if we did the magenta color would disappear whenever we clicked in the text area since such a click causes the range of characters selected to become null. It is worth experimenting with this and other variants of the following code to become familiar with the finer details of text tagging.
program test; -- SETL interactive interface example 1
use tkw,string_utility_pak; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "interactive interface example 1";
-- create the Tk interpreter
txt := Tk("text","10,5"); txt("side") := "top";
-- create and place a text widget
txt(OM) := "Type\ntext\nhere"; -- put some text into it
txt("font") := "{times 24 bold}"; -- set the text font
button := Tk("button","Select Some Text,\nThen Click Me");
button("side") := "top";
button{OM} := Click_procedure;
txt.tag_add("my_tag","1.1,1.5");
txt("my_tag","font,background,foreground,justify")
:= "{times 24 bold italic},green,yellow,center";
Tk.mainloop(); -- enter the Tk main loop
procedure Click_procedure(); -- response to button click
txt.tag_remove("temp_tag","1.1,end");
txt.tag_add("temp_tag",join(txt("tag","sel")(1),","));
-- copy selection to auxiliary tag
txt("temp_tag","foreground"):= "magenta"; -- color this magenta
end Click_procedure;
end test;
Tags and marks can be inserted into and removed in fully dynamic fashion from the text in a text widget, using the operations described above. However, it is more common to set up event-sensitive text statically (but then to use it dynamically.) To make this easy, SETL provides a special utility setup operation, having the syntax
text(OM) := descriptor_string;
Here, the descriptor_string required is a mixture of the visible text which is to appear in the text widget, along with a series of special 'tag marks' of the form <`ccctag_stringccc`> and <``ccctag_stringccc`> which respectively open and close tagged ranges.
The auxiliary string ccc.. will ordinarily be empty, so opening and closing tags will generally have the form <`tag_string`> and <``tag_string`>.
The short program seen below illustrates the declarative insertion of tags into text using the 'description_string' conventions that we have just explained. It sets up a text widget containing text carrying two tags, the first of these extending over two disjoint character ranges. Tag attributes are set to make the tag ranges visible.
program test; -- SETL interactive interface example 1
use tkw,string_utility_pak; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "interactive interface example 1";
-- create the Tk interpreter
txt := Tk("text","15,10"); txt("side") := "top";
-- create and place a text widget
-- put some tagged text into it
txt(OM) := "<`my_tag`>Sample\nte<``my_tag`>x<`my_tag`>t"
+ "<``my_tag`>\n<`my_tag2`>here<``my_tag2`>\nPlease";
txt("my_tag","font,background,foreground")
:= "{times 24 bold italic},green,red";
-- set the first tag's attributes
txt("my_tag2","font,background,foreground")
:= "{times 24 bold italic},red,green";
-- set the second tag's attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
To change the auxiliary string from this default (empty string) value, we simply use it in a null tag, e.g. can write <`ccc`><``ccc`> at the very start of a string s if we want to use <`ccctag_stringccc`> rather than the default <`tag_string`> for tags. This eases the writing of text in which character sequences like <`tag_string`> must be used for some other purpose.
Tag strings can never include end-of-line or carriage-return characters, so the appearance of any such character before the closing ..ccc`> of what might otherwise be a tag designator reduces this suspected designator to an ordinary string. The auxiliary strings ccc.. are not allowed to contain either the ` character or an end-of-line or carriage return.
The following variant of the preceding program shows the use of the alternative form of tag descriptor just explained. Using the convention explained, we introduce the question mark '?' as an additional portion of the tag marks which follow.
program test; -- SETL interactive interface example 1
use tkw,string_utility_pak; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "interactive interface example 1";
-- create the Tk interpreter
txt := Tk("text","15,10"); txt("side") := "top";
-- create and place a text widget
txt(OM) := -- put some tagged text into it
"<`?`><``?`><`?my_tag?`>Sample\nte<``?my_tag?`>x<`?my_tag?`>t"
+ "<``?my_tag?`>\n<`?my_tag2?`>here<``?my_tag2?`>\nPlease";
txt("my_tag","font,background,foreground")
:= "{times 24 bold italic},green,red";
-- set the first tag's attributes
txt("my_tag2","font,background,foreground")
:= "{times 24 bold italic},red,green";
-- set the second tag's attributes
Tk.mainloop(); -- enter the Tk main loop
end test;
A tag closing ends all identical open tags; superfluous tag closings are ignored.
Tag openings never subsequently closed are treated as marks.
The tags in a text widget have a 'priority' order, and where tags have conflicting attributes or bindings, the highest priority tag will dominate. For example, the following short program sets up a text widget with two overlapping tags 'x' and 'y' and assigns them conflicting colors.
program test; -- text setup utility
use tkw; -- use the standard graphical interface package
var Tk;
Tk := tkw(); -- create the Tk interpreter
txt := Tk("text","80,30"); txt("side") := "top";
-- create and place a text widget
txt(OM) := "<`x`>Sample <`y`>Text<``x`><``y`>";
-- put some tagged text into it
txt("x","foreground") := "red"; txt("y","foreground") := "blue";
-- set the tag color attributes
print(txt("tags"));
Tk.mainloop(); -- enter the main Tk loop
end test;
Since later-defined tags are given higher default priority than earlier-defined tags. the list of tags printed in priority order by this program is 'sel,x,y' (the special 'sel' tag, which represents the range of characters currently selected in the text widget, is always defined first and always has lowest priority.) Since y has higher priority than x, the color assigned to it dominates in the overlap region, so only the word 'Sample' appears in red, and 'Text' appears in blue. However, we can rearrange the priority list by changing the program to read
program test; -- text setup utility
use tkw; -- use the standard graphical interface package
var Tk;
Tk := tkw(); -- create the Tk interpreter
txt := Tk("text","80,30"); txt("side") := "top";
-- create and place a text widget
txt(OM) := "<`x`>Sample <`y`>Text<``x`><``y`>";
-- put some tagged text into it
txt("x","foreground") := "red"; txt("y","foreground") := "blue";
-- set the tag color attributes
txt("tags") := "y,x";
Tk.mainloop(); -- enter the main Tk loop
end test;
in which case the tag x will dominate everywhere, so both words will appear in red.
The expressions
textwidget.mark_next(n) and textwidget.mark_prev(n)
return the first and the last mark after text position n respectively. The expressions
textwidget.tag_nextrange(tag,n,m) and textwidget.tag_prevrange(tag,n,m)
respectively return the first and the last subrange of the specified range that carries the specified tag. Their use is shown in the following program, which uses a descriptor to set up a line of text containing tags and marks. Six buttons bound to actions which show the use of the operations described above are added. The comments contained in the program give additional detail.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,10"); txt("side") := "top";
txt(OM) := "<`my_tag`>Sam<`mark1`>ple\nte<``my_tag`>x<`my_tag`>t<``my_tag`>"
+ "\n<`my_tag2`>he<`mark2`>re<``my_tag2`>\nPlease";
txt("my_tag","font,background,foreground")
:= "{times 24 bold italic},green,red";
-- set the first tag's attributes
txt("my_tag2","font,background,foreground")
:= "{times 24 bold italic},red,green";
-- set the second tag's attributes
but := Tk("button","First mark after 1.1"); but("side") := "top";
-- create a button
but{OM} := lambda(); print(txt.mark_next("1.1")); end lambda;
-- when clicked, prints the first mark after 1.1
but := Tk("button","First mark after 1.4"); but("side") := "top";
-- create a button
but{OM} := lambda(); print(txt.mark_next("1.4")); end lambda;
-- when clicked, prints the first mark after 1.4
but := Tk("button","Last mark before 1.1"); but("side") := "top";
-- create a button
but{OM} := lambda(); print("*",txt.mark_prev("1.1"),"*"); end lambda;
-- when clicked, prints the last mark before 1.1
but := Tk("button","Last mark before 1.4"); but("side") := "top";
-- create a button
but{OM} := lambda(); print(txt.mark_prev("1.4")); end lambda;
-- when clicked, prints the last mark before 1.4
but := Tk("button","First 'my_tag' in range"); but("side") := "top";
-- create a button
but{OM} := lambda();
print(txt.tag_nextrange("my_tag","1.1","4.5")); end lambda;
-- when clicked, prints the first subrange of 1.1-4.5 that carries the tag 'my_tag'
but := Tk("button","Last 'my_tag2' in range"); but("side") := "top";
-- create a button
but{OM} := lambda();
print(txt.tag_prevrange("my_tag2","1.1","4.5")); end lambda;
-- when clicked, prints the last of subrange 1.1-4.5 that carries the tag 'my_tag2'
Tk.mainloop(); -- enter the Tk main loop
end test;
Text-tags have the following attributes:
| font | font of tagged zone |
| background | background color of tagged zone |
| foreground | foreground color of tagged zone |
| bgstipple | background stipple pattern |
| fgstipple | foreground stipple pattern |
| justify | justification of tagged lines: left, right, or center |
| wrap | none, char, or word |
| overstrike | 1 if tagged zone carries overstrike, else 0 |
| underline | 1 if tagged zone is underlined, else 0 |
| relief | flat, raised, sunken,ridge, or groove relief for tagged zone |
| borderwidth | borderwidth of tagged zone, in pixels |
| offset | vertical offset of tagged zone from baseline, in pixels |
| lmargin1 | left indent of first line in tagged zone, in pixels |
| lmargin2 | left indent of following lines in tagged zone, in pixels |
| rmargin | right indent of lines in tagged zone, in pixels |
| spacing1 | extra vertical space before first line in tagged zone, in pixels |
| spacing2 | extra vertical space between lines in tagged zone, in pixels |
| spacing3 | extra vertical space after last line in tagged zone, in pixels |
| tabs | comma-separated list of tab positions used for tagged lines, in pixels |
Many, but not all of these attributes can also be attributes of an entire text widget, and so control the appearance of all the text in a widget, rather than applying only to tagged text ranges within it. The tag attributes which can apply to all the text in a text widget are font, background, foreground, wrap, relief, borderwidth, spacing1, spacing2, spacing3, and tabs, but not bgstipple, fgstipple, justify, overstrike, underline, offset, lmargin1, lmargin2, or rmargin. As shown in the following table, text widgets also have various other attributes, not available for restricted text ranges.
Text widgets have the following attributes:
| font | text font |
| width | text width, in characters |
| height | text height, in number of lines |
| state | normal (editable) or disabled |
| background | background color |
| foreground | foreground color |
| wrap | none, char, or word |
| relief | flat, raised, sunken,ridge, or groove relief for text |
| cursor | cursor to use over text area |
| padx | extra space to left and right of text |
| pady | extra space above and below text |
| borderwidth | borderwidth of text, in pixels |
| exportselection | if true, export selected text to Unix selection |
| highlightthickness | thickness of border used to indicate active state of text |
| highlightbackground | color used to indicate inactive state of text |
| highlightcolor | color used to indicate active state of text |
| insertwidth | width of insertion mark |
| insertbackground | background color of insertion mark |
| insertborderwidth | border width of insertion mark |
| insertofftime | time that insertion mark remains off while blinking |
| insertontime | time that insertion mark remains on while blinking |
| selectbackground | background color of selected text |
| selectforeground | foreground color of selected text |
| selectborderwidth | border width of selected text |
| takefocus | command to be executed when text area receives focus via tab |
| setgrid | if true, items are constrained to implicit grid positions |
| spacing1 | extra vertical space before first line in text, in pixels |
| spacing2 | extra vertical space between lines in text, in pixels |
| spacing3 | extra vertical space after last line in text, in pixels |
| tabs | comma-separated list of tab positions, in pixels |
@x,y - the character at screen point x,y end - last character insert - position of insertion cursor tag_name.first - first character in the range tagged by "tag" tag_name.last - first character after the range tagged by "tag" mark_name - first character after the indicated mark current - the character under the mouse some_image - character position of an embedded image some_widget - character position of an embedded widgetThese index expressions can be modified by the addition of the following suffixes:
wordstart - start of word containing character wordend - start of word containing character linestart - start of line containing character lineend - start of line containing character +nchars - n characters forward, same line (e.g. "current+15chars") -nchars - n characters previous, same line +nlines - n lines forward, same character position (e.g. "current+5lines") -nlines - n lines previous, same character position
The following program illustrates the use of these index expressions and modifiers, by setting up a text area and printing out various sections of text.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Indexing Example"; -- create the Tk interpreter
txt := Tk("text","20,10"); txt("side") := "left";
-- set up a text widget
txt(OM) := "Type\ntext or stuff\nhere";
-- put some text into it
print(txt("1.0".."2.2")); print();
print(txt("1.0".."2.2+1chars")); print();
print(txt("1.0".."2.2-1chars")); print();
print(txt("1.0".."2.2+1lines")); print();
print(txt("1.0".."2.2-1lines")); print();
print(txt("1.0".."2.2wordstart")); print();
print(txt("1.0".."2.2wordend")); print();
print(txt("1.0".."2.2linestart")); print();
print(txt("1.0".."2.2lineend")); print();
Tk.mainloop(); -- enter the Tk main loop
end test;
Note that single-character retrievals from a text area or textline must be written as
txt(index..index),
since the form would be confused with an attribute retrieval. The expression
txt.index(modif_ix),can be used to get the 'numerical' ('i.j') form of text indices, and
txt.compare(op,modif_ix1,modif_ix2);can be used to compare two such indices. (Here, "op" can be "==", "!=", ">", ">=". "<", or "<="). This is shown in or next example.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Indexing Example"; -- create the Tk interpreter
txt := Tk("text","20,10"); txt("side") := "left"; -- set up a text widget
txt(OM) := "Type\ntext or stuff\nhere"; -- put some text into it
print(txt.index("2.2"));
print(txt.index("2.2+1chars"));
print(txt.index("2.2-1chars"));
print(txt.index("2.2+1lines"));
print(txt.index("2.2-1lines"));
print(txt.index("2.2wordstart"));
print(txt.index("2.2wordend"));
print(txt.index("2.2linestart"));
print(txt.index("2.2lineend"));
print(txt.compare("!=","2.2wordstart","2.2linestart"));
-- compare character indices in line.char and other allowed formats
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced is
2.3 2.4 2.2 3.3 1.3 2.1 2.5 2.1 2.14 FALSEAs illustrated by the following program, widgets of any kind can be inserted into the text of text widgets, where they retain their normal activity. This is done using the operation
txt.insert_widget(character_posn,but);
The expression
txt("widgets")
returns the list of all widgets currently inserted into the text. Widgets inserted into text are treated as if they were characters, and can therefore be deleted by operations of the form
txt(char_loc..char_loc) := "";
The following program sets up a textarea and a canvas containing three graphical items. The canvas is not placed in the master window, but instead is inserted into the text as a text widget. We also set up two buttons and insert them also as text widgets into our line of text. By clicking on these buttons you can see that they remain active in the normal way. We also show the use of the expression 'txt("widgets")', which prints the list of all widgets embedded in a text item. Finally, we set up a self-standing button which, when clicked deletes one of the inserted widgets. From the code bound to this button you can see that a widget embedded in text is treated as a single character of a special kind.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Master"; -- create the Tk interpreter
txt := Tk("text","30,15"); txt("side") := "top"; txt(OM) := "what flat";
-- create a text widget
txt("background") := "green";
ca := Tk("canvas","200,100"); -- create a canvas
rect := ca("rectangle","20,20,60,40"); rect("fill") := "red";
-- put various items into it
oval := ca("oval","80,20,120,40"); oval("width") := 5;
poly := ca("polygon","140,60,180,60,180,100,20,100");
poly("fill,smooth") := "blue,true";
txt.insert_widget("1.6",ca); -- insert it as a text widget
but := Tk("button","Print the time"); -- create a button
but{OM} := lambda(); print("The time is: " + time()); end lambda;
-- bind it to a print action
txt.insert_widget("1.4",but); -- insert it as a text widget
but := Tk("button","Print the time2"); -- create a second button
but{OM} := lambda(); print("The time is: " + time()); end lambda;
-- bind it to a print action
txt.insert_widget("1.8",but); -- insert it as a text widget
print(txt("widgets")); -- print list of all the widgets in the text.
but := Tk("button","Remove item"); but("side") := "top";
-- create a third button, and put it below the canvas
but{OM} := lambda(); txt("1.8".."1.8") := ""; end lambda;
-- bind it to a deletion action
Tk.mainloop(); -- enter the Tk main loop
end test;
Our next small program illustrates the use of the operation
txt.see(char_index);
which shifts the view of a text field too large to be viewed all at once so as to bring a specified character into view. It sets up a textarea containing more text than can be visible at any one time, and two buttons both bound to uses of the 'see' operation. These position the text to make specified characters visible.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,5"); txt("side") := "top"; -- create a text area
txt(OM) := "TYPETYPETYPEYYYYTYPETYpe\nTypeTypeTypeTypeType"
+ "\nTypeTypeTypeTypeType\nTypeTypeTypeTypeType\n" +
"texttexttextt*****ext\nherehereherehereherehere";
-- put lots of text into it
but := Tk("button","See 5.10"); but("side") := "top"; -- create two buttons
but{OM} := lambda(); txt.see("5.10"); end lambda;
-- bind view-shift actions to them
but := Tk("button","See 1.1"); but("side") := "top";
but{OM} := lambda(); txt.see("1.1"); end lambda;
Tk.mainloop(); -- enter the Tk main loop
end test;
Note that the same operation is available for listboxes.
As shown by our next small program, the operation
obj.bbox(item_index)
which is available for text widgets, textlines, and listboxes, returns the coordinates of the smallest rectangular box containing designated item. We also show the use of the
Tk.quit();
command, which exits the Tk interpreter, and illustrate the fact that since listboxes; like menus, are treated as a kind of tuple, slice assignments can be used to edit their list of items.
The operations shown above are illustrated in the following program. In it we set up a textarea, textline, and listbox. Two buttons are added, the first of these prints the bounding boxes of specified lines and characters in the textarea, textline, and listbox. The second button merely quits the application when clicked.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,txt,txtln,lb; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Master"; -- create the Tk interpreter
txt := Tk("text","30,3"); txt("side") := "top"; txt(OM) := "what flat";
-- create a text area
txtln := Tk("entry","30"); txtln("side") := "top"; txtln(OM) := "whot flot";
-- create a text line
lb := Tk("listbox",3); lb("side") := "top";
-- create a listbox, which shows 3 elements
lb(1..0) := "Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Last Item";
-- put 10 items into it
lb(2..3) := ""; -- delete items 2 and 3
print(lb(2..3)); -- show the new items 2 and 3
but := Tk("button","Show Box"); but("side") := "top"; -- create a button
but{OM} := lambda(); -- bind bounding box display actions to it
print(txt.bbox("1.2")); print(txtln.bbox("1"));
print(lb.bbox("0")," ",lb.bbox("2"));
end lambda;
but := Tk("button","Quit"); but("side") := "top"; -- create a second button
but{OM} := lambda(); Tk.quit(); end lambda; -- bind an exit action to it
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced by the preceding program is:
Item4 Item5 [18, 4, 25, 16] [42, 2, 45, 14] [1, 1, 36, 16] [1, 33, 36, 48]
Our next example shows the creation of 'active' ('hotworded') text by the binding of actions to tags embedded in the text. We also illustrate the 'txt.tag_ranges(tag_name)' operation, which returns the list of all character ranges to which a specified tag attaches; the 'txt.tag_names(char_index)' operation, which returns the list of all tags whose range covers a specified character; and the 'txt.tag_names(OM)' operation, which returns the list of all tags in an entire textarea.
The program shown below sets up a textarea into which text is inserted and then tagged. Information concerning the tags is then printed. We then bind actions to the tags. A pair of actions, one bound to mousedown and the other to mouseup, is attached to the first pair, but only a mouseup action to the second tag. You can click on the colored textareas to see the results of these bindings.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,10"); txt("side") := "left";
-- create and place a text widget
txt(OM) := "Type\ntext\nhere"; -- put some text into it
print(txt("1.0".."2.1")); -- print a range of this text
txt.tag_add("my_tag","1.1,1.1,2.1,3.3");
-- add a tag to two disjoint character ranges
txt.tag_add("my_tag2","1.3,1.5");
-- add a second tag to a character range
print(txt.tag_ranges("my_tag"));
-- get list of all ranges for specified tag
print(txt.tag_names("1.1"));
-- get list of all tags covering the specified character
-- set tag attributes, to make tagged ranges visible
txt("my_tag","font,background,foreground")
:= "{times 24 bold italic},red,yellow";
txt("my_tag2","font,background,foreground")
:= "{times 36 bold},blue,white";
txt{"my_tag",OM} := lambda(); print("Clicked yellow text"); end lambda;
-- bind a print action to click on the yellow text
txt{"my_tag","ButtonPress-1"} := lambda();
print("Pressed yellow text"); end lambda;
-- bind a print action to mousedown on the yellow text
txt{"my_tag2",OM} := lambda();
print("Clicked white text"); end lambda;
-- bind a print action to mousedown on the white text
print(txt.tag_names(OM));
-- print ordered list of tags associated with widget
Tk.mainloop(); -- enter the Tk main loop
end test;
The output produced is
Type t ["1.1", "1.1", "2.1", "3.3"] ["my_tag"] ["sel", "my_tag", "my_tag2"]
Note that event bindings like
txt{"my_tag","ButtonPress-1:xyXY"} := proc;
are also possible, in which case 'proc' must be a 1-parameter procedure, to which as many event parameter values as have been requested will be transmitted as a tuple.
Though the previously described scheme for inserting tags into text is quite general, it is rather more intricate than is required for text hotwording in the normal case, since it allows tagged zones in text to overlap in arbitrary fashion, which is rarely done. Normally such zones are disjoint. Our next two examples show a simpler scheme for text hotwording. To use this scheme, one simply takes the text to be tagged and marks the tagged sections in it by putting a back-apostrophe character '`' before and after each tagged section. The text within these sections is then extracted and used to tag itself, blank spaces in such sections being replaced by '~' characters. Thus, for example, a tagged text section consisting of the words 'Hello World' would receive the tag 'Hello~World'. If the same tagged section occurs several times in the text, unique serial numbers are be appended to all occurrences after the first, so that the second occurrence of a tagged section 'xxx' in text will receive the tag 'xxx~2'. The resulting tags can then be assigned attributes,for example color nd font, in the normal way. All these details are illustrated in the example seen below, which uses a simple code package called 'hotword_pak' shown following it. This package provides just one procedure, which has the form
make_hotworded(txt_widget,text,up_proc,down_proc,enter_proc,leave_proc);
Here, the first parameter is a Tk text widget into which the hotworded text is to be placed. The second parameter is the text to be hotworded, marked with back apostrophes in the way just explained. The last four parameters of 'make_hotworded' are all two-parameter procedures, which (if not OM) are called as the mouse moves over and clicks on the hotworded text zones. The first of these procedures, 'up_proc', is called when the mouse button is released on a hotworded zone in text, and the second, 'down_proc', when the mouse is pressed on a hotworded zone in text. The two last parameters, 'enter_proc' and 'leave_proc' are called when the mouse enters and leaves a hotworded text zone respectively. The two parameters passed to these routines when they re called are respectively the text widget containing the hotworded text,and the tag attached to the triggering text zone.
The following example shows how easy it is to use this hotwording scheme. It sets up two text areas in a window, each containing a sample hotworded text. (All four of the procedures then bound to this text are very trivial, and intended for illustration only. The 'up_proc' and 'down_proc' parameters passed merely print the tag associated with the hotworded text section on which a click occurs, the former in lowercase and the latter in uppercase. The 'enter_pro' and 'leave_proc' routines merely change the text color from black to red and back again, giving a 'highlighting' effect. Of course much more sophisticated effects could be obtained by elaborating these procedures.)
program test; -- SETL interactive interface example 1
use tkw,hotword_pak,string_utility_pak;
-- use the main widget class and the hotword_pak
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Hotworded Text"; -- create the Tk interpreter
txt := Tk("text","40,5"); txt("side") := "top"; -- create a text widget
txt("font") := "{Times 18 bold}"; -- set a font
text := "`Now` is the `time` for all `good men` to `time` out.";
-- define the text to be hotworded
make_hotworded(txt,text,printit,printcap,hilite,lolite);
-- put hotworded text into the text widget
txt("now",b := "background") := "yellow"; txt("time",b) := "green";
-- make the tags visible
txt("good~men",b) := "pink"; txt("time~2",b) := "cyan";
txt := Tk("text","40,5"); txt("side") := "top";
-- create a second text twidget
txt("font") := "{Times 18 bold italic}"; -- set a different font
text := "Twas `Brillig` and the `Slithy Toves` "
+ "did `Gyre` and `Gimbal` in the `Wabe`.";
-- define the second text to be hotworded
make_hotworded(txt,text,printit,printcap,hilite,lolite);
-- put hotworded text into the second text widget
txt("brillig",b) := "yellow"; txt("slithy~toves",b) := "green";
-- make the tags visible
txt("gyre",b) := "pink"; txt("gimbal",b) := "cyan"; txt("wabe",b) := "magenta";
Tk.mainloop(); -- enter the Tk main loop
procedure printit(txt,tag); print(tag); end printit;
-- print tag on mouseup
procedure printcap(txt,tag); print(case_change(tag,"lu")); end printcap;
-- print capitalized tag on mousedown
procedure hilite(txt,tag); txt(tag,"foreground") := "red"; end hilite;
-- hilite the tagged text on entry
procedure lolite(txt,tag); txt(tag,"foreground") := "black"; end lolite;
-- hilite the tagged text on exit
end test;
The code shown below is that for the 'hotword_pak' used in the preceding example. Its one procedure, 'make_hotworded' accepts a text widget TW and some text marked in the manner described above, plus the four procedure parameters that we have described. The text is analyzed to find its hotworded zones, and then converted into text tagged in our standard manner, by using the text in each hotworded section as its own tag. This is accomplished by the subprocedure 'self_tag', which you can examine to see the details of this process. The tagged text produced by 'self_tag' is then written to TW. Following this, each of the four procedure parameters passed to 'make_hotworded' is bound to each of the tags found in the text, in such a way as to ensure that then appropriate triggering events will cause these procedures to be called and TW passed to them along with the tag attached to the triggering text section. The preceding example illustrates the use of all of these conventions.
package hotword_pak; -- utility package for Tk text hotwording
procedure make_hotworded(txt_widget,text,up_proc,down_proc,enter_proc,leave_proc); -- put hotworded text into text widget
end hotword_pak;
package body hotword_pak; -- utility package for Tk text hotwording
use string_utility_pak;
var tags_list := [],seen_already := {};
-- tags_list will be collected by self_tag
procedure make_hotworded(txt_widget,text,up_proc,down_proc,enter_proc,leave_proc);
-- put hotworded text into text widget
tags_list := []; -- will be collected by self_tag
pieces := breakup(text,"`");
-- treat as a '`' treat as a '`'-delimited list
-- convert the hotworded sections 'xxx' into <`xxx`>xxx<``xxx`>,
-- i.e. use stringitself as tag
txt_widget(OM) := "" +/ [if odd(j) then piece
else self_tag(piece) end if: piece = pieces(j)];
-- self_tag also collects the tags
for tag in tags_list loop
-- attach four bindings to each of the tags
if up_proc /= OM then
-- bind 'up_proc' to button-up event
txt_widget{tag,"ButtonRelease-1"} := apply(up_proc,txt_widget,tag);
end if;
if down_proc /= OM then
-- bind 'down_proc' to button-up event
txt_widget{tag,"ButtonPress-1"} := apply(down_proc,txt_widget,tag);
end if;
if enter_proc /= OM then
-- bind 'enter_proc' to entry event
txt_widget{tag,"Enter"} := apply(enter_proc,txt_widget,tag);
end if;
if leave_proc /= OM then
-- bind 'leave_proc' to exit event
txt_widget{tag,"Leave"} := apply(leave_proc,txt_widget,tag);
end if;
end loop;
end make_hotworded;
procedure self_tag(stg); -- convert 'stg' a string carrying itself as tag
safe_stg := join(breakup(stg," "),"~");
-- convert " " to "~",which is btter for Tk
sul := case_change(safe_stg,"ul"); -- make case-insensitive
seen_already(sul) := n := (seen_already(sul)?0) + 1;
-- count number of occurneces
tags_list with:= (sul := if n = 1 then sul else sul + "~" + n end if);
-- save the tag in tags_list; keep count if > 1
return "<`" + sul + "`>"+ stg + "<``" + sul + "`>";
-- return'stg' a string carrying itself as tag
end self_tag;
procedure apply(proc,txt,tag); -- procedure binding former
return lambda(); proc(txt,tag); end lambda;
end apply;
end hotword_pak;
Tk absolute Images (and 'absolute bitmaps', which will be described later) can be inserted into text, in which case they behave as single characters of a special kind. The following small program shows this, and also illustrates the use of the 'txt.linebox(n)' operation, which returns a pair of the form [box,baseline], where 'box' is the bounding box of the specified line, and 'baseline' is the position of the baseline of this line, as measured from the top of 'box'. Note also that 'txt("images")' returns the list of all images in a text widget, or, if there is only one, returns that image object.
The program seen below sets up a textarea and then reads in an image which is inserted into the text in the textarea. Two buttons are added, one of which prints the boxes containing two specified lines of text and the other the list of all images in the textarea. Note that, as seen in the code bound to the first button, the 'linebox()' operation assumes that n is given in a 0-based form.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","30,12"); txt("side") := "top";
txt(OM) := "Type\ntext\nhere"; -- create a text area
txt("font,background") := "{Times 18 bold},green";
abs_img := Tk("image","test_files/egyptian.gif");
-- read an image file to create a Tk absolute image
txt.insert_image("1.1",abs_img);
-- insert this into the text area
but := Tk("button","Print lineboxes"); but("side") := "top";
-- create a button
but{OM} := lambda();
print(txt.linebox(0)); print(txt.linebox(2)); end lambda;
-- bind this to a pair of linebox print actions
but := Tk("button","Print images"); but("side") := "top"; -- create a button
but{OM} := lambda(); print(txt("images")); end lambda;
-- bind this to an image_list print action
Tk.mainloop(); -- enter the Tk main loop
end test;
The text widget operations
txt.scan_mark(i,j); and txt.scan_to(i,j);
together allow the view of a text field containing more text than can be viewed at any one time to be shifted. The same operations are available for listboxes. This is demonstrated in the following example, which opens a text area, inserts some text into it, and then sets up buttons which invoke the 'scan_mark' and 'scan_to' operations to reposition the text in the text area. You can experiment with these buttons to verify that the 'scan_to' positions text relative to the point set by last preceding 'scan_mark' operation.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("text","10,2"); txt("side") := "top";
txt("background") := "yellow";
txt(OM) := " (1)Type text here\n (2)Type text here\n "
+ " (3)Type text here\n (4)Type text here";
txt("font") := "{times 36 bold}"; txt("wrap") := "none";
but := Tk("button","Place scan mark at (0,0)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_mark(0,0); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Place scan mark at (-3,-3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_mark(3,3); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Scan to (-2,-2)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(-2,-2); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (-3,-3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(-3,-3); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (-4,-4)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(-4,-4); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (2,2)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(2,2); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to (3,3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(3,3); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to (4,4)"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to(4,4); end lambda;
-- move to left from (0,0)
Tk.mainloop(); -- enter the Tk main loop
end test;
Next we give a very similar example for listboxes. This sets up a listbox, and then creates buttons which invoke the 'scan_mark' and 'scan_to' operations to repostion the listbox items. You can experiment with these buttons to verify that the 'scan_to' positions the listbox items relative to the point set by last preceding 'scan_mark' operation.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var lb; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
lb := Tk("listbox",3); lb("side") := "top";
-- create a listbox, which shows 3 elements
lb(1..0) := "Item1Item1Item1Item1Item1***********,"
+ "Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Last Item";
-- put 10 elements, the first quite long, into the listbox
lb("font") := "{times 18 bold}";
but := Tk("button","Place scan mark at (0,0)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_mark(0,0); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Place scan mark at (-3,-3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_mark(3,3); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Scan to (-2,-2)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(-2,-2); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (-3,-3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(-3,-3); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (-4,-4)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(-4,-4); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to (2,2)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(2,2); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to (3,3)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(3,3); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to (4,4)"); but("side") := "top";
-- create a button
but{OM} := lambda(); lb.scan_to(4,4); end lambda;
-- move to left from (0,0)
Tk.mainloop(); -- enter the Tk main loop
end test;
As the following variant example shows, the scan_mark and scan_to operations 1s also available for textlines, but in a '1-dimensional' rather than a '2-dimensional' form, namely as
txt.scan_mark_1(i); and txt.scan_to_1(i);
The following is an example. It sets up a textline, puts text into it, and and then creates buttons which invoke the 'scan_mark_1' and 'scan_to_1' operations to repostion the textline. You can experiment with these buttons to verify that the 'scan_to' positions the text relative to the point set by last preceding 'scan_mark' operation.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var txt; -- globalize for use in procedure below
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
txt := Tk("entry","10"); txt("side") := "top";
txt("background") := "yellow";
txt(OM) := " (1)Type text here (2)Type text here "
+ "(3)Type text here (4)Type text here";
txt("font") := "{times 36 bold}";
but := Tk("button","Place scan mark at 0"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_mark_1(0); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Place scan mark at -10"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_mark_1(-10); end lambda;
-- place mark anchoring following offsets
but := Tk("button","Scan to -20"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(-20); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to -30"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(-30); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to -40"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(-40); end lambda;
-- move to right from (0,0)
but := Tk("button","Scan to 10"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(10); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to 3"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(3); end lambda;
-- move to left from (0,0)
but := Tk("button","Scan to 4"); but("side") := "top";
-- create a button
but{OM} := lambda(); txt.scan_to_1(4); end lambda;
-- move to left from (0,0)
Tk.mainloop(); -- enter the Tk main loop
end test;
rectangle - a rectangular figure oval - a circular or figure polygon - a general closed polygon or spline curve line - a general open polygon or spline curve arc - a circular or elliptical sector or pie-shaped region bitmap - a bitmap, which can be displayed in designated colors image - a photographic image widget - an arbitrary widget canvas_text - non-editable fonted text, with a transparent backgroundCanvas items are created by writing statements of the form
item := canvas("rectangle",descriptor),
item := canvas("polygon",descriptor),
item := canvas("image",descriptor), etc.
As shown in the following table, the kind of descriptor used depends on the kind of item being created
'Descriptors' used with the various kinds of canvas items rectangle - left,top,right,bottom oval - left,top,right,bottom of enclosing rectangle polygon - comma-separated series of x,y positions - for polygon or spline points line - comma-separated series of x,y positions - for polygon or spline points arc - left,top,right,bottom of enclosing rectangle bitmap - x,y coordinates of bitmap corner image - x,y coordinates of image corner widget - widget object canvas_text - string contents of textOnce they have been created within a canvas C, canvas items 'itm' are positioned (and so made visible) by writing
itm("coords") := list_of_coords;
The list_of_coords that must be supplied is generally identical with the descriptor list appearing in the preceding table, except that for widget items in a canvas and for canvas_text items the list_of_coords should be the x,y coordinates of the object corner.
Once positioned in this way any canvas item can be repositioned (and, in some cases, reshaped) at any time by a subsequent
itm("coords") := list_of_coords;
assignments. When repositioned or reshaped, objects move immediately to their new configuration, leaving no trailing artifacts. This make the canvas environment considerably easier to use than a simple 'draw' environment in which one needs to make explicit repairs of the prior positions of moved graphics. For example, the following program creates an animated pair of circles which move past each other.
Here is an example of the use of 'coords'. The code creates a canvas into which two ovals are placed and a button bound to a procedure which shifts the position of these circles every time it is clicked.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,blue_circ,red_circ,num_steps := 0;
-- globalize for use in procedure below
Tk := tkw(); -- create the Tk interpreter
bu := Tk("button","Click to move the circles"); bu("side") := "top";
-- create a button
bu{OM} := advance_animation; -- clicking the button starts the animation
ca := Tk("canvas","640,280"); ca("side") := "top"; -- create a canvas
blue_circ := ca("oval","100,100,140,140"); blue_circ("fill") := "blue";
-- insert the circles
red_circ := ca("oval","400,100,440,140"); red_circ("fill") := "red";
Tk.mainloop(); -- enter the Tk main loop
procedure advance_animation();
-- advance the animation and return true, or false if finished
bcc := [str(unstr(c) + 5.0): c in blue_circ("coords")];
-- reposition the circles
blue_circ("coords") := bcc;
rcc := [str(unstr(c) - 5.0): c in red_circ("coords")];
red_circ("coords") := rcc;
end advance_animation;
end test;
Here is another example: a time-driven animation showing two colored circles. This code is very close to the preceding program but instead of using button clicks to change the position of the circles that appear, they move automatically under timer control once a triggering button is clicked. An additional comment is found below.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
var Tk,blue_circ,red_circ,num_steps := 0;
-- globalize for use in procedure below
Tk := tkw(); -- create the Tk interpreter
bu := Tk("button","Go"); bu("side") := "top"; -- create a button
bu{OM} := advance_animation; -- clicking the button starts the animation
ca := Tk("canvas","640,280"); ca("side") := "top"; -- create a canvas
blue_circ := ca("oval","100,100,140,140"); blue_circ("fill") := "blue";
-- insert the circles
red_circ := ca("oval","400,100,440,140"); red_circ("fill") := "red";
Tk.mainloop(); -- enter the Tk main loop
procedure advance_animation();
-- advance the animation and return true, or false if finished
if (num_steps +:= 1) > 300 then return; end if;
-- end the animation after 300 steps
blue_circ("coords") := -- reposition the circles
str(100 + num_steps) + ",100," + str(140 + num_steps) + ",140";
red_circ("coords") :=
str(400 - num_steps) + ",100," + str(440 - num_steps) + ",140";
Tk.createtimer(5,advance_animation);
-- start a Tk timer (rings once)
end advance_animation;
end test;
The following comments will aid understanding of the preceding code. The initial lines of code create a button, a canvas, and two canvas items: a red and a blue circle. Clicking the button calls the procedure 'advance_animation', which repositions the two circles and then creates another timed call to itself, unless it has already been called 300 times, in which case it simply returns. Note that the desired animation is created simply by repositioning the two circles.
Note also that the line
Tk.createtimer(5,advance_animation);can be replaced by
Tk.createidle(advance_animation);This will advance the animation as rapidly as possible, rather than after a specified time interval.
Each kind of canvas item has a list of attributes which can be used to control its graphical appearance. The following table lists the attributes for each canvas item type.
rectangle attributes width - width of outline fill - color for interior outline - color for outline stipple - pattern for interior
oval attributes width - width of outline fill - color for interior outline - color for outline stipple - pattern for interior
polygon attributes width - polygon outline width, in pixels smooth - if true, polygon is a spline curve splinesteps - number of intermediate smoothing points to use, if spline fill - color for polygon interior outline - color for polygon outline stipple - pattern for arc interior
line attributes width - curve width, in pixels smooth - if true, curve is a spline curve splinesteps - number of intermediate smoothing points to use, if spline fill - color for curve interior stipple - pattern for arc interior stipple - pattern for arc interior arrow - position to place arrowheads: none, first, last, or both arrowshape - three numerical parameters defining arrowhead shape: - distance from base to point, head length, head width capstyle - line end shape: butt, projecting, or round joinstyle - line join shape: bevel, miter, or round
arc attributes style - pieslice, chord, or arc (circular boundary only) start - starting angle of circular arc, in degrees extent - extent of circular arc, in degrees width - width of outline fill - color for interior outline - color for outline stipple - pattern for interior outlinestipple - pattern for outline
bitmap attributes bitmap - file name or built-in bitmap name defining picture geometry anchor - point from which position is reckoned: n,s,e,w,nw,sw,ne, or se background - display color for bitmap background foreground - display color for bitmap foreground
image attributes image - image object to appear in canvas item anchor - point from which position is reckoned: n,s,e,w,nw,sw,ne, or se
canvas-widget attributes window - widget object to appear in canvas item anchor - point from which position is reckoned: n,s,e,w,nw,sw,ne, or se width - widget width, in pixels or number of characters height - widget height, in pixels or number of characters
canvas-text attributes text - actual text string anchor - point from which position is reckoned: n,s,e,w,nw,sw,ne, or se font - text font, e.g. "Times,20,bold" justify - left, right, or center fill - text color stipple - text pattern width - text area width
See the following section for a discussion of canvas scrolling.
Canvas Widgets. Widgets of any kind can be put directly into a canvas, as 'canvas widgets'. When so placed they retain their normal activity. This is done by creating the widgets w in the normal way, as children of the canvas, except that they are not made visible by packing of gridding them. instead, they are first converted into 'canvas widgets' by writing commands like
canv_w := canvas("widget",w);
The resulting canvas widget is then assigned coordinates by a command like
canv_w(""coords"):= "x,y";
These rules are illustrated by the following program. It sets up a canvas, and inserts three widgets into it, the first a frame containing a scrolling listbox (see the following section for additional details concerning scrollbars and scrolling listboxes) , the second a listbox, and the third a scrollbar widget geometrically disconnected from the other widgets but logically linked to the second. The scrollbar in the frame is given a horizontal orientation but connected to the y-scrolling action of the listbox in the frame (just to demonstrate that this is possible). You can execute this code and experiment with it to verify that all the canvas widgets behave as normally as other widgets.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
ca := Tk("canvas","300,300"); ca("side") := "left"; -- create a canvas
ca("background") := "green";
fr := ca("frame","100,50"); -- this frame will be put directly into the canvas
fr_incanv := ca("widget",fr); fr_incanv("coords,anchor") := "10,10;nw";
lb := fr("listbox",3); lb("side") := "top";
-- this listbox, placed in the frame, shows 3 elements
lb(1..0) := "Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Item10";
-- listbox contains 10 elements, so a scrollbar is attached
lb("yscroller") := scrollb := fr("scrollbar","h,10");
-- attach a scrollbar, giving it a somewhat' perverse' orientation
scrollb("side,fill") := "top,x";
-- make the scrollbar visible by putting it into the frame
lb2 := ca("listbox",4); -- this listbox shows 4 elements
lb2(1..0) := "Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Item10";
-- the listbox contains 10 elements, so a scrollbar is attached
lb2_incanv := ca("widget",lb2); lb2_incanv("coords,anchor") := "50,80;nw";
-- put this listbox directly into the canvas, as a canvas widget
lb2("yscroller") := scrollb := ca("scrollbar","v,10"); -- attach a scrollbar
scrollb_incanv := ca("widget",scrollb);
scrollb_incanv("coords,anchor") := "250,100;nw";
-- put this scrollbar directly into the canvas, as a canvas widget
Tk.mainloop(); -- enter the Tk main loop
end test;
As shown by the following micro-program, the convenience operation
canvas.draw_ovals(descriptor);
can be used to draw a group of any number of ovals in a canvas. Here,the descriptor should be a tuple of pairs [rect,fill], each defining the enclosing rectangle of an oval, and its fill. Each 'rect' should be a comma- or blank-delimited string of coordinates. The operation returns a pair consisting of first and last ovals drawn.
program test; -- SETL interactive interface example 1
use tkw; -- use the main widget class
Tk := tkw(); Tk(OM) := "Example 1"; -- create the Tk interpreter
ca := Tk("canvas","300,100"); ca("side") := "top";
-- if packed; or left,right,bottom
ca("background") := "#cccccc";
ca.draw_ovals([["5,5,20,20","red"],["25,5,40,20","blue"],
["45,5,60,20","green"],["65,5,80,20","magenta"]]);
Tk.mainloop(); -- enter the Tk main loop
end test;
Converting the contents of a canvas to printable Postscript. The graphical interface provides a means for translating the contents of a canvas into a Postscript file. These Postscript files are can either be printed or viewed a with a Postscript viewer. (A good Postscript viewer is 'GSView', which is free and can be downloaded the from the Web.) Translation to Postscript is the governed the options parameter in the command seen above, which should be supplied in the form of a comma-delimited string in which every in odd numbered element should be a option name, and each following even numbered element should be the corresponding option value. The most commonly used are Postscript option values are shown in the table below. (A few other options are also available; for information about these remaining options, consult one of the Tk references listed above.)
Option Name Use and possible values x left edge of canvas rectangle to be printed. Defaults to left edge of canvas. y top edge of canvas rectangle to be printed. Defaults to top edge of canvas. width width of canvas rectangle to be printed. Defaults to width of canvas. height width of canvas rectangle to be printed. Defaults to width of canvas. pageanchor determines point of printed canvas region used for positioning it on the Postscript page. Must be n,nw,w,sw,s,se, e,of center. Defaults to center. pagex x position on page of canvas anchor point. pagey y position on page of canvas anchor point. pagewidth width on page of canvas rectangle image. Scaling to achieve this is the same in x and y. Defaults to 1.0. pageheight height on page of canvas rectangle image. Scaling to achieve this is the same in x and y. Overrides pagewidth. colormode controls use of color in Postscript translation. Must be color, gray, or mono (black and white). file if given, Postscript output will be written to the file named, and the 'postscript' operation will return an empty string.
The following program illustrates the use of the 'postscript' operation.
program test; -- standard template for interactive programs
use tkw,string_utility_pak; -- use the main widget class
var Tk,global_1,global_2,global_3;
Tk := tkw(); Tk(OM) := "Caption"; -- create the Tk interpreter
ca := Tk("canvas","300,200"); ca("side") := "left"; -- create a canvas
rect := ca("rectangle","20,20,60,40"); rect("fill") := "red";
-- put some overlapping geometric items and text into the canvas
oval := ca("oval","80,20,120,40"); oval("width") := 5;
line := ca("line","140,20,180,20,180,40,20,40");
line("fill,smooth") := "blue,true";
poly := ca("polygon","140,60,180,60,180,100,20,100");
poly("fill,smooth") := "blue,true";
poly := ca("polygon","140,80,180,80,180,120,20,120");
poly("fill,smooth") := "green,true";
oval := ca("oval","80,80,120,100"); oval("width") := 5;
ct := ca("text","Text in the canvas");
ct("coords") := "30,30"; ct("anchor,font") := "nw,{Times 36}";
printa(handl := open("postscript_test","TEXT-OUT"),
ca.postscript("colormode,gray"));
-- generate Postscript for the canvas and write it out
close(handl);
Tk.mainloop();
end test;
Note that the 'postscript' operation returns the Postscript translation of the canvas area contents as a string (Postscript translations have the form of code not involving any special characters) unless the 'file' option is given, in which case the Postscript output will be written to the file named, and the 'postscript' operation will return an empty string. Note that the 'GSView' Postscript viewer is able to export Postscript files in a wide variety of formats, including Adobe PDF (portable document format), EPS (encapsulated postscript), Adobe Illustrator, FAX, Tiff, JPEG, Pict, PNG (portable network graphics image format), PBM (portable bitmap format), and PCF (portable compiled, a format used for fonts) formats. This makes it possible to write the contents of a canvas in most important graphic and image file formats.
(i) In regard to their geometry, scrollbars are treated as independent widgets, created by statements of the form
sc := parent("scrollbar",descriptor);
sc := parent("scrollbar","v,10"); sc("side,fill") := "left,y";
sc("yscroller") := sb;
(ii) Once created, the scrollbar must be made visible by packing, gridding, or placing it into a window or other widget (e.g. frame), in the same way as any other widget would be packed, gridded, or placed.
(iii) To attach a scrollbar to a scrollable widget w, so that the scrollbar will always reflect the current position within w of w's pane of visibility, and so that scrollbar manipulations will cause this pane to scroll in the expected way, one must write an assignment of the form
w("xscroller") := scrollbar; (for a horizontal scrollbar)
or
w("yscroller") := scrollbar; (for a vertical scrollbar)
The following example illustrates these scrollbar conventions. We create a text area within a frame and two scrollbars placed in only rough geometric relationship to the text area, but connected to it so as to have scrollbar dragging scroll the text in the normal way. Note that automatic wrapping of long lines is turned off so th