PreviousUpNext

15.4.1263  src/lib/tk/src/tests+examples/ex1.pkg


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

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

package example1 {

    stipulate
        include tk;
    herein

        main = make_tagged_window_id "main";
        warn = make_tagged_window_id "warning";
        e1   = make_tagged_widget_id "e1";
        enter_name = make_tagged_window_id "entername";
        menu = make_tagged_widget_id "menu";

        yesquit  = make_simple_callback (fn () => close_window main; end ); 
        nogoon   = make_simple_callback (fn () => close_window warn; end );


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

        fun message1 msg yes no
            =
            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 no
            =
            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 no
            =
            FRAME {
                widget_id => make_widget_id(),
                subwidgets => PACKED [yes_button msg yes no, 
                                                      nobut msg yes no],
                packing_hints => [],
                traits => [],
                event_callbacks => []
            };

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

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

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



        /* Enter Window */                                                      my
        inputok
            =
            fn ()
                =>
                {                                                             my
                    nm = make_title (get_tcl_text e1); 
                
                    change_title main nm ;
                    close_window enter_name; 
                }; end ;
                                                                                my 
        n_label
            =
            LABEL {
                widget_id => make_widget_id(), 
                packing_hints => [PACK_AT LEFT], 
                traits => [TEXT "name:"], 
                event_callbacks => []
            };

                                                                                my
        input
            =
            TEXT_ENTRY {
                widget_id => e1,
                packing_hints => [],
                traits => [WIDTH 20],
                event_callbacks => [ EVENT_CALLBACK (KEY_PRESS "Return", fn _=> inputok(); end )]
            };
                                                                                my 
        treesize = [n_label, input];
                                                                                my 
        enterwin = make_window {
                       window_id => enter_name, 
                        traits => [WINDOW_TITLE "Please enter name",
                                        TRANSIENTS_LEADER (THE main)], 
                        subwidgets => PACKED treesize,
                        event_callbacks => [],
                        init => null_callback
                   };
                                                                                my 
        playername = make_simple_callback (fn () => open_window enterwin; end );

        #  Main Window 
                                                                                my 
        entername= MENU_COMMAND [TEXT "Enter name", CALLBACK playername];

                                                                                my 
        player   = MENU_BUTTON { widget_id=>make_widget_id(), 
                                  mitems => [entername], packing_hints => [],
                                  traits => [TEXT "Special", MENU_UNDERLINE 0, TEAR_OFF TRUE], 
                                  event_callbacks => [] };
                                                                                my 
        yesreset = null_callback;

        fun newgame ()
            =
            warning "really reset?" yesreset nogoon;
                                                                                my 
        new      = MENU_COMMAND   [TEXT "New", 
                                   MENU_UNDERLINE 0, ACCELERATOR "Ctrl+n",
                                   CALLBACK (make_simple_callback newgame)];

        fun quitgame ()
            =
            warning "really quit?" yesquit nogoon;
                                                                                my 
        quit     = MENU_COMMAND([TEXT "Quit",  
                                 MENU_UNDERLINE 0, ACCELERATOR "Ctrl+q",
                                 CALLBACK (make_simple_callback quitgame)]); 

                                                                                my 
        game     = MENU_BUTTON { widget_id=>make_widget_id(), 
                                  mitems => [new, MENU_SEPARATOR, quit],
                                  packing_hints => [PACK_AT LEFT], 
                                  traits => [TEXT "Control", MENU_UNDERLINE 0, TEAR_OFF TRUE],
                                  event_callbacks => [] };
                                                                                my 
        menu     = FRAME {
                           widget_id => make_widget_id (),
                           subwidgets => PACKED [game, player],
                             packing_hints => [], traits => [], event_callbacks => [] };
                                                                                my 
        board
            =
            FRAME {
                widget_id       => make_widget_id (), 
                packing_hints   => [PACK_AT LEFT, FILL ONLY_X],
                subwidgets      =>  PACKED [],
                traits          => [WIDTH 200, HEIGHT 200],

                event_callbacks => [   EVENT_CALLBACK (
                                          KEY_PRESS "q",
                                          fn _ => quitgame(); end 
                                      ),
                                      EVENT_CALLBACK (
                                          CONTROL (KEY_PRESS "n"),
                                          fn _ => newgame(); end 
                                      )
                                  ]
            };
                                                                                my 
        initwin  = [   make_window {
                               window_id   => main, 
                               traits  => [ WINDOW_TITLE "Mini Example" ], 
                               subwidgets => PACKED [menu, board],
                                 event_callbacks => [],
                                 init=>null_callback
                       }
                   ];

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


    end; #  local use 

};



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext