15.4.1535  src/lib/x-kit/widget/old/lib/ro-pixmap-cache-old.pkg

## ro-pixmap-cache-old.pkg
#
# Support for icons, button images
# and so forth:   Track what readonly
# windows we have on the X server and
# transparently load new ones as needed.
#

# Compiled by:
#     src/lib/x-kit/widget/xkit-widget.sublib

###            "Opportunity is missed by most people
###              because it is dressed in overalls
###               and looks like work."
###
###                          -- Thomas Edison


stipulate
    include package   threadkit;                                                # threadkit                     is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package bio =  bitmap_io_old;                                               # bitmap_io_old                 is from   src/lib/x-kit/draw/bitmap-io-old.pkg
    package fil =  file__premicrothread;                                        # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
    package qk  =  quark;                                                       # quark                         is from   src/lib/x-kit/style/quark.pkg
    package xc  =  xclient;                                                     # xclient                       is from   src/lib/x-kit/xclient/xclient.pkg
herein

    package   ro_pixmap_cache_old
    : (weak)  Ro_Pixmap_Cache_Old                                               # Ro_Pixmap_Cache_Old           is from   src/lib/x-kit/widget/old/lib/ro-pixmap-cache-old.api
    {
        exception BAD_NAME;

        Plea_Mail  = GET_RO_PIXMAP  String;
        Reply_Mail = Null_Or( xc::Ro_Pixmap );

        Ro_Pixmap_Cache
            =
            RO_PIXMAP_CACHE
              { plea_slot:   Mailslot( Plea_Mail  ),
                reply_slot:  Mailslot( Reply_Mail )
              };

                                                                                    # typelocked_hashtable_g    is from   src/lib/src/typelocked-hashtable-g.pkg
        package qht
            =
            typelocked_hashtable_g (
                #
                Hash_Key   = qk::Quark;
                same_key   = qk::same;
                hash_value = qk::hash;
            );

        Window_Table
            =
            qht::Hashtable( xc::Ro_Pixmap );

        fun make_readonly_pixmap_cache
            ( screen,
              name_to_cs_pixmap
            )
            =
            {   exception NOT_FOUND;
                #
                window_table
                   =
                   qht::make_hashtable  { size_hint => 32,  not_found_exception => NOT_FOUND }:    Window_Table;

                note_window =  qht::set   window_table;
                find_window =  qht::find  window_table;

                # Parse file, being careful to close
                # it properly in an exception is raised:
                #
                fun parse_file (fd, parse)
                    = 
                    (parse fd
                     then
                         fil::close_input  fd
                    ) 
                    except
                        e = {   fil::close_input  fd;
                                raise exception e;
                            };

                fun make_window_from_file (name, quark)
                    =
                    {   file_name = substring (name, 1, size name - 1);

                        fd = fil::open_for_read  file_name;

                        (parse_file (fd, bio::read_bitmap))
                            ->
                            { image, ... };

                        t = xc::make_readonly_pixmap_from_clientside_pixmap
                                screen
                                image;

                        note_window (quark, t); THE t;
                    };

                fun make_window_from_clientside_pixmap  quark
                    =
                    {   window
                            =
                            xc::make_readonly_pixmap_from_clientside_pixmap
                                screen
                                (name_to_cs_pixmap  quark);

                        note_window (quark, window);

                        THE window;
                    };

                fun make_window (arg as (name, q))
                    = 
                    if (string::get_byte_as_char (name, 0) == '@')
                        #
                        make_window_from_file  arg;
                    else
                        make_window_from_clientside_pixmap  q;
                    fi
                    except _ = NULL;

                                                                    # quark             is from   src/lib/x-kit/style/quark.pkg
                fun do_plea (GET_RO_PIXMAP name)
                    =
                    {   quark = qk::quark name;
                        #
                        case (find_window quark)
                            #
                            NULL => make_window (name, quark);
                            s    => s;
                        esac;
                    };

                plea_slot  =  make_mailslot ();
                reply_slot =  make_mailslot ();

                fun loop ()
                    =
                    for (;;) {
                        #
                        put_in_mailslot  (reply_slot,   do_plea (take_from_mailslot  plea_slot));
                    };

                xlogger::make_thread  "ro_pixmap_cache"  loop;

                RO_PIXMAP_CACHE { plea_slot, reply_slot };
            };

        fun get_ro_pixmap
                (RO_PIXMAP_CACHE { plea_slot, reply_slot } )
                name
            =
            {   put_in_mailslot  (plea_slot,  GET_RO_PIXMAP name);
                #
                case (take_from_mailslot  reply_slot)
                    #
                    THE s => s;
                    _     => raise exception BAD_NAME;
                esac;
            };
    };

end;