## canvas_ex.pkg
## Author: cxl
## (C) 1996, Bremen Institute for Safe Systems, Universitaet Bremen
# Compiled by:
# src/lib/tk/src/tests+examples/sources.sublib# **************************************************************************
# An Example for Canvasses.
#
# This example displays a Canvas with three boxes (Box Canvas items)
# on it. With mouse Button 1, one can ``grab'' a box and move it about
# whilst holding the mouse Button pressed.
# **************************************************************************
package canvas_ex
: api { go: Void -> String; }
{
include package tk; # tk_21
# Some parameters
my
box_size = coordinate (50, 55);
my
first_box_pos = coordinate (20, 20); my
second_box_pos = coordinate (80, 20); my
third_box_pos = coordinate (140, 20);
my
offset = REF (coordinate (0, 0));
# getBoxPos and moveBoxPos are the functions being bound to
# pressing mouseButton1, and moving the mouse with the Button pressed,
# respectively. Note that they are bound directly to the Canvas items,
# so we do not need to check which item the mouse is over, but rather
# bind a closure with the item's id to the corresponding item.
fun get_box_pos wid cid (TK_EVENT(_, _, x, y, _, _))
=
{ my
wpos = get_tcl_canvas_item_coordinates wid cid;
{ file::write (file::stdout, "Grabbed box " + make_canvas_item_string (cid) + "\n");
offset := subtract_coordinates (coordinate (x, y)) (hd wpos);};
}
also
fun move_box_pos wid cid (TK_EVENT(_, _, x, y, _, _))
=
{ wpos = get_tcl_canvas_item_coordinates wid cid;
nu_pos = subtract_coordinates (coordinate (x, y)) *offset;
wsize = subtract_coordinates (hd (tl wpos)) (hd wpos);
nu_coords = nu_pos . (add_coordinates nu_pos wsize) . [];
{ file::write (file::stdout, "Moved box " + make_canvas_item_string cid + "\n");
set_canvas_item_coordinates wid cid nu_coords;
};
}
also
fun box_namings wid box_id
=
[ EVENT_CALLBACK (BUTTON_PRESS (THE 1), make_callback (get_box_pos wid box_id)),
EVENT_CALLBACK (MODIFIER_BUTTON (1, MOTION), make_callback (move_box_pos wid box_id))
]
also
fun little_boxes wid
=
{ fun one_box (cid, pos, colour)
=
CANVAS_BOX {
citem_id => cid,
coord1 => pos,
coord2 => add_coordinates pos box_size,
event_callbacks => box_namings wid cid,
traits => [ FILL_COLOR colour,
OUTLINE BLACK]
};
[ one_box (make_canvas_item_id(), first_box_pos, RED ),
one_box (make_canvas_item_id(), second_box_pos, BLUE ),
one_box (make_canvas_item_id(), third_box_pos, GREEN)
];
};
# This defines the Canvas with the three boxes on it
ye_auld_canvasse
=
{ canvas_id = make_widget_id();
CANVAS {
widget_id => canvas_id,
scrollbars => NOWHERE,
citems => little_boxes canvas_id,
packing_hints => [PACK_AT TOP, FILL ONLY_X, EXPAND TRUE],
traits => [ HEIGHT 300,
WIDTH 400,
RELIEF GROOVE,
BACKGROUND (MIX { red=>200, blue=>240, green=>240 } )],
event_callbacks => [] };
};
fun quit_button window
=
BUTTON {
widget_id => make_widget_id(),
packing_hints => [PACK_AT TOP, FILL ONLY_X, EXPAND TRUE],
event_callbacks => [],
traits => [ TEXT "Quit",
CALLBACK (make_simple_callback (\\ ()= close_window window))
]
};
my
testwin
=
{ my
window_id = make_window_id ();
make_window {
window_id,
subwidgets => PACKED [ye_auld_canvasse, quit_button window_id],
event_callbacks => [],
init => null_callback,
traits => [ WINDOW_TITLE "Little Boxes",
WINDOW_ASPECT_RATIO_LIMITS (4, 3, 4, 3),
WIDE_HIGH_MIN (400, 300),
WIDE_HIGH_MAX (500, 400)]
};
};
fun go ()
=
start_tcl_and_trap_tcl_exceptions [ testwin ];
};