PreviousUpNext

15.4.1264  src/lib/tk/src/tests+examples/ex2.pkg


# Compiled by:
#     src/lib/tk/src/tests+examples/sources.sublib

#  *********************************************************************** 
#                                                                          
#  Project: sml/Tk: an Tk Toolkit for sml                                  
#  Author: Burkhart Wolff, University of Bremen                            
#  Date: 25.7.95                                                           
#  Purpose of this file: Small example                                     
#                                                                          
#  *********************************************************************** 



###                   "Don't be too confused.
###                    It is not your fault.
###                    The San Andreas is your fault."
###
###                               -- Sandy Stone



package ex2 {

    stipulate

        include tk;
        include basic_utilities; 

    herein

        exception NO_FILE  String;

                                                                                my
        warn  = make_tagged_window_id "warning";                                my
        main  = make_tagged_window_id "main";                                   my
        enter = make_tagged_window_id "entername";                              my
        e1    = make_tagged_widget_id "e1";                                     my
        liste = make_tagged_widget_id "liste";                                  my
        state_wid = make_tagged_widget_id "statewid";

        fun prs s
            =
            file::write (file::stdout, s);

        fun writeln s
            =
            prs (s + "\n");


        #  Cursor Get Callback on Listboxes and TextWidgets 

        fun getcur wid
            =
            fn (_)=> { my MARK (n, m) = get_tcl_cursor wid;
                                    file::write (file::stdout, "POSITION :" + int::to_string n +
                                                        "." + int::to_string m + "\n"); 
                                  }; end ;


        #  Warning Window 

                                                                                my
        nogoon   = make_simple_callback (fn () => close_window warn; end );

        fun nobut   msg yes
            =
            BUTTON {
                widget_id    => make_widget_id(),
                packing_hints => [PACK_AT RIGHT, FILL ONLY_X, EXPAND TRUE],
                traits  => [TEXT "NO",  CALLBACK  nogoon], event_callbacks => []
            };

        fun message1 msg yes
            =
            LABEL {
                widget_id => make_widget_id(),
                packing_hints => [FILL ONLY_X, EXPAND TRUE],
                traits => [TEXT msg, RELIEF FLAT, WIDTH 25],
                event_callbacks => []
            };

        fun yes_button  msg yes
            =
            BUTTON {
                widget_id => make_widget_id(),
                packing_hints => [PACK_AT LEFT,  FILL ONLY_X, EXPAND TRUE],
                traits => [TEXT "YES", CALLBACK yes],
                event_callbacks => []
            };

        fun yesno   msg yes
            =
            FRAME {
                widget_id => make_widget_id(),
                subwidgets => PACKED [yes_button msg yes, nobut msg yes],
                packing_hints => [],
                traits => [],
                event_callbacks => []
            };

        fun tree2   msg yes
            =
            [message1 msg yes, yesno msg yes];


        fun warning_window msg yes
            =
            make_window {
                window_id  => warn, 
                traits => [WINDOW_TITLE "Warning",
                                                TRANSIENTS_LEADER (THE main)], 
                subwidgets => PACKED (tree2 msg yes),
                event_callbacks => [],
                init => null_callback
            };

        fun warning msg yes
            =
            open_window (warning_window msg yes);



        #  Enter Window 
                                                                                my
        n_label
            =
            LABEL {
                widget_id => make_widget_id (),
                packing_hints  => [PACK_AT LEFT],
                traits   => [TEXT "name:"],
                event_callbacks => []
            };

        fun input enteraction
            = 
            {                                                                 my
                mrs
                    =
                    fn (_)
                       =>
                       {                                                      my
                           nm = get_tcl_text e1;
                       
                           enteraction nm ();
                           close_window enter;
                       }; end ; 
            
                TEXT_ENTRY {
                    widget_id => e1,
                    packing_hints => [],
                    traits => [WIDTH 20],
                    event_callbacks => [EVENT_CALLBACK (KEY_PRESS "Return", mrs)]
                };
            };

        fun treesize enteraction
            =
            [n_label, input enteraction];

        fun enterwin enteraction
            =
            make_window {
                window_id => enter, 
                traits => [   WINDOW_TITLE "Please enter name",
                             TRANSIENTS_LEADER (THE main)
                         ], 
                subwidgets => PACKED (treesize enteraction),
                event_callbacks => [],
                init => null_callback
            };



        #  Main Window 
                                                                                my
        yesquit  =   make_simple_callback (fn () => close_window main; end ); 
                                                                                my
        entername
            = 
            { fun inputok nm
                    =
                    fn () => insert_text_end liste nm; end ;                            my

                cmd        = make_simple_callback (fn () => open_window (enterwin inputok); end );
            
                MENU_COMMAND [TEXT "Enter name", CALLBACK (cmd)];
            };
                                                                                my
        m1 = make_widget_id();                                                   my

        insertmenue
            =
            MENU_BUTTON {
                widget_id => m1,
                mitems => [entername],
                packing_hints => [PACK_AT LEFT],
                traits => [TEXT "Special", TEAR_OFF TRUE],
                event_callbacks => []
            };
                                                                                my
        list = LIST_BOX {
                   widget_id => liste,
                   scrollbars => AT_RIGHT,
                   packing_hints => [PACK_AT LEFT, PACK_AT TOP, FILL ONLY_Y],
                   traits => [RELIEF RAISED],           
                   event_callbacks => [EVENT_CALLBACK (DOUBLE (BUTTON_PRESS (THE 1)), 
                                                 getcur liste)]
               };
                                                                                my
        MARKLIST
            =
            REF([] : List ((Mark, Mark)) );
                                                                                my
        statewid
            = 
            TEXT_WIDGET {
                widget_id => state_wid,
                scrollbars => AT_RIGHT,
                live_text => empty_livetext,
                packing_hints => [PACK_AT LEFT, FILL XY],
                traits => [RELIEF RAISED, BORDER_WIDTH 2],
                event_callbacks => [EVENT_CALLBACK (DOUBLE (BUTTON_PRESS (THE 1)), getcur state_wid),
                              EVENT_CALLBACK (DOUBLE (BUTTON_PRESS (THE 3)),
                                     fn _ => { t = get_tcl_selection_window();
                                                 m = get_tcl_selection_range state_wid;
                                             
                                                 case t   
                                                     NULL => 
                                                         writeln("SEL");
                                                    THE (window, wid) => 
                                                         writeln (make_window_string (window) + 
                                                                 make_widget_string (wid)); esac;
                                                         MARKLIST := m;
                                             }; end ),
                              EVENT_CALLBACK (DOUBLE (BUTTON_PRESS (THE 2)),
                                     fn (_) => file::write (file::stdout,
                                                             get_tcl_text state_wid); end )]
            };
                                                                                my
        yesreset = null_callback;
                                                                                my
        loadfile
            = 
            { fun more str
                    =
                    {                                                         my
                        in_str = (   file::open_for_read str
                                     except
                                         (winix__premicrothread::RUNTIME_EXCEPTION (err, _))
                                             =
                                             raise exception (NO_FILE ("Can't open file " + str + ": " + err))
                                 )
                                 except
                                     io::io { name, ... } = raise exception (NO_FILE name);





                                  while (not (file::end_of_stream in_str)) {
                                      insert_text_end state_wid (file::read_n (in_str, 100));
                                  };
                                };

                 fun do_it nm
                     =
                     fn () => { clear_text state_wid;more nm;}; end ;
             
                 make_simple_callback (fn () => (open_window (enterwin do_it)); end );
             };

        load     = MENU_COMMAND [TEXT "Load", CALLBACK loadfile];

        quitgame = make_simple_callback (fn () => warning "really quit?"  yesquit; end );

        quit     = MENU_COMMAND([TEXT "Quit", CALLBACK quitgame]); 

        m2 = make_widget_id();

        ctrmenue = MENU_BUTTON {
                       widget_id => m2,
                       mitems => [load, MENU_SEPARATOR, quit],
                       packing_hints => [PACK_AT LEFT],
                       traits => [TEXT "Control", TEAR_OFF TRUE],
                       event_callbacks => []
                   };

        space  = FRAME {
                     widget_id => make_widget_id(),
                     subwidgets => PACKED [],
                     packing_hints => [PACK_AT LEFT, FILL XY],
                     traits => [],
                     event_callbacks => []
                 };
                                                                                my
        menu  = FRAME {
                    widget_id => make_widget_id(),
                    subwidgets => PACKED [ctrmenue, insertmenue, space],
                    packing_hints => [],
                    traits => [],
                    event_callbacks => []
                };
                                                                                my
        board  = FRAME {
                     widget_id => make_widget_id(),
                     subwidgets => PACKED [statewid, list],
                     packing_hints => [PACK_AT BOTTOM, FILL XY],
                     traits => [],
                     event_callbacks => []
                 };
                                                                                my
        tree1  = [menu, board];
                                                                                my
        initwin  = [   make_window {
                           window_id => main, 
                           traits  => [WINDOW_TITLE "Transformation System"], 
                           subwidgets => PACKED tree1,
                           event_callbacks => [],
                           init => null_callback
                       }
                   ];

        #  Launching and Shutting System 

#       open_window (hd initwin); 
#
#       start_tcl     initwin;
#       start_tcl_exn initwin;
#
#       Cursor-Position fuer TextWidgets:
#       .text index insert
#
#       Cursor-Position fuer Listboxes:
#        bind .dateien <Double-Button-1> {
#          puts [.dateien curselection]
#       }


                                                                                my 
        do_it =   fn () = start_tcl_and_trap_tcl_exceptions initwin;            my 
        go = do_it;
    end;
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext