PreviousUpNext

15.4.1269  src/lib/tk/src/tests+examples/tag_ex.pkg

/*  Project: Tk: A Tk Toolkit for Mythryl
 *  Author: Stefan Westmeier, University of Bremen
 *  Purpose of this file: Tag example
 */

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



###                "I've seen things you people wouldn't believe.
###
###                "Attack ships on fire off the shoulder of Orion.
###
###                "I watched C-beams glitter in the dark near the Tannhauser gate.
###
###                "All those moments will be lost in time, like tears in rain.
###
###
###                "Time to die."
###
###                                              -- Bladerunner



package tag_ex

: (weak)     api {  go:  Void -> String; }

{

    include basic_utilities;
    include tk;



    # Main Window 
    #
    main_window_id = make_tagged_window_id("hauptfenster");
    t1 = make_tagged_widget_id "t1";
    fat = make_text_item_id();


    my  menu: Widget
        = 
        {
            quit      = make_simple_callback (fn () = close_window main_window_id);

            fun del_but tn
                =
                make_simple_callback (fn () =  delete_text_item t1 tn);

            fun del_tag tn
                =
                make_callback (fn (_: Tk_Event) =  delete_text_item t1 tn);

            fun col_tag tn co
                =
                make_callback (fn (_: Tk_Event) =  add_text_item_traits 
                                                 t1 tn [BACKGROUND co]);
            new_but
                =
                fn ()
                    =
                    {   tn = make_text_item_id ();

                        TEXT_ITEM_WIDGET {
                            text_item_id    => tn,
                            mark     => MARK_END,
                            subwidgets  =>
                                       PACKED [
                                         BUTTON {
                                             widget_id    => make_widget_id(),
                                             packing_hints => [FILL ONLY_X],
                                             traits  => [TEXT "Delete Me",
                                                            CALLBACK (del_but tn)],
                                             event_callbacks => []
                                         }
                                     ],
                                 traits => [],
                                 event_callbacks => []
                        };
                    };

            new_tag = fn () =
                         { 
                             tn = make_text_item_id();

                             TEXT_ITEM_TAG { text_item_id => tn,
                                   marks  => [(MARK (2, 11), MARK_TO_END 2)],
                                   traits => [BACKGROUND BLUE,   BORDER_THICKNESS 2,   RELIEF RAISED],
                                   event_callbacks => [  EVENT_CALLBACK (BUTTON_PRESS NULL, del_tag tn),
                                                         EVENT_CALLBACK (ENTER, (col_tag tn RED)),
                                                         EVENT_CALLBACK (LEAVE, (col_tag tn BLUE))] };
                         };

            new_sel = fn () =
                         { 
                             tn = make_text_item_id();

                             TEXT_ITEM_TAG { text_item_id=>tn,
                                   marks=> read_selection t1,
                                   traits => [BACKGROUND GREEN,
                                            BORDER_THICKNESS 2, RELIEF RAISED],
                                   event_callbacks=> [EVENT_CALLBACK (BUTTON_PRESS NULL, del_tag tn),
                                              EVENT_CALLBACK (ENTER, (col_tag tn RED)),
                                              EVENT_CALLBACK (LEAVE, (col_tag tn GREEN))] };
                         };

            add_but = make_simple_callback (fn () = add_text_item
                                    t1
                                    (new_but()));

            add_tag = make_simple_callback (fn () = add_text_item
                                    t1
                                    (new_tag()));

            add_sel = make_simple_callback (fn () = add_text_item
                                    t1
                                    (new_sel()));

            fun print_tags wid
                =
                fn ()
                    =
                    {
                        widg = get_widget wid;
                        ans  = get_text_widget_text_items widg;
                        ans' = list::filter (fn TEXT_ITEM_TAG _ => TRUE;  _ => FALSE; end ) ans;

                        fun prt_an_pos an
                            =
                            {
                                tn = get_text_item_id an;
                                ms = get_tcl_text_item_marks wid tn;

                                file::write (file::stderr, "Tag: " $ make_text_item_id_string (tn) $ "\n");
                                file::write (file::stderr, "\t" $ show_mark_list (ms) $ "\n");
                            };

                        apply prt_an_pos ans';
                    };



            FRAME { widget_id=>make_widget_id(),
                  subwidgets => PACKED [
                                MENU_BUTTON { widget_id=>make_widget_id(),
                                      mitems => [MENU_COMMAND([TEXT "Quit", CALLBACK quit])],
                                      packing_hints => [PACK_AT LEFT],
                                      traits => [TEXT "File", TEAR_OFF FALSE],
                                      event_callbacks => [] },

                           MENU_BUTTON { widget_id=>make_widget_id(),
                                      mitems => [MENU_COMMAND([TEXT "Add Button", CALLBACK add_but]),
                                              MENU_COMMAND([TEXT "Add Tag",     CALLBACK add_tag]),
                                              MENU_COMMAND([TEXT "Conv Sel",    CALLBACK add_sel]),
                                              MENU_COMMAND([TEXT "Clear Text", 
                                                       CALLBACK (make_simple_callback (fn ()=> clear_text t1; end ))]),
                                              MENU_COMMAND([TEXT "Insert New Text", 
                                                       CALLBACK (make_simple_callback (fn ()=> insert_text_end t1 
                                                         ("No never, no never no more\n"$
                                                          "will I trust the Elves of Dunsinore\n"); end ))]),
                                              MENU_SEPARATOR,
                                              MENU_COMMAND([TEXT "Print Tags",
                                                       CALLBACK (make_simple_callback (print_tags t1))])
                                             ],
                                     packing_hints => [PACK_AT LEFT],
                                     traits => [TEXT "Item", TEAR_OFF FALSE],
                                     event_callbacks => [] },

                           MENU_BUTTON
                             { widget_id=>make_widget_id(),
                               mitems => [ MENU_CHECKBUTTON [TEXT "Writeable",
                                           VARIABLE "TWState",
                                           CALLBACK (make_simple_callback (fn ()= case (get_tcl_var_value "TWState")   
                                                                                 "0" => set_tcl_text_widget_read_only_flag t1 TRUE;
                                                                                 _  => set_tcl_text_widget_read_only_flag t1 FALSE;
                                                                             esac
                                                                            )
                                               )
                                         ],
                               MENU_SEPARATOR,
                               MENU_COMMAND([TEXT "Clear Text+Annotations", 
                                         CALLBACK (make_simple_callback (fn ()=> clear_livetext t1; end ))]),
                               MENU_COMMAND([TEXT "Replace Text+Annotations", 
                                         CALLBACK (make_simple_callback (fn ()=> {
                                                             t  = "Neuer Text\n";
                                                             tg = TEXT_ITEM_TAG { text_item_id=>fat,
                                                                            marks => [(MARK (1, 0), MARK (1, 5))],
                                                                            traits=> [BACKGROUND RED, BORDER_THICKNESS 2, RELIEF RAISED], event_callbacks=> [] };

                                                              replace_livetext t1 (LIVE_TEXT { len=>NULL, str=>t, text_items => [tg] } );


                                                  }; end 
                                                      ))])
                               ],
                              packing_hints => [PACK_AT LEFT], traits => [TEXT "Widget State", TEAR_OFF FALSE], event_callbacks => [] }
                   ],
                  packing_hints => [FILL ONLY_X],
                  traits => [RELIEF RAISED, BORDER_THICKNESS 2],
                  event_callbacks => [] };
        };

    my board:  Widget   = 
        {
            t  = "\nDies ist ein Tag-Test\n\nUnd noch ein Test ...\n";
            tg = TEXT_ITEM_TAG { text_item_id=> fat, marks=> [(MARK (2, 9), MARK (2, 21))],
                           traits=> [BACKGROUND RED, BORDER_THICKNESS 2, RELIEF RAISED],
                           event_callbacks => [EVENT_CALLBACK (BUTTON_PRESS NULL, make_callback (fn _ => 
                                       { file::write (file::stdout, 
                                    "Button press in annotation\n");
                                        add_text_item_traits t1 fat [BACKGROUND BLUE];}; end )),
                                     EVENT_CALLBACK (BUTTON_RELEASE NULL, make_callback (fn _ => 
                                                                         { file::write (file::stdout, "Button release in annotation\n");
                                                                          add_text_item_traits t1 fat [BACKGROUND RED];}; end )),
                                     EVENT_CALLBACK (ENTER, make_callback (fn _ => 
                                                            file::write (file::stdout, "text_item entered\n"); end ))] };

            wg1 =
                TEXT_ITEM_WIDGET { text_item_id    => make_text_item_id(),
                         mark     => MARK (3, 0),
                         traits  => [],
                         event_callbacks => [],
                         subwidgets  => PACKED [
                                           BUTTON {
                                               widget_id    => make_widget_id(),
                                               packing_hints => [FILL ONLY_X],
                                               traits  => [TEXT "Push Me",
                                                             CALLBACK null_callback],
                                               event_callbacks => []
                                           },
                                           BUTTON {
                                               widget_id    => make_widget_id(),
                                               packing_hints => [FILL ONLY_X],
                                               traits  => [TEXT "Push Me", 
                                                             CALLBACK null_callback],
                                               event_callbacks => []
                                           }
                                       ]
                };

            wg2
                =
                TEXT_ITEM_WIDGET {
                    text_item_id    => make_text_item_id(),
                    mark     => MARK (3, 0),
                    traits  => [],
                    event_callbacks => [],
                    subwidgets => PACKED [
                                     BUTTON {
                                         widget_id    => make_widget_id(),
                                         packing_hints => [FILL ONLY_X],
                                         traits  => [TEXT "Push Me",
                                                     CALLBACK
                                                     (make_simple_callback
                                                      (fn () => (); end  ))],
                                         event_callbacks => []
                                     }
                                 ]
                };

            at  = LIVE_TEXT { len=>NULL, str=>t, text_items => [tg, wg1, wg2] };

            FRAME {
                widget_id => make_widget_id (),
                subwidgets   => PACKED [
                                TEXT_WIDGET {
                                    widget_id  => t1,
                                    scrollbars => AT_LEFT,
                                    live_text=>at,
                                    packing_hints => [],
                                    traits => [ACTIVE FALSE],
                                    event_callbacks => []
                                }
                            ],
                packing_hints => [PACK_AT LEFT, FILL ONLY_X],
                event_callbacks => [],
                traits => [   WIDTH 200,
                             HEIGHT 200,
                             RELIEF RAISED,
                             BORDER_THICKNESS 2
                         ]
            };
        };
                                                                                    my
    area = [ menu, board ];
                                                                                    my 
    act  = make_simple_callback (fn () => (); end );



                                                                                    my
    initwin = [   make_window {
                      window_id       => main_window_id, 
                      traits          => [WINDOW_TITLE "Tag Example"],
                      subwidgets      => PACKED area, 
                      event_callbacks => [],
                      init            => act
                  }
              ];


                                                                                    my
    go   =   fn () =  start_tcl_and_trap_tcl_exceptions initwin;


};



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext