#!/usr/bin/perl -w 
# usage: "perl axcEdge.pl" 
# Original script by pallier@lscp.ehess.fr
# Modified by ansgar.endress@m4x.org
# Responses are no longer possible before end of stimulus

use Tk;

$RESFILE = "axcEdge.res";
$WINDOWTITLE = "LSCP";

&initLogging ();
&initWindow  ();

###################################################################
#                                                                 #
# INSERT YOUR FAMILIARIZATION INSTRUCTIONS AFTER THE NEXT COMMAND #
#                                                                 #
###################################################################
$f->insert("end",<<"--"); 




Bonjour, et merci de participer.


Vous allez maintenant entendre un monologue d'un martien bavard. 
Le monologue durera quatre minutes.

Essayez de trouver les mots du Martien.

Appuyez sur "Demarrer", et écoutez...
--


##############################################################
#                                                            #
# INSERT YOUR FAMILIARIZATION STIMULI AFTER THE NEXT COMMAND #
#                                                            #
##############################################################
@famStim = split('\n',<<"--");
fam.edge.2rep
--

####################################################
#                                                  #
# INSERT YOUR TEST STIMULI AFTER THE NEXT COMMAND  #
#                                                  #
# IT IS ASSUMED THAT YOU USE A FORCED CHOICE TASK  #
# WITH TWO ALTERNATIVES                            #
# THE FIRST TWO COLUMNS ARE FILE NAMES, THE LAST   #
# COLUMN IS THE CORRECT RESPONSE. THE COLUMNS      #
# IN-BETWEEN CAN CONTAIN WHATEVER YOU LIKE         #
#                                                  #
####################################################
@stim = split('\n',<<"--");
myloneRide	nelydemyzu	ACYAC	YZCAX	1
fumyzibana	zilynafuzu	AAYAC	YZCAX	1
bafudoRigi	dobogibafa	AAYAC	YZCAX	1
fulonemyna	nebonafuzu	ACYAC	YZCAX	1
bamyzinade	bodebaRezi	AAYCC	ZCAXY	1
mydedolona	gunamyzudo	ACYCC	ZCAXY	1
fugineRilo	nebolofuRe	ACYAC	YZCAX	1
badezigina	bonabafazi	ACYCC	ZCAXY	1
myfuneRilo	nebolomyzu	AAYAC	YZCAX	1
fuRidobagi	dobogifuzu	AAYAC	YZCAX	1
mybanedena	lynamyRene	AAYCC	ZCAXY	1
fumyzinalo	lylofuzuzi	AAYCC	ZCAXY	1
bafudomyna	dolynabaRe	AAYAC	YZCAX	1
Rilonegide	lydeRiRene	ACYCC	ZCAXY	1
bamyzidena	bonabazuzi	AAYCC	ZCAXY	1
Ridenegilo	guloRifane	ACYCC	ZCAXY	1
bagidoRide	dolydebazu	ACYAC	YZCAX	1
myRizidelo	gulomyRezi	AAYCC	ZCAXY	1
Ridenebagi	negugiRiRe	ACYAC	YZCAX	1
funadogilo	gulofufado	ACYCC	ZCAXY	1
badezinagi	gugibaRezi	ACYCC	ZCAXY	1
Rigidofulo	doboloRiRe	ACYAC	YZCAX	1
funazilogi	lygifufazi	ACYCC	ZCAXY	1
Rigidobade	dogudeRizu	ACYAC	YZCAX	1
bananefugi	nelygibafa	ACYAC	YZCAX	1
fubadogina	gunafuRedo	AAYCC	ZCAXY	1
Rimynelode	bodeRifane	AAYCC	ZCAXY	1
mynadodelo	lylomyfado	ACYCC	ZCAXY	1
fubanenagi	gugifufane	AAYCC	ZCAXY	1
Rifuzimylo	zilyloRiRe	AAYAC	YZCAX	1
mynadolode	bodemyRedo	ACYCC	ZCAXY	1
Ribazifugi	zigugiRizu	AAYAC	YZCAX	1
baRinemyde	negudebazu	AAYAC	YZCAX	1
mylozifuna	zibonamyfa	ACYAC	YZCAX	1
Rifudologi	lygiRifado	AAYCC	ZCAXY	1
myRizibade	zigudemyfa	AAYAC	YZCAX	1
--

$file="";

MainLoop;

########

sub familiarization {
    @famStim = &shuffle (\@famStim);
    for $file (@famStim) {
        &play($file . ".wav");
        $f->update();
        &delay(1);
    }
    
    $f->delete("1.0","end");
########################################################
#                                                      #
# INSERT YOUR TEST INSTRUCTIONS AFTER THE NEXT COMMAND #
#                                                      #
########################################################
    $f->insert("end",<<"--");
Le monologue est terminé. Maintenant commence la deuxième partie de 
l'expérience

Vous allez entendre 36 paires de 'mots'. Essayez de décider lequels des mots 
vous semble être en martien. Si vous avez l'impression que tous les deux mots
ou aucun des mots pourraient appartenir au martien, indiquez le mot dont vous
avez plus l'impression qu'il est en martien.

Après chaque paire vous devrez appuyer sur un chiffre pour indiquer votre 
choix :

    1 = Le PREMIER mot était en martien.

    2 = Le DEUXIEME mot était en martien.



Attention: attendez la fin de chaque enregistrement pour cliquer sur le 
chiffre, et ne cliquez qu'une fois! 

Appuyez sur `Démarrer' pour commencer.
--
    $bot->pack();
    &disableButtons ();
    $b->configure(-command=> \&testPhase);
}

sub nextstim {
    # Next stim is called by &Resp to play ALL stimuli
    $file=pop(@stim);
    if (!($file eq "")) {
	($file1, $file2) = split (/\s+/, $file);
	&disableButtons ();
	$MW->after(500);
	&play($file1 . ".wav");
	$MW->after(1000);
	&play($file2 . ".wav");
	&enableButtons ();
	$MW->after(20);
    } else {
	# Here, the next block COULD be called
	# &nextblock();
	$now=localtime;
	print RESULTS "%%% Session ended: $now\n";
	$bot->destroy();
	$b->destroy();
	$f->delete("1.0","end");
	$f->insert("end",<<"--");







		Merci de votre participation.
--
		$f->update();
		&delay(3);
		exit ();
  	}		
}

#####################################################

sub testPhase {
  $b->configure(-state=>"disabled");
  $f->insert("end","\nEssais :");
  $f->update();
  @stim = &shuffle (\@stim);
  &nextstim();
}

sub shuffle {
    my @newstims = ();
    my @oldStims = @{$_[0]};
    while (@oldStims) {
        push(@newstims, splice(@oldStims, rand @oldStims, 1));
    }
    return @newstims;
}

sub delay {
    select(undef, undef, undef, $_[0]); # wait 'x' sec
}

sub play {
    $com =  "wav.exe stim\\" . $_[0] . " /Q\n";
#    $com =  "play stim/" . $_[0] . "\n";
    system($com);
} 

sub save {
    $,= "\t";
    print RESULTS @_ ,"\n";
}

sub resp {
        if ($file ne $oldfile) {
	    my $isCorrect = ((split(/\s+/, $file))[-1] == $_[0]) ? "True" : "False";
	    save($file,$_[0], $isCorrect);
	    &disableButtons ();
	    $f->insert("end","*"); $f->update();
	    $oldfile=$file;
	    &nextstim;
        }
}

sub ignoreButtons {
}

sub disableButtons {
    for (@respbutt) { 
	$_->configure(-state=>'disabled', -command=> [\&ignoreButtons]); 
	$_->update();
    }
    # I couldn't intercept signals from button 1 otherwise
    $respbutt[0]->bindtags(undef);
}

sub enableButtons {
    my $iButton = 1;
    for (@respbutt) { 
	$_->configure(-state=>'normal', -command=> [\&resp,$iButton]); 
	$_->update();
	$iButton++;
    }
    my (@tmpTags) =  $respbutt[1]->bindtags;
    $respbutt[0]->bindtags([@tmpTags]);
    # The following four lines are required because button 1 gets stuck
    # otherwise
    $respbutt[0]->eventGenerate ('<Leave>');
    $respbutt[0]->eventGenerate ('<Enter>');
    $respbutt[1]->eventGenerate ('<Leave>');
    $respbutt[1]->eventGenerate ('<Enter>');
}

sub initLogging {
    $now = localtime;
    ($sName, $sAge, $sSex) = &getSubjInfo ();
    open(RESULTS,">>$RESFILE");
    print RESULTS "%%% Session start: $now\n";
    print RESULTS "%%% Name:\t$sName\tAge:\t$sAge\tSex:\t$sSex\n";
}

sub getSubjInfo  {
	my (@subject, $accept);
	print "Name: ";
	chop ($subject[0] = <STDIN>);
	print "Age: ";
	$accept = -1;
	while ($accept < 0){
		chop ($subject[1] = <STDIN>);
		if (($subject[1] =~ /[^0-9]/) && ($subject[1])) {
			print "Not a valid age, please try again: ";
		} else {
			$accept = 1;	
		}
	}
	print "Sex (f/m): ";
	$accept = -1;
	while ($accept < 0){
		chop ($subject[2] = <STDIN>);
		if (($subject[2] =~ /[^fm]/) && ($subject[2])) {
			print "Not a valid sex, please try again: ";
		} else {
			$accept = 1;	
		}	
	}
	return @subject;	
}

sub initWindow (){
    $MW = MainWindow->new(-title=> $WINDOWTITLE);
    $f=$MW->Text()->pack();
    $b=$MW->Button(-text=>'Demarrer', -command=> \&familiarization)->pack();
    $bot=$MW->Frame();
    for (1..2) {
        $bb=$bot->Button(-text=>$_,-command=>[\&resp,$_])->pack(-side=>'left');
        push(@respbutt,$bb);
    }
}