#!/usr/bin/perl -w
##############################################################################
#                                                                            #
#                     Is my manager/partner a psychopath?                    #
#                                                                            #
# PC Plus Helpdesk SuperDVD Perl Tk program example - based upon other works #
#                                                                            #
#      Program written by Paul Grosse to demonstrate the GUI in Perl Tk      #
#                                                                            #
#  WARNING: The purpose of this program is to demonstrate Perl Tk, not to    #
#  perform some sort of psychiatric assessment of an individual. If you      #
#  really want to do that, you need to use a psychiatrist. This program is   #
#  just a bit of fun in the same way that psychometric tests in women's      #
#  magazines are.                                                            #
#                                                                            #
##############################################################################

use Tk;
use Tk::ProgressBar;
&readfile;  #input Definitions and explanations (1..20)...
&initvars;  #initialise the variables
&creategui; #make the GUI
MainLoop;   #run it...
exit (0);

# Subroutines# ##############################################
sub initvars {
  $progress = 0;
  $qn = 1;
  $c = $d[$progress];
  $b = $e[$progress]
}

sub readfile {
  #input Definitions and explanations (1..20)...
  open (FH, "list.txt");
    foreach $c (0..19) {
      $a[$c] = -1;
      $d[$c] = <FH>;
      chomp ($d[$c]);
      $e[$c] = <FH>;
      chomp ($e[$c]);
      #chop down the lengths of the string into more handlaeble portions
      my @f = split " ", $e[$c];
      $e[$c] ="";
      my ($g, $lg) = ("", 0);
      $w = 50;
      foreach $h (@f) {
        $lh = length ($h);
        if (($lh + $lg) > $w) {
#          chomp ($g);
          $e[$c] .= $g . "\n";
          $g = $h . " ";
          $lg = length($g)
        } else {
          $g .= $h . " ";
          $lg = length($g)
        }
      }
      if  ($lg) {
        chomp ($g);
        $e[$c] .= $g . "\n"
      }
    }
  close FH;
}

sub creategui {
  # create GUI
  $mw = MainWindow  -> new(-title => "Hare Test...", -bd => 10);
  $bf = $mw -> Frame () -> pack (-side => 'bottom', -fill => 'x');
  $bf -> Button (-text => 'Quit', -command => sub{exit(0)}) -> pack (-side => 'right');
  $bf -> Button (-text => 'About', -command => sub{&about}) -> pack (-side => 'right');
  $bf -> Button (-text => 'Calculate', -command => sub{&calc}) -> pack (-side => 'left');
  $bf -> Button (-text => 'Reset', -command => sub{&reset}) -> pack (-side => 'left');

  $sb = $mw -> Frame () -> pack (-fill => 'x', -side => 'bottom');
  $sb -> Button (-text => 'Last', -command => sub{if ($progress >0) {
                                                                       $progress--;
                                                                       $qn = $progress +1;
                                                                       $c = $d[$progress];
                                                                       $b = $e[$progress];
                                                                       $n = $a[$progress];
                                                                     }}) -> pack (-side => 'left');
  $sb -> Button (-text => 'Next', -command => sub{if ($progress <19) {
                                                                       $progress++;
                                                                       $qn = $progress +1;
                                                                       $c = $d[$progress];
                                                                       $b = $e[$progress];
                                                                       $n = $a[$progress];
                                                                     }}) -> pack (-side => 'right');
  $sb -> ProgressBar (-from => 0, -to => 19, -gap => 0, -blocks => 20,
                      -colors => [ 0, 'green', 19, 'black' ],
                      -width => 32, -variable => \$progress) -> pack (-fill => 'x');
  $tf = $mw -> Frame () -> pack (-side => 'top', -anchor => 'nw');
  $tf -> Label (-textvariable => \$qn) -> pack (-side => 'left');
  $tf -> Label (-textvariable => \$c) -> pack (-side => 'left');
  $tf = $mw -> Frame (-borderwidth => '2', -relief => 'groove') -> pack (-side => 'top', -anchor => 'nw');
  $tf -> Label (-textvariable => \$b, -justify => 'left', -width => $w, -height => 8, -anchor => 'nw') -> pack (-side => 'left', -anchor => 'nw');
  $rf = $tf -> Frame (-width => '15')-> pack (-side => 'right', -fill => 'y');
  $rf -> Radiobutton (-width => '12', -text => 'Definitely', -anchor => 'w', -variable => \$n, -value => 2, -command => sub{&set}) -> pack (-side => 'top', -anchor => 'w');
  $rf -> Radiobutton (-width => '12', -text => 'Moderately', -anchor => 'w', -variable => \$n, -value => 1, -command => sub{&set}) -> pack (-side => 'top', -anchor => 'w');
  $rf -> Radiobutton (-width => '12', -text => 'Not at all', -anchor => 'w', -variable => \$n, -value => 0, -command => sub{&set}) -> pack (-side => 'top', -anchor => 'w');
}

sub set {
  $mw -> update;
  sleep 1;
  $a[$progress] = $n;
  if ($progress <19) {
    $progress++;
    $qn = $progress +1;
    $c = $d[$progress];
    $b = $e[$progress];
    $n = $a[$progress];
  }
}

sub calc {
  #check to see if any of the array are still negative and if so, take the user there
  my $sc = 0;
  foreach $x (0..19) {
    $sc += $a[$x];
    if ($a[$x] < 0) {
      $progress = $x;
      $qn = $progress +1;
      $c = $d[$progress];
      $b = $e[$progress];
      $n = $a[$progress];
      return
    }
  }
  if  ($sc >= 30) {
    $choice = $mw -> messageBox(-title => "Results",
                      -message => "WARNING: Psychopath!\nScore greater than 30/40",
                      -type => 'OK',
                    );
  } elsif  (($sc < 30) and ($sc >= 25)) {
    $choice = $mw -> messageBox(-title => "Results",
                      -message => "WARNING: Borderline psychopath.\nScore between 25 and 30/40",
                      -type => 'OK',
                    );
  } else {
    $choice = $mw -> messageBox(-title => "Results",
                      -message => "Psychopathy not diagnosed\nScore less than 25/40",
                      -type => 'OK',
                    );
  }
}

sub reset {
  &readfile;  #input Definitions and explanations (1..20)...
  &initvars;  #initialise the variables
  $qn = $progress +1;
  $c = $d[$progress];
  $b = $e[$progress];
  $n = $a[$progress];
}

sub about {
  $choice = $mw -> messageBox(-title => "About",
                    -message => "As a light-hearted test, similar to those found in women's magazines, this program illustrates some of the potential that the Perl Tk GUI has.\nIt is not meant as a serious assessment of somebody's mental state.",
                    -type => 'OK',
                  );
}
