15.4.1298  src/lib/tk/src/tests+examples/grid_ex.pkg

/* ***************************************************************************
   Grid geometry example
   Author: ludi
   (C) 1999, Bremen Institute for Safe Systems, Universitaet Bremen
  ************************************************************************** */

# Compiled by:
#     src/lib/tk/src/tests+examples/sources.sublib


package grid_ex: (weak)  api {
                      go:  Void -> Void;
                   }
{
    include package   tk;

    fun label i b
        =
        {                                         my
            words = ["Press", "mouse", "button", "to", "leave"];
        
            LABEL {
                widget_id       => make_widget_id(),
                packing_hints   => [COLUMN (if b  i; else 5-i;fi), ROW i],
                event_callbacks => [],
                traits          => [   TEXT (list::nth (words, i - 1)),
                                      FOREGROUND WHITE,
                                      BACKGROUND BLUE,
                                      WIDTH 8,
                                      HEIGHT 2
                                  ]
            };
        };

                                                my 
    frames
        =
        { fun frame c r b
                =
                FRAME {
                    widget_id    => make_widget_id(),
                    subwidgets  => GRIDDED [label 1 b, label 2 b, label 3 b, label 4 b,
                                        label 5 b],
                    packing_hints => [COLUMN c, ROW r],
                    traits  => [BACKGROUND RED],
                    event_callbacks => []
                };
        
            [frame 1 1 TRUE, frame 2 2 FALSE, frame 3 3 TRUE, frame 1 3 TRUE,
             frame 3 1 TRUE];
        };

                                                my 
    main_window
        =
        make_window {
            window_id   => make_window_id(),
            subwidgets  => GRIDDED frames,
            traits      => [WINDOW_TITLE "grid geometry demonstration"],
            event_callbacks => [EVENT_CALLBACK (BUTTON_PRESS (THE 1), \\ _ => exit_tcl(); end )],
            init     => null_callback
        };

    fun go ()
        =
        start_tcl [ main_window ];
};