PreviousUpNext

15.4.1301††src/lib/tk/src/toolkit/tests+examples/tsimpleinst.pkg

## tsimpleinst.pkg
## (C) 2000, Bremen Institute for Safe Systems, Universitaet Bremen
##           Albert-Ludwigs-Universitšt Freiburg
## Author: cxl&bu (Last modification by $Author: 2cxl $)

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



# ***************************************************************************
#
# Test and example program for generate_tree_gui_g.
#
# This example only knows two object types, texts and numbers. Numbers have
# four different subtypes, corresponding to the four riders of the apocalypse,
# or rather the four basic arithmetic operations. 
#
#
# Texts can be concatened by dropping one onto the other, or they can
# be edited in the construction area. Numbers can added, subtracted
# etc. by dropping them onto each other. If you drag a number object into the 
# con area, a textual representation of the number is appended to the text
# currently under construction. 
#
# There is also the possibility to import a text by calling up the
# file browser and dragging one file into the construction system. 
#
#  Use SimpleInst::go() to start. 
#
# $Date: 2001/03/30 13:40:06 $
# $Revision: 3.0 $
#
#
# **************************************************************************



###              "A table, a chair, a bowl of fruit and a violin;
###               what else does a man need to be happy?"
###
###                                -- Albert Einstein  



package tsimple_inst_appl /* : Application */

{

    stipulate

      include tk;
      include basic_utilities;

    herein     

      #  Instantiating the utility windows 

      # We have text objects and numbers. Numbers have different modes,
      # namely plus, minus, times or div.

       Objtype0 = TEXT | NUM;

       Mode    = PLUS_M | MINUS_M | TIMES_M | DIV_M;

       Part_Type = (Objtype0, Null_Or( Mode ));

      fun mode (_, m) = the m; 

       Name = Ref( String );

      fun mode_name plus_m  => "Add me";
         mode_name minus_m => "Subtract me";
         mode_name times_m => "Multiply me";
         mode_name div_m   => "Divide me"; end;


       Part_Ilk  = TEXTOBJ  (String, Ref( String ))
                     | NUMBER   (Int, Ref( Mode ), Ref( String ));

      fun ord (textobj x, number y)  => LESS;
         ord (textobj (_, x), textobj (_, x')) => string::compare (*x,*x');
         ord (number (_, _, x), number (_, _, x')) => string::compare (*x,*x');
         ord (number x, textobj y)  => GREATER; end;

      fun name_of (textobj (_, x)) => x;
          name_of (number (_, _, x)) => x;
      end;

      fun rename s (textobj (_, x)) => (x:=s);
          rename s (number (_, _, x)) => (x:=s);
      end;

      fun reset_name _ = ();

      fun string_of_name s t = *s;

      fun part_type (textobj _) => (text, NULL);
          part_type (number (_, m, _))  => (num, THE *m);
      end;

      fun modes (text, _) => [];
          modes (num, _)  => [plus_m, minus_m, times_m, div_m];
      end;

      fun sel_mode (textobj _) => plus_m;  #  Disnae matter what we return here 
          sel_mode (number(_, m, _))=> *m;
      end;

      fun set_mode (textobj _, _)=> ();
          set_mode (number(_, m, _), nu)=>  m:= nu;
      end;


      fun objlist_type ls
          = 
          {   fun forall p
                  =
                  not o (list::exists (not o p));

              if (forall (fn oo =  fst (part_type oo) == text) ls )
                   THE (text, NULL);
              elif (forall (fn oo =  fst (part_type oo) == num) ls )
                        THE (num, THE plus_m);
              else NULL;
              fi;
          };

       Objectlist = Void -> List( Part_Ilk );
       Cb_Objects = Objectlist;

      fun  cb_objects_abs x = x;
      fun  cb_objects_rep x = x;

       New_Part  = (Part_Ilk, ((tk::Coordinate, tk::Anchor_Kind)));

      fun is_constructed (text, _)  => TRUE;
         is_constructed (num, _)   => FALSE; end;

      fun get_name (textobj(_, nm))    => *nm;
         get_name (number(_, _, nm)) => *nm; end;

      fun sel_name ob = THE (get_name ob);

      fun label_action { obj, cc } =
          { fun set (textobj(_, nm)) nuname   => { nm:= nuname; cc nuname;};
                 set (number(_, _, nm)) nuname => { nm:= nuname; cc nuname;}; end;
            uw::enter_line { title=>"Renaming object", default=>"",
                           prompt=>"Please enter new name: ",
                           width=> 20, cc=>set obj };
          };

      create_actions = [];

      fun set_name (textobj(_, nm), nuname) => nm:= nuname;
         set_name (number(_, _, nm), nuname)  => nm:= nuname; end;

      fun sel_text   (textobj (t, _))= t;
      fun sel_number (number (m, _, _)) = m;

      fun outline _ = FALSE; #  never outline 

      fun icon (ot, m) =
          {
              fun iconnm (text, _)     => "note.gif";
                 iconnm (num, THE plus_m)  => "number.gif";
                 iconnm (num, THE minus_m) => "nummin.gif";
                 iconnm (num, THE times_m) => "numtim.gif";
                 iconnm (num, THE div_m)   => "numdiv.gif"; end;

              icons::get_icon (get_lib_path()$"/tests+examples/icons", 
                            iconnm (ot, m));
          };

     #  Configuring generate_gui_g 

     package conf = 
         package {
             width         = 500;
             height        = 300;
             ca_width       = 350;
             ca_height      = 300;
             ca_xy          = THE (50, 470);
             fun ca_title nm    = "Edit text: " $ nm;

             icon_name_width = 60;
             icon_name_font  = tk::SANS_SERIF [tk::SMALL];

             background    = GREY;

             move_opaque    = TRUE;

             one_window     = TRUE;

             fun trashcan_icon ()= icons::get_icon (get_lib_path()$"/icons",
                                                  "trashcan.gif");
             trashcan_coord = (width - 50, (height div 2) - 50);         

             delta         = 70;

         };

      #  The standard operations: show & info 

      fun show (textobj (tx, nm)) => 
          uw::display { title=> *nm, width=> 40, height=> 20,
                     text=> string_to_livetext tx, cc=> fn _ => (); end  };
         show (number (n, _, nm)) =>
          uw::display { title=> *nm, width=> 6, height=> 3,
                     text=> string_to_livetext ("Value:  " $ (int::to_string n)),
                     cc=> fn _ = ()  };
      end;

      fun stat   (textobj (tx, nm)) => 
          { fun count p = list::length o (list::filter p);
              tc = explode tx;
              nl = count string_util::is_linefeed tc;
              nc = list::length tc;
              nspc = count char::is_space tc;
              na = ((count char::is_alpha tc) * 100) div nc;
              st = "\nNumber of lines:  " $ (int::to_string nl) $
                       "\nNumber of chars:  " $ (int::to_string nc) $
                       "\nNumber of spaces: " $ (int::to_string nspc) $
                       "\nPercentage of alphanumerical char's: " $
                          (int::to_string na)$"\n";
            uw::display { title=> "Statistics for " + *nm,
                         width=> 40, height=> 20,
                         text=> string_to_livetext st, cc=> fn _ => (); end  };
          };
         stat  (number (n, _, nm))=> 
          { st= "The number has " + (int::to_string ((size (int::to_string n))-1)) + 
                                         " digits.\n";
           uw::display { title=> "Statistics for " +  *nm,
                        width=> 40, height=> 20,
                        text=> string_to_livetext st, cc=> fn _ => (); end  };
          }; end;


      fun std_ops _  = [(show, "Show"), (stat, "Info")];


      fun delete _ = ();


      #  Initially appearing objects. 

      fun init () =  #  oldfashioned initialization . . . 
          [(number (2, REF plus_m, REF "2"), ((10, 10), SOUTH)),
           (number (4, REF plus_m, REF "4"), ((10, 10), EAST)),
           (number (5, REF plus_m, REF "5"), ((10, 10), SOUTH)),
           (textobj("Bring me my bow of burning gold!\n" + 
                    "Bring me my arrows of desire!\n" + 
                    "Bring me my spear! O clouds unfold!\n" + 
                    "Bring me my chariot of fire!\n", 
                    REF "Jer'lem 1"), ((100, 10), CENTER)),
           (textobj("I will not cease from mental fight\n" + 
                    "Nor shall my sword sleep in my hand\n" + 
                    "Till we have built Jerusalem\n" + 
                    "In England's green and pleasant land\n",
                    REF "Jer'lem 2"), ((100, 10), SOUTH))];

      fun mon_ops _ = [];

      #  For texts, there is just one binary operation: concatenation 
      fun tconc (t1, wh, [], cc_newop) => cc_newop (t1, (wh, SOUTH));
         tconc (t1, wh, t,  cc_newop) => 
                     cc_newop (textobj (string::join "\n" 
                                              (map sel_text (t1 . t)),
                                         REF  (string::join " and " 
                                              (map get_name (t1 . t)))),
                               (wh, SOUTH)); end;

      fun numop (number (n, m, _), wh, ls, cc_newop) =
          { fun appl_op [] => n;
                 appl_op ((number (n, m, _)) . ns) => 
                  case *m    plus_m  => (appl_op ns)+n;
                            minus_m => (appl_op ns)-n;
                            times_m => (appl_op ns)*n;
                            div_m   => (appl_op ns) div n; esac; end;
              nunum = appl_op ls; 
            cc_newop (number (nunum, m, REF (int::to_string nunum)), (wh, SOUTH));
          };


      fun bin_ops ((text, _), (text, _)) => THE tconc;
         bin_ops ((num, _), (num, _))   => THE numop;
         bin_ops (_, _)               => NULL; end;


      # The Construction Area.
      # 
      # The Construction Area essentially consists of a text widget
      # which can be used to edit the text. If another text is dragged
      # down from the manipulation area, it will appended at the end.


      fun tx_id ws_id
          =
          make_sub_widget_id (ws_id, "xTxEd");

      Ca = Widget_Id;

      join_cr = string::join "\n"; 

      fun area_ops (text, _) wid ls => 
          tk::set_text_end (tx_id wid) (join_cr (map sel_text ls)); 
         area_ops (num, _) wid ls =>
          tk::set_text_end (tx_id wid) (join_cr (map (int::to_string o sel_number) ls));
      end;



      fun area_open (window, textobj (tx, nm), cc)
          = 
          {   ws_wid = make_widget_id();

              title
                  =
                  LABEL
                      { widget_id       => make_widget_id (),
                        packing_hints   => [PACK_AT TOP, FILL ONLY_X], 
                        traits          => [ RELIEF GROOVE,
                                             BORDER_THICKNESS 2,
                                             TEXT *nm
                                           ],
                        event_callbacks => []
                      };

              txwid
                  =
                  TEXT_WIDGET
                      {
                        widget_id       =>  tx_id ws_wid,
                        scrollbars      =>  AT_RIGHT, 
                        live_text       =>  string_to_livetext tx,
                        packing_hints   =>  [FILL XY], 
                        traits          =>  [],
                        event_callbacks =>  []
                      };

              fun close txid cc nm ()
                  = 
                  cc (textobj (tk::get_tcl_text txid, nm));

              quit = BUTTON
                         {
                           widget_id       => make_widget_id(),
                           packing_hints   => [PACK_AT RIGHT, PACK_AT BOTTOM],
                           traits          => [ TEXT "Close",
                                                CALLBACK (close (tx_id ws_wid) cc nm)
                                              ],
                           event_callbacks => []
                         };

              widgs  = [quit, txwid];                       

              ( ws_wid,
                if conf::one_window  title . widgs;
                                    else widgs; fi,
                k0
              );
          };

      area_init = fn () = ();   #  no init necessary 


     # Communicating with the Filer:
     #
     # First, we need to instantiate the clipboard: 
     #
     package clipboard = clipboard_g ( Part = Void -> List( Part_Ilk ); );

     # Instantiate the filer.
     # We need to provide it with a function to convert files to 
     # texts (file_to_part below); we'll do so by reading the file's contents
     # into the text of the object.
     #
     package filer =
         filer_g (package options = 
               package {
                 exception NO_FILE  String;
                 fun icons_path () = winix__premicrothread::path::cat (tk::get_lib_path(),
                                                    "icons/filer");
                 icons_size = (40, 10);
                 default_pattern = NULL;
                 fun root () = NULL;
                 default_filter = NULL;
                 package conf= filer_default_config;    # filer_default_config  is from   src/lib/tk/src/toolkit/filer_default_config.pkg
                 package clipboard= 
                     package { #  we have to insert a closure here 
                          Part = List( Part_Ilk );
                         fun  put obs ev cb = 
                             clipboard::put (fn ()=> obs; end ) ev cb;
                     };
                 filetypes =
                 {
                   fun file_to_part { dir:   String,
                                   file:  String  } =
                   {
                     filenm= "/" + winix__premicrothread::path::make_path_from_dir_and_file { dir, file };
                     objnm = REF ("File: " + file);
                     txt  =
                     {
                         fun read_file si
                             = 
                             if (file::end_of_stream si)
                                  "";
                             else (the_else((file::read_line si), "")) + (read_file si);fi;

                         is  = file::open_for_read filenm;
                         txt = read_file is;
                         file::close_input is;

                       txt;
                     }
                     except NO_FILE f => "NoFile: " + f; end ;

                     [textobj (txt, objnm)];
                   };

                   [ { ext     => [""],
                       display => THE { comment => "Default filetype",
                                        icon    => "unknown_Icon.gif",
                                        preview => NULL:   Null_Or( { dir:   String,
                                                            file:  String }
                                                          -> Void),
                                        file_to_obj => THE file_to_part } } ];
                 };
               };); 
         end;
  };

  package tsimple_inst {
      #  Begin_api my go: Void -> Void end  

      stipulate
          include tk;
      herein

          package tsimple_gui = generate_tree_gui_g (package appl= tsimple_inst_appl;);

          result = REF *tsimple_gui::gui_state;

          stipulate

              include tsimple_inst_appl;
              include tsimple_gui::tree_obj; 
          herein

              init_objects
                  = 
                  [folder((REF "texts", ((120, 20), SOUTH)),
                          [content (textobj("I will not cease from mental fight\n" + 
                                        "Nor shall my sword sleep in my hand\n" + 
                                        "Till we have built Jerusalem\n" + 
                                        "In England's green and pleasant land\n",
                                         REF "Jer'lem 2"), ((100, 10), SOUTH)),
                           content (textobj("I will not cease from mental fight\n" + 
                                        "Nor shall my sword sleep in my hand\n" + 
                                        "Till we have built Jerusalem\n" + 
                                        "In England's green and pleasant land\n",
                                         REF "Jer'lem 3"), ((100, 10), SOUTH))
                          ]),
                   content (number (2, REF plus_m, REF "2"), ((10, 10), SOUTH)),
                   content (number (4, REF plus_m, REF "4"), ((10, 10), EAST)),
                   content (number (5, REF plus_m, REF "5"), ((10, 10), SOUTH)),
                   content (textobj("Bring me my bow of burning gold!\n" + 
                            "Bring me my arrows of desire!\n" + 
                            "Bring me my spear! O clouds unfold!\n" + 
                            "Bring me my chariot of fire!\n", 
                            REF "Jer'lem 1"), ((100, 10), CENTER)),
                   content (textobj("I will not cease from mental fight\n" + 
                            "Nor shall my sword sleep in my hand\n" + 
                            "Till we have built Jerusalem\n" + 
                            "In England's green and pleasant land\n",
                            REF "Jer'lem 2"), ((100, 10), SOUTH))
                  ];
          end; #  local 
                                                                                  my
          init_guistate
              =
              (([], NULL), init_objects);

          fun quit_button window
              =
              { fun confirm_quit ()
                      = 
                      uw::confirm
                        ( "Do you really want to quit?",

                          (fn() = {   result := tsimple_gui::state();
                                      close_window window;
                                  }
                          )
                        );


                  BUTTON {
                      widget_id => make_widget_id(),
                      packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
                      traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
                                   TEXT "Quit", CALLBACK confirm_quit],
                      event_callbacks => []
                  }; 
              };

          fun new_folder_button window
              = 
              BUTTON {
                  widget_id => make_widget_id(),
                  packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
                  traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
                               TEXT "New Folder",
                               CALLBACK (fn _ => tsimple_gui::create_folder (20, 20); end )],
                  event_callbacks => []
              };

          fun filer_button window
              = 
              BUTTON {
                  widget_id => make_widget_id(),
                  packing_hints => [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
                  traits => [RELIEF RIDGE, BORDER_THICKNESS 2,
                               TEXT "Import File",
                               CALLBACK (fn _ => tsimple_inst_appl::filer::enter_file(); end )],
                  event_callbacks => []
              };
                                                                                      my
          main_window
              =
              {                                                                     my
                  wid = make_window_id ();

                  make_window {
                      window_id    => wid, 
                      traits   => [WINDOW_TITLE "tk Office 2000",
                                      WIDE_HIGH_X_Y (NULL, THE (50, 50))],
                      subwidgets  => PACKED [tsimple_gui::main_wid wid, 
                                         quit_button wid, filer_button wid,
                                         new_folder_button wid
                                         ],
                      event_callbacks => [],

                      init     => (fn ()=>tsimple_gui::init init_guistate; end )
                  };
              };

          fun go ()
              =
              {   tk::start_tcl_and_trap_tcl_exceptions [ main_window ];
                  !result
              ;}; 

      end; #  local 

};


package ts
    =
    tsimple_inst;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext