#!/usr/bin/perl -w
#
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/gtk-demo/main.pl,v 1.15 2005/04/02 17:03:45 kaffeetisch Exp $
#

our $PROGDIR = $0;
$PROGDIR =~ s/main.pl$//;

use strict;
use Carp;
use Glib qw(TRUE FALSE);
use Gtk2;
use Gtk2::Pango;
use Gtk2;


use vars qw/ @testgtk_demos /;

# lists of demo code descriptions.
# the func is a plain string in each of these, as a sentinel value to tell
# row_activated_cb that the file containing that function hasn't been 
# loaded yet.
my @child0 = (
  { title => "Editable Cells", filename => "editable_cells.pl", func => 'stub', },
  { title => "List Store",     filename => "list_store.pl",     func => 'stub', },
  { title => "Tree Store",     filename => "tree_store.pl",     func => 'stub', },
);

my @child1 = (
  { title => "Hypertext",       filename => "hypertext.pl",  func => 'stub', }, 
  { title => "Multiple Views",  filename => "textview.pl",   func => 'stub', }, 
);

@testgtk_demos = (
  { title => "Application main window",     filename => "appwindow.pl",     func => 'stub', }, 
  { title => "Button Boxes",                filename => "button_box.pl",    func => 'stub', }, 
  { title => "Change Display",              filename => "changedisplay.pl", func => 'stub', }, 
  { title => "Color Selector",              filename => "colorsel.pl",      func => 'stub', }, 
  { title => "Dialog and Message Boxes",    filename => "dialog.pl",        func => 'stub', }, 
  { title => "Drawing Area",                filename => "drawingarea.pl",   func => 'stub', }, 
  { title => "Images",                      filename => "images.pl",        func => 'stub', }, 
  { title => "Item Factory",                filename => "item_factory.pl",  func => 'stub', }, 
  { title => "Menus",                       filename => "menus.pl",         func => 'stub', }, 
  { title => "Paned Widgets",               filename => "panes.pl",         func => 'stub', }, 
  { title => "Pixbufs",                     filename => "pixbufs.pl",       func => 'stub', }, 
  { title => "Size Groups",                 filename => "sizegroup.pl",     func => 'stub', }, 
  { title => "Stock Item and Icon Browser", filename => "stock_browser.pl", func => 'stub', }, 
  { title => "Text Widget", children => \@child1 },
  { title => "Tree View",   children => \@child0 },
);

push @testgtk_demos,
  { title => "Entry Completion", filename => "entry_completion.pl", func => 'stub', },
  { title => "UI Manager",       filename => "ui_manager.pl",       func => 'stub', }
	if Gtk2->CHECK_VERSION (2, 4, 0);

push @testgtk_demos,
  { title => "Rotated Text", filename => "rotated_text.pl", func => 'stub', },
	if Gtk2->CHECK_VERSION (2, 6, 0);

# some globals.
my $info_buffer;
my $source_buffer;

my $current_file;

# clean names for column numbers.
use constant TITLE_COLUMN    => 0;
use constant FILENAME_COLUMN => 1;
use constant FUNC_COLUMN     => 2;
use constant ITALIC_COLUMN   => 3;
use constant NUM_COLUMNS     => 4;


#/**
# * demo_find_file:
# * @base: base filename
# * @err:  location to store error, or %NULL.
# * 
# * Looks for @base first in the current directory, then in the
# * location GTK+ where it will be installed on make install,
# * returns the first file found.
# * 
# * Return value: the filename, if found or %NULL
# **/
sub demo_find_file {
	my $base = shift;

	return $base if -e $base;

	my $filename = $PROGDIR.$base;
	croak "Cannot find demo data file $base ($filename)\n"
		unless -e $filename;

	return $filename;
}

sub window_closed_cb {
	my ($window, $cbdata) = @_;

	my $iter = $cbdata->{model}->get_iter ($cbdata->{path});
	my ($italic) = $cbdata->{model}->get ($iter, ITALIC_COLUMN);
	$cbdata->{model}->set ($iter, ITALIC_COLUMN, !$italic)
		if $italic;
}


#
# Stupid syntax highlighting.
#
# No regex was used in the making of this highlighting.
# It should only work for simple cases.  This is good, as
# that's all we should have in the demos.
#
# This code should not be used elsewhere, except perhaps as an example of how
# to iterate through a text buffer.
#
use constant STATE_NORMAL => 0;
use constant STATE_IN_COMMENT => 1;

=out

static gchar *tokens[] =
{
  "/*",
  "\"",
  NULL
};

static gchar *types[] =
{
  "static",
  "const ",
  "void",
  "gint",
  "int ",
  "char ",
  "gchar ",
  "gfloat",
  "float",
  "gint8",
  "gint16",
  "gint32",
  "guint",
  "guint8",
  "guint16",
  "guint32",
  "guchar",
  "glong",
  "gboolean" ,
  "gshort",
  "gushort",
  "gulong",
  "gdouble",
  "gldouble",
  "gpointer",
  "NULL",
  "GList",
  "GSList",
  "FALSE",
  "TRUE",
  "FILE ",
  "GtkObject ",
  "GtkColorSelection ",
  "GtkWidget ",
  "GtkButton ",
  "GdkColor ",
  "GdkRectangle ",
  "GdkEventExpose ",
  "GdkGC ",
  "GdkPixbufLoader ",
  "GdkPixbuf ",
  "GError",
  "size_t",
  NULL
};

static gchar *control[] =
{
  " if ",
  " while ",
  " else",
  " do ",
  " for ",
  "?",
  ":",
  "return ",
  "goto ",
  NULL
};
void
parse_chars (gchar     *text,
	     gchar    **end_ptr,
	     gint      *state,
	     gchar    **tag,
	     gboolean   start)
{
  gint i;
  gchar *next_token;

  /* Handle comments first */
  if (*state == STATE_IN_COMMENT)
    {
      *end_ptr = strstr (text, "*/");
      if (*end_ptr)
	{
	  *end_ptr += 2;
	  *state = STATE_NORMAL;
	  *tag = "comment";
	}
      return;
    }

  *tag = NULL;
  *end_ptr = NULL;

  /* check for comment */
  if (!strncmp (text, "/*", 2))
    {
      *end_ptr = strstr (text, "*/");
      if (*end_ptr)
	*end_ptr += 2;
      else
	*state = STATE_IN_COMMENT;
      *tag = "comment";
      return;
    }

  /* check for preprocessor defines */
  if (*text == '#' && start)
    {
      *end_ptr = NULL;
      *tag = "preprocessor";
      return;
    }

  /* functions */
  if (start && * text != '\t' && *text != ' ' && *text != '{' && *text != '}')
    {
      if (strstr (text, "("))
	{
	  *end_ptr = strstr (text, "(");
	  *tag = "function";
	  return;
	}
    }
  /* check for types */
  for (i = 0; types[i] != NULL; i++)
    if (!strncmp (text, types[i], strlen (types[i])))
      {
	*end_ptr = text + strlen (types[i]);
	*tag = "type";
	return;
      }

  /* check for control */
  for (i = 0; control[i] != NULL; i++)
    if (!strncmp (text, control[i], strlen (control[i])))
      {
	*end_ptr = text + strlen (control[i]);
	*tag = "control";
	return;
      }

  /* check for string */
  if (text[0] == '"')
    {
      gint maybe_escape = FALSE;

      *end_ptr = text + 1;
      *tag = "string";
      while (**end_ptr != '\000')
	{
	  if (**end_ptr == '\"' && !maybe_escape)
	    {
	      *end_ptr += 1;
	      return;
	    }
	  if (**end_ptr == '\\')
	    maybe_escape = TRUE;
	  else
	    maybe_escape = FALSE;
	  *end_ptr += 1;
	}
      return;
    }

  /* not at the start of a tag.  Find the next one. */
  for (i = 0; tokens[i] != NULL; i++)
    {
      next_token = strstr (text, tokens[i]);
      if (next_token)
	{
	  if (*end_ptr)
	    *end_ptr = (*end_ptr<next_token)?*end_ptr:next_token;
	  else
	    *end_ptr = next_token;
	}
    }

  for (i = 0; types[i] != NULL; i++)
    {
      next_token = strstr (text, types[i]);
      if (next_token)
	{
	  if (*end_ptr)
	    *end_ptr = (*end_ptr<next_token)?*end_ptr:next_token;
	  else
	    *end_ptr = next_token;
	}
    }

  for (i = 0; control[i] != NULL; i++)
    {
      next_token = strstr (text, control[i]);
      if (next_token)
	{
	  if (*end_ptr)
	    *end_ptr = (*end_ptr<next_token)?*end_ptr:next_token;
	  else
	    *end_ptr = next_token;
	}
    }
}

=cut

#
# While not as cool as c-mode, this will do as a quick attempt at highlighting 
#
sub fontify {
  my $text;
  my ($end_ptr, $tag);

  my $state = STATE_NORMAL;

  my $start_iter = $source_buffer->get_iter_at_offset (0);

##  my $next_iter = $start_iter->copy;
  my $next_iter = $start_iter;
  while ($next_iter = $next_iter->forward_line) {
      my $start = TRUE;
      my $start_ptr = $text = $start_iter->get_text ($next_iter);

      do {
	  ($end_ptr, $tag) = parse_chars ($start_ptr, $state, $start);
	  my $tmp_iter;

	  $start = FALSE;
	  if ($end_ptr) {
##	      $tmp_iter = $start_iter->copy;
	      $tmp_iter = $start_iter;
	      $tmp_iter->forward_chars ($end_ptr - $start_ptr);
	  } else {
##	      $tmp_iter = $next_iter->copy;
	      $tmp_iter = $next_iter;
	  }
	  if ($tag) {
	    $source_buffer->apply_tag_by_name ($tag, $start_iter, $tmp_iter);
	  }

	  $start_iter = $tmp_iter;
	  $start_ptr = $end_ptr;
      } while ($end_ptr);

##      $start_iter = $next_iter->copy;
      $start_iter = $next_iter;
    }
}


sub load_file {
  my $filename = shift;
  my $state = 0;
  my $in_para = 0;

  return if defined $current_file and $current_file eq $filename;

  $current_file = $filename;

  $info_buffer->delete ($info_buffer->get_bounds);

  $source_buffer->delete ($source_buffer->get_bounds);

  my $full_filename;
  eval { $full_filename = demo_find_file ($filename); };
  if ($@) { warn $@; }

  local *IN;
  open IN, $full_filename
      or warn("cannot open $full_filename: $!\n"), return;

  my $start = $info_buffer->get_iter_at_offset (0);
  while (<IN>) {
       if ($state == 0) {
         # Reading title
	 if (/^#!/) {
              # skip the interpreter line...
	 } elsif (/^\s*#?\s*$/) {
              # skip blank lines preceding the title
	 } else {
              # this must be the title!
	      s/^#\s*//;
	      s/\s*$//;

##              my $end = $start->copy;
              my $end = $start;
              $info_buffer->insert ($end, $_);
##              $start = $end;
###print "$start $end\n";

#	      gtk_text_iter_backward_chars (&start, len_chars);
$start = $info_buffer->get_iter_at_offset (0);
              $info_buffer->apply_tag_by_name ("title", $start, $end);
#
	      $start = $end;

	      $state++;
	 }

       } elsif ($state == 1) {
          # Reading body of info section
          if (/^\s*$/) {
              # completely blank line ends the info section.
              $state++;
          } else {
              # strip leading junk
              s/^#?\s+//;

              # strip trailing junk
              s/\s+$//;

	      if (length($_) > 0) {
		  $info_buffer->insert ($start, " ")
			if $in_para;

		  $info_buffer->insert ($start, $_);
		  $in_para = 1;
	      } else {
		  $info_buffer->insert ($start, "\n");
		  $in_para = 0;
              }
	  }

       } elsif ($state == 2) {
          # Skipping blank lines
	  s/^\s+//;
	  if (length ($_)) {
	    $state++;
	    $start = $source_buffer->get_iter_at_offset (0);
            $source_buffer->insert ($start, $_);
          }
       } elsif ($state == 3) {
          # Reading program body
          $source_buffer->insert ($start, $_);
       }
   }

#  fontify ();
}

sub row_activated_cb {
   my ($tree_view, $path, $column) = @_;

   my $model = $tree_view->get_model;

   my $iter = $model->get_iter ($path);
   my ($filename, $func, $italic) = $model->get ($iter, 
                                                 FILENAME_COLUMN, 
                                                 FUNC_COLUMN,
                                                 ITALIC_COLUMN);

   # this is rather a bit of a departure from the C version.
   # in the C version, the various demos are in separate modules that 
   # get compiled into the program.  perl doesn't work that way.  so, we 
   # have the code in external files that define a package with the same
   # name as the file (sans the .pl).  if the demo has never been run,
   # the func column will contain a string; when we see that, we'll
   # require the file, set the func column to point to the "do" method
   # within that file's declared package, and then retrieve that function
   # pointer again.  it's a kind of hackish lazy loading mechanism.
   # don't try this at home.
   if ('CODE' ne ref $func) {
       my $pkg = $filename;
       $filename = demo_find_file($filename);
       require $filename;
       $pkg =~ s/\.pl$//;
       eval '$model->set ($iter, FUNC_COLUMN, \&'.$pkg.'::do);';
       ($func) = $model->get ($iter, FUNC_COLUMN);
   }

   if ($func) {
       # set this row italic to show that the demo is running...
       $model->set ($iter, ITALIC_COLUMN, !$italic);
       my $window = $func->($tree_view->get_toplevel);
       if ($window) {
          # unset the italics when the window closes.
	  $window->signal_connect (destroy => \&window_closed_cb, 
	                           { model => $model, path => $path->copy });
       }
   }
}

sub selection_cb {
  my ($selection, $model) = @_;

  my $iter = $selection->get_selected;
  return unless defined $iter;

  my ($name) = $model->get ($iter, FILENAME_COLUMN);

  load_file ($name) if $name;
}

sub create_text {
  my ($buffer_ref, $is_source) = @_;

  my $scrolled_window = Gtk2::ScrolledWindow->new;
  $scrolled_window->set_policy ('automatic', 'automatic');
  $scrolled_window->set_shadow_type ('in');

  my $text_view = Gtk2::TextView->new;

  $$buffer_ref = Gtk2::TextBuffer->new (undef);
  $text_view->set_buffer ($$buffer_ref);
  $text_view->set_editable (FALSE);
  $text_view->set_cursor_visible (FALSE);

  $scrolled_window->add ($text_view);

  if ($is_source) {
       my $font_desc = Gtk2::Pango::FontDescription->from_string ("Courier 12");
       $text_view->modify_font ($font_desc);

       $text_view->set_wrap_mode ('none');
  } else {
       # Make it a bit nicer for text.
       $text_view->set_wrap_mode ('word');
       $text_view->set_pixels_above_lines (2);
       $text_view->set_pixels_below_lines (2);
  }
  
  return $scrolled_window;
}

sub create_tree {

   my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
   my $tree_view = Gtk2::TreeView->new;
   $tree_view->set_model ($model);
   my $selection = $tree_view->get_selection;

   $selection->set_mode ('browse');
   $tree_view->set_size_request (200, -1);

   #
   # this code only supports 1 level of children. If we
   # want more we probably have to use a recursing function.
   #
   foreach my $d (@testgtk_demos) {
      my $iter = $model->append (undef);

      $model->set ($iter,
                   TITLE_COLUMN,    $d->{title},
                   FILENAME_COLUMN, $d->{filename} || '',
                   FUNC_COLUMN,     $d->{func}     || '',
                   ITALIC_COLUMN,   FALSE);

      next unless $d->{children};

      foreach my $child (@{ $d->{children} }) {
         my $child_iter = $model->append ($iter);

         $model->set ($child_iter,
                      TITLE_COLUMN,    $child->{title},
                      FILENAME_COLUMN, $child->{filename},
                      FUNC_COLUMN,     $child->{func},
                      ITALIC_COLUMN,   FALSE);
      }
   }

   my $cell = Gtk2::CellRendererText->new;

  $cell->set ('style' => 'italic');
  
  my $column = Gtk2::TreeViewColumn->new_with_attributes
 					("Widget (double click for demo)",
                                        $cell,
                                        'text' => TITLE_COLUMN,
                                        'style_set' => ITALIC_COLUMN);

  $tree_view->append_column ($column);

  $selection->signal_connect (changed => \&selection_cb, $model);
  $tree_view->signal_connect (row_activated => \&row_activated_cb, $model);

  $tree_view->expand_all;
  return $tree_view;
}

sub setup_default_icon {
  my $pixbuf;
  eval { $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file 
      				(demo_find_file ("gtk-logo-rgb.gif")); };
  if ($@) {
     my $dialog = Gtk2::MessageDialog->new (undef, [], 'error', 'close',
                                            "Failed to read icon file: $@");
     $dialog->signal_connect (response => sub { $_[0]->destroy; 1 });
  }

  if ($pixbuf) {
    # The gtk-logo-rgb icon has a white background, make it transparent 
    my $transparent = $pixbuf->add_alpha (TRUE, 0xff, 0xff, 0xff);

    # only one item on the parameter list, but the parameter list is a list
    Gtk2::Window->set_default_icon_list ($transparent);
  }
}

Gtk2->init;

setup_default_icon ();
  
my $window = Gtk2::Window->new;
$window->set_title ("Gtk2-Perl Code Demos");
$window->signal_connect (destroy => sub { Gtk2->main_quit; 1 });

my $hbox = Gtk2::HBox->new (FALSE, 0);
$window->add ($hbox);

my $tree = create_tree ();
$hbox->pack_start ($tree, FALSE, FALSE, 0);

my $notebook = Gtk2::Notebook->new;
$hbox->pack_start ($notebook, TRUE, TRUE, 0);

$notebook->append_page (create_text (\$info_buffer, FALSE),
			Gtk2::Label->new_with_mnemonic ("_Info"));

$notebook->append_page (create_text (\$source_buffer, TRUE),
			Gtk2::Label->new_with_mnemonic ("_Source"));

  my $tag;
   $tag = $info_buffer->create_tag ("title", font => "Sans 18");

   $tag = $source_buffer->create_tag ("comment", foreground => "red");
   $tag = $source_buffer->create_tag ("type", foreground => "ForestGreen");
   $tag = $source_buffer->create_tag ("string", 
                                      foreground => "RosyBrown",
                                      weight => PANGO_WEIGHT_BOLD);
   $tag = $source_buffer->create_tag ("control", "foreground", "purple");
   $tag = $source_buffer->create_tag ('preprocessor', 
                                      style => 'oblique',
                                      foreground => 'burlywood4');
   $tag = $source_buffer->create_tag ('function',
                                      weight => PANGO_WEIGHT_BOLD, 
                                      foreground => 'DarkGoldenrod4');

   $window->set_default_size (600, 400);
   $window->show_all;

# this happens anyway, when the list selects the first item on show
#  load_file ($testgtk_demos[0]{filename});
 
  Gtk2->main;
__END__
Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
full list)

This library is free software; you can redistribute it and/or modify it under
the terms of the GNU Library General Public License as published by the Free
Software Foundation; either version 2.1 of the License, or (at your option) any
later version.

This library 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 Library General Public License for more
details.

You should have received a copy of the GNU Library General Public License along
with this library; if not, write to the Free Software Foundation, Inc., 59
Temple Place - Suite 330, Boston, MA  02111-1307  USA.