diff options
Diffstat (limited to 'macros/text1/macintosh/texix.turbomac')
-rw-r--r-- | macros/text1/macintosh/texix.turbomac | 591 |
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 |