#!/usr/bin/perl
# -*- mode: cperl; coding: utf-8; -*-

use strict;
use warnings;
use utf8;

use lib "/h/hamren/src/post/lib", "."; my $rval = do "common.pm" || die "$0: common.pm failed ($!) [$@]"; #--- Single-line common initializer

my $add_candidate      = em("add_candidate");
my $print_accepted = em("print_accepted");
my $find_all       = em("find_all()");
my $add_range      = em("add_range()");
my $get_unified    = em("get_unified()");
my $get_unified_   = em("get_unified");
my $main           = em("main()");

my $Word           = em("Word");
my $AnagramFinder  = em("AnagramFinder");

my $text           = em("text");
my $words          = em("words");
my $accepted       = em("accepted");

sub qqq($) { return i("@_"); }

my $Worker  = qqq("Worker");
my $Server  = qqq("Server");
my $Client  = qqq("Client");
my $center_image = { style => "display: block; margin-left: auto; margin-right: auto; margin-top: 5pt; margin-bottom: 10pt; "  };

post(
    header(),

    h2("A TMB message bus client in written in TCL"),

    img_float_right("message-bus-tester-tcl.png"),

    read_main_tmb_article(),

    p("This TMB client should work on any platform."),

    p("The source code has been split into three files:"),

    ul(
        "«networking.tcl»"                       . "   -- BSD socket code.",
        "«gui.tcl»"                              . "   -- Graphical user interface, using Tk.",
        "«message-bus-tester.tcl»"               . "   -- TMB message bus logic."
    ),
    p(" The last file also contains the main program."),

    h3("Network routines"),
    ul(
        "«global client»"                        . "   -- The socket.",
        "«proc network_start»"                   . "   -- Creates a socket and connects to the server.",
        "«proc network_write»"                   . "   -- Writes a packet to the socket. Appends newline.",
        "«proc network_read_from_server»"        . "   -- Called by the Tk framework when there are data vailable on the socket"
      ),
    h3("Graphical user interface routines"),
    ul(
        "«frame  .upper»"                        . "   -- The canvas for the upper figures, and its six configuration buttons.",
        "«frame .lower»"                         . "   -- And for the lower figure",
        "«frame .su»"                            . "   -- The subscribe and unsubscribe buttons, and the \"Send all\" button.",
        "«global upper_colour»"                  . "   -- The colour of the upper figure (\"red\", \"green\" or \"blue\").",
        "«global upper_shape»"                   . "   -- The colour of the upper figure (\"square\", \"circle\" or \"triangle\").",
        "«global lower_colour»"                  . "   -- And so on.",
        "«global lower_shape»"                   . "   -- And so forth.",
        "«proc draw_figure»"                     . "   -- Draws a triangle, square or circle.",
        "«proc draw_both»"                       . "   -- Convenience procedure to draw both the upper and lower figures.",
        "«proc create_figure_frame»"             . "   -- Creates seven widgets: the figure canvas and its push buttons.",
        "«proc configure_grid_pair»"             . "   -- Convenience for placing a pair of bttons in the subscription frame.",
        "«proc create_subscription_button_pair»" . "   -- Creates a pair of subscribe/unsubscribe buttons.",
        "«proc create_subscription_frame»"       . "   -- Creates all the subscribe and unsibscribe buttons.",
        "«proc create_gui»"                      . "   -- Creates and populates the applications window.",
        "«proc send_all»"                        . "   -- Callback for the \"Send all\" button."
    ),

    h3("Message bus routines, and main program"),
    ul(
        "«proc mb_send_command_message»"         . "   -- Send a message by calling «network_write».",
        "«proc mb_send_peer_message   »"         . "   -- Prepends a colon before calling «network_write».",
        "«proc mb_on_incoming_message»"          . "   -- Called by «network_read_from_server» for each line read from the socket.",
        "«proc main»"                            . "   -- The main program."
    ),

    h3("networking.tcl"),
    p("«network_start» loops over a range of ports, provided by the main program.",
      " When it has connected, it sets up a ⊂fileevent⊃ to call «network_read_from_server» when there is data available on the socket.",
      " That routine will then call «mb_on_incoming_message»."),
    p("In «network_write», not that «puts» automatically append a newline."),
    source_file("source/networking.tcl"),

    h3("gui.tcl"),
    source_file("source/gui.tcl"),

    h3("message-bus-tester.tcl"),
    p("One slightly interesting thing is how peer messages are handled in «proc on_incoming_message».",
      " Stripped of error handling, here is what happens:"),

    source_codeq(<<'EOF'),
regexp {^:/(\S+)/(\S+)\s+(\S+)} $message dummy group key value
set ${group}_$key $value
EOF
    p("With an incoming peer message «:/lower/colour green» the regexp sets «group» to «lower», «key» to «colour» and  «value» to «red».",
      " The next line, after parsing, becomes"),
    source_codeq(<<'EOF'),
set lower_colour red
EOF
    p("where «lower_colour» can be any of the four variables (lower_colour, lower_shape, upper_colour, upper_shape) used when drawing the two figures."),
    source_file("source/message-bus-tester.tcl"),
    #     table({class => "tight10"},
#           trow(td("«proc network_start»"),            td("Creates a socket and connects to the server.")),
#           trow(td("«proc network_write»"),            td("Writes a packet to the socket. Appends newline.")),
#           trow(td("«proc network_read_from_server»"), td("Called by the Tk framework when there are data vailable on the socket"))
#       ),

    footer()
);
__END__