home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
PROGRAMS
/
WSTAR
/
WS-COL12.LBR
/
WS-COL12.PQS
/
WS-COL12.PAS
Wrap
Pascal/Delphi Source File
|
2000-06-30
|
15KB
|
468 lines
PROGRAM WSCOLUM; (* WS-COLUM 1.2 *)
(* Released into the public domain January 1986
by the author:
Steve Wilcox
1215 South Osceola
Denver, CO 80219
303-936-0440
I would appreciate being notified of any
problems or changes in the program.
This program will take a WordStar text file
of two pages or more and arrange consecutive
pages in sets of columns. The program keeps track
of WordStar print control toggles to keep them
associated with only the text block in which they
were begun.
The three user-input variables are the name
of the source file, the name of the destination
file, and the print column numbers that will be
the left margin for subsequent text blocks.
In the ReadNWrite Procedure, the source file
is read into memory a set of pages at a time
(depending on how many columns have been entered),
using a double-tiered linked list. Each page break
is pointed to with a PagePointer, which in turn
points to the beginning of the second linked
list (BufferStorage), the actual text in that
page.
The text is stored in a series of consecutive
arbitrary 128 byte records (BufferStorage)
rather than line-by-line records. This eliminates
the need to pre-guess the length of any line
coming in from the input file.
With a set of pages in memory, they are read
back out by following the BufferStorage linked
lists for the page sets until WordStar's page-end
character (#138) is encountered.
The set of pages is assembled side-by-side
to the final file by outputting corrresponding
lines from each page in the set, with spaces
between them for the center margins. After the
output page is done, ReadNWrite goes through
another iteration.
Screen prompts in this program are set for a
52 column screen. *)
(* 6/26/86 Changed the ReadNWrite Procedure to
accommodate files that don't end in a
carriage return. The program now
appends a CR/PageBreak sequence at the
end of the file if it doesn't have one.
The buffer code in ReadASet was moved
to the new Store procedure to
accommodate storing characters from
different code locations.
8/21/86 The above modification, it turns out,
also corrects a problem when a new
LineStore record is created exactly when
the PageBreak character is encountered.
The effect was that the following page
of the source file was read into memory,
but never read out; it was discarded.
However it brought to light a similar,
though undoubtedly rare problem when a
new LineStore record is created exactly
at EOF. The problem was corrected by
filling the LineStore position after
the new record has been created.
Originally, the need for a record was
determined, and the record itself
created, after storage.
Made a minor modification to the
MergePages procedure to prevent excess
space characters from being added if
a full implement of columns is not
present on the last page.
Added provision in ControlCheck to
adjust LineCharCount for certain
sub-printable ASCII characters that are
printable in WordStar. Originally no
character below ASCII 31 would be
counted as a printing character, thus
the column justification would be
wrong if special characters were
used.
Modified the routine to read initial
dot commands. They are now written
directly to the outputfile, rather
than stored. This accommodates much
larger headers.
Modified AbortProgram to close and
erase the output file rather than
leave it partially written. *)
{$I-}
CONST
LF=#10; (* LineFeed Character *)
CR=#13; (* Carriage Return Character *)
PageBreak=#138; (* WordStar's PageBreak Character *)
TYPE
StoragePointer=^BufferStorage; (* The text of each page is *)
BufferStorage=Record (* stored in LineStore *)
LineStore:String[128];
StorageLink:StoragePointer
End;
PagePointer=^PageInfo; (* Points to the beginning *)
PageInfo=Record (* BufferStorage for each *)
Start:StoragePointer; (* text page *)
PageLink:PagePointer
End;
WriteString=Char; (* used for WriteDisk procedure *)
VAR
I,BuffCounter,PageCounter,Blocks:Byte;
Z:Integer;
Ch:Char;
InputFileName,OutputFileName:String[14];
InputFile,OutputFile:Text;
TempString:String[255];
BuffPrevious,BuffNext:StoragePointer;
PageHead,PagePrevious,PageNext:PagePointer;
HeapTop:^Integer;
InitialPass:Boolean;
Column:Array[1..20] of Integer;
PROCEDURE AbortProgram (Code:Byte);
(* Dumps out of program due to fatal condition *)
CONST
AbortMessage:Array[1..3] of String[21]=
('Source File not found',
'Destination disk full',
' Page blocks overlap ');
Begin
GotoXY(1,22);ClrEOL;
WriteLn(#7,'>> Program Aborted <<');
WriteLn(AbortMessage[Code]);
Close(OutputFile);
Erase(OutputFile);
Halt
End;
PROCEDURE WriteDisk (InString:WriteString);
(* Writes to OutputFile and checks for disk write error *)
Begin
Write(OutputFile,InString);
If IOResult>0 then AbortProgram(2) (* Fatal Error -- no return *)
End;
PROCEDURE Configuration;
(* Gets input information from user *)
PROCEDURE DrawLine (Row:Byte);
(* Draws a dashed line across the screen at the specified ROW *)
Begin
GotoXY(1,Row);
For I:=1 to 52 do Write('-')
End;
Begin (* Configuration *)
Repeat
ClrScr;
GotoXY(17,1);
Write('C O L U M N S 1.2');
DrawLine(3);
DrawLine(20);
GotoXY(1,5);
WriteLn('Enter the name of the SOURCE file');
ReadLn(InputFileName);
GotoXY(1,9);
WriteLn('Enter the name of the DESTINATION file');
ReadLn(OutputFileName);
GotoXY(1,13);
WriteLn('The program begins the first text block in column 1.');
WriteLn('Enter the STARTING COLUMN(S) for subsequent block(s),');
WriteLn('each separated by a space');
ReadLn(TempString);
(* Now parse the line for each column number *)
Blocks:=1;
While Length(TempString)>0 do
Begin
While (Length(TempString)>0) and not (TempString[1] in ['0'..'9']) do
Delete(TempString,1,1);
I:=1;
If Length(TempString)>0 then
Begin
While (I<=Length(TempString)) and (TempString[I] in ['0'..'9']) do
I:=Succ(I);
Val(Copy(TempString,1,I-1),Column[Blocks],Z);
Blocks:=Succ(Blocks);
Delete(TempString,1,I);
End;
End;
WriteLn;
Write(Blocks,' Blocks, beginning at Columns: 1');
For I:=1 to Blocks-1 do Write(Column[I]:4);
(* Now subtract 2 from each Column since
Column actually controls the number of
SPACES inserted between the end of one
block and the beginning of the next *)
For I:=1 to Blocks do
Column[I]:=Column[I]-2;
GotoXY(1,22);
Write('Are all entries correct? (Y/N) ');
Repeat
Read(Kbd,Ch);
Until UpCase(Ch) in ['Y','N'];
Until UpCase(Ch)='Y';
Assign(InputFile,InputFileName);
Assign(OutputFile,OutputFileName)
End;
PROCEDURE InitializeFile;
(* Opens files and reads in any leading dot
commands *)
Begin
GotoXY(1,22);ClrEOL;
Write('Processing...');
InitialPass:=True;
Reset(InputFile);
If IOResult>0 then AbortProgram(1); (* Fatal error -- no return *)
ReWrite(OutputFile);
If IOResult>0 then AbortProgram(2); (* Fatal Error -- no return *)
Read(InputFile,Ch);
While Ch ='.' do
Begin
(* Looks for dot commands. Any such
formatting commands are written directly to the output. *)
ReadLn(InputFile,TempString);
WriteLn(OutputFile,Ch,TempString);
Read(InputFile,Ch);
End;
(* Note that Ch is now first character of the text *)
End;
PROCEDURE ReadNWrite;
(* Reads in a set of pages and puts them side-by-side in proper columns *)
VAR
BlockLoop:Byte;
BuffPosCount:Array[1..20] of Byte;
PageLine:Array[1..20] of StoragePointer;
PageDone,RealPage,UnderScore,BoldFace,DoubleStrike:Array [1..20] of Boolean;
AllPagesDone:Boolean;
PROCEDURE ReadASet;
(* Reads a set of pages from the source file *)
PROCEDURE Store (InChar:Char);
(* stores character in memory and allocates records *)
Begin
BuffCounter:=Succ(BuffCounter);
If BuffCounter>128 then (* Create new record in memory *)
Begin
BuffPrevious:=BuffNext;
New(BuffNext);
BuffPrevious^.StorageLink:=BuffNext;
BuffCounter:=1
End;
BuffNext^.LineStore[BuffCounter]:=InChar;
End;
Begin (* ReadASet *)
New(PageHead);
PageNext:=PageHead;
PageCounter:=0;
While (PageCounter<Blocks) and (Not EOF(InputFile)) do
Begin
PageCounter:=Succ(PageCounter);
New(BuffNext); (* Set up pointers to next *)
PagePrevious:=PageNext; (* page and initial storage*)
New(PageNext); (* location for each page *)
PagePrevious^.PageLink:=PageNext;
PageNext^.Start:=BuffNext;
BuffCounter:=0;
If InitialPass then (* Store Ch left over from above Dot Search *)
Begin
Store(Ch);
InitialPass:=False
End;
Repeat
Read(InputFile,Ch);
Store(Ch);
Until (EOF(InputFile)) or (Ch=PageBreak);
If (Ch<>LF) and (Ch <> PageBreak) then (* EOF needs CR/PageBreak *)
Begin
Store(CR);
Store(PageBreak)
End
Else (* make sure last buffer character is PageBreak *)
BuffNext^.LineStore[BuffCounter]:=PageBreak
End
End;
PROCEDURE QueuePages;
(* Points to the beginning of the each page *)
Begin
PageNext:=PageHead^.PageLink;
For I:=1 to Blocks do
Begin
PageDone[I]:=(I>PageCounter); (* In case the last page has no pair *)
If not PageDone[I] then
Begin
PageLine[I]:=PageNext^.Start;
PageNext:=PageNext^.PageLink
End
End
End;
PROCEDURE MergePages;
(* Assembles output page from the pages in memory *)
VAR
LineCharCount:Byte;
FUNCTION SevenBit(InChar:Char):Char;
(* Strips high-bit off WordStar formatting *)
Begin
SevenBit:=Chr(Ord(InChar) And 127)
End;
FUNCTION BuffChar(Block:Byte):Char;
(* Retrieves text character from page *)
Begin
BuffChar:=PageLine[Block]^.LineStore[BuffPosCount[Block]];
BuffPosCount[Block]:=Succ(BuffPosCount[Block]);
If BuffPosCount[Block]>128 then (* get next BufferStorage *)
Begin
PageLine[Block]:=PageLine[Block]^.StorageLink;
BuffPosCount[Block]:=1
End
End;
PROCEDURE ControlCheck (Block:Byte);
(* Toggles WordStar Print Controls *)
Begin
Case SevenBit(Ch) of
#19:UnderScore[Block]:=not UnderScore[Block];
#02:BoldFace[Block]:=not BoldFace[Block];
#04:DoubleStrike[Block]:=not DoubleStrike[Block]
End;
If SevenBit(Ch) in [#06,#07,#15] then
(* printables: Phantom space, phantom rubout, non-break space *)
LineCharCount:=Succ(LineCharCount);
If SevenBit(Ch)=#08 then
(* Backspace, so decrement *)
LineCharCount:=Pred(LineCharCount)
End;
PROCEDURE SetControls (Block:Byte);
(* Inserts WordStar print controls at the beginning and end of lines *)
Begin
If UnderScore[Block] then WriteDisk(#19);
If BoldFace[Block] then WriteDisk(#2);
If DoubleStrike[Block] then WriteDisk(#4)
End;
Begin (* MergePages *)
For I:=1 to PageCounter do
BuffPosCount[I]:=1;
Repeat
LineCharCount:=0;
For BlockLoop:=1 to Blocks do
Begin
SetControls(BlockLoop);
If PageDone[BlockLoop] then (* No text so make blank line *)
Begin
If BlockLoop=Blocks then (* end line with CR *)
WriteDisk(CR)
End
Else (* print the text line *)
Begin
Repeat
Ch:=BuffChar(BlockLoop);
If SevenBit(Ch)<#31 then (* might be a control toggle *)
ControlCheck(BlockLoop)
Else
LineCharCount:=Succ(LineCharCount); (* increases for ASCII only *)
If SevenBit(Ch)<>CR then WriteDisk(Ch);
Until SevenBit(Ch)=CR; (* end of the line *)
SetControls(BlockLoop);
If (BlockLoop<Blocks) and
(LineCharCount>Succ(Column[BlockLoop]))
then
AbortProgram(3); (* Fatal Error -- no return *)
If BlockLoop<Blocks then
Begin
For I:=LineCharCount to Column[BlockLoop] do
WriteDisk(' '); (* Print spaces over to start of next page *)
LineCharCount:=Column[BlockLoop]+1
End
Else
WriteDisk(CR);
Ch:=BuffChar(BlockLoop); (* Checks for End of Page marker *)
PageDone[BlockLoop]:=(Ch=PageBreak) (* No more on that page *)
End
End;
AllPagesDone:=True;
For I:=1 to Blocks do
AllPagesDone:=(AllPagesDone and PageDone[I]);
If AllPagesDone then
WriteDisk(PageBreak) (* finish return page marker *)
Else
WriteDisk(LF); (* finish return with normal return *)
Until AllPagesDone
End;
Begin (* ReadNWrite *)
For I:=1 to Blocks do
Begin
UnderScore[I]:=False;
BoldFace[I]:=False;
DoubleStrike[I]:=False;
End;
Mark(HeapTop);
While not EOF(InputFile) do
Begin
ReadASet;
For I:=1 to Blocks do
PageDone[I]:=False;
QueuePages; (* Point to Page beginnings *)
MergePages; (* Pages are in queue, now put them together *)
Release(HeapTop)
End;
Close(OutputFile);
GotoXY(1,22);
WriteLn('The finished file is on <',OutputFileName,'>.')
End;
Begin (* WS-COLUM *)
Configuration;
InitializeFile;
ReadNWrite
End.