{     PROGRAM MATCH TEST, Ver. 2
      13 MARCH 1989
   This program administers a response latency experiment.  The subject
   is presented with a sentence on the screen.  After a short delay, a
   second sentence is displayed below the first one.  The subject presses
   the J key if the two sentences are identical, and the F key if they
   are not.  The test items are stored in a separate file.  Item file format
   is as follows.  Each item has three lines.  The first line has three
   integers, separated by spaces.  The first integer is the item number;
   the second integer tells whether the pair is a match (1=match, 0=no match); the
   third integer represents the grammaticality status (0=ungrammatical).
   The second and third lines contain the sentences for the match.

   Robert Bley-Vroman
   Department of English as a Second Language
   University of Hawai'i at Manoa

   Lynn Eubank
   Department of English, Linguistics Program
   University of North Texas

   If you use this program and it results in published work, please
   acknowledge the program.

}
program MatchTest(input,output,ItemFile,ResFile);

{ *****  General Utilities and declarations ***** }

const
    DefSym          =   '@';
    MaxLen          =   255;
    MaxName         =   15;
    Null            =   0;
    EPS             =   1.0E-10;
    NewLine         =   10;


type
    name            =   string[MaxName];
    index           =   integer;
    filvar          =   text;
    str80           =   string[80];
    str65           =   string[65];
    str15           =   string[15];
    character       =   -1..127;



 { **************************************************************  }
 { BEGINNING OF IBM VERSIONS OF I/O PROCEDURES}

{EXIST:  IBM Turbo VERSION check if a file is on disk. }
function Exist(filename : name) : boolean;
var    F : filvar;
begin
    if(filename <> 'CON:') then begin
        assign(F,filename);
        reset(F);
        if IOresult <> 0 then
            exist := false else
            exist := true;
        end
     else exist := true;
end;

{Fopen:  IBM Turbo VERSION  open a file for either read or write. }
procedure Fopen(var F :filvar; filename : name; itype : char);
begin
    assign(F,filename);
    if (itype in ['r','R']) then
        reset(F)
    else if (itype in ['w','W']) then
        rewrite(F);
end;


{FCLOSE: IBM Turbo VERSION close a file, forcing a ^Z to end file. }
procedure Fclose(var filnum : filvar; filname : name);
begin
    if (filname <> 'CON:') then begin;
        write(filnum, ^Z);
        close(filnum);
    end;
end;

{ **************************************************************  }
 {END OF IBM TURBO VERSIONS OF I/O PROCEDURES}


(*{STDOPEN: opens input and output file, with prompt )
procedure stdopen(var filin,filout : filvar; var namein,nameout, : name);
begin
    readstr(namein, 'Input filename (@):  ');
    readstr(nameout, 'Output filename (@):  ');
    Fopen(filin,namein,'r')
    Fopen(filout,nameout, 'w')
end;
*)

{AYE:  see if user answered yes. }
function aye : boolean;
var c   :   char;
begin
    repeat
        write(' (Y/N): ');
        readln(c);
        if (c in ['y','Y']) then Aye := true  else
        if (c in ['n','N']) then Aye := false
        else write(^G);
    until c in ['n','N','y','Y'];
end;

{NAY:  see if user answered yes. }
function nay : boolean;
var c   :   char;
begin
    repeat
        write(' (Y/N): ');
        readln(c);
        if (c in ['n','N']) then Nay := true else
        if (c in ['y','Y']) then Nay := false
        else write(^G);
    until c in ['n','N','y','Y'];
end;

{WAITKEY:  wait until a particular key is pressed to continue. }
procedure waitkey(key : char);
var response : char;
begin
    writeln;
    if (key = ' ') then
        write('>>>Press the SPACE BAR to continue!  ') else
        write('>>>Press ', key, ' to continue!  ');
    repeat read(kbd,response) until response = key;
end;

(* Some procedures needed in Dunn-Rankin's original program
procedure readreal;
procedure readname;
procedure readint;
*)


{ ********************************************************************  }

{ *****  Program-specific procedures, functions, and declarations ***** }
const
    MaxSentenceLen  =   150;           {Maximum length of sentence}
    MaxItems        =   100;           {Maximum no. of items in test}

type
    SentenceStr     =   string[MaxSentenceLen];
    Pair            =   array[1..2] of SentenceStr;
    MaxArray        =   array[1..MaxItems] of integer;
    ItemInfo        =   array[1..8] of integer;
    InfoArray       =   array[1..MaxItems] of Iteminfo;
    TestArray       =   array[1..MaxItems] of Pair;
    Real3x3Array    =   array[0..2,1..3] of real;
    Real2x3Array    =   array[0..2,1..2] of real;

var
    BUFFER_HEAD     :   integer absolute  $0000:$041A; {current head}
    BUFFER_TAIL     :   integer absolute  $0000:$041C; {current tail}
    ResFileName     :   Name;           {File for results of test}
    ItemFileName    :   Name;           {File for test items}
    ItemFile,Resfile :  Filvar;
    Subject         :   str15;          {Name of Subject}
    Sentence        :   SentenceStr;
    MatchPair       :   Pair;
    TestPair        :   Pair;
    TestInstrument  :   TestArray;
    ItemInfoArray   :   InfoArray;
    RandOrder       :   MaxArray;
    NumItems        :   integer;        {Actual no. of items on test}
    ItemNum         :   integer;        {Item Number}
    Time            :   integer;        {Time to guess}
    Guess           :   integer;        {Subject's response}
    NumTries        :   integer;        {No. of tries to hit key correctly}
    Totals          :   Real3x3Array;
    Averages        :   Real2x3Array;
    RandTest        :   boolean;
    ScreenDisplay   :   boolean;
    SaveInFile      :   boolean;
    Instruct        :   boolean;
    Del1, Del2      :   integer;        {Delays for display}
    i,j,k           :   Index;
    Response        :   char;
    Keystring       :   string[20];

{INITEMS:  reads in test items from item file. Reports NumItems. }
procedure InItems(var NumItems : integer);
var
    ItemFile   : filvar;
    i       : index;
begin
    writeln; writeln;
(*  repeat
    write('Filename containing test items :  ');
    readln(ItemFileName);         H
    until Exist(ItemFileName);*)
    Fopen(ItemFile,ItemFileName,'r');
    i := 1;
    repeat
       {[i,1] is ItemNum; [i,4] is Match, [i,3] is Gram.}
        readln(ItemFile, ItemInfoArray[i,1], ItemInfoArray[i,4], ItemInfoArray[i,3]);
        readln(ItemFile, TestInstrument[i,1]);
        readln(ItemFile, TestInstrument[i,2]);
        i := i + 1;
    until (eof(ItemFile));
    NumItems := i - 1;
 end;


{Function lookup finds an item in an array. }
(*function Lookup(N : Integer; A : MaxArray; NumItems : integer) : index;
var i : integer; found : boolean;
begin
     Found := false;
     i := 1;
     while (i <= NumItems) and (not Found) do
           if N = A[i] then
             found := true
           else
             i := i + 1;
     if Found then
        Lookup := i
     else
        Lookup := 0
end;
*)

{RandItem:   Create random array to order items. }
procedure RandItem(NumItems : integer; var RandOrder : MaxArray);
var
   i,j : index;
   rnum, left : integer;
   temp : array [1..MaxItems] of integer;

begin
     for i := 1 to NumItems do RandOrder[i] := i;
     randomize;
     left := NumItems;
     for i := 1 to NumItems do begin
         rnum := random(left) + 1;
         temp[i] := RandOrder[rnum];
         for j := rnum to (left - 1) do begin
             RandOrder[j] := RandOrder[j + 1];
             end;
         left := left - 1;
         end;
     for i := 1 to NumItems do begin
         RandOrder[i] := temp[i];
         end;
end;

{SETUP:  asks questions to set up run; invokes InItems to set up test. }
procedure SetUp (var NumItems : integer);
begin
    InItems(NumItems);
    writeln;
    write('Type your SUBJECT CODE and press <RETURN> to begin: ');
    readln(Subject);
(*  writeln('Delay between items in pairs in msec (default is 3000):    ');
    readln(del1);*)
    clrscr;
end;


{COMPUTEAVERAGES}
procedure ComputeAverages(Totals : Real3x3Array;
                          var Averages : Real2x3Array);
var i,j : index;

begin
      for i := 0 to 2 do for j := 1 to 2 do Averages[i,j] := 0;
     for i := 0 to 2 do begin
      {Averages[i,1] := Totals[i,2] / Totals[i,1];} {Average Time}
      {Averages[i,2] := Totals[i,3] / Totals[i,1];} {Average Correct}
     end
end;

{COMPUTETOTALS}
{Totals array looks like this:

Grammaticality   Count   Time   Correct
               _________________________
          0    |       |      |        |
               |_______|______|________|
          1    |       |      |        |
               |_______|______|________|
          2    |       |      |        |
               |_______|______|________|
}

procedure ComputeTotals(ItemInfoArray : InfoArray; NumItems : Integer;
                          var Totals : Real3x3Array);
var i,j : index;

begin
     for i := 0 to 2 do for j := 1 to 3 do Totals[i,j] := 0;
     for i := 1 to NumItems do begin
         if ItemInfoArray[i,4] = 1 then
         begin
            j := ItemInfoArray[i,3];         {Grammaticality status: 0,1,2}
            Totals[j,1] := Totals[j,1] + 1;  {Count of (un)grammatical}
            Totals[j,2] := Totals[j,2] + ItemInfoArray[i,8]; {Time}
            Totals[j,3] := Totals[j,3] + ItemInfoArray[i,6]; {Correct}
         end
     end
end;  {of procedure ComputeTotals}

{QUERY: display test sentences and ask whether pair are the same and output guess, time, numtries}
procedure Query(var MatchPair : Pair; var Time, NumTries, Guess : integer);
    label chk; {label 'chk' for goto}
    var response    :   char;
    begin
            time := 0;
            Guess := 0;
            NumTries := 1;
            clrscr;
            writeln('RED = DIFFERENT                                       BLUE = IDENTICAL');
            writeln;writeln;writeln;writeln;writeln;
            writeln(' ',MatchPair[1]);
            while (time < 1751) do begin
                  delay(1);
                  time :=time + 1;
            end;
            writeln;writeln;writeln;writeln;writeln;writeln;writeln;writeln;writeln;writeln;
            writeln;writeln;writeln;writeln;writeln;
            writeln('        ',MatchPair[2]);
            buffer_tail := buffer_head;
            time := 0;
            while (time < 1751) do begin
                  delay(1);
                  time := time + 1;
                  if (KeyPressed) then goto chk;
            end;
            clrscr;
            writeln('RED = DIFFERENT                                      BLUE = IDENTICAL');
            repeat
                  delay(1);
                  time := time + 1;
            until (KeyPressed);
        chk:clrscr;
            read(kbd,response);
            write;writeln;
            while not (response in ['f','F','j','J']) do begin
            if response = chr(3) then halt   {abort with control-C}
            else
              write(^G);
              writeln('  ', 'RED = DIFFERENT                                            BLUE = IDENTICAL');
              NumTries := NumTries + 1;
              read(kbd,response);
              end;
            if (response in ['j','J']) then
              begin
              Guess := 1;
              write('                                                                    IDENTICAL');
              end
            else
              begin
              Guess := 0;
              write('        DIFFERENT');
              end;
    end;

{***INCLUDE FILE CONTAINING INSTRUCTIONS: includes procedures
    DisplayPractice and Instructions. }
{$I INSTRUCT.PAS}

{DISPLAYRESULTS:   }
procedure DisplayResults;
var i,k :index;
begin
      for k := 1 to NumItems do begin
          for i := 1 to 8 do begin
            write(ItemInfoArray[k,i],'   ');
            end;
          writeln;
          end;
      writeln;
end;

{SAVEIT: stores the results of thge test in the file subject.dat.}
procedure SaveIt(ResFileName : name);
var i,k : index;
begin
    Fopen(ResFile, ResFileName, 'w');
    writeln(ResFile, 'Subject:  ', subject);
    writeln(ResFile, 'Test Item File:  ', ItemFileName);
    writeln(ResFile, 'Number of Items in Test:  ', NumItems);
    writeln(ResFile, 'Delay between members of pairs:  ', Del1);
    writeln(ResFile, 'This version contained a fake first item.');
    writeln(ResFile);
    writeln(ResFile, 'Gram.',chr(9),'Total',chr(9),'Av.Time',chr(9),'Av.Correct');
     for i := 0 to 2 do
    {writeln(ResFile,i,chr(9),Totals[i,1]:6:0,chr(9),
                         Averages[i,1]:6:0,chr(9),Averages[i,2]:4:2);}
    writeln(ResFile, '**********************************************');
    write(ResFile,'Item',chr(9),'Order',chr(9),'Gram.',chr(9),'Match',chr(9));
    writeln(ResFile, 'Respns.',chr(9),'Correct',chr(9),'Tries',chr(9),'Time');
begin
      for k := 1 to NumItems do begin
          for i := 1 to 8 do begin
            write(ResFile,ItemInfoArray[k,i],chr(9));
            end;
          writeln(ResFile);
          end;
      writeln;
end;
    close(ResFile);
    writeln;writeln('Results saved in    ', ResFileName)
end;

{ ********************************************************************  }
                        { *** MAIN PROGRAM *** }

begin
 { Initial assignments of variables.  Eventually we will want to enable
   the experimenter to set these interactively. }
    ItemFileName :=  'items.txt';
    Del1        :=  1750;Del2         :=  1750;
    Subject     :=  'subject';
    RandTest    :=  true;
    Instruct    :=  true;
    ScreenDisplay := true;
    SaveInFile  :=  true;
(* repeat   {Include this (with the 'until') if you want many tests}*)
      clrscr;
   { ** Setup and Instructions ** }
      Setup(NumItems);
      RandItem(NumItems,RandOrder);
      If Instruct then Instructions;             {Instructions to subject}
         {Now display a fake first item, just to get started.}
      TestPair[1] := 'Last May the dentist caught a cold.';
      TestPair[2] := 'Last May the dentist caught a cold.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
      TestPair[1] := 'Last March the policeman wrote a letter.';
      TestPair[2] := 'Last Tuesday the policeman wrote a letter.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
      TestPair[1] := 'Last Friday described the reporter a crime.';
      TestPair[2] := 'Last Friday described the reporter a crime.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
      TestPair[1] := 'Last November emptied the plumber a pipe.';
      TestPair[2] := 'Last November clogged the plumber a pipe.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
      TestPair[1] := 'Last Wednesday cleaned the janitor a sink.';
      TestPair[2] := 'Last Wednesday cleaned the janitor a sink.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
      TestPair[1] := 'Last Monday the manager bribed a politician.';
      TestPair[2] := 'Last Monday the manager visited a politician.';
      Query(TestPair, time, numtries, guess);
      delay (1750);clrscr;
      WaitKey(' ');
   { ** Here is the main loop of the test: ** }
      clrscr;
      for i := 1 to NumItems do begin
        k := RandOrder[i];
        Query(Testinstrument[K],Time,NumTries,Guess);
        writeln;
        ItemInfoArray[k,5] := Guess;        {Record Guess}
        ItemInfoArray[k,8] := Time;         {Record Time.}
        ItemInfoArray[k,2] := i;            {Record Order}
        ItemInfoArray[k,7] := NumTries;     {Record NumTries}
        if (ItemInfoArray[k,4] = ItemInfoArray[k,5])
           then ItemInfoArray[k,6] := 1     {Record correct}
           else ItemInfoArray[k,6] := 0;      {or incorrect}
        writeln;writeln;writeln;writeln;writeln;
        delay (1750);clrscr;
        buffer_tail := buffer_head;
        WaitKey(' ');
      end;
   { ** End of the main loop of the test: ** }
      clrscr;
      writeln;writeln;writeln;writeln;writeln;
      writeln('             **************** END OF THE EXPERIMENT ***************');
      writeln;
      writeln;writeln;writeln;writeln;writeln;writeln;writeln;
      writeln('                                   THANK YOU!!');
      writeln;writeln;
      ComputeTotals(ItemInfoArray,NumItems,Totals);
      ComputeAverages(Totals,Averages);
     { ** We record and/or display the results ** }
      if SaveInFile then begin
        ResFileName := subject + '.dat';
        SaveIt(ResFileName) end;
      readln;
      If ScreenDisplay then DisplayResults;
  { ** Allow for another test ** }
(*    write('Do you want another test?  ');
    until (Nay);*)
end.
ZW2.18
@
8ÌPRNô

TXT	
p

sfdelay (1775)
M
M
M
M
M
M
M
1750S
S
S
S