framer

#! /usr/bin/perl
#=============================================================================
#   Framer      Libero dialog mark-up tool, v1.1
#               Generates hypertext version of dialog and source, for use
#               with frame-capable browser.  For a dialog called <dialog>
#               generates three HTML files: <dialog>.htm, <dialog>d.htm,
#               and <dialog>s.htm.
#
#   Written:    96/12/18  Pieter Hintjens <ph@imatix.com>
#   Revised:    97/06/20  Pieter Hintjens <ph@imatix.com>
#
#   Copyright (c) 1997 iMatix
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#=============================================================================

require 'framer.fmt';                   #   Include HTML formats
require 'framer.d';                     #   Include dialog interpreter


##########################   INITIALISE THE PROGRAM   #########################

sub initialise_the_program
{
    print "Framer - a Libero add-on tool - v1.1\n";
    print "Copyright (c) 1997 iMatix <http://www.imatix.com>\n";

    if ($#ARGV == 0) {                  #   1 argument => source
        $source = $ARGV [0];
        $base   = &basename ($source);
        $dialog = "$base.l";
        $the_next_event = $ok_event;
    }
    elsif ($#ARGV == 1) {               #   2 arguments => source, dialog
        $source = $ARGV [0];
        $base   = &basename ($source);
        $dialog = $ARGV [1];
        $dialog .= ".l" if $dialog !~ /\./;
        $the_next_event = $ok_event;
    }
    else {
        print "syntax: framer source [dialog]\n";
        $the_next_event = $error_event;
    }
    #   Calculate names for source & dialog HTML files (use 8.3 filenames)
    if ($the_next_event eq $ok_event) {
        $s_html = substr ($base, 0, 7)."s.htm";
        $d_html = substr ($base, 0, 7)."d.htm";
    }
}

#   Return filename, without extension

sub basename {
    local ($name) = @_;                 #   Get argument
    $name =~ s/\..*//;                  #   Remove extension, if any
    return ($name);
}


#############################   OPEN DIALOG FILE   ############################

sub open_dialog_file
{
    if (!open (SOURCE, $source)) {
        print "framer E: ($document $.) can't open $source: $!\n";
        &raise_exception ($error_event);
    }
    if (!open (DIALOG, $dialog)) {
        print "framer E: ($document $.) can't open $dialog: $!\n";
        &raise_exception ($error_event);
    }
    if (!open (OUTPUT, ">$base.htm")) {
        print "framer E: ($document $.) can't create $base.htm: $!\n";
        &raise_exception ($error_event);
    }
    else {
        &format_output (OUTPUT, "FRAME_FILE");
        close (OUTPUT);
    }
    #   Prepare to build HTML file for the dialog
    open (HTML, ">$d_html");
    &format_output (HTML, "D_HTML_HEADER");
    $curline = "";                      #   Clear input line
}


#   Subroutine prepares output format and writes it to the specified
#   output stream.
#
sub format_output {
    local ($stream, $format) = @_;      #  Get subroutine arguments

    select ($stream);
    $~ = "$format";
    write;
    select (STDOUT);
}


##############################   GET NEXT TOKEN   #############################

sub get_next_token
{
    #   If necessary, get next input line
    if ($curline eq "") {
        while (<DIALOG>) {
            chop;                       #   Remove trailing newline
            if ($_) {                   #   End loop at non-blank line
                $curline = $_;
                last;
            }
        }
    }
    #   If we found nothing, we hit the end of the file
    if ($curline eq "") {
        $the_next_event = $no_more_event;
        return;
    }
    if (/^\s*!/) {                      #   Comment line?
        $token   = $curline;
        $curline = "";
        $the_next_event = $comment_event;
    }
    elsif (/^\// || /^-[^>]/) {         #   /option or -option line
        $token   = $curline;
        $curline = "";
        $the_next_event = $option_event;
    }
    else {
        $curline =~ /\s*(\S+)\s*(.*)/;  #   Get next token
        $token   = $1;
        $curline = $2;

        if ($token eq ":") {            #   :
            $the_next_event = $state_name_term_event;
        }
        elsif ($token eq "->") {        #   ->
            $the_next_event = $next_pointer_event;
        }
        elsif ($token eq "+") {         #   +
            $the_next_event = $module_flag_event;
        }
        elsif ($token =~ /^\(.*\)/) {   #   (--)
            $the_next_event = $event_number_event;
        }
        elsif ($token =~ /^(<.*>)/) {   #   <name>
            $token = $1;                #   Extract state name
            $the_next_event = $superstate_ref_event;
        }
        elsif ($token =~ /(.*):/) {     #   name:
            $token = $1;                #   Extract state name
            $the_next_event = $state_name_event;
        }
        elsif ($token eq "PARAMS") {    #   ETK-style dialog file
            $token = "";
            $curline = "";
            $the_next_event = $comment_event;
        }
        elsif ($token =~ /[A-Za-z-_]+/) {
            $the_next_event = $item_name_event;
        }
        else {
            &syntax_error ("Expected $expect, got $token");
        }
    }
}

sub syntax_error {
    local ($message) = @_;              #   Get argument

    print "$_\n";
    print "framer E: ($base $.) $message\n";
    &raise_exception ($exception_event);
}


##########################   PROCESS COMMENT VALUE   ##########################

sub process_comment_value
{
    &normalise_line ($token);
    print (HTML "$_\n");
}


#   Subroutine returns normalised line of text in $_:
#   - expands tabs to spaces
#   - <name@a.b> formatted as <A HREF="mailto:name@a.b">a@b.c</A>
#   - <x://a.b> formatted as <A HREF="x://a.b">x://a.b</A>
#   - fct_name () formatted as $(*fct_name) (), if known anchor
#   - < replaced by &lt;
#   - > replaced by &gt;
#
sub normalise_line {
    ($_) = @_;                          #   Get argument

    s/</&lt;/g;                         #   Replace < by &lt;
    s/>/&gt;/g;                         #   Replace > by &gt;

    while (/^([^\t]*)\t/) {             #   Expand tabs
        $curpos = length ($1);
        $spaces = int (($curpos / 8) + 1) * 8 - $curpos;
        s/\t/' ' x $spaces/e;
    }
    #   Format <name@a.b>
    s/&lt;(.+@[^.]+\.[^&]+)&gt;/<A HREF=mailto:"$1">$1<\/A>/g;
    #   Format <x://a.b>
    s/&lt;(\w+:\/\/[^.]+\.[^&]+)&gt;/<A HREF="$1">$1<\/A>/g;
    #   Format function names if anchors
#   return &find_links ($_);
}


###########################   PROCESS OPTION VALUE   ##########################

sub process_option_value
{
    &normalise_line ($token);
    print (HTML "$_\n");
}


#############################   ATTACH NEW STATE   ############################

sub attach_new_state
{
    printf (HTML $state_name, &normalise_name ($token), $token);
    $have_events = 0;
}


#   Subroutine returns normalised name in $_:
#     - removes all non-alphanumeric characters
#     - converts remaining text to lowercase
#
sub normalise_name {
    local ($_) = @_;                    #   Get argument
    tr/[A-Z]/[a-z]/;                    #   Shift to lowercase
    s/[^a-z0-9]//g;                     #   And keep only alphanumerics
    return ($_);
}


##########################   ATTACH USES SUPERSTATE   #########################

sub attach_uses_superstate
{
    printf (HTML $super_state, &normalise_name ($token), $token);
}


############################   STORE EVENT NUMBER   ###########################

sub store_event_number
{
    print (HTML "\n") unless $have_events;
    print (HTML "    (--) ");
    $have_events = 1;
}


#############################   ATTACH NEW EVENT   ############################

sub attach_new_event
{
    printf (HTML "%-35s", $token);
}


############################   ATTACH NEXT STATE   ############################

sub attach_next_state
{
    printf (HTML $next_state, &normalise_name ($token), $token);
}


##########################   ATTACH SAME NEXT STATE   #########################

sub attach_same_next_state
{
    print (HTML "-&gt;\n");
}


############################   ATTACH NEW MODULE   ############################

sub attach_new_module
{
    printf (HTML $module_name, $s_html, &normalise_name ($token), $token);
}


###########################   ATTACH EMPTY MODULE   ###########################

sub attach_empty_module
{
    print (HTML "          +\n");
}


############################   EXPECT STATE NAME   ############################

sub expect_state_name
{
    $expect = "statename:";
}


#########################   EXPECT STATE DEFINITION   #########################

sub expect_state_definition
{
    $expect = "(--) event";
}


############################   EXPECT EVENT NAME   ############################

sub expect_event_name
{
    $expect = "eventname";
}


#########################   EXPECT EVENT DEFINITION   #########################

sub expect_event_definition
{
    $expect = "+ module";
}


###########################   EXPECT NEXT POINTER   ###########################

sub expect_next_pointer
{
    $expect = "->";
}


############################   EXPECT MODULE NAME   ###########################

sub expect_module_name
{
    $expect = "modulename";
}


#########################   EXPAND MACRO CONSTRUCTS   #########################

sub expand_macro_constructs
{
}


##########################   BUILD SOURCE FILE NAME   #########################

sub build_source_file_name
{
}


##########################   WARNING ON STATE NAME   ##########################

sub warning_on_state_name
{
    &syntax_error ("':' expected after state name '$token'");
}


#########################   DISPLAY UNEXPECTED TOKEN   ########################

sub display_unexpected_token
{
    &syntax_error ("Expected $expect, got $token");
}


##########################   RETURN ERROR FEEDBACK   ##########################

sub return_error_feedback
{
}


############################   CLOSE DIALOG FILE   ############################

sub close_dialog_file
{
    &format_output (HTML, "D_HTML_FOOTER");
    close (HTML);

    #   Now, process entire source file
    #   Prepare to build HTML file for the dialog

    open (HTML, ">$s_html");
    &format_output (HTML, "S_HTML_HEADER");
    while (<SOURCE>) {
        &normalise_line ($_);
        if (/(\S)\s{2,5}([A-Z0-9][A-Z0-9 ]*)\s{2,5}\1/) {
            print  (HTML "$`$1   ");
            printf (HTML $module_link, &normalise_name ($2), $2);
            print  (HTML "   $1$'");
        }
        else {
            print (HTML);
        }
    }
    &format_output (HTML, "S_HTML_FOOTER");
    close (HTML);
}


############################   GET EXTERNAL EVENT   ###########################

sub get_external_event
{
}


##########################   TERMINATE THE PROGRAM    #########################

sub terminate_the_program
{
    $the_next_event = $terminate_event;
}