diff options
Diffstat (limited to 'macros/text1/vax_vms/texix.ch')
-rw-r--r-- | macros/text1/vax_vms/texix.ch | 509 |
1 files changed, 509 insertions, 0 deletions
diff --git a/macros/text1/vax_vms/texix.ch b/macros/text1/vax_vms/texix.ch new file mode 100644 index 0000000000..20168b7fe4 --- /dev/null +++ b/macros/text1/vax_vms/texix.ch @@ -0,0 +1,509 @@ + +@x line 6 + \centerline{{\twelvept For IBM VM/CMS Pascal/VS}} +@y + \centerline{{\twelvept For Vax Pascal}} +@z + +@x line 107 +segment texix; +procedure texix(ix:char); external; +procedure texix; +@y +[inherit('sortcall')] +program texix(input,output); +@z + +@x line 142 +@d getout == return +@d messages == sysprint +@y +@d getout == goto return +@d messages == output +@z + +@x line 146 +@d max_lrecl = 2048 +@y +@d max_lrecl = 255 +@z + +@x line 147 +in_record := dosubstr(in_record,1 + #) +@y +in_record := dosubstr(in_record,1 + #,length(in_record)-(#)) +@z + +@x line 176 +@d do_when_bold == begin +if length(bold_string) > 0 then add_comma(bold_string); +bold_string:= +ccat(ccat(ccat(bold_string,'{\bd '),curr_str_page),'}'); +@.\bs{}bd@> +end + +@d do_when_underscore == begin +if length(us_string) > 0 then add_comma(us_string); +us_string:= +ccat(ccat(ccat(us_string,'\us{'),curr_str_page),'}'); +@.\bs{}us@> +end + +@d do_when_italic == begin +if length(rm_string) > 0 then add_comma(rm_string); +rm_string:= +ccat(ccat(ccat(rm_string,'{\it '),curr_str_page),'}'); +@.\bs{}it@> +end +@y +@d do_when_bold == begin +if length(bold_string) > 0 then add_comma(bold_string); +bold_string:=ccat(bold_string,'{\bd '); +bold_string:=ccat(bold_string,curr_str_page); +bold_string:=ccat(bold_string,'}'); +@.\bs{}us@> +end + +@d do_when_underscore == begin +if length(us_string) > 0 then add_comma(us_string); +us_string:=ccat(us_string,'\us{'); +us_string:=ccat(us_string,curr_str_page); +us_string:=ccat(us_string,'}'); +@.\bs{}us@> +end + +@d do_when_italic == begin +if length(rm_string) > 0 then add_comma(rm_string); +rm_string:=ccat(rm_string,'{\it '); +rm_string:=ccat(rm_string,curr_str_page); +rm_string:=ccat(rm_string,'}'); +@.\bs{}it@> +end +@z + +@x line 253 + ccat := x ccat_temp y; +@y + ccat := x + y; +@z + +@x line 271 +@^System dependent code@> +@p procedure reset_file(file_number:char); +begin +if file_number = '9' then reset(sort_file, +'NAME=TEXT1$$.OUTSORT.A,LRECL=1857,RECFM=V') +else reset(ix_file, +ccat(ccat('NAME=TEXT1$$.IX',str(file_number)),'.A')); +end; +@y +@^System dependent code@> +@p procedure reset_file(file_number:char); +begin +if file_number = '9' then begin open(sort_file, +'TEXT1$$.OUTSORT',history:=readonly); reset(sort_file); end +else begin open(ix_file,ccat('TEXT1$$.IX',file_number),history:=readonly); +reset(ix_file); end; +end; + +function trim(object:string_pass):string_pass; +var i:integer; +new_string:string_pass; +begin +i:=length(object)+1; +repeat + decr(i); + until (object[i] <> ' ') or (i=1); +if (object[i] = ' ') and (i=1) +then new_string:='' +else new_string:=dosubstr(object,1,i); +trim:=new_string; +end; +@z + +@x line 288 +rewrite(sort_file,'NAME=TEXT1$$.INSORT.A,LRECL=1857,RECFM=V') +else +rewrite(ix_file, +ccat(ccat('NAME=TEXT1$$.IX',str(file_number)), +'.A,LRECL=2048,RECFM=V')); +@y +begin open(sort_file,'TEXT1$$.INSORT'); +rewrite(sort_file); end +else +begin +open(ix_file,ccat('TEXT1$$.IX',file_number), +record@=_@>@t\_@>length:=1024); +rewrite(ix_file); end; +@z + +@x line 444 +@ The {\it get\_numeric} +function will take a packed array of length max\_pn\_alpha and convert +that array (which is really the page number) into an integer. + +@p function get_numeric(x_string:string_type(max_pn_alpha)):integer; +var @!i:integer; +begin +readstr(x_string,i); +get_numeric:=i; +end; +@y +@ The {\it get\_numeric} +function will take a packed array of length max\_pn\_alpha and convert +that array (which is really the page number) into an integer. + +@p function get_numeric(x_string:string_pass):integer; +var @!i:integer; +begin +readv(x_string,i); +get_numeric:=i; +end; +@z + +@x line 459 +@p procedure strvalue(x:integer; var results:pass_pn_alpha); +var +temp:string_type(max_pn_alpha); +begin +writestr(temp,x); +results:=ltrim(temp); +end; +@y +@p function ltrim(triml_in_string:string_pass):pn_type; +var i,j:integer; +triml_out_string:pn_type; +begin +j:=0; +for i:=1 to length(triml_in_string) do begin +if triml_in_string[i] <> ' ' then begin + incr(j); + triml_out_string[j]:=triml_in_string[i]; + end; +end; +ltrim:=triml_out_string; +end; + + +procedure strvalue(x:integer; var results:pn_type); +var +temp:string_type(max_pn_alpha); +begin + writev(temp,x); + results:=trim(ltrim(temp)); + end; +@z + +@x line 470 +@p function strconv(x:pn_alpha_type):string_type(max_pn_alpha); +var i:integer; +temp:string_type(max_pn_alpha); +begin +temp:='';i := 1; +with sort_record do begin +repeat +if x[i] <> ' ' then +temp := ccat(temp,str(x[i])); +incr(i); +until (i > max_pn_alpha) or (x[i] = ' '); +end; +strconv:=temp; +end; +@y +@p function strconv(x:pn_alpha_type):pass_pn_alpha; +var i:integer; +temp:string_type(max_pn_alpha); +begin +temp:='';i := 1; +with sort_record do begin +repeat +if x[i] <> ' ' then +temp := ccat(temp,x[i]); +incr(i); +until (i > max_pn_alpha) or (x[i] = ' '); +end; +strconv:=temp; +end; +@z + +@x line 626 +@ The {\it plsort} procedure is written in PL/1 to call the CMS sort program +Syncsort. This was necessary since you cannot call Syncsort from PASCAL/VS. +The fields to be sorted are defined internally in the {\it plsort} +program. This should be the same as the three sort fields in {\it sort\_type}. +@:sort_type@> +@:plsort@> @^PL/1@> +@^Syncsort@> + +@p procedure plsort(var sort_rc:integer); fortran; +@y +@ The {\it vmssort} procedure calls a VMS sort program. +You can use your favorite program here. +The three sort fields in {\it sort\_type} are to be sorted. +@:sort_type@> +@:vmssort@> + +@z + +@x line 643 +@ This function converts to all uppercase. +Notice that this is an EBCIDIC conversion, not an ASCII conversion +to uppercase. + +@p function upper_case(x:char):char; +var temp:char; +begin + if (ord(x)>=129)and(ord(x)<=169) then + temp:=chr(ord(x)+64) + else temp:=x; +upper_case:=temp; +end; +@y +@ This function converts to all uppercase. +Notice that this is an ASCII conversion, not an EBCDIC conversion +to uppercase. + +@p function upper_case(x:char):char; +var temp:char; +begin + if ord(x) >= "a" then + temp:=chr(ord(x)-@'40) + else temp:=x; +upper_case:=temp; +end; +@z + + +@x line 710 +@!temp_strvalue:pass_pn_alpha; +@y +@!temp_strvalue:pn_type; +@z + +@x line 738 +if dosubstr(in_record,doindex(in_record,'=')+1) = 'no' +@y +if dosubstr(in_record,doindex(in_record,'=')+1,length(in_record) +-doindex(in_record,'=')) = 'no' +@z + +@x line 744 +if dosubstr(in_record,doindex(in_record,'=')+1) = 'no' +@y +if dosubstr(in_record,doindex(in_record,'=')+1,length(in_record) +-doindex(in_record,'=')) = 'no' +@z + +@x line 862 +@<Write Sort Record@>= +sort_file@@:=sort_record; +put(sort_file); +@y +@<Write Sort Record@>= +write(sort_file,sort_record); +@z + +@x line 890 +The page number for a blind entry will always be 999999999. + +@<Do Blind Entry@>= +begin remove_characters(6);{Throw away the `\$\{\$\}be'}@/ +i := doindex(in_record,'{$}'); +curr_level:=2; +write_print_chars(i-1); +curr_level:=0; +remove_characters(3);{Throw away the `\{\$\}'} +sort_record.page_number := 999999999; +@y +The page number for a blind entry will always be 9999. + +@<Do Blind Entry@>= +begin remove_characters(6);{Throw away the `\$\{\$\}be'}@/ +i := doindex(in_record,'{$}'); +curr_level:=2; +write_print_chars(i-1); +curr_level:=0; +remove_characters(3);{Throw away the `\{\$\}'} +sort_record.page_number := 9999; +@z + +@x line 937 +@p procedure add_page_number; +var i:integer; +@y +@p procedure add_page_number; +var i:integer; +label return; +@z + +@x line 955 +@<Add Page Number to the String@> +@y +@<Add Page Number to the String@> +return: +@z + +@x line 963 +@!str_build:string_type(max_lrecl); +@y +@!str_build:string_type(max_lrecl); +@!temp_build:string_type(max_lrecl); +@z + +@x line 976 +str_blind_entry := ccat(str_blind_entry,str(field_level[i])); +@y +str_blind_entry := ccat(str_blind_entry,field_level[i]); +@z + +@x line 996 +@ If the {\it page\_string[1]} is less than zero, its alphabetic and +roman numeral processing is necessary. + +@<Do Sorted Non Blind Entry@>= +with sort_record do begin +if ord(page_string[1]) < ord('0') +@y +@ If the {\it page\_string[1]} is greater + than nine, its alphabetic and +roman numeral processing is necessary. + +@<Do Sorted Non Blind Entry@>= +with sort_record do begin +if ord(page_string[1]) > ord('9') +@z + +@x line 1006 +str_build := ccat(ccat(ccat(strconv(page_string), +','),temp_strvalue),str_build); +@y +temp_build:=ccat(strconv(page_string),','); +temp_build:=ccat(temp_build,temp_strvalue); +str_build:=ccat(temp_build,str_build); +@z + +@x line 1103 +then curr_str_page:=dosubstr(curr_str_page,2) +@y +then curr_str_page:=dosubstr(curr_str_page,2,length(curr_str_page)-1) +@z + +@x line 1179 +if i < 1 then begin curr_str_page:=str_build; str_build:='';end +else begin +curr_str_page:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1); +end; +@<Get the Current Print Type of this Page Number@>;@/ +if ord(curr_str_page[1]) < ord('0') {Then its alphabetic} +@y +if i < 1 then begin curr_str_page:=str_build; +str_build:='';end +else begin +curr_str_page:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1,length(str_build)-i); +end; +@<Get the Current Print Type of this Page Number@>;@/ +if ord(curr_str_page[1]) > ord('9') +@z + + +@x line 1192 +if i < 1 then begin temp_roman:=str_build; str_build:='';end +else begin +temp_roman:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1); +@y +if i < 1 then begin temp_roman:=str_build; +str_build:='';end +else begin +temp_roman:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1,length(str_build)-i); +@z + +@x line 1254 +output_string := ccat(ccat('\leader{}',output_string),'\par'); +@y +output_string:=ccat('\leader{}',output_string); +output_string:=ccat(output_string,'\par'); +@z + +@x line 1305 +sort_record:=sort_file@@; +get(sort_file); +@y +read(sort_file,sort_record); +@z + +@x line 1524 +@* Main Program. +Ok, here is the main program. First we initialize (all\_blanks); then +set the ix\_file for input and the sort\_file for output; read all of the +entries, processing each one; close the files; sort; read the sorted file +in and build the entries, writing them back to the ix\_file to be read in +by the index markup. WHEW!! + +@p +begin @<Initialize Main@>@/ +termout(messages); +reset_file(ix);@/ +file_rewrite(s_file_number); {Should always be file 9}@/ +read_all_entries;@/ +close(ix_file);@/ +close(sort_file);@/ +@<Sort the Index@>@/ +reset_file(s_file_number);@/ +file_rewrite(ix);@/ +build_sorted_index;@/ +end; +@y +@* Main Program. +Ok, here is the main program. First we initialize (all\_blanks); then +prompt to determine which index to use (1, 2, or 3). +Next call VMS' sort routine. And thats it. + WHEW!! + +@p +begin @<Initialize Main@>@/ +write('Which index are you processing (1, 2, or 3)? ');@/ +readln(ix);@/ +if (ix <> '1') and (ix <> '2') and (ix <> '3') then begin +writeln(messages, +'You can only process indexes 1, 2, or 3. Start again.'); +halt; end; +writeln(''); +writeln(messages,'Starting the sort routine....'); +writeln(messages); +reset_file(ix);@/ +file_rewrite('9'); +read_all_entries; +close(ix_file); +close(sort_file); +@<Sort the Index@>@/ +reset_file('9'); +file_rewrite(ix); +build_sorted_index; +close(ix_file); {ix\_file now has the index to be run through \TeX} +end. +@z + + +@x line 1558 +sort_rc:integer; +@y +sort_rc:integer; +@!ix:char; +@z + + +@x line 1565 +plsort(sort_rc); +if sort_rc = 0 + then writeln(messages,'Index Successfully Completed') + else writeln(messages,'Index Failed'); +@y +vmssort(sort_rc); +if odd(sort_rc) + then writeln(messages,'Index Successfully Completed') + else writeln(messages,'Index Failed'); +@z |