Program Trans2;

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

{* SUB-PROGRAMS IN ORDER OF APPEARANCE

{*

{* PROCEDURE SaveData

{* FUNCTION  TransBackResp

{* FUNCTION  TransFrontResp

{* PROCEDURE GetResp120

{* PROCEDURE GetDayToSpecial

{* PROCEDURE GetEducation

{* PROCEDURE GetSex

{* FUNCTION  TransMonth

{* PROCEDURE GetMonth

{* FUNCTION  TransName

{* PROCEDURE GetName

{* PROCEDURE LoadData

{* PROCEDURE GetFileNames

{* PROCEDURE GetThreshhold

{* PROCEDURE Intro

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

{*

{* GLOBAL DEFINITIONS

{*

{* USES UNIT Croft,

{* USES UNIT Crt;

{*

{* GLOBAL CONSTANT ScanX = 59;

{* GLOBAL CONSTANT ScanY = 48;

{*

{* GLOBAL VARIABLE Threshhold: integer;

{* GLOBAL VARIABLE InName,

{* GLOBAL VARIABLE OutName: string;

{* GLOBAL VARIABLE ScanXY: array[1..ScanX, 1..ScanY] of integer;

{* GLOBAL VARIABLE Name: string;

{* GLOBAL VARIABLE Sex: string;

{* GLOBAL VARIABLE Education: string;

{* GLOBAL VARIABLE Month: string;

{* GLOBAL VARIABLE DayToSpecial: string;

{* GLOBAL VARIABLE Resp120: array[1..120] of char;

{* GLOBAL VARIABLE LastPage: boolean;

{* GLOBAL VARIABLE MoreThan1: boolean;

{* GLOBAL VARIABLE FirstPage: boolean;

{* GLOBAL VARIABLE SCF: text;

{*

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

{* SUB-PROGRAMS with LOCAL DEFINITIONS and other SUB-PROGRAMS CALLED

{*

{* PROCEDURE SaveData

{*   local variable DF: text;

{* FUNCTION  TransBackResp

{*   local variable alpha: integer;

{*   local variable R: char;

{* FUNCTION  TransFrontResp

{*   local variable alpha: integer;

{*   local variable R: char;

{* PROCEDURE GetResp120

{*   local variable RespNum: integer;

{*   calls FUNCTION  TransFrontResp

{*   calls FUNCTION  TransBackResp

{* PROCEDURE GetDayToSpecial

{*   local variable alpha,

{*   local variable bravo: integer;

{*   local variable DTS: char;

{* PROCEDURE GetEducation

{*   local variable bravo: integer;

{*   local variable TE: string;

{* PROCEDURE GetSex

{* FUNCTION  TransMonth

{*   local variable TM: string[3];

{* PROCEDURE GetMonth

{*   local variable bravo: integer;

{*   calls FUNCTION  TransMonth

{* FUNCTION  TransName

{*   local variable TN: char;

{* PROCEDURE GetName

{*   local variable Letter: char;

{*   local variable alpha,

{*   local variable bravo: integer;

{*   calls FUNCTION  TransName

{* PROCEDURE LoadData

{*   local variable ScanLnStr: array[1..ScanX] of string;

{*   local variable alpha,

{*   local variable bravo: integer;

{* PROCEDURE GetFileNames

{*   local variable Lead8,

{*   local variable Ext: string;

{* PROCEDURE GetThreshhold

{*   local variable TempAns: integer;

{*   local variable NulPresent: boolean;

{* PROCEDURE Intro

{* PROGRAM MAIN

{*   calls PROCEDURE Intro

{*   calls PROCEDURE GetThreshhold

{*   calls PROCEDURE GetFileNames

{*   calls PROCEDURE LoadData

{*   calls PROCEDURE GetName

{*   calls PROCEDURE GetSex

{*   calls PROCEDURE GetEducation

{*   calls PROCEDURE GetMonth

{*   calls PROCEDURE GetDayToSpecial

{*   calls PROCEDURE GetResp120

{*   calls PROCEDURE SaveData

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

{* SUB-PROGRAMS IN ALPHABETICAL ORDER

{*

{* PROCEDURE GetDayToSpecial

{* FUNCTION  GetEducation

{* FUNCTION  GetFileNames

{* PROCEDURE GetMonth

{* PROCEDURE GetName

{* PROCEDURE GetResp120

{* PROCEDURE GetSex

{* FUNCTION  GetThreshhold

{* PROCEDURE Intro

{* FUNCTION  LoadData

{* PROCEDURE SaveData

{* PROCEDURE TransBackResp

{* PROCEDURE TransFrontResp

{* PROCEDURE TransMonth

{* PROCEDURE TransName

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

uses

  Croft,

  Crt;



const

  ScanX = 59;

  ScanY = 48;



var

  Threshhold: integer;

  InName,

  OutName: string;

  ScanXY: array[1..ScanX, 1..ScanY] of integer;

  Name: string;

  Sex: string;

  Education: string;

  Month: string;

  DayToSpecial: string;

  Resp120: array[1..120] of char;

  LastPage: boolean;

  MoreThan1: boolean;

  FirstPage: boolean;

  SCF: text;



Procedure SaveData;

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

var

  DF: text;

begin

  Assign(DF, OutName);

  if not(FirstPage) then

    Append(DF)

  else

    Rewrite(DF);

  WrLn2T(DF, 'Name:  "'+Name+'"');

  WrLn2T(DF, 'Sex:  "'+Sex+'"');

  WrLn2T(DF, 'Grade/Education:  "'+Education+'"');

  WrLn2T(DF, 'Month:  "'+Month+'"');

  if (DayToSpecial[1] = ' ') and (DayToSpecial[2] = ' ') then

    WrLn2T(DF, 'Day:  "Not recorded"')

  else

    WrLn2T(DF, 'Day:  "'+DayToSpecial[1]+DayToSpecial[2]+'"');

  if (DayToSpecial[3] = ' ') and (DayToSpecial[4] = ' ') then

    WrLn2T(DF, 'Year:  "Not recorded"')

  else

    WrLn2T(DF, 'Year:  "'+DayToSpecial[3]+DayToSpecial[4]+'"');

  WrLn2T(DF, 'Identification Number (A - J):  "'+copy(DayToSpecial, 5, 10)+'"');

  WrLn2T(DF, 'Special Codes (K - P):  "'+copy(DayToSpecial, 15, 6)+'"');

  WrLn2T(DF, '120 Responses:  "'+Resp120+'"');

  WrLn2T(DF, '\');

  Close(DF);

end;



Function TransBackResp(InitAlpha, bravo: integer): char;

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

var

  alpha: integer;

  R: char;

begin

  R := ' ';

  ;

  for alpha := InitAlpha to InitAlpha + 9 do

    begin

      if ScanXY[alpha, bravo] >= Threshhold then

        if alpha = InitAlpha + 0 then

          R := 'J'

        else

        if alpha = InitAlpha + 1 then

          R := 'I'

        else

        if alpha = InitAlpha + 2 then

          R := 'H'

        else

        if alpha = InitAlpha + 3 then

          R := 'G'

        else

        if alpha = InitAlpha + 4 then

          R := 'F'

        else

        if alpha = InitAlpha + 5 then

          R := 'E'

        else

        if alpha = InitAlpha + 6 then

          R := 'D'

        else

        if alpha = InitAlpha + 7 then

          R := 'C'

        else

        if alpha = InitAlpha + 8 then

          R := 'B'

        else

        if alpha = InitAlpha + 9 then

          R := 'A';

    end;

  TransBackResp := R;

end;



Function TransFrontResp(InitAlpha, bravo: integer): char;

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

var

  alpha: integer;

  R: char;

begin

  R := ' ';

  ;

  for alpha := InitAlpha to InitAlpha + 9 do

    begin

      if ScanXY[alpha, bravo] >= Threshhold then

        if alpha = InitAlpha + 0 then

          R := 'A'

        else

        if alpha = InitAlpha + 1 then

          R := 'B'

        else

        if alpha = InitAlpha + 2 then

          R := 'C'

        else

        if alpha = InitAlpha + 3 then

          R := 'D'

        else

        if alpha = InitAlpha + 4 then

          R := 'E'

        else

        if alpha = InitAlpha + 5 then

          R := 'F'

        else

        if alpha = InitAlpha + 6 then

          R := 'G'

        else

        if alpha = InitAlpha + 7 then

          R := 'H'

        else

        if alpha = InitAlpha + 8 then

          R := 'I'

        else

        if alpha = InitAlpha + 9 then

          R := 'J';

    end;

  TransFrontResp := R;

end;



Procedure GetResp120;

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

var

  RespNum: integer;

begin

  for RespNum := 1 to 10 do

    Resp120[RespNum] := TransFrontResp(26, 44 - 2*RespNum);

  for RespNum := 11 to 20 do

    Resp120[RespNum] := TransFrontResp(38, 64 - 2*RespNum);

  for RespNum := 21 to 30 do

    Resp120[RespNum] := TransFrontResp(50, 84 - 2*RespNum);

  for RespNum := 31 to 40 do

    Resp120[RespNum] := TransFrontResp(26, 22 - 2*(RespNum-30));

  for RespNum := 41 to 50 do

    Resp120[RespNum] := TransFrontResp(38, 42 - 2*(RespNum-30));

  for RespNum := 51 to 60 do

    Resp120[RespNum] := TransFrontResp(50, 62 - 2*(RespNum-30));



  for RespNum := 61 to 70 do

    Resp120[RespNum] := TransBackResp(49, 165 - 2*RespNum);

  for RespNum := 71 to 80 do

    Resp120[RespNum] := TransBackResp(37, 185 - 2*RespNum);

  for RespNum := 81 to 90 do

    Resp120[RespNum] := TransBackResp(25, 205 - 2*RespNum);

  for RespNum := 91 to 100 do

    Resp120[RespNum] := TransBackResp(49, 203 - 2*RespNum);

  for RespNum := 101 to 110 do

    Resp120[RespNum] := TransBackResp(37, 223 - 2*RespNum);

  for RespNum := 111 to 120 do

    Resp120[RespNum] := TransBackResp(25, 243 - 2*RespNum);

end;



Procedure GetDayToSpecial;

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

var

  alpha,

  bravo: integer;

  DTS: char;

begin

  DayToSpecial := '';

  for alpha := 4 to 23 do

    begin

      DTS := ' ';

      for bravo := 2 to 11 do

        if ScanXY[alpha,bravo] >= Threshhold then

          case bravo of

            2:  DTS := '9';

            3:  DTS := '8';

            4:  DTS := '7';

            5:  DTS := '6';

            6:  DTS := '5';

            7:  DTS := '4';

            8:  DTS := '3';

            9:  DTS := '2';

            10:  DTS := '1';

            11:  DTS := '0';

          end; {case}

      DayToSpecial := DayToSpecial + DTS;

    end;

end;



Procedure GetEducation;

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

var

  bravo: integer;

  TE: string;

begin

  for bravo := 17 to 33 do

    if ScanXY[23, bravo] >= Threshhold then

      begin

        case bravo of

          17: TE := '16';

          18: TE := '15';

          19: TE := '14';

          20: TE := '13';

          21: TE := '12';

          22: TE := '11';

          23: TE := '10';

          24: TE := '9';

          25: TE := '8';

          26: TE := '7';

          27: TE := '6';

          28: TE := '5';

          29: TE := '4';

          30: TE := '3';

          31: TE := '2';

          32: TE := '1';

          33: TE := '0';

        end; {case}

        Education := TE;

      end;

end;



Procedure GetSex;

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

begin

  if ScanXY[23, 43] >= Threshhold then

    Sex := 'Male';

  if ScanXY[23, 42] >= Threshhold then

    Sex := 'Female';

end;



Function TransMonth(NumVal: integer): string;

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

var

  TM: string[3];

begin

  case NumVal of

    2:  TM := 'DEC';

    3:  TM := 'NOV';

    4:  TM := 'OCT';

    5:  TM := 'SEP';

    6:  TM := 'AUG';

    7:  TM := 'JUL';

    8:  TM := 'JUN';

    9:  TM := 'MAY';

    10:  TM := 'APR';

    11:  TM := 'MAR';

    12:  TM := 'FEB';

    13:  TM := 'JAN';

    else

      Beep;

  end; {case}

  TransMonth := TM;

end;



Procedure GetMonth;

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

var

  bravo: integer;

begin

  for bravo := 2 to 13 do

    if ScanXY[3,bravo] >= Threshhold then

      Month := TransMonth(bravo);

end;



Function TransName(NumVal: integer): char;

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

var

  TN: char;

begin

  case NumVal of

    17:  TN := 'Z';

    18:  TN := 'Y';

    19:  TN := 'X';

    20:  TN := 'W';

    21:  TN := 'V';

    22:  TN := 'U';

    23:  TN := 'T';

    24:  TN := 'S';

    25:  TN := 'R';

    26:  TN := 'Q';

    27:  TN := 'P';

    28:  TN := 'O';

    29:  TN := 'N';

    30:  TN := 'M';

    31:  TN := 'L';

    32:  TN := 'K';

    33:  TN := 'J';

    34:  TN := 'I';

    35:  TN := 'H';

    36:  TN := 'G';

    37:  TN := 'F';

    38:  TN := 'E';

    39:  TN := 'D';

    40:  TN := 'C';

    41:  TN := 'B';

    42:  TN := 'A';

    43:  TN := ' ';

    else

      Beep;

  end; {case}

  TransName := TN;

end;



Procedure GetName;

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

var

  Letter: char;

  alpha,

  bravo: integer;

begin

  Name := '';

  for alpha := 2 to 21 do

    begin

      Letter := ' ';

      for bravo := 17 to 43 do

        if ScanXY[alpha,bravo] >= Threshhold then

          Letter := TransName(bravo);

      Name := Name + Letter;

    end;

end;



Procedure LoadData;

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

var

  ScanLnStr: array[1..ScanX] of string;

  alpha,

  bravo: integer;

begin

  if not(MoreThan1) then

    begin

      Assign(SCF, InName);

      Reset(SCF);

    end

  else

    FirstPage := false;

  for alpha := 1 to ScanX do

    begin

      readln(SCF, ScanLnStr[alpha]);

      writeln(ScanLnStr[alpha]);

      for bravo := 1 to ScanY do

        ScanXY[alpha,bravo] := ValChar(ScanLnStr[alpha,bravo]);

    end;

  readln(SCF, DumStr);

  if EOF(SCF) then

    begin

      LastPage := true;

      Close(SCF);

    end

  else

    begin

      LastPage := false;

      MoreThan1 := true;

    end;

end;



Procedure GetFileNames;

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

var

  Lead8,

  Ext: string;

begin

  Clr;

  Say('Enter the input file name.');

  InName := GetDirFileOnly('*.IN');

  Writeln;

  if AskYN(

    'Do you want the output ".DAT" file to have the same name as the input',

      'Y') then

        begin

          SplitFileName(InName, Lead8, Ext);

          OutName := Lead8 + '.DAT';

        end

      else

        begin

          GetFileName(Lead8, Ext);

          OutName := Lead8 + '.DAT';

        end;

  writeln('Output data file name will be ',OutName,'.');

  wait;

end;



Procedure GetThreshhold;

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

var

  TempAns: integer;

  NulPresent: boolean;

begin

  Clr;

  Say('The range of light to dark marks that the scanner detects is 1 - 7.');

  Say('The threshhold value which TRANS2 considers a valid response is '

    + StrInt(Threshhold) + '.');

  AskPosNul('What threshhold value do you want? [Default = '

    + StrInt(Threshhold) + ']', 7, TempAns, NulPresent);

  if not(NulPresent) then

    Threshhold := TempAns;

  writeln('Threshhold set to ',Threshhold,'.');

  wait;

end;



Procedure Intro;

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

begin

  Clr;

  Say('TRANS2 by 2Lt David Croft, 31st TES');

  writeln;

  write('This program takes a *.IN file from a scanner of output array ');

  writeln(ScanX,' by ',ScanY,'.');

  write('This is normally the ');

  writeln('"GENERAL PURPOSE NCS ANSWER SHEET form no. 6703".');

  Say('A *.DAT file of the same name as the *.IN file is created with');

  Say('this data:  Name, Sex, Grade or Education, Birth Date (Month, Day,');

  Say('and Year), Identification Number (A-J), Special Codes (K-P), and');

  Say('120 responses.');

  writeln;

  Say('TRANS2.EXE and SCAN.EXE were designed to be used with the QAS');

  Say('(Questionnaire Analysis System) but may be used for any other');

  Say('scanned answer sheet application.');

  writeln;

  Say('TRANS2 has no limit to the number of answer sheets which SCAN.EXE');

  Say('places in a *.IN file.  Both SCAN and TRANS2 designate a separate');

  Say('answer sheet with a backslash (\) on a line by itself in the *.IN');

  Say('and *.DAT files.');

  writeln;

  Say('If two marks are given on a responses, TRANS2 will choose the 2nd');

  Say('based on which direction it is scanning at the time.');

  Wait;

end;



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

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

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

begin

  Threshhold := 5;

  Sex := 'Not recorded';

  Education := 'Not recorded';

  Month := 'Not recorded';

  MoreThan1 := false;

  FirstPage := true;

  ;

  Intro;

  GetThreshhold;

  GetFileNames;

  repeat

    LoadData;

    GetName;

    GetSex;

    GetEducation;

    GetMonth;

    GetDayToSpecial;

    GetResp120;

    SaveData;

  until LastPage;

  Wait;

end.

