PreviousUpNext

15.4.1292  src/lib/tk/src/toolkit/tabs.pkg

## tabs.pkg
## (C) 2000, Bremen Institute for Safe Systems, Universitaet Bremen
## Author: ludi

# Compiled by:
#     src/lib/tk/src/toolkit/sources.sublib



# ***************************************************************************
# tk-Tabs
# **************************************************************************



###         "You know my method. It is founded
###             upon the observance of trifles."
###
###                       -- Sherlock Holmes



package tabs: (weak)  Tabs              # Tabs  is from   src/lib/tk/src/toolkit/tabs.api

{
    exception ERROR  String;

    include tk;

    fun tabs { pages:  List { title:     String,
                       subwidgets:   tk::Widgets,
                       show:      tk::Void_Callback,
                       hide:      tk::Void_Callback,
                       shortcut:  Null_Or( Int ) },
              configure as { width, spare, height, font,
                            labelheight } }
        =
        {
            canvas_id = make_widget_id();
            cw_id = make_canvas_item_id();

            selected_card = REF 0;

            lwidth = (width - spare) div (length pages);

            fun init_citem_ids n =
                if (n == 0 ) [];
                else [make_canvas_item_id(), make_canvas_item_id(), make_canvas_item_id(),
                      make_canvas_item_id(), make_canvas_item_id(),
                      make_canvas_item_id()] . init_citem_ids (n - 1);fi;

            citem_ids = init_citem_ids (length pages);

            fun init_frames n
                =
                if  (n == 0 )

                     [];
                else
                     init_frames (n - 1)
                     @
                     [ FRAME
                           { widget_id    => make_widget_id(),
                             subwidgets  => .subwidgets (list::nth (pages, n - 1)),
                             packing_hints => [],
                             traits  => [],
                             event_callbacks => []
                           }
                     ];
                fi;

            frames = init_frames (length pages);

            fun page n
                =
                CANVAS_WIDGET
                    {
                      citem_id    => cw_id,
                      coord       => (3, labelheight + 1),
                      subwidgets  => PACKED [list::nth (frames, n)],
                      traits      => [ANCHOR NORTHWEST,
                                              WIDTH width, HEIGHT height],
                      event_callbacks => []
                    };

            fun id lab idn
                =
                list::nth (list::nth (citem_ids, lab), idn);

            fun field_name n
                =
                [    TEXT(.title (list::nth (pages, n)))]
                @
                (   if (not_null(.shortcut (list::nth (pages, n))))
                        
                         [MENU_UNDERLINE (the(.shortcut (list::nth (pages, n))))];
                    else
                         [];
                    fi
                );

            fun selected_page n _
                =
                {   delete_label *selected_card;
                    add_inactive_label *selected_card;
                    delete_label n;
                    add_active_label n;
                    .hide (list::nth (pages, *selected_card))();
                    delete_canvas_item canvas_id cw_id;
                    add_canvas_item canvas_id (page n);
                    .show (list::nth (pages, n))();
                    selected_card := n;
                }

            also
            fun button_pressed ev
                =
                {
                    my (x, y) = (get_x_coordinate ev, get_y_coordinate ev);
                    n = x div lwidth;

                    if (    y <  labelheight
                       and  n <  length pages
                       and  n != *selected_card
                       )

                        selected_page n (TK_EVENT (0, "", 0, 0, 0, 0));
                    fi;
                }

            also
            fun delete_label n
                =
                apply
                    (fn id =  delete_canvas_item canvas_id id except _ = ())
                    (list::nth (citem_ids, n))

            also
            fun active_label n
                =
                [   CANVAS_WIDGET {
                        citem_id  => id n 0,
                        coord    => (n * lwidth + 10, labelheight div 2),
                        subwidgets  => PACKED [LABEL { widget_id    => make_widget_id(),
                                         packing_hints => [],
                                         traits  => field_name n @
                                                    [FONT font],
                                         event_callbacks => [] } ],
                        traits  => [ANCHOR WEST],
                        event_callbacks => [] },

                 CANVAS_LINE { citem_id  => id n 1,
                        coords   => [(n * lwidth + 1, labelheight),
                                    (n * lwidth + 1, 1),
                                    ((n + 1) * lwidth, 1)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 2,
                        coords   => [(n * lwidth + 2, labelheight),
                                    (n * lwidth + 2, 2),
                                    ((n + 1) * lwidth - 1, 2)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 3,
                        coords   => [((n + 1) * lwidth, 1),
                                    ((n + 1) * lwidth, labelheight)],
                        traits  => [],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 4,
                        coords   => [((n + 1) * lwidth - 1, 2),
                                    ((n + 1) * lwidth - 1,
                                     labelheight)],
                        traits  => [],
                        event_callbacks => [] },

                 CANVAS_LINE { citem_id  => id n 5,
                        event_callbacks => [],
                        traits  => [FILL_COLOR GREY],
                        coords   => [(n * lwidth + 6, labelheight - 5),
                                    ((n + 1) * lwidth - 5,
                                     labelheight - 5),
                                    ((n + 1) * lwidth - 5, 6),
                                    (n * lwidth + 6, 6),
                                    (n * lwidth + 6, labelheight - 5)]
                       }
                ]

            also
            fun add_active_label n
                =
                apply (add_canvas_item canvas_id) (active_label n)

            also
            fun inactive_label n
                =
                [CANVAS_WIDGET { citem_id  => id n 0,
                          coord    => (n * lwidth + 10,
                                      labelheight div 2 + 2),
                          subwidgets  => PACKED [
                                            LABEL {
                                                widget_id    => make_widget_id(),
                                                packing_hints => [],
                                                traits  => field_name n @ [FONT font],
                                                event_callbacks => [EVENT_CALLBACK (BUTTON_PRESS (THE 1),
                                                   selected_page n)]
                                            }
                                        ],
                          traits  => [ANCHOR WEST],
                          event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 1,
                        coords   => [(n * lwidth + 1, labelheight),
                                    (n * lwidth + 1, 3),
                                    ((n + 1) * lwidth - 2, 3)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 2,
                        coords   => [(n * lwidth + 2, labelheight - 1),
                                    (n * lwidth + 2, 4),
                                    ((n + 1) * lwidth - 3, 4)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 3,
                        coords   => [((n + 1) * lwidth - 2, 3),
                                    ((n + 1) * lwidth - 2,
                                     labelheight)],
                        traits  => [],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 4,
                        coords   => [((n + 1) * lwidth - 3, 4),
                                    ((n + 1) * lwidth - 3,
                                     labelheight)],
                        traits  => [],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => id n 5,
                        coords   => [((n + 1) * lwidth + 1,
                                     labelheight - 1),
                                    (n * lwidth + 1, labelheight - 1),
                                    (n * lwidth + 1, labelheight),
                                    ((n + 1) * lwidth + 1, labelheight)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] } ]

            also
            fun add_inactive_label n
                =
                apply (add_canvas_item canvas_id) (inactive_label n);

            fun init_labels 0 => active_label 0;
               init_labels n =>
                inactive_label n @ init_labels (n - 1); end;

            init =
                [CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(2, labelheight),
                                    (2, height + labelheight + 2)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(1, labelheight),
                                    (1, height + labelheight + 3)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(2, height + labelheight + 2),
                                    (width + 3, height + labelheight + 2),
                                    (width + 3, labelheight + 1)],
                        traits  => [],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(1, height + labelheight + 3),
                                    (width + 4, height + labelheight + 3),
                                    (width + 4, labelheight)],
                        traits  => [],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(width + 4, labelheight - 1),
                                    (lwidth * length pages,
                                     labelheight - 1)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] },
                 CANVAS_LINE { citem_id  => make_canvas_item_id(),
                        coords   => [(width + 3, labelheight),
                                    (lwidth * length pages, labelheight)],
                        traits  => [FILL_COLOR WHITE],
                        event_callbacks => [] } ] @ init_labels (length pages - 1) @
                [page 0];

            fun check_shortcuts () =
                {
                    fun sc_equal (p1:   { title:     String,
                                         subwidgets:   tk::Widgets,
                                         show:      tk::Void_Callback,
                                         hide:      tk::Void_Callback,
                                         shortcut:  Null_Or( Int ) } )
                                 (p2:   { title:     String,
                                         subwidgets:   tk::Widgets,
                                         show:      tk::Void_Callback,
                                         hide:      tk::Void_Callback,
                                         shortcut:  Null_Or( Int ) } ) =

                        if (not_null p1.shortcut and
                            not_null p2.shortcut
                        )
                             char::to_upper
                                  (string::get (p1.title,
                                              the p1.shortcut))
                                ==
                                char::to_upper
                                  (string::get (p2.title,
                                              the p2.shortcut));

                        else FALSE;fi;

                    fun no_doubles ((p:   { title:     String,
                                           subwidgets:   tk::Widgets,
                                           show:      tk::Void_Callback,
                                           hide:      tk::Void_Callback,
                                           shortcut:  Null_Or( Int ) } ) . ps) =>
                        not (list::exists (sc_equal p) ps) and
                        no_doubles ps;
                       no_doubles _         => TRUE; end;

                    if (no_doubles pages ) ();
                    else
                        { print
               "Error: Two shortcuts with the same character, aborting...";
                          raise exception
                              ERROR
                                "Two shortcuts with the same character";};fi;
                };

            fun shortcuts ((p:  { title:       String,
                                 subwidgets:  tk::Widgets,
                                 show:        tk::Void_Callback,
                                 hide:        tk::Void_Callback,
                                 shortcut:    Null_Or( Int )
                                }
                           ) . ps
                          )
                          n
                =>
                (if (not_null p.shortcut )
                     [EVENT_CALLBACK
                        (META (KEY_PRESS (char::to_string
                                         (char::to_upper
                                            (string::get
                                               (p.title,
                                                  the p.shortcut))))),
                         selected_page n),
                      EVENT_CALLBACK
                        (META (KEY_PRESS (char::to_string
                                         (char::to_lower
                                            (string::get
                                               (p.title,
                                                the p.shortcut))))),
                         selected_page n)];
                 else [];fi) @ shortcuts ps (n + 1);
               shortcuts _ _         => []; end;

            check_shortcuts ();
            selected_card := 0;

            (   CANVAS {
                    widget_id      => canvas_id,
                    scrollbars => NOWHERE,
                    citems     => init,
                    packing_hints   => [],
                    traits    => [BORDER_THICKNESS 0,
                                  WIDTH (width + 6),
                                  HEIGHT (height + labelheight + 4)],
                    event_callbacks   => [EVENT_CALLBACK (BUTTON_PRESS (THE 1),
                                         button_pressed)]
                },
                shortcuts pages 0
            );
        };
                                                                            my
    std_conf
        =
        {   width       => 450,
            spare       => 50,
            height      => 500,
            font        => SANS_SERIF [BOLD],
            labelheight => 34
        };
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext