PreviousUpNext

15.4.1345  src/lib/x-kit/tut/show-graph/show-graph-app.pkg

# show-graph-app.pkg
#
# One way to run this app from the base-directory commandline is:
#
#     linux% my
#     eval: make "src/lib/x-kit/tut/show-graph/show-graph-app.lib";
#     eval: show_graph_app::do_it ("src/lib/x-kit/tut/show-graph/data/nodes.dot", "");

# Compiled by:
#     src/lib/x-kit/tut/show-graph/show-graph-app.lib

                                                        # scrollable_graphviz_widget            is from   src/lib/x-kit/widget/fancy/graphviz/scrollable-graphviz-widget.pkg
                                                        # dot_graphtree                         is from   src/lib/std/dot/dot-graphtree.pkg
                                                        # dotgraph_to_planargraph               is from   src/lib/std/dot/dotgraph-to-planargraph.pkg
# 2009-12-28 CrT:
#   Wrapped below code in  package main { ... }
#   just to make it more compilable -- the SML/NJ
#   code has the functions bare:
#
stipulate
    include threadkit;                                  # threadkit                             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package fil =  file__premicrothread;                # file__premicrothread                  is from   src/lib/std/src/posix/file--premicrothread.pkg
    package mps =  microthread_preemptive_scheduler;    # microthread_preemptive_scheduler      is from   src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg
    #
    package xg  =  xgeometry;                           # xgeometry                             is from   src/lib/std/2d/xgeometry.pkg
    package xc  =  xclient;                             # xclient                               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package wg  =  widget;                              # widget                                is from   src/lib/x-kit/widget/basic/widget.pkg
    package top =  topwindow;                           # topwindow                             is from   src/lib/x-kit/widget/basic/topwindow.pkg
    #
    package d2p =  dotgraph_to_planargraph;             # dotgraph_to_planargraph               is from   src/lib/std/dot/dotgraph-to-planargraph.pkg
    package dg  =  dot_graphtree;                       # dot_graphtree                         is from   src/lib/std/dot/dot-graphtree.pkg
    package gv  =  scrollable_graphviz_widget;          # scrollable_graphviz_widget            is from   src/lib/x-kit/widget/fancy/graphviz/scrollable-graphviz-widget.pkg
    package pg  =  planar_graphtree;                    # planar_graphtree                      is from   src/lib/std/dot/planar-graphtree.pkg
    package ffc =  font_family_cache;                   # font_family_cache                     is from   src/lib/x-kit/widget/fancy/graphviz/font-family-cache.pkg
    #
    package xtr =  xlogger;                             # xlogger                               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
    #
    logfile   =  "show-graph.trace.log";
    logging     =  logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "show_graph_app::logging", default => FALSE };
    to_log      =  xtr::log_if  logging 0;              # Conditionally write strings to logging.log or whatever.
        #
        # To debug via tracelogging, annotate the code with lines like
        #
        #       to_log .{ sprintf "foo/top: bar d=%d" bar; };
        #
        # and then set   write_tracelog = TRUE;   below.
herein  

    package show_graph_app {
        #
        write_tracelog = TRUE;

log_if = xtr::log_if fil::compiler_logging 0;           # Purely for debug narration.
        fun set_up_logging ()
            =
            {   # Open tracelog file and select logging level.
                # We don't need to truncate any existing file
                # because that is already done by the logic in
                #     src/lib/std/src/posix/winix-text-file-io-driver-for-posix--premicrothread.pkg
                #
                include logger;                                 # logger                        is from   src/lib/src/lib/thread-kit/src/lib/logger.pkg
                #
#               set_logger_to  (xtr::log_TO_FILE logfile);              # Commented out because for the moment I'd rather have the results in xkit-tut-unit-test.log   -- 2012-03-08 CrT
#               enable fil::all_logging;                                # Gross overkill.
            };

        stipulate
            selfcheck_tests_passed  =  REF 0;
            selfcheck_tests_failed  =  REF 0;
        herein
            run_selfcheck           =  REF FALSE;
            app_task                =  REF (NULL: Null_Or( Apptask   ));

            fun reset_global_mutable_state ()                                           # Reset above state variables to load-time values.
                =                                                                       # This will be needed if (say) we get run multiple times interactively without being reloaded.
                {   run_selfcheck               :=  FALSE;
                    #
                    app_task                    :=  NULL;
                    #
                    selfcheck_tests_passed      :=  0;
                    selfcheck_tests_failed      :=  0;
                };

            fun test_passed () =  { selfcheck_tests_passed :=  *selfcheck_tests_passed + 1;
log_if .{ "show-graph-app.pkg: test_passed() called."; }; };
            fun test_failed () =  { selfcheck_tests_failed :=  *selfcheck_tests_failed + 1;
log_if .{ "show-graph-app.pkg: test_failed() called."; }; };
            #
            fun assert bool    =  if bool   test_passed ();
                                  else      test_failed ();
                                  fi;                           
            #
            fun test_stats  ()
                =
                { passed => *selfcheck_tests_passed,
                  failed => *selfcheck_tests_failed
                };

            fun kill_show_graph_app ()
                =
                {
log::note .{ sprintf "%s\tkill_show_graph_app/TOP:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
                    kill_task  { success => TRUE,  task => (the *app_task) };
log::note .{ sprintf "%s\tkill_show_graph_app/ZZZ:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
                };

            fun wait_for_app_task_done ()
                =
                {
log::note .{ sprintf "%s\twait_for_app_task_done/TOP  -- show-graph-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    task =  the  *app_task;
                    #
log::note .{ sprintf "%s\twait_for_app_task_done/BBB  -- show-graph-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    task_finished' =  task_done__mailop  task;

log::note .{ sprintf "%s\twait_for_app_task_done/CCC  -- show-graph-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    block_until_mailop_fires  task_finished';

log::note .{ sprintf "%s\twait_for_app_task_done/DDD  -- show-graph-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    assert (get_task's_state  task  ==  state::SUCCESS);
log::note .{ sprintf "%s\twait_for_app_task_done/ZZZ  -- show-graph-app.pkg"  (mps::thread_scheduler_statestring ()); };
                };


        end;


        stipulate

            # Thread to exercise the app by simulating user
            # mouseclicks and verifying their effects:
            #
            fun make_selfcheck_thread
                {
#                 topwindow,
#                 widgettree,
                  xsession
                }
                =
                xtr::make_thread "show-graph-app selfcheck" selfcheck
                where

                    fun selfcheck ()
                        =
                        {
log_if .{ "show-graph-app.pkg:  selfcheck: AAA"; };

                            # Wait until the widgettree is realized and running:
                            # 
#                           get (wg::get_''gui_startup_complete''_oneshot_of  widgettree);      # This idea doesn't seem to be working at present anyhow.

#                           sleep_for 2.0;

#                           window = wg::window_of  widgettree;


                            # Fetch from X server the center pixels
                            # over which we are about to draw:
                            #
#                           (midwindow   window) ->  (_, window_midbox);
                            #
    #                   antedraw_window_image
    #                       =
    #                       xc::make_clientside_pixmap_from_window (window_midbox, window);

                            # Re-fetch center pixels, verify
                            # that new result differs from original result.
                            #
                            # This is dreadfully sloppy, but seems to be
                            # good enough to verify that there is something
                            # happening in the window:
                            #
    #                   postdraw_window_image
    #                       =
    #                       xc::make_clientside_pixmap_from_window (window_midbox, window);
                            #
    #                   assert (not (xc::same_cs_pixmap (antedraw_window_image, postdraw_window_image)));

log_if .{ "show-graph-app.pkg:  selfcheck: sleeping 2 seconds"; };
                            sleep_for 2.0;              # Just to let the user watch it.

                            # All done -- shut everything down:
                            #
log_if .{ "show-graph-app.pkg:  selfcheck: closing session"; };
                            xc::close_xsession  xsession;

                            sleep_for 0.2;                      # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.

                            kill_show_graph_app ();

# log_if .{ "show-graph-app.pkg:  selfcheck: shutting down thread scheduler"; };
#                           shut_down_thread_scheduler  winix__premicrothread::process::success;        # This is what we did pre-6.3.

log_if .{ "show-graph-app.pkg:  selfcheck: Done."; };
                            ();
                        };
                end;                                            # fun make_selfcheck_thread

            fun view_graph (font_family_cache, root_window, graph)
                =
                {
                    title = "Show-Graph: " + (dg::graph_name graph);

                    newvg = d2p::convert_dotgraph_to_planargraph  graph;

                    view = gv::make_scrollable_graphviz_widget (font_family_cache, root_window) newvg;

                    topwindow
                        =
                        top::make_topwindow
                          ( gv::as_widget  view,
                            NULL,
                            { window_name => THE title,
                              icon_name   => THE title
                            }
                          );

                    top::start  topwindow;
                };

            fun uncaught_exception_shutdown (m, s)
                =
                {   fil::print (cat ["uncaught exception ", m, " \"", s, "\"\n"] );
                    log_if .{ sprintf "show-graph-app.pkg/uncaught_exception_shutdown %s %s SHUTTING DOWN! DIVE! DIVE! DIVE!" m s; };

                    # Presumably we should be doing the following two lines here,
                    # but first we need how to get access to xsession at this point:    # XXX BUGGO FIXME
                    #
                    # xc::close_xsession  xsession;
                    # sleep_for 0.2;                            # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.

                    kill_show_graph_app ();

#                   shut_down_thread_scheduler winix__premicrothread::process::success;                 # We used to do this pre-6.3
                };

            # This is the toplevel application thread:
            #
            fun read_eval_print_thread (dotfile, xdisplay, xauthentication)
                =
                {
                    root_window =  wg::make_root_window (xdisplay, xauthentication);
                    screen      =  wg::screen_of  root_window;
                    xsession    =  xc::xsession_of_screen  screen;      

                    font_family_cache = ffc::make_font_family_cache root_window ffc::default_font_family;

                    graph = dg::read_graph  dotfile;
                    view_graph = view_graph (font_family_cache, root_window, graph);

                    fun run_user_command  tokens
                        =
                        do tokens
                        where
                            fun do ["quit"] =>  {   xc::close_xsession  xsession;
                                                    sleep_for 0.2;                      # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.
                                                    kill_show_graph_app ();
                                                };
                                do []       =>  ();
                                do _        =>  print "???\n";
                            end;
                        end;

                    tokenize
                        =
                        string::tokens  char::is_space;

                    # Read one line of user input from stdin:
                    #
                    fun read_user_line ()                               # This fn is a quick 2010-07-06 CrT hack,
                        =                                               # because fil::read_line doesn't block. (Which must be a bug...?!)
                        {
log_if .{ sprintf "show-graph-app.pkg/read_user_line/111"; };
                            string =    fil::read  fil::stdin           # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
                                        except x as io_exceptions::IO { name, op, cause }
                                            =
                                            {   msg = exceptions::exception_message x;

                                                log_if .{ sprintf "show-graph-app.pkg/read_user_line/111.5 %s" msg; };

                                                # XXX BUGGO FIXME this is an appallingly ugly thing to be
                                                # doing -- I/we need to fix the underlying interruped-system-call
                                                # nonsense Real Soon Now.
                                                #
                                                =~ = regex::(=~);
                                                #
                                                if (msg =~ ./Interrupted system call/)
                                                    log_if .{ sprintf "show-graph-app.pkg/read_user_line/111.6: Retrying interrupted system call"; };
                                                    read_user_line ();
                                                else
                                                    log_if .{ sprintf "show-graph-app.pkg/read_user_line/111.6: Re-raising exception"; };
                                                    raise exception x;
                                                fi;     
                                            };
log_if .{ sprintf "show-graph-app.pkg/read_user_line/222"; };

                            # If we have a full line return it,
                            # otherwise read rest of line:
                            #
                            len    =  size string;
log_if .{ sprintf "show-graph-app.pkg/read_user_line/333"; };
                            #
                            if (len > 0   and
                                string::get (string, len - 1) == '\n')
                                #
log_if .{ sprintf "show-graph-app.pkg/read_user_line/444"; };
                                string;
                            else
log_if .{ sprintf "show-graph-app.pkg/read_user_line/555"; };
                                string + read_user_line ();
                            fi;
                        };

                    fun read_eval_print_loop ()
                        =
                        if *run_selfcheck
                            #
                            # No need for read-eval-print in selfcheck mode:
                            #
                            for (;;) {
                                #
                                sleep_for 1.0;
                            };
                        else
                            print "show-graph-app command interpreter.\n";
                            print "Currently only supported command is 'quit'.\n";
                            #   
                            for (;;) {
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/AAA"; };
                                print ">> ";
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/BBB"; };
                                fil::flush  fil::stdout;
                                #
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/CCC"; };
                                user_input_line = read_user_line();
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/DDD"; };
                                tokenized_line  = tokenize  user_input_line;
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/EEE"; };
                                #
                                run_user_command  tokenized_line;
log_if .{ sprintf "show-graph-app.pkg/read_eval_print_loop/FFF"; };
                            };
                        fi;

                    if *run_selfcheck
                        #
                        make_selfcheck_thread 
                          {
#                           topwindow,
#                           widgettree => low::as_widget layout,
                            xsession
                          };

                        ();
                    fi;

                    read_eval_print_loop ();
                }
                except (dg::GRAPHTREE_ERROR       s) =>  uncaught_exception_shutdown ("dot_graphtree::GRAPHTREE_ERROR", s);
                       (pg::GRAPHTREE_ERROR       s) =>  uncaught_exception_shutdown ("planar_graphtree::GRAPH",        s);
                       (xc::XSERVER_CONNECT_ERROR s) =>  uncaught_exception_shutdown ("xclient::XSERVER_CONNECT_ERROR", s);
                       #        
                       e => {
                                fun f (s, l)
                                    =  "  ** "
                                    !  s
                                    !  "\n"
                                    !  l
                                    ;

                                trace_back
                                   =
                                   list::fold_backward f [] (lib7::exception_history e);

                                log_if .{ sprintf "show-graph-app.pkg/read_eval_print_thread: Unexpected exception %s %s: SHUTTING DOWN." (exception_name e) (cat trace_back); };

                                kill_show_graph_app ();

#                               shut_down_thread_scheduler  winix__premicrothread::process::failure;
                            };
                end;

            # This is used only by the 'generate_executable' call below:                
            #
            fun generate_executable_main  dotfile  _
                =
                {
                    display_name = "";                                                          # Should maybe create a way to pass this in.

                    my  ( xdisplay,                                                             # Typically from $DISPLAY environment variable.
                          xauthentication:  Null_Or(xc::Xauthentication)                        # Typically from ~/.Xauthority
                        )
                        =
                        xc::get_xdisplay_string_and_xauthentication
                            #
                            case display_name
                                #
                                "" =>  NULL;
                                _  =>  THE display_name;
                            esac;

                    root_window = wg::make_root_window (xdisplay, xauthentication);

                    font_family_cache = ffc::make_font_family_cache  root_window  ffc::default_font_family;

                    graph = dg::read_graph  dotfile;

                    view_graph (font_family_cache, root_window, graph);

                    0;
                }
                except (dg::GRAPHTREE_ERROR       s) =>  { uncaught_exception_shutdown ("dot_graphtree::GRAPH",           s); 1; };
                       (pg::GRAPHTREE_ERROR       s) =>  { uncaught_exception_shutdown ("planar_graphtree::GRAPH",        s); 1; };
                       (xc::XSERVER_CONNECT_ERROR s) =>  { uncaught_exception_shutdown ("xclient::XSERVER_CONNECT_ERROR", s); 1; };
                       #
                       e => {   printf           "show-graph-app.pkg/generate_executable_main: Unexpected exception %s: SHUTTING DOWN." (exception_name e);
                                log_if .{ sprintf "show-graph-app.pkg/generate_executable_main: Unexpected exception %s: SHUTTING DOWN." (exception_name e); };
                                kill_show_graph_app ();
                                winix__premicrothread::process::failure;
#                               shut_down_thread_scheduler  winix__premicrothread::process::failure;
                            };
                end;

        herein

            fun start_up_show_graph_app_threads  (dotfile, display_name)
                =
                {
                    display_name' =     case display_name   "" =>  NULL;
                                                            _  =>  THE display_name;
                                        esac;

                    (xc::get_xdisplay_string_and_xauthentication  display_name')
                        ->
                        ( xdisplay,                                                             # Typically from $DISPLAY environment variable.
                          xauthentication:  Null_Or(xc::Xauthentication)                        # Typically from ~/.Xauthority
                        );

                    read_eval_print_thread (dotfile, xdisplay, xauthentication);

                    ();
                };

            fun set_up_show_graph_app_task  (dotfile, display_name)
                =
                # Here we arrange that all the threads
                # for the application run as a task "show graph app",
                # so that later we can shut them all down with
                # a simple kill_task().  We explicitly create one
                # root thread within the task; the rest then implicitly
                # inherit task membership:
                #
                {
                    show_graph_app_task =   make_task  "show graph app"  [];
                    app_task           :=   THE  show_graph_app_task;
                    #
                    xtr::make_thread' [ THREAD_NAME "show graph app",
                                        THREAD_TASK  show_graph_app_task
                                      ]
                                      start_up_show_graph_app_threads
                                      (dotfile, display_name);
                    ();
                };

            fun do_it (dotfile, display_name)
                =
                {   flags = [];                 # Often can be set via do_it arg in other apps.
                    xlogger::init flags;

                    if write_tracelog
                        #
                        set_up_logging ();
                    fi;

                    set_up_show_graph_app_task  (dotfile, display_name);

                    wait_for_app_task_done ();

                    ();
                };                                                                              # fun do_it

            fun demo display_name
                =
                {   winix__premicrothread::file::change_directory  "../data";

                    do_it ("nodes.dot", display_name);
                };

            fun generate_executable executable_name dotfile                                     # mygraph.dot ascii file defining graph to display, e.g data/nodes.dot
                =
                spawn_to_disk( executable_name, generate_executable_main dotfile, THE (time::from_milliseconds 20) );

            fun selfcheck ()
                =
                {
log::note .{ sprintf "%s\tselfcheck/TOP:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
                    reset_global_mutable_state ();                                              # Don't depend on load-time state initialization -- we might get run multiple times interactively, say.
                    run_selfcheck :=  TRUE;
log::note .{ sprintf "%s\tselfcheck/MMM:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
                    do_it ("src/lib/x-kit/tut/show-graph/data/nodes.dot", "");
log::note .{ sprintf "%s\tselfcheck/NNN:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
result =
                    test_stats ();
log::note .{ sprintf "%s\tselfcheck/ZZZ:    -- show-graph-app.pkg" (mps::thread_scheduler_statestring ()); };
result;
                };      
        end;                                                          #  stipulate
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext