mozart-doc 1.4.0-8ubuntu1 / usr / share / mozart / doc / wp / WindowProgramming.oz

%%%
%%% Chapter: Getting started
%%%

declare
W={New Tk.toplevel tkInit(title:'Capitalization')}
E={New Tk.entry    tkInit(parent:W)}
B={New Tk.button   tkInit(parent: W
                          text:   'Change Capitalization'
                          action: proc {$}
                                     S={E tkReturn(get $)}
                                  in
                                     {E tk(delete 0 'end')}
                                     {E tk(insert 0 {Map S fun {$ I}
                                                              case {Char.type I}
                                                              of lower then {Char.toUpper I}
                                                              [] upper then {Char.toLower I}
                                                              else I
                                                              end
                                                           end})}
                                  end)}
{Tk.send pack(E B fill:x padx:4 pady:4)}





%%%
%%% Chapter: Widgets
%%%

%%
%% Toplevel widgets
%%

%% Creating a toplevel widget
declare
W={New Tk.toplevel tkInit(width:150 height:50)}

%% Changing its backgound
{W tk(configure background:purple)}

%% Closing the toplevel widget
{W tkClose}


%%
%% Frames
%%

declare
W ={New Tk.toplevel tkInit}
Fs={Map [groove ridge flat sunken raised]
    fun {$ R}
       {New Tk.frame tkInit(parent:W width:2#c height:1#c
                            relief:R borderwidth:4)}
    end}
{{Nth Fs 3} tk(configure background:black)}
{Tk.send pack(b(Fs) side:left padx:4 pady:4)}


{W tkClose}


%%
%% Label Widgets
%%

declare
W ={New Tk.toplevel tkInit}
L1={New Tk.label tkInit(parent:W bitmap:info)}
L2={New Tk.label tkInit(parent:W text:'Labels: bitmaps and text')}
{Tk.send pack(L1 L2 side:left padx:2#m pady:2#m)}

{L1 tk(configure bitmap:warning)}



%%
%% Bitmap options
%%

{L2 tk(configure bitmap:     '@'#'/usr/share/mozart/doc/wp/queen.xbm'
                 foreground: orange)}


{W tkClose}


declare
W={New Tk.toplevel tkInit}
{List.forAllInd [error     gray75 gray50    gray25   gray12
                 hourglass info   questhead question warning]
 proc {$ I D}
    R=(I-1) div 5 
    C=(I-1) mod 5
 in
    {Tk.batch [grid(row:R*2   column:C
                    {New Tk.label tkInit(parent:W bitmap:D)})
               grid(row:R*2+1 column:C
                    {New Tk.label tkInit(parent:W text:D)})]}
 end}


{W tkClose}



%%
%% Font options
%%

declare
W={New Tk.toplevel tkInit}
{ForAll [times helvetica courier]
 proc {$ Family}
    {ForAll [normal bold]
     proc {$ Weight}
        F={New Tk.font  tkInit(family: Family 
                               weight: Weight 
                               size:   12)}
        L={New Tk.label tkInit(parent: W
                               text:   'A '#Weight#' '#Family#' font.'
                               font:   F)}
     in
        {Tk.send pack(L)}
     end}
 end}


{W tkClose}



%%
%% Images
%%

declare
W ={New Tk.toplevel tkInit}
D ='/usr/share/mozart/doc/wp/'
I ={New Tk.image tkInit(type:photo format:ppm file:D#'truck-left.ppm')}
L1={New Tk.label tkInit(parent:W image:I)}
L2={New Tk.label tkInit(parent:W image:I)}
L3={New Tk.label tkInit(parent:W image:I)}
{Tk.send pack(L1 L2 L3 padx:1#m pady:1#m side:left)}

{I tk(configure file:D#'truck-right.ppm')}


{W tkClose}



%%
%% Messages
%%

declare
W ={New Tk.toplevel tkInit(bg:white)}
S ='Text extending over several lines.'
Ms={Map [left#200 center#100 right#50]
    fun {$ J#A}
       {New Tk.message tkInit(parent:W text:S justify:J aspect:A)}
    end}
{Tk.send pack(b(Ms) side:left padx:2#m pady:2#m)}


{W tkClose}




%%%
%%% Chapter: Geometry Managers
%%%

%%
%% The Packer
%%

declare
fun {NewLabels}
   W={New Tk.toplevel tkInit(background:white)}
in
   {Map ['label' 'Second label widget' '3rd label']
    fun {$ A}
       {New Tk.label tkInit(parent:W text:A)}
    end}
end

declare
[L1 L2 L3] = {NewLabels}
{Tk.send pack(L1 L2 L3)}

{Tk.send pack(b({NewLabels}))}


%% Side Options
{Tk.send pack(b({NewLabels}) side:left)}

{Tk.send pack(b({NewLabels}) side:bottom)}


%% Padding
{Tk.send pack(b({NewLabels}) padx:1#m pady:1#m)}

{Tk.send pack(b({NewLabels}) ipadx:2#m ipady:2#m)}


%% Anchors
{Tk.send pack(b({NewLabels}) anchor:w padx:1#m pady:1#m)}


%% Filling and Expansion
{Tk.send pack(b({NewLabels}) fill:x)}

{Tk.send pack(b({NewLabels}) expand:true)}

{Tk.send pack(b({NewLabels}) fill:both expand:true)}



%%
%% The Grid Geometry Manager
%%

declare
W={New Tk.toplevel tkInit(bg:white)}
proc {GL W R C S}
   L={New Tk.label tkInit(parent:W text:S)}
in
   {Tk.send grid(L row:R column:C padx:4 pady:4)}
end
{GL W 1 1 nw}   {GL W 1 2 north} {GL W 1 3 ne}
{GL W 2 1 west}                  {GL W 2 3 east}
{GL W 3 1 sw}   {GL W 3 2 south} {GL W 3 3 sw}


%% Span Options
declare
W={New Tk.toplevel tkInit(bg:white)}
{Tk.send grid({New Tk.label tkInit(parent:W text:'Upper left')} 
              row:1    rowspan:2
              column:1 columnspan:2
              padx:4 pady:4)}
{GL W 1 3 ne} {GL W 2 3 east}
{GL W 3 1 sw} {GL W 3 2 south} {GL W 3 3 sw}


%% Sticky Options
declare
W={New Tk.toplevel tkInit(bg:white)}
{Tk.send grid({New Tk.label tkInit(parent:W text:'Upper left')} 
              row:1    rowspan:2
              column:1 columnspan:2
              sticky: nse
              padx:4 pady:4)}
{GL W 1 3 ne} {GL W 2 3 east}
{GL W 3 1 sw} {GL W 3 2 south} {GL W 3 3 sw}


%% Weight Options
{Tk.batch [grid(rowconfigure    W 3 weight:1)
           grid(columnconfigure W 3 weight:1)]}



%%
%% Using Anchors for Widgets
%%

declare
[L1 L2 L3]={NewLabels}
{Tk.send pack(L1 L2 L3 fill:x)}
{L1 tk(configure anchor:w)} 
{L3 tk(configure anchor:e)}





%%%
%%% Chapter: More Widgets
%%%

%%
%% Buttons and Actions
%%

declare
W ={New Tk.toplevel tkInit}
B1={New Tk.button tkInit(parent: W 
                         text:   'Press me!'
                         action: proc {$}
                                    {Browse pressed}
                                 end)}
B2={New Tk.button tkInit(parent: W 
                         bitmap: error
                         action: W#tkClose)}
{Tk.send pack(B1 B2 fill:x padx:1#m pady:1#m)}

{B1 tkAction}
{B2 tkAction(action: B1 # tkClose)}

{W tkClose}



%%
%% Checkbuttons, Radiobuttons, and Variables
%%

declare
W ={New Tk.toplevel tkInit}
V1={New Tk.variable tkInit(false)}
C ={New Tk.checkbutton tkInit(parent:W variable:V1
                              text:'Bold' anchor:w)}
V2={New Tk.variable tkInit('Helvetica')}
Rs={Map ['Times' 'Helvetica' 'Courier']
    fun {$ F}
       {New Tk.radiobutton tkInit(parent:W 
                                  variable:V2 value:F
                                  text:F anchor:w)}
    end}
{Tk.batch [grid(C     padx:2#m columnspan:3)
           grid(b(Rs) padx:2#m)]}

{Browse state(bold:   {V1 tkReturnInt($)}==1
              family: {V2 tkReturnAtom($)})}

declare
fun {GetWeight}
   if {V1 tkReturnInt($)}==1 then bold else normal end
end
F={New Tk.font tkInit(size:24
                      family: {V2 tkReturn($)}
                      weight: {GetWeight})}
L={New Tk.label tkInit(parent:W text:'A test text.' font:F)}
{C  tkAction(action: proc {$}
                        {F tk(configure weight:{GetWeight})}
                        {L tk(configure font:F)}
                     end)}
{List.forAllInd ['Times' 'Helvetica' 'Courier']
 proc {$ I Family}
    {{Nth Rs I} tkAction(action: proc {$}
                                    {F tk(configure family:Family)}
                                    {L tk(configure font:F)}
                                 end)}
 end}
{Tk.send grid(L padx:2#m pady:2#m sticky:ew columnspan:3)}


{W tkClose}



%%
%% Menus, Menuitems and Menubuttons
%%

declare
W  ={New Tk.toplevel tkInit}
Cs =['Wheat' 'Firebrick' 'Navy' 'Darkorange']
M1 ={New Tk.menu tkInit(parent:W  tearoff:false)}
M2 ={New Tk.menu tkInit(parent:M1 tearoff:false)}
E1 ={New Tk.menuentry.cascade
     tkInit(parent:M1 label:'Background Color' menu:M2)}
E2 ={New Tk.menuentry.separator tkInit(parent:M1)}
E3 ={New Tk.menuentry.command
     tkInit(parent:M1 label:'Quit' action: W#tkClose)}
V  ={New Tk.variable tkInit(Cs.1)}
CEs={Map Cs fun {$ C}
               {New Tk.menuentry.radiobutton
                tkInit(parent:M2 label:C var:V val:C
                       action: W#tk(configure bg:C))}
            end}

{M1 tk(post 0 0)}



%%
%% Events
%%

{W tkBind(event:  '<Button-1>'
          args:   [int(x) int(y)]
          action: proc {$ X Y}
                     TX={Tk.returnInt winfo(rootx W)}
                     TY={Tk.returnInt winfo(rooty W)}
                  in
                     {Tk.send tk_popup(M1 X+TX Y+TY)}
                  end)}

{W tkBind(event:  '<1>' 
          append: true
          action: proc {$} {Browse pop} end)}

{W tkClose}



%%
%% More on Actions: Listeners
%%

declare
W ={New Tk.toplevel tkInit}
L ={New class $ from Tk.listener
            meth b1 {Browse b1} end
            meth b2 {Browse b2} end
         end tkInit}
B1={New Tk.button tkInit(parent:W text:'One' action: L#b1)}
B2={New Tk.button tkInit(parent:W text:'Two' action: L#b2)}
{Tk.send pack(B1 B2 side:left)}

{L tkServe(b1)}

{W tkClose}



%%
%% Entries and Focus
%%

declare
W={New Tk.toplevel tkInit}
L={New Tk.label tkInit(parent:W text:'File name:')}
E={New Tk.entry tkInit(parent:W width:20)}
{Tk.batch [pack(L E side:left pady:1#m padx:1#m)
           focus(E)]}

{Browse {E tkReturnAtom(get $)}}

{W tkClose}



%%
%% Scales
%%

declare
W ={New Tk.toplevel tkInit}
L ={New class $ from Tk.listener
           attr red:0 green:0 blue:0
           meth bg(C I)
              C := I {F tk(configure bg:c(@red @green @blue))}
           end
        end tkInit}
F ={New Tk.frame tkInit(parent:W height:2#c)}
Ss={Map [red green blue]
    fun {$ C}
       {New Tk.scale tkInit(parent:W orient:horizontal length:8#c
                            label:C 'from':0 to:255
                            action: L # bg(C)
                            args:   [int])}
    end}
{Tk.send pack(b(Ss) F fill:x)}

{W tkClose}



%%
%% Listboxes and Scrollbars
%%

declare
W={New Tk.toplevel tkInit}
L={New Tk.listbox tkInit(parent:W height:6)}
{L tkBind(event:  '<1>'
          action: proc {$}
                     I={L tkReturn(curselection $)}
                     C={L tkReturn(get(I) $)}
                  in
                     {L tk(configure bg:C)}
                  end)}
S={New Tk.scrollbar tkInit(parent:W)}
{ForAll [aliceblue         antiquewhite         aquamarine          
         azure             beige                bisque              
         black             blanchedalmond       blue                
         blueviolet        brown                burlywood           
         cadetblue         chartreuse           chocolate           
         coral             cornflowerblue       cornsilk            
         cyan              darkblue             darkcyan            
         darkgoldenrod     darkgray             darkgreen           
         darkgrey          darkkhaki            darkmagenta         
         darkolivegreen    darkorange           darkorchid          
         darkred           darksalmon           darkseagreen        
         darkslateblue     darkslategray        darkslategrey       
         darkturquoise     darkviolet           deeppink            
         deepskyblue       dimgray              dimgrey             
         dodgerblue        firebrick            floralwhite         
         forestgreen       gainsboro            ghostwhite          
         gold              goldenrod            gray                
         green             greenyellow          grey                
         honeydew          hotpink              indianred           
         ivory             khaki                lavender            
         lavenderblush     lawngreen            lemonchiffon        
         lightblue         lightcoral           lightcyan           
         lightgoldenrod    lightgoldenrodyellow lightgray           
         lightgreen        lightgrey            lightpink           
         lightsalmon       lightseagreen        lightskyblue        
         lightslateblue    lightslategray       lightslategrey      
         lightsteelblue    lightyellow          limegreen           
         linen             magenta              maroon              
         mediumaquamarine  mediumblue           mediumorchid        
         mediumpurple      mediumseagreen       mediumslateblue     
         mediumspringgreen mediumturquoise      mediumvioletred     
         midnightblue      mintcream            mistyrose           
         moccasin          navajowhite          navy                
         navyblue          oldlace              olivedrab           
         orange            orangered            orchid              
         palegoldenrod     palegreen            paleturquoise       
         palevioletred     papayawhip           peachpuff           
         peru              pink                 plum                
         powderblue        purple               red                 
         rosybrown         royalblue            saddlebrown         
         salmon            sandybrown           seagreen            
         seashell          sienna               skyblue             
         slateblue         slategray            slategrey           
         snow              springgreen          steelblue           
         tan               thistle              tomato              
         turquoise         violet               violetred           
         wheat             white                whitesmoke          
         yellow            yellowgreen]           
 proc {$ C}
    {L tk(insert 'end' C)}
 end}
{Tk.addYScrollbar L S}
{Tk.send pack(L S fill:y side:left)}

{W tkClose}



%%
%% Toplevel Widgets and Window Manager Commands
%%

declare
W={New Tk.toplevel tkInit(title:'Something different')}

{W tkClose}


declare
W={New Tk.toplevel tkInit(withdraw:true)}

{Tk.send wm(deiconify W)}

{W tkClose}



%%
%% Selecting Files
%%

case {Tk.return tk_getOpenFile}
of nil then skip
elseof S then {Browse file({String.toAtom S})}
end



%%
%% Example: Help Popups
%%

declare
local
   fun {MakePopup Parent Text}
      fun {$}
         [X Y H]={Map [rootx rooty height]
                  fun {$ WI}
                     {Tk.returnInt winfo(WI Parent)}
                  end}
         W={New Tk.toplevel tkInit(withdraw:true bg:black)}
         M={New Tk.message
            tkInit(parent:W text:Text bg:khaki aspect:400)}
      in
         {Tk.batch [wm(overrideredirect W true)
                    wm(geometry W '+'#X+10#'+'#Y+H)
                    pack(M padx:2 pady:2)
                    wm(deiconify W)]}
         W
      end
   end
   class HelpListener from Tk.listener
      attr
         cancel: unit
         popup:  unit
      meth init(parent:P text:T)
         popup := {MakePopup P T}
         Tk.listener,tkInit
      end
      meth enter
         C
      in
         cancel := C
         thread A={Alarm 1000} in
            {WaitOr C A}
            if {IsDet A} then W={@popup} in
               {Wait C} {W tkClose}
            end
         end
      end
      meth leave
         @cancel=unit
      end
   end
in
   proc {AttachHelp Widget Text}
      L={New HelpListener init(parent:Widget text:Text)}
   in
      {Widget tkBind(event:'<Enter>'  action:L#enter append:true)}
      {Widget tkBind(event:'<Leave>'  action:L#leave append:true)}
      {Widget tkBind(event:'<Button>' action:L#leave append:true)}
   end
end

declare 
W={New Tk.toplevel tkInit}
Bs={Map ['Okay'   # 'Do nothing meaningful.'
         'Cancel' # 'Do nothing at all.'
         'Quit'   # 'Close the window.']
    fun {$ Text # Help}
       B={New Tk.button tkInit(parent:W text:Text)}
    in
       {AttachHelp B Help} B
    end}
{Tk.send pack(b(Bs) side:left padx:2#m pady:2#m)}


{W tkClose}




%%%
%%% Chapter: Canvas Widgets
%%%

%%
%% Getting started
%%

declare
W={New Tk.toplevel tkInit}
C={New Tk.canvas tkInit(parent:W)}
{Tk.send pack(C)}
{C tk(create rectangle 10 10 1#c 1#c fill:red outline:blue)}


{W tkClose}



%%
%% Example: Drawing Bar Charts
%%

declare
local          
   O=if Tk.isColor then o(fill:wheat)
     else               o(stipple:gray50 fill:black)
     end
   D=10  D2=2*D B=10
in
   class BarCanvas from Tk.canvas
      meth DrawBars(Ys H X)
         case Ys of nil then skip
         [] Y|Yr then 
            {self tk(create rectangle X H X+D H-Y*D2 O)}
            {self tk(create text      X H+D text:Y anchor:w)}
            {self DrawBars(Yr H X+D2)}
         end
      end
      meth configure(SX SY)
         {self tk(configure scrollregion:q(B ~B SX+B SY+B))}
      end
      meth bars(Ys)
         WY=D2*({Length Ys}+1) HY=D2*({FoldL Ys Max 0}+1)
      in
         {self configure(WY HY)}
         {self DrawBars(Ys HY D)}
      end
   end
end

declare
W={New Tk.toplevel tkInit}
C={New BarCanvas    tkInit(parent:W bg:white width:300 height:120)}
H={New Tk.scrollbar tkInit(parent:W orient:horizontal)}
V={New Tk.scrollbar tkInit(parent:W orient:vertical)}
{Tk.addXScrollbar C H} {Tk.addYScrollbar C V}
{Tk.batch [grid(C row:0 column:0)
           grid(H row:1 column:0 sticky:we)
           grid(V row:0 column:1 sticky:ns)]}
{C bars([1 3 4 5 3 4 2 1 7 2 3 4 2 4 
         5 6 7 7 8 4 3 5 6 7 7 8 4 3])}



%%
%% Canvas Tags
%%

declare
W={New Tk.toplevel tkInit}
C={New Tk.canvas tkInit(parent:W)}
{Tk.send pack(C)}
R={New Tk.canvasTag tkInit(parent:C)}
{C tk(create rectangle 10 10 40 40 fill:red tags:R)}

{C tk(create oval 20 20 40 40 tags:R)}

{R tk(move 40 0)}

{W tkClose}


declare
W={New Tk.toplevel tkInit}
C={New Tk.canvas    tkInit(parent:W width:300 height:200 bg:white)}
R={New Tk.canvasTag tkInit(parent:C)}
O={New Tk.canvasTag tkInit(parent:C)}
{C tkBind(event:  '<1>' 
          args:   [int(x) int(y)]
          action: proc {$ X Y}
                     {C tk(create rectangle X-10 Y-10 X+10 Y+10
                           tags:R fill:steelblue)}
                  end)}
{C tkBind(event:  '<2>' 
          args:   [int(x) int(y)]
          action: proc {$ X Y}
                     {C tk(create oval X-10 Y-10 X+10 Y+10
                           tags:O fill:orange)}
                  end)}
{Tk.send pack(C)}

{R tk(itemconfigure fill:wheat)}
{O tk(itemconfigure fill:blue)}

{O tk(delete)}

declare
Colors={New class $ from BaseObject
               attr cs:(Cs=red|green|blue|yellow|orange|Cs 
                           in 
                        Cs)
               meth get(?C) 
                  Cr in C|Cr = (cs := Cr) 
               end
            end noop}
{O tkBind(event:  '<3>' 
          action: proc {$}
                     {O tk(itemconfigure 
                           fill:{Colors get($)})}
                  end)}




%%
%% Example: An Animated Time Waster
%%

declare
local
   fun {RandCoord} {OS.rand} mod 20 + 15 end
in
   class RandMag from Tk.canvasTag
      meth init(parent:P done:D stopped:S)
         {self tkInit(parent:P)}
         {P tk(create bitmap 0 0
                  bitmap:'@'#'/usr/share/mozart/doc/wp/magnifier.xbm'
                  tags:self foreground:blue)}
         thread {self move(D S)} end
      end
      meth move(D S)
         {WaitOr {Alarm 400} D}
         if {IsDet D} then S=unit else
            {self tk(coords {RandCoord} {RandCoord})}
            {self move(D S)}
         end
      end
   end
end

declare
proc {WaitDone Done}
   W={New Tk.toplevel tkInit(withdraw:true)}
   L={New Tk.label    tkInit(parent:W text:'Computing...')}
   C={New Tk.canvas   tkInit(parent:W width:50 height:50)}
   Stopped
in
   {Tk.batch [wm(overrideredirect W true)
              pack(L C side:left pady:2#m padx:2#m)
              wm(deiconify W)]}
   _={New RandMag init(parent:C done:Done stopped:Stopped)}
   thread {Wait Stopped} {W tkClose} end
end


declare Done
{WaitDone Done}

Done=unit




%%%
%%% Chapter: Text Widgets
%%%

%%
%% Inserting Text
%%

declare
W={New Tk.toplevel tkInit}
T={New Tk.text tkInit(parent:W width:28 height:5 bg:white)}
{T tk(insert 'end' "The quick brown fox jumps over the lazy dog.")}
{Tk.send pack(T)}

{T tk(configure wrap:word)}

{Browse {T tkReturnAtom(get p(1 4) p(1 9) $)}}

{T tk(insert p(1 4) "very very ")}

{T tk(delete p(1 4) p(1 14))}

{T tk(configure state:disabled)}


{W tkClose}



%%
%% Text Tags
%%

declare
W={New Tk.toplevel tkInit}
T={New Tk.text tkInit(parent:W width:28 height:5 bg:white)}
{T tk(insert 'end' "The quick brown fox jumps over the lazy dog.")}
{Tk.send pack(T)}

declare
B={New Tk.textTag tkInit(parent:T foreground:brown)}

{B tk(add p(1 10) p(1 15))}

{B tk(configure font:{New Tk.font tkInit(size:18)})}

{T tk(insert 'end' "\nDogs are ")}
{T tk(insert 'end' "brown" B)}
{T tk(insert 'end' " as well.")}


{W tkClose}



%%
%% Example: A ToyText Browser
%%

declare
proc {ToyBrowse ToyText Root}
   W={New Tk.toplevel tkInit}
   T={New Tk.text tkInit(parent:W width:40 height:8 bg:white wrap:word)}
   local
      HF={New Tk.font    tkInit(family:helvetica size:18 weight:bold)}
      HT={New Tk.textTag tkInit(parent:T font:HF foreground:orange)}
   in
      proc {Head E Rs}
         {T tk(insert p(0 0) E#'\n' HT)}
         {HT tkBind(event:  '<1>'
                    action: proc {$} {Display Rs} end)}
      end
   end
   local
      BF={New Tk.font    tkInit(family:helvetica size:12 weight:normal)}
      BT={New Tk.textTag tkInit(parent:T font:BF)}
      proc {Do Es CT Rs}
         case Es of nil then skip
         [] E|Er then
            case E
            of a(ref:R Es) then
               RT={New Tk.textTag tkInit(parent:T font:BF
                                         foreground:blue underline:true)}
            in
               {RT tkBind(event: '<1>'
                          action: proc {$} {Display R|Rs} end)}
               {Do Es RT Rs}
            else
               {T tk(insert 'end' E CT)}
            end
            {Do Er CT Rs}
         end
      end
   in
      proc {Body Es Rs}
         {Do Es BT Rs}
      end
   end
   proc {Display Rs}
      case Rs of nil then skip
      [] R|Rr then
        {T tk(delete p(0 0) 'end')}
        {Head ToyText.R.head Rr} {Body ToyText.R.body Rs}
      end      
   end
in
   {Tk.send pack(T)}
   {Display [Root]}
end
{ToyBrowse hyper(canvas:        
                    e(head:'Canvas'
                      body:['A canvas widget displays items. '
                            'An item is of one the following types: '
                            a(ref:arc       ['arc']) ', '
                            a(ref:bitmap    ['bitmap']) ', '
                            a(ref:image     ['image']) ', '
                            a(ref:line      ['line']) ', '
                            a(ref:oval      ['oval']) ', '
                            a(ref:polygon   ['polygon']) ', '
                            a(ref:rectangle ['rectangle']) ', '
                            a(ref:text      ['text']) ', and '
                            a(ref:window    ['window']) '.'])
                 arc:
                    e(head:'Arc'
                      body:['An arc item displays a piece of a ' 
                            'circle.'])
                 bitmap:
                    e(head:'Bitmap'
                      body:['A bitmap item displays a bitmap '
                            'with a given name.'])
                 image:
                    e(head:'Image'
                      body:['Displays an image.'])
                 line:
                    e(head:'Line'
                      body:['A line item consists of several '
                            'connected segments.'])
                 oval:
                    e(head:'Oval'
                      body:['An oval can either be a circle or '
                            'an ellipsis.'])
                 polygon:
                    e(head:'Polygon'
                      body:['A polygon is described by three or '
                            'more ' a(ref:line ['line']) 
                            ' segments.'])
                 rectangle:
                    e(head:'Rectangle'
                      body:['Displays a rectangle.'])
                 text:
                    e(head:'Text'
                      body:['Displays text consisting of a single '
                            'or several lines.'])
                 window:
                    e(head:'Window'
                      body:['Displays a widget in the canvas where '
                            'the canvas widget serves as geometry '
                            'manager for the widget. '
                            'See also ' 
                            a(ref:canvas ['the canvas widget']) '.'])) canvas}





%%%
%%% Chapter: Tools for Tk
%%%

%%
%% Dialogs
%%

declare
D={New TkTools.dialog
   tkInit(title:   'Remove File'
          buttons: ['Okay' #
                    proc {$}
                       try
                          {OS.unlink {E tkReturn(get $)}}
                          {D tkClose}
                       catch _ then skip
                       end
                    end
                    'Cancel' # tkClose]
          default: 1)}
L={New Tk.label tkInit(parent:D text:'File name:')}
E={New Tk.entry tkInit(parent:D bg:wheat width:20)}
{Tk.batch [pack(L E side:left pady:2#m) focus(E)]}



%%
%% Error Dialogs
%%

declare
W={New Tk.toplevel tkInit}
E={New TkTools.error
   tkInit(master:W
          text: 'Error in system configuration: '#
                'too much memory.')}



%%
%% Menubars
%%

declare
W={New Tk.toplevel tkInit}
V={New Tk.variable tkInit(0)}
B={TkTools.menubar W W
   [menubutton(text:'Test' underline:0
               menu: [command(label:   'About test'
                              action:  Browse#about
                              key:     alt(a)
                              feature: about)
                      separator
                      command(label:   'Quit'
                              action:  W#tkClose
                              key:     ctrl(c)
                              feature: quit)]
                      feature: test)
    menubutton(text:'Options' underline:0
               menu: [checkbutton(label: 'Incremental'
                                  var: {New Tk.variable tkInit(false)})
                      separator
                      cascade(label: 'Size'
                              menu: [radiobutton(label:'Small'
                                                 var:V value:0)
                                     radiobutton(label:'Middle'
                                                 var:V value:1)
                                     radiobutton(label:'Large'
                                                 var:V value: 2)])])]
   nil}
F={New Tk.frame tkInit(parent:W width:10#c height:5#c bg:ivory)}
{Tk.send pack(B F fill:x)}

{B.test.about tk(entryconfigure state:disabled)}

{B.test.menu tk(configure tearoff:false)}


declare
A={New Tk.menuentry.command tkInit(parent:B.test.menu
                                   before:B.test.quit
                                   label: 'Exit')}

{A tkClose}



%%
%% Images
%%

declare
U='http://www.mozart-oz.org/home-1.1.0/doc/wp/'
I={TkTools.images [U#'wp.gif' 
                   U#'queen.xbm' 
                   U#'truck-left.ppm']}