## simpleinst.pkg
## (C) 1996, Bremen Institute for Safe Systems, Universitaet Bremen
## Author: cxl (Last modification by $Author: 2cxl $)
# Compiled by:
# src/lib/tk/src/toolkit/tests+examples/sources.sublib# ***************************************************************************
#
# Test and example program for generate_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:03 $
# $Revision: 3.0 $
#
#
# **************************************************************************
package simple_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
=
String Ref;
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; end ) 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 };
};
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 { my
width = 500; my
height = 300; my
ca_width = 350; my
ca_height = 300; my
ca_xy = THE (50, 470);
fun ca_title nm
=
"Edit text: " $ nm;
my
icon_name_width = 60; my
icon_name_font = tk::SANS_SERIF [tk::SMALL];
my
background = GREY;
my
move_opaque = TRUE;
my
one_window = TRUE;
fun trashcan_icon ()
=
icons::get_icon (get_lib_path()$"/icons",
"trashcan.gif");
my
trashcan_coord = (width - 50, (height div 2) - 50);
my
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);
my
tc = explode tx; my
nl = count string_util::is_linefeed tc; my
nc = list::length tc; my
nspc = count char::is_space tc; my
na = ((count char::is_alpha tc) * 100) div nc; my
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 => \\ _ = ()
};
};
stat (number (n, _, nm))
=>
{ my
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;
fun std_ops _
=
[ (show, "Show"),
(stat, "Info")
];
fun delete _
=
();
# Initially appearing objects.
fun init ()
=
[(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 _
=
[];
my
create_actions = [];
# 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
=
\\ ()=> (); end ; # 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 simple_inst
# Begin_api my go: Void -> Void end
{
include package tk;
package simple_gui = generate_gui_g (package appl= simple_inst_appl;);
exception RESULT simple_gui::Gui_State;
fun quit_button window
=
{ fun confirm_quit ()
=
uw::confirm("Do you really want to quit?",
(\\()=> { st= simple_gui::state();
{ close_window window;
raise exception RESULT st;};
}; end ));
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 filer_button window
=
BUTTON {
widget_id => make_widget_id(),
packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
event_callbacks => [],
traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
TEXT "Import File",
CALLBACK (\\ _ => simple_inst_appl::filer::enter_file(); end )]
};
main_window
=
{ 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 [simple_gui::main_wid wid,
quit_button wid, filer_button wid],
event_callbacks => [],
init => (\\ ()=> simple_gui::init (simple_gui::initial_state()); end )
};
};
fun go ()
=
{ tk::start_tcl [ main_window ];
simple_gui::initial_state ();
}
except
simple_gui::GENERATE_GUI_FN err
=>
{ debug::print 19 ("GenGUI error: " + err);
simple_gui::initial_state();
};
RESULT state => state;
end;
};