PreviousUpNext

15.4.1282  src/lib/tk/src/toolkit/icons.pkg

## 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 tk;
    include basic_utilities;
    include 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 
};





Comments and suggestions to: bugs@mythryl.org

PreviousUpNext