## icons.pkg
## (C) 1996, 1998, Bremen Institut for Safe Systems, Universitaet Bremen
## Author: cxl
# Compiled by:
# src/lib/tk/src/toolkit/sources.sublib# ***************************************************************************
# Subsidiary module for generate_gui_g, comprising functions to handle icons.
#
# Icons are three images of the same size, the normal image, a highlighted
# image (displayed to indicate it is ready for something to be dropped on),
# and an outline, displayed while the icon is being dragged.
#
# Additionally, there is a "micro-images" of this image, which is used
# for drag-drop highlighting, or compact presentation in navigation
# trees, etc. Micro-images are expected to have a fixed size 12 * 12 pt.
# **************************************************************************
### "Chagall is my favourite pupil,
### and what I like about him is that
### after listening attentively to my lessons
### he takes his paints and brushes
### and does something absolutely different
### from what I have told him."
###
### -- Leon Bakst
api Icons {
Icon;
# Get an icon. The first is the directory, the second
# the name of the icon. We could allow for more icons here
get_icon: (String, String) -> Icon;
# the undefined Icon
no_icon: Icon;
is_no_icon: Icon -> Bool;
get_width: Icon -> Int;
get_height: Icon -> Int;
get_normal_variety: Icon -> tk::Icon_Variety;
get_highlighted_variety: Icon -> tk::Icon_Variety;
get_outlined_variety: Icon -> tk::Icon_Variety;
get_microlined_variety: Icon -> tk::Icon_Variety;
# error exception: raised when we can't read an icon file
exception ICON;
};
package icons: (weak) Icons { # Icons is from src/lib/tk/src/toolkit/icons.pkg include package tk;
include package basic_utilities;
include package winix__premicrothread::path;
exception ICON;
Icon = (Icon_Variety, Icon_Variety, Icon_Variety, Int, Int, Icon_Variety);
fun get_width (_, _, _, x, _, _) = x;
fun get_height (_, _, _, _, x, _) = x;
fun get_normal_variety (i, _, _, _, _, _) = i;
fun get_highlighted_variety (_, i, _, _, _, _) = i;
fun get_outlined_variety (_, _, i, _, _, _) = i;
fun get_microlined_variety (_, _, _, _, _, i) = i;
my
no_icon = (NO_ICON, NO_ICON, NO_ICON, 0, 0, NO_ICON);
fun is_no_icon i
=
case (get_normal_variety i)
NO_ICON => TRUE;
_ => FALSE;
esac;
fun open_file f
=
file::open_for_read f
except
io::io _
=
{ debug::error ("Can't open file " $ f);
raise exception ICON;
};
# The data file is the name as the icon file, but with the extension
# "data"
#
fun data_file_nm ifnm
=
join_base_ext { base=>base ifnm, ext=> THE "data"};
# The hilight/outlined file icons have the base name of the icon file,
# but with "-hi"/"-out" added, plus the same extension. Thus, if
# the icon is called "theory.gif", the outline is called
# "theory-out.gif"
#
fun out_file_nm ifn
=
join_base_ext { base=> (base ifn)$"-out", ext=> ext ifn };
fun hil_file_nm ifn
=
join_base_ext { base=> (base ifn)$"-hi", ext=> ext ifn };
fun micro_file_nm ifn
=
join_base_ext { base=> (base ifn)$"-mic", ext=> ext ifn };
fun get_icon_data (dir, file)
=
{ i = open_file (make_path_from_dir_and_file { dir,
file=>data_file_nm file } );
w = string_util::to_int (the_else((file::read_line i), ""));
h = string_util::to_int (the_else((file::read_line i), ""));
file::close_input i;
(w, h);
};
# Utility function: create file image from file n in directory
fun file_im (dir, n)
=
FILE_IMAGE (make_path_from_dir_and_file { dir=> dir, file=> n },
make_image_id());
fun get_icon (dir, file)
=
{ fun readable f
=
(winix__premicrothread::file::access (make_path_from_dir_and_file { dir=> dir,
file=> f
},
[winix__premicrothread::file::MAY_READ]));
my
miss = list::filter (not o readable) [file, data_file_nm file];
fun getfile s f
=
file_im ( dir,
if (readable f)
f;
else
debug::warning ("Can't find icon file " + f +
"-- substituting " + s);
s;
fi
);
if (null miss)
my (w, h) = get_icon_data (dir, file);
im = file_im (dir, file);
my [i_h, i_o, imc] = map (getfile file) [hil_file_nm file,
out_file_nm file,
micro_file_nm file];
(im, i_h, i_o, w, h, imc);
else
debug::error ("Icon file (s) missing in " + dir + ":" +
(string::join ", " miss));
raise exception ICON;
fi;
};
# This doesn't work: get_tcl_icon_width/Height need the image to be
# displayed, whereas typically you want to know the height and
# width of the icon in order to display it correctly.
# w = get_tcl_icon_width im
# h = readconHeight im
};