summaryrefslogtreecommitdiff
path: root/macros/text1/macintosh/texix.turbomac
diff options
context:
space:
mode:
Diffstat (limited to 'macros/text1/macintosh/texix.turbomac')
-rw-r--r--macros/text1/macintosh/texix.turbomac591
1 files changed, 591 insertions, 0 deletions
diff --git a/macros/text1/macintosh/texix.turbomac b/macros/text1/macintosh/texix.turbomac
new file mode 100644
index 0000000000..8e6ecaaa49
--- /dev/null
+++ b/macros/text1/macintosh/texix.turbomac
@@ -0,0 +1,591 @@
+% Version 1.0; Dean Guenther; 4/1/86
+% Version 1.1; Dean Guenther; 12/87
+% Version 1.2; Dean Guenther; 6/28/88
+These are the changes necessary to use TEXIX with Turbo mac pascal.
+
+@x line 6
+ \centerline{{\twelvept For IBM VM/CMS Pascal/VS}}
+@y
+ \centerline{{\twelvept For Macintosh Turbo Pascal}}
+@z
+
+@x line 68
+\def\PASCAL{{\sc PASCAL/VS}}
+@y
+\def\PASCAL{{\sc Macintosh Turbo Pascal}}
+@z
+
+@x line 87
+@ The @^TEXIX@>
+program is written entirely in WEB, except for an external
+procedure, {\it plsort}, which is written in @^PL/1@> PL/1.
+This was necessary since
+\PASCAL\ cannot call
+@:plsort@>
+Syncsort @^SYNCSORT@>
+to do an internal sort, and PL/1 can.
+@y
+@ The @^TEXIX@>
+program is written entirely in WEB, except for an internal
+sort which uses the TURBO Pascal DataBase Toolbox sort.
+This was necessary since
+\PASCAL\ cannot itself do a sort.
+@z
+
+@x line 107
+segment texix;
+procedure texix(ix:char); external;
+procedure texix;
+@y
+program texix;
+@{$U Sort@}
+uses sane, MemTypes, QuickDraw, OSIntf, Sort, toolintf; @/
+@{It is required to convert all @@ into a shift-6 \^ {} before
+compiling this with turbo pascal@} @{ There is one exception,
+the line at the bottom that calls the Sort routine should retain
+the at signs.@}
+
+@z
+
+@x line 119
+@<Global Var...@>=
+sysprint:text;
+@!ix_file :text;
+@y
+@<Global Var...@>=
+sysprint:text;
+@!ix_file :text;
+@!curslist:CursorList;
+@!total_recs:integer;
+@!clock_time:integer;
+@z
+
+@x line 123
+@ The {\it sort\_file} is used for the internal sort only. The \text1\ user
+never has access to it.
+
+@<Global Var...@>=
+@!sort_file :file of sort_type;
+@y
+@ The {\it sort\_file} used with Pascal/VS is not needed in \PASCAL.
+@z
+
+@x line 136
+@d dosubstr == substr
+@d doindex == index
+@y
+@d dosubstr == copy
+@d doindex == getindex
+@z
+
+@x line 142
+@d getout == return
+@d messages == sysprint
+@y
+@d getout == exit
+@d messages == output
+@z
+
+@x line 147
+@d max_field = 300
+@d max_levels = 3
+@d max_lrecl = 2048
+@y
+@d max_field = 255
+@d max_levels = 3
+@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 160
+@d string_type(#) == string(#)
+@y
+@d string_type(#) == string[#]
+@z
+
+@x line 206
+@ This is arbitrary, but
+there should never be more than 8 indicies.
+
+@d s_file_number == '9'
+@y
+@ The variable {\it s\_file\_number} is not used in \PASCAL\ and
+is omitted here.
+@z
+
+@x line 253
+ ccat := x ccat_temp y;
+@y
+ ccat := concat(x,y);
+@z
+
+@x line 277
+@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
+@p procedure reset_file(file_number:char);
+begin
+@{$I-@}
+reset(ix_file,
+ccat('TEXT1$$.IX',file_number));
+@{$I+@}
+if ioresult <> 0 then
+begin
+writeln(messages,^G,
+' -- Cannot find file ',ccat('TEXT1$$.IX',file_number));
+halt;
+end;
+end;
+
+function getindex(x:string_pass;y:string_pass):integer;
+begin
+ getindex := pos(y,x);
+ 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:=copy(object,1,i);
+trim:=new_string;
+end;
+@z
+
+@x line 292
+@p procedure file_rewrite(file_number:char);
+begin
+if file_number = '9'
+then
+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'));
+end;
+@y
+@p procedure file_rewrite(file_number:char);
+begin
+rewrite(ix_file,
+ccat('TEXT1$$.IX',file_number));
+end;
+@z
+
+@x line 343
+@ @<Global Types@>=
+@!string_pass=string_type(max_lrecl);
+@y
+@ @<Global Types@>=
+@!CursorList = array[iBeamCursor..watchCursor] of CursHandle;
+@!string_pass=string_type(max_lrecl);
+@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
+@ This function is needed to put the string to be converted by
+get\_numeric into the upper right portion of the string to be
+converted.
+
+@p function shift_right(in_string:string_pass):decstr;
+var i,j:integer; temp:pn_alpha_type;
+begin
+ j:=0;
+ repeat incr(j); {find the first blank}
+ until (in_string[j] = ' ') or (in_string[j] = '') or
+ (j >= length(in_string));
+ for i:= 1 to sizeof(temp)-1 do temp[i]:=' ';
+ for i:=1 to j do temp[sizeof(temp)-j+i]:=in_string[i];
+ shift_right:=temp;
+ end;
+
+@ 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
+get_numeric:=num2integer(str2num(shift_right(x_string)));
+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 procedure strvalue(X:integer; var results:pass_pn_alpha);
+var temp:decstr;
+ y:extended;
+ f:decform;
+ i,qq:integer;
+begin
+ f.style := fixeddecimal;
+ f.digits:=0;
+ y:=num2extended(x);
+ for i := 1 to decstrlen do temp[i] := ' ';
+ num2str(f,y,temp);
+ i:=1;
+ results:=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 LessRec} function is used by Turbo Pascal Database Toolbox's
+Sort routine. It returns true if record ``x'' is less than record ``y''.
+The record {\it sort\_type} is used for comparison.
+@:sort_type@>
+
+@p function LessRec(var x,y :sort_type):boolean;
+var Lower :boolean;
+begin Lower := (x.sort_part[1].field_level < y.sort_part[1].field_level);
+if not Lower then begin {x $\ge$ y}
+Lower := (x.sort_part[1].field_level = y.sort_part[1].field_level);
+if Lower then begin {x = y}
+Lower := (x.sort_part[2].field_level < y.sort_part[2].field_level);
+if not Lower then begin {x $\ge$ y}
+Lower := (x.sort_part[2].field_level = y.sort_part[2].field_level);
+if Lower then begin {x = y}
+Lower := (x.sort_part[3].field_level < y.sort_part[3].field_level);
+if not Lower then begin {x $\ge$ y}
+Lower := (x.sort_part[3].field_level = y.sort_part[3].field_level);
+if Lower then begin {x = y}
+Lower := (x.abs_page_number < y.abs_page_number);
+if not Lower then begin {x $\ge$ y}
+Lower := (x.abs_page_number = y.abs_page_number);
+if Lower then begin {x = y}
+Lower := (x.page_number < y.page_number);
+if not Lower then begin {x $\ge$ y}
+Lower := (x.page_number = y.page_number);
+if Lower then {x = y}
+Lower := (x.record_type < y.record_type);
+end; end; end; end; end; end; end; end; end;
+LessRec := Lower;
+end;
+@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 719
+@<Get Default Index Values@>
+@y
+writeln(messages);
+writeln(messages,'Reading in the input now...');
+total_recs := 0;
+@<Get Default Index Values@>
+@z
+
+@x line 722
+@<Read Next Record@>@/
+@y
+@<Read Next Record@>@/
+incr(total_recs);write(total_recs:6);gotoxy(1,6);
+@z
+
+@x line 728
+end;end;
+@y
+end;
+close(ix_file);
+writeln(messages);
+writeln(messages,'done reading the records. Starting to sort......');
+clock_time := tickcount;
+end;
+@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))
+ = '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))
+ = 'no'
+@z
+
+@x line 867
+@ Ok, the record has been processed, so write it to the output file.
+
+@<Write Sort Record@>=
+sort_file@@:=sort_record;
+put(sort_file);
+@y
+@ Ok, the record has been processed, so write it to the output file
+using the procedure defined to Turbo Pascal's Database Toolbox.
+
+@<Write Sort Record@>=
+SortRelease(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 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 1103
+then curr_str_page:=dosubstr(curr_str_page,2)
+@y
+then curr_str_page:=dosubstr(curr_str_page,2,length(curr_str_page))
+@z
+
+@x line 1182
+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
+str_build := dosubstr(str_build,i+1,length(str_build));
+end;
+@<Get the Current Print Type of this Page Number@>;@/
+if ord(curr_str_page[1]) > ord('9') {Then its alphabetic}
+@z
+
+@x line 1195
+str_build := dosubstr(str_build,i+1);
+@y
+str_build := dosubstr(str_build,i+1,length(str_build));
+@z
+
+@x line 1311
+while not eof(sort_file) do begin
+sort_record:=sort_file@@;
+get(sort_file);
+@y
+file_rewrite(ix);
+clock_time := tickcount - clock_time;write(^G);
+writeln(messages,'It took ',clock_time/60.0:1:4,' seconds to sort ',
+total_recs:6,' records.');
+writeln(messages,'Now building the file to be formated with TEXT1...');
+while not SortEOS do begin
+SortReturn(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 Turbo Pascal's 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;
+clearscreen;writeln('');
+writeln(messages,'Loading the sort routine....');
+writeln(messages);
+reset_file(ix);@/
+for m := iBeamCursor to watchCursor do begin
+curslist[m] := getcursor(m);
+hlock(handle(curslist[m]));end;setcursor(curslist[watchCursor]^^);
+showcursor;
+@<Sort the Index@>@/
+hidecursor;
+close(ix_file); {ix_file now has the index to be run through \TeX}
+write(messages,'Press any key to continue ');readln;
+end.
+@z
+
+
+@x line 1548
+@ As mentioned earlier, {\it plsort} is an external PL/1 subroutine
+@^PL/1@>
+@^Syncsort@>
+which is used to call Syncsort to sort the file.
+The sort fields are as follows:
+@y
+@ As mentioned earlier, {\it TurboSort} is a Turbo Toolbox Database
+ subroutine
+which is used to sort the index file.
+The sort fields are as follows:
+@z
+
+@x line 1562
+sort_rc:integer;
+@y
+sort_rc:integer;
+@!ix:char;
+@z
+
+@x line 1564
+@ @<Sort the Index@>=
+plsort(sort_rc);
+if sort_rc = 0
+ then writeln(messages,'Index Successfully Completed')
+ else writeln(messages,'Index Failed');
+@y
+@ @<Sort the Index@>=
+sort_rc := TurboSort(sizeof(sort_type),@@read_all_entries,
+@@LessRec, @@build_sorted_index);
+if sort_rc = 0
+ then writeln(messages,'Index Successfully Completed')
+ else writeln(messages,'Index Failed');
+@z