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.