## 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 package 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
(\\ 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_byte_as_char (p1.title, the p1.shortcut))
==
char::to_upper (string::get_byte_as_char (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
};
};