Oakland CPM Archive/oakcpm.iso/sigm/vol143/genindex.pas

Pascal/Delphi Source File | 1984-04-29 | 10.6 KB | 435 lines

{$S+}{}
program index(input,output) ;

{
  This PASCAL MT+ index generator program is placed in
  the public domain on the understanding that it is for
  non-profit redistribution via individuals for through
  RCPM systems
  Donated 23/6/83
  Matthew Starr P.O. Box 25 Wahroonga N.S.W 2076
        Australia

  Matthew Starr 13/12/81

  WordStar index generator program which will
  read through WordStar disk file output files
  and include strings delimited by ^Q and ^W as
  Major and Minor references respectively, creating
  an index which is then sorted and output as a
  WordStar source file.

  A required option for the Disk-file print is
  form feed page separation. (See procedure HELP)
}

const
    main_code = 17 ;        {code for boldface ref}
    sub_code = 23 ;        {code for normal ref}
    bold_code = 2 ;        {makes it boldface}
    formfeed = 12 ;
    stringz = 50 ;        {P.S. also change assgmnt}
    max_entries = 500 ;        {max # different entries}
    max_refs = 5 ;        {max # refs of either type}


type
    my_string = packed array[1 .. stringz] of char ;
    pointer = ^entry_type ;
    entry_type =
    record
        subject : my_string ;
        n_mains : integer ;
        mains : array[1 .. max_refs] of integer ;
        n_subs : integer ;
        subs : array[1 .. max_refs] of integer ;
    end ; { entry decl. }
    table_type = array[1 .. maxentries] of pointer ;

    ws_file = file of char ;
    index_file = file of entry_type ;


var
    index : index_file ;
    text_in : ws_file ;
    text_out : text ;

    end_file : entry_type ;
    table : table_type ;
    filename,response : string ;
    i, num_entries, result : integer ;


procedure addentry(var table:table_type; var tablength:integer; newentry:entry_type) ;

    begin
    if tablength >= max_entries
        then writeln('Too many entries - entry table full')
        else
        begin
            tablength := tablength+1 ;
            new(table[tablength]) ;
            table[tablength]^ := newentry
        end { else there is room }
    end;


procedure readarray(var name:my_string) ;

    var
    ch : char;
    nameindex : 0 .. stringz;

    procedure uppercase(var ch:char) ;
    begin
        if ord(ch)>127
        then ch := chr( ord(ch) - 128 ) ;
        if (ch >= 'a') and (ch <='z')
        then ch := chr( ord(ch)-(ord('a')-ord('A')) );
    end ; {uppercase}

    begin
    name := '                                                  ' ;
    nameindex := 0 ;
    read(text_in,ch) ;
    uppercase(ch) ;
    while (name_index<stringz)
        and (ord(ch)<>main_code) and (ord(ch)<>sub_code) do
        begin
        nameindex := nameindex+1 ;
        name[nameindex] := ch ;
        read(text_in,ch) ;
        uppercase(ch)
{ and throw away terminating control code }
        end {while}
    end ; {readarray}


procedure get_main
(var table:tabletype; var tablength:integer; var page, created, added_to:integer);

    var
    name: my_string;
    this_entry: entry_type;
    i: integer;

    begin
    readarray(name);
    i := 1 ;
    while (i<=num_entries) and (name<>table[i]^.subject) do
        i:=i+1 ;
    if i>num_entries    { i.e. if not found }

        then
        begin { create a new entry }
            with this_entry do
            begin
                created := created + 1 ;
                subject := name ;
                n_mains := 1 ;
                n_subs := 0 ;
                mains[1] := page
            end { with } ;
            addentry(table,tablength,this_entry)
        end {then}

        else {add to the ith entry}
        with table[i]^ do
            begin
            added_to := added_to + 1 ;
            if n_mains >= max_refs
                then
                writeln('Too many main references to ',subject)
                else
                begin
                    n_mains := n_mains+1 ;
                    mains[n_mains] := page
                end {else}
            end {with}
    end ; {get_main}


procedure get_sub
(var table:tabletype; var tablength:integer; var page, created, added_to:integer);

    var
    name: my_string;
    this_entry: entry_type;
    i: integer;

    begin
    readarray(name);
    i := 1 ;
    while (i<=num_entries) and (name<>table[i]^.subject) do
        i:=i+1 ;

    if i>num_entries    {i.e. was it found ?}
        then
        begin        { create a new entry }
            with this_entry do
            begin
                created := created + 1 ;
                subject := name ;
                n_mains := 0 ;
                n_subs := 1 ;
                subs[1] := page ;
            end { with } ;
            addentry(table,tablength,this_entry)
        end {then}

        else
        with table[i]^ do
            begin
            added_to := added_to + 1 ;
            if n_subs >= max_refs
                then
                writeln('Too many minor references to ',subject)
                else
                begin
                    n_subs := n_subs+1 ;
                    subs[n_subs] := page
                end {else}
            end {with}
    end ; {get_sub}


procedure scanfile
(var table:tabletype; var tablength:integer; filename:string);

var
    ch:char ;
    page, created, added_to : integer ;

    begin
    created := 0 ;
    added_to := 0 ;
    assign(text_in,filename) ;
    reset(text_in) ;
    if ioresult = 255
        then writeln('Could not open ',filename)
        else
        begin
            write('Page number start for this file? ');
            read(page) ;
            while not eof(text_in) do
            begin
                read(text_in,ch) ;
                if ord(ch)=formfeed
                then page := page + 1
                else if ord(ch)=main_code
                then get_main(table,tablength,page, created, added_to)
                else if ord(ch)=sub_code
                then get_sub(table,tablength,page, created, added_to)
            end ;
            writeln(created,' new entries created');
            writeln(added_to,' references added to existing subjects.')
        end { else file opened successfully }
    end ; { scanfile }


function lessthan(el1,el2 : pointer) : boolean ;
{compare the two entries as per ascii}

    begin
    lessthan := el1^.subject < el2^.subject
    end ; {compare}

procedure swap(var el1,el2 : pointer) ;
{swap two entries pointed to by el1, el2}
    var
    temporary : pointer ;
    begin
    temporary := el1 ;
    el1 := el2 ;
    el2 := temporary
    end {swap} ;


procedure split(    var splitee    :table_type;
            low,high    :integer;
            var midindex    :integer) ;
    var
    middle : pointer ;
    flag,up,down : integer ;
    begin
    up := low ;
    down := high+1 ;
    middle := splitee[low];    {split from first entry}
    flag := 1 ;
    while up < down do
        if flag = 1
        then {search downwards for a wrong one}
           begin
            down := down-1 ;
            if (up<>down) and not lessthan(middle,splitee[down])
                then
                begin
                    flag := 0 ;
                    splitee[up] := splitee[down]
                end {THEN it's out of place}
            end {THEN try and find a wrong one down}
        else {search upwards for a wrong one}
            begin
            up := up + 1 ;
            if (up <> down) and lessthan(middle,splitee[up])
                then
                begin
                    flag := 1 ;
                    splitee[down] := splitee[up]
                end {THEN it's out of place}
            end {ELSE try finding a wrong one upwards};
    splitee[up] := middle ;    {fit splitting element back}
    midindex := up ;    {where it was split}
    end ; {split}

procedure quicksort(var sortee: table_type; lower,upper:integer) ;
    var
    centre : integer ;
    begin
    if lower < upper
        then
        begin
            split(sortee,lower,upper,centre) ;
            quicksort(sortee,lower,centre-1) ;
            quicksort(sortee,centre+1,upper)
        end {then}
    end; {quicksort}

procedure writeentry(var outfile:text; item : entry_type) ;

    var
    j : integer ;

    begin
    with item do
        begin
        write(outfile,subject) ;
        if n_mains <> 0
            then
            begin
                write(outfile,chr(bold_code)) ;
                write(outfile,mains[1]:1) ;
                for j := 2 to n_mains do
                write(outfile,',',mains[j]:1) ;
                write(outfile,chr(bold_code)) ;
                if n_subs <> 0
                then write(outfile,',')
            end ; {then}
        if n_subs <> 0
            then
            begin
                write(outfile,subs[1]:1) ;
                for j := 2 to n_subs do
                write(outfile,',',subs[j]:1)
            end ; { then }
        writeln(outfile)
        end {with}
    end ; {writeentry}


procedure help;

    var
    null_line : string ;
    begin
    writeln(' This program generates a WordStar source') ;
    writeln('file of an index for manuals, etc.') ;
    writeln(' The index can be compiled from many files') ;
    writeln('which may be scanned at different times.') ;
    writeln(' The cumulative index file is stored in a') ;
    writeln('file called "index" and is updated after') ;
    writeln('each run of this program, so ERAse it when') ;
    writeln('you want to restart the index compilation') ;
    writeln(' The input files you are prompted for MUST') ;
    writeln('be "DISK FILE OUTPUT"s from the WordStar') ;
    writeln('Print command, with the FORMFEED option') ;
    writeln(' The output file is WordStar compatible,') ;
    writeln('and may be ^K Read into an index framework');
    write('Press return') ; read (null_line) ;
    writeln(' To mark an item for inclusion as one of');
    writeln('the main references, use ^KQ.') ;
    writeln(' To mark a minor reference, use ^KW') ;
    writeln(' These markers must SURROUND the reference');
    writeln('as for underlining.') ;
    writeln(' The main references are listed first in');
    writeln('BOLD type, and the minors after that in') ;
    writeln('normal type') ;
    writeln(' All marked text is converted to UPPER case');
    writeln('The max. number of references per subject');
    writeln('is ',max_refs,', and the maximum number of');
    writeln('subjects is ',max_entries)
    end ; {help}


begin {main program}

    assign(index,'index') ;

{ read in as much of the index as has been done already }
    num_entries := 0 ;
    reset(index) ;
    if ioresult <> 255
    then
        begin
        while (index^.n_mains<>-1) and not eof(index)do
            begin
            addentry(table,num_entries,index^) ;
            get(index)
            end {while}
        end ; {then}
    writeln(num_entries,' entries read from old index file');

{ read in the new WordStar source files to be scanned }
    repeat
    writeln('Enter name of WordStar print file, or CR to continue') ;
    read(filename) ;
    if filename <> ''
        then
        if (filename = 'help') or (filename = 'HELP')
            then help
            else scanfile(table,num_entries,filename)
    until filename = '' ;

{ sort the new index }
    quicksort(table,1,num_entries) ;

{ save the new index }
    rewrite(index) ;
    if ioresult = 255
    then writeln('Could not update index file')
    else
        begin
{ write index to the file }
        for i := 1 to num_entries do
            write(index,table[i]^) ;
{ now add end of file mark with n_mains =-1 }
        end_file.n_mains := -1 ;
        write(index,end_file) ;

        close(index,result) ;
        if ioresult = 255
            then writeln('Could not close index file')
            else writeln(num_entries,' entries written to index file')
        end {else} ;

{ ask if a WordStar output file is required yet }
    write('Is a WordStar output file required yet (y/n) ? ') ;
    read(response) ;
    if (response[1] = 'y') or (response[1] = 'Y')
    then
        begin
        write('What filename ? ') ;
        read(filename) ;
        assign(text_out,filename) ;
        rewrite(text_out) ;
        if ioresult = 255
            then writeln('Could not create ',filename)
            else
            begin
                for i := 1 to num_entries do
                writeentry(text_out,table[i]^);
                close(text_out,result)
            end {else}
        end {then}
end. {index}