view release on metacpan or  search on metacpan

ZIO_Tk.pm  view on Meta::CPAN

  my $canvas_x = $options->{"x"} || int($w_main->screenwidth * 0.7);
  my $canvas_y;
  if ($options->{"y"}) {
    $canvas_y = $options->{"y"};
  } else {
    my $y = int($w_main->screenheight * 0.6);
    my $rows = int($y / $line_height);
    $canvas_y = $rows * $line_height;
    # round to a multiple of the line height
  }

  $c = $w_main->Canvas(
		       "-width" => $canvas_x,
		       "-height" => $canvas_y,
		       "-bg" => $self->default_bg(),
		       "-takefocus" => 1,
		       "-highlightthickness" => 0,
		      );

  if ($need_status) {
    $status_line = $w_main->Canvas(
				   "-borderwidth" => 0,
				   "-relief" => "flat",
				   "-width" => $canvas_x,
				   "-height" => $line_height,
				   "-bg" => $self->sbg(),
				   "-takefocus" => 0,
				  );
    
    $status_line->pack("-anchor" => "n",
		       "-fill" => "x");
  }

  $self->line_height($line_height);
  $Y_BORDER = $line_height / 2;

  $self->fixed_font_width($font_width);

  $self->set_geometry();

  $abs_x = X_BORDER;
  # HACK

  $abs_col = 0;
  $abs_row = int($canvas_y / $line_height);

  $c->pack("-anchor" => "s",
	   "-expand" => 1,
	   "-fill" => "both");

  $w_main->after(0, $init_sub);
  # delay required??

  $initialized = 1;

  MainLoop;

  return 1;
}

sub update {
  # force screen refresh
  $c->update();
}

sub fatal_error {
  if ($initialized) {
    $_[0]->SUPER::fatal_error($_[1]);
  } else {
    die $_[1];
  }
}

sub fixed_font_default {
  # true or false: does this zio use a fixed-width font?
  return 0;
}

sub manual_status_line {
  # true or false: does this zio want to draw the status line itself?
  return 1;
}

sub create_text {
  # given a widget, create text w/specified properties.
  # automatically adds the tag for the current font in effect.
  my ($self, $widget, @args) = @_;
  push @args, ("-font" => $self->current_font()) if $self->current_font();
#  printf STDERR "ct in %s: %s\n", $widget, join ",",@args;
  return $self->last_text_id($widget->create("text", @args));
}

sub write_string {
  my ($self, $string, $x, $y) = @_;
  $self->absolute_move($x, $y) if defined($x) and defined($y);
  my $abs_y = $self->get_y();
  
#  printf STDERR "ws: \"%s\" at %d,%d; font=%s\n", $string, $abs_col, $abs_row, $self->zfont();

  my $is_f3;
  if ($self->zfont() == 3) {
    $self->fatal_error("long buf in write_string w/font 3 on") if length($string) > 1;
    $is_f3 = 1;
  }

  foreach my $list (@widgets) {
    # for each window...
    my $line = $list->[$abs_row];
    my $after = $abs_col + length($string);
    for (my $col=$abs_col; $col < $after; $col++) {
      # see if existing widgets exist at this location
      if (exists $line->{$col}) {
	# they do,
	foreach (@{$line->{$col}}) {
	  # so toss them.
	  $c->delete($_);
	}
	delete $line->{$col};
      }
    }
  }