## tabs_ex.pkg
## (C) 2000, Bremen Institute for Safe Systems, Universitaet Bremen
## Author: ludi (Last modification by $Author: 2cxl $)
# Compiled by:
# src/lib/tk/src/toolkit/tests+examples/sources.sublib# **************************************************************************
# tk-Tabs example
# **************************************************************************
package tabs_ex : (weak)
api {
go: Void -> tk::Widget;
}
{
include package tk;
lab_id = make_widget_id();
show_id = make_widget_id();
fun drop_newlines s =
string::implode (list::take_n (string::explode s, size s - 2));
my_txt = REF "Welcome";
my_font = REF SANS_SERIF;
my_fontsize = REF NORMAL_SIZE;
my_bold = REF FALSE;
my_italic = REF FALSE;
my_txtcol = REF BLUE;
my_bgcol = REF GREEN;
my_width = REF 15;
my_height = REF 2;
my_relief = REF RAISED;
my_borderwidth = REF 2;
fun font_name f
=
case f
SANS_SERIF _ => "SansSerif";
TYPEWRITER _ => "Typewriter";
NORMAL_FONT _ => "Normalfont"; esac;
fun fontsize_name s
=
case s
TINY => "Tiny";
SMALL => "Small";
NORMAL_SIZE => "NormalSize";
LARGE => "Large";
HUGE => "Huge"; esac;
fun rel_name r
=
case r
FLAT => "Flat";
GROOVE => "Groove";
RIDGE => "Ridge";
RAISED => "Raised";
SUNKEN => "Sunken"; esac;
fun col_name c
=
case c
BLACK => "Black";
WHITE => "White";
GREY => "Grey";
BLUE => "Blue";
GREEN => "Green";
RED => "Red";
BROWN => "Brown";
YELLOW => "Yellow"; esac;
fun show_code ()
=
{
txtconf =
"FONT(" + font_name( *my_font []) + " [" +
fontsize_name *my_fontsize +
(if *my_bold ", BOLD"; else "";fi) +
(if *my_italic ", ITALIC"; else "";fi) + "]),\n";
txt = "LABEL { widget_id = make_widget_id(),\n" +
" packing_hints = [],\n" +
" traits = [TEXT \"" + *my_txt + "\",\n" +
" " + txtconf +
" FOREGROUND " +
col_name *my_txtcol + ",\n" +
" BACKGROUND " +
col_name *my_bgcol + ",\n" +
" WIDTH " +
int::to_string *my_width + ",\n" +
" HEIGHT " +
int::to_string *my_height + ",\n" +
" RELIEF " +
rel_name *my_relief + ",\n" +
" BORDER_THICKNESS " +
int::to_string *my_borderwidth + "],\n" +
" event_callbacks = [] }";
{ add_trait show_id [ACTIVE TRUE];
clear_text show_id;
insert_text_end show_id txt;
add_trait show_id [ACTIVE FALSE];};
};
fun color_chooser id act pack cols col
=
MENU_BUTTON {
widget_id => id,
packing_hints => pack,
event_callbacks => [],
traits => [ WIDTH 20,
RELIEF RAISED,
TEAR_OFF FALSE,
TEXT cols,
FOREGROUND col
],
mitems => [ MENU_COMMAND [TEXT "Black", CALLBACK (act BLACK )],
MENU_COMMAND [TEXT "White", FOREGROUND WHITE, CALLBACK (act WHITE )],
MENU_COMMAND [TEXT "Grey", FOREGROUND GREY, CALLBACK (act GREY )],
MENU_COMMAND [TEXT "Blue", FOREGROUND BLUE, CALLBACK (act BLUE )],
MENU_COMMAND [TEXT "Green", FOREGROUND GREEN, CALLBACK (act GREEN )],
MENU_COMMAND [TEXT "Red", FOREGROUND RED, CALLBACK (act RED )],
MENU_COMMAND [TEXT "Brown", FOREGROUND BROWN, CALLBACK (act BROWN )],
MENU_COMMAND [TEXT "Yellow", FOREGROUND YELLOW, CALLBACK (act YELLOW)]
]
};
fun fconf ()
=
[!my_fontsize]
@
(if *my_bold [BOLD]; else [];fi)
@
(if *my_italic [ITALIC]; else [];fi);
fun font ()
=
*my_font (fconf());
page1
=
{ id = make_widget_id();
font_id = make_widget_id();
fsize_id = make_widget_id();
fun ch_font f _ = { my_font := f;
add_trait font_id [TEXT (font_name (f []))];
add_trait lab_id [FONT (font())];
show_code();};
fun ch_bold _ = { my_bold := not *my_bold;
add_trait lab_id [FONT (font())];
show_code();};
fun ch_ital _ = { my_italic := not *my_italic;
add_trait lab_id [FONT (font())];
show_code();};
fun ch_fsize s _ = { my_fontsize := s;
add_trait fsize_id [TEXT (fontsize_name s)];
add_trait lab_id [FONT (font())];
show_code();};
{ title => "Text Settings",
subwidgets =>
PACKED
[ LABEL { widget_id => make_widget_id(),
packing_hints => [PAD_Y 8],
traits => [TEXT "Enter text:"],
event_callbacks => [] },
TEXT_WIDGET { widget_id => id,
live_text => string_to_livetext "Welcome",
scrollbars => AT_RIGHT,
packing_hints => [PAD_X 10],
traits => [WIDTH 60, HEIGHT 10,
BACKGROUND WHITE],
event_callbacks => [ EVENT_CALLBACK (KEY_PRESS "",
\\ _ =>
{ add_trait lab_id
[TEXT
(drop_newlines
(get_tcl_text id))];
my_txt :=
(drop_newlines
(get_tcl_text id));
show_code();}; end )] },
FRAME { widget_id => make_widget_id(),
subwidgets =>
GRIDDED
[ LABEL { widget_id => make_widget_id(),
packing_hints => [ROW 1, COLUMN 1],
traits => [TEXT "Font:"],
event_callbacks => [] },
MENU_BUTTON
{ widget_id => font_id,
mitems =>
[MENU_COMMAND [TEXT "Normalfont",
FONT (NORMAL_FONT []),
CALLBACK (ch_font NORMAL_FONT)],
MENU_COMMAND [TEXT "Typewriter",
FONT (TYPEWRITER []),
CALLBACK (ch_font TYPEWRITER)],
MENU_COMMAND [TEXT "Sans Serif",
FONT (SANS_SERIF []),
CALLBACK (ch_font SANS_SERIF)]],
packing_hints => [ROW 1, COLUMN 2, PAD_Y 5,
STICK TO_NSEW],
traits => [WIDTH 20, RELIEF RAISED,
TEXT "SansSerif",
FONT (SANS_SERIF []),
TEAR_OFF FALSE],
event_callbacks => [] },
LABEL { widget_id => make_widget_id(),
packing_hints => [ROW 2, COLUMN 1],
traits => [TEXT "Font size:"],
event_callbacks => [] },
MENU_BUTTON
{ widget_id => fsize_id,
mitems =>
[MENU_COMMAND [TEXT "Tiny",
FONT (SANS_SERIF [TINY]),
CALLBACK (ch_fsize TINY)],
MENU_COMMAND [TEXT "Small",
FONT (SANS_SERIF [SMALL]),
CALLBACK (ch_fsize SMALL)],
MENU_COMMAND [TEXT "Normal",
FONT (SANS_SERIF
[NORMAL_SIZE]),
CALLBACK (ch_fsize
NORMAL_SIZE)],
MENU_COMMAND [TEXT "Large",
FONT (SANS_SERIF [LARGE]),
CALLBACK (ch_fsize LARGE)],
MENU_COMMAND [TEXT "Huge",
FONT (SANS_SERIF [HUGE]),
CALLBACK (ch_fsize HUGE)]],
packing_hints => [ROW 2, COLUMN 2, PAD_Y 5,
STICK TO_NSEW],
traits => [WIDTH 20, RELIEF RAISED,
TEXT "Normal", TEAR_OFF FALSE,
FONT (SANS_SERIF [NORMAL_SIZE])],
event_callbacks => [] },
CHECK_BUTTON {
widget_id => make_widget_id(),
packing_hints => [ROW 3, COLUMN 1],
traits =>
[WIDTH 20, TEXT "Italic",
FONT (SANS_SERIF [ITALIC]),
CALLBACK ch_ital],
event_callbacks => []
},
CHECK_BUTTON {
widget_id => make_widget_id(),
packing_hints => [ROW 3, COLUMN 2],
traits => [ WIDTH 20, TEXT "Bold",
FONT (SANS_SERIF [BOLD]),
CALLBACK ch_bold],
event_callbacks => []
}
],
packing_hints => [],
traits => [],
event_callbacks => []
}
],
show => \\() => { clear_text id;
insert_text_end id *my_txt;
add_trait fsize_id
[TEXT (fontsize_name *my_fontsize)];
add_trait font_id
[TEXT (font_name( *my_font []))];}; end ,
hide => null_callback,
shortcut => THE 0 };
};
page2 =
{
id = make_widget_id();
c1id = make_widget_id();
c2id = make_widget_id();
fun foreground c _ = { my_txtcol := c;
add_trait c1id [TEXT (col_name c),
FOREGROUND c];
add_trait lab_id [FOREGROUND c];
show_code();};
fun background c _ = { my_bgcol := c;
add_trait c2id [TEXT (col_name c),
FOREGROUND c];
add_trait lab_id [BACKGROUND c];
show_code();};
{ title => "Color Settings",
subwidgets =>
PACKED
[FRAME { widget_id => make_widget_id(),
subwidgets =>
GRIDDED
[ LABEL { widget_id => make_widget_id(),
packing_hints => [ROW 2, COLUMN 1],
traits =>
[TEXT "Text color:"],
event_callbacks => [] },
color_chooser c1id foreground
[ROW 2, COLUMN 2, PAD_Y 5]
"Blue" BLUE,
LABEL { widget_id => make_widget_id(),
packing_hints => [ROW 3, COLUMN 1,
PAD_X 15],
traits =>
[TEXT "BACKGROUND color:"],
event_callbacks => [] },
color_chooser c2id background
[ROW 3, COLUMN 2, PAD_Y 5]
"Green" GREEN],
packing_hints => [PAD_Y 50],
traits => [],
event_callbacks => [] } ],
show => \\() => { add_trait c1id [TEXT (col_name *my_txtcol),
FOREGROUND *my_txtcol];
add_trait c2id [TEXT (col_name *my_bgcol),
FOREGROUND *my_bgcol];}; end ,
hide => null_callback,
shortcut => THE 0 };
};
fun page3 () =
{
n_chooser1 =
numeric_chooser::numeric_chooser
{ initial_value => 15,
min => THE 0,
max => NULL,
increment => 1,
width => 3,
orientation => HORIZONTAL,
selection_notifier => \\ i => { add_trait lab_id [WIDTH i];
my_width := i;
show_code();}; end };
n_chooser2 =
numeric_chooser::numeric_chooser
{ initial_value => 2,
min => THE 0,
max => NULL,
increment => 1,
width => 2,
orientation => VERTICAL,
selection_notifier => \\ i => { add_trait lab_id [HEIGHT i];
my_height := i;
show_code();}; end };
{ title => "Dimensions",
subwidgets =>
PACKED [FRAME { widget_id => make_widget_id(),
subwidgets =>
GRIDDED [FRAME
{ widget_id => make_widget_id(),
subwidgets =>
PACKED
[ LABEL
{ widget_id => make_widget_id(),
packing_hints => [PACK_AT LEFT],
traits =>
[TEXT "Width:", WIDTH 10],
event_callbacks => [] },
n_chooser1.chooser],
packing_hints => [ROW 1, COLUMN 2,
PAD_Y 3, PAD_X 30],
traits => [],
event_callbacks => [] },
FRAME
{ widget_id => make_widget_id(),
subwidgets =>
PACKED
[ LABEL
{ widget_id => make_widget_id(),
packing_hints => [PACK_AT LEFT],
traits => [TEXT "Height:",
WIDTH 10],
event_callbacks => [] },
n_chooser2.chooser],
packing_hints => [ROW 1, COLUMN 4,
PAD_Y 3, PAD_X 30],
traits => [],
event_callbacks => [] } ],
packing_hints => [PAD_Y 50],
traits => [],
event_callbacks => [] } ],
show => \\() => { n_chooser1.set_value *my_width;
n_chooser2.set_value *my_height;}; end ,
hide => null_callback,
shortcut => THE 0 };
};
fun page4 () =
{
id1 = make_widget_id();
id2 = make_widget_id();
fun rel relk _ = { add_trait lab_id [RELIEF relk];
my_relief := relk;
show_code();};
n_chooser =
numeric_chooser::numeric_chooser
{ initial_value => 2,
min => THE 0,
max => NULL,
increment => 1,
width => 3,
orientation => HORIZONTAL,
selection_notifier => \\ i => { add_trait lab_id
[BORDER_THICKNESS i];
my_borderwidth := i;
show_code();}; end };
fun rel_val () =
case *my_relief
FLAT => "0";
GROOVE => "1";
RAISED => "2";
RIDGE => "3";
SUNKEN => "4"; esac;
{ title => "Relief",
subwidgets =>
PACKED
[FRAME { widget_id => make_widget_id(),
subwidgets =>
PACKED
[FRAME
{ widget_id => make_widget_id(),
subwidgets =>
GRIDDED
[ LABEL { widget_id => make_widget_id(),
packing_hints => [ROW 1, COLUMN 1,
PAD_X 10, PAD_Y 5],
traits => [TEXT "Relief: ",
WIDTH 15],
event_callbacks => [] },
RADIO_BUTTON
{ widget_id => make_widget_id(),
packing_hints => [ROW 1, COLUMN 2,
STICK TO_W],
traits =>
[TEXT "Flat",
VARIABLE "relief", VALUE "0",
CALLBACK (rel FLAT),
FONT (SANS_SERIF [])],
event_callbacks => [] },
RADIO_BUTTON
{ widget_id => make_widget_id(),
packing_hints => [ROW 1, COLUMN 3,
STICK TO_W],
traits =>
[TEXT "Groove",
VARIABLE "relief", VALUE "1",
CALLBACK (rel GROOVE),
FONT (SANS_SERIF [])],
event_callbacks => [] },
RADIO_BUTTON
{ widget_id => make_widget_id(),
packing_hints => [ROW 2, COLUMN 2,
STICK TO_W],
traits =>
[TEXT "Raised",
VARIABLE "relief", VALUE "2",
CALLBACK (rel RAISED),
FONT (SANS_SERIF [])],
event_callbacks => [] },
RADIO_BUTTON
{ widget_id => make_widget_id(),
packing_hints => [ROW 2, COLUMN 3,
STICK TO_W],
traits =>
[TEXT "Ridge",
VARIABLE "relief", VALUE "3",
CALLBACK (rel RIDGE),
FONT (SANS_SERIF [])],
event_callbacks => [] },
RADIO_BUTTON
{ widget_id => make_widget_id(),
packing_hints => [ROW 3, COLUMN 2,
STICK TO_W],
traits =>
[TEXT "Sunken",
VARIABLE "relief", VALUE "4",
CALLBACK (rel SUNKEN),
FONT (SANS_SERIF [])],
event_callbacks => [] } ],
packing_hints => [PAD_Y 30],
traits => [],
event_callbacks => [] },
FRAME
{ widget_id => make_widget_id(),
subwidgets =>
PACKED
[ LABEL { widget_id => make_widget_id(),
packing_hints => [PAD_X 10, PAD_Y 20,
PACK_AT LEFT],
traits =>
[TEXT "BORDER_THICKNESS:",
WIDTH 15],
event_callbacks => [] },
FRAME
{ widget_id => make_widget_id(),
subwidgets =>
PACKED [n_chooser.chooser],
packing_hints => [PAD_X 20, PACK_AT LEFT],
traits => [],
event_callbacks => [] } ],
packing_hints => [ROW 2, COLUMN 2, PACK_AT LEFT],
traits => [],
event_callbacks => [] } ],
packing_hints => [],
traits => [],
event_callbacks => [] } ],
show => \\() => { set_var_value "relief" (rel_val());
n_chooser.set_value *my_borderwidth;}; end ,
hide => \\() => my_borderwidth := n_chooser.read_value (); end ,
shortcut => THE 0 };
};
page5 =
{ title => "Info",
subwidgets => PACKED [ LABEL { widget_id => make_widget_id(),
packing_hints => [PAD_Y 30],
traits => [TEXT "tk-Tabs example",
FOREGROUND RED,
FONT (SANS_SERIF [HUGE])],
event_callbacks => [] },
LABEL { widget_id => make_widget_id(),
packing_hints => [],
traits => [TEXT "(C) 2000, Bremen Institute for Safe Systems, Universitaet Bremen\nAdded to the tk Toolkit in april 2000",
FONT (SANS_SERIF [LARGE])],
event_callbacks => [] } ],
show => \\() => (); end ,
hide => \\() => (); end ,
shortcut => THE 0 };
fun go ()
=
{
my (tabs, shortcuts) =
tabs::tabs
{ pages => [page1, page2, page3(), page4(), page5],
configure => { width => 700,
spare => 50,
height => 300,
font => SANS_SERIF [BOLD],
labelheight => 34 }};
{ my_txt := "Welcome";
my_font := SANS_SERIF;
my_fontsize := NORMAL_SIZE;
my_bold := FALSE;
my_italic := FALSE;
my_txtcol := BLUE;
my_bgcol := GREEN;
my_width := 15;
my_height := 2;
my_relief := RAISED;
my_borderwidth := 2;
start_tcl [
make_window {
window_id => make_window_id (),
subwidgets => PACKED [ FRAME { widget_id => make_widget_id(),
subwidgets => PACKED [tabs],
packing_hints =>
[PAD_X 10, PAD_Y 10],
traits => [],
event_callbacks => [] },
FRAME
{ widget_id => make_widget_id(),
subwidgets =>
PACKED
[BUTTON
{ widget_id =>
make_widget_id(),
packing_hints =>
[PACK_AT RIGHT],
traits =>
[TEXT "Ok", WIDTH 15,
CALLBACK
(\\ _ =>
exit_tcl(); end )],
event_callbacks => [] } ],
packing_hints => [PAD_Y 5, FILL ONLY_X,
EXPAND TRUE],
traits => [],
event_callbacks => [] } ],
traits => [WINDOW_TITLE "Tabs example"],
event_callbacks => shortcuts,
init => null_callback
},
make_window {
window_id => make_window_id (),
subwidgets => PACKED [
LABEL {
widget_id => lab_id,
packing_hints =>
[PAD_X 10, PAD_Y 10],
traits =>
[TEXT "Welcome",
FONT
(SANS_SERIF
[NORMAL_SIZE]),
FOREGROUND BLUE,
BACKGROUND GREEN,
BORDER_THICKNESS 2,
RELIEF RAISED,
HEIGHT 2,
WIDTH 15],
event_callbacks => []
}
],
traits => [WINDOW_TITLE "Constructed label"],
event_callbacks => [EVENT_CALLBACK (DESTROY, \\ _ => exit_tcl(); end )],
init => null_callback
},
make_window {
window_id => make_window_id (),
subwidgets => PACKED [TEXT_WIDGET
{ widget_id => show_id,
scrollbars => AT_RIGHT,
live_text => empty_livetext,
packing_hints =>
[PAD_X 10, PAD_Y 10],
traits => [WIDTH 80,
HEIGHT 15,
ACTIVE FALSE],
event_callbacks => [] } ],
traits => [WINDOW_TITLE "Label code"],
event_callbacks => [EVENT_CALLBACK (DESTROY, \\ _ => exit_tcl(); end )],
init => show_code
}
];
LABEL {
widget_id => make_widget_id(),
packing_hints => [],
event_callbacks => [],
traits => [ TEXT *my_txt,
FONT (font()),
FOREGROUND *my_txtcol,
BACKGROUND *my_bgcol,
WIDTH *my_width,
HEIGHT *my_height,
RELIEF *my_relief,
BORDER_THICKNESS *my_borderwidth
]
};
};
};
};