summaryrefslogtreecommitdiff
path: root/macros/text1/vax_vms/texix.ch
diff options
context:
space:
mode:
Diffstat (limited to 'macros/text1/vax_vms/texix.ch')
-rw-r--r--macros/text1/vax_vms/texix.ch509
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