PreviousUpNext

15.4.1280  src/lib/tk/src/toolkit/generate-gui-g.pkg

## generate-gui-g.pkg
## Author: cxl
## (C) 1996, 1998, Bremen Institute for Safe Systems, Universitaet Bremen
## **************************************************************************

# Compiled by:
#     src/lib/tk/src/toolkit/sources.sublib



# ***************************************************************************
# A generic graphical user interface. 
#
# See <a href=file:../../doc/manual.html>the documentation</a> for more
# details.  
#
# "tests+examples/simpleinst.pkg" contains a small example of how to
# use this package.
# **************************************************************************



###             "I honestly think it is better
###              to be a failure at something you love
###              than to be a success at something you hate."
###
###                                      -- George Burns



generic package generate_gui_g (package appl: Application;)             # Application   is from   src/lib/tk/src/toolkit/appl.api

: (weak)  Generated_Gui                                                 # Generated_Gui is from   src/lib/tk/src/toolkit/generated-gui.api

{
    include tk;
    include basic_utilities; 




    default_printmode= { mode => print::long,
                           printdepth=>100,
                           height=>NULL,
                           width=>NULL };  #  the value is temporary 

    fun debugmsg msg = debug::print 11 ("GenGUI: " + msg);



    #  the construction area frame widget id 
    ca_frame_id  = make_tagged_widget_id("ca");
    #  the widget id of the canvas all the items are placed on 

    #  flag indicating wether the construction area is currently open 
    ca_open     = REF (NULL: Null_Or( appl::Part_Ilk ));

    fun open_con_area {
            window,
            obj,
            replace_object_action,
            outline_object_action
        }
        =
        {
            #  id of the window holding the con/area widgets 

            cawin =  appl::conf::one_window
                     ??  window
                     ::  make_window_id ();

            # event_callbacks for the con area while open:

            fun ca_enter wsp ev
                =
                {   dropobs = appl::cb_objects_rep (appl::clipboard::copy ev)();
                    oot     = appl::objlist_type dropobs;
                
                    case oot
                         THE ot => appl::area_ops ot wsp dropobs;
                         NULL => ();
                    esac; 
                }
                except
                    appl::clipboard::EMPTY = ();

            fun ca_namings wsp
                = 
                [EVENT_CALLBACK (ENTER, ca_enter wsp)];

            # event_callbacks for the con/area while closed:

            ca_closed_namings
                =
                [EVENT_CALLBACK (ENTER, k0)];

            fun close_con_area nu_ob
                =
                {   ca_open := NULL;

                    replace_object_action nu_ob;

                   if appl::conf::one_window  

                       apply (delete_widget o get_widget_id) 
                           (get_subwidgets (get_widget ca_frame_id));
                   else 
                       close_window cawin;
                   fi;
                };
        
            if  (    (appl::is_constructed (appl::part_type obj)) 
                and  not (null_or::not_null *ca_open)
                )

                    # Get the con/area widgets from the application:
                    # 
                    my (wsp, wwidgs, init) = appl::area_open (cawin, obj, 
                                                             close_con_area);

                    # Add con/area event_callbacks to widgets:
                    # 
                    wwidgs = map (fn w=> update_widget_event_callbacks w 
                                               ((ca_namings wsp)@
                                                (get_widget_event_callbacks w)); end )
                                                 wwidgs;                         
                 
                     outline_object_action ();

                     ca_open := THE obj;                     # Set flag.

                     if appl::conf::one_window

                          apply (add_widget window ca_frame_id) wwidgs;
                          add_event_callbacks ca_frame_id (ca_namings wsp);
                          init();
                     else 
                          open_window (
                              make_window {
                                  window_id => cawin, 
                                  subwidgets => PACKED wwidgs, 
                                  event_callbacks => [],
                                  init,
                                  traits => [ WINDOW_TITLE (appl::conf::ca_title 
                                                     (appl::string_of_name
                                                             (appl::name_of obj)
                                                             (default_printmode))),
                                            WIDE_HIGH_X_Y (THE (appl::conf::ca_width,
                                                             appl::conf::ca_height),
                                                        appl::conf::ca_xy),
                                            WINDOW_GROUP window
                                          ]
                              }
                          );
                     fi;


            else
                debugmsg "Not a primary object, or ConArea already open.";
            fi;
     };
 
    #  And a function to check that 
    fun is_open ob
        =
        case *ca_open
          
             NULL    => FALSE; 
             THE ob2 => case (appl::ord (ob, ob2))
                          
                                     EQUAL => TRUE;
                                    _     => FALSE;
                        esac;
        esac;


    
    package notepadappl
        = 
        package { 
           include appl;

           object_action = open_con_area;

           fun activate_action { pos=>(x, y) } = ();

           is_locked_object = is_open;

        };

    package notepad = notepad_g (package appl = notepadappl;);

    include notepad;


        
    fun main_wid window
        =
        {   ass_area =  notepad::main_wid  window;
        
            if appl::conf::one_window

                FRAME {
                    widget_id       => make_widget_id(),
                    packing_hints   => [],
                    event_callbacks => [],
                    traits          => [], 

                    subwidgets => PACKED [
                                  ass_area,
                                  FRAME {
                                      widget_id       => ca_frame_id, 
                                      subwidgets      => PACKED [], 
                                      packing_hints   => [FILL ONLY_X, PACK_AT BOTTOM],
                                      event_callbacks => [],
                                      traits          =>  [   HEIGHT appl::conf::ca_height,
                                                             WIDTH  appl::conf::ca_width
                                                         ]
                                  }
                              ]
                };
           else
               ass_area;
           fi;
        };


    fun init state
        = 
        {   notepad::init  state;
            ca_open   := NULL;
            appl::area_init ();
        };

    Cb_Objects     = appl::Cb_Objects;
    cb_objects_rep = appl::cb_objects_rep;
    cb_objects_abs = appl::cb_objects_abs;

};





Comments and suggestions to: bugs@mythryl.org

PreviousUpNext