zizl

#!/usr/bin/perl -w
#
# Xanadu(R) Zigzag(tm) Hyperstructure Kit HTML interface, $Revision: 0.6 $
#
# Designed by Ted Nelson
# Programmed by Andrew Pam ("xanni") and Bek Oberin ("gossamer")
# Copyright (c) 1997-1999 Project Xanadu
#
# This is only a partial implementation, with only a few structure and view
# operations; however, they are enough to allow you to create, view and explore
# complex multidimensional structures in quantum hyperspace.
#
# A forthcoming tutorial will present you with strange spaces to explore,
# beginning with easy 2D concepts, the peculiar geography of this system and
# operating recommendations for getting around in it comfortably and changing
# your structures without losing cells or losing track of your stuff.  (This
# will emphasize pragmatic adaptations to the peculiarities of this limited
# implementation.)
#
# Forthcoming documentation will explain the space, the theory, structure
# operations, view operations, and the official planned extensions.
#
# For more information, visit http://www.xanadu.net/zz/
#
# ===================== Change Log
#
# Inital zigzag implementation
# $Id: zizl,v 0.6 1999/05/14 13:47:01 xanni Exp $
#
# $Log: zizl,v $
# Revision 0.6  1999/05/14 13:47:01  xanni
# * Moved cell_create() from Zigzag.pm
# * Added two new user_error() messages for invalid deletion attempts
# * Replaced direct access to %ZZ with cell_get(), cell_set() and cell_nbr()
# * Changed db_open() and db_close() to slice_open() and slice_close_all()
#
# Revision 0.5  1999/01/27 18:36:36  xanni
# Implemented start page, browser communication, clean server shutdown
#
# Revision 0.4  1999/01/27 14:08:12  xanni
# Implemented simple web server
#
# Revision 0.3  1999/01/26 06:09:46  xanni
# Implemented quad view
#
# Revision 0.2  1999/01/26 03:44:02  xanni
# Rewrote code to generate HTML directly
#
# Revision 0.1  1999/01/07 16:21:16  xanni
# First prototype
#

use integer;
use strict;
use POSIX;
use HTTP::Daemon;	# See Perl-modules for installation instructions
use HTTP::Status;

use Zigzag;

# Note: We are using the following coding conventions:
# Constants are named in ALLCAPS
# Global variables are named with Initial Caps
# Local variables and functions are named in lowercase
# Put brackets around all function arguments
# Prototype the number and type of arguments expected by functions
# Matching braces should line up with each other vertically
# Use the $TRUE and $FALSE constants instead of "1" and "0"

# Define constants
#my ($VERSION) = q$Revision: 0.6 $ =~ /([\d\.]+)/;
my $VERSION = q$Id: zizl,v 0.6 1999/05/14 13:47:01 xanni Exp $;
my $FALSE = 0;
my $TRUE = !$FALSE;
my $BGCOLOR = "#FFFFFF";	# White background
my $BROWSER = "netscape";	# Web browser to start
my $GUIDE = "guide.gif";	# Filename of dimension guide
my $CELLS_PER_WIN = 5;          # Number of cells displayed across each window
my $COMMAND_SYNC_COUNT = 20;    # Sync the DB after this many commands

# Declare globals
my $daemon;			# HTTP server socket
my $Zigzag_Terminated;          # True when interrupted by a signal

# Initialise global zigzag data structures
my %Keymap_Directions =
  ( # Direction key mappings
    "s"		=> "0L",
    "S"		=> "0L",
    "f"		=> "0R",
    "F"		=> "0R",
    "e"		=> "0U",
    "E"		=> "0U",
    "c"		=> "0D",
    "C"		=> "0D",
    "d"		=> "0I",
    "D"		=> "0O",
    "j"		=> "1L",
    "J"		=> "1L",
#    &KEY_LEFT	=> "1L",
    "l"		=> "1R",
    "L"		=> "1R",
#    &KEY_RIGHT	=> "1R",
    "i"		=> "1U",
    "I"		=> "1U",
#    &KEY_UP	=> "1U",
    ","		=> "1D",
#    &KEY_DOWN	=> "1D",
    "k"		=> "1I",
#    &KEY_PPAGE	=> "1I",
    "K"		=> "1O",
#    &KEY_NPAGE	=> "1O",
  );

my %Keymap =
  ( # Keyboard mappings
    "\r"		=> 'atcursor_execute(0);',
    "\n"		=> 'atcursor_execute(0);',
    "<"			=> '@_ = input_get_direction(); atcursor_import(@_) if $_[0];',
    ">"			=> '@_ = input_get_direction(); atcursor_export(@_) if $_[0];',
    chr(127)		=> 'atcursor_delete(1);',
#    &KEY_DC		=> 'atcursor_delete(1);',
#    &KEY_BACKSPACE	=> 'input_process_backspace();',
    meta_key("s")	=> 'atcursor_hop(0, "L");',
    meta_key("f")	=> 'atcursor_hop(0, "R");',
    meta_key("e")	=> 'atcursor_hop(0, "U");',
    meta_key("c")	=> 'atcursor_hop(0, "D");',
    meta_key("D")	=> 'atcursor_edit(0);',
    meta_key("d")	=> 'atcursor_edit(0);',
    "\cD"		=> 'atcursor_edit(0);',
    meta_key("j")	=> 'atcursor_hop(1, "L");',
    meta_key("l")	=> 'atcursor_hop(1, "R");',
    meta_key("i")	=> 'atcursor_hop(1, "U");',
    meta_key(",")	=> 'atcursor_hop(1, "D");',
    meta_key("K")	=> 'atcursor_edit(1);',
    meta_key("k")	=> 'atcursor_edit(1);',
    "\cK"		=> 'atcursor_edit(1);',
    "b"			=> '@_ = input_get_direction(); atcursor_break_link(@_) if $_[0];',
    "G"			=> 'cursor_jump_input(get_cursor(0));',
    "g"			=> 'cursor_jump_input(get_cursor(1));',
#    &KEY_HOME		=> 'cursor_jump_input(get_cursor(1));',
    "h"			=> '@_ = input_get_direction(); atcursor_hop(@_) if $_[0];',
    "\cL"		=> 'display_refresh(curscr()); $@ = "";',
    "M"			=> 'atcursor_select(0);',
    "m"			=> 'atcursor_select(1);',
    meta_key("m")	=> 'rotate_selection()',
    meta_key("M")	=> 'push_selection()',
    "N"			=> 'cell_create(0);',
#    &KEY_IC		=> 'cell_create(0);',
    "n"			=> 'cell_create(1);',
    "Q"			=> 'view_quadrant_toggle(0);',
    "q"			=> 'view_quadrant_toggle(1);',
    "R"			=> 'view_reset(0);',
    "r"			=> 'view_reset(1);',
    "T"			=> 'atcursor_clone(0);',
    "t"			=> 'atcursor_clone(1);',
    meta_key("T")	=> 'atcursor_copy(0);',
    meta_key("t")	=> 'atcursor_copy(1);',
    "V"			=> 'view_raster_toggle(0);',
    "v"			=> 'view_raster_toggle(1);',
    "\cV"		=> 'display_status_draw(version());',
    meta_key("V")	=> 'display_status_draw(version());',
    meta_key("v")	=> 'display_status_draw(version());',
    "X"			=> 'view_rotate(0, "X");',
    "x"			=> 'view_rotate(1, "X");',
    "\cX"		=> '$Zigzag_Terminated = "^X";',
    meta_key("X")	=> 'view_flip(0, "X");',
    meta_key("x")	=> 'view_flip(1, "X");',
    "Y"			=> 'view_rotate(0, "Y");',
    "y"			=> 'view_rotate(1, "Y");',
    meta_key("Y")	=> 'view_flip(0, "Y");',
    meta_key("y")	=> 'view_flip(1, "Y");',
    "Z"			=> 'view_rotate(0, "Z");',
    "z"			=> 'view_rotate(1, "Z");',
    meta_key("Z")	=> 'view_flip(0, "Z");',
    meta_key("z")	=> 'view_flip(1, "Z");',
  );


#
# Some helper functions
#

sub version()
{
  return "zizl version $VERSION (Zigzag $Zigzag::VERSION)";
}

sub meta_key($)
# This is just a little helper macro, returns the META/ALT key code
{ 
  return(chr(ord($_[0]) | 0x80)); 
}


sub cursor_jump_input($)
# Jump cursor to $Input_Buffer
# Or to 0 if no input buffer.
{
  my $dest = defined($Input_Buffer) ? $Input_Buffer : 0;
  cursor_jump($_[0], $dest);
  undef $Input_Buffer;
}

sub cell_create($)
# Create a new cell and optionally edit it
{
  my $edit = $_[0];
  my ($curs, $dir) = input_get_direction();
  if ($curs)
  {
    atcursor_insert($curs, $dir);
    cursor_move_direction($curs, $dir);
    atcursor_edit($curs) if $edit;
  }
}

sub atcursor_edit($)
# Invoke an external text editor to edit the cell under a given cursor
{
  my $cell = get_lastcell(get_lastcell(get_cursor($_[0]), "-d.cursor"), "-d.clone");
}

sub atcursor_import(@)
# Import cells from a text file
{
  my $curs = get_cursor($_[0]);
  my $cell = get_lastcell($curs, "-d.cursor");
  my $dim = get_dimension($curs, $_[1]);

  # Not in the Cursor dimension!
  return if $dim eq "d.cursor";
}

sub atcursor_export(@)
# Export cells to a text file
{
  my $curs = get_cursor($_[0]);
  my $dim = get_dimension($curs, $_[1]);
  my $start = get_lastcell($curs, "-d.cursor");
}


#
# Functions that are implemented using a particular user interface toolkit
# Named: display_*
#
sub display_open()
# (Re)initialise display
{
  $Hcells = $CELLS_PER_WIN;
  $Vcells = $CELLS_PER_WIN;
  $daemon = new HTTP::Daemon;

  my $url = $daemon->url;
  my $rc = $TRUE;

  $rc = system "$BROWSER -remote 'openURL($url)' 2>/dev/null"
    if $BROWSER =~ /netscape/;
  $rc = system "$BROWSER $url &" if $rc and $BROWSER;
  print "Please contact me at: <URL:", $url, ">\n" if $rc;

  # Mark all windows dirty to ensure they all get redrawn
  display_dirty();
}

sub display_close()
# Free all windows
{
}

sub display_dirty()
# The data structure has changed, so we will have to redraw
{
}

#
# Functions that generate HTML.
#
sub html_process_cell($)
# Process cell contents for HTML output
{
  my ($content) = @_;

  $content =~ s/&/&amp;/g;
  $content =~ s/</&lt;/g;
  $content =~ s/\n/<BR>\n/g;
  return $content;
}

sub html_table_cell($)
# Draw cell contents
{
  my ($cell) = @_;
  my $cursor = cell_nbr($cell, "+d.cursor")
    unless defined cell_nbr($cell, "-d.cursor");
  my $number = -1;
  my $content;

  while (defined $cursor)
  { $cursor = cell_nbr($cursor, "-d.2");  $number++; }
#  ($content) = split(/\n/, get_cell_contents($cell));	# Just the first line
# NOTE: We should probably handle containment if we're going to show the lot!
  $content = html_process_cell(get_cell_contents($cell));
  $content = "<FONT COLOR=#FFFFFF>$content</FONT>" if is_selected($cell);
  my $bgcolor = $BGCOLOR;
  $bgcolor = "#FFFF00" if is_clone($cell);
  $bgcolor = "#000000" if is_selected($cell);
  $bgcolor = "#00FF00" if $number == 1;
  $bgcolor = "#5F5FFF" if $number > 1;
  return "<TD BGCOLOR=$bgcolor>$content</TD>";
}

sub html_table_quad($)
# Draw a quad cell
{
  my ($cell) = @_;
  my $contents = "";
  # $MAXLEN = the maximum amount of cell contents we'll display
  my $MAXLEN = 5000;

  @_ = get_contained($cell);
  do
  { $contents .= substr(get_cell_contents(shift), 0, $MAXLEN) . "\n"; }
  until (($#_ < 0) || (length($contents) >= $MAXLEN));
  $contents = html_process_cell($contents);
  return "<TD BGCOLOR=$BGCOLOR COLSPAN=$Hcells ROWSPAN=$Vcells>$contents</TD>";
}

sub html_table_layout($$$)
# Draw given display window from a layout
{
  my ($guide, $lref, $quad) = @_;
  my ($i, $j);
  my $table;

  for ($j = -$Vcells + 1; $j < $Vcells; $j++)
  {
    $table .= "<TR>";
    for ($i = -$Hcells + 1; $i < $Hcells; $i++)
    {
      if ($i == (-$Hcells + 1) && $j == (-$Vcells + 1))
      { $table .= "<TD>$guide</TD>"; }
      elsif ($quad && ($i == 0) && ($j == 0))
      { $table .= html_table_quad($$lref{"0,0"}); }
      elsif (!$quad || ($i < 0) || ($j < 0))
      {
        if ($i % 2)
        {
          if ($j % 2)
          { $table .= "<TD></TD>"; }
          else
          {
            my $x = int($i / 2) + $i % 2;
            my $y = int($j / 2) + $j % 2;
            if (defined $$lref{"$x-$y"})
            { $table .= "<TD>---</TD>"; }
            else
            { $table .= "<TD></TD>"; }
          }
        }
        else
        {
          if ($j % 2)
          {
            my $x = int($i / 2) + $i % 2;
            my $y = int($j / 2) + $j % 2;
            if (defined $$lref{"$x|$y"})
            { $table .= "<TD ALIGN=CENTER>|</TD>"; }
            else
            { $table .= "<TD></TD>"; }
          }
          else
          {
            my $x = int($i / 2);
            my $y = int($j / 2);
            my $cell = $$lref{"$x,$y"};
            if (defined $cell)
            { $table .= html_table_cell($cell); }
            else
            { $table .= "<TD></TD>"; }
          }
        }
      }
    }
    $table .= "</TR>\n";
  }
  return $table;
}

sub html_layout_window($)
# Redraw given display window
{
  my ($number) = @_;
  # Local variables
  my $curs = get_cursor($number);
  my $name = cell_get($curs);
  my $cell = get_lastcell($curs, "-d.cursor");
  $curs = cell_nbr($curs, "+d.1");
  my $right = cell_get($curs);
  $curs = cell_nbr($curs, "+d.1");
  my $down = cell_get($curs);
  $curs = cell_nbr($curs, "+d.1");
  my $out = cell_get($curs);
  my $raster = cell_get(cell_nbr($curs, "+d.1"));
  my $quad = ($raster =~ /Q$/);
  my $window = "";

  # Draw window border, title and current cell number
  $window .= "<HTML><HEAD><TITLE>Zizl: $name Window</TITLE></HEAD>\n";
  $window .= "<BODY BGCOLOR=\"#C0C0C0\"><CENTER>\n";
#  $window .= "<H1>$name Window ($raster)</H1>\n";
  $window .= "<TABLE CELLPADDING=5>\n";
  $window .= "<CAPTION ALIGN=TOP>$name Window ($raster)</CAPTION>\n";

#  if ($USE_STATUSBAR)
#  {
#    addstr($win, $LINES - 2, int($COLS / 2) - length($cell) - 3, " $cell ");
#  }
#  else
#  {
#    addstr($Window[0], $LINES - 1, 1, " $Input_Buffer ")
#      if (defined $Input_Buffer) && ($number == 0);
#    addstr($win, $LINES - 1, int($COLS / 2) - length($cell) - 3, " $cell ");
#  }

  # Display dimension guide
#  my $guide =	"<FONT COLOR=\"#FF0000\"><PRE>" .
#		"+---> $right\n" .
#		"|\\\n" .
#		"|  \\| $out\n" .
#		"V  -+\n" .
#		"$down" .
#		"</PRE></FONT>";
  my $guide =	"<TABLE><TR><TD><IMG SRC=$GUIDE></TD>" .
		"<TD><FONT COLOR=\"#FF0000\">$right<BR>" .
		"<BR>$out</FONT></TD></TR>\n" .
		"<TR><TD><FONT COLOR=\"#FF0000\">$down</FONT></TD>" .
		"</TR></TABLE>\n";

  # Display window contents.
  my %layout;
  if ($raster =~ /^H/)
  { layout_Hraster(\%layout, $cell, $right, $down); }
  else
  { layout_Iraster(\%layout, $cell, $right, $down); }
  $window .= html_table_layout($guide, \%layout, $quad);

  $window .= "</TABLE>\n";
  $window .= "</BODY></HTML>\n";
  return $window;
}

sub html_start_page()
{
  my $page = "";
  my ($num, $curs);

  $page .= "<HTML><HEAD><TITLE>Zizl</TITLE></HEAD>\n";
  $page .= "<BODY BGCOLOR=#FFFFFF>\n";
  $page .= "<H1>Welcome to Zizl(tm)</H1>\n";
  for ($num = 0, $curs = get_cursor(0);
       defined $curs; $curs = cell_nbr($curs, "+d.2"), $num++)
  {
    $_ = cell_get($curs);
    $page .= "<H2><A HREF=$num TARGET=$num>$_ Window</A></H2>\n";
  }
  $page .= "</BODY></HTML>\n";
  return $page;
}

#
# Handle keyboard input.
# Named: input_*
#
sub input_get_any()
# Attempt to get any input
# NOTE: This function is also user interface toolkit specific!
{
#  my $key = getch();
#  if (($key eq "\e") && (($_ = getch()) ne -1))
#  { $key = meta_key($_); }
#  return $key eq -1 ? undef : $key;
}

sub input_get_direction()
# Attempt to get a direction key
{
  my $key;
  while (!defined($key = input_get_any())) {}  # Idle until we get a key

  if ($_ = $Keymap_Directions{$key})
  { @_ = split //; }
  else
  {
    # The key isn't a direction key
    user_error(1, $key);
    undef @_;
  }
}


#
# Handle signals and errors
#

sub catchsig()
# Handle fatal signals
{ $Zigzag_Terminated = $_[0]; die "Terminated"; }

sub user_error($$)
# Handle user errors
{
  my ($errno, $text) = @_;

  # I feel like this next should be a global.  It's not.
  my @errors =
  (
    "Key is not a valid keystroke",
    "Cannot insert - invalid neigbours",
    "Cannot jump to invalid or cursor cell",
    "Error executing cell",
    "Cannot hop - no neigbours",
    "Cannot jump to cell that does not exist",
    "Cannot break link - none exists",
    "Error opening file",
    "Cannot insert cells in selected dimension",
    "Cannot delete essential cell!",
    "Cannot delete essential dimension"
  );

#  beep(); 
#  if ($errno and $USE_STATUSBAR)
#  {
#    $errno--;
#    my $errmsg = "Error $errno";
#    $errmsg .= ": $errors[$errno]" if $errno <= $#errors;
#    if ($text)
#    { display_status_draw(substr("$errmsg ($text)", 0, $COLS)); }
#    else
#    { display_status_draw(substr("$errmsg", 0, $COLS)); }
#  }
#
#  if ($USE_STATUSBAR)
#  { display_refresh($Status); }
#  else
#  { display_refresh(); }
}


#
# Initialization functions
#

#
# Background functions, if any, can be executed here
#
sub idle()
{
  select(undef, undef, undef, 0.1);        # sleep for 1/10 second
}

#
# Network helper function
#
sub html_send($$)
{
  my ($connection, $content) = @_;

  my $response = new HTTP::Response(RC_OK);
  $response->content($content);
  $connection->send_response($response);
}

#
# Begin main.
#

slice_open(shift);

# Set the interrupt handlers
$SIG{INT} = $SIG{TERM} = \&catchsig;

display_open();
while (my $connection = $daemon->accept)
{
  while (my $request = $connection->get_request)
  {
    if ($request->method ne 'GET')
    { $connection->send_error(RC_METHOD_NOT_ALLOWED); }
    else
    {
      my $path = $request->url->path;
      if ($path eq "/")
      { html_send($connection, html_start_page()); }
      elsif ($path =~ m#^/$GUIDE$#)
      { $connection->send_file_response($GUIDE); }
      elsif (my ($win) = ($path =~ m#^/(\d+)$#))
      {
        my $content;
        eval { $content = html_layout_window($win) };
        if ($@)
        { $connection->send_error(RC_INTERNAL_SERVER_ERROR, $@); }
        else
        { html_send($connection, $content); }
      }
      else
      { $connection->send_error(RC_FORBIDDEN); }
    }
  }
  $connection->close;
  undef $connection;
}
display_close();
slice_close_all();
if ($Zigzag_Terminated)
{ print STDERR "Terminated by $Zigzag_Terminated signal\n"; }
else
{ die if $@; }

#
# End.
#