## tsimpleinst.pkg
## (C) 2000, Bremen Institute for Safe Systems, Universitaet Bremen
## Albert-Ludwigs-Universität Freiburg
## Author: cxl&bu (Last modification by $Author: 2cxl $)
# Compiled by:
# src/lib/tk/src/toolkit/tests+examples/sources.sublib# ***************************************************************************
#
# Test and example program for generate_tree_gui_g.
#
# This example only knows two object types, texts and numbers. Numbers have
# four different subtypes, corresponding to the four riders of the apocalypse,
# or rather the four basic arithmetic operations.
#
#
# Texts can be concatened by dropping one onto the other, or they can
# be edited in the construction area. Numbers can added, subtracted
# etc. by dropping them onto each other. If you drag a number object into the
# con area, a textual representation of the number is appended to the text
# currently under construction.
#
# There is also the possibility to import a text by calling up the
# file browser and dragging one file into the construction system.
#
# Use SimpleInst::go() to start.
#
# $Date: 2001/03/30 13:40:06 $
# $Revision: 3.0 $
#
#
# **************************************************************************
### "A table, a chair, a bowl of fruit and a violin;
### what else does a man need to be happy?"
###
### -- Albert Einstein
package tsimple_inst_appl /* : Application */
{
stipulate
include package tk;
include package basic_utilities;
herein
# Instantiating the utility windows
# We have text objects and numbers. Numbers have different modes,
# namely plus, minus, times or div.
Objtype0 = TEXT | NUM;
Mode = PLUS_M | MINUS_M | TIMES_M | DIV_M;
Part_Type = (Objtype0, Null_Or( Mode ));
fun mode (_, m) = the m;
Name = Ref( String );
fun mode_name plus_m => "Add me";
mode_name minus_m => "Subtract me";
mode_name times_m => "Multiply me";
mode_name div_m => "Divide me"; end;
Part_Ilk = TEXTOBJ (String, Ref( String ))
| NUMBER (Int, Ref( Mode ), Ref( String ));
fun ord (textobj x, number y) => LESS;
ord (textobj (_, x), textobj (_, x')) => string::compare (*x,*x');
ord (number (_, _, x), number (_, _, x')) => string::compare (*x,*x');
ord (number x, textobj y) => GREATER; end;
fun name_of (textobj (_, x)) => x;
name_of (number (_, _, x)) => x;
end;
fun rename s (textobj (_, x)) => (x:=s);
rename s (number (_, _, x)) => (x:=s);
end;
fun reset_name _ = ();
fun string_of_name s t = *s;
fun part_type (textobj _) => (text, NULL);
part_type (number (_, m, _)) => (num, THE *m);
end;
fun modes (text, _) => [];
modes (num, _) => [plus_m, minus_m, times_m, div_m];
end;
fun sel_mode (textobj _) => plus_m; # Disnae matter what we return here
sel_mode (number(_, m, _))=> *m;
end;
fun set_mode (textobj _, _)=> ();
set_mode (number(_, m, _), nu)=> m:= nu;
end;
fun objlist_type ls
=
{ fun forall p
=
not o (list::exists (not o p));
if (forall (\\ oo = fst (part_type oo) == text) ls )
THE (text, NULL);
elif (forall (\\ oo = fst (part_type oo) == num) ls )
THE (num, THE plus_m);
else NULL;
fi;
};
Objectlist = Void -> List( Part_Ilk );
Cb_Objects = Objectlist;
fun cb_objects_abs x = x;
fun cb_objects_rep x = x;
New_Part = (Part_Ilk, ((tk::Coordinate, tk::Anchor_Kind)));
fun is_constructed (text, _) => TRUE;
is_constructed (num, _) => FALSE; end;
fun get_name (textobj(_, nm)) => *nm;
get_name (number(_, _, nm)) => *nm; end;
fun sel_name ob = THE (get_name ob);
fun label_action { obj, cc } =
{ fun set (textobj(_, nm)) nuname => { nm:= nuname; cc nuname;};
set (number(_, _, nm)) nuname => { nm:= nuname; cc nuname;}; end;
uw::enter_line { title=>"Renaming object", default=>"",
prompt=>"Please enter new name: ",
width=> 20, cc=>set obj };
};
create_actions = [];
fun set_name (textobj(_, nm), nuname) => nm:= nuname;
set_name (number(_, _, nm), nuname) => nm:= nuname; end;
fun sel_text (textobj (t, _))= t;
fun sel_number (number (m, _, _)) = m;
fun outline _ = FALSE; # never outline
fun icon (ot, m) =
{
fun iconnm (text, _) => "note.gif";
iconnm (num, THE plus_m) => "number.gif";
iconnm (num, THE minus_m) => "nummin.gif";
iconnm (num, THE times_m) => "numtim.gif";
iconnm (num, THE div_m) => "numdiv.gif"; end;
icons::get_icon (get_lib_path()$"/tests+examples/icons",
iconnm (ot, m));
};
# Configuring generate_gui_g
package conf =
package {
width = 500;
height = 300;
ca_width = 350;
ca_height = 300;
ca_xy = THE (50, 470);
fun ca_title nm = "Edit text: " $ nm;
icon_name_width = 60;
icon_name_font = tk::SANS_SERIF [tk::SMALL];
background = GREY;
move_opaque = TRUE;
one_window = TRUE;
fun trashcan_icon ()= icons::get_icon (get_lib_path()$"/icons",
"trashcan.gif");
trashcan_coord = (width - 50, (height div 2) - 50);
delta = 70;
};
# The standard operations: show & info
fun show (textobj (tx, nm)) =>
uw::display { title=> *nm, width=> 40, height=> 20,
text=> string_to_livetext tx, cc=> \\ _ => (); end };
show (number (n, _, nm)) =>
uw::display { title=> *nm, width=> 6, height=> 3,
text=> string_to_livetext ("Value: " $ (int::to_string n)),
cc=> \\ _ = () };
end;
fun stat (textobj (tx, nm)) =>
{ fun count p = list::length o (list::filter p);
tc = explode tx;
nl = count string_util::is_linefeed tc;
nc = list::length tc;
nspc = count char::is_space tc;
na = ((count char::is_alpha tc) * 100) div nc;
st = "\nNumber of lines: " $ (int::to_string nl) $
"\nNumber of chars: " $ (int::to_string nc) $
"\nNumber of spaces: " $ (int::to_string nspc) $
"\nPercentage of alphanumerical char's: " $
(int::to_string na)$"\n";
uw::display { title=> "Statistics for " + *nm,
width=> 40, height=> 20,
text=> string_to_livetext st, cc=> \\ _ => (); end };
};
stat (number (n, _, nm))=>
{ st= "The number has " + (int::to_string ((size (int::to_string n))-1)) +
" digits.\n";
uw::display { title=> "Statistics for " + *nm,
width=> 40, height=> 20,
text=> string_to_livetext st, cc=> \\ _ => (); end };
}; end;
fun std_ops _ = [(show, "Show"), (stat, "Info")];
fun delete _ = ();
# Initially appearing objects.
fun init () = # oldfashioned initialization . . .
[(number (2, REF plus_m, REF "2"), ((10, 10), SOUTH)),
(number (4, REF plus_m, REF "4"), ((10, 10), EAST)),
(number (5, REF plus_m, REF "5"), ((10, 10), SOUTH)),
(textobj("Bring me my bow of burning gold!\n" +
"Bring me my arrows of desire!\n" +
"Bring me my spear! O clouds unfold!\n" +
"Bring me my chariot of fire!\n",
REF "Jer'lem 1"), ((100, 10), CENTER)),
(textobj("I will not cease from mental fight\n" +
"Nor shall my sword sleep in my hand\n" +
"Till we have built Jerusalem\n" +
"In England's green and pleasant land\n",
REF "Jer'lem 2"), ((100, 10), SOUTH))];
fun mon_ops _ = [];
# For texts, there is just one binary operation: concatenation
fun tconc (t1, wh, [], cc_newop) => cc_newop (t1, (wh, SOUTH));
tconc (t1, wh, t, cc_newop) =>
cc_newop (textobj (string::join "\n"
(map sel_text (t1 . t)),
REF (string::join " and "
(map get_name (t1 . t)))),
(wh, SOUTH)); end;
fun numop (number (n, m, _), wh, ls, cc_newop) =
{ fun appl_op [] => n;
appl_op ((number (n, m, _)) . ns) =>
case *m plus_m => (appl_op ns)+n;
minus_m => (appl_op ns)-n;
times_m => (appl_op ns)*n;
div_m => (appl_op ns) div n; esac; end;
nunum = appl_op ls;
cc_newop (number (nunum, m, REF (int::to_string nunum)), (wh, SOUTH));
};
fun bin_ops ((text, _), (text, _)) => THE tconc;
bin_ops ((num, _), (num, _)) => THE numop;
bin_ops (_, _) => NULL; end;
# The Construction Area.
#
# The Construction Area essentially consists of a text widget
# which can be used to edit the text. If another text is dragged
# down from the manipulation area, it will appended at the end.
fun tx_id ws_id
=
make_sub_widget_id (ws_id, "xTxEd");
Ca = Widget_Id;
join_cr = string::join "\n";
fun area_ops (text, _) wid ls =>
tk::set_text_end (tx_id wid) (join_cr (map sel_text ls));
area_ops (num, _) wid ls =>
tk::set_text_end (tx_id wid) (join_cr (map (int::to_string o sel_number) ls));
end;
fun area_open (window, textobj (tx, nm), cc)
=
{ ws_wid = make_widget_id();
title
=
LABEL
{ widget_id => make_widget_id (),
packing_hints => [PACK_AT TOP, FILL ONLY_X],
traits => [ RELIEF GROOVE,
BORDER_THICKNESS 2,
TEXT *nm
],
event_callbacks => []
};
txwid
=
TEXT_WIDGET
{
widget_id => tx_id ws_wid,
scrollbars => AT_RIGHT,
live_text => string_to_livetext tx,
packing_hints => [FILL XY],
traits => [],
event_callbacks => []
};
fun close txid cc nm ()
=
cc (textobj (tk::get_tcl_text txid, nm));
quit = BUTTON
{
widget_id => make_widget_id(),
packing_hints => [PACK_AT RIGHT, PACK_AT BOTTOM],
traits => [ TEXT "Close",
CALLBACK (close (tx_id ws_wid) cc nm)
],
event_callbacks => []
};
widgs = [quit, txwid];
( ws_wid,
if conf::one_window title . widgs;
else widgs; fi,
k0
);
};
area_init = \\ () = (); # no init necessary
# Communicating with the Filer:
#
# First, we need to instantiate the clipboard:
#
package clipboard = clipboard_g ( Part = Void -> List( Part_Ilk ); );
# Instantiate the filer.
# We need to provide it with a function to convert files to
# texts (file_to_part below); we'll do so by reading the file's contents
# into the text of the object.
#
package filer =
filer_g (package options =
package {
exception NO_FILE String;
fun icons_path () = winix__premicrothread::path::cat (tk::get_lib_path(),
"icons/filer");
icons_size = (40, 10);
default_pattern = NULL;
fun root () = NULL;
default_filter = NULL;
package conf= filer_default_config; # filer_default_config is from src/lib/tk/src/toolkit/filer_default_config.pkg package clipboard=
package { # we have to insert a closure here
Part = List( Part_Ilk );
fun put obs ev cb =
clipboard::put (\\ ()=> obs; end ) ev cb;
};
filetypes =
{
fun file_to_part { dir: String,
file: String } =
{
filenm= "/" + winix__premicrothread::path::make_path_from_dir_and_file { dir, file };
objnm = REF ("File: " + file);
txt =
{
fun read_file si
=
if (file::end_of_stream si)
"";
else (the_else((file::read_line si), "")) + (read_file si);fi;
is = file::open_for_read filenm;
txt = read_file is;
file::close_input is;
txt;
}
except NO_FILE f => "NoFile: " + f; end ;
[textobj (txt, objnm)];
};
[ { ext => [""],
display => THE { comment => "Default filetype",
icon => "unknown_Icon.gif",
preview => NULL: Null_Or( { dir: String,
file: String }
-> Void),
file_to_obj => THE file_to_part } } ];
};
};);
end;
};
package tsimple_inst {
# Begin_api my go: Void -> Void end
stipulate
include package tk;
herein
package tsimple_gui = generate_tree_gui_g (package appl= tsimple_inst_appl;);
result = REF *tsimple_gui::gui_state;
stipulate
include package tsimple_inst_appl;
include package tsimple_gui::tree_obj;
herein
init_objects
=
[folder((REF "texts", ((120, 20), SOUTH)),
[content (textobj("I will not cease from mental fight\n" +
"Nor shall my sword sleep in my hand\n" +
"Till we have built Jerusalem\n" +
"In England's green and pleasant land\n",
REF "Jer'lem 2"), ((100, 10), SOUTH)),
content (textobj("I will not cease from mental fight\n" +
"Nor shall my sword sleep in my hand\n" +
"Till we have built Jerusalem\n" +
"In England's green and pleasant land\n",
REF "Jer'lem 3"), ((100, 10), SOUTH))
]),
content (number (2, REF plus_m, REF "2"), ((10, 10), SOUTH)),
content (number (4, REF plus_m, REF "4"), ((10, 10), EAST)),
content (number (5, REF plus_m, REF "5"), ((10, 10), SOUTH)),
content (textobj("Bring me my bow of burning gold!\n" +
"Bring me my arrows of desire!\n" +
"Bring me my spear! O clouds unfold!\n" +
"Bring me my chariot of fire!\n",
REF "Jer'lem 1"), ((100, 10), CENTER)),
content (textobj("I will not cease from mental fight\n" +
"Nor shall my sword sleep in my hand\n" +
"Till we have built Jerusalem\n" +
"In England's green and pleasant land\n",
REF "Jer'lem 2"), ((100, 10), SOUTH))
];
end; # local
my
init_guistate
=
(([], NULL), init_objects);
fun quit_button window
=
{ fun confirm_quit ()
=
uw::confirm
( "Do you really want to quit?",
(\\() = { result := tsimple_gui::state();
close_window window;
}
)
);
BUTTON {
widget_id => make_widget_id(),
packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
TEXT "Quit", CALLBACK confirm_quit],
event_callbacks => []
};
};
fun new_folder_button window
=
BUTTON {
widget_id => make_widget_id(),
packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
TEXT "New Folder",
CALLBACK (\\ _ => tsimple_gui::create_folder (20, 20); end )],
event_callbacks => []
};
fun filer_button window
=
BUTTON {
widget_id => make_widget_id(),
packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
TEXT "Import File",
CALLBACK (\\ _ => tsimple_inst_appl::filer::enter_file(); end )],
event_callbacks => []
};
my
main_window
=
{ my
wid = make_window_id ();
make_window {
window_id => wid,
traits => [WINDOW_TITLE "tk Office 2000",
WIDE_HIGH_X_Y (NULL, THE (50, 50))],
subwidgets => PACKED [tsimple_gui::main_wid wid,
quit_button wid, filer_button wid,
new_folder_button wid
],
event_callbacks => [],
init => (\\ ()=>tsimple_gui::init init_guistate; end )
};
};
fun go ()
=
{ tk::start_tcl_and_trap_tcl_exceptions [ main_window ];
!result
;};
end; # local
};
package ts
=
tsimple_inst;