15.4.1464  src/lib/x-kit/widget/lib/image-imp.pkg

## image-imp.pkg
#
# This provides a name to x-kit image imp.  

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






###                 "Programming is one of the most difficult branches of applied mathematics;
###                  the poorer mathematicians had better remain pure mathematicians."
###
###                                                      -- E.J. Dijkstra



stipulate
    include package   threadkit;                        # threadkit     is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.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   image_imp
    : (weak)  Image_Imp                                 # Image_Imp     is from   src/lib/x-kit/widget/lib/image-imp.api
    {
        exception BAD_NAME;

        Plea_Mail
          #
          = GET_IMAGE   qk::Quark
          | ADD_IMAGE  (qk::Quark, xc::Cs_Pixmap_Old)
          ;

        Reply_Mail
          #
          = IMAGE  xc::Cs_Pixmap_Old
          | OKAY
          | ERROR
          ;

         Image_Imp
             =
             IMAGE_IMP
               { 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;
            );

        Image_Table
            =
            qht::Hashtable( xc::Cs_Pixmap_Old );

        fun make_image_imp inits
            =
            {   exception NOT_FOUND;
                #
                image_table
                    =
                    qht::make_hashtable  { size_hint => 32,  not_found_exception => NOT_FOUND }
                    :
                    Image_Table;

                image_ins  = qht::set image_table;
                image_find = qht::find image_table;

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

                fun do_plea (GET_IMAGE n)
                        =>
                        case (image_find n)
                            #
                            NULL  => ERROR; 
                            THE i => IMAGE i;
                        esac;

                    do_plea (ADD_IMAGE (q, i))
                        =>
                        case (image_find q )
                            #
                            NULL => { image_ins (q, i);   OKAY; };
                            THE _ => ERROR;
                        esac;
                end;

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

                apply image_ins inits;

                xlogger::make_thread  "image_imp"  loop;

                IMAGE_IMP { plea_slot, reply_slot };
            };

        fun get_image (IMAGE_IMP { plea_slot, reply_slot } ) name
            =
            {   put_in_mailslot  (plea_slot,  GET_IMAGE name);
                #
                case (take_from_mailslot  reply_slot)
                    #
                    IMAGE i => i;
                    _       => raise exception BAD_NAME; 
                esac;
            };

        fun add_image (IMAGE_IMP { plea_slot, reply_slot } ) arg
            =
            {   put_in_mailslot  (plea_slot,  ADD_IMAGE arg);
                #
                case (take_from_mailslot  reply_slot)
                    #
                    OKAY => ();
                    _    => raise exception  BAD_NAME;
                esac;
            };

    };

end;