/* ***************************************************************************
SCALE_WIDGET example
Author: ludi
(C) 1999, Bremen Institute for Safe Systems, Universitaet Bremen
************************************************************************** */
# Compiled by:
# src/lib/tk/src/tests+examples/sources.sublibpackage scale_ex
: (weak)
api {
go: Void -> Void;
}
{
include package tk;
main_id = make_window_id ();
id1 = make_widget_id();
id2 = make_widget_id();
sc1id = make_widget_id();
sc2id = make_widget_id();
act_id = make_widget_id();
canvas_id = make_widget_id();
im_id = make_canvas_item_id();
my_icon = REF (CANVAS_TAG { citem_id => make_canvas_item_id(),
citem_ids => [] } );
am_active = REF TRUE;
fun cvalue b r
=
{
fun show_real r
=
if (r < 0.0 )
"-" + float::to_string (float::abs r);
else
float::to_string r;
fi;
if b add_trait id1 [TEXT (show_real r)];
else add_trait id2 [TEXT (show_real r)];
fi;
};
fun value b _
=
if b add_trait id1 [TEXT (get_tcl_var_value "hscale" )];
else add_trait id2 [TEXT (get_tcl_var_value "vscale" )];
fi;
fun act _
=
{ if *am_active
add_trait act_id [TEXT "Activate"];
add_trait sc1id [ACTIVE FALSE];
add_trait sc2id [ACTIVE FALSE];
else
add_trait act_id [TEXT "Deactivate"];
add_trait sc1id [ACTIVE TRUE];
add_trait sc2id [ACTIVE TRUE];
fi;
am_active := not *am_active;
};
scales
=
FRAME { widget_id => make_widget_id(),
subwidgets => GRIDDED [SCALE_WIDGET { widget_id => sc1id,
packing_hints => [COLUMN 1, ROW 1],
traits => [REAL_CALLBACK (cvalue FALSE),
VARIABLE "vscale",
SLIDER_LENGTH 15,
LENGTH 180,
SLIDER_LABEL "VScale",
FROM (-1.0),
TO 1.0,
DIGITS 3,
RESOLUTION 0.2,
BIG_INCREMENT 0.5],
event_callbacks => [] },
SCALE_WIDGET { widget_id => sc2id,
packing_hints => [COLUMN 2, ROW 2],
traits => [REAL_CALLBACK (cvalue TRUE),
ORIENT HORIZONTAL,
VARIABLE "hscale",
SLIDER_LENGTH 30,
LENGTH 180,
SLIDER_LABEL "HScale"],
event_callbacks => [] },
CANVAS { widget_id => canvas_id,
scrollbars => NOWHERE,
citems => [],
packing_hints => [COLUMN 2, ROW 1],
traits => [RELIEF RAISED, WIDTH 275,
HEIGHT 235,
BACKGROUND WHITE],
event_callbacks => [] } ],
packing_hints => [PAD_X 10, PAD_Y 10],
traits => [],
event_callbacks => [] };
fun move _
=
{ value TRUE ();
value FALSE ();
delete_canvas_item canvas_id im_id;
{
x = 2 * the (int::from_string (get_tcl_var_value "hscale")) + 5;
y =
float::round (the (float::from_string (get_tcl_var_value "vscale"))
* 100.0 + 105.0);
my_icon := update_canvas_item_coordinates *my_icon [(x, y)];
};
add_canvas_item canvas_id *my_icon;
};
displ
=
FRAME { widget_id => make_widget_id(),
subwidgets => GRIDDED [LABEL { widget_id => make_widget_id(),
packing_hints => [COLUMN 1, ROW 1, PAD_Y 10],
traits => [TEXT "HScale:",
BACKGROUND BLUE,
FOREGROUND WHITE],
event_callbacks => [] },
LABEL { widget_id => id1,
packing_hints => [COLUMN 2, ROW 1, PAD_X 10],
traits => [BACKGROUND WHITE, WIDTH 10],
event_callbacks => [] },
LABEL { widget_id => make_widget_id(),
packing_hints => [COLUMN 1, ROW 2],
traits => [TEXT "VScale:",
BACKGROUND BLUE,
FOREGROUND WHITE],
event_callbacks => [] },
LABEL { widget_id => id2,
packing_hints => [COLUMN 2, ROW 2],
traits => [BACKGROUND WHITE, WIDTH 10],
event_callbacks => [] },
BUTTON { widget_id => make_widget_id(),
packing_hints => [COLUMN 3, ROW 1],
traits => [TEXT "Move", WIDTH 15,
CALLBACK move],
event_callbacks => [] },
BUTTON { widget_id => act_id,
packing_hints => [COLUMN 3, ROW 2],
traits => [TEXT "Deactivate",
WIDTH 15,
CALLBACK act],
event_callbacks => [] },
BUTTON { widget_id => make_widget_id(),
packing_hints => [COLUMN 3, ROW 3, PAD_Y 10],
traits => [ TEXT "Quit", WIDTH 15,
CALLBACK (\\ _ => exit_tcl (); end ) ],
event_callbacks => [] } ],
packing_hints => [PAD_X 10, PAD_Y 10],
traits => [],
event_callbacks => [] };
fun init _ =
{ my_icon := CANVAS_ICON { citem_id => im_id,
coord => (170, 110),
icon_variety =>
FILE_IMAGE (winix__premicrothread::path::cat (get_lib_path(),
"images/smltk.gif"),
make_image_id()),
traits => [ANCHOR NORTHWEST],
event_callbacks => [] };
set_tcl_scale sc2id 80.0;
add_canvas_item canvas_id *my_icon;
value TRUE ();
value FALSE ();};
main = make_window {
window_id => main_id,
subwidgets => PACKED [scales, displ],
traits => [WINDOW_TITLE "SCALE_WIDGET example"],
event_callbacks => [],
init
};
fun go ()
=
start_tcl [main];
};