#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::Pane;


## In case this seems mysterious, the example is eventually
## going to administer a survey in which the participant
## responds with a 1-4 about certain adjectives
my @words = ("word") x 30;

my $mw = MainWindow->new( -title => "SACL Survey" );
my $pane = $mw->Scrolled(qw/Pane -scrollbars osow/)->pack(
  -expand => 'yes',
  -fill   => 'both',
);
my $frame = $pane->Frame->pack();

$mw->Label( -text => "... <insert directions here> ..." )->pack();

my @button_values;
my @frame_widgets;

my $unanswered = 30;

sub button_set {
  my $i = int(shift);
  my $prev  = $i - 1;
  my $next  = $i + 1;
  my $first =  1;
  my $last  = 30;
  $prev = $first if $prev < $first;

  $_->destroy foreach reverse @frame_widgets;
  @frame_widgets = ();

  push @frame_widgets, $frame->Label(
    -text => "#$i.  $words[$i-1]",
  )->pack();

  push @frame_widgets, $frame->Button(
    -text    => "First",
    -command => sub { set_unasnwered(); button_set($first) },
  )->pack(
    -side=>'left',
  );

  push @frame_widgets, $frame->Button(
    -text    => "Back to $prev",
    -command => sub { set_unasnwered(); button_set($prev) },
  )->pack(
    -side=>'left',
  );

  foreach my $j (1..4) {
    push @frame_widgets, $frame->Radiobutton(
      -text     => $j,
      -value    => $j,
      -variable => \$button_values[$i-1],
    )->pack(
      -side   => 'left',
    );
  }

  my $state1 = ("normal","disabled")[$next > $last];
  push @frame_widgets, $frame->Button(
    -text    => "Forward to $next",
    -command => sub { set_unasnwered(); button_set($next) },
    -state   => $state1,
  )->pack(
    -side => 'left',
  );

  my $state2 = ("disabled","normal")[$unanswered < 1];
  push @frame_widgets, $frame->Button(
    -text    => "Finished",
    -command => sub { $mw->destroy; calc() },
    -state   => $state2,
  )->pack(
    -side => 'left',
  );
}

sub set_unasnwered {
  my $i = 29;
  foreach my $j (@button_values) { $i-- if $j }
  $unanswered = $i;
}

sub calc {
  # Make sure all questions are answered due to few, but unlikely, 
 #ways of getting past the preliminary check
  my $i = 30;
  foreach my $j (@button_values) { $i-- if $j }
  if ($i > 0) { print "Survey not completed.  Exiting. . ."; exit }

  # Calculate score and save to file (Survey is indeed completed)
}

button_set(1);

MainLoop;

use Data::Dumper;
print Dumper \@button_values;