view release on metacpan or  search on metacpan

lib/CAD/Drawing/IO/Tk.pm  view on Meta::CPAN

=head1 COPYRIGHT

This module is copyright (C) 2004-2006 by Eric L. Wilhelm.  Portions
copyright (C) 2003 by Eric L. Wilhelm and A. Zahner Co.

=head1 LICENSE

This module is distributed under the same terms as Perl.  See the Perl
source package for details.

You may use this software under one of the following licenses:

  (1) GNU General Public License
    (found at http://www.gnu.org/copyleft/gpl.html)
  (2) Artistic License
    (found at http://www.perl.com/pub/language/misc/Artistic.html)

=head1 NO WARRANTY

This software is distributed with ABSOLUTELY NO WARRANTY.  The author,
his former employer, and any other contributors will in no way be held
liable for any loss or damages resulting from its use.

=head1 Modifications

The source code of this module is made freely available and
distributable under the GPL or Artistic License.  Modifications to and
use of this software must adhere to one of these licenses.  Changes to
the code should be noted as such and this notification (as well as the
above copyright information) must remain intact on all copies of the
code.

Additionally, while the author is actively developing this code,
notification of any intended changes or extensions would be most helpful
in avoiding repeated work for all parties involved.  Please contact the
author with any such development plans.

=head1 SEE ALSO

  CAD::Drawing::IO
  Tk

=cut

=head1 Methods

There is no constructor for this class, its methods are inherited via
CAD::Drawing::IO

=head1  Thoughts

Need to re-structure the entire deal to have its own object which
belongs to the drawing object (or does the drawing object belong to this
object?)  Either way, we need to be able to build-up into interactive
commands (possibly using eval("\$drw->$command"); ?)

Ultimately, the focus here will likely drift toward supporting perlcad
and enabling use of perlcad from within CAD::Drawing scripts.  However,
the nature of lights-out scripting vs the nature of on-screen drafting
is quite different, so there will be some tricks involved.  Once each
entity has its own class, the ability to install callbacks and the
resolution of notifications should get easier.  But, there will still
be the issue that a debug popup does not know it will appear when the
entities are created, while a drafting viewport does (or does it?)

Possibly, adding a list of tk-id's to each $obj as it is drawn would be
a good starting point, but this gets us into trouble with multiple
viewports.

=cut

=head2 show

Creates a new window (no options are required.)

  $drw->show(%options);

=over

=item Available Options

  forkokay  => bool         -- Attempt to fork the new window
  window    => MainWindow   -- Use the pre-existing Tk object
  stl       => Message      -- Use pre-existing Message widget
  size      => [W,H]        -- Specify window size in pixels
  width     => W            -- alias to size
  height    => H            -- ditto
  center    => [X,Y]        -- Center the drawing at (X,Y)
  scale     => factor       -- Zoom by factor (default to fit)
  bgcolor   => color        -- defaults to "white"
  hang      => boolean      -- if not, you just get the canvas widget
  items     => \@list       -- sorry, not compatible with select_addr :(

=back

=cut
sub show {
	my $self = shift;
	my %options = @_;
	# XXX cannot do "use" or we get silly _TK_EXIT_(0) from everywhere!
	require Tk;
	require Tk::WorldCanvas;
	my $kidpid;
	if($options{forkokay}) {
		$SIG{CHILD} = 'IGNORE';
		if($kidpid = fork()) {
			return($kidpid);
		}
		defined($kidpid) or croak("cannot fork $!\n");
		$options{forkokay} = 0;
	}
	my $mw = $options{window};
	defined($mw) || ($mw = MainWindow->new());
	unless($options{size}) {
		foreach my $item ("width", "height") {
			my $val = $options{$item};
			$val || ($val = $default{$item});
			push(@{$options{size}}, $val);
		}
	}
	$options{bgcolor} || ($options{bgcolor} = "white");