Category : Word Perfect
Archive   : BIBPERF.ZIP
Filename : BIB0SORT.PAS

 
Output of file : BIB0SORT.PAS contained in archive : BIBPERF.ZIP
Program BibliographyPerfect;
Label Stop;
Const
MaxRefNum = 999;
MaxNumDocDigits = 4; (* max number of digits in a reference number *)
MaxNumDocDigitsPlusOne = 5;
MaxNumBibDigits = 4; (*max # digits in bib, large enough for MaxRefNum*)
BlankNumber = 9999; (* number for bib refs w/o any match in text *)
BlockSize = 25;
Type
Name = String[74];
String74 = String[74];
String70 = String[70];
String3 = String[3];

DocTypeRec = Record
Old : Integer;
New : Integer;
End;

RefTypeRec = Record
Num : String[MaxNumBibDigits];
Block : Array [1..BlockSize] of String[90];
End;

NewOld = (New, Old);
Selection = (Doc,Ref); (* text or bibliographic refs? *)
Var
FilVar, FileIn, FileOut : Text;
DocNumber : DocTypeRec;
BibNumber : RefTypeRec;
Line : String[90];
AlphaNum : String[MaxNumDocDigitsPlusOne];
Ch : Char;
I,J,LastX,LastY : Integer;
NumCount, Code : Integer;
NumOfDuplicates : Integer;
NumUnMatched : Integer;
NumLeadBlanks : Integer;
NumInBib : Integer; (*no in bib incl blanks*)
Full, Poss : Boolean;
Digits, Firstline : Boolean;
Match, EndOfRecord : Boolean;
Abort, Error : Boolean;
AnyUnMatched : Boolean; {any bib nos. w/o doc nos? }
Used : Array [1..MaxRefNum] of Boolean;
RefNum : Array [1..MaxRefNum,NewOld,Selection] of Integer;
Select : Selection;
DocInFile : String74;
DocOutFile : String74;
BibInFile : String74;
BibOutFile : String74;
FullName : String74;
FirstName : String70;
Extension : String3;
Ext : String3;
Prompt : String70;


{$IB:InKey.Inc}
{$IB:Exist.Inc}
{$IB:GetFile.Inc}


Begin (* main *)
(* Put up the introductory message until user hits any key *)
GotoXY (1,3);
Writeln (' BibliographyPerfect');
Writeln (' -------------------');
Writeln; writeln;
Writeln (' by');
Writeln;
Writeln (' Arthur Milholland, M.D., Ph.D.');
Writeln (' Assistant Professor of Anesthesiology');
Writeln (' University of Maryland Hospital');
Writeln (' 22 S. Greene Street');
Writeln (' Baltimore, Maryland 21201');
Writeln;
Writeln (' for the benefit of');
Writeln;
Writeln (' Physicians for Social Responsibility');
Writeln (' 325 E. 25th Street');
Writeln (' Baltimore, Maryland 21218');
Writeln;
Write (' Copyright (C) 1984');
GotoXY (1,24);
Write (' (strike any key to continue)');
Repeat
Until Keypressed;
ClrScr;

Writeln ('Enter names of files to be used ( >8 z''s to abort ) :');

(* get names of document and bibliography files *)

FirstName:='None';
Prompt := 'Document Infile (Old): ';
GetName(3,Old,False,True,'DIN');
If Abort then GOTO Stop;
DocInFile := FullName;

Prompt := 'Output document (New): ';
GetName(4,New,True,True,'DOU');
If Abort then GOTO Stop;
DocOutFile := FullName;

Prompt := 'Bibliography Infile (Old): ';
GetName(6,Old,True,True,'BIN');
If Abort then GOTO Stop;
BibInFile := FullName;

Prompt := 'Bibliography OutFile (New): ';
GetName(7,New,True,True,'BOU');
If Abort then GOTO Stop;
BibOutFile := FullName;

Assign (FileIn, DocInFile);
Assign (FileOut, DocOutFile);
Reset (FileIn); Rewrite (FileOut);
For I:=1 to MaxRefNum do
Begin
RefNum[I,New,Doc]:=0; RefNum[I,Old,Doc]:=0;
Used[I] := False;
End; (* for I *)
NumCount:=0;
NumOfDuplicates:=0;
NumUnMatched:=0;
Repeat
Full:=False;
Line := '';
Poss := False;
Digits := False;
Repeat (* read a character until line full *)
Begin
(*Ch := '';*)
Read (FileIn, Ch);
If Ord(Ch) in [10..13,140,170,171,173..176] (*WP end-of-line character*)
Then Full:=True;
If Ch='['
Then
Begin
Poss := True;
AlphaNum := '';
Line := Line + Ch;
End
Else
If Poss
Then
If Ch in ['0'..'9']
Then
Begin
Digits:=True;
AlphaNum := AlphaNum + Ch; (* form the number *)
If Length(AlphaNum)>MaxNumDocDigits then
Begin
Digits := False;
Poss := False;
Line := Line + AlphaNum;
End;
End
Else
Begin
Poss := False;
If Digits and (Ch=']')
Then (* save old and new, insert new *)
Begin
Match := False;
NumCount := NumCount + 1;
If NumCount > MaxRefNum
Then (* error *)
Begin
Writeln;
Writeln ('More than ', MaxRefNum:4, ' references');
GOTO Stop;
End
Else (* get the number *)
Begin
Val (AlphaNum,RefNum [NumCount,Old,Doc],Code);
If Code<>0 then
Begin
Writeln;
Writeln ('Val-1 error with AlphaNum = ', AlphaNum);
GOTO Stop;
End;
If RefNum[NumCount,Old,Doc]=BlankNumber then
Begin
Writeln;
Writeln ('Error: ',BlankNumber, ' entered as text number.');
GOTO Stop;
End;
I:=0;
If NumCount>1 then
Repeat
Begin
I:=I+1;
Match := RefNum[NumCount,Old,Doc]=RefNum[I,Old,Doc];
If Match then (*use same New number*)
Begin
NumOfDuplicates := NumOfDuplicates + 1;
RefNum[NumCount,New,Doc] := RefNum[I,New,Doc];
End; (* if Match *)
End;
Until Match or (I= (NumCount-1) );
End; (* begin before Val *)
If Not Match then
RefNum[NumCount,New,Doc] := NumCount - NumOfDuplicates;
(* Now, insert the new ref no. into the text line *)
Str(RefNum[NumCount,New,Doc]:MaxNumDocDigits,AlphaNum);
If Not (AlphaNum[1] In ['1'..'9']) then
Repeat
Delete(AlphaNum,1,1)
Until AlphaNum[1] in ['1'..'9'];
Line := Line + AlphaNum + Ch;
End
Else
Line := Line + AlphaNum + Ch;
Digits := False;
End (* begin before Poss:=False *)
Else
Line := Line + Ch;

End; (* Repeat reading a character *)
Until Full or EOF(FileIn) or ( (Length(Line)>75) and Not Poss ) ;

If Length(Line)>0 then
Write (FileOut,Line)

Until EOF(FileIn);
Close (FileOut);
Close (FileIn);

{For I:=1 to NumCount do
Begin
Writeln (RefNum[I,Old,Doc]:8, RefNum[I,New,Doc]:8);
End;
Writeln ('Turbosort done, result = ', TurboSort(SizeOf(DocNumber)) );
For I:=1 to NumCount do
Begin
Writeln (RefNum[I,Old,Doc]:8, RefNum[I,New,Doc]:8);
End; }

Assign (FileIn, BibInFile);
Assign (FileOut, BibOutFile);
Reset(FileIn); Rewrite(FileOut);
NumInBib:=0; (* no of items in bibliography section *)
AnyUnMatched := False;
Firstline:=True;
Repeat (* read records = firstline plus the rest *)
AlphaNum:='';
BibNumber.Num:='';
For I:=1 to BlockSize do
BibNumber.Block[I]:='';
Firstline:=True;
NumLeadBlanks := 0;
While Firstline do
Begin
Repeat (* look for leading blanks *)
Read (FileIn,Ch);
If Ch=' ' then NumLeadBlanks := NumLeadBlanks + 1;
Until ( Ch<>' ' ) or EOF(FileIn);
If EOF(FileIn) then
Begin
Writeln;
Writeln ('End of File encountered while looking for first');
Writeln (' digit of a bibliography number. Possibly, there');
Writeln (' are blanks after the last ^E');
GOTO Stop;
End;
If (Ch in ['0'..'9'])
Then
Begin
AlphaNum := Ch;
Repeat
Read (FileIn,Ch);
AlphaNum := AlphaNum + Ch;
Until (Not (Ch in ['0'..'9'])) or EOF(FileIn) or (Length(AlphaNum)>MaxNumDocDigits);
If EOF(FileIn) then
Begin
Writeln;
Writeln ('End-of-file encountered while reading number');
GOTO Stop;
End;
If Ord(Ch) <> 18 then (* check for ^R to end number entry *)
Begin
Writeln;
Writeln ('Error: Numeric entry does not end with ^R');
GOTO Stop;
End;
Delete (AlphaNum,Length(AlphaNum),1); (* remove last char *)
(* here convert to numeric, insert new value, check, ... *)
If Length(AlphaNum)>MaxNumDocDigits then
Begin (* allow values as large as those in document *)
Writeln;
Write ('Error : Bibliographic ref no. too long = ');
Writeln (AlphaNum);
GOTO Stop;
End; (*if length alphanum*)
NumInBib := NumInBib + 1;
Val(AlphaNum,RefNum[NumInBib,Old,Ref],Code);
If Code <>0 then
Begin
Writeln;
Writeln ('Val-2 error with AlphaNum =', AlphaNum);
GOTO Stop;
End;
If (NumInBib>1) and (RefNum[NumInBib,Old,Ref]<>BlankNumber) then
Begin (*Check for duplicate numbers in Bibliography*)
For I:=1 to (NumInBib-1) do
Begin
If (RefNum[NumInBib,Old,Ref] = RefNum[I,Old,Ref]) then
Begin
Writeln;
Write ('Error: Duplicate number in bibliography = ');
Writeln (RefNum[I,Old,Ref]);
GOTO Stop;
End; (* if refnum[i] = refnum[numinbib] *)
End; (* for i:=1 to numinbib-1 *)
End; (* if numinbib *)

(* Look for old document number to go with old bib number *)
Match := False;
If RefNum[NumInBib,Old,Ref]<>BlankNumber then
Begin
I:=0;
Repeat
I:=I+1;
Match := RefNum[NumInBib,Old,Ref]=RefNum[I,Old,Doc];
Until (I=NumCount) or Match;
End; (*if RefNum*)

If Match
Then
Begin (* set new bib number to new document number *)
J := RefNum[I,New,Doc];
RefNum[NumInBib,New,Ref] := J;
Used[J] := True; (* no. in doc has bib counterpart *)
Str(RefNum[NumInBib,New,Ref]:MaxNumBibDigits,BibNumber.Num);
End
Else
Begin
For I:=1 to MaxNumBibDigits do
BibNumber.Num := BibNumber.Num + '9';
If Not AnyUnMatched then
Begin (*since at least one naked bib number, write heading*)
AnyUnMatched := True;
Writeln;
Write ('Following (old) numbers are in Bibliography');
Writeln (' but not in (old) Document');
Writeln (' (in New bib, number field is 9999)');
End;
NumUnMatched := NumUnMatched + 1;
If NumUnMatched Mod 12 = 0
Then Writeln (RefNum[NumInBib,Old,Ref]:6)
Else Write (RefNum[NumInBib,Old,Ref]:6);
End;

(* Retrieve last non-digit read (should be ^R) *)
BibNumber.Block[1] := Ch;
Firstline := False;
End (* if Ch in 1..9 *)
Else (*first non-blank is a non-digit; is it a ^R? *)
If Ord(Ch) = 18 (* is it a ^R? *)
Then
Begin
For I:=1 to MaxNumBibDigits do
BibNumber.Num := BibNumber.Num + '9';
BibNumber.Block[1] := Ch; (* retrieve last non-blank char *)
Firstline := False;
End
Else
Begin
Writeln;
Writeln ('Error: Non-numeric value encountered in first line,');
Writeln (' (Could mean a blank line at beginning of file');
Writeln (' or after a ^E)');
GOTO Stop;
End;
End; (* while firstline *)

I:=1; (* we are (still) on first block of record *)
EndOfRecord:=False;
Repeat (* get rest of Bib entry *)
Begin
Repeat
Read (FileIn,Ch);
If (Ord(Ch)=5) then (* if ^E *)
Begin
BibNumber.Block[I] := BibNumber.Block[I] + Ch;
EndOfRecord := True;
Read (FileIn,Ch);

(* if a 220..220 sequence after ^E, remove it *)
If Ord(Ch)=220 then
Begin
J:=0;
Repeat
J:=J+1;
Read(FileIn,Ch);
If J=25 then
Begin
Writeln ('Error: 220..220 sequence problem');
GOTO Stop;
End;
Until (Ord(Ch)=220);
Read (FileIn, Ch);
End; (*if ord(ch)=220*)

If Not (Ord(Ch)in [10,11,26,140]) then (* if [NL] or ^Z *)
Begin
Writeln;
Writeln ('Error: A ^E in Bib file not followed by [NL].');
J:=Length(BibNumber.Block[I])-3;
Delete(BibNumber.Block[I],J,4);
BibNumber.block[i]:=BibNumber.block[I] + '^R[NL]' + '^E' + 'Ch';
Writeln (Bibnumber.block[I]);
Writeln ('Ord(Ch) = ',Ord(Ch));
For I:=1 to 10 do
Begin
Read (FileIn,Ch); Writeln('Ord(Ch) = ',Ord(Ch));
End;
GOTO Stop;
End;


End;
BibNumber.Block[I] := BibNumber.Block[I] + Ch;
If Length(BibNumber.Block[I])>78 then
Begin
I:=I+1;
If I>BlockSize then
Begin
Writeln;
Writeln ('Error: Bib entry total length too long.');
Writeln (' (Possible missing ^E)');
GOTO Stop;
End;
End;
Until EndOfRecord or EOF(FileIn);
End; (* repeat *)
Until EndOfRecord or EOF(FileIn);

If Not EndOfRecord then
Begin
Writeln;
Writeln ('Error: Bib file does not end with ^E.');
GOTO Stop;
End;

If (Length (BibNumber.Num) >0) and (Ord(Ch)<>26) then
Begin
With BibNumber do
Begin
Write (FileOut, Num); (* ?? write onto RAM disc ?? *)
I:=1;
Repeat
EndOfRecord := Length (Block[I]) = 0;
If Not EndOfRecord then
Write (FileOut, Block[I]);
I:=I+1;
Until (I>BlockSize) or EndOfRecord;
End; (* with *)
End; (* if length *)

Until EOF(FileIn); (* read records = firstline plus the rest *)
Close (FileIn);
Close (FileOut);

(* ready to Turbo-Sort on the numbers *)
I:=0; J:=0;
Writeln; Writeln;
Writeln (' The following (new) numbers occurring in the (new) text section');
Writeln (' do not appear in the (new) bibliography :');
Repeat
I:=I+1;
If Used[I] = False then
Begin
J:=J+1;
If I Mod 12 = 0
Then
Writeln (I:6)
Else
Write (I:6);
End;
Until I= (NumCount - NumOfDuplicates); (* Number of distinct new numbers *)
If J=0 then Writeln (' None');

Stop:Writeln; Writeln;
Writeln ('End of Job.');
Close (FileIn); Close(FileOut);

End. (* main *)

  3 Responses to “Category : Word Perfect
Archive   : BIBPERF.ZIP
Filename : BIB0SORT.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/