/* ***********************************************************************
# Compiled by:
# src/lib/tk/src/tests+examples/sources.sublib Project: sml/Tk: an Tk Toolkit for sml
Author: Stefan Westmeier, University of Bremen
(ported to SmlTk30 by bu)
Date: $Date: 2001/03/30 13:39:30 $
Revision: $Revision: 3.0 $
Purpose of this file: Test for Canvas and other new stuff ...
*********************************************************************** */
package big_ex
: (weak) api { go: Void -> String; }
{
include package tk;
include package tk_21;
/*
package daVinciSMLTK :
api
my startDaVinci: Void -> Void
my stopDaVinci: Void -> Void
end
=
pkg
appId = "DAVINCI"
prog = ("/usr/local/software/daVinci/daVinci",["-pipe"])
prot = "/tmp/g2da.log"
fun callBack s = (insertTextEnd "aText" (s + "\n"))
quitAction = \\ () => com::putLineApp appId "quit";
fun stopDaVinci () = com::removeApp (appId)
fun startDaVinci () =
let
/* These two functions are not delivered with tk .
* They are intended to convert a file test2.nf into a string
* representation of a graph which daVinci can understand
*/
g = FdrNf::parse("/home/stefan/bkb/sml/fdrnf/fdr-examples/test2.nf")
s = StringGraph::graph2daVinci (g, "0")
in
(addApp (appId, prog, prot, callBack, quitAction);
com::putLineApp appId ("new_term_placed(" + s + ")") )
end
end;
startDaVinci = daVinciSMLTK::startDaVinci;
stopDaVinci = daVinciSMLTK::stopDaVinci;
*/
# --- path to images ----
fun get_img_path name
=
winix__premicrothread::path::make_path_from_dir_and_file {
dir => winix__premicrothread::path::cat (
get_lib_path(),
"tests+examples"
),
file=> name
};
# ----------------------------- Id's ------------------------------------
main_window_id = make_tagged_window_id "meister";
a_text_id = make_tagged_widget_id "atext";
a_label_id = make_tagged_widget_id "alabel";
hide_button_id = make_tagged_widget_id "hidebutton";
hidden_button_id = make_tagged_widget_id "hiddenButton";
hider_id = make_tagged_widget_id "hider";
hidden_frame_id = make_tagged_widget_id "hiddenframe";
hide_frame_id = make_tagged_widget_id "hiddeframe";
hider1id = make_tagged_widget_id "hider1";
b_label_id = make_tagged_widget_id "bLabel";
davi_id = make_tagged_widget_id "davi";
texter_id = make_tagged_widget_id "texter";
da_vinci_hider_id = make_tagged_widget_id "davincihider";
da_vinci_button_start_id = make_tagged_widget_id "davincibuttonstart";
da_vinci_button_stop_id = make_tagged_widget_id "davincibuttonstop";
entry_window_id = make_tagged_window_id "entry";
entry_id = make_tagged_widget_id "entry";
canvasfr_id = make_tagged_widget_id "canvasfr";
mes_can_fr_id = make_tagged_widget_id "mescanFr";
canvas_id = make_tagged_widget_id "canvas";
cnv_hidden_button_id = make_tagged_widget_id "cnvhiddenbutton";
cnv_hider_id = make_tagged_widget_id "cnvhider";
cnv_hide_button_id = make_tagged_widget_id "cnvhidebutton";
cnv_deleter_id = make_tagged_widget_id "cnvdeleter";
c1id = make_tagged_widget_id "c1";
it0_cid = make_tagged_canvas_item_id "it0";
it1_cid = make_tagged_canvas_item_id "it1";
it2_cid = make_tagged_canvas_item_id "it2";
it3_cid = make_tagged_canvas_item_id "it3";
l1_2_cid = make_tagged_canvas_item_id "l1-2";
l2_3_cid = make_tagged_canvas_item_id "l2-3";
l3_1_cid = make_tagged_canvas_item_id "l3-1";
it4_cid = make_tagged_canvas_item_id "it4";
it4a_cid = make_tagged_canvas_item_id "it4a";
it5_cid = make_tagged_canvas_item_id "it5";
it6_cid = make_tagged_canvas_item_id "it6";
its_cid = make_tagged_canvas_item_id "its";
# ----------------------------- hide Simple Widget ----------------------
#
start_da_vinci = \\ _ = (insert_text_end a_text_id "Start\n");
stop_da_vinci = \\ _ = (insert_text_end a_text_id "Stop\n");
#
do_quit = \\ () = close_window (main_window_id);
fun a_label ()
=
label (a_label_id,[],[TEXT "My Example"],[]);
fun do_hide_button ()
=
{ delete_widget (hidden_button_id);
add_trait hide_button_id [TEXT "Add"];
add_trait hide_button_id [CALLBACK do_add_button] ;}
also
fun do_add_button ()
=
{ add_widget (main_window_id) hider_id (hidden_button());
add_trait hide_button_id [TEXT "Hide"];
add_trait hide_button_id [CALLBACK do_hide_button];}
also
fun hide_button hide
=
button (hide_button_id,
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[TEXT "Hide", CALLBACK hide],[])
also
fun hidden_button ()
=
button (hidden_button_id,
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[TEXT "ToHide", CALLBACK null_callback],[]);
fun hider ()
=
frame (hider_id, [hide_button do_hide_button, hidden_button ()],
[FILL ONLY_X],
[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
# ----------------------------- hide Recursive Widget ----------------------
fun do_hide_frame ()
=
{ delete_widget (hidden_frame_id);
add_trait hide_frame_id [TEXT "Add"];
add_trait hide_frame_id [CALLBACK do_add_frame] ;}
also
fun do_add_frame ()
=
{ add_widget (main_window_id) hider1id (hidden_frame());
add_trait hide_frame_id [TEXT "Hide"];
add_trait hide_frame_id [CALLBACK do_hide_frame];}
also
fun hide_frame hide
=
button (hide_frame_id,
[FILL ONLY_X, EXPAND TRUE],
[TEXT "Hide", CALLBACK hide],[])
also
fun hidden_button1 x
=
button (make_tagged_widget_id("hiddenButton" + x),
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[TEXT ("ToHide" + x), CALLBACK null_callback],[])
also
fun hidden_frame ()
=
frame (hidden_frame_id,
[hidden_button1 "A", hidden_button1 "B"],
[FILL ONLY_X],[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
fun hider1 ()
=
frame (hider1id,
[hide_frame do_hide_frame,
hidden_frame ()],
[FILL ONLY_X],
[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
# ----------------------------- daVinci Starter ------------------------------
fun b_label ()
=
label (b_label_id,[],[TEXT "Start daVinci"],[])
also
fun do_hide_da_vinci ()
=
{ delete_widget (davi_id);delete_widget (texter_id);}
also
fun b_button ()
=
button (da_vinci_hider_id,[FILL ONLY_X],
[TEXT "Hide daVinci", CALLBACK do_hide_da_vinci],[])
also
fun da_vinci_button_start ()
=
button (da_vinci_button_start_id,[FILL ONLY_X],
[TEXT "Start", CALLBACK start_da_vinci],[])
also
fun da_vinci_button_stop ()
=
button (da_vinci_button_stop_id,[FILL ONLY_X],
[TEXT "Stop", CALLBACK stop_da_vinci],[])
also
fun da_vinci_starter ()
=
frame (davi_id, [b_label(), b_button(),
da_vinci_button_start(),
da_vinci_button_stop()],
[FILL ONLY_X],
[RELIEF RIDGE, BORDER_THICKNESS 2],[])
also
fun a_text ()
=
text_wid (a_text_id, NOWHERE, empty_livetext,[FILL ONLY_X],[WIDTH 60, HEIGHT 10],[])
also
fun texter ()
=
frame (texter_id,[a_text()],[FILL ONLY_X],[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
fun entry ()
=
frame (make_widget_id (),
[tk_21::entry (entry_id ,[FILL ONLY_X],[],
[EVENT_CALLBACK (KEY_PRESS "Return",
(\\ (_) =>
{
t = get_tcl_text entry_id;
{ # WAS: de_focus "Entry";
# changed by bu
de_focus main_window_id;
add_trait mes_can_fr_id
[TEXT ("Entered: \"" + t + "\"")];};
}; end )
)]
)],
[FILL ONLY_X],[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
my
count = REF (0: Int); my
pos = REF (0, 0);
fun canvasfr ()
=
frame (canvasfr_id,
[canvas(), mes_can_fr()],
[FILL ONLY_X],
[RELIEF RIDGE, BORDER_THICKNESS 2],[])
also
fun mes_can_fr ()
=
message (mes_can_fr_id,
[PACK_AT TOP, FILL ONLY_X, EXPAND TRUE],
[WIDTH 350, TEXT "some Text"],
[])
also
fun canvas_items_namings wid cit
=
[ EVENT_CALLBACK (ENTER, enter_it wid cit),
EVENT_CALLBACK (LEAVE, leave_it wid cit),
EVENT_CALLBACK (MOTION, wr_mot_c wid cit),
EVENT_CALLBACK (SHIFT (BUTTON_PRESS (THE 3)), grey_it wid cit),
EVENT_CALLBACK (ALT (BUTTON_PRESS (THE 3)), display_width wid cit),
EVENT_CALLBACK (CONTROL (BUTTON_PRESS (THE 3)), display_height wid cit),
EVENT_CALLBACK (BUTTON_PRESS (THE 3), delete_it wid cit),
EVENT_CALLBACK (BUTTON_PRESS (THE 1), grab_it wid cit),
EVENT_CALLBACK (DOUBLE (BUTTON_PRESS (THE 1)), grey_it wid cit),
EVENT_CALLBACK (BUTTON_RELEASE (THE 1), drop_it wid cit),
EVENT_CALLBACK (MODIFIER_BUTTON (1, MOTION), move_it wid cit)
]
also
fun canvas_items (wid: Widget_Id)
=
[ coval (it1_cid, (50, 50), (100, 100),
[FILL_COLOR RED, OUTLINE_WIDTH 3],
canvas_items_namings wid it1_cid),
crectangle (it2_cid, (200, 200), (250, 250),
[FILL_COLOR RED, OUTLINE NO_COLOR],
canvas_items_namings wid it2_cid),
coval (it3_cid, (50, 200), (100, 250),
[FILL_COLOR NO_COLOR, OUTLINE GREEN, OUTLINE_WIDTH 3],
canvas_items_namings wid it3_cid),
cline (l1_2_cid,[(75, 75), (150, 100), (200, 150), (225, 225)],
[FILL_COLOR BROWN, OUTLINE_WIDTH 10, SMOOTH TRUE],
canvas_items_namings wid l1_2_cid),
cline (l2_3_cid,[(225, 225), (75, 225)],
[FILL_COLOR WHITE, OUTLINE_WIDTH 3],
canvas_items_namings wid l2_3_cid),
cline (l3_1_cid,[(75, 225), (75, 75)],
[FILL_COLOR BLUE, OUTLINE_WIDTH 5],
canvas_items_namings wid l3_1_cid),
cicon (it4_cid, (300, 250),
FILE_BITMAP (get_img_path "myex.bmp"),
[BACKGROUND BLUE, FOREGROUND YELLOW, ANCHOR NORTHWEST],
canvas_items_namings wid it4_cid),
cwidget (it5_cid, (250, 100), make_canvas_item_frame_id(),
[button (make_tagged_widget_id"canvBut",[FILL ONLY_X],
[TEXT "Add Subitem",
CALLBACK (\\ () => add_sub_canvas wid; end )],
[])],
[],
[ANCHOR NORTHWEST],
canvas_items_namings wid it5_cid),
cwidget (it6_cid, (200, 10), make_canvas_item_frame_id(),
sub_canvas wid it6_cid,
[BACKGROUND GREEN],
[ANCHOR NORTHWEST, WIDTH 200, HEIGHT 180],
canvas_items_namings wid it6_cid),
ctag (its_cid,[it1_cid, it2_cid, it3_cid, it4_cid, it5_cid])
]
also
fun cnv_do_hide_button (wid: Widget_Id) (cid: Canvas_Item_Id)()
=
{ delete_widget (cnv_hidden_button_id);
add_trait cnv_hide_button_id [TEXT "Add"];
add_trait cnv_hide_button_id [CALLBACK (cnv_do_add_button wid cid)] ;}
also
fun cnv_do_add_button (wid: Widget_Id) (cid: Canvas_Item_Id) ()
=
{ cit = get_canvas_item wid cid;
{ add_widget (main_window_id) cnv_hider_id (cnv_hidden_button());
add_trait cnv_hide_button_id [TEXT "Hide"];
add_trait cnv_hide_button_id [CALLBACK (cnv_do_hide_button wid cid)]
;};
}
also
fun cnv_hide_button hide
=
button (
cnv_hide_button_id,
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[TEXT "Hide", CALLBACK hide],[]
)
also
fun cnv_hidden_button ()
=
button (cnv_hidden_button_id,
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[TEXT "Delete",
CALLBACK (\\ () => delete_canvas_item c1id it1_cid; end )],
[])
also
fun testit ()
=
(add_trait cnv_hidden_button_id [TEXT "Deleted"])
also
fun cnv_hider (wid: Widget_Id) (cid: Canvas_Item_Id)
=
frame (cnv_hider_id,
[cnv_hide_button (cnv_do_hide_button wid cid),
cnv_hidden_button ()],
[FILL ONLY_X, PAD_X 5, PAD_Y 5],
[RELIEF RIDGE, BORDER_THICKNESS 2],[])
also
fun cnv_deleter (wid: Widget_Id) (cid: Canvas_Item_Id)
=
button (cnv_deleter_id,
[FILL ONLY_X, EXPAND TRUE, PAD_X 5, PAD_Y 5],
[TEXT "Quit Subitem",
CALLBACK (\\ () => delete_canvas_item wid cid; end )],
[])
also
fun sub_canvas (wid: Widget_Id) (cid: Canvas_Item_Id)
=
[cnv_hider wid cid,
cnv_deleter wid cid,
tk_21::canvas (c1id, AT_RIGHT,
[ coval (it1_cid, (25, 25), (75, 75),
[FILL_COLOR RED, OUTLINE_WIDTH 3],
[]) ],
[PAD_X 5, PAD_Y 5],
[BACKGROUND YELLOW, BORDER_THICKNESS 2, RELIEF RIDGE],
[])]
also
fun add_sub_canvas (wid: Widget_Id)
=
{
cid = make_canvas_item_id();
cit = cwidget (cid, (200, 10), make_canvas_item_frame_id(),
sub_canvas wid cid,
[BACKGROUND GREEN],
[ANCHOR NORTHWEST, WIDTH 200, HEIGHT 180],
canvas_items_namings wid cid);
add_canvas_item wid cit;
}
also
fun canvas ()
=
{ c = canvas_id;
tk_21::canvas (c, AT_RIGHT, canvas_items c,
[PACK_AT TOP, FILL ONLY_X, EXPAND TRUE],
[HEIGHT 300, WIDTH 200, BACKGROUND YELLOW,
BORDER_THICKNESS 2, RELIEF RIDGE],
[EVENT_CALLBACK (BUTTON_PRESS (THE 2), add_one_item c)]);
}
also
fun add_one_item (wid: Widget_Id) (e: Tk_Event)
=
{ x = get_x_coordinate e;
y = get_y_coordinate e;
ncid = make_canvas_item_id ();
ncit = coval (ncid, (x - 25, y - 25), (x+25, y+25),
[FILL_COLOR RED, OUTLINE_WIDTH 3],
canvas_items_namings wid ncid);
add_canvas_item wid ncit;
}
also
fun delete_it (wid: Widget_Id) (cid: Canvas_Item_Id) (_: Tk_Event)
=
delete_canvas_item wid cid
also
fun display_width (wid: Widget_Id) (cid: Canvas_Item_Id) (_: Tk_Event)
=
add_trait mes_can_fr_id [TEXT ("Item \"" + (canvas_item_id_to_string cid) + "\" has width: " +
(int::to_string (get_tcl_canvas_item_width wid cid)))]
also
fun display_height (wid: Widget_Id) (cid: Canvas_Item_Id) (_: Tk_Event)
=
add_trait mes_can_fr_id [TEXT ("Item \"" + (canvas_item_id_to_string cid) + "\" has height: " +
(int::to_string (get_tcl_canvas_item_height wid cid)))]
also
fun grey_it (wid: Widget_Id) (cid: Canvas_Item_Id) (_: Tk_Event)
=
{ add_canvas_item_traits wid cid [FILL_COLOR GREY];
add_canvas_item_event_callbacks wid cid [EVENT_CALLBACK (SHIFT (BUTTON_PRESS (THE 3)), blue_it wid cid)];}
also
fun blue_it (wid: Widget_Id) (cid: Canvas_Item_Id) (_: Tk_Event)
=
{ add_canvas_item_traits wid cid [FILL_COLOR BLUE];
add_canvas_item_event_callbacks wid cid [EVENT_CALLBACK (SHIFT (BUTTON_PRESS (THE 3)), grey_it wid cid)];}
also
fun enter_it (wid: Widget_Id) (cit: Canvas_Item_Id) (_: Tk_Event)
=
{ add_trait mes_can_fr_id [TEXT ("<Enter Canvas Item(" +
(widget_id_to_string wid) + ", " +
(canvas_item_id_to_string cit) + ")>")];
add_trait wid [CURSOR (XCURSOR("hand2", NULL))];}
also
fun grab_it (wid: Widget_Id) (cid: Canvas_Item_Id) (TK_EVENT(_, _, x, y, _, _))
=
{ pos := (x, y);
add_trait wid [CURSOR (XCURSOR("fleur", NULL))];}
also
fun move_it (wid: Widget_Id) (cid: Canvas_Item_Id) (TK_EVENT(_, _, x, y, _, _))
=
{
cit_col = get_tcl_canvas_item_coordinates wid cid;
my (x_p, y_p) = *pos;
pos := (x, y);
delta = (x-x_p, y-y_p);
cit_col' = map (add_coordinates (coordinate delta)) cit_col;
t = "<Drag Canvas Item(" + (int::to_string x) + ", " +
(int::to_string y) + ", " + (widget_id_to_string wid) + ", " +
(canvas_item_id_to_string cid) + ") > " +
(int::to_string *count);
basic_utilities::inc count;
/* (add_trait mesCanFrId [TEXT t];
*/
set_canvas_item_coordinates wid cid cit_col';
/*
move_canvas_item wid cid delta
*/
}
also
fun drop_it (wid: Widget_Id) (cid: Canvas_Item_Id) (TK_EVENT(_, _, x, y, _, _))
=
add_trait wid [CURSOR (XCURSOR("hand2", NULL))]
also
fun leave_it (wid: Widget_Id) (cit: Canvas_Item_Id) (_: Tk_Event)
=
{ add_trait mes_can_fr_id [TEXT ("<Leave Canvas Item(" + (widget_id_to_string wid) + ", " +
(canvas_item_id_to_string cit) + ")>")];
add_trait wid [CURSOR (NO_CURSOR)];}
also
fun wr_mot_c (wid: Widget_Id) (cid: Canvas_Item_Id) (TK_EVENT(_, _, x, y, _, _))
=
{ t = "<Motion Canvas Item(" + (int::to_string x) + ", " +
(int::to_string y) + ", " + (widget_id_to_string wid) + ", " +
(canvas_item_id_to_string cid) + ") > " +
(int::to_string *count);
basic_utilities::inc count;
add_trait mes_can_fr_id [TEXT t];
}
also
fun wr_ent (_: Tk_Event) = add_trait mes_can_fr_id [TEXT "<Enter>"]
also
fun wr_lea (_: Tk_Event) = add_trait mes_can_fr_id [TEXT "<Leave>"]
also
fun wr_mot (_: Tk_Event) =
{
t = "<Motion> " + (int::to_string *count);
my _ = basic_utilities::inc count;
add_trait mes_can_fr_id [TEXT t];
};
fun quit_button quit
=
button(
make_tagged_widget_id "quitButton",
[PACK_AT LEFT, FILL ONLY_X, EXPAND TRUE],
[ TEXT "Quit",
CALLBACK quit,
CURSOR(
FILE_CURSOR (
get_img_path "myex.cursor",
BLUE,
THE (
get_img_path "myex.cursor_mask",
YELLOW
) ) )
],
[]
);
fun quitter ()
=
frame (make_tagged_widget_id "quitter",
[quit_button do_quit],
[FILL ONLY_X],
[RELIEF RIDGE, BORDER_THICKNESS 2],[]);
fun initwin _
=
[ make_window {
window_id => main_window_id,
traits => [ WINDOW_TITLE "Hider Example",
WINDOW_SIZED_BY PROGRAM,
WIDE_HIGH_X_Y (NULL, THE (50, 50))
],
subwidgets => PACKED [a_label(), hider(), hider1(), da_vinci_starter(),
texter(), entry(), canvasfr(), quitter()],
event_callbacks => [],
init => null_callback
}
];
my
go = \\ () => start_tcl_and_trap_tcl_exceptions (initwin ()); end ;
};