package ATR::Tk::AtrCard;

use strict;
use warnings;
use Carp;

use Tk::Canvas;
use Tk::Derived;
use Tk::ROText;
use Tk::Pane; # a scrollable Frame
use Tk::Balloon;

#use Tk::Font;
use ATR::Tk::Font;
use ATR::Tk::BarcodeImage;

use ATR::Tk::AnimalTransfer;
use ATR::Util;

use base qw(Tk::Derived Tk::Frame);
Tk::Widget->Construct('AtrCard');

sub Populate {
    my ($self, $args) = @_;

    croak "Do not pass -card param, use setCard()" if exists $args->{-card};

    $self->SUPER::Populate($args);
    $self->ConfigSpecs(-printwidth  => [qw[METHOD printWidth  PrintWidth  130]], # millimetres
		       -printheight => [qw[METHOD printHeight PrintHeight  90]],
		       -datapoints  => [qw[METHOD dataPoints  DataPoints    9]], # fonts, printable points
		       -titlepoints => [qw[METHOD titlePoints TitlePoints  13]],
		       -guiscale =>    [qw[METHOD guiScale GuiScale]]); # print millimetres to requested screen 'm's

# Button area
    $self->Advertise('operators',
		     $self->Frame(Name => "buttons_f") # config by optdb
		     ->pack(-side => 'bottom', -fill => 'x')
		    );
    my $ops = $self->Subwidget('operators');


# Card area: bordered frame (printable card), within outer container
    # nb. Scrolled('Pane') has a significant creation overhead (switch scrollbars off?)
#    my $pane = $self->Scrolled('Pane', -scrollbars => 'osoe')
    my $pane = $self->Frame
	->pack(-side => 'top', -fill => 'both', -expand => 1);
    my $card_f = $pane->Frame(Name => 'card_f'); # pack it later (_fixSize)
    $self->Advertise(card_f => $card_f);
    $self->Advertise(card_f_parent => $pane);

    # XXX:DEBUG
    $ops->Button(-text => 'Debug size', -command => [ $self, 'showSliders' ])->pack(-side => 'left');
    $self->afterIdle(sub {
	$card_f->Label(-font => $self->getFont('data'), -text => "A line of data font for size comparison")
	  ->place(-x => 32, -rely => 1.0, '-y' => -4, -anchor => 'sw');
    });

# Buttons for any card
    $ops->Button(-text => 'Update',
		 -font => $self->getFont('furniture'),
		 -command => [ $self, 'op_update' ])->pack(-side => 'right');
    $ops->Button(-text => 'Close / discard',
		 -font => $self->getFont('furniture'),
		 -command => [ $self, 'op_close' ])->pack(-side => 'right');
    $ops->Button(-text => 'Print',
		 -font => $self->getFont('furniture'),
		 -command => [ $self, 'op_print' ])->pack(-side => 'right');

# Header area
    $self->Advertise('head_f', $card_f->Frame(Name => 'head_f')  # config by optdb
		     ->pack(-side => 'top', -fill => 'x')
		    );

    # XXX: do with ClassInit
    $pane->bind('<Configure>' => [ $self, 'Xconfig' ]);
}

sub tlBalloon {
    my $self = shift;
    return ATR::Util::tlBalloon($self);
}

sub setCard {
    my ($self, $card) = @_;
    die "Already have a card, cannot set another" if $self->haveCard;
    $self->_setCard($card);
}

sub Xconfig {
    my $self = shift;
    $self->calcGuiscale; # assume it's a resize event...?
}

sub getFont {
    my ($self, $name) = @_;
    return $self->toplevel->furnitureFont if $name eq 'furniture';
    my $F = $self->privateData->{fonts} ||= {};
    return values %$F if !defined $name;
    my $font = $F->{$name};
    if (!$font) {
	my @fonts = $self->toplevel->fontNames;
	my $num = @fonts; # suffix to make font name unique in window
	$font = $self->Font($name.$num);
	$F->{$name} = $font;
    }
    return $font;
}

sub guiscale {
    my $self = shift;
    return $self->privateData->{_conf_guiscale} if !@_;

    my $newval = shift;
    $newval = 0.5 if $newval < 0.5;
    $self->privateData->{_conf_guiscale} = $newval;
    $self->privateData->{_sliderVars}->{guiscale} = $newval; # XXX:DEBUG extra var for the slider

    $self->_fontsUpdate;
    $self->_fixSize;
}

sub printwidth {
    my $self = shift;
    return $self->privateData->{_conf_printwidth} if !@_;
    $self->privateData->{_conf_printwidth} = shift;
    $self->_fixSize;
}

sub printheight {
    my $self = shift;
    return $self->privateData->{_conf_printheight} if !@_;
    $self->privateData->{_conf_printheight} = shift;
    $self->_fixSize;
}

sub datapoints {
    my $self = shift;
    return $self->privateData->{_conf_datapoints} if !@_;
    $self->privateData->{_conf_datapoints} = shift;
    $self->_fontsUpdate;
}

sub titlepoints {
    my $self = shift;
    return $self->privateData->{_conf_titlepoints} if !@_;
    $self->privateData->{_conf_titlepoints} = shift;
    $self->_fontsUpdate;
}

sub _fontsUpdate {
    my ($self) = @_;
    my ($guiscale, $datapoints, $titlepoints)
      = map { $self->cget($_) } qw[-guiscale -datapoints -titlepoints];
    return if grep { !defined } ($guiscale, $datapoints, $titlepoints);

    # Reconfigure fonts when necessary
    my $ms_word_scale = 1.2; # the factor to multiply MS Word (or OpenOffice) font size to get PS font size (!)
    my %fonts = (label 	   => [	-family => 'helvetica', -size => $datapoints, -weight => 'bold' ],
		 data  	   => [	-family => 'helvetica', -size => $datapoints ],
		 titledata => [	-family => 'helvetica', -size => $titlepoints, -weight => 'bold' ],
		 title 	   => [	-family => 'helvetica', -size => $titlepoints ],
		);
    my %changed;
    foreach my $name (keys %fonts) {
	my $font = $self->getFont($name);
	my %attr = @{ $fonts{$name} };
	$attr{-size} *= $guiscale * $ms_word_scale;

	my $old_size = $font->fracsize;
	next unless abs($old_size - $attr{-size}) > 0.05;

	$font->configure(%attr);
	$changed{$font} = $font;
    }

    # Now ensure all widgets resize to match (at some point)
    return unless scalar keys %changed;
    foreach my $w ($self->getAllFields) {
	next unless $w->isa('ATR::Tk::UpdateEntry');
	my ($d, $l) = ($w->cget('-datafont'), $w->cget('-labelfont'));
	next unless $changed{$d} || $changed{$l};
	$w->dataSizeChange();
    }
}

sub _fixSize {
    my $self = shift;

    # Don't try unless we have the necessary numbers.  We'll get another call when we do.
    my ($guiscale, $datapoints, $titlepoints, @print_mm)
      = map { $self->cget($_) } qw[-guiscale -datapoints -titlepoints -printwidth -printheight];
    return if grep { !defined } ($guiscale, @print_mm, $datapoints, $titlepoints);
    my @screen_mm = map { $guiscale * $_ } @print_mm;

## find out what the requested size was
#    $card_f->packPropagate(1);
#    $card_f->update;
#    my @req_mm = map { $_ / $card_f->scaling * 25.4 / 72 } ($card_f->reqwidth, $card_f->reqheight);
#    warn "req = (@req_mm) mm, given (@screen_mm) mm\n";

    my $card_f = $self->Subwidget('card_f');
    $card_f->pack(-anchor => 'center') unless $card_f->manager;
    $card_f->packPropagate(0) if $card_f->packPropagate();
    $card_f->configure(-width => "$screen_mm[0]m", -height => "$screen_mm[1]m");

    my $len = 368 / 2.3 * $guiscale;
    $self->Subwidget('barcode')
      ->resize(length => $len,
	       width => $len * 0.15,
	       border => $len * 0.02);
}

sub getAllFields { # return all UpdateEntry widgets on the form (or other stuff returned by getAllParts)
    my $self = shift;
    my @parts = $self->getAllParts;
    my @widg = safemap {
	my $part = shift;
	$part->isa('ATR::Tk::CardRow') ? ($part->getCommitOrderWidgets) : ($part);
    } @parts;
    return @widg;
}


#----------------------------------------------------------------------------
#
# Debug sliders

sub showSliders {
    my $self = shift;
    return if Tk::Exists($self->privateData->{sizeSlides});

    my $W = $self->Toplevel();
    $W->title('Debug sliders');
    $W->transient($self->toplevel);
    $self->privateData->{sizeSlides} = $W;

    my $S = $self->privateData->{_sliderVars};
    foreach my $k (qw{guiscale datapoints titlepoints printwidth printheight})
      { $S->{$k} = $self->cget("-$k") }

    $W->Label(-text => 'GUI scale')->grid(-row => 0, -col => 0);
    $W->Label(-text => 'Data font size (OOish)')->grid(-row => 1, -col => 0);
    $W->Label(-text => 'Title font size (OOish)')->grid(-row => 2, -col => 0);
    $W->Scale(-command => [ $self, 'slid' ],
	      -length => 256, -width => 16, -orient => 'horiz', -resolution => 0, -showvalue => 1,
	      -from => 0.75, -to => 3, -variable => \$S->{guiscale},
	     )->grid(-row => 0, -col => 1);
    $W->Scale(-command => [ $self, 'slid' ],
	      -length => 256, -width => 16, -orient => 'horiz', -resolution => 0.1, -showvalue => 1,
	      -from => 6, -to => 24, -variable => \$S->{datapoints},
	     )->grid(-row => 1, -col => 1);
    $W->Scale(-command => [ $self, 'slid' ],
	      -length => 256, -width => 16, -orient => 'horiz', -resolution => 0.1, -showvalue => 1,
	      -from => 10, -to => 28, -variable => \$S->{titlepoints},
	     )->grid(-row => 2, -col => 1);
    $W->Button(-text => 'Calc', -command => [ $self, 'calcGuiscale' ])->grid(-row => 0, -col => 2);

    $W->Label(-text => 'Print width (mm)')->grid(-row => 3, -col => 0);
    $W->Label(-text => 'Print height (mm)')->grid(-row => 4, -col => 0);
    $W->Scale(-command => [ $self, 'slid' ],
	      -length => 256, -width => 16, -orient => 'horiz', -resolution => 0.5, -showvalue => 1,
	      -from => 70, -to => 210, -variable => \$S->{printwidth},
	     )->grid(-row => 3, -col => 1);
    $W->Scale(-command => [ $self, 'slid' ],
	      -length => 256, -width => 16, -orient => 'horiz', -resolution => 0.5, -showvalue => 1,
	      -from => 70, -to => 210, -variable => \$S->{printheight},
	     )->grid(-row => 4, -col => 1);
}

sub calcGuiscale {
    my $self = shift;

#    $self->update;
    my $card_f = $self->Subwidget('card_f');
    my $pane = $self->Subwidget('card_f_parent');

#print "calc for ".$pane->PathName."\n     for ".$card_f->PathName."\n";
# calc for .main_tabs.pg2.matingcard.frame
#      for .main_tabs.pg2.matingcard.frame.pane.frame.card_f

    my @print = map { $self->fpixels( $self->cget($_)."m" ) } qw(-printwidth -printheight);

    # This reads slightly small if the scrollbars are active - then
    # they go away on the resize.

    # Also, available space may shrink if we increase the data font
    # size, because the button area grows too.

    my @avail = ($pane->width, $pane->height);
    return if $avail[0] < 10; # working out size before the widgets have a size

    # Due to the above, calculate size to be a little small
    # But know the real available space when we calculate laziness
    $avail[1] -= 32;
    my @scale = map { ($avail[$_]-4) / $print[$_] } (0, 1);
    $avail[1] += 32;

    # Pick guiscale to fit smallest dimension
    my $min = $scale[0] > $scale[1] ? $scale[1] : $scale[0];

    # Figure out how big it will be if we resize,
    # then decide whether it's worth the effort changing
    my $old = $self->cget('-guiscale') || 0;
    my $lazy = 1;
    if ($old && $old > 0.01) {
	my @current = map { $old * $_ } @print;
	my @new     = map { $min * $_ } @print;
	for my $dim (0, 1) {
	    $lazy = 0 if $current[$dim] > $avail[$dim]; # old size doesn't fit
	    my $gap = $new[$dim] - $current[$dim];
	    $lazy = 0 if abs($gap) > 64; # card size on screen is significantly wrong
	}
    } else {
	$lazy = 0; # was unsized
    }
    return if $lazy;

    # Sometimes we get called twice, and do the calculation twice without and update
    my $scale = ($old > 0.01) ? ($min/$old) : 500;
#print "   scale factor *= $scale ($old -> $min)\n";
    $self->configure(-guiscale => $min) if abs($scale - 1.0) > 0.001;
}

sub slid { # XXX:DEBUG only
    my $self = shift;
    my $S = $self->privateData->{_sliderVars};
    # XXX: nb. this will do _fixSize many times:
    foreach my $k (qw{printwidth printheight guiscale datapoints titlepoints})
      { $self->configure("-$k" => $S->{$k}) if defined $S->{$k} }
# my $factor = $widget->scaling; # returns fractional number of pixels per point (1/72 inch)
# my $fracpix = $widget->fpixels("2m"); # convert 2mm into fractional screen pixels
}

#----------------------------------------------------------------------------

sub fieldsUpdate {
    my $self = shift;
    my $ok = eval { $self->_fieldsUpdate; 1 };
    if (!$ok) {
	$self->fatalCardError(-preamble => "This card is in a confused state.\nPlease try reloading it, or contact support with the message below.\nError message:",
			      -error => $@,
			      -errortype => ref($@) || '[none]',
			      -full => Carp::longmess);
    }
}

# Returns (generated_width, generated_height, paper_width, paper_height) of postscript, in cm
#   We have Tk generate Postscript at a larger scale because it
#   quantises the font sizes to integers; this way we lose less
#   precision.
sub generatePrintable {
    my ($self, $fh) = @_;
    my $card = $self->Subwidget('card_f');

    # Ensure card size
    $self->_fontsUpdate;
    $self->_fixSize;
    $card->update;

    # Make a temporary window, in which we can render the temporary
    # canvas.  This way, this class doesn't need to _be_ a canvas.
    my $tmpwin = $self->Toplevel;
    $tmpwin->title("Temporary Printing Window");
    my $canvas = $tmpwin->Scrolled('Canvas', -scrollbars => 'se')
      ->pack(-expand => '1', -fill => 'both');

    # Draw widget outlines to the canvas; dump postscript to file; tidy up.
    # Canvas must be on screen, else we get blown away by an X11 Pixmap error
    __print_drawcanvas($card, $canvas);
    $canvas->update;

    if (1) { # XXX:DEBUG
	# Pastel background for debugging
	my @bbox = $canvas->bbox('drawn'); # (xL, yT, xR, yB)
	my @bg = (# pink everywhere
#		  $canvas->createRectangle(-2000,-2000,2000,2000,
#					   -outline => undef,
#					   -fill => 'pink', -tags => 'bg'),
		  # light blue card area
		  $canvas->createRectangle($canvas->bbox("level0"),
					   -outline => undef,
					   -fill => '#dbf7ff', -tags => 'bg'),
		 );
	$canvas->Subwidget('canvas')->lower('bg', 'drawn');
    }

    $canvas->Subwidget('canvas')->raise('image', 'drawn'); # barcode on top

# Set printing area to card (excluding overflowed stuff) plus margin
# XXX: hardcoded margin, set to keep the DJ450 + G5 CUPS happy; OK for lasers too
    my @margin = (0.7, 0.1, 0.2, 1.3); # (left, top, right, bottom) in paper-scaled cm
    my @bbox = $canvas->bbox("level0");
    my $screen_cm = $self->fpixels("10m");
    my $guiscale = $self->cget('-guiscale');
    for (my $i=0; $i<4; $i++) {
	$bbox[$i] += $margin[$i] * $screen_cm * $guiscale * ($i < 2 ? -1 : +1);
    }

    my %fontmap = map { $_->makeFontmap } $self->fontNames;
    print $fh $canvas->postscript(-rotate => 0,
				  -fontmap => \%fontmap,

				  # Give the bounding box
				  -x   => $bbox[0],
				  '-y' => $bbox[1],
				  -height => abs($bbox[3] - $bbox[1]),
				  -width  => abs($bbox[2] - $bbox[0]),
				  -pageanchor => 'sw', # bottom left of canvas printing area

				  # Position on page: bottom left, plus border
				  # page(width,height): default to canvas printing area size
				  -pagex => '0m',
				  -pagey => '0m',
				 );
    close $fh;

    # Tidy up
    if (0) { # XXX:DEBUG
	$canvas->configure(-scrollregion => \@bbox);
    } else {
	$tmpwin->destroy;
    }

    my @screen_size = (abs($bbox[2] - $bbox[0]) / $screen_cm,
		       abs($bbox[3] - $bbox[1]) / $screen_cm);
    return (@screen_size, map { $_ / $guiscale } @screen_size);
}

sub __print_drawcanvas {
    my ($card, $canvas) = @_;

    my $do_draw = sub {
	my ($item, $lvl, $info) = @_;
	my ($rel_x, $rel_y) = @$info;
	my $path = $item->PathName; # mostly includes name at the end
	my ($x, $y) = ($rel_x + $item->x,
		       $rel_y + $item->y);
	my ($x2, $y2) = ($x + $item->width,
			 $y + $item->height);

	if ($item->can('renderOnCanvas')) {
	    my $recurse = $item->renderOnCanvas($canvas, $x, $y, $x2, $y2);
	    return( $recurse ? [ $x, $y ] : undef );
	}

# XXX: UpdateField should render its own... probably so should the AtrCard [was PsCanvas]

	# Items to skip into - they contain subwidgets which we'll use
	return [$x, $y] if grep { ref($item) eq $_ }
	  qw(ATR::Tk::UpdateEntry);

#warn "Try ".ref($item)." at $lvl:".$item->PathName."\n";

	my $border = eval { $item->cget('-border') } || undef; # 0 => undef
	$border = undef if $item->isa('Tk::Label');
	$border = 0 if $item->isa('ATR::Tk::UpdateField');
	if (defined $border) {
	    # Here, 0 means "thin"; in a widget, 0 means "none"
	    $canvas->createRectangle( $x, $y, $x2, $y2,
				    -width => $border,
				    -tags => ["drawn", "level$lvl"],
				  );
	}

	my $txt = eval { $item->cget('-text') };
	my $txtvar = eval { $item->cget('-textvariable') };
	if (defined $txtvar) {
	    $txt = $$txtvar if defined $$txtvar;
	}

	if (defined $txt) {
#warn "  ..has '$txt'\n";
	    # Assume it's single-line text, give x-margin equal to apparent y-margins
	    # XXX: this is left-align only, should check cget('-justify')
	    my $font = $item->cget('-font');
	    my $pad = 0;
	    if ($font) {
		my $lineheight = $font->can('fracMetrics') ? $font->fracMetrics('-linespace') : $font->metrics('-linespace');
		$pad = (abs($y2 - $y) - $lineheight) / 2;
		$pad = 0 if $pad < 0; # weird stuff is possible but unlikely
	    }
	    $canvas->createText( $x + $pad,
				 $y2 - $pad, # text seems to have more space on -descent than -ascent
				 -anchor => 'sw',
				 -font => $font,
				 -text => $txt,
				 -tags => 'drawn');
	}

	my $img = eval { $item->cget('-image') };
	if (defined $img) {
	    $canvas->createImage($x, $y,
				 -image => $img,
				 -anchor => 'nw',
				 -tags => ['drawn', 'image']);
	}

#	print "  $path ($x, $y) - ($x2, $y2) b=$border\n";

	# Doing the megawidget gives text; ignore button and transient toplevel
	return undef if $item->isa('Tk::DateEntry') || $item->isa('Tk::BrowseEntry');

	return [ $x, $y ]; # passes to next
    };
    main::widget_traverse($do_draw, $card, 0, [-$card->x, -$card->y]);
}


sub fatalCardError { # XXX: Currently this nobbles the entire window!
    my ($self, %args) = @_;

    warn( join "\n", "fatalCardError!",
	  ( map {my $l = "  $_ => '$args{$_}\n"; $l =~ s/\n+$//; $l."'" }
	    keys %args ),
	  '');

    $self->Busy(-recurse => 1);
    my $prob = $self->Scrolled('ROText', -scrollbars => 'oe', -wrap => 'char', -background => 'pink')
      ->place(-anchor => 'center', -relwidth => 0.5, -relx => 0.5, -rely => 0.5 );
    $prob->insert('end', $args{-preamble}.' '.$args{-error});
    $prob->bind('<F12>' => sub { $prob->placeForget }); # hotkey hides the message, just so I can see what's happening on the card
}

# Hook by which we could postpone the commit, freeze the gui, give the
# user a few seconds to roll back.  Don't need it yet - straight
# commit for now.
# Then update the fields on the card.
sub commitRealSoon {
    my $self = shift;
    my $doUpdate = shift; # default is 'true'; XXX: maybe I want it to just know when the GUI has gone away?  That was the problem this solved
    $doUpdate = 1 if !defined $doUpdate;

    main::doCommit(); # debug menu sets mode, calls
    #    ATR::MicePE->commitAll or rollbackAll or hovers
    $self->afterIdle(sub { $self->fieldsUpdate }) if $doUpdate;
}


sub op_close { # XXX: Does no modified-data checks
    my $self = shift;
    # Can't destroy this card here, because it will break the callback we're in
    $self->toplevel->closeItemDelayed($self);
}

sub op_transfer {
    my $self = shift;
    my $init = shift || ''; # one of (undef, 'by_sex')
    my $card = $self->isa('ATR::Tk::MatingPair') ? $self->pair : $self->card;
    my $dialog = $self->AnimalTransfer();
    $dialog->addSourceCard($self, $card);
    $dialog->setStateBySex() if $init eq 'by_sex';
    # XXX: Opening and closing interactions:
    #   Locking to prevent more than one of these being opened?
    #   Disable the transfer button(s) for the card(s) while window is open? (call $card->method to inform)
    #   Prod card(s) to update when the transfer is complete?
}


sub op_update { # XXX:DUP code rather similar to/should be common with ATR::Tk::AnimalTransfer->doTransfer  XXX:DUP and ColonyEd->_tk_Update
    my $self = shift;

    # A collection of CODE to run, to restore the model/view if we have a problem
    # XXX: collect also $commitActions, to update GUI on success
    # XXX: Make these actions ($methodName, @params) on their creator?
    my $rollbackActions = [];

    my $prob;
    my @allFields = $self->getAllFields;
    my @need_doDisplayCommit; # list of UpdateEntry
    $prob = ($@ || '[unknown problem]') unless eval {
	# cautious with $@ because Tk:catch is strange
	my $when = ATR::Date->now; # XXX: link to historic date

	foreach my $field (@allFields) {
# XXX: Log commit field or context: will need this info for any bug report!
	    die "Tried to update with absent Tk field '$field'" unless Tk::Exists($field);
	    if ($field->isa('ATR::Tk::UpdateEntry')) {
		if ($field->hasEdit) {
# push @$rollbackActions, sub { ... }; # XXX: deal with stuff
		    $field->doUpdate;
		    push @need_doDisplayCommit, $field;
		}
		next;
	    }
	    die "Can't update with unknown field type '$field'";
	}
	1;
    };

    if (!$prob) {
	# debug menu sets commit/rollback mode
	my $result = main::doCommit();
	$prob = "debug mode rollback" if !defined $result;
    }

    my $guiRefreshProb; # refresh is for commit or rollback

    if ($prob) {
	ATR::MicePE->rollbackAll("error");
	warn "Update failed: $prob"; # XXX:USRTHROW we would need more detail, and a catcher; string-joined exception loses blessing
	warn "Changes were NOT saved (database rollback)\n";

	# Try to restore the GUI model to pre-update state
	$guiRefreshProb = ($@ || '[unknown problem]') unless eval {
	    foreach my $action (@$rollbackActions) {
		$action->();
	    }
	    $self->_fieldsUpdate;
	    1;
	};
    } else {
	# Commit OK, ensure fields are marked as saved
	$guiRefreshProb = ($@ || '[unknown problem]') unless eval {
	    # Rebuild the card with new data; it should preserve/reuse the UE fields
	    $self->_fieldsUpdate;
	    my %commitFields;
	    @commitFields{@need_doDisplayCommit} = ();
	    # Mark saved fields as saved, force reload of the others
	    foreach my $ueWidg (@allFields) {
		if (exists $commitFields{$ueWidg}) {
		    $ueWidg->doDisplayCommit;
		} else {
		    $ueWidg->clearGui;
		}
	    }
	    1;
	};
    }
    warn "XXX: Other GUI cards not updated!\n"; # XXX: Display confirmation of change?  invalidate all objects anyway?

    if ($guiRefreshProb) {
	# We couldn't reset all the data in this window
	$self->fatalCardError(-preamble => "Update left this card window in a confused state.\nPlease contact support with the message below, then reload the card.\nError message:",
			      -error => $guiRefreshProb,
			      -errortype => ref($guiRefreshProb) || '[none]');
    }
}

sub op_print {
    my $self = shift;
    main::doPrinting($self); # XXX: remove dependency on atr-demo.pl
}

# Should return all ATR::Tk::UpdateEntry widgets or ATR::Tk::CardRow
# objects on the card, in commit-significant order; this shall be
# everything that might contain an edit or update.
#
# see can('getAllParts') above:
#    sub getAllParts { die "Card has not defined the field list" }


sub getRow {
    my $P = shift->privateData->{_rows} ||= {};
    my @rowNames = @_ ? @_ : sort keys %$P;
    return wantarray ? @{ $P }{ @rowNames } : $P->{$rowNames[0]};
}
sub setRow {
    my $P = shift->privateData->{_rows} ||= {};
    my ($key, $value) = @_;
    if (defined $value) {
	$P->{$key} = $value;
    } else {
	delete $P->{$key};
    }
    return $value;
}


1;
